chiark / gitweb /
Checkin to move to davenant.#
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Aug 2000 20:18:30 +0000 (20:18 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Aug 2000 20:18:30 +0000 (20:18 +0000)
bot.tcl [new file with mode: 0755]

diff --git a/bot.tcl b/bot.tcl
new file mode 100755 (executable)
index 0000000..b5be32b
--- /dev/null
+++ b/bot.tcl
@@ -0,0 +1,90 @@
+#!/usr/bin/tclsh8.2
+
+set host chiark
+set port 6667
+set nick Blight
+
+set sock [socket $host $port]
+fconfigure $sock -buffering line
+#fconfigure $sock -translation binary
+fconfigure $sock -translation crlf
+
+proc sendout {prefix command args} {
+    if {[llength $args]} {
+       set la [lindex $args end]
+       set args [lreplace $args end end]
+       foreach i $args {
+           if {[regexp {[: ]} $i]} {
+               error "bad argument in output $i ($prefix $command $args)"
+           }
+       }
+       lappend $args :$la
+    }
+    set args [lreplace $args 0 -1 $command]
+    if {[string length $prefix]} {
+       set args [lreplace $args 
+    set string "$command"
+    puts $string
+    puts $sock $string
+}
+puts $sock "USER guest 0 * :chiark testing bot"
+puts $sock "NICK $nick"
+
+proc log {data} {
+    puts $data
+}
+
+proc logerror {data} {
+    log $data
+}      
+
+proc onread {args} {
+    global sock saveei saveec errorInfo errorCode
+    
+    gets $sock line
+    regsub -all "\\[^ -\176\240-\376\\]" $line ? line
+    set org $line
+    if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
+       set line $remain
+    } else {
+       set prefix {}
+    }
+    if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
+       log "bad command: $org"
+       return
+    }
+    set command [string toupper command]
+    set params {}
+    while {[regexp {([^ :]+) *(.*)} $line dummy thisword line]} {
+       lappend params $thisword
+    }
+    if {[regexp {^:(.*)} $line dummy thisword]} {
+       lappend params $thisword
+    } elseif {[string length $line]} {
+       log "junk at end: $org"
+       return
+    }
+    set procname msg_$command
+    if {[catch {
+       eval [list $procname $prefix $command] $params
+    } emsg]} {
+       logerror "error: $emsg ($prefix $command $params)"
+       if {![regexp {^invalid command name } $emsg]} {
+           set saveei $errorInfo
+           set saveec $errorCode
+       }
+    }
+}
+
+proc noprefix {} {
+    upvar 1 p
+    if {[string length $p]} { error "prefix specified" }
+
+proc msg_PING {p s1} {
+    noprefix
+    puts "PONG $s1"
+}
+
+fileevent $sock readable onread
+
+vwait terminate