chiark - git - mdw - ircbot/blob - bot.tcl

   1 #!/usr/bin/tclsh8.2
   2
   3 set host chiark
   4 set port 6667
   5 set nick Blight
   6
   7 set sock [socket $host $port]
   8 fconfigure $sock -buffering line
   9 #fconfigure $sock -translation binary
  10 fconfigure $sock -translation crlf
  11
  12 proc sendout {prefix command args} {
  13     if {[llength $args]} {
  14         set la [lindex $args end]
  15         set args [lreplace $args end end]
  16         foreach i $args {
  17             if {[regexp {[: ]} $i]} {
  18                 error "bad argument in output $i ($prefix $command $args)"
  19             }
  20         }
  21         lappend $args :$la
  22     }
  23     set args [lreplace $args 0 -1 $command]
  24     if {[string length $prefix]} {
  25         set args [lreplace $args
  26     set string "$command"
  27     puts $string
  28     puts $sock $string
  29 }
  30 puts $sock "USER guest 0 * :chiark testing bot"
  31 puts $sock "NICK $nick"
  32
  33 proc log {data} {
  34     puts $data
  35 }
  36
  37 proc logerror {data} {
  38     log $data
  39 }
  40
  41 proc onread {args} {
  42     global sock saveei saveec errorInfo errorCode
  43
  44     gets $sock line
  45     regsub -all "\\[^ -\176\240-\376\\]" $line ? line
  46     set org $line
  47     if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
  48         set line $remain
  49     } else {
  50         set prefix {}
  51     }
  52     if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
  53         log "bad command: $org"
  54         return
  55     }
  56     set command [string toupper command]
  57     set params {}
  58     while {[regexp {([^ :]+) *(.*)} $line dummy thisword line]} {
  59         lappend params $thisword
  60     }
  61     if {[regexp {^:(.*)} $line dummy thisword]} {
  62         lappend params $thisword
  63     } elseif {[string length $line]} {
  64         log "junk at end: $org"
  65         return
  66     }
  67     set procname msg_$command
  68     if {[catch {
  69         eval [list $procname $prefix $command] $params
  70     } emsg]} {
  71         logerror "error: $emsg ($prefix $command $params)"
  72         if {![regexp {^invalid command name } $emsg]} {
  73             set saveei $errorInfo
  74             set saveec $errorCode
  75         }
  76     }
  77 }
  78
  79 proc noprefix {} {
  80     upvar 1 p
  81     if {[string length $p]} { error "prefix specified" }
  82
  83 proc msg_PING {p s1} {
  84     noprefix
  85     puts "PONG $s1"
  86 }
  87
  88 fileevent $sock readable onread
  89
  90 vwait terminate