commit 8b24bba16430df875e211b86648120f35410f0b3
parent 6756637209c65761e1b5b429be7d3a37984922ba
Author: jaffacake <jaffacake@ronsor.(none)>
Date: Mon, 25 Aug 2014 07:56:41 +0000
P10N gold standard - also a "syn" which does gateway cloaking now exists.
Diffstat:
26 files changed, 1115 insertions(+), 2 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,5 @@
*.db
*.pem
scripts/
+*.motd
+
diff --git a/LICENSE.md b/LICENSE.md
diff --git a/README.md b/README.md
@@ -1,3 +1,3 @@
read the code, i'm too lazy to document this shite.
-one of the available scripts is a highly modified bmotion for tclserv. use at your own risk.
+you need php. no questions. you need php. you also need tcl, obviously. but you need php.
diff --git a/b64.tcl b/b64.tcl
diff --git a/chanserv.conf.example b/chanserv.conf.example
diff --git a/chanserv.help b/chanserv.help
diff --git a/core/0000-conn.tcl b/core/0000-conn.tcl
diff --git a/core/0002-p10.tcl b/core/0002-p10.tcl
@@ -1,6 +1,6 @@
namespace eval p10 {
-set sid [string repeat "A" [expr {2-[b64e $::numeric]}]]
+set sid [string repeat "A" [expr {2-[string length [b64e $::numeric]]}]]
append sid [b64e $::numeric]
proc ::p10::sendUid {sck nick ident host dhost uid {realname "* Unknown *"} {modes "+oik"} {server ""}} {
diff --git a/core/0003-ts6.tcl b/core/0003-ts6.tcl
diff --git a/core/0004-p10n.tcl b/core/0004-p10n.tcl
@@ -0,0 +1,356 @@
+
+namespace eval p10n {
+set sid [string repeat "A" [expr {2-[string length [b64e $::numeric]]}]]
+append sid [b64e $::numeric]
+
+proc ::p10n::sendUid {sck nick ident host dhost uid {realname "* Unknown *"} {modes "+oik"} {server ""}} {
+ if {""==$server} {set server $::numeric}
+ set sid [string repeat "A" [expr {2-[string length [b64e $server]]}]]
+ append sid [b64e $server]
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ set sl [format "%s N %s 1 %s %s %s %s AAAAAA %s%s :%s" $sid $nick [clock format [clock seconds] -format %s] $ident $host $modes $sid $sendnn $realname]
+ tnda set "intclient/$::netname($sck)/${sid}${sendnn}" $uid
+ puts $sck $sl
+}
+
+proc ::p10n::sendSid {sck sname sid {realname "In use by Services"}} {
+ set sl [format "%s S %s 2 %s %s P10 %s]]] 0 :%s" [b64e $::sid] $sname [clock format [clock seconds] -format %s] [clock format [clock seconds] -format %s] [b64e $sid] $realname]
+ puts $sck $sl
+}
+
+proc ::p10n::topic {sck uid targ topic} {
+ set sid [string repeat "A" [expr {2-[string length [b64e $::numeric]]}]]
+ append sid [b64e $::numeric]
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s T %s :%s" $sid $sendnn $targ $topic]
+}
+
+proc ::p10n::privmsg {sck uid targ msg} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s P %s :%s" $sid $sendnn $targ $msg]
+}
+
+proc ::p10n::kick {sck uid targ tn msg} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s K %s %s :%s" $sid $sendnn $targ $tn $msg]
+}
+
+proc ::p10n::kill {sck uid tn msg} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s D %s :%s" $sid $sendnn $tn $msg]
+}
+
+proc ::p10n::notice {sck uid targ msg} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s O %s :%s" $sid $sendnn $targ $msg]
+}
+
+proc ::p10n::setacct {sck targ msg} {
+ global sid
+ puts $sck [format "%s AC %s R %s" $sid $targ $msg]
+ tnda set "login/$::netname($sck)/$targ" $msg
+}
+
+proc ::p10n::putwallop {sck msg} {
+ global sid
+ puts $sck [format "%s WA :%s" $sid $msg]
+}
+
+proc ::p10n::sethost {sck uid targ msg} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s SH %s %s %s" $sid $sendnn $targ [tnda get "ident/$::netname($sck)/$targ"] $msg]
+ puts $sck [format "%s FA %s %s" $sid $targ $msg]
+ puts stdout [format "%s SH %s %s %s" $sid $targ [tnda get "ident/$::netname($sck)/$targ"] $msg]
+ tnda set "vhost/$::netname($sck)/$targ" $msg
+}
+
+proc ::p10n::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
+ puts stdout "binds/$sock/$type/$client/$comd/$bindnum [tnda get "binds/$sock/$type/$client/$comd"]"
+ return $bindnum
+}
+
+proc ::p10n::unbind {sock type client comd id} {
+ tnda set "binds/$sock/$type/$client/$comd/$id" ""
+}
+
+proc ::p10n::putmode {sck uid targ mode parm ts} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s%s M %s %s %s" $sid $sendnn $targ $mode $parm $ts]
+}
+
+proc ::p10n::putmotd {sck targ line} {
+ global sid
+ puts $sck [format "%s 372 %s :- %s" $sid $targ $line]
+}
+
+proc ::p10n::mark {sck targ type line} {
+ global sid
+ puts $sck [format "%s MK %s %s :%s" $sid $targ $type $line]
+ puts stdout [format "%s MK %s %s :%s" $sid $targ $type $line]
+}
+
+proc ::p10n::putmotdend {sck targ} {
+ global sid
+ puts $sck [format "%s 376 %s :End of global MOTD." $sid $targ]
+}
+
+proc ::p10n::putjoin {sck uid targ ts} {
+ global sid
+ set sendid [b64e $uid]
+ set sendnn [string repeat "A" [expr {3-[string length $sendid]}]]
+ append sendnn $sendid
+ puts $sck [format "%s B %s %s %s%s:o" $sid $targ $ts $sid $sendnn]
+ puts stdout [format "%s B %s %s %s%s:o" $sid $targ $ts $sid $sendnn]
+
+}
+
+proc ::p10n::callbind {sock type client comd args} {
+ puts stdout "[tnda get "binds/$sock/$type/$client/$comd"]"
+ if {""!=[tnda get "binds/$sock/$type/$client/$comd"]} {
+ foreach {id script} [tnda get "binds/$sock/$type/$client/$comd"] {
+ $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}
+}
+
+proc ::p10n::irc-main {sck} {
+ global sid sock
+ if {[eof $sck]} {puts stderr "duckfuck.";exit}
+ gets $sck line
+ set line [string trim $line "\r\n"]
+ set gotsplitwhere [string first " :" $line]
+ if {$gotsplitwhere==-1} {set comd [split $line " "]} {set comd [split [string range $line 0 [expr {$gotsplitwhere - 1}]] " "]}
+ set payload [split [string range $line [expr {$gotsplitwhere + 2}] end] " "]
+ switch -nocase -- [lindex $comd 1] {
+ "P" {
+ if {[string index [lindex $comd 2] 0] == "#"} {
+ set client chan
+ callbind $sck pub "-" [string tolower [lindex $payload 0]] [lindex $comd 2] [lindex $comd 0] [lrange $payload 1 end] p10
+ callbind $sck evnt "-" "chanmsg" [lindex $comd 0] [lindex $comd 2] [lrange $payload 0 end] p10
+ } {
+ set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"]
+ callbind $sck msg $client [string tolower [lindex $payload 0]] [lindex $comd 0] [lrange $payload 1 end] p10
+ callbind $sck "evnt" "-" "privmsg" [lindex $comd 0] [lindex $comd 2] [lrange $payload 0 end] p10
+ }
+ }
+
+ "O" {
+ if {[string index [lindex $comd 2] 0] == "#"} {
+ set client chan
+ callbind $sck pubnotc "-" [string tolower [lindex $payload 0]] [lindex $comd 2] [lindex $comd 0] [lrange $payload 1 end] p10
+ callbind $sck pubnotc-m "-" [string tolower [lindex $payload 0]] [lindex $comd 2] [lindex $comd 0] [lrange $payload 1 end] p10
+ callbind $sck "evnt" "-" "channotc" [lindex $comd 0] [lindex $comd 2] [lrange $payload 0 end] p10
+ } {
+ set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"]
+ callbind $sck notc $client [string tolower [lindex $payload 0]] [lindex $comd 0] [lrange $payload 1 end]
+ callbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] [lrange $payload 0 end] p10
+ }
+ }
+
+ "M" {
+ puts stdout [join [list {*}$comd {*}$payload] " "]
+ if {[string index [lindex $comd 2] 0] != "#"} {if {[lindex $comd 2] == [tnda get "nick/$::netname($sck)/[lindex $comd 0]"]} {
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -- $c {
+ "+" {set state 1}
+ "-" {set state 0}
+ "o" {tnda set "oper/$::netname($sck)/[lindex $comd 0]" $state}
+ }
+ }
+ } } {
+ set ctr 3
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -regexp -- $c {
+ "\\\+" {set state 1}
+ "-" {set state 0}
+ "[aCcDdiMmNnOpQRrSsTtZz]" {callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2] $::netname($sck)}
+ "[belLkohv]" {callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2] [lindex $comd [incr ctr]] $::netname($sck)}
+ }
+ }
+ }
+ }
+
+ "C" {
+ callbind $sck create "-" "-" [lindex $comd 2] [lindex $comd 0] $::netname($sck)
+ callbind $sck join "-" "-" [lindex $comd 2] [lindex $comd 0] $::netname($sck)
+ set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
+ tnda set "channels/$::netname($sck)/$chan/$::netname($sck)/ts" [lindex $comd 3]
+ }
+
+ "T" {
+ callbind $sck topic "-" "-" [lindex $comd 2] [join $payload " "]
+ }
+
+ "OM" {
+ set ctr 3
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -regexp -- $c {
+ "\\\+" {set state 1}
+ "\\\-" {set state 0}
+ "[aCcDdiMmNnOpQRrSsTtZz]" {callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2]}
+ "[belLkohv]" {callbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2] [lindex $comd [incr ctr]]}
+ }
+ }
+ }
+
+ "B" {
+ set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
+ puts stdout "$chan"
+ if {[string index [lindex $comd 4] 0] == "+"} {
+ set four 5
+ if {[string match "*l*" [lindex $comd 4]]} {incr four}
+ if {[string match "*L*" [lindex $comd 4]]} {incr four}
+ if {[string match "*k*" [lindex $comd 4]]} {incr four}
+ } {
+ set four 4
+ }
+ tnda set "channels/$::netname($sck)/$chan/$::netname($sck)/ts" [lindex $comd 3]
+ foreach {nick} [split [lindex $comd $four] ","] {
+ set n [split $nick ":"]
+ set un [lindex $n 0]
+ set uo [lindex $n 1]
+ if {""!=$uo} {tnda set "channels/$::netname($sck)/$chan/modes/$::netname($sck)/$un" $uo}
+ callbind $sck join "-" "-" [lindex $comd 2] $un
+ }
+
+ }
+
+ "J" {
+ callbind $sck join "-" "-" [lindex $comd 2] [lindex $comd 0]
+ }
+
+ "MO" {
+ callbind $sck motd "-" "-" [lindex $comd 0]
+ }
+
+ "L" {
+ callbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0]
+ }
+
+ "AC" {
+ tnda set "login/$::netname($sck)/[lindex $comd 2]" [lindex $comd 3]
+ callbind $sck account "-" "-" [lindex $comd 2] [lindex $comd 3]
+ }
+
+ "K" {
+ callbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3]
+ }
+
+ "EB" {
+ puts $sck "$sid EA"
+ }
+
+ "N" {
+ if {[llength $comd] >= 5} {
+ set num 8
+ set ctr 1
+ set oper 0
+ set loggedin ""
+ set fakehost ""
+ set modes ""
+ if {[string index [lindex $comd 7] 0] == "+"} {set modes [string range [lindex $comd 7] 1 end]; incr num}
+ foreach {c} [split $modes {}] {
+ puts stdout "$ctr $comd"
+ switch -exact -- $c {
+ "o" {set oper 1}
+ "r" {incr ctr;incr num; set loggedin [lindex $comd [expr {$ctr+6}]]}
+ "C" {incr ctr;incr num; set fakehost [lindex $comd [expr {$ctr+6}]]}
+ "c" {incr ctr;incr num; set fakehost [lindex $comd [expr {$ctr+6}]]}
+ "f" {incr ctr;incr num; set fakehost [lindex $comd [expr {$ctr+6}]]}
+ "h" {incr ctr;incr num; set fakehost [lindex [split [lindex $comd [expr {$ctr+7}]] "@"] 1]}
+ }
+ }
+
+ if {""!=$loggedin} {
+ tnda set "login/$::netname($sck)/[lindex $comd $num]" $loggedin
+ }
+
+ if {""!=$fakehost} {
+ tnda set "vhost/$::netname($sck)/[lindex $comd $num]" $fakehost
+ }
+
+ 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 5]
+ tnda set "rhost/$::netname($sck)/[lindex $comd $num]" [lindex $comd 6]
+ callbind $sck conn "-" "-" [lindex $comd $num]
+ } {
+ callbind $sck nch "-" "-" [lindex $comd 0] [tnda get "nick/$::netname($sck)/[lindex $comd 0]"] [lindex $comd 2]
+ tnda set "nick/$::netname($sck)/[lindex $comd 0]" [lindex $comd 2]
+ }
+ }
+
+ "Q" {
+ tnda set "login/$::netname($sck)/[lindex $comd 0]" ""
+ tnda set "nick/$::netname($sck)/[lindex $comd 0]" ""
+ tnda set "oper/$::netname($sck)/[lindex $comd 0]" 0
+ tnda set "ident/$::netname($sck)/[lindex $comd 0]" ""
+ tnda set "rhost/$::netname($sck)/[lindex $comd 0]" ""
+ tnda set "vhost/$::netname($sck)/[lindex $comd 0]" ""
+ }
+
+ "D" {
+ tnda set "login/$::netname($sck)/[lindex $comd 2]" ""
+ tnda set "nick/$::netname($sck)/[lindex $comd 2]" ""
+ tnda set "oper/$::netname($sck)/[lindex $comd 2]" 0
+ tnda set "ident/$::netname($sck)/[lindex $comd 2]" ""
+ tnda set "rhost/$::netname($sck)/[lindex $comd 2]" ""
+ tnda set "vhost/$::netname($sck)/[lindex $comd 2]" ""
+ }
+
+ "G" {
+ puts $sck "$sid Z [lindex $comd 3] [lindex $comd 2] [lindex $comd 4]"
+ }
+ }
+}
+
+proc ::p10n::login {sck} {
+ global servername sid password
+ tnda set "pfx/owner" o
+ tnda set "pfx/protect" o
+ tnda set "pfx/halfop" h
+ set sid [string repeat "A" [expr {2-[string length [b64e $::numeric]]}]]
+ append sid [b64e $::numeric]
+ puts $sck "PASS :$password"
+ puts $sck "SERVER $servername 1 [clock format [clock seconds] -format %s] [clock format [clock seconds] -format %s] J10 $sid\]\]\] +s6h :Services for IRC Networks ($::netname($sck))"
+ puts $sck "$sid EB"
+ puts stdout "PASS :$password"
+ puts stdout "SERVER $servername 1 [clock format [clock seconds] -format %s] [clock format [clock seconds] -format %s] J10 $sid\]\]\] 0 :Services for IRC Networks"
+}
+
+
+#source services.conf
+namespace export *
+namespace ensemble create
+}
+
+#p10 login $::sock
diff --git a/core/9999-protocol-common.tcl b/core/9999-protocol-common.tcl
diff --git a/dict.tcl b/dict.tcl
@@ -0,0 +1,630 @@
+# dict.tcl
+# http://wiki.tcl.tk/10609
+#
+# Tcl 8.4-compatible implementation of the [dict] command.
+#
+# Known deficiencies:
+# - In error messages, the variable name doesn't always appear correctly. This
+# is due to use of [upvar] which renames the variable.
+# - Tcl 8.4 offers no way for [return], [break], etc. inside the script to
+# affect the caller. [uplevel] doesn't quite do everything that's needed.
+# - Some usage error messages show different names for formal arguments.
+# - Performance is reduced.
+#
+# Test failures (prefix each name with "dict-"):
+# 3.12 4.5 5.7 9.7 9.8 11.15 12.7 12.8 12.10
+# 13.7 13.8 13.9 14.1 14.2 14.3 14.4 14.12 14.13
+# 14.22 15.9 15.10 15.11 16.8 16.9 16.17 16.18 17.13
+# 17.16 17.18 21.1 21.2 21.3 21.4 21.13 21.14 21.15
+# 22.1 22.2 22.3 22.10 22.14 22.15 23.1 23.2 24.1
+# 24.2 24.3 24.4 24.12 24.13 24.20.1 24.21 24.24 24.25
+
+# Only create [dict] command if it doesn't already exist.
+if {[catch {dict get {}}]} {
+ # Tcl 8.4-style implementation of namespace ensembles.
+ namespace eval ::dict {}
+ proc ::dict {subcommand args} {
+ # Confirm $subcommand is a [dict] command or unambiguous prefix thereof.
+ if {[regexp {[][*?\\]} $subcommand]
+ || [llength [set command [info commands ::dict::$subcommand*]]] != 1} {
+ set commands [string map {::dict:: {}}\
+ [lsort [info commands ::dict::*]]]
+ if {[llength $commands] > 1} {
+ lset commands end "or [lindex $commands end]"
+ }
+ if {[llength $commands] > 2} {
+ set commands [join $commands ", "]
+ } else {
+ set commands [join $commands " "]
+ }
+ error "unknown or ambiguous subcommand \"$subcommand\":\
+ must be $commands"
+ }
+
+ # Invoke the command.
+ if {[catch {uplevel 1 [concat [list $command] $args]} msg]} {
+ # Rewrite the command name on error.
+ regsub {^(wrong # args: should be \")::(dict)::} $msg {\1\2 } msg
+ error $msg
+ } else {
+ return $msg
+ }
+ }
+
+ # [dict append]
+ proc ::dict::append {varName key args} {
+ upvar 1 $varName var
+
+ # Locate the matching key. On match, append to the key's value.
+ if {[::info exists var]} {
+ ::set var [get $var]
+ ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
+ if {[lindex $var $i] eq $key} {
+ ::incr i
+ return [lset var $i [lindex $var $i][join $args {}]]
+ }
+ }
+ }
+
+ # On search failure, add the key to the dict. This code also will
+ # create the dict if it doesn't already exist.
+ ::lappend var $key [join $args {}]
+ }
+
+ # [dict create]
+ proc ::dict::create {args} {
+ if {[llength $args] & 1} {
+ error "wrong # args: should be \"dict create ?key value ...?\""
+ }
+ get $args
+ }
+
+ # [dict exists]
+ proc ::dict::exists {dictionary key args} {
+ # Traverse through nested dicts searching for matches.
+ ::set sub $dictionary
+ foreach key [concat [list $key] $args] {
+ if {[llength $sub] & 1} {
+ return 0
+ }
+ ::set match 0
+ foreach {subkey sub} $sub {
+ if {$subkey eq $key} {
+ ::set match 1
+ break
+ }
+ }
+ if {!$match} {
+ return 0
+ }
+ }
+ return $match
+ }
+
+ # [dict filter]
+ proc ::dict::filter {dictionary filterType args} {
+ # Invoke the correct filter handler.
+ ::set result {}
+ switch $filterType {
+ k - ke - key {
+ # Filter on keys.
+ foreach {key val} [get $dictionary] {
+ foreach pattern $args {
+ if {[string match $pattern $key]} {
+ ::lappend result $key $val
+ break
+ }
+ }
+ }
+ } v - va - val - valu - value {
+ # Filter on values.
+ foreach {key val} [get $dictionary] {
+ foreach pattern $args {
+ if {[string match $pattern $val]} {
+ ::lappend result $key $val
+ break
+ }
+ }
+ }
+ } s - sc - scr - scri - scrip - script {
+ # Filter on script returning true.
+ if {[llength $args] != 2} {
+ error "wrong # args: should be \"dict filter dictionary script\
+ {keyVarName valueVarName} filterScript\""
+ } elseif {[llength [lindex $args 0]] != 2} {
+ error "must have exactly two variable names"
+ }
+ upvar 1 [lindex $args 0 0] key [lindex $args 0 1] val
+ foreach {key val} [get $dictionary] {
+ if {[uplevel 1 [lindex $args 1]]} {
+ ::lappend result $key $val
+ }
+ }
+ } default {
+ error "bad filterType \"$filterType\":\
+ must be key, script, or value"
+ }}
+ return $result
+ }
+
+ # [dict for]
+ proc ::dict::for {keyVarValueVar dictionary script} {
+ if {[llength $keyVarValueVar] != 2} {
+ error "must have exactly two variable names"
+ }
+
+ # [foreach] does what's needed, mostly. Tcl 8.4 offers no way for
+ # [return], etc. inside the script to make the caller return.
+ uplevel 1 [list foreach $keyVarValueVar [get $dictionary] $script]
+ }
+
+ # [dict get]
+ proc ::dict::get {dictionary args} {
+ if {[llength $args]} {
+ # When given multiple arguments, traverse nested dicts to find the
+ # requested key. Fail if the key is not found.
+ ::set sub $dictionary
+ foreach key $args {
+ if {[llength $sub] & 1} {
+ error "missing value to go with key"
+ }
+ ::for {::set i [expr {[llength $sub] - 2}]} {1} {::incr i -2} {
+ if {$i < 0} {
+ error "key \"$key\" not known in dictionary"
+ } elseif {[lindex $sub $i] eq $key} {
+ break
+ }
+ }
+ ::set sub [lindex $sub [expr {$i + 1}]]
+ }
+ return $sub
+ } else {
+ # With only one argument, convert that argument to a canonical dict.
+ if {[llength $dictionary] & 1} {
+ error "missing value to go with key"
+ }
+ ::for {::set i 0} {$i < [llength $dictionary]} {::incr i 2} {
+ if {[::info exists indexes([lindex $dictionary $i])]} {
+ lset dictionary $indexes([lindex $dictionary $i])\
+ [lindex $dictionary [expr {$i + 1}]]
+ ::set dictionary [lreplace $dictionary $i [expr {$i + 1}]]
+ ::incr i -2
+ } else {
+ ::set indexes([lindex $dictionary $i]) [expr {$i + 1}]
+ }
+ }
+ return $dictionary
+ }
+ }
+
+ # [dict incr]
+ proc ::dict::incr {varName key {increment 1}} {
+ upvar 1 $varName var
+
+ # Disallow non-integer increments.
+ if {![string is integer -strict $increment]} {
+ error "expected integer but got \"$increment\""
+ }
+
+ # Locate the matching key and increment its value.
+ if {[::info exists var]} {
+ ::set var [get $var]
+ ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
+ if {$key eq [lindex $var $i]} {
+ ::incr i
+
+ # Disallow non-integer values.
+ if {![string is integer -strict [lindex $var $i]]} {
+ error "expected integer but got \"[lindex $var $i]\""
+ }
+
+ # Increment the value in place.
+ return [lset var $i [expr {[lindex $var $i] + $increment}]]
+ }
+ }
+ }
+
+ # On search failure, add the key to the dict. This code also will
+ # create the dict if it doesn't already exist.
+ ::lappend var $key $increment
+ }
+
+ # [dict info]
+ proc ::dict::info {dictionary} {
+ # Make sure the dictionary is valid.
+ if {[llength $dictionary] & 1} {
+ error "missing value to go with key"
+ }
+
+ # No hash table.
+ return "dict is represented as plain list"
+ }
+
+ # [dict keys]
+ proc ::dict::keys {dictionary {pattern *}} {
+ # Build and return a list of matching keys.
+ ::set result {}
+ foreach {key val} [get $dictionary] {
+ if {[string match $pattern $key]} {
+ ::lappend result $key
+ }
+ }
+ return $result
+ }
+
+ # [dict lappend]
+ proc ::dict::lappend {varName key args} {
+ upvar 1 $varName var
+
+ # Locate the matching key and append a list element to its value.
+ if {[::info exists var]} {
+ ::set var [get $var]
+ ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
+ if {$key eq [lindex $var $i]} {
+ ::incr i
+
+ # Disallow non-list values.
+ llength [lindex $var $i]
+
+ # Increment the value in place.
+ return [lset var $i [concat [lindex $var $i] $args]]
+ }
+ }
+ }
+
+ # On search failure, add the key to the dict. This code also will
+ # create the dict if it doesn't already exist.
+ ::lappend var $key $args
+ }
+
+ # [dict map]
+ proc ::dict::map {keyVarValueVar dictionary script} {
+ # Confirm argument syntax.
+ if {[llength $keyVarValueVar] != 2} {
+ error "must have exactly two variable names"
+ }
+
+ # Link to local variables which will be used as iterators.
+ upvar 1 [lindex $keyVarValueVar 0] key [lindex $keyVarValueVar 1] val
+
+ # Accumulate and return the result.
+ ::set result {}
+ foreach {key val} [get $dictionary] {
+ ::lappend result $key [uplevel 1 $script]
+ }
+ return $result
+ }
+
+ # [dict merge]
+ proc ::dict::merge {args} {
+ # Confirm each argument is a dict.
+ foreach dict $args {
+ if {[llength $dict] & 1} {
+ error "missing value to go with key"
+ }
+ }
+
+ # Merge the dicts, then normalize.
+ get [eval [list concat] $args]
+ }
+
+ # [dict remove]
+ proc ::dict::remove {dictionary args} {
+ # Remove all dictionary keys matching any of the key arguments.
+ ::set dictionary [get $dictionary]
+ ::set args [lsort -unique $args]
+ ::for {::set i 0} {$i < [llength $dictionary]} {::incr i 2} {
+ ::set index [lsearch -exact -sorted $args [lindex $dictionary $i]]
+ if {$index >= 0} {
+ ::set dictionary [lreplace $dictionary $i [expr {$i + 1}]]
+ ::set args [lreplace $args $index $index]
+ if {![llength $args]} {
+ break
+ }
+ ::incr i -2
+ }
+ }
+ return $dictionary
+ }
+
+ # [dict replace]
+ proc ::dict::replace {dictionary args} {
+ # Confirm correct argument parity.
+ if {[llength $args] & 1} {
+ error "wrong # args:\
+ should be \"dict replace dictionary ?key value ...?\""
+ }
+
+ # Concatenate the dicts then use [get] to canonicalize the result.
+ get [eval [list concat $dictionary] $args]
+ }
+
+ # [dict set]
+ proc ::dict::set {varName key args} {
+ upvar 1 $varName var
+
+ # Confirm that a value argument was given.
+ if {![llength $args]} {
+ error "wrong # args:\
+ should be \"dict set varName key ?key ...? value\""
+ }
+
+ # Default the dictionary to empty.
+ if {![::info exists var]} {
+ ::set var {}
+ }
+
+ # Shuffle the arguments into the right variables.
+ ::set keys [concat [list $key] [lrange $args 0 end-1]]
+ ::set val [lindex $args end]
+
+ # Traverse through nested dicts to find the key to insert or replace.
+ ::set path {}
+ ::set sub $var
+ ::for {::set i 0} {$i < [llength $keys]} {::incr i} {
+ # Canonicalize each level of nested dicts.
+ lset var $path [::set sub [get $sub]]
+
+ # Search the current level to see if any keys match.
+ ::for {::set j 0} {1} {::incr j 2} {
+ if {$j >= [llength $sub]} {
+ # On match failure, move the remaining keys into the value,
+ # transforming it into a nested dict, then set that value.
+ ::set j [expr {[llength $keys] - 1}]
+ ::for {} {$j > $i} {::incr j -1} {
+ ::set val [list [lindex $keys $j] $val]
+ }
+ lset var $path [concat $sub [list [lindex $keys $i] $val]]
+ return $var
+ } elseif {[lindex $sub $j] eq [lindex $keys $i]} {
+ # On match success, advance to the next level of nesting.
+ break
+ }
+ }
+
+ # Descend into the value associated with the matching key.
+ ::incr j
+ ::lappend path $j
+ ::set sub [lindex $sub $j]
+ }
+
+ # Replace the value of the matched key.
+ lset var $path $val
+ }
+
+ # [dict size]
+ proc ::dict::size {dictionary} {
+ # Canonicalize the dict and return half its length.
+ expr {[llength [get $dictionary]] / 2}
+ }
+
+ # [dict unset]
+ proc ::dict::unset {varName key args} {
+ upvar 1 $varName var
+
+ # Handle the case of the dict not existing.
+ if {![::info exists var]} {
+ if {[llength $args]} {
+ # Fail when unsetting a nested key.
+ error "key \"$key\" not known in dictionary"
+ } else {
+ # Create the dict when unsetting a non-nested key.
+ ::set var {}
+ return
+ }
+ }
+
+ # Traverse through nested dicts to find the key to remove.
+ ::set keys [concat [list $key] $args]
+ ::set path {}
+ ::set sub $var
+ ::for {::set i 0} {1} {::incr i} {
+ # Canonicalize each level of nested dicts.
+ lset var $path [::set sub [get $sub]]
+
+ # Search the current level to see if any keys match.
+ ::for {::set j 0} {$j < [llength $sub]} {::incr j 2} {
+ if {[lindex $sub $j] eq [lindex $keys $i]} {
+ break
+ }
+ }
+
+ # Handle outer and innermost nesting levels differently.
+ if {$i < [llength $keys] - 1} {
+ # In parent levels, search failure is an error.
+ if {$j >= [llength $sub]} {
+ error "key \"[lindex $keys $i]\" not known in dictionary"
+ }
+
+ # Descend into the value associated with the matching key.
+ ::incr j
+ ::lappend path $j
+ ::set sub [lindex $sub $j]
+ } else {
+ # In the innermost level, search failure is acceptable. On
+ # search success, remove the key, otherwise just ignore.
+ if {$j < [llength $sub]} {
+ lset var $path [lreplace $sub $j [expr {$j + 1}]]
+ }
+
+ # Return the updated dictionary.
+ return $var
+ }
+ }
+ }
+
+ # [dict update]
+ proc ::dict::update {varName key valVarName args} {
+ # Confirm argument parity.
+ if {!([llength $args] & 1)} {
+ error "wrong # args: should be \"dict update varName key valVarName\
+ ?key valVarName ...? script\""
+ }
+ ::set script [lindex $args end]
+
+ # Convert the list of keys and variable names to an array.
+ array set names [concat [list $key $valVarName] [lrange $args 0 end-1]]
+
+ # Copy the dict values into the caller's variables.
+ upvar 1 $varName dict
+ foreach {key val} [get $dict] {
+ if {[::info exists names($key)]} {
+ upvar 1 $names($key) valVar
+ ::set valVar $val
+ }
+ }
+
+ # Invoke the caller-supplied script.
+ ::set result [uplevel 1 $script]
+
+ # If the dict is gone, let it stay gone. Otherwise update it.
+ if {[::info exists dict]} {
+ # Update the dict values from the caller's variables, and remove
+ # keys corresponding to unset variables.
+ ::for {::set i 0} {$i < [llength $dict]} {::incr i 2} {
+ if {[::info exists names([lindex $dict $i])]} {
+ upvar 1 $names([lindex $dict $i]) valVar
+ ::unset names([lindex $dict $i])
+ if {[::info exists valVar]} {
+ lset dict [expr {$i + 1}] $valVar
+ } else {
+ ::set dict [lreplace $dict $i [expr {$i + 1}]]
+ ::incr i -2
+ }
+ }
+ }
+
+ # Add keys back to the dict from the caller's variables, in case the
+ # caller removed some keys directly from the dict.
+ foreach {key valVarName} [array get names] {
+ upvar 1 $valVarName valVar
+ if {[::info exists valVar]} {
+ ::lappend dict $key $valVar
+ }
+ }
+ }
+
+ # Return the result of the script.
+ return $result
+ }
+
+ # [dict values]
+ proc ::dict::values {dictionary {pattern *}} {
+ # Build and return a list of matching values.
+ ::set result {}
+ foreach {key val} [get $dictionary] {
+ if {[string match $pattern $val]} {
+ ::lappend result $val
+ }
+ }
+ return $result
+ }
+
+ # [dict with]
+ proc ::dict::with {varName args} {
+ upvar 1 $varName dict
+
+ # Confirm a script argument was supplied.
+ if {![llength $args]} {
+ error "wrong # args:\
+ should be \"dict with varName ?key ...? script\""
+ }
+ ::set script [lindex $args end]
+ ::set args [lrange $args 0 end-1]
+
+ # Traverse through nested dicts to find the dict on which to operate.
+ ::set path {}
+ ::set sub [get $dict]
+ foreach key $args {
+ # Canonicalize each level of nested dicts.
+ lset dict $path $sub
+
+ # Search the current level to see if any keys match.
+ ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
+ if {[lindex $sub $i] eq $key} {
+ break
+ }
+ }
+
+ # Terminate on match failure.
+ if {$i >= [llength $sub]} {
+ error "key \"$key\" not known in dictionary"
+ }
+
+ # Descend into the value associated with the matching key.
+ ::incr i
+ ::set sub [get [lindex $sub $i]]
+ ::lappend path $i
+ }
+
+ # Copy the dict values into the caller's variables. Make an array to
+ # keep track of all the keys in the dict.
+ foreach {key val} $sub {
+ upvar 1 $key valVar
+ ::set valVar $val
+ ::set keys($key) {}
+ }
+
+ # Invoke the caller-supplied script.
+ ::set result [uplevel 1 $script]
+
+ # If the dict is gone, let it stay gone. Otherwise update it.
+ if {[::info exists dict]} {
+ # Traverse through nested dicts again in case the caller-supplied
+ # script reorganized the dict.
+ ::set path {}
+ ::set sub [get $dict]
+ foreach key $args {
+ # Canonicalize each level of nested dicts.
+ lset dict $path $sub
+
+ # Search the current level to see if any keys match.
+ ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
+ if {[lindex $sub $i] eq $key} {
+ break
+ }
+ }
+
+ # Terminate on match failure.
+ if {$i >= [llength $sub]} {
+ error "key \"$key\" not known in dictionary"
+ }
+
+ # Descend into the value associated with the matching key.
+ ::incr i
+ ::set sub [get [lindex $sub $i]]
+ ::lappend path $i
+ }
+
+ # Update the dict values from the caller's variables, and remove
+ # keys corresponding to unset variables.
+ ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
+ if {[::info exists keys([lindex $sub $i])]} {
+ upvar 1 [lindex $sub $i] valVar
+ ::unset keys([lindex $sub $i])
+ if {[::info exists valVar]} {
+ lset sub [expr {$i + 1}] $valVar
+ } else {
+ ::set sub [lreplace $sub $i [expr {$i + 1}]]
+ ::incr i -2
+ }
+ }
+ }
+
+ # Add keys back to the dict from the caller's variables, in case the
+ # caller removed some keys directly from the dict.
+ foreach key [array names keys] {
+ upvar 1 $key valVar
+ if {[::info exists valVar]} {
+ ::lappend sub $key $valVar
+ }
+ }
+
+ # Save the updated nested dict back into the dict variable.
+ lset dict $path $sub
+ }
+
+ # Return the result of the script.
+ return $result
+ }
+}
diff --git a/dnslib.php b/dnslib.php
@@ -0,0 +1,54 @@
+<?php
+
+# Following function is jaffacake's own work.
+# GPLv3 blablabla
+
+define("DNSBL",0x1);
+define("NORMLOOKUP",0x2);
+define("V6LOOKUP",0x4);
+define("REVLOOKUP",0x8);
+
+function dig($name, $qtype, $dnsbl = ".", $isdnsbl = false) {
+ $type = 0;
+ if ($isdnsbl >= 1) {
+ $isipv6 = (strpos($name, ":") !== FALSE);
+ if ($dnsbl == ".") return false;
+ if ($isipv6) {
+ $type = $type | V6LOOKUP;
+ }
+ $type = $type | DNSBL;
+ $type = $type | REVLOOKUP;
+ }
+ if (!$isdnsbl) $type = NORMLOOKUP;
+ if ($qtype == "PTR") {
+ $isipv6 = (strpos($name, ":") !== FALSE);
+ if ($isipv6) {
+ $type = $type | REVLOOKUP;
+ }
+ $type = $type | REVLOOKUP;
+ }
+ if ($type & 0x8) {
+ if ($type & V6LOOKUP) $rdns = implode(".",str_split(strrev(implode("",explode(":",$name)))));
+ else $rdns = implode(".",array_reverse(explode(".",$name)));
+ $dname = $rdns;
+ if (($type & 0x4) and ($type & 0x1)) $dname .= ".ip6.arpa";
+ else if ($type & 0x2) $dname .= ".in-addr.arpa";
+ else {
+ $dname .= ".".$dnsbl;
+ }
+ } else $dname = $name;
+ $dnsname = "dig +short +time=1 ".escapeshellarg($dname)." ".escapeshellarg(strtoupper($qtype))." | tail -n 1";
+ $out = shell_exec($dnsname);
+ if ($type & 0x1) {
+ $num = explode(".",$out);
+ $numreply = 0;
+ $numreply = $numreply + $num[3];
+ $numreply = $numreply + ($num[2] << 8);
+ $numreply = $numreply + ($num[1] << 16);
+ // We'll return the pton result :P
+ return $numreply;
+ }
+ return $out;
+}
+
+print($argv[5]. " " .dig($argv[1], $argv[2], $argv[3], $argv[4]). "\n");
diff --git a/main.tcl b/main.tcl
diff --git a/modules/0001-eggcompat.tcl b/modules/0000-eggcompat.tcl
diff --git a/modules/0002-chanserv-thcserv.tcl b/modules/0002-chanserv-thcserv.tcl
diff --git a/modules/0003-weather.tcl b/modules/0003-weather.tcl
diff --git a/modules/0004-limitserv.tcl b/modules/0004-limitserv.tcl
diff --git a/modules/0007-quote.tcl b/modules/0007-quote.tcl
diff --git a/modules/0008-relayserv.tcl b/modules/0008-relayserv.tcl
diff --git a/modules/0009-gateway.tcl b/modules/0009-gateway.tcl
@@ -0,0 +1,71 @@
+$::maintype sendUid $sock syn syn channels. channels. 1444 "Tin"
+bind $::sock msg 1444 "addgwcloak" addgwcloak
+bind $::sock msg 1444 "addaccloak" addaccloak
+bind $::sock conn - - dogwcloak
+bind $::sock motd - - dogwcloak
+bind $::sock msg 1444 "motd" dogwcloak
+
+proc addgwcloak {from msg} {
+ set uname [tnda get "login/$::netname($::sock)/$from"]
+ if {$::synpass != [lindex $msg 0 2]} {
+ $::maintype notice $::sock 1444 $from "SYNTAX: /msg syn addgwcloak match cloak syn-password"
+ $::maintype notice $::sock 1444 $from "FORMATCHAR: %i = realhost"
+ return
+ }
+ if {""==[lindex $msg 0 0]} {
+ $::maintype notice $::sock 1444 $from "SYNTAX: /msg syn addgwcloak match cloak"
+ $::maintype notice $::sock 1444 $from "FORMATCHAR: %i = realhost"
+ return
+
+ }
+ if {""==[lindex $msg 0 1]} {
+ $::maintype notice $::sock 1444 $from "SYNTAX: /msg syn addgwcloak match cloak"
+ $::maintype notice $::sock 1444 $from "FORMATCHAR: %i = realhost"
+ return
+
+ }
+ nda set "gwcloaks/[lindex $msg 0 0]" [lindex $msg 0 1]
+}
+
+proc dogwcloak {unick n} {
+ doinsecurehost $unick
+ set fp [open ./services.motd r]
+ set fl [read $fp]
+# set fl ""
+ close $fp
+ foreach {l} [split $fl "\r\n"] {
+ $::maintype putmotd $::sock $unick "$l"
+ }
+ $::maintype putmotdend $::sock $unick
+ set match [tnda get "rhost/$::netname($::sock)/$unick"]
+ foreach {mask cloak} [nda get "gwcloaks"] {
+ if {[string match -nocase $mask "[tnda get "nick/$::netname($::sock)/$unick"]![tnda get "ident/$::netname($::sock)/$unick"]@[tnda get "rhost/$::netname($::sock)/$unick"]"]} {set match $cloak}
+ }
+ set cloake [string map [list "::" "-" ":" "."] [string map [list "%i" [tnda get "rhost/$::netname($::sock)/$unick"]] $match]]
+ $::maintype notice $::sock 1444 $unick "$cloake should be your vHost."
+ $::maintype sethost $::sock 1444 $unick "$cloake"
+ $::maintype putwallop $::sock "CONNECT: [tnda get "nick/$::netname($::sock)/$unick"]![tnda get "ident/$::netname($::sock)/$unick"]@[tnda get "rhost/$::netname($::sock)/$unick"] ($cloake)"
+}
+
+proc doinsecurehost {unick} {
+ package require ip
+ set rhostname [tnda get "rhost/$::netname($::sock)/$unick"]
+ if {![string match "*:*" $rhostname] && [catch {::ip::toInteger $rhostname}]} {
+ if {![catch "exec php ./dnslib.php [string trim $rhostname] A . 0 $unick" reho]} {set rhostname [lindex [split [string trim $reho] " "] 1]} elseif {![catch "exec php ./dnslib.php [string trim $rhostname] AAAA . 0 $unick" reho]} {set rhostname [lindex [split [string trim $reho] " "] 1]} {puts stdout "gave up $rhostname $unick";return}
+ # If we returned then we gave up.
+ }
+ if {[string match "*:*" $rhostname]} {return;}
+ foreach {dnsbl} $::dnsbls {
+ set fp [open |[list php ./dnslib.php [string trim $rhostname] A $dnsbl 1 $unick] r]
+ set reho [read $fp]
+ catch "close $fp"
+ set reho [string trim $reho]
+ if {[lindex [split $reho " "] 0] == $unick} {set result [lindex [split $reho " "] 1]} {puts stdout "gave up $rhostname $unick results /$reho/";return}
+ # If we returned then we gave up.
+ if {$result!="" && $result != 0 && $result != 1} {$::maintype kill $::sock 1444 $unick "(DNSBL::$::dname($dnsbl) match - if this is in error contact j4jackj)"}
+ }
+}
+
+set dname(dnsbl.dronebl.org) DroneBL
+set dname(6667.141.117.162.69.ip-port.exitlist.torproject.org) Tor
+set dnsbls [list dnsbl.dronebl.org 6667.141.117.162.69.ip-port.exitlist.torproject.org]
diff --git a/modules/bmotion.disabled b/modules/bmotion.disabled
diff --git a/modules/0005-chanserv.tcl b/modules/disabled.chanserv
diff --git a/modules/trigserv.disabled b/modules/trigserv.disabled
diff --git a/nda.tcl b/nda.tcl
diff --git a/services.conf.example b/services.conf.example
