chiark / gitweb /
Works and sort of just sits there.
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Aug 2000 21:04:16 +0000 (21:04 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 14 Aug 2000 21:04:16 +0000 (21:04 +0000)
bot.tcl

diff --git a/bot.tcl b/bot.tcl
index b5be32befb17a9611ed5ae2eb304363152c7d789..ffab760546d6a12f4bc36b0388799150c8679e27 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -4,31 +4,23 @@ 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} {
+proc sendout {command args} {
+    global sock
     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)"
+               error "bad argument in output $i ($command $args)"
            }
        }
-       lappend $args :$la
+       lappend args :$la
     }
     set args [lreplace $args 0 -1 $command]
-    if {[string length $prefix]} {
-       set args [lreplace $args 
-    set string "$command"
-    puts $string
+    set string [join $args { }]
+    puts "-> $string"
     puts $sock $string
 }
-puts $sock "USER guest 0 * :chiark testing bot"
-puts $sock "NICK $nick"
 
 proc log {data} {
     puts $data
@@ -36,26 +28,42 @@ proc log {data} {
 
 proc logerror {data} {
     log $data
-}      
+}
+
+proc saveeic {} {
+    global saveei saveec errorInfo errorCode
+
+    set saveei $errorInfo
+    set saveec $errorCode
+
+    puts ">$saveec|$saveei<"
+}
+
+proc bgerror {msg} {
+    global save
+    logerror $msg
+    saveeic
+}
 
 proc onread {args} {
-    global sock saveei saveec errorInfo errorCode
+    global sock
     
-    gets $sock line
-    regsub -all "\\[^ -\176\240-\376\\]" $line ? line
+    if {[gets $sock line] == -1} { set terminate 1; return }
+    regsub -all "\[^ -\176\240-\376\]" $line ? line
     set org $line
     if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
        set line $remain
     } else {
        set prefix {}
     }
+    if {![string length $line]} { return }
     if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
        log "bad command: $org"
        return
     }
-    set command [string toupper command]
+    set command [string toupper $command]
     set params {}
-    while {[regexp {([^ :]+) *(.*)} $line dummy thisword line]} {
+    while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} {
        lappend params $thisword
     }
     if {[regexp {^:(.*)} $line dummy thisword]} {
@@ -64,27 +72,71 @@ proc onread {args} {
        log "junk at end: $org"
        return
     }
+    if {"$command" == "PRIVMSG" &&
+        [regexp {^[&#+!]} [lindex $params 0]] &&
+        ![regexp {^!} [lindex $params 1]]} {
+       # on-channel message, ignore
+       return
+    }
+    log "<- $org"
     set procname msg_$command
+    if {[catch { info body $procname }]} { return }
     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
-       }
+       saveeic
     }
 }
 
-proc noprefix {} {
-    upvar 1 p
+proc prefix_none {} {
+    upvar 1 p p
     if {[string length $p]} { error "prefix specified" }
+}
 
-proc msg_PING {p s1} {
-    noprefix
-    puts "PONG $s1"
+proc msg_PING {p s1} {
+    prefix_none
+    sendout PONG $s1
 }
 
-fileevent $sock readable onread
+proc check_nick {n} {
+    if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" }
+    if {[regexp {^[-0-9]} $n]} { error "bad nick start" }
+}
+
+proc prefix_nick {} {
+    global nick
+    upvar 1 p p
+    upvar 1 n n
+    if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
+    check_nick $n
+    if {"[string tolower $n]" == "$nick"} { error "from myself" }
+}
 
-vwait terminate
+proc msg_PRIVMSG {p c dest text} {
+    prefix_nick
+    if {[regexp {^[&#+!]} $dest]} {
+       set what "!..."
+       set them it
+    } else {
+       set what "private messages"
+       set them them
+    }
+    sendout PRIVMSG $n \
+           "I will respond to $what at some point; for now I just log $them."
+}
+
+if {![info exists sock]} {
+    set sock [socket $host $port]
+    fconfigure $sock -buffering line
+    #fconfigure $sock -translation binary
+    fconfigure $sock -translation crlf
+
+    sendout USER guest 0 * ":chiark testing bot"
+    sendout NICK $nick
+    fileevent $sock readable onread
+}
+
+if {![regexp {tclsh} $argv0]} {
+    vwait terminate
+}