add more tcl scripts

Add more tcl scripts.

Signed-off-by: hwipl <33433250+hwipl@users.noreply.github.com>

auth.tcl

@@ -0,0 +1,20 @@
+# auth.tcl
+
+proc auth_auth { type } {
+	putserv "PRIVMSG <auth_serv> :auth <name> <password>"
+	putserv "MODE <name> :+x"
+}
+
+#proc auth_register {nick host hand chan arg} {
+#	puthelp "PRIVMSG $nick :trying to register..."
+#	puthelp "PRIVMSG <auth_serv>: HELLO <email> <email>"
+#}
+
+#proc auth_test {nick host hand chan argv} {
+#	puthelp "PRIVMSG $nick :test,1,2,3..."
+#}
+
+#bind pub - !register auth_register
+bind evnt - init-server auth_auth
+#bind pub - !test auth_test
+

funwar.tcl

@@ -0,0 +1,230 @@
+#!/usr/bin/tclsh
+# funwar script
+# have fun ;)
+
+
+package require sql
+
+# sql stuff:
+set funwar_sql_server "server.ip.add.ress"
+set funwar_sql_user "username"
+set funwar_sql_password "password"
+set funwar_sql_dbname_et "name of database"
+set funwar_sql_dbname_rtcw "name of database"
+set funwar_sql_tblname_et "name of table"
+set funwar_sql_tblname_rtcw "name of table"
+
+# where the bot should post funwars automatically:
+set funwar_channels_auto "#example #test"
+
+# how often should funwars be posted in the above specified channels?
+# bind time - "MIN HOUR DAY MONTH YEAR" funwar_auto
+# for example:
+# bind time - "20 * * * *" funwar auto
+# bind time - "50 * * * *" funwar auto
+# (posts at 20 and 50 minutes every hour/day/month/year)
+
+bind time - "20 * * * *" funwar_auto
+bind time - "50 * * * *" funwar_auto
+
+# which triggers should be used?
+set funwar_trigger_et "!et"
+set funwar_trigger_rtcw "!rtcw"
+set funwar_trigger_both "!funwars"
+
+# what should the output look like?
+
+set funwar_output_header "*** Funwars: ***"
+set funwar_output_header2 "Game: Date/Time: XonX: Clantag: IRC:"
+set funwar_output_footer "*** end of funwars list ***"
+
+
+#<don´t change>
+proc funwar_post {game id date time xonx clantag irc www server org chan } {
+#</don´t change>
+	
+set funwar_output_body "$game $date $xonx $clantag $irc"
+
+
+#<don´t change>
+puthelp "PRIVMSG $chan :$funwar_output_body"	
+}
+#</don´t change>
+
+
+# you shouldn´t change anything below except your really want to modify something!!!
+
+global funwar_sql_server
+global funwar_sql_user
+global funwar_sql_passwd
+global funwar_sql_dbname_et
+global funwar_sql_dbname_rtcw
+global funwar_sql_tblname_et
+global funwar_sql_tblname_rtcw
+global funwar_output_header
+global funwar_output_header2
+global funwar_output_footer
+global funwar_channels_auto
+
+
+
+proc funwar_sql_parsedb { server user password dbname tblname order chan game limit command} {
+
+global funwar_output_header
+global funwar_output_header2
+global funwar_output_footer
+
+set counter "1"
+
+set conn [ sql connect $server $user $password ]
+set res [ catch { sql selectdb $conn $dbname } msg ]
+if { $res != 0 } {
+	puthelp "PRIVMSG $chan :Sorry, could not select the database '$dbname': $msg"
+}
+
+set res [ sql query $conn "select id,date,time,xonx,clantag,irc,www,server,org from $tblname order by $order desc" ]
+if { $res != 0 } {
+
+if { $command != "noheader" } {
+	if { [llength $chan] == 1 } {
+	puthelp "PRIVMSG $chan :$funwar_output_header"
+	puthelp "PRIVMSG $chan :$funwar_output_header2"
+	} else {
+	foreach channel $chan {
+		puthelp "PRIVMSG $channel :$funwar_output_header"
+		puthelp "PRIVMSG $channel :$funwar_output_header2"
+	}
+	}
+}
+
+while { [ set row [ sql fetchrow $conn ] ] != "" } {
+	set id [lindex $row 0]
+	set date [lindex $row 1]
+	set time [lindex $row 2]
+	set xonx [lindex $row 3]
+	set clantag [lindex $row 4]
+	set irc [lindex $row 5]
+	set www [lindex $row 6]
+	set server [lindex $row 7]
+	set org [lindex $row 8]
+
+	if { $counter <= $limit } {
+	if { [llength $chan] == 1 } {
+		funwar_post $game $id $date $time $xonx $clantag $irc $www $server $org $chan
+	} else {
+		foreach channel $chan {
+		funwar_post $game $id $date $time $xonx $clantag $irc $www $server $org $channel
+		}
+	}
+	}
+	incr counter
+}
+
+if { $command != "nofooter" } {
+if { [llength $chan] == 1 } {
+	puthelp "PRIVMSG $chan :$funwar_output_footer"
+} else {
+	foreach channel $chan {
+		puthelp "PRIVMSG $channel :$funwar_output_footer"
+	}
+}
+}
+
+}
+sql endquery $conn
+sql disconnect $conn
+
+
+}
+
+
+proc funwar_rtcw { nick host hand chan arg } {
+
+	global funwar_sql_server
+	global funwar_sql_user
+	global funwar_sql_password
+	global funwar_sql_dbname_rtcw
+	global funwar_sql_tblname_rtcw
+	
+	set order "id"
+	set game "RTCW"
+	set limit "10"
+	set command ""
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_rtcw $funwar_sql_tblname_rtcw $order $chan $game $limit $command
+
+}
+
+proc funwar_et { nick host hand chan arg } {
+
+	global funwar_sql_server
+	global funwar_sql_user
+	global funwar_sql_password
+	global funwar_sql_dbname_et
+	global funwar_sql_tblname_et
+	
+	set order "id"
+	set game "ET"
+	set limit "10"
+	set command ""
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_et $funwar_sql_tblname_et $order $chan $game $limit $command
+	
+}
+
+proc funwar_both { nick host hand chan arg } {
+
+	global funwar_sql_server
+	global funwar_sql_user
+	global funwar_sql_password
+	global funwar_sql_dbname_rtcw
+	global funwar_sql_tblname_rtcw
+	global funwar_sql_dbname_et
+	global funwar_sql_tblname_et
+	
+	set order "id"
+	set game "RTCW"
+	set limit "3"
+	set command "nofooter"
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_rtcw $funwar_sql_tblname_rtcw $order $chan $game $limit $command
+	
+	set game "ET"
+	set command "noheader"
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_et $funwar_sql_tblname_et $order $chan $game $limit $command
+	
+}
+
+proc funwar_auto { min hour day month year } {
+	
+	global funwar_channels_auto
+	global funwar_sql_server
+	global funwar_sql_user
+	global funwar_sql_password
+	global funwar_sql_dbname_rtcw
+	global funwar_sql_tblname_rtcw
+	global funwar_sql_dbname_et
+	global funwar_sql_tblname_et
+	global funwar_channels_auto
+	
+	set order "id"
+	set game "RTCW"
+	set limit "3"
+	set command "nofooter"
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_rtcw $funwar_sql_tblname_rtcw $order $funwar_channels_auto $game $limit $command
+	
+	set game "ET"
+	set command "noheader"
+	
+	funwar_sql_parsedb $funwar_sql_server $funwar_sql_user $funwar_sql_password $funwar_sql_dbname_et $funwar_sql_tblname_et $order $funwar_channels_auto $game $limit $command
+	
+}
+
+
+bind pub - $funwar_trigger_et funwar_et
+bind pub - $funwar_trigger_rtcw funwar_rtcw
+bind pub - $funwar_trigger_both funwar_both
+
+putlog "Loaded funwars.tcl"

