# HG changeset patch # User Matti Hamalainen # Date 1285063969 -10800 # Node ID 1c4e2814cd4193d23ef7f44451446216be729a47 Initial import. diff -r 000000000000 -r 1c4e2814cd41 feeds.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/feeds.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,190 @@ +############################################################################ +# +# FeedCheck v0.7 by ccr/TNSP +# (C) Copyright 2008-2010 Tecnic Software productions (TNSP) +# +# Requires get_feeds.tcl to be run as a cronjob, for example +# 15 * * * * /absolute/path/to/get_feeds.tcl +# +# This script is freely distributable under GNU GPL (version 2) license. +# +############################################################################ + +# Datafile, MUST be set to same as in get_feeds.tcl +set feeds_datafile "/home/niinuska/bot/data.feeds" + +# Set channels and feed filters here: +# "channel" "feedname|feedname2" +# feednames can use matching, e.g. "mtv3*" would match all beginning with "mtv3" +array set feeds_channels { + "mazmlame" "the adventurers|oots|mestari|blastwave" + "fireball" "mestari" + "tnsp" "the adventurers|oots|mestari" +} + + +set feeds_preferredmsg "PRIVMSG" + + +############################################################################ +# No need to look below this line +############################################################################ +set feeds_name "FeedCheck" +set feeds_message "$feeds_name v0.7 by ccr/TNSP" + +putlog "$feeds_message" +bind pub - !feeds feeds_pubfetch +bind pub - !last feeds_publast + + +# ------------------------------------------------------------------------- +proc feeds_smsg {uchan umsg} { + global feeds_preferredmsg + putserv "$feeds_preferredmsg $uchan :$umsg" +} + +proc feeds_log {umsg} { + global feeds_name + putlog "$feeds_name: $umsg" +} + +proc feeds_msg {urec} { + global feeds_channels + set uname [string tolower [lindex $urec 1]] + foreach {uchan ufilter} [array get feeds_channels] { + foreach umatch [split [string tolower $ufilter] "|"] { + if {[string match $umatch $uname]} { + feeds_smsg "#$uchan" "[lindex $urec 1]: \002[lindex $urec 3]\002 -- [lindex $urec 2]" + } + } + } +} + +proc feeds_ctime {utime} { + if {$utime == "" || $utime == "*"} { + set utime 0 + } + return [clock format $utime -format "%d.%m.%Y %H:%M"] +} + + +# ------------------------------------------------------------------------- +proc feeds_check {} { + global feeds_datafile + + set results {} + + # Otetaan aika + set newtime [clock seconds] + + # Haetaan edellinen + set oldtime 0 + if {![catch {set ufile [open "$feeds_datafile.time" r 0600]} uerrmsg]} { + gets $ufile oldtime + close $ufile + } else { + feeds_log "Could not open timefile: $uerrmsg" + } + + # Tarkistetaan + if {![catch {set ufile [open "$feeds_datafile" r 0600]} uerrmsg]} { + while {![eof $ufile]} { + gets $ufile uline + set urec [split $uline "½"] + if {[llength $urec] == 4 && [lindex $urec 0] > $oldtime} { + lappend results $urec + } + } + close $ufile + } else { + feeds_log "Could not open datafile: $uerrmsg" + } + + # Talletetaan + if {[llength $results] > 0} { + if {![catch {set ufile [open "$feeds_datafile.time" w 0600]} uerrmsg]} { + puts $ufile $newtime + close $ufile + } + } + + return $results +} + +# ------------------------------------------------------------------------- +proc feeds_exec {} { + feeds_log "Checking for new entries." + set uresult [feeds_check] + set nresult [llength $uresult] + if {$nresult >= 20} { + feeds_log "$nresult entries, probably broken datafile. Ignoring." + } else { + foreach urec $uresult { feeds_msg $urec } + } + timer 5 feeds_exec +} + +if {![info exists feeds_running]} { + feeds_log "Starting timed feed check." + timer 5 feeds_exec + set feeds_running 1 +} + +# ------------------------------------------------------------------------- +proc feeds_pubfetch {unick uhost uhand uchan utext} { + feeds_log "Manual check invoked on $uchan." + set uresult [feeds_check] + set nresult [llength $uresult] + if {$nresult > 0} { + if {$nresult >= 20} { + feeds_smsg $uchan "$nresult uutta, tod. näk. epäsynkissä. Ignoorataan." + } else { + foreach urec $uresult { feeds_msg $urec } + feeds_smsg $uchan "$nresult uutta." + } + } else { + feeds_smsg $uchan "Ei uusia." + } + +} + + +# ------------------------------------------------------------------------- +proc feeds_checklast {ufeed} { + global feeds_datafile + + set result "" + set oldtime 0 + set matsi [string tolower "*$ufeed*"] + + # Tarkistetaan + if {![catch {set ufile [open "$feeds_datafile" r 0600]} uerrmsg]} { + while {![eof $ufile]} { + gets $ufile uline + set urec [split $uline "½"] + if {[llength $urec] == 4 && [lindex $urec 0] >= $oldtime} { + if {[string match $matsi [string tolower [lindex $urec 1]]]} { + set result $urec + set oldtime [lindex $urec 0] + } + } + } + close $ufile + } else { + feeds_log "Could not open datafile: $uerrmsg" + } + + return $result +} + + +proc feeds_publast {unick uhost uhand uchan utext} { + set uresult [feeds_checklast $utext] + if {$uresult != ""} { + feeds_smsg $uchan "Uusin '[lindex $uresult 1]' / [feeds_ctime [lindex $uresult 0]]: [lindex $uresult 3] -- [lindex $uresult 2]" + } else { + feeds_smsg $uchan "Ei osumia haulla '$utext'." + } + +} + diff -r 000000000000 -r 1c4e2814cd41 hae_feedit.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hae_feedit.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,191 @@ +#!/usr/bin/tclsh +############################################################################ +# +# FeedCheck fetcher v0.7 by ccr/TNSP +# (C) Copyright 2008-2010 Tecnic Software productions (TNSP) +# +# This script is freely distributable under GNU GPL (version 2) license. +# +############################################################################ + +# Datafile, MUST be set to same as in feeds.tcl +set datafile "/home/niinuska/bot/data.feeds" + +# Use a HTTP proxy? 1 = yes, 0 = no +set http_proxy 0 + +# HTTP proxy address and port +set http_proxy_host "cache.inet.fi" +set http_proxy_port 800 + + +############################################################################## +set html_ent [split " | |»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] + +package require http +::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5" +if {$http_proxy != 0} { + ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port +} + + +proc convert_ent {udata} { + global html_ent + return [string map $html_ent $udata] +} + + +proc add_entry {uname uprefix uurl udesc} { + global entries isentries newurls currclock + set utest "$uprefix[convert_ent $uurl]" + set isentries($utest) 1 + if {[catch {set utmp $entries($utest)}]} { + set entries($utest) [list $currclock $uname $utest [convert_ent $udesc]] + incr newurls + } +} + + +proc add_rss_feed {datauri dataname dataprefix} { + if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" + return 1 + } + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set umatches [regexp -all -nocase -inline -- ".\*\?<..CDATA.(.\*\?)\\\]\\\]>.\*\?(http.\*\?).\*\?" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]] + } + + if {$nmatches == 0} { + set umatches [regexp -all -nocase -inline -- ".\*\?(.\*\?).\*\?(http.\*\?).\*\?" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]] + } + } + + if {$nmatches == 0} { + set umatches [regexp -all -nocase -inline -- "\]*>.\*\?(.\*\?).\*\?(http.\*\?).\*\?" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]] + } + } + return 0 +} + + +############################################################################## +### Luetaan vanhat paskat +set oldurls 0 +set newurls 0 +if {![catch {set ufile [open $datafile r 0600]} uerrmsg]} { + while {![eof $ufile]} { + gets $ufile uline + set urec [split $uline "½"] + if {[llength $urec] == 4} { + set entries([lindex $urec 2]) $urec + set isentries([lindex $urec 2]) 0 + incr oldurls + } + } + close $ufile +} +set currclock [clock seconds] + + +############################################################################## +### Haetaan ja parsitaan Halla-ahon jutut +set datauri "http://www.halla-aho.com/scripta/"; +set dataname "Mestari" +if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" +} else { + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set umatches [regexp -all -nocase -inline -- "(\[^<\]+)" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname $datauri [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]] + } + + set umatches [regexp -all -nocase -inline -- "(\[^<\]\[^b\]\[^<\]+)" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname $datauri [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]] + } +} + + +### The Adventurers +set datauri "http://www.peldor.com/chapters/index_sidebar.html"; +set dataname "The Adventurers" +if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" +} else { + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set umatches [regexp -all -nocase -inline -- "(\[^<\]+)" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname "http://www.peldor.com/" [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]] + } +} + + +### Order of the Stick +set datauri "http://www.giantitp.com/comics/oots.html"; +set dataname "OOTS" +if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" +} else { + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set umatches [regexp -all -nocase -inline -- "(\[^<\]+)" $upage] + set nmatches [llength $umatches] + for {set n 0} {$n < $nmatches} {incr n 3} { + add_entry $dataname "http://www.giantitp.com" [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]] + } +} + + +### Hae RSS-feedit +add_rss_feed "http://www.kaleva.fi/rss/145.xml" "Kaleva/Tiede" "" + +#add_rss_feed "http://sektori.com/?tpl=rssNewsFeed" "Sektori" "" + +add_rss_feed "http://www.effi.org/xml/uutiset.rss" "EFFI" "" + +add_rss_feed "http://www.mtv3.fi/rss/uutiset_rikos.rss" "MTV3/Rikos" "" + +add_rss_feed "http://www.blastwave-comic.com/rss/blastwave.xml" "Blastwave" "" + +#add_rss_feed "http://lehti.samizdat.info/feed/" "Lehti" "" + +############################################################################## +### Avataan tulostiedosto +set tmpfname "$datafile.tmp" +if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} { + puts "Error opening $tmpfname for writing: $uerrmsg" + return 1 +} + +set uexpire [expr [clock seconds] - (7*24*60*60)] +foreach {ukey udata} [array get entries] { +# if {$isentries($ukey) != 0 || [lindex $udata 0] >= $uexpire} { + puts $outfile [join $udata "½"] +# } +} + +close $outfile +if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} { + puts "Error renaming $tmpfname to $datafile: $uerrmsg" +} +#puts "$newurls new entries." diff -r 000000000000 -r 1c4e2814cd41 hae_ruoka.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hae_ruoka.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,138 @@ +#!/usr/bin/tclsh +########################################################################## +# +# RuokaLista fetcher v1.0 by ccr/TNSP +# (C) Copyright 2010 Tecnic Software productions (TNSP) +# +########################################################################## + +# Datatiedosto, oltava sama kuin ruoka.tcl:n vastaava asetus +set datafile "/home/niinuska/bot/data.ruoka" + +# Käytä HTTP proxya? 1 = kyllä, 0 = ei +set http_proxy 0 + +# HTTP proxyn osoite ja portti +set http_proxy_host "cache.inet.fi" +set http_proxy_port 800 + + +############################################################################## +set html_ent [split "\n| |\r| |
| | | | | |»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] + +package require http +::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5" +if {$http_proxy != 0} { + ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port +} + + +proc convert_ent {udata} { + global html_ent + return [string map $html_ent $udata] +} + + +proc add_entry {uname uday udate udesc} { + global entries + set utest "$uname:$udate" + if {[catch {set utmp $entries($utest)}]} { + set entries($utest) [list $uname $uday $udate $udesc] + } +} + + +proc add_amica {datauri dataname} { + if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" + return 1 + } + + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set nmatches 1 + while {$nmatches > 0} { + set umatches [regexp -nocase -inline -- "(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai).?.?(\[^<\]+)(.*)\$" $upage] + set nmatches [llength $umatches] + if {$nmatches > 3} { + set umat [regexp -nocase -inline -- "^(.+?)(|)" [lindex $umatches 3]] + set umat [regexp -all -nocase -inline -- "(.\*\?)" [lindex $umat 1]] + set tmp "" + foreach {ukey udata} $umat { + set item [string trim [convert_ent $udata]] + if {[string length $item] > 0} { + lappend tmp $item + } + } + add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] + } + set upage [lindex $umatches 3] + } + + return 0 +} + +proc add_uniresta {datauri dataname} { + if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" + return 1 + } + + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set nmatches 1 + while {$nmatches > 0} { + set umatches [regexp -nocase -inline -- "(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) +(\[^<\]+)(.*)\$" $upage] + set nmatches [llength $umatches] + if {$nmatches > 3} { + set umat [regexp -nocase -inline -- "^(.+?)


" [lindex $umatches 3]] + set umat [regexp -all -nocase -inline -- "(.\*\?)
" [lindex $umat 1]] + set tmp "" + foreach {ukey udata} $umat { + set item [string trim [convert_ent $udata]] + if {[string length $item] > 0} { + lappend tmp $item + } + } + add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] + } + set upage [lindex $umatches 3] + } + + return 0 +} + + +############################################################################## +# Amica/OAMK tekniikan yksikkö +add_amica "http://www.amica.fi/kotkanpoika" "OAMK" + +# Oulun yliopiston Unirestat +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=2" "Aularavintola" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=3" "Discus" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=4" "Julinia" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=5" "Kastari" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=6" "Snellmania" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=7" "Pruxis" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=10" "Vanilla" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=11" "Minttu" + + +############################################################################## +### Open result datafile and save data +set tmpfname "$datafile.tmp" +if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} { + puts "Error opening $tmpfname for writing: $uerrmsg" + return 1 +} + +foreach {ukey udata} [array get entries] { + puts $outfile [join $udata "½"] +} + +close $outfile +if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} { + puts "Error renaming $tmpfname to $datafile: $uerrmsg" +} diff -r 000000000000 -r 1c4e2814cd41 hae_saatiedot.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hae_saatiedot.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,62 @@ +#!/usr/bin/tclsh + +# Polku ja tiedosto mihin tiedot talletetaan +set datafile "/home/niinuska/bot/saa.data" + +# HTTP proxy +# 1 = kyllä +# 0 = ei +set use_proxy 0 + +# HTTP proxy osoite ja portti (jos ed. optio 1) +set http_proxy_host "cache.inet.fi" +set http_proxy_port 800 + + +############################################################################## +package require http +::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5" +if {$use_proxy != 0} { + ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port +} + + +############################################################################## +proc fetch_uri {uurl} { + global ngot + if {[catch {set utoken [::http::geturl $uurl -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting #$uurl: $uerrmsg" + return "" + } else { + incr ngot + set udata [::http::data $utoken] + ::http::cleanup $utoken + return $udata + } +} + +############################################################################## +set tmpfname "$datafile.tmp" +if {[catch {set savefile [open $tmpfname w 0600]} uerrmsg]} { + puts "Error opening $tmpfname: $uerrmsg" + return 1 +} + +# Haetaan 22 framea osoitteista +# http://www.tiehallinto.fi/alk/tiesaa/tiesaa_maak_1.html - +# http://www.tiehallinto.fi/alk/tiesaa/tiesaa_maak_22.html +# ja talletetaan kaikki samaan tiedostoon +set ngot 0 +for { set i 1 } { $i < 23 } { incr i } { + puts $savefile [fetch_uri "http://alk.tiehallinto.fi/alk/tiesaa/tiesaa_maak_$i.html"] +} + +#set paske [fetch_uri "http://www.wunderground.com/global/stations/56294.html"] + +close $savefile +if {$ngot > 5} { + if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} { + puts "Error renaming $tmpfname to $datafile: $uerrmsg" + } +} + diff -r 000000000000 -r 1c4e2814cd41 help.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/help.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,30 @@ +############################################################################ +# Niinuska Help +############################################################################ +set nn_message "Niinuska Help v0.1 by ccr/TNSP" +set nn_preferredmsg "PRIVMSG" + +putlog "$nn_message" +bind pub - !help nn_pubmsg +bind pub - !apua nn_pubmsg + +# ------------------------------------------------------------------------- +proc nn_smsg {udest umsg} { + global nn_preferredmsg + + putserv "$nn_preferredmsg $udest :$umsg" +} + + +# ------------------------------------------------------------------------- +proc nn_pubmsg {nick uhost hand chan args} { + if {$args == "{}" || $args == ""} { set args $hand } + + nn_smsg $chan "Lisätietoja: http://tnsp.org/irc/readme.php" + nn_smsg $chan "!sää \[paikka|minmax\] ; !urlfind <+sana|-sana|%käyttäjä> ; !tj \[käyttäjä\] ; !tjaamut \[-\]vuorokaudet \[\[-\]tunnit\]" + nn_smsg $chan "!laske (\002HUOM! Pyöristää vakiona lähimpään kokonaislukuun, käytä yhtä desimaalikua vaihtaaksesi tarkkuuden\002)" + nn_smsg $chan "!spede \[nro\] ; !spedefind <+sana|-sana|%käyttäjä> ; !mn \[nro\] ; !mnfind <+sana|-sana|%käyttäjä>" + return 1 +} + +# ------------------------------------------------------------------------- diff -r 000000000000 -r 1c4e2814cd41 index.desc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/index.desc Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,17 @@ +

+This directory contains development versions of my TCL-scripts +for Eggdrop bot. THERE IS ABSOLUTELY NO WARRANTY OR GUARANTEE THAT THESE +SCRIPTS WORK AT ALL. I am not interested about any problems with these +scripts. +

+ +

+There is also no documentation about these except the texts +found in scripts themselves. If you can't figure out them yourself... +well, that's too bad. +

+ +

+- ccr/TNSP, 2010 +

+ diff -r 000000000000 -r 1c4e2814cd41 index.php --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/index.php Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,5 @@ + \ No newline at end of file diff -r 000000000000 -r 1c4e2814cd41 laske.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/laske.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,69 @@ +############################################################################ +# +# Laske v0.2 by ccr/TNSP +# (C) Copyright 2008 Tecnic Software productions (TNSP) +# +# This script is freely distributable under GNU GPL (version 2) license. +# +############################################################################ + +set laske_preferredmsg "PRIVMSG" + + +############################################################################ +# No need to look below this line +############################################################################ +set laske_message "Laske v0.2 by ccr/TNSP" +set laske_reps [split "\$|| ||^|**|pi|3.14159265|e|2.71828183" "|"] + +putlog "$laske_message" +bind pub - !laske laske_pubmsg +bind msg - laske laske_msg + + +# ------------------------------------------------------------------------- +proc laske_smsg {udest umsg} { + global laske_preferredmsg + putserv "$laske_preferredmsg $udest :$umsg" +} + +# ------------------------------------------------------------------------- +proc laske_do {args} { + global laske_reps + +# Tama on jotain ihan uskomattoman perverssia + set lasku [join [join [string map $laske_reps $args] ""] ""] + +# putlog "Laske: $args :: $lasku" + if {[catch { set res [expr $lasku] } errmsg]} { + return $errmsg + } else { + return "$lasku = $res" + } +} + +# ------------------------------------------------------------------------- +proc laske_pubmsg {nick uhost hand chan args} { + if {$args == {} || $args == ""} { + laske_smsg $chan "Laa laalis paski." + return 1 + } + + set result [laske_do $args] + laske_smsg $chan "$nick, $result" + return 1 +} + +# ------------------------------------------------------------------------- +proc laske_msg {nick uhost hand args} { + if {$args == {} || $args == ""} { + laske_smsg $nick "Laa laalis paski." + return 1 + } + + set result [laske_do $args] + laske_smsg $nick "$result" + return 1 +} + +# ------------------------------------------------------------------------- diff -r 000000000000 -r 1c4e2814cd41 mndb.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/mndb.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,346 @@ +########################################################################## +# +# MattiNykanenDB v0.7 by ccr/TNSP +# +# Not for public use or distribution. If you happen to find this, +# send your questions and/or problems to /dev/null, thank you. +# +########################################################################## + +### +### General options +### +# Filename where the logged quote data goes +set mndb_file "data.mndb" + +# 1 = Verbose: Say messages PUBLIC when quote is OK, bad, etc. +# 0 = Quiet : Say privately +set mndb_verbose 0 + +# 1 = Put some info to bot's Logfile when doing stuff... +# 0 = Don't. +set mndb_logmsg 1 + +# What IRC "command" should we use to send messages: +# (Valid alternatives are "PRIVMSG" and "NOTICE") +set mndb_preferredmsg "PRIVMSG" + + +### +### Search related settings +### + +# How many quote's should the !mnfind command show (maximum limit) +set mndb_showmax_pub 3 + +# For private-search, this is the default limit (user can change it) +set mndb_showmax_priv 5 + + +########################################################################## +# No need to look below this line +########################################################################## +#------------------------------------------------------------------------- +set mndb_name "MattiNykanenDB" +set mndb_version "0.7" + + +#------------------------------------------------------------------------- +### Binding initializations +bind pub - !mnfind mndb_pub_find +bind pub - !mnadd mndb_pub_add +bind pub - !mn mndb_pub_mn +bind msg - mnfind mndb_msg_find +bind msg - mn mndb_msg_mn + + +### Initialization messages +set mndb_message "$mndb_name v$mndb_version by ccr/TNSP" +putlog "$mndb_message" + + +#------------------------------------------------------------------------- +### Utility functions +proc mndb_log { jarg } { + global mndb_logmsg mndb_name + + if {$mndb_logmsg != 0} { + putlog "$mndb_name: $jarg" + } +} + + +proc mndb_ctime { utime } { + + if {$utime == "" || $utime == "*"} { + set utime 0 + } + + return [clock format $utime -format "%d.%m.%Y %H:%M"] +} + + +proc mndb_isnumber { uarg } { + set ufoo 1 + + foreach i [split $uarg {}] { + if ![string match \[0-9\] $i] {set ufoo 0} + } + + return $ufoo +} + + +proc mndb_msg {apublic anick achan amsg} { +global mndb_preferredmsg + +if {$apublic == 0} { + putserv "$mndb_preferredmsg $anick :$amsg" + } else { + putserv "$mndb_preferredmsg $achan :$anick, $amsg" + } +} + + +#------------------------------------------------------------------------- +proc mndb_add {utext unick uhost uchan upublic} { +global mndb_file + + if {[string length $utext] < 10} { + mndb_msg $upublic $unick $uchan "pyh." + return 0 + } + +### Create the database file if it does not exist yet + set fd [open $mndb_file a+] + close $fd + +### OK. The quote is valid, but let's check if we already know it. + set fd [open $mndb_file r] + set sindex 0 + set smax -1 + + while {![eof $fd]} { + gets $fd foo + incr sindex + + set foo [split $foo "|"] + set qindex [lindex $foo 0] + if {$qindex > $smax} { set smax $qindex } + } + + close $fd + +### OK, the quote was not already known and IS valid. Add it. + + incr smax + + set fd [open $mndb_file a+] + puts $fd "$smax|$utext|[unixtime]|$unick|$uhost|$uchan" + close $fd + +### Log some data + mndb_log "Added quote #$smax ($unick @ $uchan): $utext" + +### Let's report success to user + mndb_msg $upublic $unick $uchan "tietokantaa sörkitty (#$smax / $sindex), kiitos." + + return 1 +} + + +#------------------------------------------------------------------------- +proc mndb_find {ipatterns imax} { +global mndb_file + +### Search the database for pattern +### Clear the count, open the quote logfile +set iresults {} +set nresults 0 +set fd [open $mndb_file r] + +### Start searching... +while {![eof $fd]} { + +# Get one quote for inspection + gets $fd foo + set irecord [split [string tolower $foo] "|"] + set itext [lindex $irecord 1] + set iname [lindex $irecord 3] + +# Match with all given patterns and rules + set imatched 1 + + foreach ipattern $ipatterns { + + set foob [split [string tolower $ipattern] " "] + set ftoken [lindex $foob 0] + set fparam [lindex $foob 1] + set fmatch [string match $fparam $itext] + + if {($ftoken == "+") && ($fmatch == 0)} { set imatched 0 } + + if {($ftoken == "-") && ($fmatch == 1)} { set imatched 0 } + + if {($ftoken == "%") && ([string match $fparam $iname] == 0)} { set imatched 0 } + + } + +# If the all patterns matched, add to the list... + if {($imatched == 1) && ($foo != "")} { + incr nresults + lappend iresults $foo + } + + } + +# Close file +close $fd + +# Take only last imax results +return [lrange $iresults [expr $nresults-$imax] $nresults] +} + + + +#------------------------------------------------------------------------- +proc mndb_get { unick uhand uindex } { +global mndb_file + +set ifound 0 +set iindex 0 +set iresults {} +set nresults 0 + +### Create the database file if it does not exist yet +set fd [open $mndb_file a+] +close $fd + +### OK. The quote is valid, but let's check if we already know it. +set fd [open $mndb_file r] + +if {$uindex == ""} { +### Log search + mndb_log "$unick/$uhand get random quote" + +### Do search + while {![eof $fd]} { + gets $fd foo + incr nresults + lappend iresults $foo + } + + set foo [split [lindex $iresults [rand $nresults]] "|"] + set ifound 1 + +} else { +### Log search + mndb_log "$unick/$uhand searched quote #$uindex" + +### Do search + while {![eof $fd] && !$ifound} { + gets $fd foo + set foo [split $foo "|"] + + if {[lindex $foo 0] == $uindex} { + set ifound 1 + } + } +} + +### Close file +close $fd + +### Return result +if {$ifound} { + return "#[lindex $foo 0]: [lindex $foo 1]" + } else { + return "ei löydy." + } +} + + +#------------------------------------------------------------------------- +proc mndb_search {unick uhand uchan utext upublic} { +global mndb_showmax_pub spmsg_nomatch + +### Log search + mndb_log "$unick/$uhand searched quote: $utext" + +### Parse the given command + set footokens [split $utext " "] + foreach ftoken $footokens { + set foomark [string range $ftoken 0 0] + set foopat [string range $ftoken 1 end] + + if {$foomark == "-" || $foomark == "+" || $foomark == "%"} { + lappend ipatlist "$foomark *$foopat*" + } else { + lappend ipatlist "+ *$ftoken*" + } + } + + +### Get the matches + + set iresults [mndb_find $ipatlist $mndb_showmax_pub] + +### Show the results + if {$iresults != ""} { + foreach i $iresults { + set foo [split $i "|"] + mndb_msg $upublic $unick $uchan "#[lindex $foo 0]: [lindex $foo 1]" + } + +# If no quotes were found + } else { + mndb_msg $upublic $unick $uchan "ei löydy." + } +} + + +#------------------------------------------------------------------------- +proc mndb_pub_mn {unick uhost uhand uchan utext} { + +mndb_msg 0 $uchan "" [mndb_get $unick $uhand $utext] +} + + +#------------------------------------------------------------------------- +proc mndb_msg_mn {unick uhost uhand utext} { + +mndb_msg 0 $unick "" [mndb_get $unick $uhand $utext] +} + + +#------------------------------------------------------------------------- +proc mndb_pub_add {unick uhost uhand uchan utext} { + + mndb_add $utext $unick $uhost $uchan 1 +} + + +#------------------------------------------------------------------------- +proc mndb_pub_rm {unick uhost uhand uchan utext} { + + mndb_rm $utext $unick $uhost $uchan 1 +} + + +#------------------------------------------------------------------------- +proc mndb_pub_find {unick uhost uhand uchan utext} { + + mndb_search $unick $uhand $uchan $utext 1 +} + + +#------------------------------------------------------------------------- +proc mndb_msg_find {unick uhost uhand utext} { + + mndb_search $unick $uhand "" $utext 0 +} + + +#------------------------------------------------------------------------- + +# end of script diff -r 000000000000 -r 1c4e2814cd41 ruoka.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ruoka.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,212 @@ +########################################################################## +# +# RuokaLista v1.1 by ccr/TNSP +# (C) Copyright 2004-2010 Tecnic Software productions (TNSP) +# +# Requires hae_ruoka.tcl to be run as a cronjob, for example +# 15 * * * * /absolute/path/to/hae_ruoka.tcl +# +# This script is freely distributable under GNU GPL (version 2) license. +# +########################################################################## + +# Vakioravintola, jos muuta ei annettu/asetettu +set ruoka_restaurant "OAMK" + +# Datatiedosto, oltava sama kuin hae_ruoka.tcl:n vastaava asetus +set ruoka_datafile "/home/niinuska/bot/data.ruoka" + +# Kellonaika, jolloin default-päivä vaihtuu seuraavaksi vuorokaudeksi +# -1 = Ei vaihdeta +# esim. 15 = klo 15 jälkeen näytetään vakiona seuraavan päivän ruokalista +set ruoka_threshold 15 + +# Yleiset asetukset +set ruoka_logmsg 1 +set ruoka_preferredmsg "PRIVMSG" + + +########################################################################## +# No need to look below this line +########################################################################## +set ruoka_name "RuokaLista" +set ruoka_version "1.1" + +### Binding initializations +bind pub - !ruoka ruoka_get_pub +bind msg - ruoka ruoka_get_msg +bind pub - !ruokaset ruoka_set_pub + +### Initialization messages +set ruoka_message "$ruoka_name v$ruoka_version by ccr/TNSP" +putlog "$ruoka_message" + +set ruoka_days {Sunnuntai Maanantai Tiistai Keskiviikko Torstai Perjantai Lauantai} + +#------------------------------------------------------------------------- +proc ruoka_log {arg} { + global ruoka_logmsg ruoka_name + if {$ruoka_logmsg != 0} { + putlog "$ruoka_name: $arg" + } +} + + +proc ruoka_msg {apublic anick achan amsg} { + global ruoka_preferredmsg + if {$apublic == 1} { + putserv "$ruoka_preferredmsg $achan :$amsg" + } else { + putserv "$ruoka_preferredmsg $anick :$amsg" + } +} + + +proc ruoka_get_restaurants {urestaurants} { + global ruoka_datafile + upvar $urestaurants restaurants + + if {![catch {set ufile [open "$ruoka_datafile" r 0600]} uerrmsg]} { + while {![eof $ufile]} { + gets $ufile uline + set urec [split $uline "½"] + if {[llength $urec] == 4} { + set restaurants([lindex $urec 0]) 1 + } + } + } +} + + +proc ruoka_match_day {umatch} { + global ruoka_days + if {$umatch == "" || $umatch == "{}"} { return "" } + set udate "" + foreach i $ruoka_days { + if {[string match "$umatch*" [string tolower $i]]} { set udate $i } + } + return $udate +} + + +proc ruoka_match_restaurant {urestaurants umatch} { + upvar $urestaurants restaurants + if {$umatch == "" || $umatch == "{}"} { return "" } + foreach {nimi arvo} [array get restaurants] { + if {[string match "$umatch*" [string tolower $nimi]]} { + return $nimi + } + } + return "" +} + + +#------------------------------------------------------------------------- +proc ruoka_get {unick uhand uchan uargs upublic} { + global ruoka_restaurant ruoka_datafile ruoka_days ruoka_threshold + + # Get list of restaurants + ruoka_get_restaurants restaurants + + # Check and handle arguments + set ulist [split [string tolower $uargs] " "] + set rarg1 [lindex $ulist 0] + set rarg2 [lindex $ulist 1] + + if {$rarg1 == "?" || $rarg1 == "help"} { + set tmp [join [array names restaurants] ", "] + ruoka_msg $upublic $unick $uchan "Käyttö: ruoka \[ravintola\] \[päivä\]" + ruoka_msg $upublic $unick $uchan "Huom! Jos päivää ei anneta, tiedot haetaan tältä päivältä." + ruoka_msg $upublic $unick $uchan "Käyttö: ruokaset " + ruoka_msg $upublic $unick $uchan "Jossa ravintola on yksi seuraavista: $tmp" + return 0 + } + + # Try to parse arguments, if any + set urestaurant "" + set udate "" + if {$rarg1 != ""} { + set udate [ruoka_match_day $rarg1] + if {$udate == ""} { + set udate [ruoka_match_day $rarg2] + set urestaurant [ruoka_match_restaurant restaurants $rarg1] + } else { + set urestaurant [ruoka_match_restaurant restaurants $rarg2] + } + } + + # Default date to today + if {$udate == ""} { + set sstamp [unixtime] + + # Check if threshold setting is active and act accordingly + if {$ruoka_threshold > 0 && [clock format $sstamp -format "%H"] > $ruoka_threshold} { + set sstamp [expr $sstamp + 60*60*(24 - $ruoka_threshold)+30] + } + + set udate [lindex $ruoka_days [clock format $sstamp -format "%w"]] + } + + # If no restaurant given, try to get one from user settings + if {$urestaurant == ""} { + set urestaurant [getuser $uhand XTRA "restaurant"] + # If still no known/set restaurant, use global default + if {$urestaurant == ""} { + set urestaurant $ruoka_restaurant + } + } + + # Read datafile + if {![catch {set ufile [open "$ruoka_datafile" r 0600]} uerrmsg]} { + set found 0 + while {![eof $ufile]} { + gets $ufile uline + set urec [split $uline "½"] + if {[llength $urec] == 4 && [lindex $urec 1] == $udate && [lindex $urec 0] == $urestaurant} { + ruoka_msg $upublic $unick $uchan "\002[lindex $urec 0]\002, [lindex $urec 1] \002[lindex $urec 2]\002: [lindex $urec 3]" + set found 1 + break + } + } + close $ufile + if {$found == 0} { + ruoka_msg $upublic $unick $uchan "Ei tietoja ($udate, $urestaurant)" + } + } else { + ruoka_log "Could not open datafile: $uerrmsg" + } +} + + + +#------------------------------------------------------------------------- +proc ruoka_get_pub {unick uhost uhand uchan uargs} { + ruoka_get $unick $uhand $uchan $uargs 1 + return 0 +} + +#------------------------------------------------------------------------- +proc ruoka_get_msg {unick uhost uhand uargs} { + ruoka_get $unick $uhand "PRIV" $uargs 0 + return 0 +} + +#------------------------------------------------------------------------- +proc ruoka_set_pub {unick uhost uhand uchan uargs} { + array unset restaurants + ruoka_get_restaurants restaurants + set rav "" + if {$uargs != "{}" && $uargs != ""} { + set rav [ruoka_match_restaurant restaurants $uargs] + } + if {$rav != ""} { + ruoka_msg 1 $unick $uchan "Vakioravintolaksi asetettu: $rav" + setuser $uhand XTRA "restaurant" "$rav" + } else { + set tmp [join [array names restaurants] ", "] + ruoka_msg 1 $unick $uchan "Ravintolan oltava yksi seuraavista: $tmp" + } + return 0 +} + +# end of script diff -r 000000000000 -r 1c4e2814cd41 spededb.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/spededb.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,347 @@ +########################################################################## +# +# SpedeDB v0.7 by ccr/TNSP +# +# Not for public use or distribution. If you happen to find this, +# send your questions and/or problems to /dev/null, thank you. +# +########################################################################## + +### +### General options +### +# Filename where the logged SPEDE data goes +set spdb_file "data.spededb" + +# 1 = Verbose: Say messages PUBLIC when SPEDE is OK, bad, etc. +# 0 = Quiet : Say privately +set spdb_verbose 0 + +# 1 = Put some info to bot's Logfile when doing stuff... +# 0 = Don't. +set spdb_logmsg 1 + +# What IRC "command" should we use to send messages: +# (Valid alternatives are "PRIVMSG" and "NOTICE") +set spdb_preferredmsg "PRIVMSG" + + +### +### Search related settings +### + +# How many SPEDE's should the !spedefind command show (maximum limit) +set spdb_showmax_pub 3 + +# For private-search, this is the default limit (user can change it) +set spdb_showmax_priv 5 + + +########################################################################## +# No need to look below this line +########################################################################## +#------------------------------------------------------------------------- +set spdb_name "SpedeDB" +set spdb_version "0.7" + + +#------------------------------------------------------------------------- +### Binding initializations +bind pub - !spedefind spdb_pub_find +bind pub - !spedeadd spdb_pub_add +bind pub - !spede spdb_pub_spede +bind msg - spedefind spdb_msg_find +bind msg - spede spdb_msg_spede + + +### Initialization messages +set spdb_message "$spdb_name v$spdb_version by ccr/TNSP" +putlog "$spdb_message" + + +#------------------------------------------------------------------------- +### Utility functions +proc spdb_log { jarg } { + global spdb_logmsg spdb_name + + if {$spdb_logmsg != 0} { + putlog "$spdb_name: $jarg" + } +} + + +proc spdb_ctime { utime } { + + if {$utime == "" || $utime == "*"} { + set utime 0 + } + + return [clock format $utime -format "%d.%m.%Y %H:%M"] +} + + +proc spdb_isnumber { uarg } { + set ufoo 1 + + foreach i [split $uarg {}] { + if ![string match \[0-9\] $i] {set ufoo 0} + } + + return $ufoo +} + + +proc spdb_msg {apublic anick achan amsg} { +global spdb_preferredmsg + +if {$apublic == 0} { + putserv "$spdb_preferredmsg $anick :$amsg" + } else { + putserv "$spdb_preferredmsg $achan :$anick, $amsg" + } +} + + +#------------------------------------------------------------------------- +proc spdb_add {utext unick uhost uchan upublic} { +global spdb_file + + +if {"x$utext" == "x"} { + spdb_msg $upublic $unick $uchan "pyh." + return 0 + } + +### Create the database file if it does not exist yet + set fd [open $spdb_file a+] + close $fd + +### OK. The SPEDE is valid, but let's check if we already know it. + set fd [open $spdb_file r] + set sindex 0 + set smax -1 + + while {![eof $fd]} { + gets $fd foo + incr sindex + + set foo [split $foo "|"] + set qindex [lindex $foo 0] + if {$qindex > $smax} { set smax $qindex } + } + + close $fd + +### OK, the SPEDE was not already known and IS valid. Add it. + + incr smax + + set fd [open $spdb_file a+] + puts $fd "$smax|$utext|[unixtime]|$unick|$uhost|$uchan" + close $fd + +### Log some data + spdb_log "Added SPEDE #$smax ($unick @ $uchan): $utext" + +### Let's report success to user + spdb_msg $upublic $unick $uchan "tietokantaa sörkitty (#$smax / $sindex), kiitos." + + return 1 +} + + +#------------------------------------------------------------------------- +proc spdb_find {ipatterns imax} { +global spdb_file + +### Search the database for pattern +### Clear the count, open the SPEDE logfile +set iresults {} +set nresults 0 +set fd [open $spdb_file r] + +### Start searching... +while {![eof $fd]} { + +# Get one SPEDE for inspection + gets $fd foo + set irecord [split [string tolower $foo] "|"] + set itext [lindex $irecord 1] + set iname [lindex $irecord 3] + +# Match with all given patterns and rules + set imatched 1 + + foreach ipattern $ipatterns { + + set foob [split [string tolower $ipattern] " "] + set ftoken [lindex $foob 0] + set fparam [lindex $foob 1] + set fmatch [string match $fparam $itext] + + if {($ftoken == "+") && ($fmatch == 0)} { set imatched 0 } + + if {($ftoken == "-") && ($fmatch == 1)} { set imatched 0 } + + if {($ftoken == "%") && ([string match $fparam $iname] == 0)} { set imatched 0 } + + } + +# If the all patterns matched, add to the list... + if {($imatched == 1) && ($foo != "")} { + incr nresults + lappend iresults $foo + } + + } + +# Close file +close $fd + +# Take only last imax results +return [lrange $iresults [expr $nresults-$imax] $nresults] +} + + + +#------------------------------------------------------------------------- +proc spdb_get { unick uhand uindex } { +global spdb_file + +set ifound 0 +set iindex 0 +set iresults {} +set nresults 0 + +### Create the database file if it does not exist yet +set fd [open $spdb_file a+] +close $fd + +### OK. The SPEDE is valid, but let's check if we already know it. +set fd [open $spdb_file r] + +if {$uindex == ""} { +### Log search + spdb_log "$unick/$uhand get random SPEDE" + +### Do search + while {![eof $fd]} { + gets $fd foo + incr nresults + lappend iresults $foo + } + + set foo [split [lindex $iresults [rand $nresults]] "|"] + set ifound 1 + +} else { +### Log search + spdb_log "$unick/$uhand searched SPEDE #$uindex" + +### Do search + while {![eof $fd] && !$ifound} { + gets $fd foo + set foo [split $foo "|"] + + if {[lindex $foo 0] == $uindex} { + set ifound 1 + } + } +} + +### Close file +close $fd + +### Return result +if {$ifound} { + return "#[lindex $foo 0]: [lindex $foo 1] ([lindex $foo 3])" + } else { + return "ei löydy." + } +} + + +#------------------------------------------------------------------------- +proc spdb_search {unick uhand uchan utext upublic} { +global spdb_showmax_pub spmsg_nomatch + +### Log search + spdb_log "$unick/$uhand searched SPEDE: $utext" + +### Parse the given command + set footokens [split $utext " "] + foreach ftoken $footokens { + set foomark [string range $ftoken 0 0] + set foopat [string range $ftoken 1 end] + + if {$foomark == "-" || $foomark == "+" || $foomark == "%"} { + lappend ipatlist "$foomark *$foopat*" + } else { + lappend ipatlist "+ *$ftoken*" + } + } + + +### Get the matches + + set iresults [spdb_find $ipatlist $spdb_showmax_pub] + +### Show the results + if {$iresults != ""} { + foreach i $iresults { + set foo [split $i "|"] + spdb_msg $upublic $unick $uchan "#[lindex $foo 0]: [lindex $foo 1] ([lindex $foo 3] @ [spdb_ctime [lindex $foo 2]])" + } + +# If no SPEDEs were found + } else { + spdb_msg $upublic $unick $uchan "ei löydy." + } +} + + +#------------------------------------------------------------------------- +proc spdb_pub_spede {unick uhost uhand uchan utext} { + +spdb_msg 0 $uchan "" [spdb_get $unick $uhand $utext] +} + + +#------------------------------------------------------------------------- +proc spdb_msg_spede {unick uhost uhand utext} { + +spdb_msg 0 $unick "" [spdb_get $unick $uhand $utext] +} + + +#------------------------------------------------------------------------- +proc spdb_pub_add {unick uhost uhand uchan utext} { + + spdb_add $utext $unick $uhost $uchan 1 +} + + +#------------------------------------------------------------------------- +proc spdb_pub_rm {unick uhost uhand uchan utext} { + + spdb_rm $utext $unick $uhost $uchan 1 +} + + +#------------------------------------------------------------------------- +proc spdb_pub_find {unick uhost uhand uchan utext} { + + spdb_search $unick $uhand $uchan $utext 1 +} + + +#------------------------------------------------------------------------- +proc spdb_msg_find {unick uhost uhand utext} { + + spdb_search $unick $uhand "" $utext 0 +} + + +#------------------------------------------------------------------------- + +# end of script diff -r 000000000000 -r 1c4e2814cd41 tj.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tj.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,194 @@ +############################################################################ +# +# TJ (Army Mornings Left-counter) v0.60 by ccr/TNSP +# (C) Copyright 2000,2009 Tecnic Software productions (TNSP) +# Send comments and shit via e-mail: +# +# This script is freely distributable under GNU GPL (version 2) license. +# +# Laskee aamuja tiettyyn paivamaaraan. TJ-paivamaara annettava +# tietenkin etta toimii, oletuksena skripti asettaa (uudelle kayttajalle) +# sen hetkisen ajan + 180 aamua. Esimerkkeja kaytosta: +# !tj [nick] +# /msg TheBot tj [nick] +# +# Ja TJ:n asetus toimii nain: +# !tjaamut <[-]aamujen lkm tasta hetkesta laskien> [+/- tunnit] +# !tjset dd.mm.yyyy hh:mm +# +############################################################################ + +# Default starting TJ +set tj_defstarttj 180 + + + +############################################################################ +# No need to look below this line +############################################################################ +set tj_message "TJ (SA-INT model) v0.60 by ccr/TNSP" +set tj_dateident "tjdate" +set tj_preferredmsg "PRIVMSG" + +putlog "$tj_message" +bind pub - !tj tj_pubmsg +bind pub - !tjaamut tj_pubaamut +bind pub - !tjset tj_pubset + +# ------------------------------------------------------------------------- +proc tj_correctnickcase { jnick } { + + if {![validuser $jnick]} { return "" } + set nicklwr [string tolower $jnick] + foreach juser [userlist] { + if {[string tolower $juser] == $nicklwr} { + unset nicklwr + return "$juser" + } + } + + return "" +} + + +# ------------------------------------------------------------------------- +proc tj_smsg {udest umsg} { + global tj_preferredmsg + + putserv "$tj_preferredmsg $udest :$umsg" +} + + +# ------------------------------------------------------------------------- +proc tj_pubmsg {nick uhost hand chan args} { + if {$args == "{}" || $args == ""} { set args $hand } + set args [lindex [split $args " "] 0] + + tj_smsg $chan [tj_gettj $args $chan] + return 1 +} + + +# ------------------------------------------------------------------------- +proc tj_ctime { utime } { + return [clock format $utime -format "%d.%m.%Y %H:%M"] +} + + +# ------------------------------------------------------------------------- +proc tj_pubaamut {unick uhost uhand uchan uargs} { + set foo [split $uargs " "] + set tjdays [lindex $foo 0] + set tjhours [lindex $foo 1] + if {$tjdays == ""} { + tj_smsg $uchan "Hälärm." + return 1 + } + + if {$tjhours == ""} { set tjhours 0 } + + set udate [expr [unixtime] + ($tjdays * 86400) + ($tjhours * 3600)] + tj_smsg $uchan [tj_settj $uhand $unick $udate] + return 1 +} + + +# ------------------------------------------------------------------------- +proc tj_pubset {unick uhost uhand uchan uargs} { + + set udate [clock scan $uargs -format "%d.%N.%Y %H:%M"] + tj_smsg $uchan [tj_settj $uhand $unick $udate] + return 1 +} + + +# ------------------------------------------------------------------------- +proc tj_settj { uuser unick udate } { + global tj_dateident + + if {![validuser $uuser]} { + return "Tuntematon käyttäjä $uuser." + } + + setuser $uuser XTRA $tj_dateident $udate + return "$unick:n ($uuser) TJ asetettu. ([tj_ctime $udate])" +} + + +# ------------------------------------------------------------------------- +proc tj_gettj {ihandle ichan} { + global tj_defstarttj + global tj_dateident + + # Tarkistetaan onko kayttaja OK + if {![validuser $ihandle]} { + if {$ichan == ""} { + return "$ihandle, Mene pois." + } else { + if {$ihandle == "*"} { + return "En tiedä kuka olet, mene pois." + } else { + return "En tiedä kuka $ihandle on." + } + } + } + + set chandle [tj_correctnickcase $ihandle] + + # Haetaan TJ aloitus paivamaara + set tjpaiva [getuser $chandle XTRA $tj_dateident] + + if {$tjpaiva == ""} { + return "$chandle ei ole asettanut itselleen TJ päivämäärää." + } + + # Lasketaan tamanhetkinen TJ aika + set deltatj [expr $tjpaiva - [unixtime]] + + if {$deltatj < 0} { + set tmp [expr [unixtime] - $tjpaiva] + } else { + set tmp $deltatj + } + + # Lasketaan TJ aamut, tunnit jne + set aamut [expr ($tmp / 86400)] + set tunnit [expr (($tmp % 86400) / 3600)] + + # Maaritetaan sanalause + if {$ichan != ""} { + set tjmt "$chandle:lla on" + set tjmi "$chandle on" + } else { + set tjmt "Sinulla on" + set tjmi "Sinä olet" + } + + if {$aamut > 0} { + set lause "$aamut aamua" + } else { + set lause "" + } + + if {$tunnit > 0} { + if {$aamut > 0} { set lause "$lause ja" } + set lause "$lause $tunnit tuntia" + } + + if {$aamut == 0 && $deltatj > 0} { + if {$tunnit == 0} { + return "$tjmt TOSI WÄINÖ! TJ 0!!" + } else { + return "$tjmt AIKA WÄBÄ -- TJ $tunnit tuntia!" + } + } else { + if {$deltatj > 0} { + return "$tjmt $lause jäljellä... ([tj_ctime $tjpaiva])" + } else { + return "$tjmi ollut reservissä jo $lause! ([tj_ctime $tjpaiva])" + } + } + +} + +# ------------------------------------------------------------------------- diff -r 000000000000 -r 1c4e2814cd41 urllog.php.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/urllog.php.txt Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,57 @@ + \ No newline at end of file diff -r 000000000000 -r 1c4e2814cd41 urllog.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/urllog.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,711 @@ +########################################################################## +# +# URLLog v1.99.12 by ccr/TNSP +# (C) Copyright 2000-2010 Tecnic Software productions (TNSP) +# +########################################################################## +# +# NOTICE! If you are upgrading to v1.90+ from any older version, you +# might want to run a conversion script against your URL-database file. +# +# It is NOT strictly necessary, but recommended especially if you +# utilize the "shorturl" functionality. The conversion script is +# available at < http://tnsp.org/egg-tcls/ > +# +########################################################################## +### +### HTTP options +### +# Set to 1 if you want to use proxy +set http_proxy 0 + +# Proxy host and port number (only used if enabled above) +set http_proxy_host "" +set http_proxy_port 8080 + + +### +### General options +### + +# Filename where the logged URL data goes +set urllog_file "data.urllog" + + +# 1 = Verbose: Say messages when URL is OK, bad, etc. +# 0 = Quiet : Be quiet (only speak if asked with !urlfind, etc) +set urllog_verbose 1 + + +# 1 = Put some info to bot's Logfile during operation +# 0 = Don't. +set urllog_logmsg 1 + + +# 1 = Check URLs for validity and existence before adding. +# 0 = No checks. Add _anything_ that looks like an URL to the database. +set urllog_check 1 + + +### +### WWW page creation options +### +# 1 = Create the www pages, 0 = Don't. +set urllog_makewww 0 + +# TIP: If you don't want the bot to create the HTML-file, you can +# use a simple Perl/Ruby/Python/PHP/whatnot-scripted page to do that. + +# Filename AND FULL PATH of the html-file where the www-format log goes +# (Remember to set the permissions right after the file has been created) +set urllog_webfile "/home/niinuska/public_html/urllog.html" + + +### +### Search related settings +### + +# 0 = No search-commands available +# 1 = Search enabled +set urllog_search 1 + + +# How many URL's should the !urlfind command show (maximum limit) +set urllog_showmax_pub 3 + + +# For private-search, this is the default limit (user can change it) +set urllog_showmax_priv 6 + + +### +### ShortURL-settings +### + +# 1 = Use ShortURLs +# 0 = Don't. +set urllog_shorturl 1 + +# Max length of original URL to be shown +set urllog_shorturl_orig 30 + +# Path to PHP/CGI-script that redirects ShortURLs +set urllog_shorturl_prefix "http://tnsp.org/u/" + + +### +### Message-texts +### + +# No such host was found +set urlmsg_nosuchhost "ei tommosta oo!" + +# Could not connect host (I/O errors etc) +set urlmsg_ioerror "kraak, virhe yhdynnässä." + +# HTTP timeout +set urlmsg_timeout "ei jaksa ootella" + +# No such document was found +set urlmsg_errorgettingdoc "siitosvirhe" + +# URL was already known (was in database) +set urlmsg_alreadyknown "wanha!" +#set urlmsg_alreadyknown "Empiiristen havaintojen perusteella ja tällä sovellutusalueella esiintyneisiin aikaisempiin kontekstuaalisiin ilmaisuihin viitaten uskallan todeta, että sovellukseen ilmoittamasi tietoverkko-osoite oli kronologisti ajatellen varsin postpresentuaalisesti sopimaton ja ennestään hyvin tunnettu." + +# No match was found when searched with !urlfind or other command +set urlmsg_nomatch "Ei osumia." + + +### +### Things that you usually don't need to touch ... +### + +# What IRC "command" should we use to send messages: +# (Valid alternatives are "PRIVMSG" and "NOTICE") +set urllog_preferredmsg "PRIVMSG" + +# The valid known Top Level Domains (TLDs), but not the country code TLDs +# (Now includes the new IANA published TLDs) +set urllog_tlds "org,com,net,mil,gov,biz,edu,coop,aero,info,museum,name,pro,int" + + +########################################################################## +# No need to look below this line +########################################################################## +#------------------------------------------------------------------------- +set urllog_name "URLLog" +set urllog_version "1.99.12" + +set urllog_tlds [split $urllog_tlds ","] +set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] + +set urllog_html_ent [split "‪||‬||‎||å|å|Å|Å|é|é|:|:|ä|ä|ö|ö|ä|ä|ö|ö| | |-|-|”|\"|“|\"|»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] + + +### HTTP module initialization +package require http +::http::config -useragent "$urllog_name/$urllog_version" +if {$http_proxy != 0} { + ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port +} + + +### Binding initializations +if {$urllog_search != 0} { + bind pub - !urlfind urllog_pub_urlfind + bind msg - urlfind urllog_msg_urlfind +} + +bind pubm - *.* urllog_checkmsg +bind topc - *.* urllog_checkmsg +bind msg - paska urllog_checkmsg2 + +if {$urllog_makewww != 0} { + bind dcc m dowebfile urllog_dowebfile + bind time - "*0 % % % %" urllog_timer +} + + +### Initialization messages +set urllog_message "$urllog_name v$urllog_version (C) 2000-2010 ccr/TNSP" +putlog "$urllog_message" + +if {$http_proxy != 0} { + putlog " (Using proxy $http_proxy_host:$http_proxy_port)" +} + +if {$urllog_check != 0} { + putlog " (Additional URL validity checks enabled)" +} + +if {$urllog_verbose != 0} { + putlog " (Verbose mode enabled)" +} + +if {$urllog_makewww != 0} { + putlog " (Creating WWW page to $urllog_webfile)" +} + +if {$urllog_search != 0} { + putlog " (Search commands enabled)" +} + + +#------------------------------------------------------------------------- +### Utility functions +proc urllog_log {arg} { + global urllog_logmsg urllog_name + + if {$urllog_logmsg != 0} { + putlog "$urllog_name: $arg" + } +} + + +proc urllog_ctime { utime } { + + if {$utime == "" || $utime == "*"} { + set utime 0 + } + + return [clock format $utime -format "%d.%m.%Y %H:%M"] +} + + +proc urllog_dowebfile {hand idx text} { +global urllog_name urllog_makewww + +if {$urllog_makewww == 1} { + urllog_log "Making webfiles..." + urllog_make_web_file +} else { + urllog_log "Webfile disabled." +} +} + + +proc urllog_isnumber {uarg} { + set ufoo 1 + + foreach i [split $uarg {}] { + if {![string match \[0-9\] $i]} {set ufoo 0} + } + + return $ufoo +} + + +proc urllog_msg {apublic anick achan amsg} { + global urllog_preferredmsg + + if {$apublic == 1} { + putserv "$urllog_preferredmsg $achan :$amsg" + } else { + putserv "$urllog_preferredmsg $anick :$amsg" + } +} + + +proc urllog_verb_msg {anick achan amsg} { + global urllog_verbose + + if {$urllog_verbose != 0} { + urllog_msg 1 $anick $achan $amsg + } +} + + +proc urllog_convert_ent {udata} { + global urllog_html_ent + regsub -all " " $udata " " utmp + regsub -all "\r" $udata " " utmp + regsub -all "\n" $utmp " " utmp + regsub -all " *" $utmp " " utmp + regsub -all "\t" $utmp "" utmp + return [string map -nocase $urllog_html_ent $utmp] +} + + +#------------------------------------------------------------------------- +proc urllog_make_web_file {} { +global urllog_file urllog_webfile urllog_message botnick + +# Starting message +urllog_log "Creating HTML-file for WWW..." + +# Open files +set fd [open $urllog_webfile w] +set fd2 [open $urllog_file r] + +# HTML headers +puts $fd "Caught URLs" +puts $fd "" +puts $fd "" +puts $fd "
URLs caught by $botnick
" +puts $fd "" + +# Process database, convert to links & info +while {![eof $fd2]} { + gets $fd2 foo + if {$foo != ""} { + regsub -all "<|>|\"" $foo "" foo + set foo [split $foo " "] + puts $fd "[lindex $foo 0]
Added on [urllog_ctime [lindex $foo 1]] by [lindex $foo 2]
" + } + } + +# HTML footers +puts $fd "
Generated by $urllog_message
" +puts $fd "(Last updated [urllog_ctime [unixtime]])
" +puts $fd "" + +# Close files +close $fd +close $fd2 + +# OK-message +urllog_log "HTML-file generated OK." +} + + +#------------------------------------------------------------------------- +proc urllog_timer {umin uhour uday umonth uyear} { + urllog_make_web_file +} + + +#------------------------------------------------------------------------- +proc urllog_get_short {utime} { + global urllog_shorturl urllog_shorturl_prefix + set ustr "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + set ulen [string length $ustr] + + set u1 [expr $utime / ($ulen * $ulen)] + set utmp [expr $utime % ($ulen * $ulen)] + set u2 [expr $utmp / $ulen] + set u3 [expr $utmp % $ulen] + + return "\[ $urllog_shorturl_prefix[string index $ustr $u1][string index $ustr $u2][string index $ustr $u3] \]" +} + + +#------------------------------------------------------------------------- +proc urllog_chop_url {url} { + global urllog_shorturl_orig + if {[string length $url] > $urllog_shorturl_orig} { + return "[string range $url 0 $urllog_shorturl_orig]..." + } else { + return $url + } +} + +#------------------------------------------------------------------------- +proc urllog_addurl {urlStr urlNick urlHost urlChan urlTitle} { +global urlmsg_alreadyknown urllog_file urllog_shorturl + +### Let's check if we already know the URL +set fd [open $urllog_file a+] +close $fd + +set fd [open $urllog_file r] +set urlID -1 +while {![eof $fd]} { + set qitems [split [gets $fd] " "] + set qindex [lindex $qitems 4] + if {$qindex != "" && $qindex > $urlID} { + set urlID $qindex + } + if {[lindex $qitems 0] == $urlStr} { + urllog_log "URL said by $urlNick ($urlStr) already known" + if {$urllog_shorturl != 0} { + set qstr "[urllog_get_short $urlID] " + } else { + set qstr "" + } + append qstr "([lindex $qitems 2]@[urllog_ctime [lindex $qitems 1]])" + if {[string length $urlTitle] > 0} { + set qstr "$urlmsg_alreadyknown - '$urlTitle' $qstr" + } else { + set qstr "$urlmsg_alreadyknown $qstr" + } + urllog_verb_msg $urlNick $urlChan $qstr + return 0 + } +} +close $fd + + +### OK, the URL was not already known - thus we add it +incr urlID +set urlTime [unixtime] +set fd [open $urllog_file a+] +puts $fd "$urlStr $urlTime $urlNick ($urlHost) $urlID" +close $fd +urllog_log "Added URL ($urlNick@$urlChan): $urlStr" + + +### Let's say something, to confirm that everything went well. +if {$urllog_shorturl != 0} { + set qstr "[urllog_get_short $urlID] " +} else { + set qstr "" +} +if {[string length $urlTitle] > 0} { + urllog_verb_msg $urlNick $urlChan "'$urlTitle' ([urllog_chop_url $urlStr]) $qstr" +} else { + urllog_verb_msg $urlNick $urlChan "[urllog_chop_url $urlStr] $qstr" +} + +return 1 +} + + +#------------------------------------------------------------------------- +proc urllog_http_handler {utoken utotal ucurrent} { + upvar #0 $utoken state + + # Stop after around 3000 received bytes, typically we would assume + # that section is contained in this amount of data. + if {$state(currentsize) >= 3000} { + set state(status) "ok" + } +} + +#------------------------------------------------------------------------- +proc urllog_checkurl {urlStr urlNick urlHost urlChan} { +global botnick urllog_html urllog_tlds urllog_check urllog_file +global urlmsg_nosuchhost urlmsg_ioerror urlmsg_timeout urlmsg_errorgettingdoc +global urllog_httprep urllog_shorturl_prefix urllog_shorturl urllog_encoding + +### Some status +urllog_log "$urlStr ($urlNick@$urlChan)" + +### Try to determine the URL protocol component (if it is missing) +set u_checktld 1 + +if {[string match "*www.*" $urlStr] && ![string match "http://*" $urlStr] && ![string match "https://*" $urlStr]} { + set urlStr "http://$urlStr" + } + +if {[string match "*ftp.*" $urlStr] && ![string match "ftp://*" $urlStr]} { + set urlStr "ftp://$urlStr" + } + +if {[regexp "(ftp|http|https)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr u_match u_prefix ni1 ni2 ni3 ni4]} { + # Check if the IP is on local network + if {($ni1 == 127) || ($ni1 == 10) || ($ni1 == 192 && $ni2 == 168) || ($ni1 == 0)} { + urllog_log "URL pointing to local or invalid network, ignored ($urlStr)." + return 0 + } + + # Skip TLD check for URLs with IP address + set u_checktld 0 + } + +if {$urllog_shorturl != 0 && [string match "*$urllog_shorturl_prefix*" $urlStr]} { + urllog_log "Ignoring ShortURL." + return 0 +} + +### Check the PORT (if the ":" is there) +set u_record [split $urlStr "/"] +set u_hostname [lindex $u_record 2] +set u_port [lindex [split $u_hostname ":"] end] + +if {![urllog_isnumber $u_port] && $u_port != "" && $u_port != $u_hostname} { + urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $u_port" + return 0 + } + +# Default to port 80 (HTTP) +if {![urllog_isnumber $u_port]} { + set u_port 80 + } + +### Is it a http or ftp url? (FIX ME!) +if {[string range $urlStr 0 3] != "http" && [string range $urlStr 0 2] != "ftp"} { + urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED TYPE (not HTTP or FTP)" + return 0 + } + +### Check the Top Level Domain (TLD) validity +if {$u_checktld != 0} { + set u_sane [lindex [split $u_hostname "."] end] + set u_tld [lindex [split $u_sane ":"] 0] + set u_found 0 + + if {[string length $u_tld] == 2} { + # Assume all 2-letter domains to be valid :) + set u_found 1 + } else { + # Check our list of known TLDs + foreach itld $urllog_tlds { + if {[string match $itld $u_tld]} { + set u_found 1 + } + } + } + + if {$u_found == 0} { + urllog_log "Broken URL from $urlNick: ($urlStr) illegal TLD: $u_tld." + return 0 + } + } + +set urlStr [string map $urllog_httprep $urlStr] + +### Do we perform additional optional checks? +if {$urllog_check != 0 && [string range $urlStr 0 6] == "http://"} { + # Does the document pointed by the URL exist? + if {[catch {set utoken [::http::geturl $urlStr -progress urllog_http_handler -blocksize 1024 -timeout 4000]} uerrmsg]} { + urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)" + urllog_log "HTTP request failed: $uerrmsg" + return 0 + } + + upvar #0 $utoken ustate + + if {$ustate(status) == "timeout"} { + urllog_verb_msg $urlNick $urlChan "$urlmsg_timeout" + urllog_log "HTTP request timed out ($urlStr)" + } + + if {$ustate(status) == "error"} { + urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::error $utoken])" + urllog_log "Error in HTTP transaction: [::http::error $utoken] ($urlStr)" + } + + # FIXME! Handle redirects! + if {$ustate(status) == "ok"} { + if {[::http::ncode $utoken] >= 200 && [::http::ncode $utoken] <= 309} { + set udata $ustate(body) + set umatches [regexp -nocase -inline -- "" $udata] + set uconvert 0 + if {[llength $umatches] > 0} { + set uencoding [lindex $umatches 1] + if {[string length $uencoding] > 3} { + set uconvert 1 + } + } + + set umatches [regexp -nocase -inline -- "(.\*\?)" $udata] + if {[llength $umatches] > 0} { + set urlTitle [lindex $umatches 1] + if {$uconvert != 0} { + set urlTitle [encoding convertfrom $uencoding $urlTitle] + } + set urlTitle [urllog_convert_ent $urlTitle] + regsub -all "(^ *| *$)" $urlTitle "" urlTitle + } else { + set urlTitle "" + } + urllog_addurl $urlStr $urlNick $urlHost $urlChan $urlTitle + } else { + urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::code $utoken])" + urllog_log "[::http::code $utoken] - $urlStr" + } + } + + ::http::cleanup $utoken + } else { + # No optional checks, just add the URL + urllog_addurl $urlStr $urlNick $urlHost $urlChan "" + } +} + + +#------------------------------------------------------------------------- +proc urllog_checkmsg {nick uhost hand chan text} { +### Check the nick +if {$nick == "*"} { + urllog_log "urllog_checkmsg: nick was wc, this should not happen." + return 0 + } + +### Do the URL checking +foreach istr [split $text " "] { + if {[string match "*http://*" $istr] || [string match "*ftp://*" $istr] || + [string match "*www.*" $istr] || [string match "*ftp.*" $istr] || + [regexp "(ftp|http|https)://\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}" $istr imatch]} { + urllog_checkurl $istr $nick $uhost $chan + } + } + +return 0 +} + + +#------------------------------------------------------------------------- +### Find from database according to patterns, up to imax results. + +proc urllog_urlfind {ipatterns imax} { +global urllog_file + +### Search the database for pattern +### Clear the count, open the URL logfile +set iresults {} +set nresults 0 +set fd [open $urllog_file r] + +### Start searching... +while {![eof $fd]} { + + # Get one URL for inspection + gets $fd foo + set irecord [split [string tolower $foo] " "] + set iurl [lindex $irecord 0] + set iname [lindex $irecord 2] + + # Match with all given patterns and rules + set imatched 1 + foreach ipattern $ipatterns { + set foob [split [string tolower $ipattern] " "] + set ftoken [lindex $foob 0] + set fparam [lindex $foob 1] + set fmatch [string match $fparam $iurl] + + if {$ftoken == "+" && $fmatch == 0} { set imatched 0 } + + if {$ftoken == "-" && $fmatch == 1} { set imatched 0 } + + if {$ftoken == "%" && [string match $fparam $iname] == 0} { set imatched 0 } + } + + # If the all patterns matched, add to the list... + if {$imatched == 1 && $foo != ""} { + incr nresults + lappend iresults $foo + } +} + +# Close file +close $fd + +# Take only last imax results +return [lrange $iresults [expr $nresults-$imax] $nresults] +} + + +#------------------------------------------------------------------------- +### Parse arguments, find and show the results +proc urllog_find {unick uhand uchan utext upublic} { +global botnick urllog_name urllog_version urllog_shorturl +global urllog_showmax_pub urllog_showmax_priv urlmsg_nomatch + +### Parse the given command + urllog_log "$unick/$uhand searched URL: $utext" + + set footokens [split $utext " "] + foreach ftoken $footokens { + set foomark [string range $ftoken 0 0] + set foopat [string range $ftoken 1 end] + + if {$foomark == "-" || $foomark == "+" || $foomark == "%" || $foomark == "@"} { + lappend ipatlist "$foomark *$foopat*" + } else { + lappend ipatlist "+ *$ftoken*" + } + } + +### Get the matches from database + + if {$upublic == 0} { + set iresults [urllog_urlfind $ipatlist $urllog_showmax_priv] + } else { + set iresults [urllog_urlfind $ipatlist $urllog_showmax_pub] + } + +### Show the results + if {$iresults != ""} { + set j 0 + foreach i $iresults { + incr j + set foo [split $i " "] + set shortURL [lindex $foo 0] + set shortID [lindex $foo 4] + + if {$urllog_shorturl != 0 && $shortID != ""} { + set shortURL "$shortURL [urllog_get_short $shortID]" + } + + urllog_msg $upublic $unick $uchan "#$j: $shortURL ([lindex $foo 2]@[urllog_ctime [lindex $foo 1]])" + } + + } else { + # If no URLs were found + urllog_msg $upublic $unick $uchan $urlmsg_nomatch + } + +return 0 +} + + +#------------------------------------------------------------------------- +### Finding binded functions +proc urllog_pub_urlfind {unick uhost uhand uchan utext} { + +urllog_find $unick $uhand $uchan $utext 1 + +return 0 +} + + +proc urllog_msg_urlfind {unick uhost uhand utext} { + +urllog_find $unick $uhand "" $utext 0 + +return 0 +} + +#------------------------------------------------------------------------- +proc urllog_checkmsg2 {unick uhost uhand utext} { + +urllog_checkurl $utext $unick $uhost "#CHANNEL" + +return 0 +} + + + +# end of script diff -r 000000000000 -r 1c4e2814cd41 urllog_upgrade --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/urllog_upgrade Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,14 @@ +#!/usr/bin/perl +# Extremely simple script for converting old format +# URLLog databases into new format. Usage: +# +# perl urllog_upgrade.pl < old_database_file > new_database_file +# + +$i = 0; +while () { + chomp; + ($murl, $mtime, $mnick, $mhost, $mfoo) = split(/ /); + print "$murl $mtime $mnick $mhost $i\n"; + $i++; +} diff -r 000000000000 -r 1c4e2814cd41 wordkick.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/wordkick.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,207 @@ +########################################################################## +# +# WordKick v1.60 by ccr/TNSP +# +# TO-DO: +# - document this pile of shit. +# +########################################################################## +# Configure these as you like + +## Kickword mask/message file +# (FORMAT: See the example file!) +set wc_badword_file "data.wordkick" + + +## Stupid call-out kick +# 1 = kick everyone who only say someone's nick on one public msg +# 0 = no kick +set wc_callout_kick 1 + +# Kickmessage for call-out kick +set wc_callout_msg "Pälli." + + +## Use "happy messages"? +# 0 = No +# 1 = Yes (you'll need the happymessage-file, see below) +set wc_happy_msg_use 0 + + +## "Random happy-joy-joy-messages file" +# (FORMAT: One message per line) +set wc_happy_msg_file "data.happymsg" + + +## Gentle mode: +# 0 = Kick with kickmessage, say happymsg just before kicking +# 1 = Don't kick, just say happymsg. +set wc_gentlemode 0 + + +## Irritation treshold mode: +# 0 = Normal, immendiate kick on detected kickword. +# 1 = Irritation tresholded kick. See README. +set wc_irritationmode 0 + + +## Irritation treshold value +# Number of how many kickwords to ignore before starting to kick +set wc_irritationtreshold 4 + + +# Preferred message type ("PRIVMSG" and "NOTICE") +set wc_preferredmsg "PRIVMSG" + + +########################################################################## +# No need to look below this line +########################################################################## +set wc_message "WKick v1.60 by ccr/TNSP" +set wc_name "WKick" + + +### +### Read the bad-word file +### +catch {unset wc_bad_mask_list} +catch {unset wc_kick_msg_list} +set wc_badword_max 0 +set fd [open $wc_badword_file r] + while {![eof $fd]} { + gets $fd foo + if {[string first # $foo] && ([lindex $foo 0] != "")} { + set foo [split $foo "$"] + lappend wc_bad_mask_list [lindex $foo 0] + lappend wc_kick_msg_list [lrange $foo 1 end] + incr wc_badword_max + } + } +close $fd + + +### +### Read the happy-message file +### +set wc_happy_msg_max 0 +catch {unset wc_happy_msg_list} +set fd [open $wc_happy_msg_file r] + while {![eof $fd]} { + gets $fd foo + lappend wc_happy_msg_list $foo + incr wc_happy_msg_max + } +close $fd + + +### +### Initialize the script +### +bind time - "* % % % %" wc_timer +bind pubm - %* wc_check +bind ctcp - ACTION wc_check + +putlog "$wc_message" +putlog "(maskfile: $wc_badword_file, $wc_badword_max // happymsg: $wc_happy_msg_file, $wc_happy_msg_max)" + +if {$wc_irritationmode} { +putlog "(irritation mode, treshold: $wc_irritationtreshold)" +} else { +putlog "(normal instant wordkick)" +} + +if {$wc_gentlemode} { +putlog "(gentlemode, no kicking)" +} + +if {$wc_callout_kick} { +putlog "(call-out idiotism kick mode ON)" +} + +catch {unset wc_irritation} +set wc_irritation 0 + +### +### Change the irritation +### +proc wc_timer {umin uhour uday umonth uyear} { +global wc_irritation +if {$wc_irritation > 0} { + decr wc_irritation + } +} + + +### +### Match the messages with bad-word list +### +proc wc_check {nick uhost hand chan itext} { +global wc_bad_mask_list wc_kick_msg_list botnick wc_preferredmsg +global wc_happy_msg_list wc_happy_msg_max wc_name wc_gentlemode +global wc_irritation wc_irritationmode wc_irritationtreshold +global wc_callout_kick wc_callout_msg + +# Convert to lower case + set itext [string tolower $itext] + +# Check for idiots +if {$wc_callout_kick} { + + set ilist [split $itext " "] + set isec [lindex $ilist 1] + + if {$isec == "" || $isec == "{}"} { + set iword [lindex $ilist 0] + + foreach inick [chanlist $chan] { + if {[string match [string tolower "*$inick*"] $iword]} { + putlog "$wc_name: $nick@$chan was idiot." + putserv "KICK $chan $nick :$wc_callout_msg" + } + } + } +} + + +# Go through the sentence + set kickit 0 + set x 0 + foreach foo $wc_bad_mask_list { + set foo2 [split $foo "|"] + + foreach i $foo2 { + if {[string match $i $itext]} { + putlog "$wc_name: $nick@$chan said a bad thing: $i" + +# Say happymsg + if {[rand 100] > 60} { + putserv "$wc_preferredmsg $chan :$nick, [lindex $wc_happy_msg_list [rand $wc_happy_msg_max]]" + } + +# Check for irritation mode + if {$wc_irritationmode != 0} { + if {$wc_irritation >= $wc_irritationtreshold} { + set kickit 1 + } else { + incr wc_irritation + } + } else { + set kickit 1 + } + +# Check for gentle-mode + if {($wc_gentlemode != 0) || [matchattr $hand n]} { return 0 } + +# Kick the lamer + if {$kickit != 0} { + putserv "KICK $chan $nick :[lindex $wc_kick_msg_list $x]" + return 0 + } + + } + } + + incr x + } +} +