From ba46c304bdffdce0b6019a47f6759ce6abbeef90 Mon Sep 17 00:00:00 2001 From: Stefan Ritter Date: Tue, 16 Aug 2011 10:51:41 +0200 Subject: Initial commit --- ques5.tcl | 370 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 370 insertions(+) create mode 100644 ques5.tcl (limited to 'ques5.tcl') diff --git a/ques5.tcl b/ques5.tcl new file mode 100644 index 0000000..b0d9d89 --- /dev/null +++ b/ques5.tcl @@ -0,0 +1,370 @@ +# +# ques5.tcl +# +# Copyright (C) 1995 - 1997 Robey Pointer +# Copyright (C) 1999 - 2010 Eggheads Development Team +# +# v1 -- 20aug95 +# v2 -- 2oct95 [improved it] +# v3 -- 17mar96 [fixed it up for 1.0 multi-channel] +# v4 -- 3nov97 [Fixed it up for 1.3.0 version bots] by TG +# v4.00001 nov97 [blurgh] +# v5-BETA1 -- 26sep99 by rtc +# +# $Id: ques5.tcl,v 1.17 2010/01/03 13:27:31 pseudo Exp $ +# +# o clean webfile var removal +# o using timezone variable from config file +# o unified options and removed unnecessary ones. +# o convert urls, nicks etc. to HTML before we put them into the page. +# o nice html source indenting +# o replace the old file after the new one has completely written to +# disk +# o the description still contained robey's address, replaced +# by the eggheads email. +# o don't link any spaces in the HTML2.0 file +# v5-RC1 -- 29sep99 by rtc +# o info line wasn't converted to HTML. +# o now supports bold, italic and underline text style and colors. +# v5-FINAL -- 04oct99 by rtc +# o style converter now strictly follows HTML standard. +# o Fake color attributes with number > 2^32 don't cause Tcl +# error anymore. +# o now uses strftime as time and date functions have both been removed +# in 1.3.29 + +# this will create an html file every so often (the default is once every +# 5 minutes). the html file will have a table showing the people currently +# on the channel, their user@hosts, who's an op, and who's idle. it +# uses a table which some browsers (and pseudo-browsers like lynx) can't +# see, but it can optionally make a second page which will support these +# archaic browsers. browsers supporting push-pull will receive the updated +# page automatically periodically. +# +# if you have a "url" field defined for a user, their nickname in the +# table will be a link pointing there. otherwise it checks the info +# line and comment field to see if they start with "http://" -- if so, +# that link will be used. as a last resort, it will make a "mailto:" +# link if an email address is recorded for the user. +# +# feel free to modify and play with this. the original was written in +# 15 minutes, then at various times i fixed bugs and added features. +# softlord helped me make the design look a little nicer. :) if you make +# any nifty improvements, please let us know. +# eggheads@eggheads.org + +# this line makes sure other scripts won't interfere +if {[info exists web_file] || [array exists web_file]} {unset web_file} + +# You must define each channel you want a webfile for . +# If you want a HTML2.0 file, too, put it's filename separated by +# a colon to the same option, it goes to the same directory. +#set web_file(#turtle) "/home/lamest/public_html/turtle.html:turtle-lynx.html" + +# This example demonstrates how to put lynx files into another dir. +#set web_file(#gloom) "/home/lamest/public_html/gloom.html:lynx/gloom.html" + +# You can also prevent the HTML2.0 file from being written. +#set web_file(#channel) "/home/lamest/public_html/channel.html" + +# You can even let the bot write only a HTML2.0. +#set web_file(#blah) "/home/lamest/public_html/:blah.html" + +# how often should these html files get updated? +# (1 means once every minute, 5 means once every 5 minutes, etc) +set web_update 5 + +# Which characters should be allowed in URLs? +# DO NOT MODIFY unless you really know what you are doing. +# Especially never add '<', '"' and '>' +set web_urlchars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 :+-/!\$%&()=[]{}#^~*.:,;\\|?_@" + +# IRC -> HTML color translation table +set web_color(0) "#FFFFFF" +set web_color(1) "#000000" +set web_color(2) "#00007F" +set web_color(3) "#008F00" +set web_color(4) "#FF0000" +set web_color(5) "#7F0000" +set web_color(6) "#9F009F" +set web_color(7) "#FF7F00" +set web_color(8) "#F0FF00" +set web_color(9) "#00F700" +set web_color(10) "#008F8F" +set web_color(11) "#00F7FF" +set web_color(12) "#0000FF" +set web_color(13) "#FF00FF" +set web_color(14) "#7F7F7F" +set web_color(15) "#CFCFCF" + +# IRC -> HTML style translation table +set web_style(\002) " " +set web_style(\003) " " +set web_style(\026) " " +set web_style(\037) " " + +proc getnumber {string} { + set result "" + foreach char [split $string ""] { + if {[string first $char "0123456789"] == -1} { + return $result + } else { + append result $char + } + } + return $result +} + +proc webify {string} { + # Tcl8.1 only: + #return [string map {\" " & & < < > >} $string] + + # Otherwise use this: + regsub -all "\\&" $string "\\&" string + regsub -all "\"" $string "\\"" string + regsub -all "<" $string "<" string + regsub -all ">" $string ">" string + + return $string +} + +proc convstyle {string} { + global web_color web_style + set result "" + set stack "" + for {set i 0} "\$i < [string length $string]" {incr i} { + set char [string index $string $i] + switch -- $char { + "\002" - "\026" - "\037" { + if {[string first $char $stack] != -1} { + # NOT && + if {[string index $stack 0] == $char} { + append result [lindex $web_style($char) 1] + set stack [string range $stack 1 end] + } + } else { + append result [lindex $web_style($char) 0] + set stack $char$stack + } + } + "\003" { + if {[string first $char $stack] != -1} { + if {[string index $stack 0] == $char} { + append result [lindex $web_style($char) 1] + set stack [string range $stack 1 end] + } + } + set c [getnumber [string range $string [expr $i + 1] [expr $i + 2]]] + if {$c != "" && $c >= 0 && $c <= 15} { + incr i [string length $c] + append result "" + set stack $char$stack + } + } + default {append result $char} + } + } + foreach char [split $stack ""] { + if {$char == "\002" || $char == "\003" || + $char == "\026" || $char == "\037"} { + append result [lindex $web_style($char) 1] + } + } + return $result +} + +proc urlstrip {string} { + global web_urlchars + set result "" + foreach char [split $string ""] { + if {[string first $char $web_urlchars] != -1} { + append result $char + } + } + return $result +} + +proc do_ques {} { + global web_file web_update web_timerid + global botnick timezone + + if {[info exists web_timerid]} {unset web_timerid} + + foreach chan [array names web_file] { + if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue} + set i [split $web_file($chan) ":"] + set dir "" + set file1 [lindex $i 0] + set file2 [lindex $i 1] + set j [string last "/" $file1] + if {$j != -1} { + set dir [string range $file1 0 $j] + set file1 [string range $file1 [expr $j + 1] end] + } + unset i j + if {$file1 != ""} { + set fd1 [open $dir$file1~new w] + } else { + set fd1 [open "/dev/null" w] + } + if {$file2 != ""} { + set fd2 [open $dir$file2~new w] + } else { + set fd2 [open "/dev/null" w] + } + + puts $fd1 "" + puts $fd1 " " + puts $fd1 " People on [webify $chan] right now" + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + + puts $fd2 "" + puts $fd2 " " + puts $fd2 " People on [webify $chan] right now" + puts $fd2 " " + puts $fd2 " " + puts $fd2 " " + puts $fd2 " " + if {![onchan $botnick $chan]} { + puts $fd1 "

