commit ad9e313a654e9b02b36a3a5fdc03fe0340a27f9b parent a75eea6c8a6234c6ac5890c2f5aecc95c66037c0 Author: Ellenor Malik <ellenor@umbrellix.net> Date: Fri, 22 Jun 2018 02:20:18 +0000 Well it happened. Diffstat:
| M | chanserv.conf.example | | | 6 | +++--- |
| M | core/0000-conn.tcl | | | 38 | +++++++++++++++++++++++++++++++++++++- |
| A | core/0001-usefultools.tcl | | | 10 | ++++++++++ |
| A | core/2000-protocol-common.tcl | | | 31 | +++++++++++++++++++++++++++++++ |
| A | core/2003-ts6.tcl | | | 775 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | core/4000-eggcom.tcl | | | 360 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| D | core/9999-protocol-common.tcl | | | 22 | ---------------------- |
| R | core/0002-p10.tcl -> core/p10.disabled | | | 0 | |
| R | core/0004-p10n.tcl -> core/p10n.disabled | | | 0 | |
| R | core/0003-ts6.tcl -> core/ts62.disabled | | | 0 | |
| A | language.txt | | | 2 | ++ |
| M | main.tcl | | | 82 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---- |
| D | modules/0000-eggcompat.tcl | | | 343 | ------------------------------------------------------------------------------- |
| A | modules/0000-limitedeggcompat.tcl | | | 360 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| R | modules/0001-chanserv.tcl -> modules/chanserv.disabled | | | 0 | |
| A | modules/debugserv.tcl | | | 51 | +++++++++++++++++++++++++++++++++++++++++++++++++++ |
| R | modules/0004-limitserv.tcl -> modules/limitserv.disabled | | | 0 | |
| R | modules/0007-quote.tcl -> modules/quote.disabled | | | 0 | |
| R | modules/0008-relayserv.tcl -> modules/relayserv.disabled | | | 0 | |
| R | modules/0002-chanserv-thcserv.tcl -> modules/thcserv.disabled | | | 0 | |
| R | modules/0003-weather.tcl -> modules/weather.disabled | | | 0 | |
| M | nda.tcl | | | 85 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------- |
| A | openconf2.tcl | | | 43 | +++++++++++++++++++++++++++++++++++++++++++ |
| M | services.conf.example | | | 38 | +++++++++++++++++++++++++++++++------- |
| A | services.conf.old | | | 7 | +++++++ |
25 files changed, 1864 insertions(+), 389 deletions(-)
diff --git a/chanserv.conf.example b/chanserv.conf.example @@ -1,7 +1,7 @@ set cs(nick) "Mars" set cs(ident) "services" -set cs(host) "your.network.name" -set cs(admin) "j4jackj" -# REPLACE THIS! ^^ This user gets +mno set on him every bootup. +set cs(host) "pandersticks.com" +set cs(admin) "Ellenor" +# REPLACE THIS! ^^ This user gets +mno set on them every bootup. set cs(netname) yournet ::ts6::login $::sock($cs(netname)) $::numeric $::password $cs(netname) diff --git a/core/0000-conn.tcl b/core/0000-conn.tcl @@ -8,4 +8,40 @@ proc connect {addr port script} { return $sck } -source services.conf +proc mknetwork {a} { + set headlines [lrange $a 0 end-1] + set block [lindex $a end] + if {[llength $headlines]<2} { + puts stdout "fuck it, block's invalid ($headlines)" + return + } + set proto [dict get $block proto] + set numeric [dict get $block numeric] + set pass [dict get $block pass] + set host [dict get $block host] + set port [dict get $block port] + set servername [lindex $headlines 1] + set netname [lindex $headlines 0] + if {[dict exists $block prefixes]} { + # only required for ts6 + set prefixes [split [dict get $block prefix] " "] + set pfxl [split [lindex $prefixes 0] {}] + set pfxr [split [lindex $prefixes 1] {}] + set pfx [list] + foreach {p} $pfxl {m} $pfxr { + lappend pfx $p + lappend pfx $m + } + tnda set "ts6/$netname/prefix" $pfx + } { + # safe defaults, will cover charybdis and chatircd + tnda set "ts6/$netname/prefix" [list @ o % h + v] + } + # open a connection + set socke [connect $host $port [list $proto irc-main]] + after 500 $proto login $socke $numeric $pass $netname $servername + # store it up + postblock network $headlines $block +} + +blockwcb network mknetwork diff --git a/core/0001-usefultools.tcl b/core/0001-usefultools.tcl @@ -0,0 +1,10 @@ +proc dictassign {dictValue args} { + foreach {i j} $args { + upvar $j jj + if {[dict exists $dictValue {*}$i]} { + set jj [dict get $dictValue {*}$i] + } { + set jj "" + } + } +} diff --git a/core/2000-protocol-common.tcl b/core/2000-protocol-common.tcl @@ -0,0 +1,31 @@ +proc bind {sock type client comd script} { + set moretodo 1 + while {0!=$moretodo} { + set bindnum [rand 1 100000000] + if {[tnda get "binds/$sock/$type/$client/$comd/$bindnum"]!=""} {} {set moretodo 0} + } + tnda set "binds/$sock/$type/$client/$comd/$bindnum" $script + return $bindnum +} + +proc unbind {sock type client comd id} { + tnda set "binds/$sock/$type/$client/$comd/$id" "" +} +proc callbind {sock type client comd args} { +# puts stdout "$sock $type $client $comd $args" + if {""!=[tnda get "binds/$sock/$type/$client/$comd"]} { + foreach {id script} [tnda get "binds/$sock/$type/$client/$comd"] { + if {$script != ""} { + set scr $script +# lappend $scr $sock + foreach {a} $args { + lappend scr $a + } + if {[catch {eval $scr} erre] > 0} {puts stdout $erre + callbind $sock evnt - error $erre {*}$scr + } + } + };return + } + #if {""!=[tnda get "binds/$type/-/$comd"]} {foreach {id script} [tnda get "binds/$type/-/$comd"] {$script [lindex $args 0] [lrange $args 1 end]};return} +} diff --git a/core/2003-ts6.tcl b/core/2003-ts6.tcl @@ -0,0 +1,775 @@ +source nda.tcl +#source 9999-protocol-common.tcl + + +namespace eval ts6 { +proc ::ts6::b64e {numb} { + set b64 [split "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" {}] + + set res "" + while {$numb != 0} { + append res [lindex $b64 [expr {$numb % 36}]] + set numb [expr {$numb / 36}] + } + if {[string length $res] == 0} { + set res "A" + } + return [string reverse $res] +} + +proc ::ts6::b64d {numb} { + set b64 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + set numb [string trimleft $numb "A"] + set res 0 + for {set i 0} {$i<[string length $numb]} {incr i} { + set new [string first [string index $numb $i] $b64] + incr res [expr {$new * (36 * $i)+1}] + } + return $res +} +} + +proc putl {args} { +# puts stdout [join $args " "] + puts {*}$args +} + +namespace eval ts6 { + +proc ::ts6::sendUid {sck nick ident host dhost uid {realname "* Unknown *"} {modes "+oiS"} {server ""}} { + if {""==$server} {set server $::sid($sck)} + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $server]]}]] + append sid [::ts6::b64e $server] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + if {![tnda get "ts6/$::netname($sck)/euid"]} { + set sl [format ":%s UID %s 1 %s %s %s %s 0 %s%s :%s" $sid $nick [clock format [clock seconds] -format %s] $modes $ident $host $sid $sendnn $realname] + } { + 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 "intclient/$::netname($sck)/${sid}${sendnn}" $uid + tnda set "nick/$::netname($sck)/${sid}${sendnn}" $nick + tnda set "ident/$::netname($sck)/${sid}${sendnn}" $ident + tnda set "rhost/$::netname($sck)/${sid}${sendnn}" $host + tnda set "vhost/$::netname($sck)/${sid}${sendnn}" $dhost + tnda set "rname/$::netname($sck)/${sid}${sendnn}" $realname + tnda set "ipaddr/$::netname($sck)/${sid}${sendnn}" 0 + putl $sck $sl +} + +proc ::ts6::topic {sck uid targ topic} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s TOPIC %s :%s" $sid $sendnn $targ $topic] +} + +proc ::ts6::setnick {sck uid newnick} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s NICK %s :%s" $sid $sendnn $newnick [clock format [clock seconds] -format %s]] +} + +proc ::ts6::sethost {sck targ topic} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append sid [::ts6::b64e $::sid($sck)] + if {![tnda get "ts6/$::netname($sck)/euid"]} { + putl $sck [format ":%s ENCAP * CHGHOST %s %s" $sid $targ $topic] + } { + putl $sck [format ":%s CHGHOST %s %s" $sid $targ $topic] + } +} + +proc ::ts6::sendSid {sck sname sid {realname "In use by Services"}} { +set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] +append sid [::ts6::b64e $::sid($sck)] + set sl [format ":%s SID %s 1 %s :%s" [::ts6::b64e $sid] $sname [::ts6::b64e $sid] $realname] + putl $sck $sl +} + +proc ::ts6::privmsg {sck uid targ msg} { +set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] +append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s PRIVMSG %s :%s" $sid $sendnn $targ $msg] +} + +proc ::ts6::snote {sck targ msg} { +set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] +append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s ENCAP * SNOTE %s :%s" $sid $sendnn $targ $msg] +} + +proc ::ts6::metadata {sck targ direction type {msg ""}} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append sid [::ts6::b64e $::sid($sck)] + if {[string toupper $direction] != "ADD" && [string toupper $direction] != "DELETE"} {putcmdlog "failed METADATA attempt (invalid arguments)";return} ;#no that didn't work + if {[string toupper $direction] == "ADD"} { + tnda set "metadata/$::netname($sck)/$targ/[ndaenc $type]" $msg + putl $sck [format ":%s ENCAP * METADATA %s %s %s :%s" $sid [string toupper $direction] $targ [string toupper $type] $msg] + } + if {[string toupper $direction] == "DELETE"} { + tnda unset "metadata/$::netname($sck)/$targ/[ndaenc $type]" + putl $sck [format ":%s ENCAP * METADATA %s %s :%s" $sid [string toupper $direction] $targ [string toupper $type]] + } +} + +proc ::ts6::kick {sck uid targ tn msg} { +set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] +append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s KICK %s %s :%s" $sid $sendnn $targ $tn $msg] +} + +proc ::ts6::notice {sck uid targ msg} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s NOTICE %s :%s" $sid $sendnn $targ $msg] +} + +proc ::ts6::part {sck uid targ msg} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s PART %s :%s" $sid $sendnn $targ $msg] +} + +proc ::ts6::quit {sck uid msg} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s QUIT :%s" $sid $sendnn $msg] + tnda unset "intclient/$::netname($sck)/${sid}${sendnn}" + 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}" +} + +proc ::ts6::setacct {sck targ msg} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + if {[ts6 uid2nick $sck $targ] == ""} {return} + putl $sck [format ":%s ENCAP * SU %s %s" $sid $targ $msg] + tnda set "login/$::netname($sck)/$targ" $msg +} + +proc ::ts6::grant {sck targ msg {fmult 65}} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + if {[ts6 uid2nick $sck $targ] == ""} {return} + putl $sck [format ":%s ENCAP * GRANT %s %s %s" $sid $targ $fmult $msg] + tnda set "oper/$::netname($sck)/$targ" 1 +} + +proc ::ts6::putmotd {sck targ msg} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + if {[ts6 uid2nick $sck $targ] == ""} {return} + putl $sck [format ":%s 372 %s :- %s" $sid $targ $msg] +} + +proc ::ts6::putmotdend {sck targ} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + if {[ts6 uid2nick $sck $targ] == ""} {return} + putl $sck [format ":%s 376 %s :End of global MOTD." $sid $targ] +} + +proc ::ts6::putmode {sck uid targ mode {parm ""} {ts ""}} { + if {$ts == ""} { + if {[set ts [tnda get "channels/$::netname($sck)/[ndaenc [string tolower $targ]]/ts"]] == ""} {return} ;#cant do it, doesnt exist + } + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s%s TMODE %s %s %s %s" $sid $sendnn $ts $targ $mode $parm] +} + +proc ::ts6::sendencap {sck uid targ args} { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + if {[ts6 uid2nick $sck $targ] == ""} {return} + if {$uid == "-1"} { set sendnn ""} { + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + } + if {[string first " " [lindex $args end]] != -1} { + putl $sck [format ":%s%s ENCAP %s %s :%s" $sid $sendnn $targ [join [lrange $args 0 end-1] " "] [lindex $args end]] + } { + putl $sck [format ":%s%s ENCAP %s %s" $sid $sendnn $targ [join $args " "]] + } +} + +proc ::ts6::putjoin {sck uid targ {ts ""}} { + if {$ts == ""} { + if {[set ts [tnda get "channels/$::netname($sck)/[ndaenc [string tolower $targ]]/ts"]] == ""} {set ts [clock format [clock seconds] -format %s]} + } + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set sendid [::ts6::b64e $uid] + set sendnn [string repeat "A" [expr {6-[string length $sendid]}]] + append sendnn $sendid + putl $sck [format ":%s SJOIN %s %s + :%s%s" $sid $ts $targ $sid $sendnn] +} + +proc ::ts6::validchan {sck channelname} { + if {[string is digit [string index $channelname 0]] && [string length $channelname] == 9} {return 0} ;# valid handle, not valid channel + if {[string first [string index $channelname 0] [tnda get "ts6/$::netname($sck)/[ndaenc CHANTYPES]"]] != -1} {return 1} ;# could be valid channel, so let's just say yes +} + +proc ::ts6::quitstorm {sck sid comment {doinit 1}} { + if {$doinit} {set splits [list $sid]} {set splits [list]} + foreach {sid64 sdesc} [tnda get "servers/$::netname($sck)"] { + # if the server doesn't have $sid as the uplink, continue + if {[dict get $sdesc uplink] != $sid} { + continue + } + # but if it does... they split and we should see who they're taking down + lappend splits [string toupper [ndadec $sid64]] + foreach {splitid} [::ts6::quitstorm $sck [ndadec $sid64] $comment 0] { + lappend splits $splitid + } + } + return $splits +} + +proc ::ts6::irc-main {sck} { + global sid sock socksid + if {[eof $sck]} {close $sck} + gets $sck line + #putcmdlog $line + set line [string trim $line "\r\n"] + set one [string match ":*" $line] + set line [string trimleft $line ":"] + set gotsplitwhere [string first " :" $line] + if {$gotsplitwhere==-1} {set comd [split $line " "]} {set comd [split [string range $line 0 [expr {$gotsplitwhere - 1}]] " "]} + if {$gotsplitwhere==-1} {set payload [lindex $comd end]} {set payload [split [string range $line [expr {$gotsplitwhere + 2}] end] " "]} + if {$gotsplitwhere != -1} {lappend comd $payload} + if {[lindex $comd 0] == "PING"} {putl $sck "PONG $::snames($sck) :$payload"} + if {[lindex $comd 0] == "SERVER"} {putl $sck "VERSION"} + set erreno [catch { + switch -nocase -- [lindex $comd $one] { + "479" {putcmdlog $payload} + "PASS" { + putquick "PRIVMSG #services :$line" + 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 + tnda set "socksid/$::netname($sck)" $payload + } + + "SERVER" { + putquick "PRIVMSG #services :$line" +# 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}]] + callbind $sck evnt "-" "ts6.alive" $::netname($sck) ;#obvious + callbind $sck evnt "-" "alive" $::netname($sck) ;#obvious + } + + "SID" { + 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] + tnda set "servers/$::netname($sck)/[ndaenc [lindex $comd 4]]/sid" [lindex $comd 4] +# putloglev o * [tnda get "servers"] + } + + "SQUIT" { + set sid [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]];append sid [::ts6::b64e $::sid($sck)] + set failedserver [lindex $comd [expr {$one + 1}]] + # is it us? + if {$failedserver == $sid} { + #yes, it's us. + putcmdlog "We're dead, folks." + callbind $sck evnt "-" "ts6.dead" $::netname($sck) + callbind $sck evnt "-" "dead" $::netname($sck) + return + } + # Mark all servers with an uplink in failedservers as split + set slist [::ts6::quitstorm $sck [lindex $comd [expr {$one + 1}]] [lindex $comd [expr {$one + 2}]]] + foreach {srv} $slist { + ::ts6::snote $sck x [format "!! NETSPLIT: %s (%s) has left the network (Server Quit: %s)" [tnda get "servers/$::netname($sck)/[ndaenc $srv]/name"] $srv [lindex $comd [expr {$one + 2}]] + tnda unset "servers/$::netname($sck)/[ndaenc $srv]" + foreach {uidd _} [tnda get "nick/$::netname($sck)"] { + if {[string range $uidd 0 2] != $srv} {continue};# not a dead user + foreach {chan _} [tnda get "userchan/$::netname($sck)/$uidd"] { + callbind $sck part "-" "-" [ndadec $chan] $uidd $::netname($sck) +# callbind $sck cquit "-" "-" [ndadec $chan] $uidd $::netname($sck) + tnda set "userchan/$::netname($sck)/$uidd/$chan" 0 + } + + ::ts6::snote $sck F [format "!! NETSPLIT: %s (%s) has quit due to netsplit (%s: %s)" [tnda get "nick/$::netname($sck)/$uidd"] $uidd [tnda get "servers/$::netname($sck)/[ndaenc $srv]/name"] [lindex $comd [expr {$one + 2}]] + tnda unset "login/$::netname($sck)/$uidd" + tnda unset "nick/$::netname($sck)/$uidd" + tnda set "oper/$::netname($sck)/$uidd" 0 + tnda unset "ident/$::netname($sck)/$uidd" + tnda unset "rhost/$::netname($sck)/$uidd" + tnda unset "vhost/$::netname($sck)/$uidd" + tnda unset "rname/$::netname($sck)/$uidd" + tnda unset "ipaddr/$::netname($sck)/$uidd" + tnda set "metadata/$::netname($sck)/$uidd" [list] + tnda unset "certfps/$::netname($sck)/$uidd" + callbind $sck quit "-" "-" $uidd $::netname($sck) + } + } + } + + "005" - "105" { + foreach {tok} [lrange $comd 3 end] { + foreach {key val} [split $tok "="] { + if {$key == "PREFIX"} { + # We're in luck! Server advertises its PREFIX in VERSION reply to servers. + if {[tnda get "ts6/$::netname($sck)/pfxissjoin"] == 1} {continue} + set v [string range $val 1 end] + set mod [split $v ")"] + set modechar [split [lindex $mod 1] {}] + set modepref [split [lindex $mod 0] {}] + foreach {c} $modechar {x} $modepref { + tnda set "ts6/$::netname($sck)/prefix/$c" $x + } + foreach {x} $modechar {c} $modepref { + tnda set "ts6/$::netname($sck)/pfxchar/$c" $x + } + } elseif {$key == "SJOIN"} { + # We're in luck! Server advertises its PREFIX in VERSION reply to servers. + tnda set "ts6/$::netname($sck)/pfxissjoin" 1 + set v [string range $val 1 end] + set mod [split $v ")"] + set modechar [split [lindex $mod 1] {}] + set modepref [split [lindex $mod 0] {}] + foreach {c} $modechar {x} $modepref { + tnda set "ts6/$::netname($sck)/prefix/$c" $x + } + foreach {x} $modechar {c} $modepref { + tnda set "ts6/$::netname($sck)/pfxchar/$c" $x + } + } elseif {$key == "CHANMODES"} { + set spt [split $val ","] + tnda set "ts6/$::netname($sck)/chmparm" [format "%s%s" [lindex $spt 0] [lindex $spt 1]] + tnda set "ts6/$::netname($sck)/chmpartparm" [lindex $spt 2] + tnda set "ts6/$::netname($sck)/chmnoparm" [lindex $spt 3] + } else { + tnda set "ts6/$::netname($sck)/[ndaenc $key]" $val + } + } + } + } + + "PRIVMSG" { + if {[::ts6::validchan $sck [lindex $comd 2]]} { + set client chan + callbind $sck pub "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "] + callbind $sck evnt "-" "chanmsg" [lindex $comd 0] [lindex $comd 2] $payload + } { + set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"] + callbind $sck msg $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "] + callbind $sck "evnt" "-" "privmsg" [lindex $comd 0] [lindex $comd 2] $payload + } + } + + "NOTICE" { + if {![tnda get "ts6/$::netname($sck)/connected"]} {return} + if {[::ts6::validchan $sck [lindex $comd 2]]} { + set client chan + callbind $sck pubnotc "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "] +# callbind $sck pubnotc-m "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "] + callbind $sck "evnt" "-" "channotc" [lindex $comd 0] [lindex $comd 2] $payload + } { + set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"] + callbind $sck notc $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "] + callbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] $payload + } + } + + "MODE" { + if {[lindex $comd 3] == [tnda get "nick/$::netname($sck)/[lindex $comd 0]"]} { + foreach {c} [split [lindex $comd 4] {}] { + switch -- $c { + "+" {set state 1} + "-" {set state 0} + "o" {tnda set "oper/$::netname($sck)/[lindex $comd 0]" $state} + } + } + } + } + + "JOIN" { + set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 3]]]] + if {""==[tnda get "channels/$::netname($sck)/$chan/ts"]} {callbind $sck create "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck)} + callbind $sck join "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck) + tnda set "channels/$::netname($sck)/$chan/ts" [lindex $comd 2] + tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 1 + } + + "BMASK" { + # always +, no ctr and no state + set adding [split $payload " "] + if {[lindex $comd 3] > [tnda get "channels/$::netname($sck)/$chan/ts"]} {return} ;# send it packing. + set channel [lindex $comd 3] + set type [lindex $comd 4] + foreach {mask} $adding { + callbind $sck mode - + $type [lindex $comd 0] [lindex $comd 3] $mask $::netname($sck) + } + } + + "TMODE" { + set ctr 4 + set state 1 + foreach {c} [split [lindex $comd 4] {}] { + if {$c == "+"} { + set state 1 + } elseif {$c == "-"} { + set state 0 + } elseif {[string match [format "*%s*" $c] [tnda get "ts6/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "ts6/$::netname($sck)/chmpartparm"]])} { + callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] [lindex $comd [incr ctr]] $::netname($sck) + } else { + callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] "" $::netname($sck) + } + } + } + + "SJOIN" { + set chan [ndaenc [lindex $comd 3]] + if {[string index [lindex $comd 4] 0] == "+"} { + set four 5 + if {[string match "*l*" [lindex $comd 4]]} {incr four} + if {[string match "*f*" [lindex $comd 4]]} {incr four} + if {[string match "*j*" [lindex $comd 4]]} {incr four} + if {[string match "*k*" [lindex $comd 4]]} {incr four} + } { + set four 4 + } + tnda set "channels/$::netname($sck)/$chan/ts" [lindex $comd 2] + # XXX: some servers don't give their SJOIN prefixes in PREFIX. + # Solution? irca will, from the next release, support 005 portion "SJOIN=" formatted same as + # PREFIX. + # Also allow hardcoding. + foreach {nick} [split $payload " "] { + set un "" + set uo "" + set state uo + set un [string range $nick end-8 end] + set uo [string map [tnda get "ts6/$::netname($sck)/prefix"] [string range $nick 0 end-9]] +# foreach {c} [split $nick {}] { +# if {[string is digit $c]} {set state un} +# if {$state == "uo"} {set c [tnda get "ts6/$::netname($sck)/prefix/$c"] ; } +# if {"un"==$state} {append un $c} +# if {"uo"==$state} {append uo $c} +# } + putcmdlog [format "JOIN %s by nicknumber %s (nick %s, modes %s)" [ndadec $chan] $nick [tnda get "nick/$::netname($sck)/$un"] $uo] + callbind $sck join "-" "-" [lindex $comd 3] $un $::netname($sck) + tnda set "userchan/$::netname($sck)/$un/$chan" 1 + if {""!=$uo} {tnda set "channels/$::netname($sck)/$chan/modes/$un" $uo + foreach {c} [split $uo {}] { + callbind $sck mode "-" + $c $un [lindex $comd 3] $un $::netname($sck) + } + } + } + + } + + "PART" { + callbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0] $::netname($sck) + set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]] + tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0 + } + + "KICK" { + callbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3] $::netname($sck) + } + + "NICK" { + tnda set "nick/$::netname($sck)/[lindex $comd 0]" [lindex $comd 2] + tnda set "ts/$::netname($sck)/[lindex $comd 0]" [lindex $comd 3] + } + + "EUID" { + set num 9 + set ctr 1 + set oper 0 + set loggedin [lindex $comd 11] + set realhost [lindex $comd 10] + set modes [lindex $comd 4] + if {[string match "*o*" $modes]} {set oper 1} + if {"*"!=$loggedin} { + tnda set "login/$::netname($sck)/[lindex $comd $num]" $loggedin + } + if {"*"!=$realhost} { + tnda set "rhost/$::netname($sck)/[lindex $comd $num]" $realhost + } { + tnda set "rhost/$::netname($sck)/[lindex $comd $num]" [lindex $comd 7] + } + tnda set "nick/$::netname($sck)/[lindex $comd $num]" [lindex $comd 2] + tnda set "oper/$::netname($sck)/[lindex $comd $num]" $oper + tnda set "ident/$::netname($sck)/[lindex $comd $num]" [lindex $comd 6] + tnda set "vhost/$::netname($sck)/[lindex $comd $num]" [lindex $comd 7] + tnda set "ipaddr/$::netname($sck)/[lindex $comd $num]" [lindex $comd 8] + tnda set "ts/$::netname($sck)/[lindex $comd $num]" [lindex $comd 4] + tnda set "rname/$::netname($sck)/[lindex $comd $num]" $payload + putloglev j * [format "New user at %s %s %s!%s@%s (IP address %s, vhost %s) :%s" $::netname($sck) [lindex $comd $num] [lindex $comd 2] [lindex $comd 6] [tnda get "rhost/$::netname($sck)/[lindex $comd $num]"] [lindex $comd 8] [tnda get "vhost/$::netname($sck)/[lindex $comd $num]"] $payload] + callbind $sck conn "-" "-" [lindex $comd $num] + } + + "KLINE" {putloglev k * [format "KLINE: %s" $line]} + "BAN" {putloglev k * [format "BAN: %s" $line]} + + "ENCAP" { + switch -nocase -- [lindex $comd 3] { + "SASL" { + # we have to support sasl messages, so... + callbind $sck encap - "sasl" [lrange $comd 4 end] + #don't bother + } + "KLINE" { + putloglev k * [format "KLINE: %s" $line] + } + "SU" { + if {$payload == ""} {set payload [lindex $comd 5]} + tnda set "login/$::netname($sck)/[lindex $comd 4]" $payload + if {$payload == ""} {callbind $sck logout "-" "-" [lindex $comd 4]} {callbind $sck login "-" "-" [lindex $comd 4] $payload} + } + "CERTFP" { + tnda set "certfps/$::netname($sck)/[lindex $comd 0]" $payload + callbind $sck encap "-" "certfp" [lindex $comd 0] $payload + } + "METADATA" { + switch -nocase -- [lindex $comd 4] { + "ADD" { + tnda set "metadata/$::netname($sck)/[lindex $comd 5]/[ndcenc [lindex $comd 6]]" $payload + callbind $sck encap "-" "metadata.[string tolower [lindex $comd 6]]" [lindex $comd 5] $payload + callbind $sck mark "-" [lindex $comd 6] [lindex $comd 5] $payload + } + "DELETE" { + tnda unset "metadata/$::netname($sck)/[lindex $comd 5]/[ndcenc $payload]" + callbind $sck encap "-" "metadata.[string tolower $payload]" [lindex $comd 5] "" + callbind $sck mark "-" $payload [lindex $comd 5] "" + # WARNING!!!! Pick ONE. The official scripts use MARK; you should too. + } + } + } + } + } + + "TOPIC" { + callbind $sck topic "-" "-" [lindex $comd 2] [join $payload " "] + } + "QUIT" { + if {![string is digit [string index [lindex $comd 0] 0]]} { + set ocomd [lrange $comd 1 end] + set on [lindex $comd 0] + set comd [list [::ts6::nick2uid $::netname($sck) $on] {*}$ocomd] + putcmdlog [format "Uh-oh, netsplit! %s -> %s has split" $on [::ts6::nick2uid $::netname($sck) $on]] + } + foreach {chan _} [tnda get "userchan/$::netname($sck)/[lindex $comd 0]"] { + callbind $sck part "-" "-" [ndadec $chan] [lindex $comd 0] $::netname($sck) + tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 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 "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 "certfps/$::netname($sck)/[lindex $comd 0]" + callbind $sck quit "-" "-" [lindex $comd 0] $::netname($sck) + } + + "KILL" { + foreach {chan _} [tnda get "userchan/$::netname($sck)/[lindex $comd 2]"] { + callbind $sck part "-" "-" [ndadec $chan] [lindex $comd 2] + 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 "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 "certfps/$::netname($sck)/[lindex $comd 2]" + callbind $sck quit "-" "-" [lindex $comd 2] $::netname($sck) + } + + "ERROR" { + putcmdlog "Recv'd an ERROR $payload from $::netname($sck)" + } + + "WHOIS" { + # Usually but not always for a local client. + set num [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append num [::ts6::b64e $::sid($sck)] + set targ [::ts6::nick2uid $::netname($sck) $payload] + if {[tnda get "nick/$::netname($sck)/$targ"] == ""} { + putl $sck [format ":%s 401 %s %s :No such user." $num [lindex $comd 0] $payload] + } else { + putl $sck [format ":%s 311 %s %s %s %s * :%s" $num [lindex $comd 0] [tnda get "nick/$::netname($sck)/$targ"] [tnda get "ident/$::netname($sck)/$targ"] [tnda get "vhost/$::netname($sck)/$targ"] [tnda get "rname/$::netname($sck)/$targ"]] + } + putl $sck [format ":%s 318 %s %s :End of /WHOIS list." $num [lindex $comd 0] $payload] + } + + "CAPAB" { + tnda set "ts6/$::netname($sck)/euid" 0 + foreach {cw} [split $payload " "] { + if {$cw == "EUID"} {tnda set "ts6/$::netname($sck)/euid" 1} + } + tnda set "ts6/$::netname($sck)/connected" 1 + } + + "PING" { + set num [string repeat "0" [expr {3-[string length [::ts6::b64e $::sid($sck)]]}]] + append num [::ts6::b64e $::sid($sck)] + if {[lindex $comd 3]==""} {set pong [lindex $comd 0]} {set pong [lindex $comd 3]} + putl $sck [format ":%s PONG %s %s" $num $pong [lindex $comd 2]] + } + } + } erreur] + #puts stdout [join [list $erreno $erreur] " "] +} + +proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servername services.invalid}} { + set num [string repeat "0" [expr {3-[string length [::ts6::b64e $osid]]}]] + append num [::ts6::b64e $osid] + global netname sid sock nettype socksid snames + set snames($sck) $servername + set netname($sck) $servname + set nettype($servname) ts6 + set sock($servname) $sck + set sid($sck) $osid + set sid($servname) $osid + tnda set "ts6/$::netname($sck)/connected" 0 + tnda set "ts6/$::netname($sck)/euid" 0 + if {![info exists ::ts6(halfops)]} {tnda set "pfx/halfop" v} {tnda set "pfx/halfop" $::ts6(halfops)} + if {![info exists ::ts6(ownermode)]} {tnda set "pfx/owner" o} {tnda set "pfx/owner" $::ts6(ownermode)} + if {![info exists ::ts6(protectmode)]} {tnda set "pfx/protect" o} {tnda set "pfx/protect" $::ts6(protectmode)} + if {![info exists ::ts6(euid)]} {set ::ts6(euid) 1} + putl $sck "PASS $password TS 6 :$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" + bind $sck mode - + ::ts6::checkop + bind $sck mode - - ::ts6::checkdeop + + chan event $sck readable [list ::ts6::irc-main $sck] +} + +#source services.conf + +proc ::ts6::nick2uid {netname nick} { + foreach {u n} [tnda get "nick/$netname"] { + if {[string tolower $n] == [string tolower $nick]} {return $u} + } +} +proc ::ts6::intclient2uid {netname nick} { + foreach {u n} [tnda get "intclient/$netname"] { + if {[string tolower $n] == [string tolower $nick]} {return $u} + } +} +proc ::ts6::uid2nick {netname u} { + return [tnda get "nick/$netname/$u"] +} +proc ::ts6::uid2rhost {netname u} { + return [tnda get "rhost/$netname/$u"] +} +proc ::ts6::uid2host {netname u} { + return [tnda get "host/$netname/$u"] +} +proc ::ts6::uid2ident {netname u} { + return [tnda get "ident/$netname/$u"] +} +proc ::ts6::nick2host {netname nick} { + return [tnda get "host/$netname/[nick2uid $netname $nick]"] +} +proc ::ts6::nick2ident {netname nick} { + return [tnda get "ident/$netname/[nick2uid $netname $nick]"] +} +proc ::ts6::nick2rhost {netname nick} { + return [tnda get "rhost/$netname/[nick2uid $netname $nick]"] +} +proc ::ts6::nick2ipaddr {netname nick} { + return [tnda get "ipaddr/$netname/[nick2uid $netname $nick]"] +} +proc ::ts6::getts {netname chan} { + return [tnda get "channels/$netname/[ndaenc $chan]/ts"] +} +proc ::ts6::getpfx {netname chan nick} { + return [tnda get "channels/$netname/[ndaenc $chan]/modes/[::ts6::nick2uid $netname $nick]"] +} +proc ::ts6::getupfx {netname chan u} { + return [tnda get "channels/$netname/[ndaenc $chan]/modes/$u"] +} +proc ::ts6::getpfxchars {netname modes} { + set o "" + foreach {c} [split $modes {}] { + append o [nda get "ts6/$netname/prefix/$c"] + } + return $o +} +proc ::ts6::getmetadata {netname nick metadatum} { + return [tnda get "metadata/$netname/[::ts6::nick2uid $netname $nick]/[ndcenc $metadatum]"] +} +proc ::ts6::getcertfp {netname nick} { + return [tnda get "certfps/$netname/[::ts6::nick2uid $netname $nick]"] +} + +proc ::ts6::checkop {mc s c p n} { + set f $s + set t $c + if {[tnda get "ts6/$n/pfxchar/$mc"]==""} {return} +putcmdlog "up $mc $f $t $p $n" + set chan [string map {/ [} [::base64::encode [string tolower $t]]] + tnda set "channels/$n/$chan/modes/$p" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]] $mc] +} + +proc ::ts6::checkdeop {mc s c p n} { + set f $s + set t $c + if {[tnda get "ts6/$n/pfxchar/$mc"]==""} {return} +putcmdlog "down $mc $f $t $p $n" + set chan [string map {/ [} [::base64::encode [string tolower $t]]] + tnda set "channels/$n/$chan/modes/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]] +} + +proc ::ts6::formprefix {netname nick} { + return [format ":%s " $nick] +} +proc ::ts6::uid2intclient {netname u} { + return [tnda get "intclient/$netname/$u"] +} + +proc ::ts6::getfreeuid {net} { +set work 1 +set cns [list] +foreach {_ cnum} [tnda get "intclient/$net"] {lappend cns $cnum} +while {0!=$work} {set num [expr {[rand 30000]+10000}];if {[lsearch -exact $cns $num]==-1} {set work 0}} +return $num +} + +namespace export * +namespace ensemble create +} + +#ts6 login $::sock diff --git a/core/4000-eggcom.tcl b/core/4000-eggcom.tcl @@ -0,0 +1,360 @@ +#source chanserv.conf + +#bind $::sock($::cs(netname)) mode "-" "+" bitchopcheck +#bind $::sock($::cs(netname)) mode "-" "-" protectopcheck +#bind $::sock($::cs(netname)) join "-" "-" autoopcheck + +proc protectopcheck {mc f t p} { + if {"o"==$mc && ![channel get $t protectop]} {return} + if {"h"==$mc && ![channel get $t protecthalfop]} {return} + if {"v"==$mc && ![channel get $t protectvoice]} {return} + switch -- $mc { + "o" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] omn|omn $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + "h" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + "v" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + } +} + +proc finduserbyid {n} { + tnda get "login/$::netname($::sock($::cs(netname)))/$f" +} + +proc autoopcheck {c f} { + set globe 0 + if {[channel get $c operit]} {set globe 1} + if {[channel get $c autoop]} {set auto nmo} {set auto ""} + if {[channel get $c autohalfop]} {append auto l} + if {[channel get $c autovoice]} {append auto v} + tcs:opcheck $c $f $globe $auto +} + +proc tcs:opcheck {c f {globe 0} {auto nmolv}} { +# puts stdout "$c $f" + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |k $c]} { + # obviously optimised for charybdis... ??? + $::maintype putmode $::sock($::cs(netname)) 77 $c +b "*![tnda get "ident/$::netname($::sock($::cs(netname)))/$f"]@[tnda get "vhost/$::netname($::sock($::cs(netname)))/$f"]" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + $::maintype kick $::sock($::cs(netname)) 77 $c $f "Autokicked (+k attribute)" + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] n|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |n $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] m|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |m $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] a|]} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] o|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |o $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] l|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |l $c] && ([string first "h" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] v|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |v $c] && ([string first "v" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } +} + +proc bitchopcheck {mc ftp} { + set f [lindex $ftp 0] + set t [lindex $ftp 1] + set p [lindex $ftp 2] + puts stdout "$ftp" + if {[tnda get "pfx/owner"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/owner"] != q} {set mc q}} + if {[tnda get "pfx/protect"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/protect"] != a} {set mc a}} + if {"o"==$mc && ![channel get $t bitch]} {return} + if {"h"==$mc && ![channel get $t halfbitch]} {return} + if {"v"==$mc && ![channel get $t voicebitch]} {return} + switch -glob -- $mc { + "q" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] n|n $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "a" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] mn|mn $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "o" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] aomn|omn $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "h" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "v" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + } +} + +proc utimer {seconds tcl-command} {after [expr $seconds * 1000] ${tcl-command}} +proc timer {minutes tcl-command} {after [expr $minutes * 60 * 1000] ${tcl-command}} +proc utimers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} +proc timers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} +proc killtimer id {return [after cancel $id]} +proc killutimer id {return [after cancel $id]} + +proc isbotnick {n} {return [expr {$n == $::botnick}]} + + +set globctx "" + +proc setctx {ctx} { + global globctx + if {[catch [list set ::sock($ctx)] erre] > 0} {return} ; # silently crap out + set globctx $ctx +} + +proc curctx {{type .net}} { + if {$::globctx == ""} {return ""} + switch -exact -- [format ".%s" [string tolower $type]] { + .sock { + return $::sock($::globctx) + } + .net { + return $::globctx + } + .proto { + return $::nettype($::globctx) + } + } +} + +foreach {pname} [list putserv puthelp putquick putnow] { + proc $pname {msg} { + puts [curctx sock] [[curctx proto] formprefix [curctx net] $msg] + } +} + +proc msgmt {from msg} { + set handle [lindex $msg 0] + set attr [lindex $msg 1] + set chan [lindex $msg 2] + $::maintype notice $::sock($::cs(netname)) 77 $from "$handle $attr $chan Matchattr result: [matchattr $handle $attr $chan]" +} + +#bind $::sock($::cs(netname)) msg 77 "matchattr" msgmt + +proc matchattr {handle attr {chan "*"}} { + set handle [string tolower $handle] + if {-1!=[string first "&" $attr]} {set and 1} {set and 0} + set gattr [lindex [split $attr "&|"] 0] + set cattr [lindex [split $attr "&|"] 1] + set isattrg 0 + foreach {c} [split [nda get "eggcompat/attrs/global/$handle"] {}] { + foreach {k} [split $gattr {}] { + if {$c == $k} {set isattrg 1} + } + } + set isattrc 0 + if {"*"!=$chan} { + foreach {c} [split [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"] {}] { + foreach {k} [split $cattr {}] { + if {$c == $k} {set isattrc 1} + } + } + } + if {$and && ($isattrg == $isattrc) && ($isattrc == 1)} {return 1} + if {!$and && ($isattrg || $isattrc)} {return 1} + return 0 +} + +proc chattr {handle attr {chan "*"}} { + set handle [string tolower $handle] + if {$chan == "*"} { + set del [list] + set app "" + set state app + foreach {c} [split $attr {}] { + if {"+"==$c} {set state app;continue} + if {"-"==$c} {set state del;continue} + if {$state=="del"} { + lappend del $c "" + } + if {$state=="app"} { + lappend del $c "" + append app $c + } + } + nda set "eggcompat/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/global/$handle"]] $app] ""] + } { + set del [list] + set app "" + set state app + foreach {c} [split $attr {}] { + if {"+"==$c} {set state app;continue} + if {"-"==$c} {set state del;continue} + if {$state=="del"} { + lappend del $c "" + } + if {$state=="app"} { + lappend del $c "" + append app $c + } + } + puts stdout [ndaenc $chan] + nda set "eggcompat/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"]] $app] ""] + } +} + +proc channels {} { + foreach {chan _} [nda get "regchan"] { + lappend ret $chan + } + return $ret +} + +namespace eval channel { + proc ::channel::get {chan flag} { + if {[::set enda [nda get "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0} + } + proc ::channel::set {chan flags} { + if {[llength $flags] != 1} { + foreach {flag} $flags { + ::set bit [string index $flag 0] + if {$bit=="+"} {::set bitt 1} {::set bitt 0} + ::set flag [string range $flag 1 end] + nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt + } + } { + ::set bit [string index $flags 0] + if {$bit=="+"} {::set bitt 1} {::set bitt 0} + ::set flag [string range $flags 1 end] + nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt + } + } + namespace export * + namespace ensemble create +} + +proc validuser {n} { + if {""==[nda get "usernames/$n"]} {return 0} {return 1} +} + +#bind $::sock($::cs(netname)) msg 77 "chanset" msgchanset +#bind $::sock($::cs(netname)) msg 77 "chattr" msgchattr +#bind $::sock($::cs(netname)) msg 77 "setxtra" msgxtra +#set botnick $cs(nick) +#chattr $cs(admin) +mnolv + +proc msgchanset {from msg} { + set ndacname [ndaenc [lindex $msg 0 0]] + set chanset [lindex $msg 0 1] + if {300>[nda get "regchan/$ndacname/levels/[string tolower [tnda get "login/$from"]]"] && ![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] m|m [lindex $msg 0 0]]} { + $::maintype notice $::sock($::cs(netname)) 77 $from "Only channel super-operators (300) and above and network masters may use eggdrop-compatible chansets." + return + } + channel set [lindex $msg 0 0] $chanset + $::maintype notice $::sock($::cs(netname)) 77 $from "Eggdrop compatible chanset $chanset set on [lindex $msg 0 0]." +} + +proc msgchattr {from msg} { + set ndacname [ndaenc [lindex $msg 0 2]] + set handle [lindex $msg 0 0] + set hand [lindex $msg 0 0] + set attrs [lindex $msg 0 1] + set chan [lindex $msg 0 2] + set ch [lindex $msg 0 2] + foreach {c} [split $attrs {}] { + if {$c == "+"} {continue} + if {$c == "-"} {continue} + if {$c == "k"} {set c "mn|mnol"} + if {$c == "v"} {set c "mn|lmno"} + if {$c == "l"} {set c "mn|mno"} + if {$c == "o"} {set c "mn|omn"} + if {$c == "m"} {set c "mn|mn"} + if {$c == "n"} {set c "n|n"} + if {$c == "a"} {set c "mn|"} + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] $c $chan]} { + $::maintype notice $::sock($::cs(netname)) 77 $from "You may only give flags you already possess (Any of flags $c required to set $attrs)." + return + } + } + if {""==$chan} {chattr $hand $attrs} {chattr $hand $attrs $chan} + $::maintype notice $::sock($::cs(netname)) 77 $from "Global flags for $hand are now [nda get "eggcompat/attrs/global/[string tolower $handle]"]" + if {""==[nda get "regchan/$ndacname/levels/[string tolower $hand]"]} {nda set "regchan/$ndacname/levels/[string tolower $hand]" 1} + if {$ch != ""} {$::maintype notice $::sock($::cs(netname)) 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/attrs/$ndacname/[string tolower $handle]"]"} +} + +proc nick2hand {nick} { + foreach {uid nic} [tnda get "nick"] { + if {$nick == $nic} {return [tnda get "login/$::netname($::sock($::cs(netname)))/$uid"]} + } +} + +proc getuser {nick datafield {dataval "body"}} { + return [nda get "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]"] +} + +proc setuser {nick datafield {dataval "body"} val} { + return [nda set "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]" $val] +} + +proc msgxtra {from msg} { + if {[set log [tnda get "login/$::netname($::sock($::cs(netname)))/$from"]]==""} { + $::maintype notice $::sock($::cs(netname)) 77 $from "Until you've registered with the bot, you have no business setting XTRA values." + return + } + set subfield [lindex $msg 0 0] + set value [join [lrange [lindex $msg 0] 1 end] " "] + setuser $log "XTRA" $subfield $value + $::maintype notice $::sock($::cs(netname)) 77 $from "Set your user record XTRA $subfield to $value." +} + +proc chandname2name {channame} {return $channame} +proc channame2dname {channame} {return $channame} + +proc islinked {bot} {return 0} diff --git a/core/9999-protocol-common.tcl b/core/9999-protocol-common.tcl @@ -1,22 +0,0 @@ -proc bind {sock type client comd script} { - set moretodo 1 - while {0!=$moretodo} { - set bindnum [rand 1 10000000] - if {[tnda get "binds/$sock/$type/$client/$comd/$bindnum"]!=""} {} {set moretodo 0} - } - tnda set "binds/$sock/$type/$client/$comd/$bindnum" $script - return $bindnum -} - -proc unbind {sock type client comd id} { - tnda set "binds/$sock/$type/$client/$comd/$id" "" -} -proc callbind {sock type client comd args} { - puts stdout [tnda get "binds/mode"] - if {""!=[tnda get "binds/$sock/$type/$client/$comd"]} { - foreach {id script} [tnda get "binds/$sock/$type/$client/$comd"] { - if {$script != ""} {$script [lindex $args 0] [lrange $args 1 end]} - };return - } - #if {""!=[tnda get "binds/$type/-/$comd"]} {foreach {id script} [tnda get "binds/$type/-/$comd"] {$script [lindex $args 0] [lrange $args 1 end]};return} -} diff --git a/core/0002-p10.tcl b/core/p10.disabled diff --git a/core/0004-p10n.tcl b/core/p10n.disabled diff --git a/core/0003-ts6.tcl b/core/ts62.disabled diff --git a/language.txt b/language.txt @@ -0,0 +1,2 @@ +debugserv.metadata 14/2/12/ Metadata %s for %s: %s +continuant 14/2/12/ %s diff --git a/main.tcl b/main.tcl @@ -14,8 +14,9 @@ proc pwhash {pass} { return "SHA1/$hash" } -proc rand {minn maxx} { +proc rand {minn {maxx 0}} { if {$minn==$maxx} {return $maxx} + if {$minn > $maxx} {set omx $maxx; set maxx $minn ; set minn $omx} set maxnum [expr {$maxx - $minn}] set fp [open /dev/urandom r] set bytes [read $fp 6] @@ -35,16 +36,89 @@ proc mysrc {script} { close $fp uplevel "#0" $ev } + +proc readfile {script} { + set fp [open $script r] + set ev [read $fp] + close $fp + return $ev +} + +proc readbfile {script} { + set fp [open $script rb] + set ev [read $fp] + close $fp + return $ev +} + +proc loadmodule {script} { + 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} { + 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 + # 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]] + # should not block for long + puts -nonewline $there $db + close $there + after 12500 catch [list file delete -- [format "%s.bk%s" $name $now]] + return +} + mysrc nda.tcl -::tie::tie nd file services.db +# every 40sec, save, but not if never written + +set lastsave [clock seconds] + +if {[file exists [pwd]/services.db]} { + set nd [readbfile [format "%s/%s" [pwd] services.db]] +} + +set globwd [pwd] +set gettext [list] + +trace add variable nd [list write unset] [list save.db [format "%s/%s" [pwd] services.db]] + + +#::tie::tie nd file services.db + +source openconf2.tcl foreach {file} [lsort [glob ./core/*.tcl]] { mysrc $file } #mysrc services.conf -foreach {file} [lsort [glob ./modules/*.tcl]] { - mysrc $file + +proc svc.rehash {} { + global gettext + if {[file exists $::globwd/language.txt]} { + set languagefile [split [readfile [format "%s/%s" $::globwd language.txt]] "\n"] + foreach {line} $languagefile { + set ll [split $line " "] + set ltext [join [lrange $ll 1 end] " "] + dict set gettext [lindex $ll 0] $ltext + } + } + tnda set "openconf" [list] + mysrc $::globwd/services.conf } +svc.rehash +#by now we've loaded everything +callbind - evnt - "confloaded" loaded + +#load from cfg file, not here + +#foreach {file} [lsort [glob ./modules/*.tcl]] { +# mysrc $file +#} + vwait forever diff --git a/modules/0000-eggcompat.tcl b/modules/0000-eggcompat.tcl @@ -1,343 +0,0 @@ -source chanserv.conf - -#bind $::sock($::cs(netname)) mode "-" "+" bitchopcheck -#bind $::sock($::cs(netname)) mode "-" "-" protectopcheck -bind $::sock($::cs(netname)) join "-" "-" autoopcheck - -proc protectopcheck {mc ftp} { - set f [lindex $ftp 0 0] - set t [lindex $ftp 0 1] - set p [lindex $ftp 0 2] - if {"o"==$mc && ![channel get $t protectop]} {return} - if {"h"==$mc && ![channel get $t protecthalfop]} {return} - if {"v"==$mc && ![channel get $t protectvoice]} {return} - switch -- $mc { - "o" { - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] omn|omn $t]} { - $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] - } - } - "h" { - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { - $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] - } - } - "v" { - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { - $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] - } - } - } -} - -proc autoopcheck {c f} { - puts stdout "$c $f" - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |k $c]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +bb "*![tnda get "ident/$::netname($::sock($::cs(netname)))/$f"]@[tnda get "vhost/$::netname($::sock($::cs(netname)))/$f"] \$a:[tnda get "login/$::netname($::sock($::cs(netname)))/$f"]" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - $::maintype kick $::sock($::cs(netname)) 77 $c $f "Autokicked (+k attribute)" - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] n|] && [channel get $c operit]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |n $c] && [channel get $c autoop]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] m|] && [channel get $c operit]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |m $c] && [channel get $c autoop]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] a|]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] o|] && [channel get $c operit]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |o $c] && [channel get $c autoop]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] l|] && [channel get $c operit]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |l $c] && [channel get $c autohalfop]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] v|] && [channel get $c operit]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } - if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |v $c] && [channel get $c autovoice]} { - $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] - return - } -} - -proc bitchopcheck {mc ftp} { - set f [lindex $ftp 0] - set t [lindex $ftp 1] - set p [lindex $ftp 2] - puts stdout "$ftp" - if {[tnda get "pfx/owner"]==$mc && ![channel get $t bitch]} {return} - if {[tnda get "pfx/protect"]==$mc && ![channel get $t bitch]} {return} - if {"o"==$mc && ![channel get $t bitch]} {return} - if {"h"==$mc && ![channel get $t halfbitch]} {return} - if {"v"==$mc && ![channel get $t voicebitch]} {return} - switch -glob -- $mc { - "q" { - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] n|n $t]} { - puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" - $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] - } - } - "a" { - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] mn|mn $t]} { - puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" - $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] - } - } - "o" { - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] aomn|omn $t]} { - puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" - $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] - } - } - "h" { - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { - puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" - $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] - } - } - "v" { - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { - puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" - $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] - } - } - } -} - -proc utimer {seconds tcl-command} {after [expr $seconds * 1000] ${tcl-command}} -proc timer {minutes tcl-command} {after [expr $minutes * 60 * 1000] ${tcl-command}} -proc utimers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} -proc timers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} -proc killtimer id {return [after cancel $id]} -proc killutimer id {return [after cancel $id]} -proc ndaenc {n} { - return [string map {/ [} [::base64::encode [string tolower $n]]] -} - -proc isbotnick {n} {return [expr {$n == $::botnick}]} - -proc putserv {msg} { - puts $::sock($::cs(netname)) ":$::botnick $msg" - puts stdout ":$::botnick $msg" -} - -proc puthelp {msg} { - puts $::sock($::cs(netname)) ":$::botnick $msg" -} - -proc putquick {msg} { - puts $::sock($::cs(netname)) ":$::botnick $msg" -} - -proc putnow {msg} { - puts $::sock($::cs(netname)) ":$::botnick $msg" -} - -proc ndadec {n} { - return [::base64::decode [string map {[ /} $n]] -} - -proc msgmt {from msg} { - set handle [lindex $msg 0 0] - set attr [lindex $msg 0 1] - set chan [lindex $msg 0 2] - $::maintype notice $::sock($::cs(netname)) 77 $from "$handle $attr $chan Matchattr result: [matchattr $handle $attr $chan]" -} - -bind $::sock($::cs(netname)) msg 77 "matchattr" msgmt - -proc matchattr {handle attr {chan "*"}} { - set handle [string tolower $handle] - if {-1!=[string first "&" $attr]} {set and 1} {set and 0} - set gattr [lindex [split $attr "&|"] 0] - set cattr [lindex [split $attr "&|"] 1] - set isattrg 0 - foreach {c} [split [nda get "eggcompat/attrs/global/$handle"] {}] { - foreach {k} [split $gattr {}] { - if {$c == $k} {set isattrg 1} - } - } - set isattrc 0 - if {"*"!=$chan} { - foreach {c} [split [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"] {}] { - foreach {k} [split $cattr {}] { - if {$c == $k} {set isattrc 1} - } - } - } - if {$and && ($isattrg == $isattrc) && ($isattrc == 1)} {return 1} - if {!$and && ($isattrg || $isattrc)} {return 1} - return 0 -} - -proc chattr {handle attr {chan "*"}} { - set handle [string tolower $handle] - if {$chan == "*"} { - set del [list] - set app "" - set state app - foreach {c} [split $attr {}] { - if {"+"==$c} {set state app;continue} - if {"-"==$c} {set state del;continue} - if {$state=="del"} { - lappend del $c "" - } - if {$state=="app"} { - lappend del $c "" - append app $c - } - } - nda set "eggcompat/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/global/$handle"]] $app] ""] - } { - set del [list] - set app "" - set state app - foreach {c} [split $attr {}] { - if {"+"==$c} {set state app;continue} - if {"-"==$c} {set state del;continue} - if {$state=="del"} { - lappend del $c "" - } - if {$state=="app"} { - lappend del $c "" - append app $c - } - } - puts stdout [ndaenc $chan] - nda set "eggcompat/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"]] $app] ""] - } -} - -proc channels {} { - foreach {chan _} [nda get "regchan"] { - lappend ret $chan - } - return $ret -} - -namespace eval channel { - proc ::channel::get {chan flag} { - if {[::set enda [nda get "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0} - } - proc ::channel::set {chan flags} { - if {[llength $flags] != 1} { - foreach {flag} $flags { - ::set bit [string index $flag 0] - if {$bit=="+"} {::set bitt 1} {::set bitt 0} - ::set flag [string range $flag 1 end] - nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt - } - } { - ::set bit [string index $flags 0] - if {$bit=="+"} {::set bitt 1} {::set bitt 0} - ::set flag [string range $flags 1 end] - nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt - } - } - namespace export * - namespace ensemble create -} - -proc validuser {n} { - if {""==[nda get "usernames/$n"]} {return 0} {return 1} -} - -bind $::sock($::cs(netname)) msg 77 "chanset" msgchanset -bind $::sock($::cs(netname)) msg 77 "chattr" msgchattr -bind $::sock($::cs(netname)) msg 77 "setxtra" msgxtra -set botnick $cs(nick) -chattr $cs(admin) +mnolv - -proc msgchanset {from msg} { - set ndacname [ndaenc [lindex $msg 0 0]] - set chanset [lindex $msg 0 1] - if {300>[nda get "regchan/$ndacname/levels/[string tolower [tnda get "login/$from"]]"] && ![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] m|m [lindex $msg 0 0]]} { - $::maintype notice $::sock($::cs(netname)) 77 $from "Only channel super-operators (300) and above and network masters may use eggdrop-compatible chansets." - return - } - channel set [lindex $msg 0 0] $chanset - $::maintype notice $::sock($::cs(netname)) 77 $from "Eggdrop compatible chanset $chanset set on [lindex $msg 0 0]." -} - -proc msgchattr {from msg} { - set ndacname [ndaenc [lindex $msg 0 2]] - set handle [lindex $msg 0 0] - set hand [lindex $msg 0 0] - set attrs [lindex $msg 0 1] - set chan [lindex $msg 0 2] - set ch [lindex $msg 0 2] - foreach {c} [split $attrs {}] { - if {$c == "+"} {continue} - if {$c == "-"} {continue} - if {$c == "k"} {set c "mn|mnol"} - if {$c == "v"} {set c "mn|lmno"} - if {$c == "l"} {set c "mn|mno"} - if {$c == "o"} {set c "mn|omn"} - if {$c == "m"} {set c "mn|mn"} - if {$c == "n"} {set c "n|n"} - if {$c == "a"} {set c "mn|"} - if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] $c $chan]} { - $::maintype notice $::sock($::cs(netname)) 77 $from "You may only give flags you already possess (Any of flags $c required to set $attrs)." - return - } - } - if {""==$chan} {chattr $hand $attrs} {chattr $hand $attrs $chan} - $::maintype notice $::sock($::cs(netname)) 77 $from "Global flags for $hand are now [nda get "eggcompat/attrs/global/[string tolower $handle]"]" - if {""==[nda get "regchan/$ndacname/levels/[string tolower $hand]"]} {nda set "regchan/$ndacname/levels/[string tolower $hand]" 1} - if {$ch != ""} {$::maintype notice $::sock($::cs(netname)) 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/attrs/$ndacname/[string tolower $handle]"]"} -} - -proc nick2hand {nick} { - foreach {uid nic} [tnda get "nick"] { - if {$nick == $nic} {return [tnda get "login/$::netname($::sock($::cs(netname)))/$uid"]} - } -} - -proc getuser {nick datafield {dataval "body"}} { - return [nda get "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]"] -} - -proc setuser {nick datafield {dataval "body"} val} { - return [nda set "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]" $val] -} - -proc msgxtra {from msg} { - if {[set log [tnda get "login/$::netname($::sock($::cs(netname)))/$from"]]==""} { - $::maintype notice $::sock($::cs(netname)) 77 $from "Until you've registered with the bot, you have no business setting XTRA values." - return - } - set subfield [lindex $msg 0 0] - set value [join [lrange [lindex $msg 0] 1 end] " "] - setuser $log "XTRA" $subfield $value - $::maintype notice $::sock($::cs(netname)) 77 $from "Set your user record XTRA $subfield to $value." -} - -proc chandname2name {channame} {return $channame} -proc channame2dname {channame} {return $channame} - -proc islinked {bot} {return 0} diff --git a/modules/0000-limitedeggcompat.tcl b/modules/0000-limitedeggcompat.tcl @@ -0,0 +1,360 @@ +#source chanserv.conf + +#bind $::sock($::cs(netname)) mode "-" "+" bitchopcheck +#bind $::sock($::cs(netname)) mode "-" "-" protectopcheck +#bind $::sock($::cs(netname)) join "-" "-" autoopcheck + +proc protectopcheck {mc f t p} { + if {"o"==$mc && ![channel get $t protectop]} {return} + if {"h"==$mc && ![channel get $t protecthalfop]} {return} + if {"v"==$mc && ![channel get $t protectvoice]} {return} + switch -- $mc { + "o" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] omn|omn $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + "h" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + "v" { + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { + $::maintype putmode $::sock($::cs(netname)) 77 $t +$mc "$p" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $t]/ts"] + } + } + } +} + +proc finduserbyid {n} { + tnda get "login/$::netname($::sock($::cs(netname)))/$f" +} + +proc autoopcheck {c f} { + set globe 0 + if {[channel get $c operit]} {set globe 1} + if {[channel get $c autoop]} {set auto nmo} {set auto ""} + if {[channel get $c autohalfop]} {append auto l} + if {[channel get $c autovoice]} {append auto v} + tcs:opcheck $c $f $globe $auto +} + +proc tcs:opcheck {c f {globe 0} {auto nmolv}} { +# puts stdout "$c $f" + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |k $c]} { + # obviously optimised for charybdis... ??? + $::maintype putmode $::sock($::cs(netname)) 77 $c +b "*![tnda get "ident/$::netname($::sock($::cs(netname)))/$f"]@[tnda get "vhost/$::netname($::sock($::cs(netname)))/$f"]" [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + $::maintype kick $::sock($::cs(netname)) 77 $c $f "Autokicked (+k attribute)" + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] n|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |n $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] m|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |m $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] a|]} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] o|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |o $c] && ([string first "o" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +o $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] l|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |l $c] && ([string first "h" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] v|] && $globe} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } + if {[matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$f"] |v $c] && ([string first "v" $auto] != -1)} { + $::maintype putmode $::sock($::cs(netname)) 77 $c +v $f [tnda get "channels/$::netname($::sock($::cs(netname)))/[ndaenc $c]/ts"] + return + } +} + +proc bitchopcheck {mc ftp} { + set f [lindex $ftp 0] + set t [lindex $ftp 1] + set p [lindex $ftp 2] + puts stdout "$ftp" + if {[tnda get "pfx/owner"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/owner"] != q} {set mc q}} + if {[tnda get "pfx/protect"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/protect"] != a} set mc a}} + if {"o"==$mc && ![channel get $t bitch]} {return} + if {"h"==$mc && ![channel get $t halfbitch]} {return} + if {"v"==$mc && ![channel get $t voicebitch]} {return} + switch -glob -- $mc { + "q" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] n|n $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "a" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] mn|mn $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "o" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] aomn|omn $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "h" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] l|l $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + "v" { + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$p"] v|v $t]} { + puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" + $::maintype putmode $::sock($::cs(netname)) 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] + } + } + } +} + +proc utimer {seconds tcl-command} {after [expr $seconds * 1000] ${tcl-command}} +proc timer {minutes tcl-command} {after [expr $minutes * 60 * 1000] ${tcl-command}} +proc utimers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} +proc timers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} +proc killtimer id {return [after cancel $id]} +proc killutimer id {return [after cancel $id]} + +proc isbotnick {n} {return [expr {$n == $::botnick}]} + + +set globctx "" + +proc setctx {ctx} { + global globctx + if {[catch [list set ::sock($ctx)] erre] > 0} {return} ; # silently crap out + set globctx $ctx +} + +proc curctx {type} { + if {$::globctx == ""} {return ""} + switch -exact -- [format ".%s" [string tolower $type]] { + .sock { + return $::sock($::globctx) + } + .net { + return $::globctx + } + .proto { + return $::nettype($::globctx) + } + } +} + +foreach {pname} [list putserv puthelp putquick putnow] { + proc $pname {msg} { + puts [curctx sock] [[curctx proto] formprefix [curctx net] $msg] + } +} + +proc msgmt {from msg} { + set handle [lindex $msg 0] + set attr [lindex $msg 1] + set chan [lindex $msg 2] + $::maintype notice $::sock($::cs(netname)) 77 $from "$handle $attr $chan Matchattr result: [matchattr $handle $attr $chan]" +} + +#bind $::sock($::cs(netname)) msg 77 "matchattr" msgmt + +proc matchattr {handle attr {chan "*"}} { + set handle [string tolower $handle] + if {-1!=[string first "&" $attr]} {set and 1} {set and 0} + set gattr [lindex [split $attr "&|"] 0] + set cattr [lindex [split $attr "&|"] 1] + set isattrg 0 + foreach {c} [split [nda get "eggcompat/attrs/global/$handle"] {}] { + foreach {k} [split $gattr {}] { + if {$c == $k} {set isattrg 1} + } + } + set isattrc 0 + if {"*"!=$chan} { + foreach {c} [split [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"] {}] { + foreach {k} [split $cattr {}] { + if {$c == $k} {set isattrc 1} + } + } + } + if {$and && ($isattrg == $isattrc) && ($isattrc == 1)} {return 1} + if {!$and && ($isattrg || $isattrc)} {return 1} + return 0 +} + +proc chattr {handle attr {chan "*"}} { + set handle [string tolower $handle] + if {$chan == "*"} { + set del [list] + set app "" + set state app + foreach {c} [split $attr {}] { + if {"+"==$c} {set state app;continue} + if {"-"==$c} {set state del;continue} + if {$state=="del"} { + lappend del $c "" + } + if {$state=="app"} { + lappend del $c "" + append app $c + } + } + nda set "eggcompat/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/global/$handle"]] $app] ""] + } { + set del [list] + set app "" + set state app + foreach {c} [split $attr {}] { + if {"+"==$c} {set state app;continue} + if {"-"==$c} {set state del;continue} + if {$state=="del"} { + lappend del $c "" + } + if {$state=="app"} { + lappend del $c "" + append app $c + } + } + puts stdout [ndaenc $chan] + nda set "eggcompat/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"]] $app] ""] + } +} + +proc channels {} { + foreach {chan _} [nda get "regchan"] { + lappend ret $chan + } + return $ret +} + +namespace eval channel { + proc ::channel::get {chan flag} { + if {[::set enda [nda get "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0} + } + proc ::channel::set {chan flags} { + if {[llength $flags] != 1} { + foreach {flag} $flags { + ::set bit [string index $flag 0] + if {$bit=="+"} {::set bitt 1} {::set bitt 0} + ::set flag [string range $flag 1 end] + nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt + } + } { + ::set bit [string index $flags 0] + if {$bit=="+"} {::set bitt 1} {::set bitt 0} + ::set flag [string range $flags 1 end] + nda set "eggcompat/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt + } + } + namespace export * + namespace ensemble create +} + +proc validuser {n} { + if {""==[nda get "usernames/$n"]} {return 0} {return 1} +} + +#bind $::sock($::cs(netname)) msg 77 "chanset" msgchanset +#bind $::sock($::cs(netname)) msg 77 "chattr" msgchattr +#bind $::sock($::cs(netname)) msg 77 "setxtra" msgxtra +#set botnick $cs(nick) +#chattr $cs(admin) +mnolv + +proc msgchanset {from msg} { + set ndacname [ndaenc [lindex $msg 0 0]] + set chanset [lindex $msg 0 1] + if {300>[nda get "regchan/$ndacname/levels/[string tolower [tnda get "login/$from"]]"] && ![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] m|m [lindex $msg 0 0]]} { + $::maintype notice $::sock($::cs(netname)) 77 $from "Only channel super-operators (300) and above and network masters may use eggdrop-compatible chansets." + return + } + channel set [lindex $msg 0 0] $chanset + $::maintype notice $::sock($::cs(netname)) 77 $from "Eggdrop compatible chanset $chanset set on [lindex $msg 0 0]." +} + +proc msgchattr {from msg} { + set ndacname [ndaenc [lindex $msg 0 2]] + set handle [lindex $msg 0 0] + set hand [lindex $msg 0 0] + set attrs [lindex $msg 0 1] + set chan [lindex $msg 0 2] + set ch [lindex $msg 0 2] + foreach {c} [split $attrs {}] { + if {$c == "+"} {continue} + if {$c == "-"} {continue} + if {$c == "k"} {set c "mn|mnol"} + if {$c == "v"} {set c "mn|lmno"} + if {$c == "l"} {set c "mn|mno"} + if {$c == "o"} {set c "mn|omn"} + if {$c == "m"} {set c "mn|mn"} + if {$c == "n"} {set c "n|n"} + if {$c == "a"} {set c "mn|"} + if {![matchattr [tnda get "login/$::netname($::sock($::cs(netname)))/$from"] $c $chan]} { + $::maintype notice $::sock($::cs(netname)) 77 $from "You may only give flags you already possess (Any of flags $c required to set $attrs)." + return + } + } + if {""==$chan} {chattr $hand $attrs} {chattr $hand $attrs $chan} + $::maintype notice $::sock($::cs(netname)) 77 $from "Global flags for $hand are now [nda get "eggcompat/attrs/global/[string tolower $handle]"]" + if {""==[nda get "regchan/$ndacname/levels/[string tolower $hand]"]} {nda set "regchan/$ndacname/levels/[string tolower $hand]" 1} + if {$ch != ""} {$::maintype notice $::sock($::cs(netname)) 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/attrs/$ndacname/[string tolower $handle]"]"} +} + +proc nick2hand {nick} { + foreach {uid nic} [tnda get "nick"] { + if {$nick == $nic} {return [tnda get "login/$::netname($::sock($::cs(netname)))/$uid"]} + } +} + +proc getuser {nick datafield {dataval "body"}} { + return [nda get "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]"] +} + +proc setuser {nick datafield {dataval "body"} val} { + return [nda set "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]" $val] +} + +proc msgxtra {from msg} { + if {[set log [tnda get "login/$::netname($::sock($::cs(netname)))/$from"]]==""} { + $::maintype notice $::sock($::cs(netname)) 77 $from "Until you've registered with the bot, you have no business setting XTRA values." + return + } + set subfield [lindex $msg 0 0] + set value [join [lrange [lindex $msg 0] 1 end] " "] + setuser $log "XTRA" $subfield $value + $::maintype notice $::sock($::cs(netname)) 77 $from "Set your user record XTRA $subfield to $value." +} + +proc chandname2name {channame} {return $channame} +proc channame2dname {channame} {return $channame} + +proc islinked {bot} {return 0} diff --git a/modules/0001-chanserv.tcl b/modules/chanserv.disabled diff --git a/modules/debugserv.tcl b/modules/debugserv.tcl @@ -0,0 +1,51 @@ +blocktnd debugserv + +bind - evnt - confloaded debugserv.connect + +proc debugserv.connect {arg} { + puts stdout [format "there are %s debugserv blocks" [set blocks [tnda get "openconf/[ndcenc debugserv]/blocks"]]] + for {set i 1} {$i < ($blocks + 1)} {incr i} { + 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.oneintro {headline block} { + set net [lindex $headline 0] + set nsock $::sock($net) + dictassign $block logchan logchan nick nick ident ident host host modes modes realname realname + setctx $net + $::nettype($net) sendUid $nsock $nick $ident $host $host [set ourid [$::nettype($net) getfreeuid $net]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes + tnda set "debugserv/$net/ourid" $ourid + bind $nsock pub - ".metadata" [list debugserv.pmetadata $net] + $::nettype($net) putjoin $nsock $ourid $logchan + after 500 [list $::nettype($net) putmode $nsock $ourid $logchan "+ao" [format "%s %s" [$::nettype($net) intclient2uid $net $ourid] [$::nettype($net) intclient2uid $net $ourid]]] + bind $nsock msg [tnda get "debugserv/$net/ourid"] "metadata" [list debugserv.metadata $net] + bind $nsock pub - "gettext" [list debugserv.gettext $net] + puts stdout "bind $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.gettext {n c i m} { + setctx $n + catch {$::nettype($n) privmsg [curctx sock] [tnda get "debugserv/$n/ourid"] $c [gettext {*}[split $m " "]]} +} + +proc debugserv.pmetadata {n c i m} { + # net chan id msg +# puts stdout "debugserv.pmetadata called $n $c $i $m" + catch [set command { + setctx $n + set metadatalist [tnda get "metadata/$n/$i"] +# puts stdout $metadatalist + foreach {.datum value} $metadatalist { + set datum [ndcdec ${.datum}] + $::nettype($n) [expr {$c != $i ? "privmsg" : "notice"}] [curctx sock] [tnda get "debugserv/$n/ourid"] $c [set totmsg [gettext debugserv.metadata $datum [$::nettype($n) uid2nick $n $i] $value]] + } }] zere +# puts stdout [curctx sock] +# puts stdout $command +# puts stdout $zere +} + +proc debugserv.metadata {n i m} { + debugserv.pmetadata $n $i $i $m +} diff --git a/modules/0004-limitserv.tcl b/modules/limitserv.disabled diff --git a/modules/0007-quote.tcl b/modules/quote.disabled diff --git a/modules/0008-relayserv.tcl b/modules/relayserv.disabled diff --git a/modules/0002-chanserv-thcserv.tcl b/modules/thcserv.disabled diff --git a/modules/0003-weather.tcl b/modules/weather.disabled diff --git a/nda.tcl b/nda.tcl @@ -1,6 +1,23 @@ +# This whole didgeridoo is legacy code and I need to kill it with fire! -array set nd {} -array set tnd {} +package require base64 +proc ndaenc {n} { + return [string map {/ [} [::base64::encode [string tolower $n]]] +} + +proc ndadec {n} { + return [::base64::decode [string map {[ /} $n]] +} + +proc ndcenc {n} { + return [string map {/ [} [::base64::encode $n]] +} + +proc ndcdec {n} { + return [::base64::decode [string map {[ /} $n]] +} + +set nd [set tnd [list]] namespace eval nda { proc ::nda::get {path} { @@ -10,16 +27,39 @@ namespace eval nda { return "" } ::set pathe [lrange $parr 1 end] - if {[info exists nd([lindex $parr 0])] && ![catch {dict get $nd([lindex $parr 0]) {*}$pathe} eee]} {return $eee} + if {[info exists nd] && ![catch {dict get $nd {*}$parr} eee]} {return $eee} {return ""} } + proc ::nda::set {path val} { global nd ::set parr [split $path "/"] if {[lindex $parr 0] == ""} { return "" } - ::set pathe [lrange $parr 1 end] - return [dict set nd([lindex $parr 0]) {*}$pathe $val] + return [dict set nd {*}$parr $val] + } + + proc ::nda::unset {path} { + global nd + ::set parr [split $path "/"] + if {[lindex $parr 0] == ""} { + return "" + } + return [dict unset nd {*}$parr] + } + + proc ::nda::incr {path} { + global nd + ::set parr [split $path "/"] + if {[lindex $parr 0] == ""} { + return "" + } + set orig [::nda::get $path] + if {[string is integer $orig]} { + ::nda::set $path [expr $orig+$inc] + } { + ::nda::set $path $inc + } } namespace export * @@ -33,8 +73,8 @@ namespace eval tnda { if {[lindex $parr 0] == ""} { return "" } - ::set pathe [lrange $parr 1 end] - if {[info exists tnd([lindex $parr 0])] && ![catch {dict get $tnd([lindex $parr 0]) {*}$pathe} eee]} {return $eee} + #::set pathe [lrange $parr 1 end] + if {[info exists tnd] && ![catch {dict get $tnd {*}$parr} eee]} {return $eee} {return ""} } proc ::tnda::set {path val} { global tnd @@ -42,10 +82,37 @@ namespace eval tnda { if {[lindex $parr 0] == ""} { return "" } - ::set pathe [lrange $parr 1 end] - return [dict set tnd([lindex $parr 0]) {*}$pathe $val] + #::set pathe [lrange $parr 1 end] + return [dict set tnd {*}$parr $val] + } + + proc ::tnda::unset {path} { + global tnd + ::set parr [split $path "/"] + if {[lindex $parr 0] == ""} { + return "" + } + return [dict unset tnd {*}$parr] + } + + proc ::tnda::incr {path {inc 1}} { + global tnd + ::set parr [split $path "/"] + if {[lindex $parr 0] == ""} { + return "" + } + ::set orig [::tnda::get $path] + if {[string is integer $orig]} { + ::tnda::set $path [expr $orig+$inc] + } { + ::tnda::set $path $inc + } } namespace export * namespace ensemble create } + +proc gettext {stringname args} { + format [dict get $::gettext $stringname] {*}$args +} diff --git a/openconf2.tcl b/openconf2.tcl @@ -0,0 +1,43 @@ +#!/usr/local/bin/env tclsh8.6 + +# OpenConf 2 + +proc blockwcb {blockname cb} { + proc $blockname {args} "$cb \$args" +} + +proc blocktnd {blockname} { + set programme [list \ + [list set blockname $blockname] \ + [list tnda incr [format "openconf/%s/blocks" [ndcenc $blockname]] ] \ + ] + set blockpro { + puts stdout $args + tnda set [format "openconf/%s/n%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] [lindex $args end] + if {[llength [lrange $args 0 end-1]] > 0} {tnda set [format "openconf/%s/hdr%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] [lrange $args 0 end-1]} + } + lappend programme $blockpro + proc $blockname {args} [join $programme "\n"] +} + +proc blocktndretfunc {blockname} { + set programme [list \ + [list set blockname $blockname] \ + [list tnda incr [format "openconf/%s/blocks" [ndcenc $blockname]] ] \ + ] + set blockpro { + puts stdout $args + tnda set [format "openconf/%s/n%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] [lindex $args end] + if {[llength [lrange $args 0 end-1]] > 0} {tnda set [format "openconf/%s/hdr%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] [lrange $args 0 end-1]} + } + lappend programme $blockpro + return [join $programme "\n"] +} ;#for making aliases of block procs + +proc postblock {blockname headlines block} { + set blockname $blockname + tnda incr [format "openconf/%s/blocks" [ndcenc $blockname]] + tnda set [format "openconf/%s/n%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] $block + if {[llength $headlines] > 0} {tnda set [format "openconf/%s/hdr%s" [ndcenc $blockname] [tnda get [format "openconf/%s/blocks" [ndcenc $blockname] ] ]] $headlines} +} + diff --git a/services.conf.example b/services.conf.example @@ -1,7 +1,31 @@ -set numeric "53" -set servername "channels." -set password "laoo,rpe" -set maintype ts6 -set sock [connect 127.0.0.1 4400 ::ts6::irc-main] -set netname($sock) "ast" -# Set a short network name; used for relaybawts +# TCLServ Config File + +# needs prefix for ts6 +network "pand" "services.invalid" { + host 127.0.0.1 port +6697 + numeric 53 + pass link + proto ts6 + prefix {*~&@%+ yqaohv} +} + +#old; +#set numeric "53" +#set servername "services.invalid" +#set password "link" +#set maintype ts6 +#set sock [connect 127.0.0.1 4400 ::ts6::irc-main] +#set netname($sock) "pand" + +loadmodule debugserv + +# module confs after here, load before here + +debugserv "pand" { + logchan #lounge + nick DebugServ + ident Debug + host services.umbrellix.net + modes +oiS + comment "Or +oiDS if you dont want it to hear channel convos" +} diff --git a/services.conf.old b/services.conf.old @@ -0,0 +1,7 @@ +set numeric "53" +set servername "services.invalid" +set password "link" +set maintype ts6 +set sock [connect 127.0.0.1 4400 ::ts6::irc-main] +set netname($sock) "pand" +# Set a short network name; used for relaybawts