Page MenuHomeDevCentral
Files F3780294

D106.id252.diff
No OneTemporary
Actions

D106.id252.diff
View Options

diff --git a/Core.tcl b/Core.tcl
--- a/Core.tcl
+++ b/Core.tcl
@@ -17,6 +17,15 @@
}
#
+# Loop constructs
+#
+
+# http://wiki.tcl.tk/3603
+proc do {code while cond} {
+ tailcall try $code\n[list $while $cond $code]
+}
+
+#
# Trivial procs
#
diff --git a/Wearg/Broker.tcl b/Wearg/Broker.tcl
new file mode 100644
--- /dev/null
+++ b/Wearg/Broker.tcl
@@ -0,0 +1,108 @@
+namespace eval broker {
+ proc init {} {
+ # Loads our librabbitmq wrapper extension
+ if {![is_package_present rabbitmq]} {
+ load ../rabbitmq.so
+ }
+
+ # Connects to the broker
+ if {![mq connected]} {
+ connect
+ }
+
+ # Starts timer
+ if {![is_timer_started]} {
+ start_timer
+ }
+ }
+
+ proc is_package_present {package} {
+ expr ![catch {package present $package}]
+ }
+
+ proc connect {} {
+ mq connect [registry get broker.host] [registry get broker.user] [registry get broker.password] [registry get broker.vhost]
+ }
+
+ proc is_timer_started {} {
+ expr [string first ::broker::on_tick [utimers]] > -1
+ }
+
+ proc start_timer {} {
+ utimer 4 [namespace current]::on_tick
+ }
+
+ proc on_tick {} {
+ get_messages
+ utimer 1 [namespace current]::on_tick
+ }
+
+ proc get_messages {} {
+ foreach queue [registry get broker.queues] {
+ while 1 {
+ if {[catch {set message [mq get $queue -noack]} brokerError]} {
+ if {[recover_from_broker_error $brokerError]} {
+ continue
+ } {
+ error $brokerError
+ }
+ }
+ if {$message == ""} {
+ break
+ } {
+ on_message $queue $message
+ }
+ }
+ }
+ }
+
+ # Tries to recover from broker error and determines if we could continue
+ #
+ # @param error The error message.
+ # @return 1 if we can continue to process messages, 0 if we should throw an error
+ proc recover_from_broker_error {error} {
+ if {$error == "Child process signal received."} {
+ putdebug "Ignoring SIGCHLD"
+ } elseif {$error == "Not connected."} {
+ connect
+ } else {
+ return 0
+ }
+
+ return 1
+ }
+
+ proc bind {queue callback} {
+ global brokerbinds
+ set entry [list $queue $callback]
+
+ foreach bind $brokerbinds {
+ if {$bind == $entry} {
+ # Bind is already here
+ return
+ }
+ }
+
+ lappend brokerbinds $entry
+ }
+
+ proc binds {} {
+ global brokerbinds
+ return $brokerbinds
+ }
+
+ # Triggered when a message comes to the broker to dispatch it to bound procs
+ proc on_message {queue message} {
+ set propagated 0
+ foreach bind [binds] {
+ foreach "bindQueue callback" $bind {}
+ if {[string match $bindQueue $queue]} {
+ $callback $queue $message
+ incr propagated
+ }
+ }
+ if {$propagated == 0} {
+ putdebug "<$queue> [string range $message 0 32]..."
+ }
+ }
+}
diff --git a/Wearg/Notifications.tcl b/Wearg/Notifications.tcl
new file mode 100644
--- /dev/null
+++ b/Wearg/Notifications.tcl
@@ -0,0 +1,104 @@
+package require json
+
+namespace eval notifications {
+ proc init {} {
+ ::broker::bind "wearg-notifications" ::notifications::on_broker_message
+
+ bind * * * * ::notifications::channel_notify
+ }
+
+ proc bind {service project group type callback} {
+ global notificationsbinds
+ set entry [list $service $project $group $type $callback]
+
+ if {[info exists notificationsbinds]} {
+ foreach bind $notificationsbinds {
+ if {$bind == $entry} {
+ # Bind is already here
+ return
+ }
+ }
+ }
+
+ lappend notificationsbinds $entry
+ }
+
+ proc binds {} {
+ global notificationsbinds
+
+ if {[info exists notificationsbinds]} {
+ return $notificationsbinds
+ }
+
+ return ""
+ }
+
+ proc is_matching_notification_bind {bind notification} {
+ set bindFields "service project group type callback"
+
+ # We want to ensure the first four bind fields match the values of the notification dictionary
+ foreach $bindFields $bind {}
+ set fields [lrange $bindFields 0 end-1]
+ foreach field $fields {
+ if {![string match [set $field] [dict get $notification $field]]} {
+ return 0
+ }
+ }
+
+ return 1
+ }
+
+ proc on_broker_message {queue message} {
+ set notification [json::json2dict $message]
+ set message [dict get $notification text]
+
+ foreach field "service project group rawContent type text link" {
+ lappend params [dict get $notification $field]
+ }
+
+ foreach bind [binds] {
+ if {[is_matching_notification_bind $bind $notification]} {
+ set callback [lindex $bind 4]
+ $callback {*}$params
+ }
+ }
+ }
+
+ proc get_notification_channel {project group} {
+ if {$project == "Wolfplex"} {
+ return "#wolfplex"
+ }
+ if {$project == "Nasqueron"} {
+ switch $group {
+ tasacora { return "#tasacora" }
+ docker { return "#nasqueron-ops" }
+ ops { return "#nasqueron-ops" }
+ orgz { return "#nasqueron-ops" }
+ default {
+ putdebug "Message for unknown group: $project $group"
+ return "#nasqueron-logs"
+ }
+ }
+ }
+ return ""
+ }
+
+ proc channel_notify {service project group rawContent type text link} {
+ set channel [get_notification_channel $project $group]
+ if {$channel == ""} {
+ return
+ }
+
+ set message $text
+ if {$link != ""} {
+ append message " — $link"
+ }
+
+ if {$type == "push" || $type == "ping" || $type == "repository" || $type == "create"} {
+ putquick "PRIVMSG $channel :$message"
+ } {
+ # These probably need some love on the notifications center
+ putdebug "Message for $channel: $message"
+ }
+ }
+}

File Metadata

Mime Type
text/plain
Expires
Tue, Nov 26, 12:51 (18 h, 10 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
2264642
Default Alt Text
D106.id252.diff (5 KB)

Event Timeline

Nasqueron DevCentral · If it had been much bigger the moon would have had a core of ice. · Powered by Phabricator