commit 9e2b737750c78f8bb76a3cd9acc88af5e8c363d8
parent 8f08e635b2a5a5ebbd15ce876f8e1bdb1a5e9f79
Author: Ellenor Malik ellenor@umbrellix.net <j4jackj@gmx.com>
Date: Tue, 26 Jun 2018 15:47:07 -0700
ah stuff is just stuffed
Diffstat:
9 files changed, 513 insertions(+), 141 deletions(-)
diff --git a/core/0000-conn.tcl b/core/0000-conn.tcl
@@ -1,5 +1,8 @@
package require tls
+# just to have sanity here. don't want a {} dict or a bum array
+set $::netname(-) -
+
proc connect {addr port script} {
if {[string index $port 0] == "+"} { set port [string range $port 1 end] ; set comd ::tls::socket } {set comd socket}
set sck [$comd $addr $port]
@@ -8,13 +11,7 @@ proc connect {addr port script} {
return $sck
}
-proc mknetwork {a} {
- set headlines [lrange $a 0 end-1]
- set block [lindex $a end]
- if {[catch {set ::sock($servername)} result] == 0} {
- puts stdout "probably rehashing (duplicate network block, [tnda get rehashing], $result)"
- return
- }
+proc mknetwork {headlines block} {
if {[llength $headlines]<2} {
puts stdout "fuck it, block's invalid ($headlines)"
return
@@ -26,6 +23,12 @@ proc mknetwork {a} {
set port [dict get $block port]
set servername [lindex $headlines 1]
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)"
+ return
+ }
+ }
if {[dict exists $block prefixes]} {
# only required for ts6
set prefixes [split [dict get $block prefix] " "]
@@ -48,4 +51,15 @@ proc mknetwork {a} {
postblock network $headlines $block
}
-blockwcb network mknetwork
+proc core.conn.mknetworks {args} {
+ set blocks [tnda get "openconf/[ndcenc network]/blocks"]]
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ after 1000 [list mknetwork [tnda get [format "openconf/%s/hdr%s" [ndcenc network] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc network] $i]]]
+ }
+}
+
+blocktnd network
+
+llbind - evnt - confloaded core.conn.mknetworks
+
+#blockwcb network mknetwork
diff --git a/core/2000-protocol-common.tcl b/core/2000-protocol-common.tcl
@@ -1,20 +1,28 @@
-proc bind {sock type client comd script} {
+proc llbind {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}
+ set llbindnum [rand 1 100000000]
+ if {[tnda get "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]/$llbindnum"]!=""} {} {set moretodo 0}
}
- tnda set "binds/$sock/$type/$client/$comd/$bindnum" $script
- return $bindnum
+ tnda set "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]/$llbindnum" $script
+ return $llbindnum
}
-proc unbind {sock type client comd id} {
- tnda set "binds/$sock/$type/$client/$comd/$id" ""
+proc unllbind {sock type client comd id} {
+ tnda set "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]/$id" ""
+ tnda unset "llbinds/$::netname($sock)/$type/$client/[ndcenc $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"] {
+proc unllbindall {sock type client comd} {
+ tnda set "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]" ""
+ tnda unset "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]"
+}
+proc firellbind {sock type client comd args} {
+# puts stdout "$sock $type $client [ndcenc $comd] $args"
+ global globuctx globctx
+ set globctx $::netname($sck)
+ set globuctx $client
+ if {""!=[tnda get "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]"]} {
+ foreach {id script} [tnda get "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]"] {
if {$script != ""} {
set scr $script
# lappend $scr $sock
@@ -22,10 +30,10 @@ proc callbind {sock type client comd args} {
lappend scr $a
}
if {[catch {eval $scr} erre] > 0} {puts stdout $erre
- callbind $sock evnt - error $erre {*}$scr
+ firellbind $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}
+ #if {""!=[tnda get "llbinds/$type/-/[ndcenc $comd]"]} {foreach {id script} [tnda get "llbinds/$type/-/[ndcenc $comd]"] {$script [lindex $args 0] [lrange $args 1 end]};return}
}
diff --git a/core/2003-ts6.tcl b/core/2003-ts6.tcl
@@ -252,7 +252,12 @@ proc ::ts6::quitstorm {sck sid comment {doinit 1}} {
proc ::ts6::irc-main {sck} {
global sid sock socksid
- if {[eof $sck]} {close $sck}
+ if {[eof $sck]} {
+ putl stdout "We're dead, folks."
+# firellbind $sck evnt "-" "ts6.dead" $::netname($sck) $sck
+ firellbind $sck evnt "-" "dead" $::netname($sck) $sck
+ close $sck
+ }
gets $sck line
setctx $::netname($sck)
#puts stdout $line
@@ -281,8 +286,8 @@ proc ::ts6::irc-main {sck} {
# 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
+ firellbind $sck evnt "-" "ts6.alive" $::netname($sck) ;#obvious
+ firellbind $sck evnt "-" "alive" $::netname($sck) ;#obvious
}
"SID" {
@@ -300,8 +305,8 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck evnt "-" "ts6.dead" $::netname($sck)
+ firellbind $sck evnt "-" "dead" $::netname($sck)
return
}
# Mark all servers with an uplink in failedservers as split
@@ -312,8 +317,8 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck part "-" "-" [ndadec $chan] $uidd $::netname($sck)
+# firellbind $sck cquit "-" "-" [ndadec $chan] $uidd $::netname($sck)
tnda set "userchan/$::netname($sck)/$uidd/$chan" 0
}
@@ -328,7 +333,7 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck quit "-" "-" $uidd $::netname($sck)
}
}
}
@@ -377,12 +382,12 @@ proc ::ts6::irc-main {sck} {
"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
+ firellbind $sck pub "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ firellbind $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
+ firellbind $sck msg $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ firellbind $sck "evnt" "-" "privmsg" [lindex $comd 0] [lindex $comd 2] $payload
}
}
@@ -390,13 +395,13 @@ proc ::ts6::irc-main {sck} {
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
+ firellbind $sck pubnotc "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+# firellbind $sck pubnotc-m "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ firellbind $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
+ firellbind $sck notc $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
}
}
@@ -414,8 +419,8 @@ proc ::ts6::irc-main {sck} {
"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)
+ if {""==[tnda get "channels/$::netname($sck)/$chan/ts"]} {firellbind $sck create "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck)}
+ firellbind $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
}
@@ -427,7 +432,7 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck mode - + $type [lindex $comd 0] [lindex $comd 3] $mask $::netname($sck)
}
}
@@ -440,9 +445,9 @@ proc ::ts6::irc-main {sck} {
} 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)
+ firellbind $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)
+ firellbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] "" $::netname($sck)
}
}
}
@@ -476,11 +481,11 @@ proc ::ts6::irc-main {sck} {
# 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)
+ firellbind $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)
+ firellbind $sck mode "-" + $c $un [lindex $comd 3] $un $::netname($sck)
}
}
}
@@ -488,13 +493,13 @@ proc ::ts6::irc-main {sck} {
}
"PART" {
- callbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0] $::netname($sck)
+ firellbind $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)
+ firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3] $::netname($sck)
}
"NICK" {
@@ -528,7 +533,7 @@ proc ::ts6::irc-main {sck} {
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]
+ firellbind $sck conn "-" "-" [lindex $comd $num]
}
"KLINE" {putloglev k * [format "KLINE: %s" $line]}
@@ -538,7 +543,7 @@ proc ::ts6::irc-main {sck} {
switch -nocase -- [lindex $comd 3] {
"SASL" {
# we have to support sasl messages, so...
- callbind $sck encap - "sasl" [lrange $comd 4 end]
+ firellbind $sck encap - "sasl" [lrange $comd 4 end]
#don't bother
}
"KLINE" {
@@ -547,23 +552,23 @@ proc ::ts6::irc-main {sck} {
"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}
+ if {$payload == ""} {firellbind $sck logout "-" "-" [lindex $comd 4]} {firellbind $sck login "-" "-" [lindex $comd 4] $payload}
}
"CERTFP" {
tnda set "certfps/$::netname($sck)/[lindex $comd 0]" $payload
- callbind $sck encap "-" "certfp" [lindex $comd 0] $payload
+ firellbind $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
+ firellbind $sck encap "-" "metadata.[string tolower [lindex $comd 6]]" [lindex $comd 5] $payload
+ firellbind $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] ""
+ firellbind $sck encap "-" "metadata.[string tolower $payload]" [lindex $comd 5] ""
+ firellbind $sck mark "-" $payload [lindex $comd 5] ""
# WARNING!!!! Pick ONE. The official scripts use MARK; you should too.
}
}
@@ -572,7 +577,7 @@ proc ::ts6::irc-main {sck} {
}
"TOPIC" {
- callbind $sck topic "-" "-" [lindex $comd 2] [join $payload " "]
+ firellbind $sck topic "-" "-" [lindex $comd 2] [join $payload " "]
}
"QUIT" {
if {![string is digit [string index [lindex $comd 0] 0]]} {
@@ -582,7 +587,7 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck part "-" "-" [ndadec $chan] [lindex $comd 0] $::netname($sck)
tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0
}
@@ -596,12 +601,12 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $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]
+ firellbind $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]"
@@ -614,7 +619,7 @@ proc ::ts6::irc-main {sck} {
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)
+ firellbind $sck quit "-" "-" [lindex $comd 2] $::netname($sck)
}
"ERROR" {
@@ -653,10 +658,12 @@ proc ::ts6::irc-main {sck} {
#puts stdout [join [list $erreno $erreur] " "]
}
-proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servername services.invalid}} {
+# irrelevant parameters should simply be ignored.
+proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servername services.invalid} {cfg {}}} {
set num [string repeat "0" [expr {3-[string length [::ts6::b64e $osid]]}]]
append num [::ts6::b64e $osid]
global netname sid sock nettype socksid snames
+ dictassign $cfg euid useeuid gecos gecos
set snames($sck) $servername
set netname($sck) $servname
set nettype($servname) ts6
@@ -665,78 +672,81 @@ proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servernam
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}
+ #if {$halfops == ""} {tnda set "pfx/halfop" v} {tnda set "pfx/halfop" $halfops}
+ #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 "ts6/$::netname($sck)/euid" 1} {tnda set "ts6/$::netname($sck)/euid" $useeuid}
+
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
+ llbind $sck mode - + ::ts6::checkop
+ llbind $sck mode - - ::ts6::checkdeop
chan event $sck readable [list ::ts6::irc-main $sck]
}
#source services.conf
-proc ::ts6::nick2uid {netname nick} {
+proc ::ts6::nick2uid {sck nick} {
foreach {u n} [tnda get "nick/$netname"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
+ return ""
}
-proc ::ts6::intclient2uid {netname nick} {
+proc ::ts6::intclient2uid {sck nick} {
foreach {u n} [tnda get "intclient/$netname"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
+ return ""
}
-proc ::ts6::uid2nick {netname u} {
- return [tnda get "nick/$netname/$u"]
+proc ::ts6::uid2nick {sck u} {
+ return [tnda get "nick/$::netname($sck)/$u"]
}
-proc ::ts6::uid2rhost {netname u} {
- return [tnda get "rhost/$netname/$u"]
+proc ::ts6::uid2rhost {sck u} {
+ return [tnda get "rhost/$::netname($sck)/$u"]
}
-proc ::ts6::uid2host {netname u} {
- return [tnda get "vhost/$netname/$u"]
+proc ::ts6::uid2host {sck u} {
+ return [tnda get "vhost/$::netname($sck)/$u"]
}
-proc ::ts6::uid2ident {netname u} {
- return [tnda get "ident/$netname/$u"]
+proc ::ts6::uid2ident {sck u} {
+ return [tnda get "ident/$::netname($sck)/$u"]
}
-proc ::ts6::nick2host {netname nick} {
- return [tnda get "vhost/$netname/[nick2uid $netname $nick]"]
+proc ::ts6::nick2host {sck nick} {
+ return [tnda get "vhost/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc ::ts6::nick2ident {netname nick} {
- return [tnda get "ident/$netname/[nick2uid $netname $nick]"]
+proc ::ts6::nick2ident {sck nick} {
+ return [tnda get "ident/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc ::ts6::nick2rhost {netname nick} {
- return [tnda get "rhost/$netname/[nick2uid $netname $nick]"]
+proc ::ts6::nick2rhost {sck nick} {
+ return [tnda get "rhost/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc ::ts6::nick2ipaddr {netname nick} {
- return [tnda get "ipaddr/$netname/[nick2uid $netname $nick]"]
+proc ::ts6::nick2ipaddr {sck nick} {
+ return [tnda get "ipaddr/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc ::ts6::getts {netname chan} {
- return [tnda get "channels/$netname/[ndaenc $chan]/ts"]
+proc ::ts6::getts {sck chan} {
+ return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/ts"]
}
-proc ::ts6::getpfx {netname chan nick} {
- return [tnda get "channels/$netname/[ndaenc $chan]/modes/[::ts6::nick2uid $netname $nick]"]
+proc ::ts6::getpfx {sck chan nick} {
+ return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/[::ts6::nick2uid $netname $nick]"]
}
-proc ::ts6::getupfx {netname chan u} {
- return [tnda get "channels/$netname/[ndaenc $chan]/modes/$u"]
+proc ::ts6::getupfx {sck chan u} {
+ return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/$u"]
}
-proc ::ts6::getpfxchars {netname modes} {
+proc ::ts6::getpfxchars {sck modes} {
set o ""
foreach {c} [split $modes {}] {
- append o [nda get "ts6/$netname/prefix/$c"]
+ append o [nda get "ts6/$::netname($sck)/prefix/$c"]
}
return $o
}
-proc ::ts6::getmetadata {netname nick metadatum} {
- return [tnda get "metadata/$netname/[::ts6::nick2uid $netname $nick]/[ndcenc $metadatum]"]
+proc ::ts6::getmetadata {sck nick metadatum} {
+ return [tnda get "metadata/$::netname($sck)/[::ts6::nick2uid $netname $nick]/[ndcenc $metadatum]"]
}
-proc ::ts6::getcertfp {netname nick} {
- return [tnda get "certfps/$netname/[::ts6::nick2uid $netname $nick]"]
+proc ::ts6::getcertfp {sck nick} {
+ return [tnda get "certfps/$::netname($sck)/[::ts6::nick2uid $netname $nick]"]
}
proc ::ts6::checkop {mc s c p n} {
@@ -757,17 +767,17 @@ putcmdlog "down $mc $f $t $p $n"
tnda set "channels/$n/$chan/modes/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]]
}
-proc ::ts6::formprefix {netname nick} {
+proc ::ts6::formprefix {sck nick} {
return [format ":%s " $nick]
}
-proc ::ts6::uid2intclient {netname u} {
- return [tnda get "intclient/$netname/$u"]
+proc ::ts6::uid2intclient {sck u} {
+ return [tnda get "intclient/$::netname($sck)/$u"]
}
-proc ::ts6::getfreeuid {net} {
+proc ::ts6::getfreeuid {sck} {
set work 1
set cns [list]
-foreach {_ cnum} [tnda get "intclient/$net"] {lappend cns $cnum}
+foreach {_ cnum} [tnda get "intclient/$::netname($sck)"] {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/4000-eggcom.tcl b/core/4000-eggcom.tcl
@@ -1,8 +1,8 @@
#source chanserv.conf
-#bind [curctx sock] mode "-" "+" bitchopcheck
-#bind [curctx sock] mode "-" "-" protectopcheck
-#bind [curctx sock] join "-" "-" autoopcheck
+#llbind [curctx sock] mode "-" "+" bitchopcheck
+#llbind [curctx sock] mode "-" "-" protectopcheck
+#llbind [curctx sock] join "-" "-" autoopcheck
proc protectopcheck {mc f t p} {
if {"o"==$mc && ![channel get $t protectop]} {return}
@@ -147,10 +147,10 @@ proc timers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after in
proc killtimer id {return [after cancel $id]}
proc killutimer id {return [after cancel $id]}
-proc isbotnick {n} {return [expr {$n == $::botnick}]}
-
+proc isbotnick {n} {return [expr {$n == $::globuctx}]}
set globctx ""
+set globuctx ""
proc setctx {ctx} {
global globctx
@@ -158,6 +158,18 @@ proc setctx {ctx} {
set globctx $ctx
}
+proc setuctx {ctx} {
+ global globuctx
+ if {[% nick2uid $ctx] == ""} {return} ; # silently crap out
+ set globuctx [% uid2intclient [% nick2uid $ctx]]
+}
+
+proc % {c args} {
+ set ul [list [curctx proto] $c [curctx sock]]
+ foreach {a} $args {lappend ul $a}
+ uplevel 1 $a
+}
+
proc curctx {{type .net}} {
if {$::globctx == ""} {return ""}
switch -exact -- [format ".%s" [string tolower $type]] {
@@ -167,6 +179,15 @@ proc curctx {{type .net}} {
.net {
return $::globctx
}
+ .unum {
+ return $::globuctx
+ }
+ .uid {
+ return [% intclient2uid $::globuctx]
+ }
+ .user {
+ return [% uid2nick [% intclient2uid $::globuctx]]
+ }
.proto {
return $::nettype($::globctx)
}
@@ -175,7 +196,7 @@ proc curctx {{type .net}} {
foreach {pname} [list putserv puthelp putquick putnow] {
proc $pname {msg} {
- puts [curctx sock] [[curctx proto] formprefix [curctx net] $msg]
+ puts [curctx sock] [[curctx proto] formprefix [curctx sock] $msg]
}
}
@@ -186,7 +207,7 @@ proc msgmt {from msg} {
[curctx proto] notice [curctx sock] 77 $from "$handle $attr $chan Matchattr result: [matchattr $handle $attr $chan]"
}
-#bind [curctx sock] msg 77 "matchattr" msgmt
+#llbind [curctx sock] msg 77 "matchattr" msgmt
proc matchattr {handle attr {chan "*"}} {
set handle [string tolower $handle]
@@ -194,14 +215,14 @@ proc matchattr {handle attr {chan "*"}} {
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 {c} [split [nda get "eggcompat/[curctx net]/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 {c} [split [nda get "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle"] {}] {
foreach {k} [split $cattr {}] {
if {$c == $k} {set isattrc 1}
}
@@ -229,7 +250,7 @@ proc chattr {handle attr {chan "*"}} {
append app $c
}
}
- nda set "eggcompat/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/global/$handle"]] $app] ""]
+ nda set "eggcompat/[curctx net]/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/[curctx net]/attrs/global/$handle"]] $app] ""]
} {
set del [list]
set app ""
@@ -246,7 +267,7 @@ proc chattr {handle attr {chan "*"}} {
}
}
puts stdout [ndaenc $chan]
- nda set "eggcompat/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/attrs/[ndaenc $chan]/$handle"]] $app] ""]
+ nda set "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle"]] $app] ""]
}
}
@@ -259,7 +280,7 @@ proc channels {} {
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}
+ if {[::set enda [nda get "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0}
}
proc ::channel::set {chan flags} {
if {[llength $flags] != 1} {
@@ -267,13 +288,13 @@ namespace eval channel {
::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
+ nda set "eggcompat/[curctx net]/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
+ nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt
}
}
namespace export *
@@ -284,9 +305,9 @@ proc validuser {n} {
if {""==[nda get "usernames/$n"]} {return 0} {return 1}
}
-#bind [curctx sock] msg 77 "chanset" msgchanset
-#bind [curctx sock] msg 77 "chattr" msgchattr
-#bind [curctx sock] msg 77 "setxtra" msgxtra
+#llbind [curctx sock] msg 77 "chanset" msgchanset
+#llbind [curctx sock] msg 77 "chattr" msgchattr
+#llbind [curctx sock] msg 77 "setxtra" msgxtra
#set botnick $cs(nick)
#chattr $cs(admin) +mnolv
@@ -324,9 +345,9 @@ proc msgchattr {from msg} {
}
}
if {""==$chan} {chattr $hand $attrs} {chattr $hand $attrs $chan}
- [curctx proto] notice [curctx sock] 77 $from "Global flags for $hand are now [nda get "eggcompat/attrs/global/[string tolower $handle]"]"
+ [curctx proto] notice [curctx sock] 77 $from "Global flags for $hand are now [nda get "eggcompat/[curctx net]/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 != ""} {[curctx proto] notice [curctx sock] 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/attrs/$ndacname/[string tolower $handle]"]"}
+ if {$ch != ""} {[curctx proto] notice [curctx sock] 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/[curctx net]/attrs/$ndacname/[string tolower $handle]"]"}
}
proc nick2hand {nick} {
@@ -363,7 +384,6 @@ proc channame2dname {channame} {return $channame}
proc islinked {bot} {return 0}
-
proc operHasPrivilege {n i p} {
# this bit requires irca.
set metadatum [tnda get "metadata/$n/$i/[ndcenc PRIVS]"]
@@ -399,9 +419,26 @@ proc ishalf {chan id} {
}
proc ismode {chan id mode} {
- if {[string first $mode [[curctx proto] getupfx [curctx net] $chan $id]] != -1} {return 1} {return 0}
+ if {[string first $mode [[curctx proto] getupfx [curctx sock] $chan $id]] != -1} {return 1} {return 0}
}
proc ismodebutnot {chan id mode} {
- if {[string length [[curctx proto] getupfx [curctx net] $chan $id]] > 0 && [string first $mode [[curctx proto] getupfx [curctx net] $chan $id]] == -1} {return 1} {return 0}
+ if {[string length [[curctx proto] getupfx [curctx sock] $chan $id]] > 0 && [string first $mode [[curctx proto] getupfx [curctx sock] $chan $id]] == -1} {return 1} {return 0}
+}
+
+# rules are odd. you should store the bind return in a variable to unbind it.
+# flags aren't part of the bind define.
+proc bind {type flag text script} {
+ set ctxsock [curctx sock]
+ set ctxuser [curctx unum]
+ return [llbind $ctxsock $type $ctxuser [list matchthenrun $ctxsock $ctxuser $flag $script]]
+}
+
+proc matchthenrun {sock user flags script args} {
+ #setctx $sock
+ foreach {a} $args {
+ lappend script $a
+ }
+# matchattr [uid2hand $user] $flags
+ eval $script
}
diff --git a/main.tcl b/main.tcl
@@ -65,8 +65,10 @@ proc save.db {name var no oper} {
# 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]]
+ chan configure $there -blocking 0 -buffering full -buffersize 8192
# should not block for long
puts -nonewline $there $db
+ flush $there
close $there
after 12500 [list catch [list file delete -- [format "%s.bk%s" $name $now]]]
return
diff --git a/modules/debugserv.tcl b/modules/debugserv.tcl
@@ -1,6 +1,6 @@
blocktnd debugserv
-bind - evnt - confloaded debugserv.connect
+llbind - evnt - confloaded debugserv.connect
proc debugserv.connect {arg} {
puts stdout [format "there are %s debugserv blocks" [set blocks [tnda get "openconf/[ndcenc debugserv]/blocks"]]]
@@ -39,10 +39,11 @@ proc debugserv.oneintro {headline block} {
tnda set "debugserv/$net/logchan" $logchan
#tnda set "debugserv/$net/nspass" $nspass
setctx $net
- $::nettype($net) sendUid $nsock $nick $ident $host $host [set ourid [$::nettype($net) getfreeuid $net]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes
+ if {[% intclient2uid [tnda get "debugserv/$net/ourid"]] == ""} {$::nettype($net) sendUid $nsock $nick $ident $host $host [set ourid [$::nettype($net) getfreeuid $net]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes}
+ setuctx $nick
tnda set "debugserv/$net/ourid" $ourid
- bind $nsock pub - ".metadata" [list debugserv.pmetadata $net]
-# bind $nsock pub - ".rehash" [list debugserv.crehash $net]
+ 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] [$::nettype($net) nick2uid $net $nickserv]] == 0} {
@@ -53,10 +54,10 @@ proc debugserv.oneintro {headline block} {
}
after 650 $::nettype($net) putjoin $nsock $ourid $logchan
after 700 [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 msg [tnda get "debugserv/$net/ourid"] "rehash" [list debugserv.rehash $net]
-# bind $nsock pub - "gettext" [list debugserv.gettext $net]
- puts stdout "bind $nsock msg [tnda get "debugserv/$net/ourid"] metadata [list debugserv.metdata $net]"
+ 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]
+ 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]
}
diff --git a/modules/0000-limitedeggcompat.tcl b/modules/nope.egg.nope
diff --git a/modules/quoteserv.tcl b/modules/quoteserv.tcl
@@ -3,7 +3,7 @@ blocktnd qshelp
source quoteserv.help
-bind - evnt - confloaded quoteserv.connect
+llbind - evnt - confloaded quoteserv.connect
proc quoteserv.connect {arg} {
puts stdout [format "there are %s quoteserv blocks" [set blocks [tnda get "openconf/[ndcenc quoteserv]/blocks"]]]
@@ -41,8 +41,8 @@ proc quoteserv.oneintro {headline block} {
setctx $net
$::nettype($net) sendUid $nsock $nick $ident $host $host [set ourid [$::nettype($net) getfreeuid $net]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes
tnda set "quoteserv/[curctx net]/ourid" $ourid
-# bind $nsock pub - ".metadata" [list quoteserv.pmetadata $net]
-# bind $nsock pub - ".rehash" [list quoteserv.crehash $net]
+# llbind $nsock pub - ".metadata" [list quoteserv.pmetadata $net]
+# llbind $nsock pub - ".rehash" [list quoteserv.crehash $net]
if {[string length $nspass] != 0 && [string length $nickserv] != 0} {
# only works if nettype is ts6!
if {[string first [quoteserv.find6sid $net $nsserv] [$::nettype($net) nick2uid $net $nickserv]] == 0} {
@@ -53,13 +53,13 @@ proc quoteserv.oneintro {headline block} {
}
after 650 $::nettype($net) putjoin $nsock $ourid $logchan
after 700 [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 "quoteserv/[curctx net]/ourid"] "metadata" [list quoteserv.metadata $net]
-# bind $nsock msg [tnda get "quoteserv/[curctx net]/ourid"] "rehash" [list quoteserv.rehash $net]
-# bind $nsock pub - "gettext" [list quoteserv.gettext $net]
-# puts stdout "bind $nsock msg [tnda get "quoteserv/[curctx net]/ourid"] metadata [list quoteserv.metdata $net]"
+# llbind $nsock msg [tnda get "quoteserv/[curctx net]/ourid"] "metadata" [list quoteserv.metadata $net]
+# llbind $nsock msg [tnda get "quoteserv/[curctx net]/ourid"] "rehash" [list quoteserv.rehash $net]
+# llbind $nsock pub - "gettext" [list quoteserv.gettext $net]
+# puts stdout "llbind $nsock msg [tnda get "quoteserv/[curctx net]/ourid"] metadata [list quoteserv.metdata $net]"
puts stdout [format "Connected for %s: %s %s %s" $net $nick $ident $host]
- bind $nsock pub - "!quote" [list quoteservdo $net]
- bind $nsock evnt - privmsg [list qs.pmdo $net]
+ llbind $nsock pub - "!quote" [list quoteservdo $net]
+ llbind $nsock evnt - privmsg [list qs.pmdo $net]
puts stdout $::nd
foreach {chan is} [nda get "quoteserv/[curctx net]/regchan"] {
puts stdout "to join $chan on [curctx]"
diff --git a/modules/weather.tcl b/modules/weather.tcl
@@ -0,0 +1,300 @@
+blocktnd weatherserv
+blocktnd wshelp
+
+source weatherserv.help
+
+llbind - evnt - confloaded weatherserv.connect
+
+proc weatherserv.connect {arg} {
+ puts stdout [format "there are %s weatherserv blocks" [set blocks [tnda get "openconf/[ndcenc weatherserv]/blocks"]]]
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ after 1000 [list weatherserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc weatherserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc weatherserv] $i]]]
+ }
+}
+
+proc weatherserv.find6sid {n s {hunting 0}} {
+ # we're trying to get the sid of the server named $s
+ # if hunting, we're looking for the first splat match
+ set servs [tnda get "servers/$n"]
+ foreach {.k dv} $servs {
+ set k [string toupper [ndadec ${.k}]]
+ # name description uplink sid - we only need two
+ dictassign $dv name sname
+ if {$hunting} {
+ if {[string match [string tolower $s] [string tolower $sname]] == 1} {return $k}
+ } {
+ if {[string tolower $s] == [string tolower $sname]} {return $k}
+ }
+ }
+ return ""
+}
+
+proc weatherserv.oneintro {headline block} {
+ set net [lindex $headline 0]
+ set nsock $::sock($net)
+ setctx $net
+ dictassign $block logchan logchan nick nick ident ident host host modes modes realname realname operflags rehashprivs idcommand nspass \
+ nickserv nickserv nsserv nsserv
+ tnda set "weather/[curctx net]/operflags" $rehashprivs
+ tnda set "weather/[curctx net]/logchan" $logchan
+ #tnda set "weather/[curctx net]/nspass" $nspass
+ setctx $net
+ $::nettype($net) sendUid $nsock $nick $ident $host $host [set ourid [$::nettype($net) getfreeuid $net]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes
+ tnda set "weather/[curctx net]/ourid" $ourid
+# llbind $nsock pub - ".metadata" [list weatherserv.pmetadata $net]
+# llbind $nsock pub - ".rehash" [list weatherserv.crehash $net]
+ if {[string length $nspass] != 0 && [string length $nickserv] != 0} {
+ # only works if nettype is ts6!
+ if {[string first [weatherserv.find6sid $net $nsserv] [$::nettype($net) nick2uid $net $nickserv]] == 0} {
+ $::nettype($net) privmsg $nsock $ourid $nickserv $nspass
+ } {
+ $::nettype($net) privmsg $nsock $ourid $logchan [gettext weatherserv.impostornickserv $nickserv [$::nettype($net) nick2uid $n $nickserv] $nsserv [weatherserv.find6sid $net $nsserv]]
+ }
+ }
+ after 650 [list $::nettype($net) putjoin $nsock $ourid $logchan]
+ after 950 [list $::nettype($net) putmode $nsock $ourid $logchan "+ao" [format "%s %s" [$::nettype($net) intclient2uid $net $ourid] [$::nettype($net) intclient2uid $net $ourid]]]
+# llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] "metadata" [list weatherserv.metadata $net]
+# llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] "rehash" [list weatherserv.rehash $net]
+# llbind $nsock pub - "gettext" [list weatherserv.gettext $net]
+# puts stdout "llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] metadata [list weatherserv.metdata $net]"
+ puts stdout [format "Connected for %s: %s %s %s" $net $nick $ident $host]
+ llbind $nsock pub - "!quote" [list weatherservdo $net]
+ llbind $nsock evnt - privmsg [list ws.pmdo $net]
+ puts stdout $::nd
+ foreach {chan is} [nda get "weather/[curctx net]/regchan"] {
+ puts stdout "to join $chan on [curctx]"
+ if {1!=$is} {continue}
+ weatherjoin [ndadec $chan] 0
+# [curctx proto] putjoin [curctx sock] [tnda get "weather/[curctx net]/ourid"] [::base64::decode [string map {[ /} $chan]] [nda get "regchan/$chan/ts"]
+# tnda set "channels/$chan/ts" [nda get "regchan/$chan/$::netname([curctx sock])/ts"]
+ }
+}
+
+#$::maintype sendUid [curctx sock] "W" "weather" "services." "services." 57 "Weather Services"
+llbind [curctx sock] request "w" "-" weatherjoin
+llbind [curctx sock] request "weather" "-" weatherjoin
+
+proc weatherjoin {chan {setting 1}} {
+ set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]]
+ puts stdout "to join $chan on [curctx]"
+ [curctx proto] putjoin [curctx sock] [tnda get "weather/[curctx net]/ourid"] $chan
+ [curctx proto] putmode [curctx sock] [tnda get "weather/[curctx net]/ourid"] $chan "+ao" \
+ [format "%s %s" [[curctx proto] intclient2uid [curctx net] [tnda get "weather/[curctx net]/ourid"]]\
+ [[curctx proto] intclient2uid [curctx net] [tnda get "weather/[curctx net]/ourid"]]]
+ if {$setting} {nda set "weather/[curctx net]/regchan/$ndacname" 1}
+}
+
+proc weatherpart {chan {who "the script"} {msg isunused}} {
+ set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]]
+ [curctx proto] putpart [curctx sock] [tnda get "weather/[curctx net]/ourid"] $chan [gettext weather.left $who]
+ nda set "weather/[curctx net]/regchan/$ndacname" 0
+ nda unset "weather/[curctx net]/regchan/$ndacname"
+}
+
+proc weatherenabled {chan} {
+ set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]]
+ if {[nda get "weather/[curctx net]/regchan/$ndacname"] == 1} {return 1} {return 0}
+}
+
+##############################################################################################
+## ## wunderground.tcl for eggdrop by Ford_Lawnmower irc.geekshed.net #Script-Help ## ##
+##############################################################################################
+## To use this script you must set channel flag +weather (ie .chanset #chan +weather) ##
+##############################################################################################
+##############################################################################################
+## ## Start Setup. ## ##
+##############################################################################################
+namespace eval wunderground {
+## Edit logo to change the logo displayed at the start of the line ## ##
+ variable logo "\017\00304\002W\00304u\00307n\00308d\00311e\00312r\00304g\00307r\00308o\00311u\00312n\00304d\017"
+## Edit textf to change the color/state of the text shown ## ##
+ variable textf "\017"
+## Edit tagf to change the color/state of the Tags: ## ##
+ variable tagf "\017\002"
+## Edit weatherline, line1, line2, line3, line4 to change what is displayed ## ##
+## weatherline is for the !weather trigger and line1-4 are for !forecast ## ##
+## Valid items are: location weatherstation conditions tempf tempc tempfc feelsf ## ##
+## feelsc feelsfc windgust windspeed winddirection sunset sunrise moon ## ##
+## day1 day2 day3 day4 day5 day6 day7 day8 day9 day10 ## ##
+## Do not remove any variables here! Just change them to "" to suppress display ## ##
+ variable line1 "location weatherstation conditions tempfc feelsfc windspeed winddirection windgust sunset sunrise moon"
+ variable line3 ""
+ variable line2 "day1 day2 day3 day4 day5 day6 day7 day8 day9 day10"
+ variable line4 ""
+ variable weatherline "location weatherstation conditions tempfc feelsfc windspeed winddirection windgust sunset sunrise moon day1 day2 day3"
+## Edit cmdchar to change the !trigger used to for this script ## ##
+ variable cmdchar "!"
+##############################################################################################
+## ## End Setup. ## ##
+##############################################################################################
+ llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]weather wunderground::tclservwe
+ llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]wz wunderground::tclservwe
+ llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]forecast wunderground::tclservfc
+}
+
+proc wunderground::tclservwe {n cname i msg} {
+ if {[weatherenabled $cname] == 0} {return}
+ set nick [tnda get "nick/$::netname([curctx sock])/$i"]
+ set host "[tnda get "ident/$i"]@[tnda get "vhost/$::netname([curctx sock])/$i"]"
+ set comd "weather"
+ set hand ""
+ set text $msg
+ wunderground::main $comd $nick $host $hand $cname $text
+}
+
+proc wunderground::tclservfc {n cname i msg} {
+ if {[weatherenabled $cname] == 0} {return}
+ set nick [tnda get "nick/$::netname([curctx sock])/$i"]
+ set host "[tnda get "ident/$i"]@[tnda get "vhost/$::netname([curctx sock])/$i"]"
+ set comd "forecast"
+ set hand ""
+ set text $msg
+ wunderground::main $comd $nick $host $hand $cname $text
+}
+
+proc wunderground::main {command nick host hand chan text} {
+ set search [strip $text]
+ set div ""; set moon ""; set sunset ""; set sunrise ""; set windspeed ""; set div ""
+ set winddirection ""; set location ""; set weatherstation ""; set temperature ""; set tempfc ""
+ set conditions ""; set feelslike ""; set feelsf ""; set feelsc ""; set city ""; set day ""
+ set details ""; set forc ""; set count 1; set tempf ""; set state_name ""; set tempc ""
+ set day1 ""; set day2 ""; set day3 ""; set day4 ""; set day5 ""; set state_name ""
+ set day6 ""; set day7 ""; set day8 ""; set day9 ""; set day10 ""; set windgust ""; set feelsfc ""
+ set wundergroundurl "/cgi-bin/findweather/hdfForecast?query=[urlencode $search]"
+ set wundergroundsite "www.wunderground.com"
+ if {"wz" == $command} {set command weather}
+ if {[catch {set wundergroundsock [socket -async $wundergroundsite 80]} sockerr]} {
+ return 0
+ } else {
+ puts $wundergroundsock "GET $wundergroundurl HTTP/1.0"
+ puts $wundergroundsock "Host: $wundergroundsite"
+ puts $wundergroundsock "User-Agent: Opera 9.6"
+ puts $wundergroundsock ""
+ flush $wundergroundsock
+ while {![eof $wundergroundsock]} {
+ set wundergroundvar " [gets $wundergroundsock] "
+ regexp -nocase {"(current)_observation":} $wundergroundvar match div
+ regexp -nocase {"(forecast)":} $wundergroundvar match div
+ regexp -nocase {"(astronomy)":} $wundergroundvar match div
+ if {[regexp -nocase {"city":"([^"]*)} $wundergroundvar match city]} {
+ if {$city == "null"} {
+ set city ""
+ }
+ } elseif {[regexp -nocase {"state_name":"([^"]*)} $wundergroundvar match state_name]} {
+ if {$state_name == "null"} {
+ set state_name ""
+ }
+ set location "${wunderground::tagf}Location: ${wunderground::textf}${city}, $state_name"
+ } elseif {[regexp -nocase {"name":"([^"]*)} $wundergroundvar match weatherstation]} {
+ set weatherstation "${wunderground::tagf}Station: ${wunderground::textf}${weatherstation}"
+ } elseif {$forc == "" && [regexp -nocase {class="wx-unit"> °(.*?)<\/span>} $wundergroundvar match forc]} {
+ } elseif {[regexp -nocase {"condition":"([^"]*)} $wundergroundvar match conditions]} {
+ set conditions "${wunderground::tagf}Conditions: ${wunderground::textf}${conditions}"
+ } elseif {$div == "current" && [regexp -nocase {"temperature":\s([^\,]*)} $wundergroundvar match temperature]} {
+ set tempf "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc F] deg F"
+ set tempc "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc C] deg C"
+ set tempfc "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc F] deg F/[forc ${temperature} $forc C] deg C"
+ } elseif {$div == "current" && [regexp -nocase {"feelslike":\s([^\,]*)} $wundergroundvar match feelslike]} {
+ set feelsf "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc F] deg F"
+ set feelsc "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc C] deg C"
+ set feelsfc "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc F] deg F/[forc ${feelslike} $forc C] deg C"
+ } elseif {$div == "current" && [regexp -nocase {"wind_speed":\s?([^\,]*)} $wundergroundvar match windspeed]} {
+ set windspeed "${wunderground::tagf}Wind speed: ${wunderground::textf}${windspeed}"
+ } elseif {$div == "current" && [regexp -nocase {"wind_gust_speed":\s?([^\,]*)} $wundergroundvar match windgust]} {
+ set windgust "${wunderground::tagf}Wind gust: ${wunderground::textf}${windgust}"
+ } elseif {[regexp -nocase {"wind_dir":"([^"]*)} $wundergroundvar match winddirection]} {
+ set winddirection "${wunderground::tagf}Wind Direction: ${wunderground::textf}${winddirection}"
+ } elseif {[regexp -nocase {id="cc-sun-rise">(.*?)</span>\s?<span class="ampm">(.*?)</span>} $wundergroundvar match sunrise ampm]} {
+ set sunrise "${wunderground::tagf}Sunrise: ${wunderground::textf}${sunrise}${ampm}"
+ } elseif {[regexp -nocase {id="cc-sun-set">(.*?)</span> <span class="ampm">(.*?)</span>} $wundergroundvar match sunset ampm]} {
+ set sunset "${wunderground::tagf}Sunset: ${wunderground::textf}${sunset}${ampm}"
+ } elseif {[regexp -nocase {id="cc-moon-phase".*">(.+?)<\/span>} $wundergroundvar match moon]} {
+ set moon "${wunderground::tagf}Moon: ${wunderground::textf}${moon}"
+ } elseif {$div == "forecast" && $command == "weather"} {
+ msg $chan $wunderground::logo ${wunderground::textf} [subst [regsub -all -nocase {(\S+)} $wunderground::weatherline {$\1}]]
+ close $wundergroundsock
+ return 0
+ } elseif {[regexp -nocase {<div\sclass="fctDayDate">(.+)\,} $wundergroundvar match day]} {
+ set day "${wunderground::tagf}${day}"
+ } elseif {[string match "forecast" $div]} {
+ if {[regexp -nocase {"weekday_short":\s?"([^"]*)} $wundergroundvar match day]} {
+ set day "${wunderground::tagf}${day}:->"
+ } elseif {[regexp -nocase {"high":\s([^\,]*)} $wundergroundvar match high]} {
+ set high "${wunderground::tagf}High:${wunderground::textf}[forc $high $forc F] deg F/[forc $high $forc C] deg C"
+ } elseif {[regexp -nocase {"low":\s([^\,]*)} $wundergroundvar match low]} {
+ set low "${wunderground::tagf}low:${wunderground::textf}[forc $low $forc F] deg F/[forc $low $forc C] deg C"
+ } elseif {[regexp -nocase {"condition":\s?"([^"]*)} $wundergroundvar match condition]} {
+ set condition "${wunderground::tagf}Cond:${wunderground::textf}${condition}"
+ } elseif {[regexp -nocase {"day":\s?\{} $wundergroundvar]} {
+ set day${count} "$day $high $low $condition"
+ incr count
+ }
+ } elseif {$div == "astronomy"} {
+ if {$wunderground::line1 != ""} {
+ msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line1 {$\1}]]
+ }
+ if {$wunderground::line2 != ""} {
+ msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line2 {$\1}]]
+ }
+ if {$wunderground::line3 != ""} {
+ msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line3 {$\1}]]
+ }
+ if {$wunderground::line4 != ""} {
+ msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line4 {$\1}]]
+ }
+ close $wundergroundsock
+ return 0
+ }
+ }
+ }
+}
+proc wunderground::forc {value fc forc} {
+ if {[string equal -nocase $fc $forc]} {
+ return $value
+ } elseif {[string equal -nocase "f" $fc]} {
+ if {[expr {(($value - 32) * 5)} == 0]} { return 0 }
+ return [format "%.1f" [expr {(($value - 32) * 5) / 9}]]
+ } elseif {[string equal -nocase "c" $fc]} {
+ if {$value == 0} { return 32 }
+ return [format "%.1f" [expr {(($value * 9) / 5) + 32}]]
+ }
+}
+proc wunderground::striphtml {string} {
+ return [string map {" \" < < &rt; >} [regsub -all {(<[^<^>]*>)} $string ""]]
+}
+proc wunderground::urlencode {string} {
+ regsub -all {^\{|\}$} $string "" string
+ return [subst [regsub -nocase -all {([^a-z0-9\+])} $string {%[format %x [scan "\\&" %c]]}]]
+}
+proc wunderground::strip {text} {
+ regsub -all {\002|\031|\015|\037|\017|\003(\d{1,2})?(,\d{1,2})?} $text "" text
+ return $text
+}
+proc wunderground::msg {chan logo textf text} {
+ set text [textsplit $text 50]
+ set counter 0
+ while {$counter <= [llength $text]} {
+ if {[lindex $text $counter] != ""} {
+ % privmsg [tnda get "weatherserv/[curctx net]/ourid"] $chan "${logo} ${textf}[string map {\\\" \"} [lindex $text $counter]]"
+ }
+ incr counter
+ }
+}
+proc wunderground::textsplit {text limit} {
+ set text [split $text " "]
+ set tokens [llength $text]
+ set start 0
+ set return ""
+ while {[llength [lrange $text $start $tokens]] > $limit} {
+ incr tokens -1
+ if {[llength [lrange $text $start $tokens]] <= $limit} {
+ lappend return [join [lrange $text $start $tokens]]
+ set start [expr $tokens + 1]
+ set tokens [llength $text]
+ }
+ }
+ lappend return [join [lrange $text $start $tokens]]
+ return $return
+}
+puts stdout "\002*Loaded* \00304\002W\00304u\00307n\00308d\00311e\00312r\00304g\00307r\00308o\00311u\00312n\00304d\017 \002by \
+Ford_Lawnmower irc.GeekShed.net #Script-Help"