help.tcl

@@ -0,0 +1,17 @@
+# help.tcl
+
+proc show_help { nick host hand chan arg } {
+	putserv "PRIVMSG $nick :*** command help: ***"
+	putserv "PRIVMSG $nick : Quake2 Server List Commands:"
+	putserv "PRIVMSG $nick :  !addserver ip:port  -   this adds a server to the server list"
+	putserv "PRIVMSG $nick :  !delserver number   -   this removes the server specified by number from the server list"
+	putserv "PRIVMSG $nick :  !serverlist         -   this shows all servers in the server list"
+	putserv "PRIVMSG $nick :  !refresh            -   this refreshes all servers in the server list"
+	putserv "PRIVMSG $nick :  !refresh number     -   this refreshes the server specified by number"
+	putserv "PRIVMSG $nick : Others:"
+	putserv "PRIVMSG $nick :  !help               -   you are viewing this right now ;)"
+	putserv "PRIVMSG $nick :  !insult name        -   this insults the user specified by name with a random insult"
+	putserv "PRIVMSG $nick :*** end of help ***"
+}
+
+bind pub - !help show_help

qstat.tcl

@@ -0,0 +1,202 @@
+###################################################################
+#
+# qstat.tcl
+#
+# CONFIG:
+#
+# Here you can change some global variables. You can change the
+# name and/or path of the file you want to store the servers in
+# and its backup file.
+
+set qstat "/path/to/qstat"		;#path to your qstat binary
+set optionsall "-u -default q2s"	;#qstat options for all servers
+set optionssingle "-P -u -q2s"		;#qstat options for single server
+
+set file "servers.lst"			;#file to store servers in
+set filebak "servers.lst.bak"		;#server backup file
+
+# Here you can change the command names to something you like more.
+
+set addcommand "!addserver"		;#add server to the list
+set delcommand "!delserver"		;#remove server from list
+set showcommand "!serverlist"		;#show servers in list (no qstat)
+set refreshcommand "!refresh"		;#show server stats (qstat)
+
+# END OF CONFIG
+####################################################################
+
+global file
+global filebak
+global qstat
+global optionsall
+global optionssingle
+
+set playerlist1 ""
+global playerlist1
+
+# this procedure shows the saved matches:
+proc show_matches {nick host hand chan arg} {
+	global file
+	if {[isop $nick $chan]} {
+	if {[file exists $file]} {
+	if {[file size $file] > 0} {
+	if ![catch {open $file r} input] {
+	while {[gets $input line] >= 0} {
+		lappend matches $line
+	}
+	close $input
+	puthelp "PRIVMSG $nick :*** Server List ***:"
+	for { set i 0 } { $i < [llength $matches] } { incr i } {
+	puthelp "PRIVMSG $nick :([expr $i +1])  [lindex $matches $i]"
+	}
+	} else { puthelp "NOTICE $nick :Error opening file: $input" }
+	} else { puthelp "PRIVMSG $nick :No servers have been added yet..."}
+	} else { puthelp "PRIVMSG $nick :No servers have been added yet..."}
+	}
+}
+
+# this procedure deletes saved matches:
+proc del_match {nick host hand chan arg} {
+	global file
+	global filebak
+	if {[isop $nick $chan]} {
+	if {[file exists $file]} {
+	if {[file size $file] > 0} {
+	if ![catch {open $file r} input] {
+	while {[gets $input line] >= 0} {
+		lappend matches $line
+	}
+	if {$arg <= [llength $matches] && $arg != 0} {
+	close $input
+	file copy -force $file $filebak
+	if ![catch {open $file w} output] {
+	for { set i 0 } { $i < [llength $matches] } { incr i } {
+	if {[expr $i +1] != $arg} { puts $output "[lindex $matches $i]" }
+	}
+	close $output
+	puthelp "NOTICE $nick :Attempted to delete server number $arg."
+	putlog "match.tcl: $nick@$chan attempted to delete server number $arg."
+	} else { puthelp "NOTICE $nick :Error opening file: $output"
+		 putlog "match.tcl: ERROR! Error opening file: $output"}
+	} else { puthelp "NOTICE $nick :Can't delete servers that don't exist..." }
+	} else { puthelp "NOTICE $nick :Error opening file: $input"
+		 putlog "match.tcl: ERROR! Error opening file: $input"}
+	} else { puthelp "NOTICE $nick :Can't delete servers that don't exist..." }
+	} else { puthelp "NOTICE $nick :Can't delete servers that don't exist..." }
+	}
+}
+
+# this procedure adds matches to the list:
+proc add_match {nick host hand chan arg} {
+	global file
+	if {[isop $nick $chan]} {
+	if { $arg != "" } {
+
+        set match [regexp {[\d]+.[\d]+.[\d]+.[\d]+:[\d]+} $arg matchl]
+	if { $match == 1 } {
+
+	if ![catch {open $file a} output] {
+	puts $output "$arg"
+	close $output
+	puthelp "NOTICE $nick :Attempted to add server."
+	putlog "match.tcl: $nick@$chan attempted to add a server to the list"
+	} else { puthelp "NOTICE $nick :Error opening file: $input"
+		 putlog "match.tcl: ERROR! Error opening file: $input"}
+	}
+	} else { puthelp "NOTICE $nick :Can't add empty entry" }
+	}
+}
+
+
+proc refresh_servers {nick host hand chan arg} {
+	global qstat
+	global file
+	global playerlist1
+	global optionsall
+	global optionssingle
+	
+	if { $arg == "" } {
+	
+	if {[file exists $file]} {
+	
+	if {[file size $file] > 0} {
+	
+	if ![catch {open $file r} input] {
+	while {[gets $input line] >= 0} {
+	lappend matches $line
+	}
+	close $input
+	}
+	
+	if ![catch {open "|$qstat $optionsall -f $file" r} input] {
+	
+	while {[gets $input line] >= 0} {
+	formatline $line $chan $matches
+	}
+	
+	close $input
+	} else { puthelp "PRIVMSG $nick :Error refreshing servers: $input " }
+	} else { puthelp "PRIVMSG $nick :No servers have been added yet..." }
+	} else { puthelp "PRIVMSG $nick :No servers have been added yet..." }
+
+	} else {
+        
+	set playerlist1 ""
+	if {[file exists $file]} {
+	if {[file size $file] > 0} {
+	if ![catch {open $file r} input] {
+	while {[gets $input line] >= 0} {
+	lappend matches $line
+	}
+	close $input
+	}
+        if ![catch {open "|$qstat $optionssingle [lindex $matches [expr $arg -1]]" r} input] {
+	while {[gets $input line] >= 0} {
+	formatone $line $chan $arg
+	}
+	if { $playerlist1 != "" } { puthelp "PRIVMSG $chan :$playerlist1" }
+	close $input
+	} else { puthelp "NOTICE $nick :Error opening file: $input" }
+	} else { puthelp "PRIVMSG $chan :No servers have been added yet..."}
+	} else { puthelp "PRIVMSG $chan :No servers have been added yet..."}
+	
+	}
+}	
+
+# binds to call the procedures:
+bind pub - $showcommand show_matches
+bind pub - $addcommand add_match
+bind pub - $delcommand del_match
+bind pub - $refreshcommand refresh_servers
+
+proc formatline { line chan matches } {
+	set match [regexp {([\d]+.[\d]+.[\d]+.[\d]+:[\d]+)\
+                   [\s]*([\d]+/[\d]+)[\s]*\
+		   ([\w]+)[\s]*([\d]+)[\s]*/[\s]*[\d]+\
+		   [\s]*([\w]+)[\s]*(.+)} $line matchln address players map ping type name]
+	#puthelp "PRIVMSG $chan :$match"
+
+	if { $match == 1 } {
+	set number [expr [lsearch $matches $address] +1]
+	puthelp "PRIVMSG $chan :($number) \0030,1\00307[format "%-21s " $address] \00315[format "%-45s " $name] \0034[format "%-7s " ($players)] \00315[format "%-10s " ($map)]"}
+}	
+
+proc formatone { line chan arg } {
+	global playerlist1
+        set match [regexp {([\d]+.[\d]+.[\d]+.[\d]+:[\d]+)\
+	                   [\s]*([\d]+/[\d]+)[\s]*\
+			   ([\w]+)[\s]*([\d]+)[\s]*/[\s]*[\d]+\
+			   [\s]*([\w]+)[\s]*(.+)} $line matchln address players map ping type name]
+	#puthelp "PRIVMSG $chan :$match"
+        if { $match == 1 } {
+	puthelp "PRIVMSG $chan :($arg) \0030,1\00307[format "%-21s " $address] \00315[format "%-45s " $name] \0034[format "%-7s " ($players)] \00315[format "%-10s " ($map)]"
+	} else {
+	set match2 [regexp {[\s]*(-*[\d]+)[\s]*frags[\s]*([\d]+)ms[\s]*(.+)} $line matchln2 playerfrags playerping playername]
+		if { $match2 == 1 } {
+			if { $playerlist1 != "" } {
+			set playerlist1 "${playerlist1}, \00307$playername \00315(${playerfrags} frags, \00304${playerping}ms)"
+			} else { set playerlist1 "\0030,1\00307$playername \00315(${playerfrags} frags, \00304${playerping}ms)"
+			}
+		}
+	}
+}

