bot.tcl

   1 #!/usr/bin/tclsh8.2
   2
   3 set host chiark
   4 set port 6667
   5 if {![info exists nick]} { set nick Blight }
   6 if {![info exists ownfullname]} { set ownfullname "here to Help" }
   7 set ownmailaddr blight@chiark.greenend.org.uk
   8
   9 if {![info exists globalsecret]} {
  10     set gsfile [open /dev/urandom r]
  11     fconfigure $gsfile -translation binary
  12     set globalsecret [read $gsfile 32]
  13     binary scan $globalsecret H* globalsecret
  14     close $gsfile
  15     unset gsfile
  16 }
  17
  18 proc try_except_finally {try except finally} {
  19     global errorInfo errorCode
  20     set er [catch { uplevel 1 $try } emsg]
  21     if {$er} {
  22         set ei $errorInfo
  23         set ec $errorCode
  24         if {[catch { uplevel 1 $except } emsg3]} {
  25             append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3"
  26         }
  27     }
  28     set er2 [catch { uplevel 1 $finally } emsg2]
  29     if {$er} {
  30         if {$er2} {
  31             append ei "\nALSO ERROR CLEANING UP:\n$emsg2"
  32         }
  33         return -code $er -errorinfo $ei -errorcode $ec $emsg
  34     } elseif {$er2} {
  35         return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2
  36     } else {
  37         return $emsg
  38     }
  39 }
  40
  41 proc sendout {command args} {
  42     global sock
  43     if {[llength $args]} {
  44         set la [lindex $args end]
  45         set args [lreplace $args end end]
  46         foreach i $args {
  47             if {[regexp {[: ]} $i]} {
  48                 error "bad argument in output $i ($command $args)"
  49             }
  50         }
  51         lappend args :$la
  52     }
  53     set args [lreplace $args 0 -1 $command]
  54     set string [join $args { }]
  55     puts "[clock seconds] -> $string"
  56     puts $sock $string
  57 }
  58
  59 proc log {data} {
  60     puts $data
  61 }
  62
  63 proc logerror {data} {
  64     log $data
  65 }
  66
  67 proc saveeic {} {
  68     global saveei saveec errorInfo errorCode
  69
  70     set saveei $errorInfo
  71     set saveec $errorCode
  72
  73     puts ">$saveec|$saveei<"
  74 }
  75
  76 proc bgerror {msg} {
  77     global save
  78     logerror $msg
  79     saveeic
  80 }
  81
  82 proc onread {args} {
  83     global sock nick
  84
  85     if {[gets $sock line] == -1} { set terminate 1; return }
  86     regsub -all "\[^ -\176\240-\376\]" $line ? line
  87     set org $line
  88     if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
  89         set line $remain
  90         if {[regexp {^([^!]+)!} $prefix dummy maybenick] &&
  91             "[irctolower $maybenick]" == "[irctolower $nick]"} return
  92     } else {
  93         set prefix {}
  94     }
  95     if {![string length $line]} { return }
  96     if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
  97         log "bad command: $org"
  98         return
  99     }
 100     set command [string toupper $command]
 101     set params {}
 102     while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} {
 103         lappend params $thisword
 104     }
 105     if {[regexp {^:(.*)} $line dummy thisword]} {
 106         lappend params $thisword
 107     } elseif {[string length $line]} {
 108         log "junk at end: $org"
 109         return
 110     }
 111     if {"$command" == "PRIVMSG" &&
 112         [regexp {^[&#+!]} [lindex $params 0]] &&
 113         ![regexp {^!} [lindex $params 1]]} {
 114         # on-channel message, ignore
 115         catch {
 116             recordlastseen_p $prefix "talking on [lindex $params 0]" 1
 117         }
 118         return
 119     }
 120     log "[clock seconds] <- $org"
 121     set procname msg_$command
 122     if {[catch { info body $procname }]} { return }
 123     if {[catch {
 124         eval [list $procname $prefix $command] $params
 125     } emsg]} {
 126         logerror "error: $emsg ($prefix $command $params)"
 127         saveeic
 128     }
 129 }
 130
 131 proc sendprivmsg {dest l} {
 132     sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $l
 133 }
 134 proc sendaction {dest what} { sendout PRIVMSG $dest "\001ACTION $what\001" }
 135 proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } }
 136 proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] }
 137
 138 proc prefix_none {} {
 139     upvar 1 p p
 140     if {[string length $p]} { error "prefix specified" }
 141 }
 142
 143 proc msg_PING {p c s1} {
 144     prefix_none
 145     sendout PONG $s1
 146 }
 147
 148 proc check_nick {n} {
 149     if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" }
 150     if {[regexp {^[-0-9]} $n]} { error "bad nick start" }
 151 }
 152
 153 proc ischan {dest} {
 154     return [regexp {^[&#+!]} $dest]
 155 }
 156
 157 proc irctolower {v} {
 158     foreach {from to} [list "\\\[" "{" \
 159                           "\\\]" "}" \
 160                           "\\\\" "|" \
 161                           "~"    "^"] {
 162         regsub -all $from $v $to v
 163     }
 164     return [string tolower $v]
 165 }
 166
 167 proc prefix_nick {} {
 168     global nick
 169     upvar 1 p p
 170     upvar 1 n n
 171     if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
 172     check_nick $n
 173     if {"[irctolower $n]" == "[irctolower $nick]"} {
 174         error "from myself" {} {}
 175     }
 176 }
 177
 178 proc showintervalsecs {howlong} {
 179     if {$howlong < 1000} {
 180         return "${howlong}s"
 181     } else {
 182         if {$howlong < 1000000} {
 183             set pfx k
 184             set scale 1000
 185         } else {
 186             set pfx M
 187             set scale 1000000
 188         }
 189         set value [expr "$howlong.0 / $scale"]
 190         foreach {min format} {100 %.0f 10 %.1f 1 %.2f} {
 191             if {$value < $min} continue
 192             return [format "$format${pfx}s" $value]
 193         }
 194     }
 195 }
 196
 197 proc showinterval {howlong} {
 198     if {$howlong <= 0} {
 199         return {just now}
 200     } else {
 201         return "[showintervalsecs $howlong] ago"
 202     }
 203 }
 204
 205 proc showtime {when} {
 206     return [showinterval [expr {[clock seconds] - $when}]]
 207 }
 208
 209 proc def_msgproc {name argl body} {
 210     proc msg_$name "varbase $argl" "\
 211     upvar #0 msg/\$varbase/dest d\n\
 212     upvar #0 msg/\$varbase/str s\n\
 213     upvar #0 msg/\$varbase/accum a\n\
 214 $body"
 215 }
 216
 217 def_msgproc begin {dest str} {
 218     set d $dest
 219     set s $str
 220     set a {}
 221 }
 222
 223 def_msgproc append {str} {
 224     set ns "$s$str"
 225     if {[string length $s] && [string length $ns] > 65} {
 226         msg__sendout $varbase
 227         set s " [string trimleft $str]"
 228     } else {
 229         set s $ns
 230     }
 231 }
 232
 233 def_msgproc finish {} {
 234     msg__sendout $varbase
 235     unset s
 236     unset d
 237     return $a
 238 }
 239
 240 def_msgproc _sendout {} {
 241     lappend a [string trimright $s]
 242     set s {}
 243 }
 244
 245 proc looking_whenwhere {when where} {
 246     set str [showtime [expr {$when-1}]]
 247     if {[string length $where]} { append str " on $where" }
 248     return $str
 249 }
 250
 251 proc recordlastseen_n {n how here} {
 252     global lastseen lookedfor
 253     set lastseen([irctolower $n]) [list $n [clock seconds] $how]
 254     if {!$here} return
 255     upvar #0 lookedfor([irctolower $n]) lf
 256     if {[info exists lf]} {
 257         switch -exact [llength $lf] {
 258             0 {
 259                 set ml {}
 260             }
 261             1 {
 262                 manyset [lindex $lf 0] when who where
 263                 set ml [list \
 264  "FYI, $who was looking for you [looking_whenwhere $when $where]."]
 265             }
 266             default {
 267                 msg_begin tosend $n "FYI, people have been looking for you:"
 268                 set i 0
 269                 set fin ""
 270                 foreach e $lf {
 271                     incr i
 272                     if {$i == 1} {
 273                         msg_append tosend " "
 274                     } elseif {$i == [llength $lf]} {
 275                         msg_append tosend " and "
 276                         set fin .
 277                     } else {
 278                         msg_append tosend ", "
 279                     }
 280                     manyset $e when who where
 281                     msg_append tosend \
 282                             "$who ([looking_whenwhere $when $where])$fin"
 283                 }
 284                 set ml [msg_finish tosend]
 285             }
 286         }
 287         unset lf
 288         msendprivmsg_delayed 1000 $n $ml
 289     }
 290 }
 291
 292 proc recordlastseen_p {p how here} {
 293     prefix_nick
 294     recordlastseen_n $n $how $here
 295 }
 296
 297 proc chanmode_arg {} {
 298     upvar 2 args cm_args
 299     set rv [lindex $cm_args 0]
 300     set cm_args [lreplace cm_args 0 0]
 301     return $rv
 302 }
 303
 304 proc chanmode_o1 {m g p chan} {
 305     global nick
 306     prefix_nick
 307     set who [chanmode_arg]
 308     recordlastseen_n $n "being nice to $who" 1
 309     if {"[irctolower $who]" == "[irctolower $nick]"} {
 310         sendprivmsg $n Thanks.
 311     }
 312 }
 313
 314 proc chanmode_o0 {m g p chan} {
 315     global nick chandeop
 316     prefix_nick
 317     set who [chanmode_arg]
 318     recordlastseen_p $p "being mean to $who" 1
 319     if {"[irctolower $who]" == "[irctolower $nick]"} {
 320         set chandeop($chan) [list [clock seconds] $p]
 321     }
 322 }
 323
 324 proc msg_MODE {p c dest modelist args} {
 325     if {![ischan $dest]} return
 326     if {[regexp {^\-(.+)$} $modelist dummy modelist]} {
 327         set give 0
 328     } elseif {[regexp {^\+(.+)$} $modelist dummy modelist]} {
 329         set give 1
 330     } else {
 331         error "invalid modelist"
 332     }
 333     foreach m [split $modelist] {
 334         set procname chanmode_$m$give
 335         if {[catch { info body $procname }]} {
 336             recordlastseen_p $p "fiddling with $dest" 1
 337         } else {
 338             $procname $m $give  $p $dest
 339         }
 340     }
 341 }
 342
 343 proc process_kickpart {chan user} {
 344     check_nick $user
 345     if {![ischan $chan]} { error "not a channel" }
 346
 347     upvar #0 nick_onchans($user) oc
 348     set lc [irctolower $chan]
 349     set oc [grep tc {"$tc" != "$lc"} $oc]
 350 }
 351
 352 proc msg_KICK {p c chans users comment} {
 353     set chans [split $chans ,]
 354     set users [split $users ,]
 355     if {[llength $chans] > 1} {
 356         foreach chan $chans user $users { process_kickpart $chan $user }
 357     } else {
 358         foreach user $users { process_kickpart [lindex $chans 0] $user }
 359     }
 360 }
 361
 362 proc msg_KILL {p c user why} {
 363     nick_forget $user
 364 }
 365
 366 set nick_arys {onchans username}
 367
 368 proc nick_forget {n} {
 369     global nick_arys
 370     foreach ary $nick_arys {
 371         upvar #0 nick_${ary}($n) av
 372         catch { unset av }
 373     }
 374 }
 375
 376 proc msg_NICK {p c newnick} {
 377     global nick_arys
 378     prefix_nick
 379     recordlastseen_n $n "changing nicks to $newnick" 0
 380     recordlastseen_n $newnick "changing nicks from $n" 1
 381     foreach ary $nick_arys {
 382         upvar #0 nick_${ary}($n) old
 383         upvar #0 nick_${ary}($newnick) new
 384         if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
 385         if {[info exists old]} { set new $old; unset old }
 386     }
 387 }
 388
 389 proc msg_JOIN {p c chan} {
 390     prefix_nick
 391     recordlastseen_n $n "joining $chan" 1
 392     upvar #0 nick_onchans($n) oc
 393     lappend oc [irctolower $chan]
 394 }
 395 proc msg_PART {p c chan} {
 396     prefix_nick
 397     recordlastseen_n $n "leaving $chan" 1
 398     process_kickpart $chan $n
 399 }
 400 proc msg_QUIT {p c why} {
 401     prefix_nick
 402     recordlastseen_n $n "leaving ($why)" 0
 403     nick_forget $n
 404 }
 405
 406 proc msg_PRIVMSG {p c dest text} {
 407     prefix_nick
 408     if {[ischan $dest]} {
 409         recordlastseen_n $n "invoking me in $dest" 1
 410         set output $dest
 411     } else {
 412         recordlastseen_n $n "talking to me" 1
 413         set output $n
 414     }
 415
 416     if {[catch {
 417         regsub {^! *} $text {} text
 418         set ucmd [ta_word]
 419         set procname ucmd/[string tolower $ucmd]
 420         if {[catch { info body $procname }]} {
 421             error "unknown command; try help for help"
 422         }
 423         $procname $p $dest
 424     } rv]} {
 425         sendprivmsg $n "error: $rv"
 426     } else {
 427         manyset $rv priv_msgs pub_msgs priv_acts pub_acts
 428         foreach {td val} [list $n $priv_acts $output $pub_acts] {
 429             foreach l [split $val "\n"] {
 430                 sendaction $td $l
 431             }
 432         }
 433         foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
 434             foreach l [split $val "\n"] {
 435                 sendprivmsg $td $l
 436             }
 437         }
 438     }
 439 }
 440
 441 proc msg_INVITE {p c n chan} {
 442     after 1000 [list sendout JOIN $chan]
 443 }
 444
 445 proc grep {var predicate list} {
 446     set o {}
 447     upvar 1 $var v
 448     foreach v $list {
 449         if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
 450     }
 451     return $o
 452 }
 453
 454 proc msg_353 {p c dest type chan nicklist} {
 455     global names_chans nick_onchans
 456     if {![info exists names_chans]} { set names_chans {} }
 457     set chan [irctolower $chan]
 458     lappend names_chans $chan
 459     foreach n [array names nick_onchans] {
 460         upvar #0 nick_onchans($n) oc
 461         set oc [grep tc {"$tc" != "$chan"} $oc]
 462     }
 463     foreach n [split $nicklist { }] {
 464         regsub {^[@+]} $n {} n
 465         check_nick $n
 466         if {![string length $n]} continue
 467         upvar #0 nick_onchans($n) oc
 468         lappend oc $chan
 469     }
 470 }
 471
 472 proc msg_366 {p c args} {
 473     global names_chans nick_onchans
 474     if {[llength names_chans] > 1} {
 475         foreach n [array names nick_onchans] {
 476             upvar #0 nick_onchans($n) oc
 477             set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
 478             if {![llength $oc]} { nick_forget $n }
 479         }
 480     }
 481     unset names_chans
 482 }
 483
 484 proc ta_anymore {} {
 485     upvar 1 text text
 486     return [expr {!![string length $text]}]
 487 }
 488
 489 proc ta_nomore {} {
 490     upvar 1 text text
 491     if {[string length $text]} { error "too many parameters" }
 492 }
 493
 494 proc ta_word {} {
 495     upvar 1 text text
 496     if {![regexp {^([^  ]+) *(.*)} $text dummy firstword text]} {
 497         error "too few parameters"
 498     }
 499     return $firstword
 500 }
 501
 502 proc ta_nick {} {
 503     upvar 1 text text
 504     set v [ta_word]
 505     check_nick $v
 506     return $v
 507 }
 508
 509 proc def_ucmd {cmdname body} {
 510     proc ucmd/$cmdname {p dest} "    upvar 1 text text\n$body"
 511 }
 512
 513 proc ucmdr {priv pub args} {
 514     return -code return [concat [list $priv $pub] $args]
 515 }
 516
 517 proc loadhelp {} {
 518     global help_topics
 519
 520     catch { unset help_topics }
 521     set f [open helpinfos r]
 522     set lno 0
 523     while {[gets $f l] >= 0} {
 524         incr lno
 525         if {[regexp {^#.*} $l]} {
 526         } elseif {[regexp {^ *$} $l]} {
 527             if {[info exists topic]} {
 528                 set help_topics($topic) [join $lines "\n"]
 529                 unset topic
 530                 unset lines
 531             }
 532         } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
 533             if {[info exists topic]} { error "help $newtopic while in $topic" }
 534             set topic $newtopic
 535             set lines {}
 536         } elseif {[regexp {^[^!#]} $l]} {
 537             set topic
 538             lappend lines [string trimright $l]
 539         } else {
 540             error "eh ? $lno: $l"
 541         }
 542     }
 543     if {[info exists topic]} { error "unfinished topic $topic" }
 544 }
 545
 546 def_ucmd help {
 547     upvar #0 help_topics([irctolower [string trim $text]]) info
 548     if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
 549     ucmdr $info {}
 550 }
 551
 552 def_ucmd ? {
 553     global help_topics
 554     ucmdr $help_topics() {}
 555 }
 556
 557 proc manyset {list args} {
 558     foreach val $list var $args {
 559         upvar 1 $var my
 560         set my $val
 561     }
 562 }
 563
 564 proc check_username {target} {
 565     if {
 566         [string length $target] > 8 ||
 567         [regexp {[^-0-9a-z]} $target] ||
 568         ![regexp {^[a-z]} $target]
 569     } { error "invalid username" }
 570 }
 571
 572 proc nickdb__head {} {
 573     uplevel 1 {
 574         set nl [irctolower $n]
 575         upvar #0 nickdb($nl) ndbe
 576         binary scan $nl H* nh
 577         set nfn users/$nh
 578         if {![info exists ndbe] && [file exists $nfn]} {
 579             set f [file open $nfn r]
 580             try_except_finally { set newval [read $f] } {} { close $f }
 581             if {[llength $newval] % 2} { error "invalid length" }
 582             set ndbe $newval
 583         }
 584     }
 585 }
 586
 587 proc def_nickdb {name arglist body} {
 588     proc nickdb_$name $arglist "nickdb__head; $body"
 589 }
 590
 591 def_nickdb exists {n} {
 592     return [info exists ndbe]
 593 }
 594
 595 def_nickdb delete {n} {
 596     catch { unset ndbe }
 597     file delete $nfn
 598 }
 599
 600 set default_settings {timeformat ks}
 601
 602 def_nickdb set {n args} {
 603     global default_settings
 604     if {![info exists ndbe]} { set ndbe $default_settings }
 605     foreach {key value} [concat $ndbe $args] { set a($key) $value }
 606     set newval {}
 607     foreach {key value} [array get a] { lappend newval $key $value }
 608     set f [open $nfn.new w]
 609     try_except_finally {
 610         puts $f $newval
 611         close $f
 612         file rename -force $nfn.new $nfn
 613     } {
 614         catch { close $f }
 615     } {
 616     }
 617     set ndbe $newval
 618 }
 619
 620 def_nickdb opt {n key} {
 621     global default_settings
 622     if {[info exists ndbe]} {
 623         set l $ndbe
 624     } else {
 625         set l $default_settings
 626     }
 627     foreach {tkey value} $l {
 628         if {"$tkey" == "$key"} { return $value }
 629     }
 630     error "unset setting $key"
 631 }
 632
 633 proc check_notonchan {} {
 634     upvar 1 dest dest
 635     if {[ischan $dest]} { error "that command must be sent privately" }
 636 }
 637
 638 proc nick_securitycheck {strict} {
 639     upvar 1 n n
 640     if {![nickdb_exists $n]} { error "you are unknown to me, use `register'." }
 641     set wantu [nickdb_opt $n username]
 642     if {![string length $wantu]} {
 643         if {$strict} {
 644             error "that feature is only available to secure users, sorry."
 645         } else {
 646             return
 647         }
 648     }
 649     upvar #0 nick_username($n) nu
 650     if {![info exists nu]} {
 651         error "nick $n is secure, you must identify yourself first."
 652     }
 653     if {"$wantu" != "$nu"} {
 654         error "you are the wrong user - the nick $n belongs to $wantu, not $nu"
 655     }
 656 }
 657
 658 def_ucmd register {
 659     prefix_nick
 660     check_notonchan
 661     set old [nickdb_exists $n]
 662     if {$old} { nick_securitycheck 0 }
 663     switch -exact [string tolower [string trim $text]] {
 664         {} {
 665             upvar #0 nick_username($n) nu
 666             if {![info exists nu]} {
 667                 ucmdr {} \
 668  "You must identify yourself before using `register'.  See `help identify'."
 669             }
 670             nickdb_set $n username $nu
 671             ucmdr {} {} "makes a note of your username." {}
 672         }
 673         delete {
 674             nickdb_delete $n
 675             ucmdr {} {} "forgets your nickname." {}
 676         }
 677         insecure {
 678             nickdb_set $n username {}
 679             if {$old} {
 680                 ucmdr {} "Security is now disabled for your nickname !"
 681             } else {
 682                 ucmdr {} "This is fine, but bear in mind that people will be able to mess with your settings.  Channel management features need a secure registration." "makes an insecure registration for your nick."
 683             }
 684         }
 685     }
 686 }
 687
 688 proc timeformat_desc {tf} {
 689     switch -exact $tf {
 690         ks { return "Times will be displayed in kiloseconds or seconds." }
 691         hms { return "Times will be displayed in hours, minutes, etc." }
 692         default { error "invalid timeformat: $v" }
 693     }
 694 }
 695
 696 proc def_setting {opt show_body set_body} {
 697     proc set_show/$opt {} "
 698         upvar 1 n n
 699         set opt $opt
 700         $show_body"
 701     if {![string length $set_body]} return
 702     proc set_set/$opt {} "
 703         upvar 1 n n
 704         upvar 1 text text
 705         set opt $opt
 706         $set_body"
 707 }
 708
 709 def_setting timeformat {
 710     set tf [nickdb_opt $n timeformat]
 711     return "$tf: [timeformat_desc $tf]"
 712 } {
 713     set tf [string tolower [ta_word]]
 714     ta_nomore
 715     set desc [timeformat_desc $tf]
 716     nickdb_set $n timeformat $tf
 717     ucmdr {} $desc
 718 }
 719
 720 def_setting security {
 721     set s [nickdb_opt $n username]
 722     if {[string length $s]} {
 723         return "Your nick, $n, is controlled by the user $s."
 724     } else {
 725         return "Your nick, $n, is not secure."
 726     }
 727 } {}
 728
 729 def_ucmd set {
 730     prefix_nick
 731     check_notonchan
 732     if {![nickdb_exists $n]} {
 733         ucmdr {} "You are unknown to me and so have no settings."
 734     }
 735     if {![ta_anymore]} {
 736         set ol {}
 737         foreach proc [lsort [info procs]] {
 738             if {![regexp {^set_show/(.*)$} $proc dummy opt]} continue
 739             lappend ol [format "%-10s %s" $opt [set_show/$opt]]
 740         }
 741         ucmdr {} [join $ol "\n"]
 742     } else {
 743         set opt [ta_word]
 744         if {[catch { info body set_show/$opt }]} {
 745             error "no setting $opt"
 746         }
 747         if {![ta_anymore]} {
 748             ucmdr {} "$opt [set_show/$opt]"
 749         } else {
 750             if {[catch { info body set_set/$opt }]} {
 751                 error "setting $opt cannot be set with `set'"
 752             }
 753             set_set/$opt
 754         }
 755     }
 756 }
 757
 758 def_ucmd identpass {
 759     set username [ta_word]
 760     set passmd5 [md5sum [ta_word]]
 761     ta_nomore
 762     prefix_nick
 763     check_notonchan
 764     upvar #0 nick_onchans($n) onchans
 765     if {![info exists onchans] || ![llength $onchans]} {
 766         ucmdr "You must be on a channel with me to identify yourself." {}
 767     }
 768     check_username $username
 769     exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
 770             irc-identpass $n
 771     upvar #0 nick_username($n) rec_username
 772     set rec_username $username
 773     ucmdr "Pleased to see you, $username." {}
 774 }
 775
 776 def_ucmd summon {
 777     set target [ta_word]
 778     ta_nomore
 779     check_username $target
 780     prefix_nick
 781
 782     upvar #0 lastsummon($target) ls
 783     set now [clock seconds]
 784     if {[info exists ls]} {
 785         set interval [expr {$now - $ls}]
 786         if {$interval < 30} {
 787             ucmdr {} \
 788  "Please be patient; $target was summoned only [showinterval $interval]."
 789         }
 790     }
 791     regsub {^[^!]*!} $p {} path
 792     if {[catch {
 793         exec userv --timeout 3 $target irc-summon $n $path \
 794                 [expr {[ischan $dest] ? "$dest" : ""}] \
 795                 < /dev/null
 796     } rv]} {
 797         regsub -all "\n" $rv { / } rv
 798         error $rv
 799     }
 800     if {[regexp {^problem (.*)} $rv dummy problem]} {
 801         ucmdr {} "The user `$target' $problem."
 802     } elseif {[regexp {^ok ([^ ]+) ([0-9]+)$} $rv dummy tty idlesince]} {
 803         set idletime [expr {$now - $idlesince}]
 804         set ls $now
 805         ucmdr {} {} {} "invites $target ($tty[expr {
 806             $idletime > 10 ? ", idle for [showintervalsecs $idletime]" : ""
 807         }]) to [expr {
 808             [ischan $dest] ? "join us here" : "talk to you"
 809         }]."
 810     } else {
 811         error "unexpected response from userv service: $rv"
 812     }
 813 }
 814
 815 proc md5sum {value} { exec md5sum << $value }
 816
 817 def_ucmd seen {
 818     global lastseen nick
 819     prefix_nick
 820     set ncase [ta_nick]
 821     set nlower [irctolower $ncase]
 822     ta_nomore
 823     set now [clock seconds]
 824     if {"$nlower" == "[irctolower $nick]"} {
 825         error "I am not self-aware."
 826     } elseif {![info exists lastseen($nlower)]} {
 827         set rstr "I've never seen $ncase."
 828     } else {
 829         manyset $lastseen($nlower) realnick time what
 830         set howlong [expr {$now - $time}]
 831         set string [showinterval $howlong]
 832         set rstr "I last saw $realnick $string, $what."
 833     }
 834     if {[ischan $dest]} {
 835         set where $dest
 836     } else {
 837         set where {}
 838     }
 839     upvar #0 lookedfor($nlower) lf
 840     if {[info exists lf]} { set oldvalue $lf } else { set oldvalue {} }
 841     set lf [list [list $now $n $where]]
 842     foreach v $oldvalue {
 843         if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
 844         lappend lf $v
 845     }
 846     ucmdr {} $rstr
 847 }
 848
 849 if {![info exists sock]} {
 850     set sock [socket $host $port]
 851     fconfigure $sock -buffering line
 852     #fconfigure $sock -translation binary
 853     fconfigure $sock -translation crlf
 854
 855     sendout USER blight 0 * $ownfullname
 856     sendout NICK $nick
 857     fileevent $sock readable onread
 858 }
 859
 860 loadhelp
 861
 862 #if {![regexp {tclsh} $argv0]} {
 863 #    vwait terminate
 864 #}