# putils # vim: expandtab tabstop=2 shiftwidth=2 softtabstop=2 autoindent: namespace eval ::putils { ## some internal variables for messaging and stuff :) not your business after all. set local_ver "0.4truncateSR" package require base64 package require md5 # if putils-variable (thus, putils!) is already loaded, then .. well .. load again, but, this time, quietly. ;-) if {![info exists putils]} { set putils(version) $local_ver putlog "::putils:: paul's utils for eggdrop bots in tcl - $putils(version) - loading..." } # set again .. perhaps we changed version while in development ;) - even while putils was already loaded. set putils(version) $local_ver } ### this "library" supplies the following procedures: # gets botnick, truncates it and lowercases it. If input-value of a botnick was # already correct, then it won't change anything. ;) proc ::putils::proper_botnick {botnick} { set temp [string tolower $botnick] # abfrage ob zu lang, dann fixen # putlog "::putils::proper_botnick: $botnick lowercase: $temp" if {[string length $botnick] > 9} { set temp [string range $temp 0 8 ] # putlog "::putils::proper_botnick: botnickname $botnick too long: capping to: $temp" } return $temp } proc ::putils::sleep {N} { after [expr {int($N * 1000)}] } proc ::putils::proper_channelname {channelname} { # channel names ARE NOT and SHOULD NOT BE CASE SENSITIVE! set temp [string tolower $channelname] set temp [::putils::umlauts $temp] # putlog "::putils:: $channelname lowercase: $temp" return $temp } # puts out a normal channel message. proc ::putils::put_local_msg {chan text} { putserv "PRIVMSG $chan :$text" putlog "::putils:: + normal message: ${chan} => '$text'" } # puts a NOTICE to a specified nickname with a specified message. proc ::putils::put_nick {nick msg} { putserv "NOTICE $nick :$msg" } proc ::putils::kill_spaces {text} { regsub -all "\\s+" $text "" text return $text } proc ::putils::put_bot {target_botnetnick fromdata} { # real maxlen for putbot is 400. but we have overhead. set maxmsglen 300 set calcmsglen [expr $maxmsglen + 1] #debug #set fromdata "12345678901234567890" if {[islinked $target_botnetnick] == 1} { # prepare data ...! encode. send multiple data, if needed. # encode it, base64, all in one line! '-wrapchar ""' set data [::base64::encode -wrapchar "" $fromdata] #::putils::filelog "scripts/cims/cims.log" "put_bot to $target_botnetnick: full base64 $data" # make a hash of $data set md5 [::md5::md5 -hex $data] putlog "::putils::put_bot: md5 of full base64 message: $md5" set data_len [string length $data] putlog "::putils::put_bot: data_len of full base64 message: $data_len" # into how many pieces does this message to be splitted? # default 1 set count_parts 1 if {$data_len > $calcmsglen} { set count_parts [expr $data_len / $calcmsglen] set remainder [expr $data_len % $calcmsglen] set real [expr ${data_len}.00 / ${calcmsglen}.00] putlog "::putils::put_bot: remainder: $remainder real: $real" if {[expr $data_len % $calcmsglen] > 0} { set count_parts [expr $count_parts + 1] } putlog "::putils::put_bot: length: $data_len messagedata will be divided into $count_parts parts" } #MTIzNDU2Nzg5MDEyMzQ1Njc4OTA= #MTIzNDU2 #Nzg5MDEy #MzQ1Njc4 #OTA= # cut data into pieces and send! for {set x 0} {$x < $count_parts} {incr x} { #putlog "part number is $x" # get the part set part [string range $data 0 $maxmsglen] putlog "::putils::put_bot: part $x is $part" # kill the part out of the original string set data [string replace $data 0 $maxmsglen ""] #::putils::filelog "scripts/cims/cims.log" "put_bot to $target_botnetnick: $part" putbot $target_botnetnick [concat "rec_putils " $md5 " " [expr $x + 1] " " $count_parts " " $part] } putlog "::putils:: put_bot: + delivered a message part to ${target_botnetnick}." } else { putlog "::putils:: put_bot: + a message couldn't be delivered. Bot ${target_botnetnick} is not linked" } } proc ::putils::rec_bot {sender_botnetnick cmd rec_data} { # cmd is "rec_putils" #putlog "inside rec_bot. we want to decode rec_data: $rec_data" set rec_data [split $rec_data] set message_hash [join [lindex $rec_data 0]] set current_part [join [lindex $rec_data 1]] #putlog "current_part: $current_part" set count_parts [join [lindex $rec_data 2]] #putlog "count_parts: $count_parts" set base64data [join [lindex $rec_data 3]] variable themessage variable kill_coordinates variable kill_timer_id # push to intermediary variable .. everything is there. it's our message stack. lappend themessage "$message_hash" "${current_part}" "$count_parts" "${base64data}" # kill old one, start a new one. if {[info exists kill_timer_id]} { set timerlist [utimers] foreach {timerinfo} $timerlist { set timer_id [join [lindex $timerinfo 2]] if {$timer_id == $kill_timer_id} { killutimer $kill_timer_id } } unset kill_timer_id unset kill_coordinates } set kill_timer_id [utimer 2 "::putils::timer_cleanup"] proc ::putils::timer_cleanup {} { variable themessage variable kill_coordinates set themessage "" set kill_coordinates "" } # .tcl namespace eval ::putils { unset themessage } set copymessage $themessage set my_count 0 set before_part "" # build a null list with X-count-elements set base64 "" for {set x 1} {$x <= $count_parts} {incr x} { lappend base64 $x } set iteration 0 set finish 0 foreach {hash current_part count base64data} $copymessage { incr iteration if {$hash == $message_hash} { if {$current_part != $before_part} { incr my_count set before_part $current_part # insert the element into the right place of the X-count-element list lset base64 [expr $current_part - 1] $base64data #putlog "building base64: $base64" # save the coordinates for later deletion. #1*4 - 4 3 2 1 set kill_from [expr ($iteration * 4) - 4] set kill_to [expr ($iteration * 4) - 1] lappend kill_coordinates $kill_from $kill_to #putlog "current_part: $current_part kill_from: $kill_from kill_to: $kill_to" if {$my_count == $count} { regsub -all " " ${base64} "" base64 #putlog "finished base64: $base64" set finish 1 # now delete this 4 from the $themessage foreach {kill_from kill_to} $kill_coordinates { #putlog "kill_from: $kill_from kill_to: $kill_to" for {set y $kill_from} {$y <= $kill_to} {incr y} { lset themessage $y "X" #putlog "themessage: $themessage" } } set kill_coordinates "" } } } } if {$finish == 1} { #::putils::filelog "scripts/cims/cims.log" "rec_bot from $sender_botnetnick base64: $base64" # decode base64data ... set original_data [::base64::decode $base64] #putlog "original_data: $original_data" set md5 [::md5::md5 -hex $base64] if {$md5 == $message_hash} { putlog "::putils::rec_bot: received decoded base64 message with correct md5" # start the targetted procedure with the received data. if available. set bindlist [split [join [binds bot]]] foreach {type o cmd cnt procedure} $bindlist { #putlog "::putils::put_bot: cmd: $cmd procedure: $procedure" # FIXME: we currently don't check for permissions... if {$cmd == [join [lindex $original_data 0]]} { putlog "::putils::rec_bot: ORIGINAL DATA has [llength $original_data] ELEMENTS" putlog "::putils::rec_bot from $sender_botnetnick : execute procedure: $procedure $sender_botnetnick [join [lindex $original_data 0]] [lrange $original_data 1 end]" $procedure $sender_botnetnick [join [lindex $original_data 0]] [lrange $original_data 1 end] #any_netbot_proc rec_bot cmd payload } } } } } bind bot - rec_putils ::putils::rec_bot # cleans the input text from all irc control codes... and even has # some spam-protection. proc ::putils::clean_txt {text} { #putlog "filter_A: ${text}" #regsub -all "\\" $text "\\\\" text # fixes many whitespace between words down to one space between words regsub -all "\\s+" $text " " text # filtering out all colorcodes (works well) regsub -all "\003\[0-9\]\{1,2\},\[0-9\]\{1,2\}" $text "" text regsub -all "\003\[0-9\]\{1,2\}" $text "" text regsub -all "\003" $text "" text # filtering out BOLD text regsub -all "\002" $text "" text # underline gets filtered too. (since +c on quakenet would suppress it ...) regsub -all "\037" $text "" text # replacing like !!!!!!!!!!!!! with !!!!! (5 letters) # s/(.?)\1{4,}/\1\1\1\1\1/g; # - max 5 same chars in a row regsub -all -nocase -expanded {(.)\1\1\1\1+} $text {\1\1\1\1\1} text #putlog "test: $text" set text [string trim $text] # putlog "filter_B: ${text}" return $text } # replace found umlauts with umlauts.. funny, eh? We have to do this to channel names with # umlauts, because of some encoding problem inside eggdrop. # Afterwards, you can check for channelnames - without errors. proc ::putils::umlauts {text} { # A REAL STRANGE BUG WORKAROUND WITH UMLAUTS regsub -all "Ä" ${text} "Ä" text regsub -all "Ü" ${text} "Ü" text regsub -all "Ö" ${text} "Ö" text regsub -all "ä" ${text} "ä" text regsub -all "ü" ${text} "ü" text regsub -all "ö" ${text} "ö" text return ${text} } # # Proc to generate a string of (given) characters # Range defaults to "ABCDEF...wxyz' # proc ::putils::randomRangeString {length {chars "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"}} { set range [expr {[string length $chars]-1}] set txt "" for {set i 0} {$i < $length} {incr i} { set pos [expr {int(rand()*$range)}] append txt [string range $chars $pos $pos] } return $txt } # safe "bot-knows-the-channel-and-is-in-there"-function, returns boolean proc ::putils::botonchannel {chan} { if {[validchan $chan] == 1 && [botonchan $chan] == 1} { return 1 } else { return 0 } } proc ::putils::write_f_array {file thearraylist} { array set myinternalarray $thearraylist set array_string [array get myinternalarray] set fh [open "$file" "w"] puts $fh $array_string close $fh } proc ::putils::read_f_array {file} { set fh [open "$file" "r"] array set myinternalarray [gets $fh] close $fh return [array get myinternalarray] } proc ::putils::filelog {file txt} { # write all to it set timestamp [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"] #open handle set fh [open "$file" "a"] # put to handle puts $fh "$timestamp $txt" # close handle close $fh } return 1