commit 22c6f060c9eb867670e1c7fd87e82dc61ef5392e
parent 5c63a29c6301c19374365bec11c4676bdf4e6955
Author: Ellenor Malik <ellenor@umbrellix.net>
Date: Thu, 11 Feb 2021 04:52:29 -0800
pre-merge commit
Diffstat:
14 files changed, 401 insertions(+), 141 deletions(-)
diff --git a/core/0000-callbacks.tcl b/core/0000-callbacks.tcl
@@ -1,5 +1,18 @@
# This portion, of course, is available under the MIT license if not bundled with the rest of TclServ.
+# just to have sanity here. don't want a {} dict or a bum array
+# this is for the logging algorithm to work once implemented, too, among other important things
+set ::netname(-) -
+#set ::nettype(-) -
+#set ::sock(-) -
+
+set globctx ""
+set globuctx ""
+
+proc curctx {args} {return "-"}
+
+tnda set "llbinds" [list]
+
proc llbind {sock type client comd script} {
set moretodo 1
while {0!=$moretodo} {
@@ -33,7 +46,7 @@ proc firellbind {sock type client comd args} {
lappend scr $a
}
if {[set errcode [catch {eval $scr} erre]] > 0} {
- foreach logline [split [format "in script %s:\n\nerror code %s, %s\ncontact script developer for assistance\n" $scr $errcode $erre] "\n"] {
+ foreach logline [split [format "in script %s:\n\nerror code %s, %s\nerror info:\n%s\ncontact script developer for assistance\n" $scr $errcode $::errorInfo $erre] "\n"] {
putloglev o * $logline
}
firellbind $sock evnt - error $erre {*}$scr
@@ -64,7 +77,7 @@ proc firellmbind {sock type client comd args} {
lappend scr $a
}
if {[set errcode [catch {eval $scr} erre]] > 0} {
- foreach logline [split [format "in script (#%s) %s:\n\nerror code %s, %s\ncontact script developer for assistance\n" $id $scr $errcode $erre] "\n"] {
+ foreach logline [split [format "in script (#%s) %s:\n\nerror code %s, %s\nerror info:\n%s\ncontact script developer for assistance\n" $id $scr $errcode $::errorInfo $erre] "\n"] {
putloglev o * $logline
}
firellbind $sock evnt - error $erre {*}$scr
@@ -81,10 +94,10 @@ proc putloglev {lev ch msg} {
set oldglobuctx $globuctx
# punt
foreach level [split $lev {}] {
- firellmbind [curctx sock] log - [format "%s %s" $ch $level] $level $ch $msg
- firellbind [curctx sock] logall - - $level $ch $msg
- firellmbind - log - [format "%s %s" $ch $level] [curctx net] $level $ch $msg
- firellbind - logall - - [curctx net] $level $ch $msg
+ catch {firellmbind [curctx sock] log - [format "%s %s" $ch $level] [curctx net] $level $ch $msg}
+ catch {firellbind [curctx sock] logall - - [curctx net] $level $ch $msg}
+ catch {firellmbind - log - [format "%s %s" $ch $level] [curctx net] $level $ch $msg}
+ catch {firellbind - logall - - [curctx net] $level $ch $msg}
}
set globuctx $oldglobuctx
}
diff --git a/core/0001-usefultools.tcl b/core/0001-usefultools.tcl
@@ -1,3 +1,26 @@
+blocktnd misc
+set miscellanyunbindrehash [llbind - evnt - confloaded miscellany.rehash]
+
+proc miscellany.rehash {a} {
+# if {[catch {set oldmiscellanyunbindalive}] == 0} {
+# unllbind - evnt - alive $::oldmiscellanyunbindalive
+# unllbind - evnt - confloaded $::oldmiscellanyunbindrehash
+# }
+ putlog [format "there are %s miscellany blocks" [set blocks [tnda get "openconf/[ndcenc misc]/blocks"]]]
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ set netname [string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc misc] $i]] 0]]
+ after 1000 [list miscellany.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc misc] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc misc] $i]]]
+ }
+}
+
+proc miscellany.oneintro {hdr block} {
+ if {$hdr == ""} {
+ tnda set "gmisc" $block
+ } {
+ tnda set "misc/[ndcenc $hdr]" $block
+ }
+}
+
proc dictassign {dictValue args} {
foreach {i j} $args {
upvar $j jj
diff --git a/core/0002-statemachine.tcl b/core/0002-statemachine.tcl
@@ -1,77 +1,84 @@
proc nick2uid {nick} {
set sck [curctx sock]
- foreach {u n} [tnda get "nick/$::netname($sck)"] {
+ foreach {u n} [tnda get "nick/[curctx net]"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
return ""
}
proc intclient2uid {nick} {
set sck [curctx sock]
- foreach {u n} [tnda get "intclient/$::netname($sck)"] {
+ foreach {u n} [tnda get "intclient/[curctx net]"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
return ""
}
+proc intclient2nick {nick} {
+ set sck [curctx sock]
+ foreach {u n} [tnda get "intclient/[curctx net]"] {
+ if {[string tolower $n] == [string tolower $nick]} {return [uid2nick $u]}
+ }
+ return ""
+}
proc uid2nick {u} {
set sck [curctx sock]
- return [tnda get "nick/$::netname($sck)/$u"]
+ return [tnda get "nick/[curctx net]/$u"]
}
proc uid2rhost {u} {
set sck [curctx sock]
- return [tnda get "rhost/$::netname($sck)/$u"]
+ return [tnda get "rhost/[curctx net]/$u"]
}
proc uid2host {u} {
set sck [curctx sock]
- return [tnda get "vhost/$::netname($sck)/$u"]
+ return [tnda get "vhost/[curctx net]/$u"]
}
proc uid2ident {u} {
set sck [curctx sock]
- return [tnda get "ident/$::netname($sck)/$u"]
+ return [tnda get "ident/[curctx net]/$u"]
}
proc nick2host {nick} {
set sck [curctx sock]
- return [tnda get "vhost/$::netname($sck)/[nick2uid $netname $nick]"]
+ return [tnda get "vhost/[curctx net]/[nick2uid $netname $nick]"]
}
proc nick2ident {nick} {
set sck [curctx sock]
- return [tnda get "ident/$::netname($sck)/[nick2uid $netname $nick]"]
+ return [tnda get "ident/[curctx net]/[nick2uid $netname $nick]"]
}
proc nick2rhost {nick} {
set sck [curctx sock]
- return [tnda get "rhost/$::netname($sck)/[nick2uid $netname $nick]"]
+ return [tnda get "rhost/[curctx net]/[nick2uid $netname $nick]"]
}
proc nick2ipaddr {nick} {
set sck [curctx sock]
- return [tnda get "ipaddr/$::netname($sck)/[nick2uid $netname $nick]"]
+ return [tnda get "ipaddr/[curctx net]/[nick2uid $netname $nick]"]
}
proc getts {chan} {
set sck [curctx sock]
- return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/ts"]
+ return [tnda get "channels/[curctx net]/[ndaenc $chan]/ts"]
}
proc getpfx {chan nick} {
set sck [curctx sock]
- return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/[nick2uid $netname $nick]"]
+ return [tnda get "channels/[curctx net]/[ndaenc $chan]/modes/[nick2uid $netname $nick]"]
}
proc getupfx {chan u} {
- return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/$u"]
+ return [tnda get "channels/[curctx net]/[ndaenc $chan]/modes/$u"]
set sck [curctx sock]
}
proc getpfxchars {modes} {
set sck [curctx sock]
set o ""
foreach {c} [split $modes {}] {
- append o [nda get "netinfo/$::netname($sck)/prefix/$c"]
+ append o [nda get "netinfo/[curctx net]/prefix/$c"]
}
return $o
}
proc getmetadata {nick metadatum} {
set sck [curctx sock]
- return [tnda get "metadata/$::netname($sck)/[nick2uid $netname $nick]/[ndcenc $metadatum]"]
+ return [tnda get "metadata/[curctx net]/[nick2uid $netname $nick]/[ndcenc $metadatum]"]
}
proc getcertfp {nick} {
set sck [curctx sock]
- return [tnda get "certfps/$::netname($sck)/[nick2uid $netname $nick]"]
+ return [tnda get "certfps/[curctx net]/[nick2uid $netname $nick]"]
}
proc checkop {mc s c p n} {
@@ -94,14 +101,14 @@ putcmdlog "down $mc $f $t $p $n"
proc uid2intclient {u} {
set sck [curctx sock]
- return [tnda get "intclient/$::netname($sck)/$u"]
+ return [tnda get "intclient/[curctx net]/$u"]
}
proc getfreeuid {} {
set sck [curctx sock]
set work 1
set cns [list]
-foreach {_ cnum} [tnda get "intclient/$::netname($sck)"] {lappend cns $cnum}
+foreach {_ cnum} [tnda get "intclient/[curctx net]"] {lappend cns $cnum}
while {0!=$work} {set num [expr {[rand 30000]+10000}];if {[lsearch -exact $cns $num]==-1} {set work 0}}
return $num
}
diff --git a/core/0004-hashing.tcl b/core/0004-hashing.tcl
@@ -61,3 +61,10 @@ proc encrypt-v1 {site pass} {
proc pwhash.SSHA256 {pass {site "a"}} {
return [format "SSHA256/%s/%s" $site [string map {/ - + _ = {}} [::base64::encode -maxlen 0 -wrapchar "" [encrypt $site $pass]]]]
}
+
+proc pwhash {args} {
+ if {[llength $args] == 1} {lassign $args pass; set alg SSHA256; set salt a}
+ if {[llength $args] == 2} {lassign $args pass salt; set alg SSHA256}
+ if {[llength $args] == 3} {lassign $args alg pass salt}
+ return [pwhash.$alg $pass $salt]
+}
diff --git a/core/0999-conn.tcl b/core/0999-conn.tcl
@@ -29,11 +29,11 @@ proc mknetwork {headlines block} {
set netname [lindex $headlines 0]
if {[catch {set ::sock($netname)} result] == 0} {
if {![eof $::sock($netname)]} {
- puts stdout "probably rehashing (connected network block, [tnda get rehashing], $result)"
+ putloglev o * "probably rehashing (connected network block, [tnda get rehashing], $result)"
return
}
}
- if {[dict exists $block prefixes]} {
+ if {[dict exists $block prefix]} {
# only required for ts6
set prefixes [split [dict get $block prefix] " "]
set pfxl [split [lindex $prefixes 0] {}]
@@ -44,9 +44,16 @@ proc mknetwork {headlines block} {
lappend pfx $m
}
tnda set "netinfo/$netname/prefix" $pfx
+ set pfx [list]
+ foreach {m} $pfxl {p} $pfxr {
+ lappend pfx $p
+ lappend pfx $m
+ }
+ tnda set "netinfo/$netname/pfxchar" $pfx
} {
# safe defaults, will cover charybdis and chatircd
tnda set "netinfo/$netname/prefix" [list @ o % h + v]
+ tnda set "netinfo/$netname/prefix" [list o @ h % v +]
}
if {[dict exists $block type]} {
tnda set "netinfo/$netname/type" [dict get $block type]
@@ -92,7 +99,7 @@ proc mknetwork {headlines block} {
}
# open a connection
set socke [connect $host $port [list $proto irc-main]]
- after 500 $proto login $socke $numeric $pass $netname $servername
+ after 500 [list $proto login $socke $numeric $pass $netname $servername $block]
llbind - dead - $socke [list after 5000 [list mknetwork $headlines $block]]
foreach {def} {
protectop protecthalfop protectvoice operit autoop autohalfop autovoice bitch halfbitch voicebitch
diff --git a/core/2003-ts6.tcl b/core/2003-ts6.tcl
@@ -31,7 +31,7 @@ proc ::ts6::b64d {numb} {
}
proc putl {args} {
- puts stdout [join $args " "]
+# puts stdout [join $args " "]
puts {*}$args
}
@@ -49,6 +49,10 @@ proc ::ts6::sendUid {sck nick ident host dhost uid {realname "* Unknown *"} {mod
} {
set sl [format ":%s EUID %s 1 %s %s %s %s 0 %s%s %s * :%s" $sid $nick [clock format [clock seconds] -format %s] $modes $ident $dhost $sid $sendnn $host $realname]
}
+ tnda set "login/$::netname($sck)/${sid}${sendnn}" ""
+ tnda set "oper/$::netname($sck)/${sid}${sendnn}" [expr {[string first "o" $modes] != -1 ? 1 : 0}]
+ tnda set "metadata/$::netname($sck)/${sid}${sendnn}" [list]
+ tnda set "certfps/$::netname($sck)/${sid}${sendnn}" ""
tnda set "intclient/$::netname($sck)/${sid}${sendnn}" $uid
tnda set "nick/$::netname($sck)/${sid}${sendnn}" $nick
tnda set "ident/$::netname($sck)/${sid}${sendnn}" $ident
@@ -150,8 +154,9 @@ proc ::ts6::part {sck uid targ msg} {
append sendnn $sendid
putl $sck [format ":%s%s PART %s :%s" $sid $sendnn $targ $msg]
set chan [ndaenc $targ]
- tnda set "userchan/$::netname($sck)/$sid$sendnn/$chan" 0
- tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
+ tnda unset "userchan/$::netname($sck)/$sid$sendnn/$chan"
+ tnda unset "channels/$::netname($sck)/$chan/status/$sid$sendnn"
+ firellbind $sck part "-" "-" [ndadec $chan] ${sid}${sendnn} $msg
}
proc ::ts6::quit {sck uid msg} {
@@ -160,13 +165,24 @@ proc ::ts6::quit {sck uid msg} {
set sendnn [string repeat "A" [expr {6-[string length $sendid]}]]
append sendnn $sendid
putl $sck [format ":%s%s QUIT :%s" $sid $sendnn $msg]
+ foreach {chan _} [tnda get "userchan/$::netname($sck)/${sid}${sendnn}"] {
+ #firellbind $sck part "-" "-" $sid$sendnn [ndadec $chan] $msg
+ firellbind $sck quit "-" "-" $sid$sendnn [ndadec $chan] $msg
+ tnda unset "userchan/$::netname($sck)/${sid}${sendnn}/$chan"
+ tnda unset "channels/$::netname($sck)/$chan/status/${sid}${sendnn}"
+ }
+ firellbind $sck nquit "-" "-" $sid$sendnn $msg
+ tnda unset "login/$::netname($sck)/${sid}${sendnn}"
+ tnda unset "nick/$::netname($sck)/${sid}${sendnn}"
tnda unset "intclient/$::netname($sck)/${sid}${sendnn}"
+ tnda set "oper/$::netname($sck)/${sid}${sendnn}" 0
tnda unset "ident/$::netname($sck)/${sid}${sendnn}"
tnda unset "rhost/$::netname($sck)/${sid}${sendnn}"
tnda unset "vhost/$::netname($sck)/${sid}${sendnn}"
tnda unset "rname/$::netname($sck)/${sid}${sendnn}"
tnda unset "ipaddr/$::netname($sck)/${sid}${sendnn}"
- tnda unset "nick/$::netname($sck)/${sid}${sendnn}"
+ tnda set "metadata/$::netname($sck)/${sid}${sendnn}" [list]
+ tnda unset "certfps/$::netname($sck)/${sid}${sendnn}"
}
proc ::ts6::setacct {sck targ msg} {
@@ -214,10 +230,10 @@ proc ::ts6::putmode {sck uid targ mode {parm ""} {ts ""}} {
set state 0
} elseif {[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmpartparm"]])} {
[expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
-# firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
} else {
[expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
-# firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
# firellmbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] ""
}
}
@@ -276,15 +292,16 @@ proc ::ts6::quitstorm {sck sid comment {doinit 1}} {
proc ::ts6::irc-main {sck} {
global sid sock socksid
if {[eof $sck]} {
- puts stdout "We're dead, folks."
+ puts stdout "We're dead, folks. [clock format [clock seconds] -format {%Y%m%d %H:%M.%S}]"
# firellbind $sck evnt "-" "ts6.dead" $::netname($sck) $sck
firellbind $sck evnt "-" "dead" $::netname($sck) $sck
firellbind - evnt "-" "dead" $sck $::netname($sck)
close $sck
}
+ set ::errorInfo ""
gets $sck line
setctx $::netname($sck)
- #puts stdout $line
+ putloglev r * $line
set line [string trim $line "\r\n"]
set one [string match ":*" $line]
set line [string trimleft $line ":"]
@@ -305,7 +322,7 @@ proc ::ts6::irc-main {sck} {
"479" {putloglev d * $payload}
"PASS" {
# putquick "PRIVMSG #services :$line"
- puts stdout "we have a winner! $one"
+ #puts stdout "we have a winner! $one"
set ssid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append ssid [::ts6::b64e $::sid($sck)]
tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/uplink" $ssid
tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/sid" $payload
@@ -313,7 +330,7 @@ proc ::ts6::irc-main {sck} {
}
"SERVER" {
- puts stdout "we have a winner! $one"
+ #puts stdout "we have a winner! $one"
# if {[lindex $comd [expr {$one + 2}]] != 1} {return};#we don't support jupes
tnda set "servers/$::netname($sck)/[ndaenc [tnda get "socksid/$::netname($sck)"]]/name" [lindex $comd [expr {$one + 1}]]
tnda set "servers/$::netname($sck)/[ndaenc [tnda get "socksid/$::netname($sck)"]]/description" [lindex $comd [expr {$one + 3}]]
@@ -323,7 +340,7 @@ proc ::ts6::irc-main {sck} {
}
"SID" {
- puts stdout "we have a winner! $one"
+ #puts stdout "we have a winner! $one"
tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/name" [lindex $comd 2]
tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/description" [lindex $comd 5]
tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/uplink" [lindex $comd 0]
@@ -337,7 +354,7 @@ proc ::ts6::irc-main {sck} {
# is it us?
if {$failedserver == $ssid} {
#yes, it's us.
- putloglev d * "We're dead, folks."
+ putloglev d * "We're dead, folks. [clock format [clock seconds] -format {%Y%m%d %H:%M:%S}]"
firellbind $sck evnt "-" "ts6.dead" $::netname($sck)
firellbind $sck evnt "-" "dead" $::netname($sck)
firellbind - evnt "-" "dead" $sck $::netname($sck)
@@ -456,7 +473,7 @@ proc ::ts6::irc-main {sck} {
}
"NOTICE" {
- if {![tnda get "netinfo/$::netname($sck)/connected"]} {return}
+ if {0==[tnda get "netinfo/$::netname($sck)/connected"]} {} {
if {[::ts6::validchan $sck [lindex $comd 2]]} {
set client chan
if {[string index $payload 0] == "\001"} {
@@ -487,6 +504,7 @@ proc ::ts6::irc-main {sck} {
#firellmbind $sck notcm $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
#firellbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] $payload
}
+ }
}
"MODE" {
@@ -558,10 +576,12 @@ proc ::ts6::irc-main {sck} {
# _NOTREACHED
set state 0
} elseif {[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmpartparm"]])} {
+ putloglev d * "check(de)op with parameter"
[expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
} else {
- [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ putloglev d * "check(de)op without parameter"
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
# firellmbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] ""
}
@@ -606,14 +626,21 @@ proc ::ts6::irc-main {sck} {
firellmbind $sck part - [format "%s %s!%s@%s" [lindex $comd 2] [% uid2nick $un] [% uid2ident $un] [% uid2host $un]] $un [lindex $comd 2] [lindex $comd 3]
firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0] [lindex $comd 3]
set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
- tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0
- tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
+ foreach {c} [split [tnda get "channels/$::netname($sck)/$chan/status/[lindex $comd 0]"] {}] {
+ ::ts6::checkdeop [lindex $comd 0] [ndadec $chan] -$c [lindex $comd 0]
+ }
+ tnda unset "userchan/$::netname($sck)/[lindex $comd 0]/$chan"
+ tnda unset "channels/$::netname($sck)/$chan/status/[lindex $comd 0]"
}
"KICK" {
- firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3] [lindex $comd 4]
+ firellbind $sck kick "-" "-" [lindex $comd 2] [lindex $comd 3] [lindex $comd 4]
set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
- tnda set "userchan/$::netname($sck)/[lindex $comd 3]/$chan" 0
+ foreach {c} [split [tnda get "channels/$::netname($sck)/$chan/status/[lindex $comd 3]"] {}] {
+ ::ts6::checkdeop [lindex $comd 0] [ndadec $chan] -$c [lindex $comd 3]
+ }
+ tnda unset "userchan/$::netname($sck)/[lindex $comd 3]/$chan"
+ tnda unset "channels/$::netname($sck)/$chan/status/[lindex $comd 3]"
}
"NICK" {
@@ -632,6 +659,7 @@ proc ::ts6::irc-main {sck} {
# puts stdout $comd
# puts stdout $modes
if {[string first "o" $modes] != -1} {set oper 1}
+ tnda set "login/$::netname($sck)/[lindex $comd $num]" ""
if {"*"!=$loggedin} {
tnda set "login/$::netname($sck)/[lindex $comd $num]" $loggedin
}
@@ -702,40 +730,47 @@ proc ::ts6::irc-main {sck} {
putloglev k * [format "Uh-oh, netsplit! %s -> %s has split" $on [::ts6::nick2uid $::netname($sck) $on]]
}
foreach {chan _} [tnda get "userchan/$::netname($sck)/[lindex $comd 0]"] {
- firellbind $sck part "-" "-" [ndadec $chan] [lindex $comd 0] $::netname($sck)
- tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0
- tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
+ putloglev d * "$chan -> [ndadec $chan]"
+ putloglev d * "[cdbase get channels $::netname($sck) $chan]"
+ foreach {c} [split [cdbase get channels $::netname($sck) $chan status [lindex $comd 0]] {}] {
+ ::ts6::checkdeop [lindex $comd 0] [ndadec $chan] -$c [lindex $comd 0]
+ #puts stdout $::errorInfo
+ }
+ firellbind $sck quit "-" "-" [lindex $comd 0] [ndadec $chan] $::netname($sck)
+ tnda unset "userchan/$::netname($sck)/[lindex $comd 0]/$chan"
+ #tnda unset "channels/$::netname($sck)/$chan/status/[lindex $comd 0]"
}
tnda unset "login/$::netname($sck)/[lindex $comd 0]"
tnda unset "nick/$::netname($sck)/[lindex $comd 0]"
- tnda set "oper/$::netname($sck)/[lindex $comd 0]" 0
+ tnda unset "oper/$::netname($sck)/[lindex $comd 0]"
tnda unset "ident/$::netname($sck)/[lindex $comd 0]"
tnda unset "rhost/$::netname($sck)/[lindex $comd 0]"
tnda unset "vhost/$::netname($sck)/[lindex $comd 0]"
tnda unset "rname/$::netname($sck)/[lindex $comd 0]"
tnda unset "ipaddr/$::netname($sck)/[lindex $comd 0]"
- tnda set "metadata/$::netname($sck)/[lindex $comd 0]" [list]
+ tnda unset "metadata/$::netname($sck)/[lindex $comd 0]"
tnda unset "certfps/$::netname($sck)/[lindex $comd 0]"
- firellbind $sck quit "-" "-" [lindex $comd 0] $::netname($sck)
+ firellbind $sck nquit - - [lindex $comd 0] $payload
}
"KILL" {
foreach {chan _} [tnda get "userchan/$::netname($sck)/[lindex $comd 2]"] {
- firellbind $sck part "-" "-" [ndadec $chan] [lindex $comd 2]
+ firellbind $sck quit "-" "-" [lindex $comd 2] [ndadec $chan] $payload
tnda set "userchan/$::netname($sck)/[lindex $comd 2]/$chan" 0
}
tnda unset "login/$::netname($sck)/[lindex $comd 2]"
tnda unset "nick/$::netname($sck)/[lindex $comd 2]"
- tnda set "oper/$::netname($sck)/[lindex $comd 2]" 0
+ tnda unset "oper/$::netname($sck)/[lindex $comd 2]"
tnda unset "ident/$::netname($sck)/[lindex $comd 2]"
tnda unset "ipaddr/$::netname($sck)/[lindex $comd 2]"
tnda unset "rhost/$::netname($sck)/[lindex $comd 2]"
tnda unset "vhost/$::netname($sck)/[lindex $comd 2]"
tnda unset "rname/$::netname($sck)/[lindex $comd 2]"
- tnda set "metadata/$::netname($sck)/[lindex $comd 2]" [list]
+ tnda unset "metadata/$::netname($sck)/[lindex $comd 2]"
tnda unset "certfps/$::netname($sck)/[lindex $comd 2]"
- firellbind $sck quit "-" "-" [lindex $comd 2] $::netname($sck)
+ #firellbind $sck nquit - - [lindex $comd 2] $payload
+ firellbind $sck nkill - - [lindex $comd 0] [lindex $comd 2] $payload
}
"ERROR" {
@@ -770,8 +805,12 @@ proc ::ts6::irc-main {sck} {
putl $sck [format ":%s PONG %s %s" $num $pong [lindex $comd 2]]
}
}
- } erreur]
- if {$erreno != 0} {puts stdout [join [list $erreno $erreur] " "]}
+ } erreur erropts]
+ if {$erreno != 0} {putloglev d * [format "error code %s, output %s while processing %s" $erreno $erreur [join $comd " "]]
+ foreach {li} [split [dict get $erropts -errorinfo] "\r\n"] {
+ putloglev d * [format "error info: %s" $li]
+ }
+ }
}
# irrelevant parameters should simply be ignored.
@@ -792,12 +831,12 @@ proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servernam
#if {![info exists ::ts6(ownermode)]} {tnda set "pfx/owner" o} {tnda set "pfx/owner" $ownermode)}
#if {![info exists ::ts6(protectmode)]} {tnda set "pfx/protect" o} {tnda set "pfx/protect" $protectmode}
if {$useeuid == ""} {tnda set "netinfo/$::netname($sck)/euid" 1} {tnda set "netinfo/$::netname($sck)/euid" $useeuid}
-
- putl $sck "PASS $password TS 6 :$num"
+
+ putl $sck [format "PASS %s TS 6 :%s" $password $num]
putl $sck "CAPAB :UNKLN BAN KLN RSFNC EUID ENCAP IE EX CLUSTER EOPMOD SVS SERVICES QS"
- putl $sck "SERVER $servername 1 :chary.tcl for Eggdrop and related bots"
- putl $sck "SVINFO 6 6 0 :[clock format [clock seconds] -format %s]"
- putl $sck ":$num VERSION"
+ putl $sck [format "SERVER %s 1 :%s" $servername $gecos]
+ putl $sck [format "SVINFO 6 6 0 :%s" [clock format [clock seconds] -format %s]]
+ putl $sck [format ":%s VERSION" $num]
# llbind $sck mode - "* +*" ::ts6::checkop
# llbind $sck mode - "* -*" ::ts6::checkdeop
@@ -870,28 +909,36 @@ proc ::ts6::getcertfp {sck nick} {
proc ::ts6::checkop {f t m p} {
set n [curctx net]
- set mc [string index $m 1]
- puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ set mc [string index $m end]
+ #puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ putloglev d * "up $mc $f $t $p $n"
if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {::ts6::handlemode $f $t $m $p;return}
-putloglev d * "up $mc $f $t $p $n"
- set chan [string map {/ [} [::base64::encode [string tolower $t]]]
- tnda set "channels/$n/$chan/status/$p" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]] $mc]
+ set chan [string map {/ [} [::base64::encode [string tolower $t]]]
+ tnda set "channels/$n/$chan/status/$p" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]] $mc]
+ #puts stdout [format "Now, the state machine for $t looks like:"]
+ #puts stdout [tnda get "channels/$n/$chan"]
}
proc ::ts6::checkdeop {f t m p} {
set n [curctx net]
- set mc [string index $m 1]
- puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ set mc [string index $m end]
+# puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ putloglev d * "down $m ($mc) $f $t $p $n"
if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {::ts6::handlemode $f $t $m $p;return}
-putloglev d * "down $mc $f $t $p $n"
- set chan [string map {/ [} [::base64::encode [string tolower $t]]]
- tnda set "channels/$n/$chan/status/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]]
+ set chan [string map {/ [} [::base64::encode [string tolower $t]]]
+ if {[set thestatus [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]]] != ""} {
+ tnda set "channels/$n/$chan/status/$p" $thestatus
+ } else {
+ tnda unset "channels/$n/$chan/status/$p"
+ }
+ #puts stdout [format "Now, the state machine for $t looks like:"]
+ #puts stdout [tnda get "channels/$n/$chan"]
}
proc ::ts6::handlemode {from t mode parm} {
set n [curctx net]
set chan [string map {/ [} [::base64::encode [string tolower $t]]]
- puts stdout [format ":%s MODE %s %s %s" $from $t $mode $parm]
+# puts stdout [format ":%s MODE %s %s %s" $from $t $mode $parm]
if {[string index $mode 0] == "+"} {set state 1} {set state 0}
set mc [string index $mode 1]
if {$state} {
@@ -921,9 +968,6 @@ proc ::ts6::handlemode {from t mode parm} {
}
}
}
- puts stdout [format "Now, the state machine for $t looks like:"]
- puts stdout [tnda get "channels/$n/$chan"]
- puts stdout [tnda get "userchan/$n/$chan"]
}
proc ::ts6::putnow {sck intclient msg} {
diff --git a/core/4000-convenience.tcl b/core/4000-convenience.tcl
@@ -292,7 +292,7 @@ proc @@ {c args} {
proc getctx {{type net}} {curctx $type}
proc curctx {{type net}} {
- if {$::globctx == ""} {return ""}
+ if {$::globctx == ""} {return "-"}
switch -exact -- [format ".%s" [string tolower $type]] {
.sock {
return $::sock($::globctx)
@@ -575,12 +575,27 @@ proc deluser {username} {
dbase unset usernames [curctx net] $username
}
+proc delhost {username hostmask} {
+ if {![validuser $username]} {return 0}
+ set hmsks [dbase get usernames [curctx net] $username hostmasks
+ set tounset [list]
+ foreach {bindn hm} $hmsks {
+ if {[string tolower $hm] == $hostmask} {lappend tounset $bindn}
+ }
+ foreach {n} $tounset {
+ dbase unset usernames [curctx net] $username hostmasks $n
+ }
+ return 1
+}
+
+proc addhost {username hostmask} {adduser $username $hostmask}
+
proc adduser {username {hostmask ""}} {
- if {[validuser $username]} {return 0}
+ #if {[validuser $username]} {return 0}
if {$hostmask != ""} {set moretodo 1} {set moretodo 0}
while {0!=$moretodo} {
set bindnum [rand 1 10000000]
- if {[dbase get usernames [curctx net] $username]!=""} {} {set moretodo 0}
+ if {[dbase get usernames [curctx net] $username hostmasks $bindnum]==""} {set moretodo 0}
}
if {$hostmask != ""} {dbase set usernames [curctx net] $username hostmasks $bindnum $hostmask}
dbase set usernames [curctx net] $username reg 1
@@ -805,18 +820,22 @@ proc onchan {nick chan} {
}
proc alg {{ha ""}} {
- if {$ha == ""} {return "SSHA256"} {return $ha}
+ if {$ha == ""} {
+ if {[set ha [cdbase get misc [curctx net] hashing]] != ""} {return $ha}
+ if {[set ha [cdbase get gmisc hashing]] != ""} {return $ha}
+ return "SSHA256"
+ } {return $ha}
}
proc passwdok {n p} {
set isp [dbase get usernames [curctx net] $n pass]
- set chkp [pwhash.[alg [lindex [split $isp "/"] 0]] $p]
+ set chkp [pwhash [alg [lindex [split $isp "/"] 0]] $p [lindex [split $isp "/"] end-1]]
if {$isp==""} {return 1}
if {$chkp == $isp} {return 1}
return 0
}
-proc usetpass {n p} {
- set chkp [pwhash.SSHA256 $p]
+proc usetpass {n p s} {
+ set chkp [pwhash [alg] $p $s]
dbase get usernames [curctx net] $n pass $chkp
}
diff --git a/language.txt b/language.txt
@@ -1,23 +1,28 @@
-debugserv.metadata 14>2>12> Metadata %s for %s: %s
-debugserv.nometadata 14>7>8> %s, you do not have any metadata set by the ircd.
-continuant 14>2>12> %s
-debugserv.rehashed 14>3>9> As you so politely demand, %s.
-debugserv.isoper 14>3>9> %s (UID %s) is an oper on this network.
-debugserv.isntoper 14>5>4> %s (UID %s) is 4NOT an oper on this network.
-debugserv.youreoper 14>3>9> YOU (UID %s) are an oper on this network.
-debugserv.yourentoper 14>5>4> YOU (UID %s) are 4NOT an oper on this network.
-debugserv.youvenoprivs 14>5>4> YOU (UID %s) do 4NOT have the required privileges to execute the commanded action.
-debugserv.youvenoprivs2 14>5>4> YOU (UID %s) do 4NOT have the required privileges to execute the commanded action. (Requires %s)
-debugserv.impostornickserv 14>5>4> NickServ specified in config file (nick %s, UID %s, intended server %s, whose SID is "%s" - check links if blank) is gone or an impostor! Not identifying with NickServ - DebugServ WILL NOT BE ABLE TO ACCESS SOME CHANNELS.
-quoteserv.impostornickserv 14>5>4> NickServ specified in config file (nick %s, UID %s, intended server %s, whose SID is "%s" - check links if blank) is gone or an impostor! Not identifying with NickServ - DebugServ WILL NOT BE ABLE TO ACCESS SOME CHANNELS.
-quoteserv.results 14>3>9> Quotes: Found results numbered %s
-quoteserv.noresults 14>5>4> Quotes: Found NO results for your search.
-quoteserv.qheader 14>2>12> Quote number %s, by %s:
-quoteserv.quote 14>2>12> %s
-quoteserv.added 14>3>9> Added quote number %s to database.
-quoteserv.usevalidint 14>5>4> Please use a valid integer, without the #.
-quoteserv.enopriv 14>5>4> You do not have the required privileges to execute that command (requires oper permissions %s).
-quoteserv.removed 14>3>9> Removed quote number %s (by %s) from database.
-quoteserv.removedcontents 14>2>12> Removed quote was: %s
-quoteserv.left 14>7>8> The quote service was requested to leave by %s. Ja mata!
-quoteserv.disabled 14>7>8> Sorry, the quote service is disabled for %s.
+en.debugserv.metadata 14>2>12> Metadata %s for %s: %s
+en.debugserv.nometadata 14>7>8> %s, you do not have any metadata set by the ircd.
+en.continuant 14>2>12> %s
+en.blue 14>2>12> %s
+en.red 14>5>4> %s
+en.green 14>3>9> %s
+en.jaune 14>7>8> %s
+en.debugserv.rehashed 14>3>9> As you so politely demand, %s.
+en.debugserv.isoper 14>3>9> %s (UID %s) is an oper on this network.
+en.debugserv.isntoper 14>5>4> %s (UID %s) is 4NOT an oper on this network.
+en.debugserv.youreoper 14>3>9> YOU (UID %s) are an oper on this network.
+en.debugserv.yourentoper 14>5>4> YOU (UID %s) are 4NOT an oper on this network.
+en.debugserv.youvenoprivs 14>5>4> YOU (UID %s) do 4NOT have the required privileges to execute the commanded action.
+en.debugserv.youvenoprivs2 14>5>4> YOU (UID %s) do 4NOT have the required privileges to execute the commanded action. (Requires %s)
+en.debugserv.impostornickserv 14>5>4> NickServ specified in config file (nick %s, UID %s, intended server %s, whose SID is "%s" - check links if blank) is gone or an impostor! Not identifying with NickServ - DebugServ WILL NOT BE ABLE TO ACCESS SOME CHANNELS.
+en.quoteserv.impostornickserv 14>5>4> NickServ specified in config file (nick %s, UID %s, intended server %s, whose SID is "%s" - check links if blank) is gone or an impostor! Not identifying with NickServ - DebugServ WILL NOT BE ABLE TO ACCESS SOME CHANNELS.
+en.quoteserv.results 14>3>9> Quotes: Found results numbered %s
+en.quoteserv.noresults 14>5>4> Quotes: Found NO results for your search.
+en.quoteserv.qheader 14>2>12> Quote number %s, by %s:
+en.quoteserv.quote 14>2>12> %s
+en.quoteserv.added 14>3>9> Added quote number %s to database.
+en.quoteserv.usevalidint 14>5>4> Please use a valid integer, without the #.
+en.quoteserv.enopriv 14>5>4> You do not have the required privileges to execute that command (requires oper permissions %s).
+en.quoteserv.removed 14>3>9> Removed quote number %s (by %s) from database.
+en.quoteserv.removedcontents 14>2>12> Removed quote was: %s
+en.quoteserv.left 14>7>8> The quote service was requested to leave by %s. Ja mata!
+en.quoteserv.disabled 14>7>8> Sorry, the quote service is disabled for %s.
+en.mars.alreadyuser You're already a user on %s. Perhaps try logging in instead!
diff --git a/main.tcl b/main.tcl
@@ -8,10 +8,10 @@ package require sha1
source b64.tcl
-proc pwhash.SHA1 {pass} {
+proc pwhash.SHA1 {pass {salt "a"}} {
global b64
set hash [::sha1::sha1 -hex $pass]
- return "SHA1/$hash"
+ return "SHA1//$hash"
}
proc rand {minn {maxx 0}} {
@@ -52,16 +52,25 @@ proc readbfile {script} {
}
proc loadmodule {script} {
+ set ismodule 0
+ foreach {file} [lsort [glob ./modules/*.tcl]] {
+ if {$file == [format "./modules/%s.tcl" $script]} {set ismodule 1}
+ }
+ if {!$ismodule} {
+ putloglev o * "MODULE $script DOES NOT EXIST; CONTINUING (or attempting to) ANYWAY"
+ return
+ }
set fp [open [format "./modules/%s.tcl" $script] r]
set ev [read $fp]
close $fp
uplevel "#0" $ev
}
-proc save.db {name var no oper} {
+proc save.db {name var no oper {apres 1}} {
upvar $var db
global lastsave
- if {$lastsave + 40 > [set now [clock seconds]]} {return} ;#save CPU time by not always saving DB; integrity problems may result
+ if {$apres != 1 && ($lastsave + 40 > [set now [clock seconds]])} {return} ;#save CPU time by not always saving DB. integrity problems may result
+ # but do not save CPU time if we are apres=0
# ensure DB save is atomic, so if tclserv is killed during or under 12.5 seconds after save
catch [list file rename $name [format "%s.bk%s" $name $now]]
set there [open $name [list WRONLY CREAT TRUNC BINARY]]
@@ -70,7 +79,9 @@ proc save.db {name var no oper} {
puts -nonewline $there $db
flush $there
close $there
- after 12500 [list catch [list file delete -- [format "%s.bk%s" $name $now]]]
+# if {$apres == 1} { ;# the french word for "after", apres (from après) is the variable we use to say we want to repeat. on by default.
+ after 12500 [list catch [list file delete -- [format "%s.bk%s" $name $now]]]
+# }
return
}
@@ -80,9 +91,9 @@ mysrc nda.tcl
set lastsave [clock seconds]
if {[file exists services.db]} {
- puts stdout "reading the nda dict"
+ #puts stdout "reading the nda dict"
set nd [readbfile services.db]
- puts stdout $nd
+ #puts stdout $nd
}
set globwd [pwd]
@@ -90,6 +101,7 @@ set gettext [list]
proc outputbotnick {var no oper} {
upvar $var v
+ # depends on 4000-convenience. luckily not used before that's loaded or we'd be issue.
set v [curctx user]
}
@@ -98,24 +110,29 @@ proc showcontexts {var no oper} {
# puts stdout "curctx is [curctx unum]@[curctx net]"
}
-trace add variable nd [list write unset] [list save.db [format "%s/%s" [pwd] services.db]]
+# eventually we need to change services.db to SERVICESDBNAME or something.
+trace add variable nd [list write unset] [list save.db [set sdbname [format "%s/%s" [pwd] services.db]]]
trace add variable botnick [list read] [list outputbotnick]
trace add variable globuctx [list read write] [list showcontexts]
+proc force_save_db {dbname {d ::nd}} {
+ # the fifth variable is "après", which refers to whether the save is a one-off, or whether it's ongoing. it defaults to 1, which means ongoing. this is a one-off save.
+ save.db $dbname $d 0 write 0
+}
#::tie::tie nd file services.db
source openconf2.tcl
-
-foreach {file} [lsort [glob ./core/*.tcl]] {
- mysrc $file
-}
#mysrc services.conf
proc svc.rehash {} {
global gettext
tnda set rehashing 1
+ foreach {file} [lsort [glob ./core/*.tcl]] {
+ mysrc $file
+ }
+ force_save_db $::sdbname
if {[file exists $::globwd/language.txt]} {
set languagefile [split [readfile [format "%s/%s" $::globwd language.txt]] "\n"]
foreach {line} $languagefile {
@@ -127,11 +144,12 @@ proc svc.rehash {} {
tnda set "openconf" [list]
mysrc $::globwd/services.conf
tnda set rehashing 0
+ firellbind - evnt - "confloaded" loaded
}
svc.rehash
#by now we've loaded everything
-firellbind - evnt - "confloaded" loaded
+#firellbind - evnt - "confloaded" loaded
#load from cfg file, not here
diff --git a/modules/chanserv.tcl b/modules/chanserv.tcl
@@ -13,11 +13,28 @@
blocktnd chanserv
-llbind - evnt - alive chanserv.connect
+set chanservunbindalive [llbind - evnt - alive chanserv.connect]
+set chanservunbindrehash [llbind - evnt - confloaded chanserv.rehash]
set numversion 1
+proc chanserv.rehash {a} {
+# if {[catch {set oldchanservunbindalive}] == 0} {
+# unllbind - evnt - alive $::oldchanservunbindalive
+# unllbind - evnt - confloaded $::oldchanservunbindrehash
+# }
+ set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ set netname [string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] 0]]
+ if {[catch {set ::sock($netname)} result] == 0} {
+ if {![eof $::sock($netname)]} {
+ after 1000 [list chanserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc chanserv] $i]]]
+ }
+ }
+ }
+}
+
proc chanserv.connect {arg} {
- putlog [format "there are %s chanserv blocks" [set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]]]
+ set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]
for {set i 1} {$i < ($blocks + 1)} {incr i} {
if {[string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] 0]] != [string tolower $arg]} {continue}
after 1000 [list chanserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc chanserv] $i]]]
@@ -28,12 +45,20 @@ proc cs.confighandler {servicename defdbname headline block} {
set net [lindex $headline 0]
set nsock $::sock($net)
set servicename [format "%s.%s" $servicename [lindex $headline 1]]
+ setctx $net
dictassign $block nick nick ident ident host host modes modes realname realname
- if {[llength [tnda get "service/$net/$servicename/config"]] != 0} {return -code error "<$servicename> O damn, I'm already loaded for $net!"}
+ #if {[tnda get "service/$net/$servicename/ourid"] != ""} {
+ # putloglev o * "<$servicename> O damn, I'm already loaded for $net ([tnda get "service/$net/$servicename/ourid"])! Restarting."
+ # % quit [tnda get "service/$net/$servicename/ourid"] "REHASHED; QUITTING TO REAPPLY CONFIG"
+ # tnda unset "service/$net/$servicename/ourid"
+ #}
tnda set "service/$net/$servicename/config" $block
if {[tnda get "service/$net/$servicename/config/dbname"] == ""} {tnda set "service/$net/$servicename/dbname" $defdbname}
- setctx $net
- if {[% intclient2uid [tnda get "service/$net/$servicename/ourid"]] == ""} {% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* $servicename *" : $realname}] $modes; set connected "Connected"} {set connected "Already connected"}
+ if {[tnda get "service/$net/$servicename/ourid"] == ""} {
+ % sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* $servicename *" : $realname}] $modes; set connected "Connected"
+ } {
+ set connected "Already connected"
+ }
set ouroid [tnda get "service/$net/$servicename/ourid"]
if {[info exists ourid]} {tnda set "service/$net/$servicename/ourid" $ourid} {set ourid [tnda get "service/$net/$servicename/ourid"]}
puts stdout [format "%s for %s: %s %s %s" $connected $net $nick $ident $host]
@@ -42,8 +67,9 @@ proc cs.confighandler {servicename defdbname headline block} {
proc chanserv.oneintro {headline block} {
cs.confighandler chanserv chanserv $headline $block
+ #llbind - evnt - confloaded [list chanserv.rehash chanserv chanserv $headline $block]
dictassign $headline net network
- dictassign $block config eggconf nick nick ident username host my-hostname
+ dictassign $block config eggconf nick nick ident username host my-hostname
bind time -|- "?0 * * * *" checkchannels
bind time -|- "?5 * * * *" checkchannels
diff --git a/modules/debugserv.tcl b/modules/debugserv.tcl
@@ -1,14 +1,29 @@
blocktnd debugserv
-llbind - evnt - alive debugserv.connect
-llbind - logall - - debug.logall
+set debugservunbindalive [llbind - evnt - alive debugserv.connect]
+set debugservunbindrehash [llbind - evnt - confloaded debugserv.reload]
+set debugservunbindlogall [llbind - logall - - debug.logall]
-proc debug.logall {args} {
- puts stdout [format "%s: %s" "DEBUGSERV LOGALL" [join $args]]
+proc debug.logall {netzwerk charakter canal args} {
+ puts stdout [format "%s loglevel %s on %s@%s: %s" "DEBUGSERV" $charakter $canal $netzwerk [join $args]]
+}
+
+proc debugserv.reload {arg} {
+ set blocks [tnda get "openconf/[ndcenc debugserv]/blocks"]
+ putlog "debugserv:blocks $blocks"
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ set netname [string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc debugserv] $i]] 0]]
+ if {[catch {set ::sock($netname)} result] == 0} {
+ if {![eof $::sock($netname)]} {
+ # connect bind will be called when we reconnect
+ after 1000 [list debugserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc debugserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc debugserv] $i]]]
+ }
+ }
+ }
}
proc debugserv.connect {arg} {
- puts stdout [format "there are %s debugserv blocks" [set blocks [tnda get "openconf/[ndcenc debugserv]/blocks"]]]
+ set blocks [tnda get "openconf/[ndcenc debugserv]/blocks"]
for {set i 1} {$i < ($blocks + 1)} {incr i} {
if {[string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc debugserv] $i]] 0]] != [string tolower $arg]} {continue}
after 1000 [list debugserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc debugserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc debugserv] $i]]]
@@ -51,7 +66,21 @@ proc debugserv.oneintro {headline block} {
tnda set "debugserv/$net/logchan" $logchan
#tnda set "debugserv/$net/nspass" $nspass
setctx $net
- if {[% intclient2uid [tnda get "debugserv/$net/ourid"]] == ""} {% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes}
+ if {[% intclient2uid [tnda get "debugserv/$net/ourid"]] == ""} {% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes} {
+ set quitting 0
+ foreach {confitem} [list nick ident host realname modes] {
+ if {[catch {dict get [tnda get "debugserv/$net/block"] $confitem}] == 0} {
+ if {[dict get [tnda get "debugserv/$net/block"] $confitem] != [set $confitem]} {
+ set quitting 1
+ }
+ }
+ }
+ if {$quitting} {
+ % quit $ourid "REHASHED; RESTARTING TO APPLY NEW CONFIG"
+ % sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes
+ }
+ }
+ tnda set "debugserv/$net/block" $block
set ouroid [tnda get "debugserv/$net/ourid"]
if {[info exists ourid]} {tnda set "debugserv/$net/ourid" $ourid} {set ourid [tnda get "debugserv/$net/ourid"]}
unllbindall $nsock pub - ".rehash"
@@ -64,7 +93,6 @@ proc debugserv.oneintro {headline block} {
}
setuctx $nick
llbind $nsock pub - ".metadata" [list debugserv.pmetadata $net]
- llbind $nsock pub - ".rehash" [list debugserv.crehash $net]
if {[string length $nspass] != 0 && [string length $nickserv] != 0} {
# only works if nettype is ts6!
if {[string first [debugserv.find6sid $net $nsserv] [% nick2uid $nickserv]] == 0} {
@@ -79,29 +107,33 @@ proc debugserv.oneintro {headline block} {
llbind $nsock msg [tnda get "debugserv/$net/ourid"] "metadata" [list debugserv.metadata $net]
llbind $nsock msg [tnda get "debugserv/$net/ourid"] "rehash" [list debugserv.rehash $net]
# llbind $nsock pub - "gettext" [list debugserv.gettext $net]
+ llbind $nsock pub - ".rehash" [list debugserv.crehash $net]
llbind $nsock pub - "!usage" [list debugserv.pusage $net]
debugserv.armdns $headline $dnsconf
puts stdout "llbind $nsock msg [tnda get "debugserv/$net/ourid"] metadata [list debugserv.metdata $net]"
puts stdout [format "Connected for %s: %s %s %s" $net $nick $ident $host]
}
-proc debugserv.pusage {n c i m} {
+proc debugserv.pusage {n i c m} {
set uptime [exec uptime]
% [expr {$c != $i ? "privmsg" : "notice"}] [tnda get "debugserv/$n/ourid"] $c $uptime
}
proc debugserv.rehash {n i m} {debugserv.crehash $n $i $i $m}
-proc debugserv.crehash {n c i m} {
+proc debugserv.crehash {n i c m} {
+ putloglev o * "debugserv.crehash $n $c $i $m"
if {![operHasPrivilege $n $i [tnda get "debugserv/$n/rehashprivs"]]} {
+ putloglev d * "no privilege reached"
% [expr {$c != $i ? "privmsg" : "notice"}] [tnda get "debugserv/$n/ourid"] $c [gettext debugserv.youvenoprivs2 $i [join [split [tnda get "debugserv/$n/rehashprivs"] ", "] ", or "]]
} {
- after 500 [list uplevel #0 [list svc.rehash]]
% [expr {$c != $i ? "privmsg" : "notice"}] [tnda get "debugserv/$n/ourid"] $c [gettext debugserv.rehashed [% uid2nick $i]]
+ putloglev d * "svc.rehash reached"
+ after 500 [list uplevel #0 [list svc.rehash]]
}
}
-proc debugserv.pmetadata {n c i m} {
+proc debugserv.pmetadata {n i c m} {
# net chan id msg
setctx $n
if {($c != $i) && ![debugservenabled $c]} {return}
diff --git a/modules/quoteserv.tcl b/modules/quoteserv.tcl
@@ -74,7 +74,7 @@ proc quoteserv.oneintro {headline block} {
proc qs.pmdo {n i t m} {
set whoarewe [tnda get "intclient/$n/$t"]
if {$whoarewe != [tnda get "quoteserv/[curctx net]/ourid"]} {return}
- quoteservdo $n 0 $i $m
+ quoteservdo $n $i 0 $m
}
proc quoteservjoin {chan {setting 1}} {
@@ -116,7 +116,7 @@ quoteserv.removedcontents ^C14>^C2>^C12>^C Removed quote was: %s
quoteserv.disabled >>> Sorry, I'm disabled for %s.
}
-proc quoteservdo {n chan from m} {
+proc quoteservdo {n from chan m} {
setctx $n
set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]]
if {![quoteservenabled $chan] && $chan != 0} {return}
diff --git a/nda.tcl b/nda.tcl
@@ -1,6 +1,7 @@
# This whole didgeridoo is legacy code and I need to kill it with fire!
package require base64
+
proc ndaenc {n} {
return [string map {/ [} [::base64::encode [string tolower $n]]]
}
@@ -21,6 +22,7 @@ set nd [set tnd [list]]
namespace eval nda {
proc ::nda::get {path} {
+ #puts stdout "invoked with $path"
global nd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -31,6 +33,7 @@ namespace eval nda {
}
proc ::nda::set {path val} {
+ #puts stdout "invoked with $path"
global nd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -40,15 +43,17 @@ namespace eval nda {
}
proc ::nda::unset {path} {
+ #puts stdout "invoked with $path"
global nd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
return ""
}
- return [dict unset nd {*}$parr]
+ if {[info exists nd] && ![catch {dict unset nd {*}$parr} eee]} {return $eee} {return ""}
}
proc ::nda::incr {path} {
+ #puts stdout "invoked with $path"
global nd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -102,6 +107,7 @@ namespace eval dbase {
namespace eval tnda {
proc ::tnda::get {path} {
+ #puts stdout "invoked with $path"
global tnd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -111,6 +117,7 @@ namespace eval tnda {
if {[info exists tnd] && ![catch {dict get $tnd {*}$parr} eee]} {return $eee} {return ""}
}
proc ::tnda::set {path val} {
+ #puts stdout "invoked with $path"
global tnd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -121,15 +128,17 @@ namespace eval tnda {
}
proc ::tnda::unset {path} {
+ #puts stdout "invoked with $path"
global tnd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
return ""
}
- return [dict unset tnd {*}$parr]
+ if {[info exists tnd] && ![catch {dict unset tnd {*}$parr} eee]} {return $eee} {return ""}
}
proc ::tnda::incr {path {inc 1}} {
+ #puts stdout "invoked with $path"
global tnd
::set parr [split $path "/"]
if {[lindex $parr 0] == ""} {
@@ -147,6 +156,49 @@ namespace eval tnda {
namespace ensemble create
}
+namespace eval cdbase {
+ proc ::cdbase::get {args} {
+ global tnd
+ if {[info exists tnd] && ![catch {dict get $tnd {*}$args} eee]} {return $eee} {return ""}
+ }
+
+ proc ::cdbase::set {args} {
+ global tnd
+ if {[lindex $args 1] == ""} {
+ return ""
+ }
+ return [dict set tnd {*}$args]
+ }
+
+ proc ::cdbase::lappend {args} {
+ global tnd
+ if {[lindex $args 1] == ""} {
+ return ""
+ }
+ ::set orig [::cdbase::get {*}[lrange $args 0 end-1]]
+ ::lappend orig [lindex $args end]
+ return [dict set tnd {*}[lrange $args 0 end-1] $orig]
+ }
+
+ proc ::cdbase::unset {args} {
+ global tnd
+ return [dict unset tnd {*}$args]
+ }
+
+ namespace export *
+ namespace ensemble create
+}
+
+proc tdb {args} {set l [list cdbase]; foreach {i} $args {lappend l $i}; $l}
+
proc gettext {stringname args} {
- format [dict get $::gettext $stringname] {*}$args
+ gettext.i18n $stringname en $args
+}
+
+proc gettext.i18n {stringname language arg} {
+ if {"" == [set out [format [dict get $::gettext [format "%s.%s" $language $stringname]] {*}$arg]]} {
+ # default to the English locale if we don't know
+ set out [format [dict get $::gettext [format "%s.%s" en $stringname]] {*}$arg]
+ }
+ return $out
}
diff --git a/services.conf.example b/services.conf.example
@@ -1,9 +1,14 @@
# TCLServ Config File
# This is a valid Tcl script when sourced by TCLServ
+misc "pand" {
+ hashing "SSHA256" comment "this is currently the only supported hashing algorithm."
+}
+
# needs prefix for ts6; this example is for irca. Give it the isupport from your ircd if you are running some other TS6.
network "pand" "services.invalid" {
host 127.0.0.1 port +6697
+ gecos "QuackServ"
numeric 53
pass link
proto ts6
@@ -33,6 +38,8 @@ debugserv "pand" {
modes +oiS
comment "Or +oiDS if you dont want it to hear channel convos"
comment "idcommand is obvious."
+ comment "Using rehash in its unmodified form requires that you use irca or another ircd that passes oper privileges in a metadata."
+ rehashprivs "oper:quote"
realname "Depanner"
nickserv "NickServ"
nsserv services.umbrellix.net
