Disable vwait temporarily.

[ircbot] / bot.tcl

#!/usr/bin/tclsh8.2

set host chiark
set port 6667
set nick Blight

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 ($command $args)"
	    }
	}
	lappend args :$la
    }
    set args [lreplace $args 0 -1 $command]
    set string [join $args { }]
    puts "-> $string"
    puts $sock $string
}

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
    
    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 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
    }
    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)"
	saveeic
    }
}

proc prefix_none {} {
    upvar 1 p p
    if {[string length $p]} { error "prefix specified" }
}

proc msg_PING {p c s1} {
    prefix_none
    sendout PONG $s1
}

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" }
}

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
#}