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
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]} {
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 c 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
+}