commit ad9e83ba0c8d921938d781a327cd5ec7a0f335fd
Author: Jaffa Cake <j4jackj@template.hostname>
Date: Fri, 8 Aug 2014 05:34:29 -0400
First release of TclMars, a bot NOT designed to emulate Starlink's Mars but designed to just be as awesome as said bot
Diffstat:
9 files changed, 531 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,3 @@
+*.conf
+*.db
+*.pem
diff --git a/b64.tcl b/b64.tcl
@@ -0,0 +1,24 @@
+proc b64e {numb} {
+ set b64 [split "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789\[\]" {}]
+
+ set res ""
+ while {$numb != 0} {
+ append res [lindex $b64 [expr {$numb % 64}]]
+ set numb [expr {$numb>>6}]
+ }
+ if {[string length $res] == 0} {
+ set res "A"
+ }
+ return [string reverse $res]
+}
+
+proc b64d {numb} {
+ set b64 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789\[\]"
+ 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<<(6*$i)}]
+ }
+ return $res
+}
diff --git a/chanserv.conf.example b/chanserv.conf.example
@@ -0,0 +1,3 @@
+set cs(nick) "Mars"
+set cs(ident) "services"
+set cs(host) "umbrellix.tk"
diff --git a/core/0000-conn.tcl b/core/0000-conn.tcl
@@ -0,0 +1,9 @@
+package require tls
+
+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]
+ fconfigure $sck -blocking 0 -buffering line
+ fileevent $sck readable [concat $script $sck]
+ return $sck
+}
diff --git a/core/0001-p10.tcl b/core/0001-p10.tcl
@@ -0,0 +1,236 @@
+proc sendUid {sck nick ident host dhost uid {realname "* Unknown *"}} {
+ global sid
+ 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 +oikd AAAAAA %s%s :%s" $sid $nick [clock format [clock seconds] -format %s] $ident $host $sid $sendnn $realname]
+ tnda set "intclient/${sid}${sendnn}" $uid
+ puts $sck $sl
+ puts stdout $sl
+}
+
+proc 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 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 setacct {sck targ msg} {
+ global sid
+ puts $sck [format "%s AC %s R %s" $sid $targ $msg]
+ tnda set "login/$targ" $msg
+}
+
+proc bind {type client comd script} {
+ tnda set "binds/$type/$client/$comd" $script
+}
+
+proc unbind {type client comd} {
+ tnda set "binds/$type/$client/$comd" ""
+}
+
+proc 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 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]
+}
+
+proc callbind {type client comd args} {
+ if {""!=[tnda get "binds/$type/$client/$comd"]} {[tnda get "binds/$type/$client/$comd"] [lindex $args 0] [lrange $args 1 end]} {
+ puts stdout "bind called $type $client $comd but no one to send it to!"
+ }
+}
+
+proc p10-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] " "]
+ puts stdout [join $comd "<->"]
+ switch -nocase -- [lindex $comd 1] {
+ "P" {
+ if {[string index [lindex $comd 2] 0] == "#"} {
+ set client chan
+ } {
+ set client [tnda get "intclient/[lindex $comd 2]"]
+ }
+
+ callbind msg $client [string tolower [lindex $payload 0]] [lindex $comd 0] [lrange $payload 1 end]
+ }
+
+ "M" {
+ if {[string length [lindex $comd 0]] != 2} {if {[lindex $comd 2] == [tnda get "nick/[lindex $comd 0]"]} {
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -- $c {
+ "+" {set state 1}
+ "-" {set state 0}
+ "o" {tnda set "oper/[lindex $comd 0]" $state}
+ }
+ }
+ } } {
+ set ctr 3
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -regexp -- $c {
+ "\\\+" {set state 1}
+ "\\\-" {set state 0}
+ "[aCcDdiMmNnOpQRrSsTtZz]" {callbind mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2]}
+ "[belLkohv]" {callbind mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2] [lindex $comd [incr ctr]]}
+ }
+ }
+ }
+ }
+
+ "C" {
+ callbind create "-" "-" [lindex $comd 2] [lindex $comd 0]
+ }
+
+ "OM" {
+ if {[string length [lindex $comd 0]] != 2} {if {[lindex $comd 2] == [tnda get "nick/[lindex $comd 0]"]} {
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -- $c {
+ "+" {set state 1}
+ "-" {set state 0}
+ "o" {tnda set "oper/[lindex $comd 0]" $state}
+ }
+ }
+ } } {
+ set ctr 3
+ foreach {c} [split [lindex $comd 3] {}] {
+ switch -regexp -- $c {
+ "\\\+" {set state 1}
+ "\\\-" {set state 0}
+ "[aCcDdiMmNnOpQRrSsTtZz]" {callbind mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 2]}
+ "[belLkohv]" {callbind 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
+ } {
+ set four 4
+ }
+ tnda set "channels/$chan/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/$chan/modes/$un" $uo}
+ }
+
+ }
+
+ "EB" {
+ puts $sck "$sid EA"
+ puts $sck "$sid EB"
+ }
+
+ "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/[lindex $comd $num]" $loggedin
+ }
+
+ if {""!=$fakehost} {
+ tnda set "vhost/[lindex $comd $num]" $fakehost
+ }
+
+ puts $sck "$sid O #o :conn $line"
+
+ tnda set "nick/[lindex $comd $num]" [lindex $comd 2]
+ tnda set "oper/[lindex $comd $num]" $oper
+ tnda set "ident/[lindex $comd $num]" [lindex $comd 5]
+ tnda set "rhost/[lindex $comd $num]" [lindex $comd 6]
+ #callbind conn "-" "-" [lindex $comd $num]
+ } {
+ puts $sck "$sid O #o :nch [tnda get "nick/[lindex $comd 0]"] [lindex $comd 2]"
+ #callbind nch "-" "-" [lindex $comd $num] [tnda get "nick/[lindex $comd 0]"] [lindex $comd 2]
+ tnda set "nick/[lindex $comd 0]" [lindex $comd 2]
+ }
+ }
+
+ "Q" {
+ tnda set "login/[lindex $comd 0]" ""
+ tnda set "nick/[lindex $comd 0]" ""
+ tnda set "oper/[lindex $comd 0]" 0
+ tnda set "ident/[lindex $comd 0]" ""
+ tnda set "rhost/[lindex $comd 0]" ""
+ tnda set "vhost/[lindex $comd 0]" ""
+ }
+
+ "D" {
+ tnda set "login/[lindex $comd 2]" ""
+ tnda set "nick/[lindex $comd 2]" ""
+ tnda set "oper/[lindex $comd 2]" 0
+ tnda set "ident/[lindex $comd 2]" ""
+ tnda set "rhost/[lindex $comd 2]" ""
+ tnda set "vhost/[lindex $comd 2]" ""
+ }
+
+ "G" {
+ puts $sck "$sid Z [lindex $comd 3] [lindex $comd 2] [lindex $comd 4]"
+ }
+ }
+}
+
+proc p10-burst {sck} {
+ global servername sid password
+ set sid [string repeat "A" [expr {2-[b64e $::numeric]}]]
+ append sid [b64e $::numeric]
+ puts $sck "PASS :$password"
+ puts $sck "SERVER $servername 0 [clock format [clock seconds] -format %s] [clock format [clock seconds] -format %s] J10 $sid\]\]\] +s :Services for IRC Networks"
+ puts stdout "PASS :$password"
+ puts stdout "SERVER $servername 0 [clock format [clock seconds] -format %s] [clock format [clock seconds] -format %s] J10 $sid\]\]\] +s :Services for IRC Networks"
+}
+
+
+source services.conf
+
+set sid [string repeat "A" [expr {2-[b64e $numeric]}]]
+append sid [b64e $numeric]
diff --git a/main.tcl b/main.tcl
@@ -0,0 +1,49 @@
+#!/usr/bin/env tclsh
+# Basic tcl services program.
+
+package require tie
+package require base64
+package require sha1
+#set b64 [split "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789[]" {}]
+
+source b64.tcl
+
+proc pwhash {pass} {
+ global b64
+ set hash [::sha1::sha1 -hex $pass]
+ return "SHA1/$hash"
+}
+
+proc rand {minn maxx} {
+ set maxnum [expr {$maxx - $minn}]
+ set fp [open /dev/urandom r]
+ set bytes [read $fp 6]
+ close $fp
+ scan $bytes %c%c%c%c%c%c ca co ce cu ci ch
+ set co [expr {$co + pow(2,8)}]
+ set ce [expr {$ce + pow(2,16)}]
+ set cu [expr {$cu + pow(2,24)}]
+ set ci [expr {$ci + pow(2,32)}]
+ set ch [expr {$ch + pow(2,40)}]
+ return [expr {$minn+(int($ca+$co+$ce+$cu+$ci+$ch)%$maxnum)}]
+}
+
+proc mysrc {script} {
+ set fp [open $script r]
+ set ev [read $fp]
+ close $fp
+ uplevel "#0" $ev
+}
+mysrc nda.tcl
+::tie::tie nd file services.db
+
+foreach {file} [lsort [glob ./core/*.tcl]] {
+ mysrc $file
+}
+#mysrc services.conf
+
+foreach {file} [lsort [glob ./modules/*.tcl]] {
+ mysrc $file
+}
+
+vwait forever
diff --git a/modules/0001-chanserv.tcl b/modules/0001-chanserv.tcl
@@ -0,0 +1,152 @@
+source chanserv.conf
+sendUid $sock $cs(nick) $cs(ident) $cs(host) $cs(host) 77 "Channels Server"
+bind msg 77 "register" regchan
+bind msg 77 "adduser" adduserchan
+#bind msg 77 "deluser" deluserchan
+bind msg 77 "up" upchan
+bind msg 77 "down" downchan
+bind msg 77 "hello" regnick
+bind msg 77 "chpass" chpassnick
+bind msg 77 "login" idnick
+bind msg 77 "help" chanhelp
+bind mode "-" "+" checkop
+bind mode "-" "-" checkdeop
+bind create "-" "-" checkcreate
+
+foreach {chan _} [nda get "regchan"] {
+ putjoin $::sock 77 [::base64::decode [string map {[ /} $chan]] [nda get "regchan/$chan/ts"]
+ tnda set "channels/$chan/ts" [tnda get "channels/$chan/ts"]
+}
+
+proc checkop {mc ftp} {
+ set f [lindex $ftp 0 0]
+ set t [lindex $ftp 0 1]
+ set p [lindex $ftp 0 2]
+ if {"o"!=$mc} {return}
+ set chan [string map {/ [} [::base64::encode [string tolower $t]]]
+ tnda set "channels/$chan/modes/$p" "[tnda get "channels/$chan/modes/$p"]o"
+}
+
+proc checkcreate {mc ftp} {
+ set chan [string map {/ [} [::base64::encode [string tolower $mc]]]
+ tnda set "channels/$chan/modes/$ftp" "o"
+ puts stdout "channels/$chan/modes/$ftp"
+}
+
+proc checkdeop {mc ftp} {
+ set f [lindex $ftp 0 0]
+ set t [lindex $ftp 0 1]
+ set p [lindex $ftp 0 2]
+ if {"o"!=$mc} {return}
+ set chan [string map {/ [} [::base64::encode [string tolower $t]]]
+ tnda set "channels/$chan/modes/$p" [string map {o ""} [tnda get "channels/$chan/modes/$p"]]
+}
+
+proc chanhelp {from msg} {
+ notice $::sock 77 $from " --- ChanServ Help ---"
+ notice $::sock 77 $from "ChanServ provides channel auto op and basic protection (depending on loaded scripts)"
+ notice $::sock 77 $from "to registered channels."
+ notice $::sock 77 $from " -!- Commands available -!-"
+ notice $::sock 77 $from "register <channel> - Register a channel to your username. "
+ notice $::sock 77 $from "up <channel> - Ops you if you have level on the channel for this username."
+ notice $::sock 77 $from "down <channel> - Removes all channel user modes affecting your nick."
+ notice $::sock 77 $from "hello <username> <password> - Register a username."
+ notice $::sock 77 $from "login <username> <password> - Log in to a username."
+}
+
+proc regchan {from msg} {
+ if {""==[tnda get "login/$from"]} {notice $::sock 77 $from "You fail at life.";return}
+ set cname [lindex $msg 0 0]
+ set ndacname [string map {/ [} [::base64::encode [string tolower $cname]]]
+ if {[string length [nda get "regchan/$ndacname"]] != 0} {
+ notice $::sock 77 $from "You fail at life."
+ notice $::sock 77 $from "Channel already exists."
+ return
+ }
+ if {-1==[string first "o" [tnda get "channels/$ndacname/modes/$from"]]} {
+ notice $::sock 77 $from "You fail at life."
+ notice $::sock 77 $from "You are not an operator."
+ return
+ }
+ notice $::sock 77 $from "Guess what? :)"
+ nda set "regchan/$ndacname/levels/[tnda get "login/$from"]" 500
+ nda set "regchan/$ndacname/ts" [tnda get "channels/$ndacname/ts"]
+ putjoin $::sock 77 $cname [tnda get "channels/$ndacname/ts"]
+}
+
+proc adduserchan {from msg} {
+ if {""==[tnda get "login/$from"]} {notice $::sock 77 $from "You fail at life.";return}
+ set cname [lindex $msg 0 0]
+ set adduser [lindex $msg 0 1]
+ set addlevel [lindex $msg 0 2]
+ set ndacname [string map {/ [} [::base64::encode [string tolower $cname]]]
+ if {![string is -integer $addlevel]} {return}
+ if {$addlevel > [nda get "regchan/$ndacname/levels/[tnda get "login/$from"]"]} {notice $::sock 77 $from "You can't do that; you're not the channel's Dave";return}
+ if {[nda get "regchan/$ndacname/levels/$adduser"] > [nda get "regchan/$ndacname/levels/[tnda get "login/$from"]"]} {notice $::sock 77 $from "You can't do that; the person you're changing the level of is more like Dave than you.";return}
+ if {$adduser == [tnda get "login/$from"]} {notice $::sock 77 $from "You can't change your own level, even if you're downgrading. Sorreh :/";return}
+ notice $::sock 77 $from "Guess what? :) User added."
+ nda set "regchan/$ndacname/levels/$adduser" $addlevel
+}
+
+proc upchan {from msg} {
+ puts stdout [nda get regchan]
+ if {""==[tnda get "login/$from"]} {notice $::sock 77 $from "You fail at life.";return}
+ set cname [lindex $msg 0 0]
+ set ndacname [string map {/ [} [::base64::encode [string tolower $cname]]]
+ if {1>[nda get "regchan/$ndacname/levels/[tnda get "login/$from"]"]} {
+ notice $::sock 77 $from "You fail at life."
+ notice $::sock 77 $from "Channel not registered to you."
+ return
+ }
+ set lev [nda get "regchan/$ndacname/levels/[tnda get "login/$from"]"]
+ set sm "+"
+ set st ""
+ if {$lev > 1} {set sm "v"}
+ if {$lev > 150} {set sm "h"}
+ if {$lev > 200} {set sm "o"}
+ putmode $::sock 77 $cname $sm $from [tnda get "channels/$ndacname/ts"]
+}
+
+proc regnick {from msg} {
+ set uname [lindex $msg 0 0]
+ if {[string first "/" $uname] != -1} {return}
+ set pw [lindex $msg 0 1]
+ if {""!=[nda get "usernames/[string tolower $uname]"]} {
+ notice $::sock 77 $from "You fail at life."
+ notice $::sock 77 $from "Account already exists; try LOGIN"
+ return
+ }
+ nda set "usernames/[string tolower $uname]/password" [pwhash $pw]
+ setacct $::sock $from $uname
+}
+
+proc chpassnick {from msg} {
+ set uname [lindex $msg 0 0]
+ if {[string first "/" $uname] != -1} {return}
+ set pw [lindex $msg 0 1]
+ set newpw [lindex $msg 0 2]
+ set checkpw [split [nda get "usernames/[string tolower $uname]/password"] "/"]
+ set ispw [pwhash $pw]
+
+ if {$ispw != [nda get "usernames/[string tolower $uname]/password"]} {
+ notice $::sock 77 $from "You fail at life."
+ notice $::sock 77 $from "Wrong pass."
+ return
+ }
+ nda set "usernames/[string tolower $uname]/password" [pwhash $newpw]
+ notice $::sock 77 $from "Password changed."
+}
+
+proc idnick {from msg} {
+ set uname [lindex $msg 0 0]
+ if {[string first "/" $uname] != -1} {return}
+ set pw [lindex $msg 0 1]
+ set checkpw [split [nda get "usernames/[string tolower $uname]/password"] "/"]
+ set ispw [pwhash $pw]
+ if {$ispw == [nda get "usernames/[string tolower $uname]/password"]} {
+ notice $::sock 77 $from "You have successfully logged in as $uname."
+ setacct $::sock $from $uname
+ } {
+ notice $::sock 77 $from "You cannot log in as $uname. You have the wrong password."
+ }
+}
diff --git a/nda.tcl b/nda.tcl
@@ -0,0 +1,51 @@
+
+array set nd {}
+array set tnd {}
+
+namespace eval nda {
+ proc ::nda::get {path} {
+ global nd
+ ::set parr [split $path "/"]
+ if {[lindex $parr 0] == ""} {
+ 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}
+ }
+ 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]
+ }
+
+ namespace export *
+ namespace ensemble create
+}
+
+namespace eval tnda {
+ proc ::tnda::get {path} {
+ global tnd
+ ::set parr [split $path "/"]
+ 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}
+ }
+ proc ::tnda::set {path val} {
+ global tnd
+ ::set parr [split $path "/"]
+ if {[lindex $parr 0] == ""} {
+ return ""
+ }
+ ::set pathe [lrange $parr 1 end]
+ return [dict set tnd([lindex $parr 0]) {*}$pathe $val]
+ }
+
+ namespace export *
+ namespace ensemble create
+}
diff --git a/services.conf.example b/services.conf.example
@@ -0,0 +1,4 @@
+set numeric "53"
+set servername "channels."
+set password "laoo,rpe"
+p10-burst [set sock [connect 127.0.0.1 4400 p10-main]]
