cims-eggdrop/putils.tcl

# putils



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: execute procedure: $procedure $sender_botnetnick [join [lindex $original_data 0]] [join [lrange $original_data 1 end]]"
					#execute procedure
					$procedure $sender_botnetnick [join [lindex $original_data 0]] [join [lrange $original_data 1 end]]
				}
			}
		}
	}

}

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