topic.tcl

@@ -0,0 +1,20 @@
+# topic.tcl
+
+proc set_topic_off { nick host hand chan arg } {
+	putserv "TOPIC $chan :Something is now offline"
+}
+
+proc set_topic_on { nick host hand chan arg } {
+	putserv "TOPIC $chan :Something is now online"
+}
+
+bind pub o|o !off set_topic_off
+bind pub o|o !on set_topic_on
+
+bind pub - !topic set_topic
+
+proc set_topic { nick host hand chan arg } {
+	if [isop $chan $nick] {
+	putserv "TOPIC $chan :$arg"
+	}
+}

watch.tcl

@@ -0,0 +1,102 @@
+#!/usr/bin/tclsh
+
+proc watch_nick {nick host hand chan argv} {
+	
+	global watch_nick_user
+	set watch_nick_user $nick
+	
+	# check if there are enough parameters
+	if {[llength $argv] < 2} {
+		puthelp "PRIVMSG $nick :Usage: !watch <add|del|chk> <nick>"
+		#puts "PRIVMSG $nick :Usage: !watch <add|del> <nick>"
+		return
+	}
+	
+	# set some variables
+	set command [lindex $argv 0]
+	set nick2watch [lindex $argv 1]
+
+	if {$command == "add"} {
+		watch_add $nick2watch
+	} elseif {$command == "del" } {
+		watch_del $nick2watch
+	} elseif {$command == "chk" } {
+		watch_chk $nick2watch
+	}
+}
+
+proc watch_add {nick} {
+	
+	# file where to save nicks
+	set nickdb "watch_nick.db"
+
+	# helper var to check if nick is already saved
+	set found 0
+	
+	# open file and start reading and comparing saved nicks with submitted one
+	if ![catch {open $nickdb r} input] {
+		while {[gets $input line] >= 0} {
+			if {[string compare -nocase $line $nick] == 0} {
+			set found 1
+			}
+		}
+		close $input
+	}
+	
+	# insert nick into nickdb if it´s not already in it
+	if { $found == 0} {
+		if ![catch {open $nickdb a} output] {
+			puts $output $nick
+			close $output
+		}
+	}
+}
+
+proc watch_del {nick} {
+
+	# file where to save nicks
+	set nickdb "watch_nick.db"
+	
+	# open file and read nicks from it (omit nick that´s about to get deleted)
+	if ![catch {open $nickdb r} input] {
+		while {[gets $input line] >= 0} {
+			if {$line != $nick} {
+				lappend nicklist $line
+			}
+		}
+		close $input
+	}
+
+	# write nicks to the file again
+	if ![catch {open $nickdb w} output] {
+		foreach entry $nicklist {
+			puts $output $entry
+		}
+		close $output
+	}
+}
+
+
+proc watch_chk {nick2watch} {
+
+	bind RAW - 401 watch_chk_nosuch
+	bind RAW - 311 watch_chk_info
+	putserv "WHOIS $nick2watch"	
+}
+
+proc watch_chk_nosuch {var1 var2 var3} {
+	global watch_nick_user
+	puthelp "PRIVMSG $watch_nick_user :offline $var1 || $var2 || $var3"
+	unbind RAW - 401 watch_chk_nosuch
+	unbind RAW - 311 watch_chk_info
+}
+
+proc watch_chk_info {var1 var2 var3} {
+	global watch_nick_user
+	puthelp "PRIVMSG $watch_nick_user :online $var1 || $var2 || $var3"
+	unbind RAW - 401 watch_chk_nosuch
+	unbind RAW - 311 watch_chk_info
+}
+
+bind pub - !watch watch_nick
+