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

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