bot.tcl

   1 # Core bot code
   2
   3 source irccore.tcl
   4
   5 proc unlogged_content_msg {prefix params} {
   6     if {![regexp {^[&#+!]} [lindex $params 0]] ||
   7         [regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} {
   8         return 1
   9     }
  10     # on-channel message, ignore
  11     set chan [lindex $params 0]
  12     upvar #0 chan_lastactivity([irctolower $chan]) la
  13     set la [clock seconds]
  14     catch { recordlastseen_p $prefix "talking on $chan" 1 }
  15     return
  16 }
  17
  18 proc usererror {emsg} { error $emsg {} {BLIGHT USER} }
  19
  20 proc prefix_none {} {
  21     upvar 1 p p
  22     if {[string length $p]} { error "prefix specified" }
  23 }
  24
  25 proc prefix_nick {} {
  26     global nick
  27     upvar 1 p p
  28     upvar 1 n n
  29     if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
  30     check_nick $n
  31     if {"[irctolower $n]" == "[irctolower $nick]"} {
  32         error "from myself" {} {}
  33     }
  34 }
  35
  36 proc showintervalsecs {howlong abbrev} {
  37     return [showintervalsecs/[opt timeformat] $howlong $abbrev]
  38 }
  39
  40 proc showintervalsecs/ks {howlong abbrev} {
  41     if {$howlong < 1000} {
  42         return "${howlong}s"
  43     } else {
  44         if {$howlong < 1000000} {
  45             set pfx k
  46             set scale 1000
  47         } else {
  48             set pfx M
  49             set scale 1000000
  50         }
  51         set value [expr "$howlong.0 / $scale"]
  52         foreach {min format} {100 %.0f 10 %.1f 1 %.2f} {
  53             if {$value < $min} continue
  54             return [format "$format${pfx}s" $value]
  55         }
  56     }
  57 }
  58
  59 proc format_qty {qty unit abbrev} {
  60     set o $qty
  61     if {$abbrev} {
  62         append o [string range $unit 0 0]
  63     } else {
  64         append o " "
  65         append o $unit
  66         if {$qty != 1} { append o s }
  67     }
  68     return $o
  69 }
  70
  71 proc showintervalsecs/hms {qty abbrev} {
  72     set ul {second 60 minute 60 hour 24 day 7 week}
  73     set remainv 0
  74     while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} {
  75         set remainu [lindex $ul 0]
  76         set remainv [expr {$qty % $uv}]
  77         set qty [expr {($qty-$remainv)/$uv}]
  78         set ul [lreplace $ul 0 1]
  79     }
  80     set o [format_qty $qty [lindex $ul 0] $abbrev]
  81     if {$remainv} {
  82         if {!$abbrev} { append o " " }
  83         append o [format_qty $remainv $remainu $abbrev]
  84     }
  85     return $o
  86 }
  87
  88 proc showinterval {howlong} {
  89     if {$howlong <= 0} {
  90         return {just now}
  91     } else {
  92         return "[showintervalsecs $howlong 0] ago"
  93     }
  94 }
  95
  96 proc showtime {when} {
  97     return [showinterval [expr {[clock seconds] - $when}]]
  98 }
  99
 100 proc def_msgproc {name argl body} {
 101     proc msg_$name "varbase $argl" "\
 102     upvar #0 msg/\$varbase/dest d\n\
 103     upvar #0 msg/\$varbase/str s\n\
 104     upvar #0 msg/\$varbase/accum a\n\
 105 $body"
 106 }
 107
 108 def_msgproc begin {dest str} {
 109     set d $dest
 110     set s $str
 111     set a {}
 112 }
 113
 114 def_msgproc append {str} {
 115     set ns "$s$str"
 116     if {[string length $s] && [string length $ns] > 65} {
 117         msg__sendout $varbase
 118         set s " [string trimleft $str]"
 119     } else {
 120         set s $ns
 121     }
 122 }
 123
 124 def_msgproc finish {} {
 125     msg__sendout $varbase
 126     unset s
 127     unset d
 128     return $a
 129 }
 130
 131 def_msgproc _sendout {} {
 132     lappend a [string trimright $s]
 133     set s {}
 134 }
 135
 136 proc looking_whenwhere {when where} {
 137     set str [showtime [expr {$when-1}]]
 138     if {[string length $where]} { append str " on $where" }
 139     return $str
 140 }
 141
 142 proc recordlastseen_n {n how here} {
 143     global lastseen lookedfor
 144     set lastseen([irctolower $n]) [list $n [clock seconds] $how]
 145     if {!$here} return
 146     upvar #0 lookedfor([irctolower $n]) lf
 147     if {[info exists lf]} {
 148         switch -exact [llength $lf] {
 149             0 {
 150                 set ml {}
 151             }
 152             1 {
 153                 manyset [lindex $lf 0] when who where
 154                 set ml [list \
 155  "FYI, $who was looking for you [looking_whenwhere $when $where]."]
 156             }
 157             default {
 158                 msg_begin tosend $n "FYI, people have been looking for you:"
 159                 set i 0
 160                 set fin ""
 161                 foreach e $lf {
 162                     incr i
 163                     if {$i == 1} {
 164                         msg_append tosend " "
 165                     } elseif {$i == [llength $lf]} {
 166                         msg_append tosend " and "
 167                         set fin .
 168                     } else {
 169                         msg_append tosend ", "
 170                     }
 171                     manyset $e when who where
 172                     msg_append tosend \
 173                             "$who ([looking_whenwhere $when $where])$fin"
 174                 }
 175                 set ml [msg_finish tosend]
 176             }
 177         }
 178         unset lf
 179         msendprivmsg_delayed 1000 $n $ml
 180     }
 181 }
 182
 183 proc note_topic {showoff whoby topic} {
 184     set msg "FYI, $whoby has changed the topic on $showoff"
 185     if {[string length $topic] < 160} {
 186         append msg " to $topic"
 187     } else {
 188         append msg " but it is too long to reproduce here !"
 189     }
 190     set showoff [irctolower $showoff]
 191     set tell [chandb_get $showoff topictell]
 192     if {[lsearch -exact $tell *] >= 0} {
 193         set tryspies [chandb_list]
 194     } else {
 195         set tryspies $tell
 196     }
 197     foreach spy $tryspies {
 198         set see [chandb_get $spy topicsee]
 199         if {[lsearch -exact $see $showoff] >= 0 || \
 200                 ([lsearch -exact $see *] >= 0 && \
 201                 [lsearch -exact $tell $spy] >= 0)} {
 202             sendprivmsg $spy $msg
 203         }
 204     }
 205 }
 206
 207 proc recordlastseen_p {p how here} {
 208     prefix_nick
 209     recordlastseen_n $n $how $here
 210 }
 211
 212 proc chanmode_arg {} {
 213     upvar 2 args cm_args
 214     set rv [lindex $cm_args 0]
 215     set cm_args [lreplace cm_args 0 0]
 216     return $rv
 217 }
 218
 219 proc chanmode_o1 {m g p chan} {
 220     global nick chan_initialop
 221     prefix_nick
 222     set who [chanmode_arg]
 223     recordlastseen_n $n "being nice to $who" 1
 224     if {"[irctolower $who]" == "[irctolower $nick]"} {
 225         set nlower [irctolower $n]
 226         upvar #0 nick_unique($nlower) u
 227         if {[chandb_exists $chan]} {
 228             sendprivmsg $n Thanks.
 229         } elseif {![info exists u]} {
 230             sendprivmsg $n {Op me while not on the channel, why don't you ?}
 231         } else {
 232             set chan_initialop([irctolower $chan]) $u
 233             sendprivmsg $n \
 234  "Thanks. You can use `channel manager ...' to register this channel."
 235             if {![nickdb_exists $n] || ![string length [nickdb_get $n username]]} {
 236                 sendprivmsg $n \
 237  "(But to do that you must register your nick securely first.)"
 238             }
 239         }
 240     }
 241 }
 242
 243 proc chanmode_o0 {m g p chan} {
 244     global nick chandeop
 245     prefix_nick
 246     set who [chanmode_arg]
 247     recordlastseen_p $p "being mean to $who" 1
 248     if {"[irctolower $who]" == "[irctolower $nick]"} {
 249         set chandeop($chan) [list [clock seconds] $p]
 250     }
 251 }
 252
 253 proc msg_MODE {p c dest modelist args} {
 254     if {![ischan $dest]} return
 255     if {[regexp {^\-(.+)$} $modelist dummy modelist]} {
 256         set give 0
 257     } elseif {[regexp {^\+(.+)$} $modelist dummy modelist]} {
 258         set give 1
 259     } else {
 260         error "invalid modelist"
 261     }
 262     foreach m [split $modelist] {
 263         set procname chanmode_$m$give
 264         if {[catch { info body $procname }]} {
 265             recordlastseen_p $p "fiddling with $dest" 1
 266         } else {
 267             $procname $m $give  $p $dest
 268         }
 269     }
 270 }
 271
 272 proc leaving {lchan} {
 273     foreach luser [array names nick_onchans] {
 274         upvar #0 nick_onchans($luser) oc
 275         set oc [grep tc {"$tc" != "$lchan"} $oc]
 276     }
 277     upvar #0 chan_nicks($lchan) nlist
 278     unset nlist
 279     upvar #0 chan_lastactivity($lchan) la
 280     catch { unset la }
 281 }
 282
 283 proc doleave {lchan} {
 284     sendout PART $lchan
 285     leaving $lchan
 286 }
 287
 288 proc dojoin {lchan} {
 289     global chan_nicks
 290     sendout JOIN $lchan
 291     set chan_nicks($lchan) {}
 292 }
 293
 294 proc check_justme {lchan} {
 295     global nick
 296     upvar #0 chan_nicks($lchan) nlist
 297     if {[llength $nlist] != 1} return
 298     if {"[lindex $nlist 0]" != "[irctolower $nick]"} return
 299     if {[chandb_exists $lchan]} {
 300         set mode [chandb_get $lchan mode]
 301         if {"$mode" != "*"} {
 302             sendout MODE $lchan $mode
 303         }
 304         set topic [chandb_get $lchan topicset]
 305         if {[string length $topic]} {
 306             sendout TOPIC $lchan $topic
 307         }
 308     } else {
 309         doleave $lchan
 310     }
 311 }
 312
 313 proc process_kickpart {chan user} {
 314     global nick
 315     check_nick $user
 316     set luser [irctolower $user]
 317     set lchan [irctolower $chan]
 318     if {![ischan $chan]} { error "not a channel" }
 319     if {"$luser" == "[irctolower $nick]"} {
 320         leaving $lchan
 321     } else {
 322         upvar #0 nick_onchans($luser) oc
 323         upvar #0 chan_nicks($lchan) nlist
 324         set oc [grep tc {"$tc" != "$lchan"} $oc]
 325         set nlist [grep tn {"$tn" != "$luser"} $nlist]
 326         nick_case $user
 327         if {![llength $oc]} {
 328             nick_forget $luser
 329         } else {
 330             check_justme $lchan
 331         }
 332     }
 333 }
 334
 335 proc msg_TOPIC {p c dest topic} {
 336     prefix_nick
 337     if {![ischan $dest]} return
 338     recordlastseen_n $n "changing the topic on $dest" 1
 339     note_topic [irctolower $dest] $n $topic
 340 }
 341
 342 proc msg_KICK {p c chans users comment} {
 343     set chans [split $chans ,]
 344     set users [split $users ,]
 345     if {[llength $chans] > 1} {
 346         foreach chan $chans user $users { process_kickpart $chan $user }
 347     } else {
 348         foreach user $users { process_kickpart [lindex $chans 0] $user }
 349     }
 350 }
 351
 352 proc msg_KILL {p c user why} {
 353     nick_forget $user
 354 }
 355
 356 set nick_counter 0
 357 set nick_arys {onchans username unique}
 358 # nick_onchans($luser) -> [list ... $lchan ...]
 359 # nick_username($luser) -> <securely known local username>
 360 # nick_unique($luser) -> <counter>
 361 # nick_case($luser) -> $user  (valid even if no longer visible)
 362 # nick_markid($luser) -> <after id for marktime>
 363
 364 # chan_nicks($lchan) -> [list ... $luser ...]
 365 # chan_lastactivity($lchan) -> [clock seconds]
 366
 367 proc lnick_forget {luser} {
 368     global nick_arys chan_nicks
 369     lnick_marktime_cancel $luser
 370     foreach ary $nick_arys {
 371         upvar #0 nick_${ary}($luser) av
 372         catch { unset av }
 373     }
 374     foreach lch [array names chan_nicks] {
 375         upvar #0 chan_nicks($lch) nlist
 376         set nlist [grep tn {"$tn" != "$luser"} $nlist]
 377         check_justme $lch
 378     }
 379 }
 380
 381 proc nick_forget {user} {
 382     global nick_arys chan_nicks
 383     lnick_forget [irctolower $user]
 384     nick_case $user
 385 }
 386
 387 proc nick_case {user} {
 388     global nick_case
 389     set nick_case([irctolower $user]) $user
 390 }
 391
 392 proc msg_NICK {p c newnick} {
 393     global nick_arys nick_case
 394     prefix_nick
 395     recordlastseen_n $n "changing nicks to $newnick" 0
 396     recordlastseen_n $newnick "changing nicks from $n" 1
 397     set luser [irctolower $n]
 398     lnick_marktime_cancel $luser
 399     set lusernew [irctolower $newnick]
 400     foreach ary $nick_arys {
 401         upvar #0 nick_${ary}($luser) old
 402         upvar #0 nick_${ary}($lusernew) new
 403         if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
 404         if {[info exists old]} { set new $old; unset old }
 405     }
 406     upvar #0 nick_onchans($lusernew) oc
 407     foreach ch $oc {
 408         upvar #0 chan_nicks($ch) nlist
 409         set nlist [grep tn {"$tn" != "$luser"} $nlist]
 410         lappend nlist $lusernew
 411     }
 412     lnick_marktime_start $lusernew "Hi." 500
 413     nick_case $newnick
 414 }
 415
 416 proc nick_ishere {n} {
 417     global nick_counter
 418     upvar #0 nick_unique([irctolower $n]) u
 419     if {![info exists u]} { set u [incr nick_counter].$n.[clock seconds] }
 420     nick_case $n
 421 }
 422
 423 proc msg_JOIN {p c chan} {
 424     prefix_nick
 425     recordlastseen_n $n "joining $chan" 1
 426     set nl [irctolower $n]
 427     set lchan [irctolower $chan]
 428     upvar #0 nick_onchans($nl) oc
 429     upvar #0 chan_nicks($lchan) nlist
 430     if {![info exists oc]} {
 431         global marktime_join_startdelay
 432         lnick_marktime_start $nl "Welcome." $marktime_join_startdelay
 433     }
 434     lappend oc $lchan
 435     lappend nlist $nl
 436     nick_ishere $n
 437 }
 438 proc msg_PART {p c chan} {
 439     prefix_nick
 440     recordlastseen_n $n "leaving $chan" 1
 441     process_kickpart $chan $n
 442 }
 443 proc msg_QUIT {p c why} {
 444     prefix_nick
 445     recordlastseen_n $n "leaving ($why)" 0
 446     nick_forget $n
 447 }
 448
 449 proc msg_PRIVMSG {p c dest text} {
 450     global errorCode
 451
 452     prefix_nick
 453     if {[ischan $dest]} {
 454         recordlastseen_n $n "invoking me in $dest" 1
 455         set output $dest
 456     } else {
 457         recordlastseen_n $n "talking to me" 1
 458         set output $n
 459     }
 460     nick_case $n
 461
 462     if {[catch {
 463         regsub {^! *} $text {} text
 464         set ucmd [ta_word]
 465         set procname ucmd/[string tolower $ucmd]
 466         if {[catch { info body $procname }]} {
 467             usererror "Unknown command; try help for help."
 468         }
 469         $procname $p $dest
 470     } rv]} {
 471         if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
 472         sendprivmsg $n $rv
 473     } else {
 474         manyset $rv priv_msgs pub_msgs priv_acts pub_acts
 475         foreach {td val} [list $n $priv_acts $output $pub_acts] {
 476             foreach l [split $val "\n"] {
 477                 sendaction_priority 0 $td $l
 478             }
 479         }
 480         foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
 481             foreach l [split $val "\n"] {
 482                 sendprivmsg $td $l
 483             }
 484         }
 485     }
 486 }
 487
 488 proc msg_INVITE {p c n chan} {
 489     after 1000 [list dojoin [irctolower $chan]]
 490 }
 491
 492 proc grep {var predicate list} {
 493     set o {}
 494     upvar 1 $var v
 495     foreach v $list {
 496         if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
 497     }
 498     return $o
 499 }
 500
 501 proc msg_353 {p c dest type chan nicklist} {
 502     global names_chans nick_onchans
 503     set lchan [irctolower $chan]
 504     upvar #0 chan_nicks($lchan) nlist
 505     lappend names_chans $lchan
 506     if {![info exists nlist]} {
 507         # We don't think we're on this channel, so ignore it !
 508         # Unfortunately, because we don't get a reply to PART,
 509         # we have to remember ourselves whether we're on a channel,
 510         # and ignore stuff if we're not, to avoid races.  Feh.
 511         return
 512     }
 513     set nlist_new {}
 514     foreach user [split $nicklist { }] {
 515         regsub {^[@+]} $user {} user
 516         if {![string length $user]} continue
 517         check_nick $user
 518         set luser [irctolower $user]
 519         upvar #0 nick_onchans($luser) oc
 520         lappend oc $lchan
 521         lappend nlist_new $luser
 522         nick_ishere $user
 523     }
 524     set nlist $nlist_new
 525 }
 526
 527 proc msg_366 {p c args} {
 528     global names_chans nick_onchans
 529     set lchan [irctolower $c]
 530     foreach luser [array names nick_onchans] {
 531         upvar #0 nick_onchans($luser) oc
 532         if {[llength names_chans] > 1} {
 533             set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
 534         }
 535         if {![llength $oc]} { lnick_forget $n }
 536     }
 537     unset names_chans
 538 }
 539
 540 proc ta_anymore {} {
 541     upvar 1 text text
 542     return [expr {!![string length $text]}]
 543 }
 544
 545 proc ta_nomore {} {
 546     upvar 1 text text
 547     if {[string length $text]} { error "too many parameters" }
 548 }
 549
 550 proc ta_word {} {
 551     upvar 1 text text
 552     if {![regexp {^([^  ]+) *(.*)} $text dummy firstword text]} {
 553         error "too few parameters"
 554     }
 555     return $firstword
 556 }
 557
 558 proc ta_nick {} {
 559     upvar 1 text text
 560     set v [ta_word]
 561     check_nick $v
 562     return $v
 563 }
 564
 565 proc def_ucmd {cmdname body} {
 566     proc ucmd/$cmdname {p dest} "    upvar 1 text text\n$body"
 567 }
 568
 569 proc ucmdr {priv pub args} {
 570     return -code return [concat [list $priv $pub] $args]
 571 }
 572
 573 proc loadhelp {} {
 574     global help_topics errorInfo
 575
 576     catch { unset help_topics }
 577     set f [open helpinfos r]
 578     try_except_finally {
 579         set lno 0
 580         while {[gets $f l] >= 0} {
 581             incr lno
 582             if {[regexp {^#.*} $l]} {
 583             } elseif {[regexp {^ *$} $l]} {
 584                 if {[info exists topic]} {
 585                     set help_topics($topic) [join $lines "\n"]
 586                     unset topic
 587                     unset lines
 588                 }
 589             } elseif {[regexp {^\:\:} $l]} {
 590             } elseif {[regexp {^\:([-+._0-9a-z]*)$} $l dummy newtopic]} {
 591                 if {[info exists topic]} {
 592                     error "help $newtopic while in $topic"
 593                 }
 594                 set topic $newtopic
 595                 set lines {}
 596             } elseif {[regexp {^[^:#]} $l]} {
 597                 set topic
 598                 regsub -all {([^\\])\!\$?} _$l {\1} l
 599                 regsub -all {\\(.)} $l {\1} l
 600                 regsub {^_} $l {} l
 601                 lappend lines [string trimright $l]
 602             } else {
 603                 error "eh ? $lno: $l"
 604             }
 605         }
 606         if {[info exists topic]} { error "unfinished topic $topic" }
 607     } {
 608         set errorInfo "in helpinfos line $lno\n$errorInfo"
 609     } {
 610         close $f
 611     }
 612 }
 613
 614 def_ucmd help {
 615     upvar 1 n n
 616
 617     set topic [irctolower [string trim $text]]
 618     if {[string length $topic]} {
 619         set ontopic " on `$topic'"
 620     } else {
 621         set ontopic ""
 622     }
 623     if {[set lag [out_lagged]]} {
 624         if {[ischan $dest]} { set replyto $dest } else { set replyto $n }
 625         if {$lag > 1} {
 626             sendaction_priority 1 $replyto \
 627                 "is very lagged.  Please ask for help$ontopic again later."
 628             ucmdr {} {}
 629         } else {
 630             sendaction_priority 1 $replyto \
 631                 "is lagged.  Your help$ontopic will arrive shortly ..."
 632         }
 633     }
 634
 635     upvar #0 help_topics($topic) info
 636     if {![info exists info]} { ucmdr "No help on $topic, sorry." {} }
 637     ucmdr $info {}
 638 }
 639
 640 def_ucmd ? {
 641     global help_topics
 642     ucmdr $help_topics() {}
 643 }
 644
 645 proc check_username {target} {
 646     if {
 647         [string length $target] > 8 ||
 648         [regexp {[^-0-9a-z]} $target] ||
 649         ![regexp {^[a-z]} $target]
 650     } { error "invalid username" }
 651 }
 652
 653 proc somedb__head {} {
 654     uplevel 1 {
 655         set idl [irctolower $id]
 656         upvar #0 ${nickchan}db($idl) ndbe
 657         binary scan $idl H* idh
 658         set idfn $fprefix$idh
 659         if {![info exists iddbe] && [file exists $idfn]} {
 660             set f [open $idfn r]
 661             try_except_finally { set newval [read $f] } {} { close $f }
 662             if {[llength $newval] % 2} { error "invalid length" }
 663             set iddbe $newval
 664         }
 665     }
 666 }
 667
 668 proc def_somedb {name arglist body} {
 669     foreach {nickchan fprefix} {nick users/n chan chans/c} {
 670         proc ${nickchan}db_$name $arglist \
 671             "set nickchan $nickchan; set fprefix $fprefix; $body"
 672     }
 673 }
 674
 675 def_somedb list {} {
 676     set list {}
 677     foreach path [glob -nocomplain -path $fprefix *] {
 678         binary scan $path "A[string length $fprefix]A*" afprefix thinghex
 679         if {"$afprefix" != "$fprefix"} { error "wrong prefix $path $afprefix" }
 680         lappend list [binary format H* $thinghex]
 681     }
 682     return $list
 683 }
 684
 685 proc def_somedb_id {name arglist body} {
 686     def_somedb $name [concat id $arglist] "somedb__head; $body"
 687 }
 688
 689 def_somedb_id exists {} {
 690     return [info exists iddbe]
 691 }
 692
 693 def_somedb_id delete {} {
 694     catch { unset iddbe }
 695     file delete $idfn
 696 }
 697
 698 set default_settings_nick {timeformat ks  marktime off}
 699 set default_settings_chan {
 700     autojoin 1
 701     mode *
 702     userinvite pub
 703     topicset {}
 704     topicsee {}
 705     topictell {}
 706 }
 707
 708 def_somedb_id set {args} {
 709     upvar #0 default_settings_$nickchan def
 710     if {![info exists iddbe]} { set iddbe $def }
 711     foreach {key value} [concat $iddbe $args] { set a($key) $value }
 712     set newval {}
 713     foreach {key value} [array get a] { lappend newval $key $value }
 714     set f [open $idfn.new w]
 715     try_except_finally {
 716         puts $f $newval
 717         close $f
 718         file rename -force $idfn.new $idfn
 719     } {
 720     } {
 721         catch { close $f }
 722     }
 723     set iddbe $newval
 724 }
 725
 726 def_somedb_id get {key} {
 727     upvar #0 default_settings_$nickchan def
 728     if {[info exists iddbe]} {
 729         set l [concat $iddbe $def]
 730     } else {
 731         set l $def
 732     }
 733     foreach {tkey value} $l {
 734         if {"$tkey" == "$key"} { return $value }
 735     }
 736     error "unset setting $key"
 737 }
 738
 739 proc opt {key} {
 740     global calling_nick
 741     if {[info exists calling_nick]} { set n $calling_nick } { set n {} }
 742     return [nickdb_get $n $key]
 743 }
 744
 745 proc check_notonchan {} {
 746     upvar 1 dest dest
 747     if {[ischan $dest]} { usererror "That command must be sent privately." }
 748 }
 749
 750 proc nick_securitycheck {strict} {
 751     upvar 1 n n
 752     if {![nickdb_exists $n]} {
 753         usererror "You are unknown to me, use `register'."
 754     }
 755     set wantu [nickdb_get $n username]
 756     if {![string length $wantu]} {
 757         if {$strict} {
 758             usererror "That feature is only available to secure users, sorry."
 759         } else {
 760             return
 761         }
 762     }
 763     set luser [irctolower $n]
 764     upvar #0 nick_username($luser) nu
 765     if {![info exists nu]} {
 766         usererror "Nick $n is secure, you must identify yourself first."
 767     }
 768     if {"$wantu" != "$nu"} {
 769         usererror "You are the wrong user -\
 770                 the nick $n belongs to $wantu, not $nu."
 771     }
 772 }
 773
 774 proc channel_ismanager {channel n} {
 775     set mgrs [chandb_get $channel managers]
 776     return [expr {[lsearch -exact [irctolower $mgrs] [irctolower $n]] >= 0}]
 777 }
 778
 779 proc channel_securitycheck {channel} {
 780     upvar n n
 781     if {![channel_ismanager $channel $n]} {
 782         usererror "You are not a manager of $channel."
 783     }
 784     nick_securitycheck 1
 785 }
 786
 787 proc def_chancmd {name body} {
 788     proc channel/$name {} \
 789             "    upvar 1 target chan; upvar 1 n n; upvar 1 text text; $body"
 790 }
 791
 792 proc ta_listop {findnow procvalue} {
 793     # findnow and procvalue are code fragments which will be executed
 794     # in the caller's level.  findnow should set ta_listop_ev to
 795     # the current list, and procvalue should treat ta_listop_ev as
 796     # a proposed value in the list and check and possibly modify
 797     # (canonicalise?) it.  After ta_listop, ta_listop_ev will
 798     # be the new value of the list.
 799     upvar 1 ta_listop_ev exchg
 800     upvar 1 text text
 801     set opcode [ta_word]
 802     switch -exact _$opcode {
 803         _= { }
 804         _+ - _- {
 805             uplevel 1 $findnow
 806             foreach item $exchg { set array($item) 1 }
 807         }
 808         default {
 809             error "list change opcode must be one of + - ="
 810         }
 811     }
 812     foreach exchg [split $text " "] {
 813         if {![string length $exchg]} continue
 814         uplevel 1 $procvalue
 815         if {"$opcode" != "-"} {
 816             set array($exchg) 1
 817         } else {
 818             catch { unset array($exchg) }
 819         }
 820     }
 821     set exchg [lsort [array names array]]
 822 }
 823
 824 def_chancmd manager {
 825     ta_listop {
 826         if {[chandb_exists $chan]} {
 827             set ta_listop_ev [chandb_get $chan managers]
 828         } else {
 829             set ta_listop_ev [list [irctolower $n]]
 830         }
 831     } {
 832         check_nick $ta_listop_ev
 833         set ta_listop_ev [irctolower $ta_listop_ev]
 834     }
 835     if {[llength $ta_listop_ev]} {
 836         chandb_set $chan managers $ta_listop_ev
 837         ucmdr "Managers of $chan: $ta_listop_ev" {}
 838     } else {
 839         chandb_delete $chan
 840         ucmdr {} {} "forgets about managing $chan." {}
 841     }
 842 }
 843
 844 def_chancmd autojoin {
 845     set yesno [ta_word]
 846     switch -exact [string tolower $yesno] {
 847         no { set nv 0 }
 848         yes { set nv 1 }
 849         default { error "channel autojoin must be `yes' or `no' }
 850     }
 851     chandb_set $chan autojoin $nv
 852     ucmdr [expr {$nv ? "I will join $chan when I'm restarted " : \
 853             "I won't join $chan when I'm restarted "}] {}
 854 }
 855
 856 def_chancmd userinvite {
 857     set nv [string tolower [ta_word]]
 858     switch -exact $nv {
 859         pub { set txt "!invite will work for $chan, but it won't work by /msg" }
 860         here { set txt "!invite and /msg invite will work, but only for users who are already on $chan." }
 861         all { set txt "Any user will be able to invite themselves or anyone else to $chan." }
 862         none { set txt "I will not invite anyone to $chan." }
 863         default {
 864             error "channel userinvite must be `pub', `here', `all' or `none'
 865         }
 866     }
 867     chandb_set $chan userinvite $nv
 868     ucmdr $txt {}
 869 }
 870
 871 def_chancmd topic {
 872     set what [ta_word]
 873     switch -exact $what {
 874         leave {
 875             ta_nomore
 876             chandb_set $chan topicset {}
 877             ucmdr "I won't ever change the topic of $chan." {}
 878         }
 879         set {
 880             set t [string trim $text]
 881             if {![string length $t]} {
 882                 error "you must specific the topic to set"
 883             }
 884             chandb_set $chan topicset $t
 885             ucmdr "Whenever I'm alone on $chan, I'll set the topic to $t." {}
 886         }
 887         see - tell {
 888             ta_listop {
 889                 set ta_listop_ev [chandb_get $chan topic$what]
 890             } {
 891                 if {"$ta_listop_ev" != "*"} {
 892                     if {![ischan $ta_listop_ev]} {
 893                         error "bad channel \`$ta_listop_ev' in topic $what"
 894                     }
 895                     set ta_listop_ev [irctolower $ta_listop_ev]
 896                 }
 897             }
 898             chandb_set $chan topic$what $ta_listop_ev
 899             ucmdr "Topic $what list for $chan: $ta_listop_ev" {}
 900         }
 901         default {
 902             usererror "Unknown channel topic subcommand - see help channel."
 903         }
 904     }
 905 }
 906
 907 def_chancmd mode {
 908     set mode [ta_word]
 909     if {"$mode" != "*" && ![regexp {^(([-+][imnpst]+)+)$} $mode mode]} {
 910         error {channel mode must be * or match ([-+][imnpst]+)+}
 911     }
 912     chandb_set $chan mode $mode
 913     if {"$mode" == "*"} {
 914         ucmdr "I won't ever change the mode of $chan." {}
 915     } else {
 916         ucmdr "Whenever I'm alone on $chan, I'll set the mode to $mode." {}
 917     }
 918 }
 919
 920 def_chancmd show {
 921     if {[chandb_exists $chan]} {
 922         set l "Settings for $chan: autojoin "
 923         append l [lindex {no yes} [chandb_get $chan autojoin]]
 924         append l ", mode " [chandb_get $chan mode]
 925         append l ", userinvite " [chandb_get $chan userinvite] "."
 926         append l "\nManagers: "
 927         append l [join [chandb_get $chan managers] " "]
 928         foreach {ts sep} {see "\n" tell "  "} {
 929             set t [chandb_get $chan topic$ts]
 930             append l $sep
 931             if {[llength $t]} {
 932                 append l "Topic $ts list: $t."
 933             } else {
 934                 append l "Topic $ts list is empty."
 935             }
 936         }
 937         append l "\n"
 938         set t [chandb_get $chan topicset]
 939         if {[string length $t]} {
 940             append l "Topic to set: $t"
 941         } else {
 942             append l "I will not change the topic."
 943         }
 944         ucmdr {} $l
 945     } else {
 946         ucmdr {} "The channel $chan is not managed."
 947     }
 948 }
 949
 950 proc channelmgr_monoop {} {
 951     upvar 1 dest dest
 952     upvar 1 text text
 953     upvar 1 n n
 954     upvar 1 p p
 955     upvar 1 target target
 956     global chan_nicks
 957
 958     prefix_nick
 959
 960     if {[ischan $dest]} { set target $dest }
 961     if {[ta_anymore]} { set target [ta_word] }
 962     ta_nomore
 963     if {![info exists target]} {
 964         usererror "You must specify, or invoke me on, the relevant channel."
 965     }
 966     if {![info exists chan_nicks([irctolower $target])]} {
 967         usererror "I am not on $target."
 968     }
 969     if {![ischan $target]} { error "not a valid channel" }
 970
 971     if {![chandb_exists $target]} {
 972         usererror "$target is not a managed channel."
 973     }
 974     channel_securitycheck $target
 975 }
 976
 977 def_ucmd op {
 978     channelmgr_monoop
 979     sendout MODE $target +o $n
 980 }
 981
 982 def_ucmd leave {
 983     channelmgr_monoop
 984     doleave $target
 985 }
 986
 987 def_ucmd invite {
 988     global chan_nicks errorCode errorInfo
 989     prefix_nick
 990
 991     if {[ischan $dest]} {
 992         set target $dest
 993         set onchan 1
 994     } else {
 995         set target [ta_word]
 996         set onchan 0
 997     }
 998     set ltarget [irctolower $target]
 999     if {![ischan $target]} { error "$target is not a channel" }
1000     if {![info exists chan_nicks($ltarget)]} {
1001         usererror "I am not on $target."
1002     }
1003     set ui [chandb_get $ltarget userinvite]
1004     if {[catch {
1005         if {"$ui" == "pub" && !$onchan} {
1006             usererror "Invitations to $target must be made there with !invite."
1007         }
1008         if {"$ui" != "all"} {
1009             if {[lsearch -exact $chan_nicks($ltarget) [irctolower $n]] < 0} {
1010                 usererror "Invitations to $target may only be made\
1011                         by a user on the channel."
1012             }
1013         }
1014         if {"$ui" == "none"} {
1015             usererror "Sorry, I've not been authorised\
1016                     to invite people to $target."
1017         }
1018     } emsg]} {
1019         if {"$errorCode" == "BLIGHT USER" && [channel_ismanager $target $n]} {
1020             if {[catch {
1021                 nick_securitycheck 1
1022             } emsg2]} {
1023                 if {"$errorCode" == "BLIGHT USER"} {
1024                     usererror "$emsg2  Therefore you can't use your\
1025                             channel manager privilege.  $emsg"
1026                 } else {
1027                     error $error $errorInfo $errorCode
1028                 }
1029             }
1030         } else {
1031             error $emsg $errorInfo $errorCode
1032         }
1033     }
1034     if {![ta_anymore]} {
1035         usererror "You have to say who to invite."
1036     }
1037     set invitees {}
1038     while {[ta_anymore]} {
1039         set invitee [ta_word]
1040         check_nick $invitee
1041         lappend invitees $invitee
1042     }
1043     foreach invitee $invitees {
1044         sendout INVITE $invitee $ltarget
1045     }
1046     set who [lindex $invitees 0]
1047     switch -exact llength $invitees {
1048         0 { error "zero invitees" }
1049         1 { }
1050         2 { append who " and [lindex $invitees 1]" }
1051         * {
1052             set who [join [lreplace $invitees end end] ", "]
1053             append who " and [lindex $invitees [llength $invitees]]"
1054         }
1055     }
1056     ucmdr {} {} {} "invites $who to $target."
1057 }
1058
1059 def_ucmd channel {
1060     if {[ischan $dest]} { set target $dest }
1061     if {![ta_anymore]} {
1062         set subcmd show
1063     } else {
1064         set subcmd [ta_word]
1065     }
1066     if {[ischan $subcmd]} {
1067         set target $subcmd
1068         if {![ta_anymore]} {
1069             set subcmd show
1070         } else {
1071             set subcmd [ta_word]
1072         }
1073     }
1074     if {![info exists target]} { error "privately, you must specify a channel" }
1075     set procname channel/$subcmd
1076     if {"$subcmd" != "show"} {
1077         if {[catch { info body $procname }]} {
1078             usererror "unknown channel setting $subcmd."
1079         }
1080         prefix_nick
1081         if {[chandb_exists $target]} {
1082             channel_securitycheck $target
1083         } else {
1084             nick_securitycheck 1
1085             upvar #0 chan_initialop([irctolower $target]) io
1086             upvar #0 nick_unique([irctolower $n]) u
1087             if {![info exists io]} {
1088                 usererror "$target is not a managed channel."
1089             }
1090             if {"$io" != "$u"} {
1091                 usererror "You are not the interim manager of $target."
1092             }
1093             if {"$subcmd" != "manager"} {
1094                 usererror "Please use `channel manager' first."
1095             }
1096         }
1097     }
1098     channel/$subcmd
1099 }
1100
1101 def_ucmd who {
1102     if {[ta_anymore]} {
1103         set target [ta_word]; ta_nomore
1104         set myself 1
1105     } else {
1106         prefix_nick
1107         set target $n
1108         set myself [expr {"$target" != "$n"}]
1109     }
1110     set ltarget [irctolower $target]
1111     upvar #0 nick_case($ltarget) ctarget
1112     set nshow $target
1113     if {[info exists ctarget]} {
1114         upvar #0 nick_onchans($ltarget) oc
1115         upvar #0 nick_username($ltarget) nu
1116         if {[info exists oc]} { set nshow $ctarget }
1117     }
1118     if {![nickdb_exists $ltarget]} {
1119         set ol "$nshow is not a registered nick."
1120     } elseif {[string length [set username [nickdb_get $target username]]]} {
1121         set ol "The nick $nshow belongs to the user $username."
1122     } else {
1123         set ol "The nick $nshow is registered (but not to a username)."
1124     }
1125     if {![info exists ctarget] || ![info exists oc]} {
1126         if {$myself} {
1127             append ol "\nI can't see $nshow on anywhere."
1128         } else {
1129             append ol "\nYou aren't on any channels with me."
1130         }
1131     } elseif {![info exists nu]} {
1132         append ol "\n$nshow has not identified themselves."
1133     } elseif {![info exists username]} {
1134         append ol "\n$nshow has identified themselves as the user $nu."
1135     } elseif {"$nu" != "$username"} {
1136         append ol "\nHowever, $nshow is being used by the user $nu."
1137     } else {
1138         append ol "\n$nshow has identified themselves to me."
1139     }
1140     ucmdr {} $ol
1141 }
1142
1143 def_ucmd register {
1144     prefix_nick
1145     check_notonchan
1146     set old [nickdb_exists $n]
1147     if {$old} { nick_securitycheck 0 }
1148     set luser [irctolower $n]
1149     switch -exact [string tolower [string trim $text]] {
1150         {} {
1151             upvar #0 nick_username($luser) nu
1152             if {![info exists nu]} {
1153                 ucmdr {} \
1154  "You must identify yourself before using `register'.  See `help identify', or use `register insecure'."
1155             }
1156             nickdb_set $n username $nu
1157             ucmdr {} {} "makes a note of your username." {}
1158         }
1159         delete {
1160             nickdb_delete $n
1161             ucmdr {} {} "forgets your nickname." {}
1162         }
1163         insecure {
1164             nickdb_set $n username {}
1165             if {$old} {
1166                 ucmdr {} "Security is now disabled for your nickname !"
1167             } else {
1168                 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."
1169             }
1170         }
1171     }
1172 }
1173
1174 proc timeformat_desc {tf} {
1175     switch -exact $tf {
1176         ks { return "Times will be displayed in seconds or kiloseconds." }
1177         hms { return "Times will be displayed in hours, minutes, etc." }
1178         default { error "invalid timeformat: $v" }
1179     }
1180 }
1181
1182 proc def_setting {opt show_body set_body} {
1183     proc set_show/$opt {} "
1184         upvar 1 n n
1185         set opt $opt
1186         $show_body"
1187     if {![string length $set_body]} return
1188     proc set_set/$opt {} "
1189         upvar 1 n n
1190         upvar 1 text text
1191         set opt $opt
1192         $set_body"
1193 }
1194
1195 def_setting timeformat {
1196     set tf [nickdb_get $n timeformat]
1197     return "$tf: [timeformat_desc $tf]"
1198 } {
1199     set tf [string tolower [ta_word]]
1200     ta_nomore
1201     set desc [timeformat_desc $tf]
1202     nickdb_set $n timeformat $tf
1203     ucmdr {} $desc
1204 }
1205
1206 proc marktime_desc {mt} {
1207     if {"$mt" == "off"} {
1208         return "I will not send you periodic messages."
1209     } elseif {"$mt" == "once"} {
1210         return "I will send you one informational message when I see you."
1211     } else {
1212         return "I'll send you a message every [showintervalsecs $mt 0]."
1213     }
1214 }
1215
1216 def_setting marktime {
1217     set mt [nickdb_get $n marktime]
1218     set p $mt
1219     if {[string match {[0-9]*} $mt]} { append p s }
1220     append p ": "
1221     append p [marktime_desc $mt]
1222     return $p
1223 } {
1224     global marktime_min
1225     set mt [string tolower [ta_word]]
1226     ta_nomore
1227
1228     if {"$mt" == "off" || "$mt" == "once"} {
1229     } elseif {[regexp {^([0-9]+)([a-z]+)$} $mt dummy value unit]} {
1230         switch -exact $unit {
1231             s { set u 1 }
1232             ks { set u 1000 }
1233             m { set u 60 }
1234             h { set u 3600 }
1235             default { error "unknown unit of time $unit" }
1236         }
1237         if {$value > 86400*21/$u} { error "marktime interval too large" }
1238         set mt [expr {$value*$u}]
1239         if {$mt < $marktime_min} { error "marktime interval too small" }
1240     } else {
1241         error "invalid syntax for marktime"
1242     }
1243     nickdb_set $n marktime $mt
1244     lnick_marktime_start [irctolower $n] "So:" 500
1245     ucmdr {} [marktime_desc $mt]
1246 }
1247
1248 def_setting security {
1249     set s [nickdb_get $n username]
1250     if {[string length $s]} {
1251         return "Your nick, $n, is controlled by the user $s."
1252     } else {
1253         return "Your nick, $n, is not secure."
1254     }
1255 } {}
1256
1257 def_ucmd set {
1258     prefix_nick
1259     check_notonchan
1260     if {![nickdb_exists $n]} {
1261         ucmdr {} "You are unknown to me and so have no settings.  (Use `register'.)"
1262     }
1263     if {![ta_anymore]} {
1264         set ol {}
1265         foreach proc [lsort [info procs]] {
1266             if {![regexp {^set_show/(.*)$} $proc dummy opt]} continue
1267             lappend ol [format "%-10s %s" $opt [set_show/$opt]]
1268         }
1269         ucmdr {} [join $ol "\n"]
1270     } else {
1271         set opt [ta_word]
1272         if {[catch { info body set_show/$opt }]} {
1273             error "no setting $opt"
1274         }
1275         if {![ta_anymore]} {
1276             ucmdr {} "$opt [set_show/$opt]"
1277         } else {
1278             nick_securitycheck 0
1279             if {[catch { info body set_set/$opt }]} {
1280                 error "setting $opt cannot be set with `set'"
1281             }
1282             set_set/$opt
1283         }
1284     }
1285 }
1286
1287 def_ucmd identpass {
1288     set username [ta_word]
1289     set passmd5 [md5sum "[ta_word]\n"]
1290     ta_nomore
1291     prefix_nick
1292     check_notonchan
1293     set luser [irctolower $n]
1294     upvar #0 nick_onchans($luser) onchans
1295     if {![info exists onchans] || ![llength $onchans]} {
1296         ucmdr "You must be on a channel with me to identify yourself." {}
1297     }
1298     check_username $username
1299     exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
1300             irc-identpass $n
1301     upvar #0 nick_username($luser) rec_username
1302     set rec_username $username
1303     ucmdr "Pleased to see you, $username." {}
1304 }
1305
1306 def_ucmd summon {
1307     set target [ta_word]
1308     ta_nomore
1309     check_username $target
1310     prefix_nick
1311
1312     upvar #0 lastsummon($target) ls
1313     set now [clock seconds]
1314     if {[info exists ls]} {
1315         set interval [expr {$now - $ls}]
1316         if {$interval < 30} {
1317             ucmdr {} \
1318  "Please be patient; $target was summoned only [showinterval $interval]."
1319         }
1320     }
1321     regsub {^[^!]*!} $p {} path
1322     if {[catch {
1323         exec userv --timeout 3 $target irc-summon $n $path \
1324                 [expr {[ischan $dest] ? "$dest" : ""}] \
1325                 < /dev/null
1326     } rv]} {
1327         regsub -all "\n" $rv { / } rv
1328         error $rv
1329     }
1330     if {[regexp {^problem (.*)} $rv dummy problem]} {
1331         ucmdr {} "The user `$target' $problem."
1332     } elseif {[regexp {^ok ([^ ]+) ([0-9]+)$} $rv dummy tty idlesince]} {
1333         set idletime [expr {$now - $idlesince}]
1334         set ls $now
1335         ucmdr {} {} {} "invites $target ($tty[expr {
1336             $idletime > 10 ? ", idle for [showintervalsecs $idletime 0]" : ""
1337         }]) to [expr {
1338             [ischan $dest] ? "join us here" : "talk to you"
1339         }]."
1340     } else {
1341         error "unexpected response from userv service: $rv"
1342     }
1343 }
1344
1345 proc md5sum {value} { exec md5sum << $value }
1346
1347 def_ucmd seen {
1348     global lastseen nick
1349     prefix_nick
1350     set ncase [ta_nick]
1351     set nlower [irctolower $ncase]
1352     ta_nomore
1353     set now [clock seconds]
1354     if {"$nlower" == "[irctolower $nick]"} {
1355         usererror "I am not self-aware."
1356     } elseif {![info exists lastseen($nlower)]} {
1357         set rstr "I've never seen $ncase."
1358     } else {
1359         manyset $lastseen($nlower) realnick time what
1360         set howlong [expr {$now - $time}]
1361         set string [showinterval $howlong]
1362         set rstr "I last saw $realnick $string, $what."
1363     }
1364     if {[ischan $dest]} {
1365         set where $dest
1366     } else {
1367         set where {}
1368     }
1369     upvar #0 lookedfor($nlower) lf
1370     if {[info exists lf]} { set oldvalue $lf } else { set oldvalue {} }
1371     set lf [list [list $now $n $where]]
1372     foreach v $oldvalue {
1373         if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
1374         lappend lf $v
1375     }
1376     ucmdr {} $rstr
1377 }
1378
1379 proc lnick_marktime_cancel {luser} {
1380     upvar #0 nick_markid($luser) mi
1381     if {![info exists mi]} return
1382     catch { after cancel $mi }
1383     catch { unset mi }
1384 }
1385
1386 proc lnick_marktime_doafter {luser why ms} {
1387     lnick_marktime_cancel $luser
1388     upvar #0 nick_markid($luser) mi
1389     set mi [after $ms [list lnick_marktime_now $luser $why]]
1390 }
1391
1392 proc lnick_marktime_reset {luser} {
1393     set mt [nickdb_get $luser marktime]
1394     if {"$mt" == "off" || "$mt" == "once"} return
1395     lnick_marktime_doafter $luser "Time passes." [expr {$mt*1000}]
1396 }
1397
1398 proc lnick_marktime_start {luser why ms} {
1399     set mt [nickdb_get $luser marktime]
1400     if {"$mt" == "off"} {
1401         lnick_marktime_cancel $luser
1402     } else {
1403         lnick_marktime_doafter $luser $why $ms
1404     }
1405 }
1406
1407 proc lnick_marktime_now {luser why} {
1408     upvar #0 nick_onchans($luser) oc
1409     global calling_nick
1410     set calling_nick $luser
1411     sendprivmsg $luser [lnick_pingstring $why $oc ""]
1412     lnick_marktime_reset $luser
1413 }
1414
1415 proc lnick_pingstring {why oc apstring} {
1416     global nick_onchans
1417     catch { exec uptime } uptime
1418     set nnicks [llength [array names nick_onchans]]
1419     if {[regexp \
1420  {^ *([0-9:apm]+) +up.*, +(\d+) users, +load average: +([0-9., ]+) *$} \
1421             $uptime dummy time users load]} {
1422         regsub -all , $load {} load
1423         set uptime "$time  $nnicks/$users  $load"
1424     } else {
1425         append uptime ", $nnicks nicks"
1426     }
1427     if {[llength $oc]} {
1428         set best_la 0
1429         set activity quiet
1430         foreach ch $oc {
1431             upvar #0 chan_lastactivity($ch) la
1432             if {![info exists la]} continue
1433             if {$la <= $best_la} continue
1434             set since [showintervalsecs [expr {[clock seconds]-$la}] 1]
1435             set activity "$ch $since"
1436             set best_la $la
1437         }
1438     } else {
1439         set activity unseen
1440     }
1441     set str $why
1442     append str "  " $uptime "  " $activity
1443     if {[string length $apstring]} { append str "  " $apstring }
1444     return $str
1445 }
1446
1447 def_ucmd ping {
1448     if {[ischan $dest]} {
1449         set oc [irctolower $dest]
1450     } else {
1451         global nick_onchans
1452         prefix_nick
1453         set ln [irctolower $n]
1454         if {[info exists nick_onchans($ln)]} {
1455             set oc $nick_onchans($ln)
1456         } else {
1457             set oc {}
1458         }
1459         if {[llength $oc]} { lnick_marktime_reset $ln }
1460     }
1461     ucmdr {} [lnick_pingstring "Pong!" $oc $text]
1462 }
1463
1464 proc ensure_globalsecret {} {
1465     global globalsecret
1466
1467     if {[info exists globalsecret]} return
1468     set gsfile [open /dev/urandom r]
1469     fconfigure $gsfile -translation binary
1470     set globalsecret [read $gsfile 32]
1471     binary scan $globalsecret H* globalsecret
1472     close $gsfile
1473     unset gsfile
1474 }
1475
1476 proc ensure_outqueue {} {
1477     out__vars
1478     if {[info exists out_queue]} return
1479     set out_creditms 0
1480     set out_creditat [clock seconds]
1481     set out_queue {}
1482     set out_lag_reported 0
1483     set out_lag_reportwhen $out_creditat
1484 }
1485
1486 proc fail {msg} {
1487     logerror "failing: $msg"
1488     exit 1
1489 }
1490
1491 proc ensure_connecting {} {
1492     global sock ownfullname host port nick socketargs
1493     global musthaveping_ms musthaveping_after
1494
1495     if {[info exists sock]} return
1496     set sock [eval socket $socketargs [list $host $port]]
1497     fconfigure $sock -buffering line
1498     fconfigure $sock -translation crlf
1499
1500     sendout USER blight 0 * $ownfullname
1501     sendout NICK $nick
1502     fileevent $sock readable onread
1503
1504     set musthaveping_after [after $musthaveping_ms \
1505             {fail "no ping within timeout"}]
1506 }
1507
1508 proc connected {} {
1509     global musthaveping_after
1510
1511     after cancel $musthaveping_after
1512     unset musthaveping_after
1513
1514     foreach chan [chandb_list] {
1515         if {[chandb_get $chan autojoin]} { dojoin $chan }
1516     }
1517 }
1518
1519 ensure_globalsecret
1520 ensure_outqueue
1521 loadhelp
1522 ensure_connecting