Page MenuHomeDevCentral
Files F3767402

No OneTemporary
Actions

View Options

diff --git a/Wearg/ServersLog.tcl b/Wearg/ServersLog.tcl
index 935ee81..a9ff5aa 100644
--- a/Wearg/ServersLog.tcl
+++ b/Wearg/ServersLog.tcl
@@ -1,43 +1,70 @@
package require rest
bind pub - .+log pub:log
bind dcc - +log dcc:log
+bind pubm - "#* \[*\] *" pubm:log
+
+proc pubm:log {nick uhost handle chan text} {
+ regexp "\\\[(.*)\\\] (.*)" $text match component entry
+
+ if {[is_known_component $component]} {
+ add_to_servers_log $emitter "$network $source" $component $entry
+ putcmdlog "<<$nick>> !$handle! .+log $text"
+ } {
+ putserv "PRIVMSG $chan :$nick, if you wish to log that, confirm with .+log $text"
+ }
+}
+
proc pub:log {nick uhost handle chan arg} {
set callback [get_putbymode_chan_callback $chan $nick]
handle_send_to_servers_log [resolve_nick $nick] $chan $arg $callback
}
proc dcc:log {handle idx arg} {
global username
handle_send_to_servers_log $handle $username $arg "dcc $idx"
}
+proc is_known_component {candidate} {
+ # If "Dwellers" is a known component, are known:
+ # - Dwellers
+ # - Dwellers/DevCentral
+
+ foreach component [registry get serverslog.knowncomponents] {
+ if {[regexp ^${component}(/.+)?$ $candidate]} {
+ return 1
+ }
+ }
+
+ return 0
+}
+
proc handle_send_to_servers_log {emitter source arg callback} {
global network
#Parse [component] entry
if {[regexp "\\\[(.*)\\\] (.*)" $arg match component entry]} {
add_to_servers_log $emitter "$network $source" $component $entry
return 1
} {
putbymode $callback "use the format \[component\] message"
return 0
}
}
proc add_to_servers_log {emitter source component entry} {
set request [dict2json "
date [iso8601date]
emitter $emitter
source {$source}
component $component
entry {$entry}
"]
rest::simple https://api.nasqueron.org/servers-log/ {} {
method PUT
content-type application/json
format json
} $request
}
diff --git a/tests/ServersLog.test b/tests/ServersLog.test
new file mode 100644
index 0000000..635da1d
--- /dev/null
+++ b/tests/ServersLog.test
@@ -0,0 +1,48 @@
+package require tcltest
+namespace import ::tcltest::*
+
+###
+### Init
+###
+
+# Tested code
+source init.tcl
+source $dir/Wearg/ServersLog.tcl
+
+###
+### Mocks
+###
+
+proc registry {command key {value ""}} {
+ if {$command == "get" && $key == "serverslog.knowncomponents"} {
+ return "Alpha Beta"
+ }
+
+ error "Unexpected registry call: $command $key $value"
+}
+
+###
+### Tests
+###
+
+test is_known_component_when_known {} -body {
+ is_known_component Alpha
+} -result 1
+
+test is_known_component_when_known_parent {} -body {
+ is_known_component Beta/Delta
+} -result 1
+
+test is_known_component_with_trailing_slash {} -body {
+ is_known_component Beta/
+} -result 0
+
+test is_known_component_when_unknown {} -body {
+ is_known_component Gamma
+} -result 0
+
+###
+### Cleanup
+###
+
+cleanupTests

File Metadata

Mime Type
text/x-diff
Expires
Sun, Nov 24, 23:56 (16 h, 27 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
2259228
Default Alt Text
(3 KB)

Event Timeline

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