X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/cf6ea4de62f6db0f2d923d2b5f9c009f2cc19fd5..cd8c3236df9b5e2804e34f6a36fe714c4e626b1c:/bot.tcl diff --git a/bot.tcl b/bot.tcl index 5bbaeb0..1119fbf 100755 --- a/bot.tcl +++ b/bot.tcl @@ -1,281 +1,29 @@ -# Core bot code +# Actual IRC bot code -proc defset {varname val} { - upvar #0 $varname var - if {![info exists var]} { set var $val } -} - -# must set host -defset port 6667 - -defset nick testbot -defset ownfullname "testing bot" -defset ownmailaddr test-irc-bot@example.com - -defset musthaveping_ms 10000 -defset out_maxburst 6 -defset out_interval 2100 -defset out_lag_lag 5000 -defset out_lag_very 25000 +set helpfile helpinfos -proc manyset {list args} { - foreach val $list var $args { - upvar 1 $var my - set my $val - } -} +source irccore.tcl +source parsecmd.tcl +source stdhelp.tcl -proc try_except_finally {try except finally} { - global errorInfo errorCode - set er [catch { uplevel 1 $try } emsg] - if {$er} { - set ei $errorInfo - set ec $errorCode - if {[catch { uplevel 1 $except } emsg3]} { - append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3" - } - } - set er2 [catch { uplevel 1 $finally } emsg2] - if {$er} { - if {$er2} { - append ei "\nALSO ERROR CLEANING UP:\n$emsg2" - } - return -code $er -errorinfo $ei -errorcode $ec $emsg - } elseif {$er2} { - return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2 - } else { - return $emsg - } -} - -proc out__vars {} { - uplevel 1 { - global out_queue out_creditms out_creditat out_interval out_maxburst - global out_lag_lag out_lag_very -#set pr [lindex [info level 0] 0] -#puts $pr>[clock seconds]|$out_creditat|$out_creditms|[llength $out_queue]< - } -} - -proc out_lagged {} { - out__vars - if {[llength $out_queue]*$out_interval > $out_lag_very} { - return 2 - } elseif {[llength $out_queue]*$out_interval > $out_lag_lag} { - return 1 - } else { +proc privmsg_unlogged {prefix ischan params} { + if {!$ischan || + [regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} { return 0 } + # on-channel message, ignore + set chan [lindex $params 0] + upvar #0 chan_lastactivity([irctolower $chan]) la + set la [clock seconds] + catch { recordlastseen_p $prefix "talking on $chan" 1 } + return 1 } -proc out_restart {} { - out__vars - - set now [clock seconds] - incr out_creditms [expr {($now - $out_creditat) * 1000}] - set out_creditat $now - if {$out_creditms > $out_maxburst*$out_interval} { - set out_creditms [expr {$out_maxburst*$out_interval}] - } - out_runqueue $now -} - -proc out_runqueue {now} { - global sock - out__vars - - while {[llength $out_queue] && $out_creditms >= $out_interval} { -#puts rq>$now|$out_creditat|$out_creditms|[llength $out_queue]< - manyset [lindex $out_queue 0] orgwhen msg - set out_queue [lrange $out_queue 1 end] - if {[llength $out_queue]} { - append orgwhen "+[expr {$now - $orgwhen}]" - append orgwhen "([llength $out_queue])" - } - puts "$orgwhen -> $msg" - puts $sock $msg - incr out_creditms -$out_interval - } - if {[llength $out_queue]} { - after $out_interval out_nextmessage - } -} - -proc out_nextmessage {} { - out__vars - set now [clock seconds] - incr out_creditms $out_interval - set out_creditat $now - out_runqueue $now -} - -proc sendout_priority {priority command args} { - global sock out_queue - if {[llength $args]} { - set la [lindex $args end] - set args [lreplace $args end end] - foreach i $args { - if {[regexp {[: ]} $i]} { - error "bad argument in output $i ($command $args)" - } - } - lappend args :$la - } - set args [lreplace $args 0 -1 $command] - set string [join $args { }] - set now [clock seconds] - set newe [list $now $string] - if {$priority} { - set out_queue [concat [list $newe] $out_queue] - } else { - lappend out_queue $newe - } - if {[llength $out_queue] == 1} { - out_restart - } +proc showintervalsecs {howlong abbrev} { + return [showintervalsecs/[opt timeformat] $howlong $abbrev] } -proc sendout {command args} { eval sendout_priority [list 0 $command] $args } - -proc log {data} { - puts $data -} - -proc logerror {data} { - log $data -} - -proc saveeic {} { - global saveei saveec errorInfo errorCode - - set saveei $errorInfo - set saveec $errorCode - - puts ">$saveec|$saveei<" -} - -proc bgerror {msg} { - global save - logerror $msg - saveeic -} - -proc onread {args} { - global sock nick calling_nick errorInfo errorCode - - if {[gets $sock line] == -1} { fail "EOF/error on input" } - regsub -all "\[^ -\176\240-\376\]" $line ? line - set org $line - - set ei $errorInfo - set ec $errorCode - catch { unset calling_nick } - set errorInfo $ei - set errorCode $ec - - if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} { - set line $remain - if {[regexp {^([^!]+)!} $prefix dummy maybenick]} { - set calling_nick $maybenick - if {"[irctolower $maybenick]" == "[irctolower $nick]"} return - } - } else { - set prefix {} - } - if {![string length $line]} { return } - if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} { - log "bad command: $org" - return - } - set command [string toupper $command] - set params {} - while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} { - lappend params $thisword - } - if {[regexp {^:(.*)} $line dummy thisword]} { - lappend params $thisword - } elseif {[string length $line]} { - log "junk at end: $org" - return - } - if {"$command" == "PRIVMSG" && - [regexp {^[&#+!]} [lindex $params 0]] && - ![regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} { - # on-channel message, ignore - catch { - recordlastseen_p $prefix "talking on [lindex $params 0]" 1 - } - return - } - log "[clock seconds] <- $org" - set procname msg_$command - if {[catch { info body $procname }]} { return } - if {[catch { - eval [list $procname $prefix $command] $params - } emsg]} { - logerror "error: $emsg ($prefix $command $params)" - saveeic - } -} - -proc sendprivmsg {dest l} { - foreach v [split $l "\n"] { - sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v - } -} -proc sendaction_priority {priority dest what} { - sendout_priority $priority PRIVMSG $dest "\001ACTION $what\001" -} -proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } } -proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] } - -proc prefix_none {} { - upvar 1 p p - if {[string length $p]} { error "prefix specified" } -} - -proc msg_PING {p c s1} { - global musthaveping_after - prefix_none - sendout PONG $s1 - if {[info exists musthaveping_after]} connected -} - -proc check_nick {n} { - if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" } - if {[regexp {^[-0-9]} $n]} { error "bad nick start" } -} - -proc ischan {dest} { - return [regexp {^[&#+!]} $dest] -} - -proc irctolower {v} { - foreach {from to} [list "\\\[" "{" \ - "\\\]" "}" \ - "\\\\" "|" \ - "~" "^"] { - regsub -all $from $v $to v - } - return [string tolower $v] -} - -proc prefix_nick {} { - global nick - upvar 1 p p - upvar 1 n n - if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" } - check_nick $n - if {"[irctolower $n]" == "[irctolower $nick]"} { - error "from myself" {} {} - } -} - -proc showintervalsecs {howlong} { - return [showintervalsecs/[opt timeformat] $howlong] -} - -proc showintervalsecs/ks {howlong} { +proc showintervalsecs/ks {howlong abbrev} { if {$howlong < 1000} { return "${howlong}s" } else { @@ -294,15 +42,19 @@ proc showintervalsecs/ks {howlong} { } } -proc format_qty {qty unit} { +proc format_qty {qty unit abbrev} { set o $qty - append o " " - append o $unit - if {$qty != 1} { append o s } + if {$abbrev} { + append o [string range $unit 0 0] + } else { + append o " " + append o $unit + if {$qty != 1} { append o s } + } return $o } -proc showintervalsecs/hms {qty} { +proc showintervalsecs/hms {qty abbrev} { set ul {second 60 minute 60 hour 24 day 7 week} set remainv 0 while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} { @@ -311,10 +63,10 @@ proc showintervalsecs/hms {qty} { set qty [expr {($qty-$remainv)/$uv}] set ul [lreplace $ul 0 1] } - set o [format_qty $qty [lindex $ul 0]] + set o [format_qty $qty [lindex $ul 0] $abbrev] if {$remainv} { - append o " " - append o [format_qty $remainv $remainu] + if {!$abbrev} { append o " " } + append o [format_qty $remainv $remainu $abbrev] } return $o } @@ -323,7 +75,7 @@ proc showinterval {howlong} { if {$howlong <= 0} { return {just now} } else { - return "[showintervalsecs $howlong] ago" + return "[showintervalsecs $howlong 0] ago" } } @@ -510,6 +262,8 @@ proc leaving {lchan} { } upvar #0 chan_nicks($lchan) nlist unset nlist + upvar #0 chan_lastactivity($lchan) la + catch { unset la } } proc doleave {lchan} { @@ -591,11 +345,14 @@ set nick_arys {onchans username unique} # nick_username($luser) -> # nick_unique($luser) -> # nick_case($luser) -> $user (valid even if no longer visible) +# nick_markid($luser) -> # chan_nicks($lchan) -> [list ... $luser ...] +# chan_lastactivity($lchan) -> [clock seconds] proc lnick_forget {luser} { global nick_arys chan_nicks + lnick_marktime_cancel $luser foreach ary $nick_arys { upvar #0 nick_${ary}($luser) av catch { unset av } @@ -619,11 +376,13 @@ proc nick_case {user} { } proc msg_NICK {p c newnick} { - global nick_arys nick_case + global nick_arys nick_case calling_nick prefix_nick recordlastseen_n $n "changing nicks to $newnick" 0 + set calling_nick $newnick recordlastseen_n $newnick "changing nicks from $n" 1 set luser [irctolower $n] + lnick_marktime_cancel $luser set lusernew [irctolower $newnick] foreach ary $nick_arys { upvar #0 nick_${ary}($luser) old @@ -637,6 +396,7 @@ proc msg_NICK {p c newnick} { set nlist [grep tn {"$tn" != "$luser"} $nlist] lappend nlist $lusernew } + lnick_marktime_start $lusernew "Hi." 500 nick_case $newnick } @@ -654,6 +414,10 @@ proc msg_JOIN {p c chan} { set lchan [irctolower $chan] upvar #0 nick_onchans($nl) oc upvar #0 chan_nicks($lchan) nlist + if {![info exists oc]} { + global marktime_join_startdelay + lnick_marktime_start $nl "Welcome." $marktime_join_startdelay + } lappend oc $lchan lappend nlist $nl nick_ishere $n @@ -670,6 +434,8 @@ proc msg_QUIT {p c why} { } proc msg_PRIVMSG {p c dest text} { + global errorCode + prefix_nick if {[ischan $dest]} { recordlastseen_n $n "invoking me in $dest" 1 @@ -680,29 +446,7 @@ proc msg_PRIVMSG {p c dest text} { } nick_case $n - if {[catch { - regsub {^! *} $text {} text - set ucmd [ta_word] - set procname ucmd/[string tolower $ucmd] - if {[catch { info body $procname }]} { - error "unknown command; try help for help" - } - $procname $p $dest - } rv]} { - sendprivmsg $n "error: $rv" - } else { - manyset $rv priv_msgs pub_msgs priv_acts pub_acts - foreach {td val} [list $n $priv_acts $output $pub_acts] { - foreach l [split $val "\n"] { - sendaction_priority 0 $td $l - } - } - foreach {td val} [list $n $priv_msgs $output $pub_msgs] { - foreach l [split $val "\n"] { - sendprivmsg $td $l - } - } - } + execute_usercommand $p $c $n $output $dest $text } proc msg_INVITE {p c n chan} { @@ -757,111 +501,6 @@ proc msg_366 {p c args} { unset names_chans } -proc ta_anymore {} { - upvar 1 text text - return [expr {!![string length $text]}] -} - -proc ta_nomore {} { - upvar 1 text text - if {[string length $text]} { error "too many parameters" } -} - -proc ta_word {} { - upvar 1 text text - if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} { - error "too few parameters" - } - return $firstword -} - -proc ta_nick {} { - upvar 1 text text - set v [ta_word] - check_nick $v - return $v -} - -proc def_ucmd {cmdname body} { - proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body" -} - -proc ucmdr {priv pub args} { - return -code return [concat [list $priv $pub] $args] -} - -proc loadhelp {} { - global help_topics errorInfo - - catch { unset help_topics } - set f [open helpinfos r] - try_except_finally { - set lno 0 - while {[gets $f l] >= 0} { - incr lno - if {[regexp {^#.*} $l]} { - } elseif {[regexp {^ *$} $l]} { - if {[info exists topic]} { - set help_topics($topic) [join $lines "\n"] - unset topic - unset lines - } - } elseif {[regexp {^\:\:} $l]} { - } elseif {[regexp {^\:([-+._0-9a-z]*)$} $l dummy newtopic]} { - if {[info exists topic]} { - error "help $newtopic while in $topic" - } - set topic $newtopic - set lines {} - } elseif {[regexp {^[^:#]} $l]} { - set topic - regsub -all {([^\\])\!\$?} _$l {\1} l - regsub -all {\\(.)} $l {\1} l - regsub {^_} $l {} l - lappend lines [string trimright $l] - } else { - error "eh ? $lno: $l" - } - } - if {[info exists topic]} { error "unfinished topic $topic" } - } { - set errorInfo "in helpinfos line $lno\n$errorInfo" - } { - close $f - } -} - -def_ucmd help { - upvar 1 n n - - set topic [irctolower [string trim $text]] - if {[string length $topic]} { - set ontopic " on `$topic'" - } else { - set ontopic "" - } - if {[set lag [out_lagged]]} { - if {[ischan $dest]} { set replyto $dest } else { set replyto $n } - if {$lag > 1} { - sendaction_priority 1 $replyto \ - "is very lagged. Please ask for help$ontopic again later." - ucmdr {} {} - } else { - sendaction_priority 1 $replyto \ - "is lagged. Your help$ontopic will arrive shortly ..." - } - } - - upvar #0 help_topics($topic) info - if {![info exists info]} { ucmdr "No help on $topic, sorry." {} } - ucmdr $info {} -} - -def_ucmd ? { - global help_topics - ucmdr $help_topics() {} -} - proc check_username {target} { if { [string length $target] > 8 || @@ -915,7 +554,7 @@ def_somedb_id delete {} { file delete $idfn } -set default_settings_nick {timeformat ks} +set default_settings_nick {timeformat ks marktime off} set default_settings_chan { autojoin 1 mode * @@ -964,16 +603,18 @@ proc opt {key} { proc check_notonchan {} { upvar 1 dest dest - if {[ischan $dest]} { error "that command must be sent privately" } + if {[ischan $dest]} { usererror "That command must be sent privately." } } proc nick_securitycheck {strict} { upvar 1 n n - if {![nickdb_exists $n]} { error "you are unknown to me, use `register'." } + if {![nickdb_exists $n]} { + usererror "You are unknown to me, use `register'." + } set wantu [nickdb_get $n username] if {![string length $wantu]} { if {$strict} { - error "that feature is only available to secure users, sorry." + usererror "That feature is only available to secure users, sorry." } else { return } @@ -981,19 +622,25 @@ proc nick_securitycheck {strict} { set luser [irctolower $n] upvar #0 nick_username($luser) nu if {![info exists nu]} { - error "nick $n is secure, you must identify yourself first." + usererror "Nick $n is secure, you must identify yourself first." } if {"$wantu" != "$nu"} { - error "you are the wrong user - the nick $n belongs to $wantu, not $nu" + usererror "You are the wrong user -\ + the nick $n belongs to $wantu, not $nu." } } -proc channel_securitycheck {channel n} { - # You must also call `nick_securitycheck 1' +proc channel_ismanager {channel n} { set mgrs [chandb_get $channel managers] - if {[lsearch -exact [irctolower $mgrs] [irctolower $n]] < 0} { - error "you are not a manager of $channel" + return [expr {[lsearch -exact [irctolower $mgrs] [irctolower $n]] >= 0}] +} + +proc channel_securitycheck {channel} { + upvar n n + if {![channel_ismanager $channel $n]} { + usererror "You are not a manager of $channel." } + nick_securitycheck 1 } proc def_chancmd {name body} { @@ -1111,7 +758,7 @@ def_chancmd topic { ucmdr "Topic $what list for $chan: $ta_listop_ev" {} } default { - error "unknown channel topic subcommand - see help channel" + usererror "Unknown channel topic subcommand - see help channel." } } } @@ -1167,20 +814,23 @@ proc channelmgr_monoop {} { upvar 1 target target global chan_nicks + prefix_nick + if {[ischan $dest]} { set target $dest } if {[ta_anymore]} { set target [ta_word] } ta_nomore if {![info exists target]} { - error "you must specify, or invoke me on, the relevant channel" + usererror "You must specify, or invoke me on, the relevant channel." } if {![info exists chan_nicks([irctolower $target])]} { - error "I am not on $target." + usererror "I am not on $target." } if {![ischan $target]} { error "not a valid channel" } - if {![chandb_exists $target]} { error "$target is not a managed channel." } - prefix_nick - nick_securitycheck 1 - channel_securitycheck $target $n + + if {![chandb_exists $target]} { + usererror "$target is not a managed channel." + } + channel_securitycheck $target } def_ucmd op { @@ -1194,7 +844,8 @@ def_ucmd leave { } def_ucmd invite { - global chan_nicks + global chan_nicks errorCode errorInfo + prefix_nick if {[ischan $dest]} { set target $dest @@ -1204,23 +855,43 @@ def_ucmd invite { set onchan 0 } set ltarget [irctolower $target] - if {![ischan $target]} { error "$target is not a channel." } - if {![info exists chan_nicks($ltarget)]} { error "I am not on $target." } - set ui [chandb_get $ltarget userinvite] - if {"$ui" == "pub" && !$onchan} { - error "Invitations to $target must be made with !invite." + if {![ischan $target]} { error "$target is not a channel" } + if {![info exists chan_nicks($ltarget)]} { + usererror "I am not on $target." } - if {"$ui" != "all"} { - prefix_nick - if {[lsearch -exact $chan_nicks($ltarget) [irctolower $n]] < 0} { - error "Invitations to $target may only be made by a user on the channel." + set ui [chandb_get $ltarget userinvite] + if {[catch { + if {"$ui" == "pub" && !$onchan} { + usererror "Invitations to $target must be made there with !invite." + } + if {"$ui" != "all"} { + if {[lsearch -exact $chan_nicks($ltarget) [irctolower $n]] < 0} { + usererror "Invitations to $target may only be made\ + by a user on the channel." + } + } + if {"$ui" == "none"} { + usererror "Sorry, I've not been authorised\ + to invite people to $target." + } + } emsg]} { + if {"$errorCode" == "BLIGHT USER" && [channel_ismanager $target $n]} { + if {[catch { + nick_securitycheck 1 + } emsg2]} { + if {"$errorCode" == "BLIGHT USER"} { + usererror "$emsg2 Therefore you can't use your\ + channel manager privilege. $emsg" + } else { + error $error $errorInfo $errorCode + } + } + } else { + error $emsg $errorInfo $errorCode } - } - if {"$ui" == "none"} { - error "Sorry, I've not been authorised to invite people to $target." } if {![ta_anymore]} { - error "You have to say who to invite." + usererror "You have to say who to invite." } set invitees {} while {[ta_anymore]} { @@ -1241,7 +912,7 @@ def_ucmd invite { append who " and [lindex $invitees [llength $invitees]]" } } - ucmdr {} "invites $who to $target." + ucmdr {} {} {} "invites $who to $target." } def_ucmd channel { @@ -1262,17 +933,25 @@ def_ucmd channel { if {![info exists target]} { error "privately, you must specify a channel" } set procname channel/$subcmd if {"$subcmd" != "show"} { - if {[catch { info body $procname }]} { error "unknown channel setting $subcmd" } + if {[catch { info body $procname }]} { + usererror "unknown channel setting $subcmd." + } prefix_nick - nick_securitycheck 1 if {[chandb_exists $target]} { - channel_securitycheck $target $n + channel_securitycheck $target } else { + nick_securitycheck 1 upvar #0 chan_initialop([irctolower $target]) io upvar #0 nick_unique([irctolower $n]) u - if {![info exists io]} { error "$target is not a managed channel" } - if {"$io" != "$u"} { error "you are not the interim manager of $target" } - if {"$subcmd" != "manager"} { error "use `channel manager' first" } + if {![info exists io]} { + usererror "$target is not a managed channel." + } + if {"$io" != "$u"} { + usererror "You are not the interim manager of $target." + } + if {"$subcmd" != "manager"} { + usererror "Please use `channel manager' first." + } } } channel/$subcmd @@ -1348,6 +1027,9 @@ def_ucmd register { 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." } } + default { + error "you mean register / register delete / register insecure" + } } } @@ -1383,6 +1065,48 @@ def_setting timeformat { ucmdr {} $desc } +proc marktime_desc {mt} { + if {"$mt" == "off"} { + return "I will not send you periodic messages." + } elseif {"$mt" == "once"} { + return "I will send you one informational message when I see you." + } else { + return "I'll send you a message every [showintervalsecs $mt 0]." + } +} + +def_setting marktime { + set mt [nickdb_get $n marktime] + set p $mt + if {[string match {[0-9]*} $mt]} { append p s } + append p ": " + append p [marktime_desc $mt] + return $p +} { + global marktime_min + set mt [string tolower [ta_word]] + ta_nomore + + if {"$mt" == "off" || "$mt" == "once"} { + } elseif {[regexp {^([0-9]+)([a-z]+)$} $mt dummy value unit]} { + switch -exact $unit { + s { set u 1 } + ks { set u 1000 } + m { set u 60 } + h { set u 3600 } + default { error "unknown unit of time $unit" } + } + if {$value > 86400*21/$u} { error "marktime interval too large" } + set mt [expr {$value*$u}] + if {$mt < $marktime_min} { error "marktime interval too small" } + } else { + error "invalid syntax for marktime" + } + nickdb_set $n marktime $mt + lnick_marktime_start [irctolower $n] "So:" 500 + ucmdr {} [marktime_desc $mt] +} + def_setting security { set s [nickdb_get $n username] if {[string length $s]} { @@ -1471,7 +1195,7 @@ def_ucmd summon { set idletime [expr {$now - $idlesince}] set ls $now ucmdr {} {} {} "invites $target ($tty[expr { - $idletime > 10 ? ", idle for [showintervalsecs $idletime]" : "" + $idletime > 10 ? ", idle for [showintervalsecs $idletime 0]" : "" }]) to [expr { [ischan $dest] ? "join us here" : "talk to you" }]." @@ -1490,7 +1214,7 @@ def_ucmd seen { ta_nomore set now [clock seconds] if {"$nlower" == "[irctolower $nick]"} { - error "I am not self-aware." + usererror "I am not self-aware." } elseif {![info exists lastseen($nlower)]} { set rstr "I've never seen $ncase." } else { @@ -1514,6 +1238,91 @@ def_ucmd seen { ucmdr {} $rstr } +proc lnick_marktime_cancel {luser} { + upvar #0 nick_markid($luser) mi + if {![info exists mi]} return + catch { after cancel $mi } + catch { unset mi } +} + +proc lnick_marktime_doafter {luser why ms} { + lnick_marktime_cancel $luser + upvar #0 nick_markid($luser) mi + set mi [after $ms [list lnick_marktime_now $luser $why]] +} + +proc lnick_marktime_reset {luser} { + set mt [nickdb_get $luser marktime] + if {"$mt" == "off" || "$mt" == "once"} return + lnick_marktime_doafter $luser "Time passes." [expr {$mt*1000}] +} + +proc lnick_marktime_start {luser why ms} { + set mt [nickdb_get $luser marktime] + if {"$mt" == "off"} { + lnick_marktime_cancel $luser + } else { + lnick_marktime_doafter $luser $why $ms + } +} + +proc lnick_marktime_now {luser why} { + upvar #0 nick_onchans($luser) oc + global calling_nick + set calling_nick $luser + sendprivmsg $luser [lnick_pingstring $why $oc ""] + lnick_marktime_reset $luser +} + +proc lnick_pingstring {why oc apstring} { + global nick_onchans + catch { exec uptime } uptime + set nnicks [llength [array names nick_onchans]] + if {[regexp \ + {^ *([0-9:apm]+) +up.*, +(\d+) users, +load average: +([0-9., ]+) *$} \ + $uptime dummy time users load]} { + regsub -all , $load {} load + set uptime "$time $nnicks/$users $load" + } else { + append uptime ", $nnicks nicks" + } + if {[llength $oc]} { + set best_la 0 + set activity quiet + foreach ch $oc { + upvar #0 chan_lastactivity($ch) la + if {![info exists la]} continue + if {$la <= $best_la} continue + set since [showintervalsecs [expr {[clock seconds]-$la}] 1] + set activity "$ch $since" + set best_la $la + } + } else { + set activity unseen + } + set str $why + append str " " $uptime " " $activity + if {[string length $apstring]} { append str " " $apstring } + return $str +} + +def_ucmd ping { + if {[ischan $dest]} { + set oc [irctolower $dest] + } else { + global nick_onchans + prefix_nick + set ln [irctolower $n] + if {[info exists nick_onchans($ln)]} { + set oc $nick_onchans($ln) + } else { + set oc {} + } + if {[llength $oc]} { lnick_marktime_reset $ln } + } + ucmdr {} [lnick_pingstring "Pong!" $oc $text] +} + proc ensure_globalsecret {} { global globalsecret @@ -1526,50 +1335,12 @@ proc ensure_globalsecret {} { unset gsfile } -proc ensure_outqueue {} { - out__vars - if {[info exists out_queue]} return - set out_creditms 0 - set out_creditat [clock seconds] - set out_queue {} - set out_lag_reported 0 - set out_lag_reportwhen $out_creditat -} - -proc fail {msg} { - logerror "failing: $msg" - exit 1 -} - -proc ensure_connecting {} { - global sock ownfullname host port nick socketargs - global musthaveping_ms musthaveping_after - - if {[info exists sock]} return - set sock [eval socket $socketargs [list $host $port]] - fconfigure $sock -buffering line - fconfigure $sock -translation crlf - - sendout USER blight 0 * $ownfullname - sendout NICK $nick - fileevent $sock readable onread - - set musthaveping_after [after $musthaveping_ms \ - {fail "no ping within timeout"}] -} - proc connected {} { - global musthaveping_after - - after cancel $musthaveping_after - unset musthaveping_after - foreach chan [chandb_list] { if {[chandb_get $chan autojoin]} { dojoin $chan } } } ensure_globalsecret -ensure_outqueue loadhelp ensure_connecting