Oops!

" + puts $fd1 " I'm not on [webify $chan] right now for some reason
" + puts $fd1 " IRC isn't a very stable place these days..." + puts $fd1 " Please try again later!
" + + puts $fd2 "

Oops!

" + puts $fd2 " I'm not on [webify $chan] right now for some reason
" + puts $fd2 " IRC isn't a very stable place these days..." + puts $fd2 " Please try again later!
" + } else { + puts $fd1 "

[webify $chan]

" + puts $fd2 "

[webify $chan]

" + if {$file2 != ""} { + puts $fd1 " If this page looks screwy on your browser, " + puts $fd1 " try the HTML 2.0 " + puts $fd1 " version.
" + } + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd2 " People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]" + puts $fd2 " 
"
+      puts $fd2 "      Nickname  Status           User@Host"
+      foreach nick [chanlist $chan] {
+        set len1 9
+        set len2 16
+        puts $fd1 "
" + if {[isop $nick $chan]} {lappend status "op"} + if {[getchanidle $nick $chan] > 10} {lappend status "idle"} + set host [getchanhost $nick $chan] + set handle [finduser $nick!$host] + set host [webify $host] + if {[onchansplit $nick $chan]} { + lappend status "split" + #incr len2 [string length ""] + incr len2 17 + } + if {![info exists status]} { + set status "-" + } else { + set status [join $status ", "] + } + set url [urlstrip [getuser $handle XTRA url]] + set info [getuser $handle INFO] + set comment [getuser $handle COMMENT] + set email [getuser $handle XTRA email] + if {$url == "" && [string range $comment 0 6] == "http://"} { + set url [urlstrip $comment] + } + if {$url == "" && [string range $info 0 6] == "http://"} { + set url [urlstrip $info] + } + if {$url == "" && $email != "" && [string match *@*.* $email]} { + set url [urlstrip mailto:$email] + } + incr len1 [string length [webify $nick]] + incr len1 -[string length $nick] + if {[string tolower $nick] == [string tolower $botnick]} { + set host "<- it's me, the channel bot!" + set info "" + } elseif {[matchattr $handle b]} { + set host "<- it's another channel bot" + set info "" + } + if {$url != ""} { + incr len1 [string length ""] + puts $fd1 " " + puts $fd2 " [format %-${len1}s [webify $nick]] [format %-${len2}s $status] $host" + } else { + puts $fd1 " " + puts $fd2 " [format %-${len1}s [webify $nick]] [format %-${len2}s $status] $host" + } + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + if {$info != ""} { + puts $fd1 " " + puts $fd1 " " + puts $fd1 " " + puts $fd2 " Info: [convstyle [webify $info]]" + } + unset len1 len2 status info url host comment email + } + puts $fd1 "
People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]
NicknameStatusUser@Host
[webify $nick][webify $nick]$status$host
Info: [convstyle [webify $info]]
" + puts $fd2 " " + } + puts $fd1 "
" + puts $fd1 " This page is automatically refreshed every [webify $web_update] minute(s).
" + puts $fd1 "
Created by quesedilla v5 via eggdrop.
" + puts $fd1 " " + puts $fd1 "" + puts $fd1 "" + puts $fd2 "
" + puts $fd2 " This page is automatically refreshed every [webify $web_update] minute(s).
" + puts $fd2 "
Created by quesedilla v5 via eggdrop.
" + puts $fd2 " " + puts $fd2 "" + puts $fd2 "" + close $fd1 + close $fd2 + if {$file1 != ""} {exec /bin/mv $dir$file1~new $dir$file1} + if {$file2 != ""} {exec /bin/mv $dir$file2~new $dir$file2} + unset nick file1 file2 dir fd1 fd2 + } + + set web_timerid [timer $web_update do_ques] +} + +#if {[info exists web_timerid]} { +# killtimer $web_timerid +# unset web_timerid +#} +if {![info exists web_timerid] && $web_update > 0} { + set web_timerid [timer $web_update do_ques] +} +#do_ques + +foreach chan [array names web_file] { + if {[string first ":" $web_file($chan)] != -1} { + lappend channels "$chan" + } else { + lappend channels "$chan (no lynx)" + } +} + +if {![info exists channels]} { + putlog "Quesedilla v5 final loaded (no channels)" +} else { + putlog "Quesedilla v5 final loaded: [join $channels ,\ ]" + unset channels +} + +if {![info exists timezone]} { + set timezone [clock format 0 -format %Z] +} -- cgit v1.2.3