defset out_lag_lag 5000
defset out_lag_very 25000
+defset marktime_min 300
+defset marktime_join_startdelay 5000
+
proc manyset {list args} {
foreach val $list var $args {
upvar 1 $var my
set out_queue [lrange $out_queue 1 end]
if {[llength $out_queue]} {
append orgwhen "+[expr {$now - $orgwhen}]"
- append orgwhen ([llength $out_queue])"
+ append orgwhen "([llength $out_queue])"
}
puts "$orgwhen -> $msg"
puts $sock $msg
}
if {"$command" == "PRIVMSG" &&
[regexp {^[&#+!]} [lindex $params 0]] &&
- ![regexp {^!} [lindex $params 1]]} {
+ ![regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} {
# on-channel message, ignore
- catch {
- recordlastseen_p $prefix "talking on [lindex $params 0]" 1
- }
+ 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
}
log "[clock seconds] <- $org"
msendprivmsg_delayed 1000 $n $ml
}
}
-
+
+proc note_topic {showoff whoby topic} {
+ set msg "FYI, $whoby has changed the topic on $showoff"
+ if {[string length $topic] < 160} {
+ append msg " to $topic"
+ } else {
+ append msg " but it is too long to reproduce here !"
+ }
+ set showoff [irctolower $showoff]
+ set tell [chandb_get $showoff topictell]
+ if {[lsearch -exact $tell *] >= 0} {
+ set tryspies [chandb_list]
+ } else {
+ set tryspies $tell
+ }
+ foreach spy $tryspies {
+ set see [chandb_get $spy topicsee]
+ if {[lsearch -exact $see $showoff] >= 0 || \
+ ([lsearch -exact $see *] >= 0 && \
+ [lsearch -exact $tell $spy] >= 0)} {
+ sendprivmsg $spy $msg
+ }
+ }
+}
+
proc recordlastseen_p {p how here} {
prefix_nick
recordlastseen_n $n $how $here
}
upvar #0 chan_nicks($lchan) nlist
unset nlist
+ upvar #0 chan_lastactivity($lchan) la
+ catch { unset la }
+}
+
+proc doleave {lchan} {
+ sendout PART $lchan
+ leaving $lchan
}
proc dojoin {lchan} {
global nick
upvar #0 chan_nicks($lchan) nlist
if {[llength $nlist] != 1} return
- if {"[lindex $nlist 0]" != "$nick"} return
+ if {"[lindex $nlist 0]" != "[irctolower $nick]"} return
if {[chandb_exists $lchan]} {
set mode [chandb_get $lchan mode]
if {"$mode" != "*"} {
sendout MODE $lchan $mode
}
+ set topic [chandb_get $lchan topicset]
+ if {[string length $topic]} {
+ sendout TOPIC $lchan $topic
+ }
} else {
- sendout PART $lchan
- leaving $lchan
+ doleave $lchan
}
}
}
}
+proc msg_TOPIC {p c dest topic} {
+ prefix_nick
+ if {![ischan $dest]} return
+ recordlastseen_n $n "changing the topic on $dest" 1
+ note_topic [irctolower $dest] $n $topic
+}
+
proc msg_KICK {p c chans users comment} {
set chans [split $chans ,]
set users [split $users ,]
# nick_username($luser) -> <securely known local username>
# nick_unique($luser) -> <counter>
# nick_case($luser) -> $user (valid even if no longer visible)
+# nick_markid($luser) -> <after id for marktime>
# 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 }
prefix_nick
recordlastseen_n $n "changing nicks to $newnick" 0
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}($n) old
- upvar #0 nick_${ary}($newnick) new
+ upvar #0 nick_${ary}($luser) old
+ upvar #0 nick_${ary}($lusernew) new
if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
if {[info exists old]} { set new $old; unset old }
}
- upvar #0 nick_onchans($new)
- set luser [irctolower $n]
- set lusernew [irctolower $newnick]
+ upvar #0 nick_onchans($lusernew) oc
foreach ch $oc {
upvar #0 chan_nicks($ch) nlist
set nlist [grep tn {"$tn" != "$luser"} $nlist]
lappend nlist $lusernew
}
+ lnick_marktime_start $lusernew "Hi." 500
nick_case $newnick
}
proc msg_JOIN {p c chan} {
prefix_nick
recordlastseen_n $n "joining $chan" 1
- upvar #0 nick_onchans([irctolower $n]) oc
- lappend oc [irctolower $chan]
+ set nl [irctolower $n]
+ 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
}
proc msg_PART {p c chan} {
}
proc loadhelp {} {
- global help_topics
+ global help_topics errorInfo
catch { unset help_topics }
set f [open helpinfos r]
unset topic
unset lines
}
- } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
+ } 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]} {
+ } 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 again later."
+ "is very lagged. Please ask for help$ontopic again later."
ucmdr {} {}
} else {
sendaction_priority 1 $replyto \
- "is lagged. Your help will arrive shortly ..."
+ "is lagged. Your help$ontopic will arrive shortly ..."
}
}
- upvar #0 help_topics([irctolower [string trim $text]]) info
- if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
+ upvar #0 help_topics($topic) info
+ if {![info exists info]} { ucmdr "No help on $topic, sorry." {} }
ucmdr $info {}
}
file delete $idfn
}
-set default_settings_nick {timeformat ks}
-set default_settings_chan {autojoin 1 mode *}
+set default_settings_nick {timeformat ks marktime off}
+set default_settings_chan {
+ autojoin 1
+ mode *
+ userinvite pub
+ topicset {}
+ topicsee {}
+ topictell {}
+}
def_somedb_id set {args} {
upvar #0 default_settings_$nickchan def
" upvar 1 target chan; upvar 1 n n; upvar 1 text text; $body"
}
-def_chancmd manager {
+proc ta_listop {findnow procvalue} {
+ # findnow and procvalue are code fragments which will be executed
+ # in the caller's level. findnow should set ta_listop_ev to
+ # the current list, and procvalue should treat ta_listop_ev as
+ # a proposed value in the list and check and possibly modify
+ # (canonicalise?) it. After ta_listop, ta_listop_ev will
+ # be the new value of the list.
+ upvar 1 ta_listop_ev exchg
+ upvar 1 text text
set opcode [ta_word]
switch -exact _$opcode {
- _= { set ml {} }
+ _= { }
_+ - _- {
- if {[chandb_exists $chan]} {
- set ml [chandb_get $chan managers]
- } else {
- set ml [list [irctolower $n]]
- }
+ uplevel 1 $findnow
+ foreach item $exchg { set array($item) 1 }
}
default {
- error "`channel manager' opcode must be one of + - ="
+ error "list change opcode must be one of + - ="
}
}
- foreach nn [split $text " "] {
- if {![string length $nn]} continue
- check_nick $nn
- set nn [irctolower $nn]
+ foreach exchg [split $text " "] {
+ if {![string length $exchg]} continue
+ uplevel 1 $procvalue
if {"$opcode" != "-"} {
- lappend ml $nn
+ set array($exchg) 1
+ } else {
+ catch { unset array($exchg) }
+ }
+ }
+ set exchg [lsort [array names array]]
+}
+
+def_chancmd manager {
+ ta_listop {
+ if {[chandb_exists $chan]} {
+ set ta_listop_ev [chandb_get $chan managers]
} else {
- set ml [grep nq {"$nq" != "$nn"} $ml]
+ set ta_listop_ev [list [irctolower $n]]
}
+ } {
+ check_nick $ta_listop_ev
+ set ta_listop_ev [irctolower $ta_listop_ev]
}
- if {[llength $ml]} {
- chandb_set $chan managers $ml
- ucmdr "Managers of $chan: $ml" {}
+ if {[llength $ta_listop_ev]} {
+ chandb_set $chan managers $ta_listop_ev
+ ucmdr "Managers of $chan: $ta_listop_ev" {}
} else {
chandb_delete $chan
ucmdr {} {} "forgets about managing $chan." {}
default { error "channel autojoin must be `yes' or `no' }
}
chandb_set $chan autojoin $nv
- ucmdr [expr {$nv ? "I will join #chan when I'm restarted " : \
- "I won't join #chan when I'm restarted "}] {}
+ ucmdr [expr {$nv ? "I will join $chan when I'm restarted " : \
+ "I won't join $chan when I'm restarted "}] {}
+}
+
+def_chancmd userinvite {
+ set nv [string tolower [ta_word]]
+ switch -exact $nv {
+ pub { set txt "!invite will work for $chan, but it won't work by /msg" }
+ here { set txt "!invite and /msg invite will work, but only for users who are already on $chan." }
+ all { set txt "Any user will be able to invite themselves or anyone else to $chan." }
+ none { set txt "I will not invite anyone to $chan." }
+ default {
+ error "channel userinvite must be `pub', `here', `all' or `none'
+ }
+ }
+ chandb_set $chan userinvite $nv
+ ucmdr $txt {}
+}
+
+def_chancmd topic {
+ set what [ta_word]
+ switch -exact $what {
+ leave {
+ ta_nomore
+ chandb_set $chan topicset {}
+ ucmdr "I won't ever change the topic of $chan." {}
+ }
+ set {
+ set t [string trim $text]
+ if {![string length $t]} {
+ error "you must specific the topic to set"
+ }
+ chandb_set $chan topicset $t
+ ucmdr "Whenever I'm alone on $chan, I'll set the topic to $t." {}
+ }
+ see - tell {
+ ta_listop {
+ set ta_listop_ev [chandb_get $chan topic$what]
+ } {
+ if {"$ta_listop_ev" != "*"} {
+ if {![ischan $ta_listop_ev]} {
+ error "bad channel \`$ta_listop_ev' in topic $what"
+ }
+ set ta_listop_ev [irctolower $ta_listop_ev]
+ }
+ }
+ chandb_set $chan topic$what $ta_listop_ev
+ ucmdr "Topic $what list for $chan: $ta_listop_ev" {}
+ }
+ default {
+ error "unknown channel topic subcommand - see help channel"
+ }
+ }
}
def_chancmd mode {
}
chandb_set $chan mode $mode
if {"$mode" == "*"} {
- ucmdr "I won't ever change the mode of #chan." {}
+ ucmdr "I won't ever change the mode of $chan." {}
} else {
- ucmdr "Whenever I'm alone on #chan, I'll set the mode to $mode." {}
+ ucmdr "Whenever I'm alone on $chan, I'll set the mode to $mode." {}
}
}
if {[chandb_exists $chan]} {
set l "Settings for $chan: autojoin "
append l [lindex {no yes} [chandb_get $chan autojoin]]
- append l ", mode " [chandb_get $chan mode] "."
+ append l ", mode " [chandb_get $chan mode]
+ append l ", userinvite " [chandb_get $chan userinvite] "."
append l "\nManagers: "
append l [join [chandb_get $chan managers] " "]
+ foreach {ts sep} {see "\n" tell " "} {
+ set t [chandb_get $chan topic$ts]
+ append l $sep
+ if {[llength $t]} {
+ append l "Topic $ts list: $t."
+ } else {
+ append l "Topic $ts list is empty."
+ }
+ }
+ append l "\n"
+ set t [chandb_get $chan topicset]
+ if {[string length $t]} {
+ append l "Topic to set: $t"
+ } else {
+ append l "I will not change the topic."
+ }
ucmdr {} $l
} else {
ucmdr {} "The channel $chan is not managed."
}
}
-def_ucmd op {
+proc channelmgr_monoop {} {
+ upvar 1 dest dest
+ upvar 1 text text
+ upvar 1 n n
+ upvar 1 p p
+ 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 !... on, the channel" }
+ if {![info exists target]} {
+ error "you must specify, or invoke me on, the relevant channel"
+ }
+ if {![info exists chan_nicks([irctolower $target])]} {
+ error "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
+}
+
+def_ucmd op {
+ channelmgr_monoop
sendout MODE $target +o $n
}
+def_ucmd leave {
+ channelmgr_monoop
+ doleave $target
+}
+
+def_ucmd invite {
+ global chan_nicks
+
+ if {[ischan $dest]} {
+ set target $dest
+ set onchan 1
+ } else {
+ set target [ta_word]
+ 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 {"$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."
+ }
+ }
+ 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."
+ }
+ set invitees {}
+ while {[ta_anymore]} {
+ set invitee [ta_word]
+ check_nick $invitee
+ lappend invitees $invitee
+ }
+ foreach invitee $invitees {
+ sendout INVITE $invitee $ltarget
+ }
+ set who [lindex $invitees 0]
+ switch -exact llength $invitees {
+ 0 { error "zero invitees" }
+ 1 { }
+ 2 { append who " and [lindex $invitees 1]" }
+ * {
+ set who [join [lreplace $invitees end end] ", "]
+ append who " and [lindex $invitees [llength $invitees]]"
+ }
+ }
+ ucmdr {} "invites $who to $target."
+}
+
def_ucmd channel {
if {[ischan $dest]} { set target $dest }
if {![ta_anymore]} {
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]."
+ }
+}
+
+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]} {
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
+ 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 , $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 activity "$ch [showintervalsecs [expr {[clock seconds]-$la}]]"
+ 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
proc ensure_outqueue {} {
out__vars
if {[info exists out_queue]} return
- set out_creditms [expr {$out_maxburst*$out_interval}]
+ set out_creditms 0
set out_creditat [clock seconds]
set out_queue {}
set out_lag_reported 0
}
proc ensure_connecting {} {
- global sock ownfullname host port nick
+ global sock ownfullname host port nick socketargs
global musthaveping_ms musthaveping_after
if {[info exists sock]} return
- set sock [socket $host $port]
+ set sock [eval socket $socketargs [list $host $port]]
fconfigure $sock -buffering line
fconfigure $sock -translation crlf
~mdw / ircbot / blobdiff