9 defset marktime_min 300
10 defset marktime_join_startdelay 5000
12 proc privmsg_unlogged {prefix ischan params} {
14 [regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} {
17 # on-channel message, ignore
18 set chan [lindex $params 0]
19 upvar #0 chan_lastactivity([irctolower $chan]) la
20 set la [clock seconds]
21 catch { recordlastseen_p $prefix "talking on $chan" 1 }
25 proc showintervalsecs {howlong abbrev} {
26 return [showintervalsecs/[opt timeformat] $howlong $abbrev]
29 proc showintervalsecs/ks {howlong abbrev} {
30 if {$howlong < 1000} {
33 if {$howlong < 1000000} {
40 set value [expr "$howlong.0 / $scale"]
41 foreach {min format} {100 %.0f 10 %.1f 1 %.2f} {
42 if {$value < $min} continue
43 return [format "$format${pfx}s" $value]
48 proc format_qty {qty unit abbrev} {
51 append o [string range $unit 0 0]
55 if {$qty != 1} { append o s }
60 proc showintervalsecs/hms {qty abbrev} {
61 set ul {second 60 minute 60 hour 24 day 7 week}
63 while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} {
64 set remainu [lindex $ul 0]
65 set remainv [expr {$qty % $uv}]
66 set qty [expr {($qty-$remainv)/$uv}]
67 set ul [lreplace $ul 0 1]
69 set o [format_qty $qty [lindex $ul 0] $abbrev]
71 if {!$abbrev} { append o " " }
72 append o [format_qty $remainv $remainu $abbrev]
77 proc showinterval {howlong} {
81 return "[showintervalsecs $howlong 0] ago"
85 proc showtime {when} {
86 return [showinterval [expr {[clock seconds] - $when}]]
89 proc parse_interval {specified min} {
90 if {![regexp {^([0-9]+)([a-z]+)$} $specified dummy value unit]} {
91 error "invalid syntax for interval"
98 default { error "unknown unit of time $unit" }
100 if {$value > 86400*21/$u} { error "interval too large" }
101 set result [expr {$value*$u}]
102 if {$result < $min} { error "interval too small (<${min}s)" }
106 proc def_msgproc {name argl body} {
107 proc msg_$name "varbase $argl" "\
108 upvar #0 msg/\$varbase/dest d\n\
109 upvar #0 msg/\$varbase/str s\n\
110 upvar #0 msg/\$varbase/accum a\n\
114 def_msgproc begin {dest str} {
120 def_msgproc append {str} {
122 if {[string length $s] && [string length $ns] > 65} {
123 msg__sendout $varbase
124 set s " [string trimleft $str]"
130 def_msgproc finish {} {
131 msg__sendout $varbase
137 def_msgproc _sendout {} {
138 lappend a [string trimright $s]
142 proc looking_whenwhere {when where} {
143 set str [showtime [expr {$when-1}]]
144 if {[string length $where]} { append str " on $where" }
148 proc recordlastseen_n {n how here} {
149 global lastseen lookedfor
150 set lastseen([irctolower $n]) [list $n [clock seconds] $how]
152 upvar #0 lookedfor([irctolower $n]) lf
153 if {[info exists lf]} {
154 switch -exact [llength $lf] {
159 manyset [lindex $lf 0] when who where
161 "FYI, $who was looking for you [looking_whenwhere $when $where]."]
164 msg_begin tosend $n "FYI, people have been looking for you:"
170 msg_append tosend " "
171 } elseif {$i == [llength $lf]} {
172 msg_append tosend " and "
175 msg_append tosend ", "
177 manyset $e when who where
179 "$who ([looking_whenwhere $when $where])$fin"
181 set ml [msg_finish tosend]
185 msendprivmsg_delayed 1000 $n $ml
189 proc note_topic {showoff whoby topic} {
190 set msg "FYI, $whoby has changed the topic on $showoff"
191 if {[string length $topic] < 160} {
192 append msg " to $topic"
194 append msg " but it is too long to reproduce here !"
196 set showoff [irctolower $showoff]
197 set tell [chandb_get $showoff topictell]
198 if {[lsearch -exact $tell *] >= 0} {
199 set tryspies [chandb_list]
203 foreach spy $tryspies {
204 set see [chandb_get $spy topicsee]
205 if {[lsearch -exact $see $showoff] >= 0 || \
206 ([lsearch -exact $see *] >= 0 && \
207 [lsearch -exact $tell $spy] >= 0)} {
208 sendprivmsg $spy $msg
213 proc recordlastseen_p {p how here} {
215 recordlastseen_n $n $how $here
218 proc chanmode_arg {} {
220 set rv [lindex $cm_args 0]
221 set cm_args [lreplace cm_args 0 0]
225 proc chanmode_o1 {m g p chan} {
226 global nick chan_initialop
228 set who [chanmode_arg]
229 recordlastseen_n $n "being nice to $who" 1
230 if {"[irctolower $who]" == "[irctolower $nick]"} {
231 set nlower [irctolower $n]
232 upvar #0 nick_unique($nlower) u
233 if {[chandb_exists $chan]} {
234 sendprivmsg $n Thanks.
235 } elseif {![info exists u]} {
236 sendprivmsg $n {Op me while not on the channel, why don't you ?}
238 set chan_initialop([irctolower $chan]) $u
240 "Thanks. You can use `channel manager ...' to register this channel."
241 if {![nickdb_exists $n] || ![string length [nickdb_get $n username]]} {
243 "(But to do that you must register your nick securely first.)"
249 proc chanmode_o0 {m g p chan} {
252 set who [chanmode_arg]
253 recordlastseen_p $p "being mean to $who" 1
254 if {"[irctolower $who]" == "[irctolower $nick]"} {
255 set chandeop($chan) [list [clock seconds] $p]
259 proc msg_MODE {p c dest modelist args} {
260 if {![ischan $dest]} return
261 if {[regexp {^\-(.+)$} $modelist dummy modelist]} {
263 } elseif {[regexp {^\+(.+)$} $modelist dummy modelist]} {
266 error "invalid modelist"
268 foreach m [split $modelist] {
269 set procname chanmode_$m$give
270 if {[catch { info body $procname }]} {
271 recordlastseen_p $p "fiddling with $dest" 1
273 $procname $m $give $p $dest
278 proc leaving {lchan} {
279 foreach luser [array names nick_onchans] {
280 upvar #0 nick_onchans($luser) oc
281 set oc [grep tc {"$tc" != "$lchan"} $oc]
283 upvar #0 chan_nicks($lchan) nlist
285 upvar #0 chan_lastactivity($lchan) la
289 proc doleave {lchan} {
294 proc dojoin {lchan} {
297 set chan_nicks($lchan) {}
300 proc check_justme {lchan} {
302 upvar #0 chan_nicks($lchan) nlist
303 if {[llength $nlist] != 1} return
304 if {"[lindex $nlist 0]" != "[irctolower $nick]"} return
305 if {[chandb_exists $lchan]} {
306 set mode [chandb_get $lchan mode]
307 if {"$mode" != "*"} {
308 sendout MODE $lchan $mode
310 set topic [chandb_get $lchan topicset]
311 if {[string length $topic]} {
312 sendout TOPIC $lchan $topic
319 proc process_kickpart {chan user} {
322 set luser [irctolower $user]
323 set lchan [irctolower $chan]
324 if {![ischan $chan]} { error "not a channel" }
325 if {"$luser" == "[irctolower $nick]"} {
328 upvar #0 nick_onchans($luser) oc
329 upvar #0 chan_nicks($lchan) nlist
330 set oc [grep tc {"$tc" != "$lchan"} $oc]
331 set nlist [grep tn {"$tn" != "$luser"} $nlist]
333 if {![llength $oc]} {
341 proc msg_TOPIC {p c dest topic} {
343 if {![ischan $dest]} return
344 recordlastseen_n $n "changing the topic on $dest" 1
345 note_topic [irctolower $dest] $n $topic
348 proc msg_KICK {p c chans users comment} {
349 set chans [split $chans ,]
350 set users [split $users ,]
351 if {[llength $chans] > 1} {
352 foreach chan $chans user $users { process_kickpart $chan $user }
354 foreach user $users { process_kickpart [lindex $chans 0] $user }
358 proc msg_KILL {p c user why} {
363 set nick_arys {onchans username unique}
364 # nick_onchans($luser) -> [list ... $lchan ...]
365 # nick_username($luser) -> <securely known local username>
366 # nick_unique($luser) -> <counter>
367 # nick_case($luser) -> $user (valid even if no longer visible)
368 # nick_markid($luser) -> <after id for marktime>
370 # chan_nicks($lchan) -> [list ... $luser ...]
371 # chan_lastactivity($lchan) -> [clock seconds]
373 proc lnick_forget {luser} {
374 global nick_arys chan_nicks
375 lnick_marktime_cancel $luser
376 foreach ary $nick_arys {
377 upvar #0 nick_${ary}($luser) av
380 foreach lch [array names chan_nicks] {
381 upvar #0 chan_nicks($lch) nlist
382 set nlist [grep tn {"$tn" != "$luser"} $nlist]
387 proc nick_forget {user} {
388 global nick_arys chan_nicks
389 lnick_forget [irctolower $user]
393 proc nick_case {user} {
395 set nick_case([irctolower $user]) $user
398 proc msg_NICK {p c newnick} {
399 global nick_arys nick_case calling_nick
401 recordlastseen_n $n "changing nicks to $newnick" 0
402 set calling_nick $newnick
403 recordlastseen_n $newnick "changing nicks from $n" 1
404 set luser [irctolower $n]
405 lnick_marktime_cancel $luser
406 set lusernew [irctolower $newnick]
407 foreach ary $nick_arys {
408 upvar #0 nick_${ary}($luser) old
409 upvar #0 nick_${ary}($lusernew) new
410 if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
411 if {[info exists old]} { set new $old; unset old }
413 upvar #0 nick_onchans($lusernew) oc
415 upvar #0 chan_nicks($ch) nlist
416 set nlist [grep tn {"$tn" != "$luser"} $nlist]
417 lappend nlist $lusernew
419 lnick_marktime_start $lusernew "Hi." 500 1
423 proc nick_ishere {n} {
425 upvar #0 nick_unique([irctolower $n]) u
426 if {![info exists u]} { set u [incr nick_counter].$n.[clock seconds] }
430 proc msg_JOIN {p c chan} {
432 recordlastseen_n $n "joining $chan" 1
433 set nl [irctolower $n]
434 set lchan [irctolower $chan]
435 upvar #0 nick_onchans($nl) oc
436 upvar #0 chan_nicks($lchan) nlist
437 if {![info exists oc]} {
438 global marktime_join_startdelay
439 lnick_marktime_start $nl "Welcome." $marktime_join_startdelay 1
445 proc msg_PART {p c chan args} {
447 set msg "leaving $chan"
448 if {[llength $args]} {
449 set why [lindex $args 0]
450 if {"[irctolower $why]" != "[irctolower $n]"} { append msg " ($why)" }
452 recordlastseen_n $n $msg 1
453 process_kickpart $chan $n
455 proc msg_QUIT {p c why} {
457 recordlastseen_n $n "leaving ($why)" 0
461 proc msg_PRIVMSG {p c dest text} {
465 if {[ischan $dest]} {
466 recordlastseen_n $n "invoking me in $dest" 1
469 recordlastseen_n $n "talking to me" 1
474 execute_usercommand $p $c $n $output $dest $text
477 proc msg_INVITE {p c n chan} {
478 after 1000 [list dojoin [irctolower $chan]]
481 proc grep {var predicate list} {
485 if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
490 proc msg_353 {p c dest type chan nicklist} {
491 global names_chans nick_onchans
492 set lchan [irctolower $chan]
493 upvar #0 chan_nicks($lchan) nlist
494 lappend names_chans $lchan
495 if {![info exists nlist]} {
496 # We don't think we're on this channel, so ignore it !
497 # Unfortunately, because we don't get a reply to PART,
498 # we have to remember ourselves whether we're on a channel,
499 # and ignore stuff if we're not, to avoid races. Feh.
503 foreach user [split $nicklist { }] {
504 regsub {^[@+]} $user {} user
505 if {![string length $user]} continue
507 set luser [irctolower $user]
508 upvar #0 nick_onchans($luser) oc
510 lappend nlist_new $luser
516 proc msg_366 {p c args} {
517 global names_chans nick_onchans
518 set lchan [irctolower $c]
519 foreach luser [array names nick_onchans] {
520 upvar #0 nick_onchans($luser) oc
521 if {[llength names_chans] > 1} {
522 set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
524 if {![llength $oc]} { lnick_forget $n }
529 proc check_username {target} {
531 [string length $target] > 8 ||
532 [regexp {[^-0-9a-z]} $target] ||
533 ![regexp {^[a-z]} $target]
534 } { error "invalid username" }
537 proc somedb__head {} {
539 set idl [irctolower $id]
540 upvar #0 ${nickchan}db($idl) ndbe
541 binary scan $idl H* idh
542 set idfn $fprefix$idh
543 if {![info exists iddbe] && [file exists $idfn]} {
545 try_except_finally { set newval [read $f] } {} { close $f }
546 if {[llength $newval] % 2} { error "invalid length" }
552 proc def_somedb {name arglist body} {
553 foreach {nickchan fprefix} {
558 proc ${nickchan}db_$name $arglist \
559 "set nickchan $nickchan; set fprefix $fprefix; $body"
565 foreach path [glob -nocomplain -path $fprefix *] {
566 binary scan $path "A[string length $fprefix]A*" afprefix thinghex
567 if {"$afprefix" != "$fprefix"} { error "wrong prefix $path $afprefix" }
568 lappend list [binary format H* $thinghex]
573 proc def_somedb_id {name arglist body} {
574 def_somedb $name [concat id $arglist] "somedb__head; $body"
577 def_somedb_id exists {} {
578 return [info exists iddbe]
581 def_somedb_id delete {} {
582 catch { unset iddbe }
586 set default_settings_nick {
590 tellrel {remind 3600 30}
593 set default_settings_chan {
602 set default_settings_msgs {
606 # inbound -> [<nick> <time_t> <message>] ...
607 # outbound -> [<nick> <time_t(earliest)> <count>] ...
609 def_somedb_id set {args} {
610 upvar #0 default_settings_$nickchan def
611 if {![info exists iddbe]} { set iddbe $def }
612 foreach {key value} [concat $iddbe $args] { set a($key) $value }
614 foreach {key value} [array get a] { lappend newval $key $value }
615 set f [open $idfn.new w]
619 file rename -force $idfn.new $idfn
627 def_somedb_id get {key} {
628 upvar #0 default_settings_$nickchan def
629 if {[info exists iddbe]} {
630 set l [concat $iddbe $def]
634 foreach {tkey value} $l {
635 if {"$tkey" == "$key"} { return $value }
637 error "unset setting $key"
642 if {[info exists calling_nick]} { set n $calling_nick } { set n {} }
643 return [nickdb_get $n $key]
646 proc check_notonchan {} {
648 if {[ischan $dest]} { usererror "That command must be sent privately." }
651 proc nick_securitycheck {strict} {
653 if {![nickdb_exists $n]} {
654 usererror "You are unknown to me, use `register'."
656 set wantu [nickdb_get $n username]
657 if {![string length $wantu]} {
659 usererror "That feature is only available to secure users, sorry."
664 set luser [irctolower $n]
665 upvar #0 nick_username($luser) nu
666 if {![info exists nu]} {
667 usererror "Nick $n is secure, you must identify yourself first."
669 if {"$wantu" != "$nu"} {
670 usererror "You are the wrong user -\
671 the nick $n belongs to $wantu, not $nu."
675 proc channel_ismanager {channel n} {
676 set mgrs [chandb_get $channel managers]
677 return [expr {[lsearch -exact [irctolower $mgrs] [irctolower $n]] >= 0}]
680 proc channel_securitycheck {channel} {
682 if {![channel_ismanager $channel $n]} {
683 usererror "You are not a manager of $channel."
688 proc def_chancmd {name body} {
689 proc channel/$name {} \
690 " upvar 1 target chan; upvar 1 n n; upvar 1 text text; $body"
693 proc ta_listop {findnow procvalue} {
694 # findnow and procvalue are code fragments which will be executed
695 # in the caller's level. findnow should set ta_listop_ev to
696 # the current list, and procvalue should treat ta_listop_ev as
697 # a proposed value in the list and check and possibly modify
698 # (canonicalise?) it. After ta_listop, ta_listop_ev will
699 # be the new value of the list.
700 upvar 1 ta_listop_ev exchg
703 switch -exact _$opcode {
707 foreach item $exchg { set array($item) 1 }
710 error "list change opcode must be one of + - ="
713 foreach exchg [split $text " "] {
714 if {![string length $exchg]} continue
716 if {"$opcode" != "-"} {
719 catch { unset array($exchg) }
722 set exchg [lsort [array names array]]
725 def_chancmd manager {
727 if {[chandb_exists $chan]} {
728 set ta_listop_ev [chandb_get $chan managers]
730 set ta_listop_ev [list [irctolower $n]]
733 check_nick $ta_listop_ev
734 set ta_listop_ev [irctolower $ta_listop_ev]
736 if {[llength $ta_listop_ev]} {
737 chandb_set $chan managers $ta_listop_ev
738 ucmdr "Managers of $chan: $ta_listop_ev" {}
741 ucmdr {} {} "forgets about managing $chan." {}
745 def_chancmd autojoin {
747 switch -exact [string tolower $yesno] {
750 default { error "channel autojoin must be `yes' or `no' }
752 chandb_set $chan autojoin $nv
753 ucmdr [expr {$nv ? "I will join $chan when I'm restarted " : \
754 "I won't join $chan when I'm restarted "}] {}
757 def_chancmd userinvite {
758 set nv [string tolower [ta_word]]
760 pub { set txt "!invite will work for $chan, but it won't work by /msg" }
761 here { set txt "!invite and /msg invite will work, but only for users who are already on $chan." }
762 all { set txt "Any user will be able to invite themselves or anyone else to $chan." }
763 none { set txt "I will not invite anyone to $chan." }
765 error "channel userinvite must be `pub', `here', `all' or `none'
768 chandb_set $chan userinvite $nv
774 switch -exact $what {
777 chandb_set $chan topicset {}
778 ucmdr "I won't ever change the topic of $chan." {}
781 set t [string trim $text]
782 if {![string length $t]} {
783 error "you must specific the topic to set"
785 chandb_set $chan topicset $t
786 ucmdr "Whenever I'm alone on $chan, I'll set the topic to $t." {}
790 set ta_listop_ev [chandb_get $chan topic$what]
792 if {"$ta_listop_ev" != "*"} {
793 if {![ischan $ta_listop_ev]} {
794 error "bad channel \`$ta_listop_ev' in topic $what"
796 set ta_listop_ev [irctolower $ta_listop_ev]
799 chandb_set $chan topic$what $ta_listop_ev
800 ucmdr "Topic $what list for $chan: $ta_listop_ev" {}
803 usererror "Unknown channel topic subcommand - see help channel."
810 if {"$mode" != "*" && ![regexp {^(([-+][imnpst]+)+)$} $mode mode]} {
811 error {channel mode must be * or match ([-+][imnpst]+)+}
813 chandb_set $chan mode $mode
814 if {"$mode" == "*"} {
815 ucmdr "I won't ever change the mode of $chan." {}
817 ucmdr "Whenever I'm alone on $chan, I'll set the mode to $mode." {}
822 if {[chandb_exists $chan]} {
823 set l "Settings for $chan: autojoin "
824 append l [lindex {no yes} [chandb_get $chan autojoin]]
825 append l ", mode " [chandb_get $chan mode]
826 append l ", userinvite " [chandb_get $chan userinvite] "."
827 append l "\nManagers: "
828 append l [join [chandb_get $chan managers] " "]
829 foreach {ts sep} {see "\n" tell " "} {
830 set t [chandb_get $chan topic$ts]
833 append l "Topic $ts list: $t."
835 append l "Topic $ts list is empty."
839 set t [chandb_get $chan topicset]
840 if {[string length $t]} {
841 append l "Topic to set: $t"
843 append l "I will not change the topic."
847 ucmdr {} "The channel $chan is not managed."
851 proc channelmgr_monoop {} {
856 upvar 1 target target
861 if {[ischan $dest]} { set target $dest }
862 if {[ta_anymore]} { set target [ta_word] }
864 if {![info exists target]} {
865 usererror "You must specify, or invoke me on, the relevant channel."
867 if {![info exists chan_nicks([irctolower $target])]} {
868 usererror "I am not on $target."
870 if {![ischan $target]} { error "not a valid channel" }
872 if {![chandb_exists $target]} {
873 usererror "$target is not a managed channel."
875 channel_securitycheck $target
880 sendout MODE $target +o $n
889 global chan_nicks errorCode errorInfo
892 if {[ischan $dest]} {
899 set ltarget [irctolower $target]
900 if {![ischan $target]} { error "$target is not a channel" }
901 if {![info exists chan_nicks($ltarget)]} {
902 usererror "I am not on $target."
904 set ui [chandb_get $ltarget userinvite]
906 if {"$ui" == "pub" && !$onchan} {
907 usererror "Invitations to $target must be made there with !invite."
909 if {"$ui" != "all"} {
910 if {[lsearch -exact $chan_nicks($ltarget) [irctolower $n]] < 0} {
911 usererror "Invitations to $target may only be made\
912 by a user on the channel."
915 if {"$ui" == "none"} {
916 usererror "Sorry, I've not been authorised\
917 to invite people to $target."
920 if {"$errorCode" == "BLIGHT USER" && [channel_ismanager $target $n]} {
924 if {"$errorCode" == "BLIGHT USER"} {
925 usererror "$emsg2 Therefore you can't use your\
926 channel manager privilege. $emsg"
928 error $error $errorInfo $errorCode
932 error $emsg $errorInfo $errorCode
936 usererror "You have to say who to invite."
939 while {[ta_anymore]} {
940 set invitee [ta_word]
942 lappend invitees $invitee
944 foreach invitee $invitees {
945 sendout INVITE $invitee $ltarget
947 set who [lindex $invitees 0]
948 switch -exact llength $invitees {
949 0 { error "zero invitees" }
951 2 { append who " and [lindex $invitees 1]" }
953 set who [join [lreplace $invitees end end] ", "]
954 append who " and [lindex $invitees [llength $invitees]]"
957 ucmdr {} {} {} "invites $who to $target."
961 if {[ischan $dest]} { set target $dest }
967 if {[ischan $subcmd]} {
975 if {![info exists target]} { error "privately, you must specify a channel" }
976 set procname channel/$subcmd
977 if {"$subcmd" != "show"} {
978 if {[catch { info body $procname }]} {
979 usererror "unknown channel setting $subcmd."
982 if {[chandb_exists $target]} {
983 channel_securitycheck $target
986 upvar #0 chan_initialop([irctolower $target]) io
987 upvar #0 nick_unique([irctolower $n]) u
988 if {![info exists io]} {
989 usererror "$target is not a managed channel."
992 usererror "You are not the interim manager of $target."
994 if {"$subcmd" != "manager"} {
995 usererror "Please use `channel manager' first."
1003 global nick_case ownmailaddr ownfullname
1006 set target [ta_word]
1007 if {![string length $text]} { error "tell them what?" }
1009 set ltarget [irctolower $target]
1011 if {[info exists nick_case($ltarget)]} { set ctarget $nick_case($ltarget) }
1013 manyset [nickdb_get $target tellsec] sec mailto mailwhy
1014 manyset [nickdb_get $target tellrel] rel relint relwithin
1015 switch -exact $sec {
1017 set now [clock seconds]
1018 set inbound [msgsdb_get $ltarget inbound]
1019 lappend inbound $n $now $text
1020 msgsdb_set $ltarget inbound $inbound
1022 set outbound [msgsdb_get $n outbound]
1025 foreach {recip time count} $outbound {
1026 if {"[irctolower $recip]" == "$ltarget"} {
1031 lappend noutbound $recip $time $count
1034 lappend noutbound $ctarget $now 1
1036 msgsdb_set $n outbound $noutbound
1037 set msg "OK, I'll tell $ctarget"
1038 if {$found} { append msg " that too" }
1040 if {"$sec" != "secure"} {
1041 switch -exact $rel {
1042 unreliable { append msg "neither reliably nor securely" }
1043 remind { append msg "pretty reliably, but not securely" }
1044 pester { append msg "reliably but not securely" }
1047 switch -exact $rel {
1048 unreliable { append msg "securely but not reliably" }
1049 remind { append msg "securely and pretty reliably" }
1050 pester { append msg "reliably and securely" }
1057 set fmtmsg [exec fmt << " $text"]
1058 exec /usr/sbin/sendmail -odb -oi -t -oee -f $mailwhy \
1060 "From: $ownmailaddr ($ownfullname)
1062 Subject: IRC tell from $n
1064 $n asked me[expr {[ischan $dest] ? " on $dest" : ""}] to tell you:
1065 [exec fmt << " $text"]
1067 (This message was for your nick $ctarget; your account $mailwhy
1068 arranged for it to be forwarded to $mailto.)
1071 "I've mailed $ctarget at $mailto, which is what they prefer." \
1075 usererror "Sorry, $ctarget does not want me to take messages."
1078 error "bad tellsec $sec"
1085 set target [ta_word]; ta_nomore
1090 set myself [expr {"$target" != "$n"}]
1092 set ltarget [irctolower $target]
1093 upvar #0 nick_case($ltarget) ctarget
1095 if {[info exists ctarget]} {
1096 upvar #0 nick_onchans($ltarget) oc
1097 upvar #0 nick_username($ltarget) nu
1098 if {[info exists oc]} { set nshow $ctarget }
1100 if {![nickdb_exists $ltarget]} {
1101 set ol "$nshow is not a registered nick."
1102 } elseif {[string length [set username [nickdb_get $target username]]]} {
1103 set ol "The nick $nshow belongs to the user $username."
1105 set ol "The nick $nshow is registered (but not to a username)."
1107 if {![info exists ctarget] || ![info exists oc]} {
1109 append ol "\nI can't see $nshow on anywhere."
1111 append ol "\nYou aren't on any channels with me."
1113 } elseif {![info exists nu]} {
1114 append ol "\n$nshow has not identified themselves."
1115 } elseif {![info exists username]} {
1116 append ol "\n$nshow has identified themselves as the user $nu."
1117 } elseif {"$nu" != "$username"} {
1118 append ol "\nHowever, $nshow is being used by the user $nu."
1120 append ol "\n$nshow has identified themselves to me."
1128 set old [nickdb_exists $n]
1129 if {$old} { nick_securitycheck 0 }
1130 set luser [irctolower $n]
1131 switch -exact [string tolower [string trim $text]] {
1133 upvar #0 nick_username($luser) nu
1134 if {![info exists nu]} {
1136 "You must identify yourself before using `register'. See `help identify', or use `register insecure'."
1138 nickdb_set $n username $nu
1139 ucmdr {} {} "makes a note of your username." {}
1143 ucmdr {} {} "forgets your nickname." {}
1146 nickdb_set $n username {}
1148 ucmdr {} "Security is now disabled for your nickname !"
1150 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."
1154 error "you mean register / register delete / register insecure"
1159 proc timeformat_desc {tf} {
1161 ks { return "Times will be displayed in seconds or kiloseconds." }
1162 hms { return "Times will be displayed in hours, minutes, etc." }
1163 default { error "invalid timeformat: $v" }
1168 proc def_setting {opt show_body set_body} {
1170 lappend settings $opt
1171 proc set_show/$opt {} "
1175 if {![string length $set_body]} return
1176 proc set_set/$opt {} "
1183 proc tellme_sec_desc {v} {
1184 manyset $v sec mailto
1185 switch -exact $sec {
1187 return "I'll tell you your messages whenever I see you."
1191 "I'll keep the bodies of your messages private until you identify yourself."
1194 return "I shan't accept messages for you."
1197 return "I'll forward your messages by email to $mailto."
1200 error "bad tellsec $sec"
1205 proc tellme_rel_desc {v} {
1206 manyset $v rel every within
1207 switch -exact $rel {
1209 return "As soon as I've told you, I'll forget the message - note that this means messages can get lost !"
1215 set u ", or talk on channel within [showintervalsecs $within 1] of me having told you"
1218 error "bad tellrel $rel"
1221 return "I'll remind you every [showintervalsecs $every 1] until you say delmsg$u."
1224 def_setting timeformat {
1225 set tf [nickdb_get $n timeformat]
1226 return "$tf: [timeformat_desc $tf]"
1228 set tf [string tolower [ta_word]]
1230 set desc [timeformat_desc $tf]
1231 nickdb_set $n timeformat $tf
1235 proc marktime_desc {mt} {
1236 if {"$mt" == "off"} {
1237 return "I will not send you periodic messages."
1238 } elseif {"$mt" == "once"} {
1239 return "I will send you one informational message when I see you."
1241 return "I'll send you a message every [showintervalsecs $mt 0]."
1245 def_setting marktime {
1246 set mt [nickdb_get $n marktime]
1248 if {[string match {[0-9]*} $mt]} { append p s }
1250 append p [marktime_desc $mt]
1254 set mt [string tolower [ta_word]]
1257 if {"$mt" == "off" || "$mt" == "once"} {
1259 set mt [parse_interval $mt $marktime_min]
1261 nickdb_set $n marktime $mt
1262 lnick_marktime_start [irctolower $n] "So:" 500 0
1263 ucmdr {} [marktime_desc $mt]
1266 def_setting security {
1267 set s [nickdb_get $n username]
1268 if {[string length $s]} {
1269 return "Your nick, $n, is controlled by the user $s."
1271 return "Your nick, $n, is not secure."
1275 def_setting tellme {
1276 set secv [nickdb_get $n tellsec]
1277 set ms [tellme_sec_desc $secv]
1279 switch -exact $sec {
1281 set mr [tellme_rel_desc [nickdb_get $n tellrel]]
1289 set setting [string tolower [ta_word]]
1290 switch -exact $setting {
1291 insecure - secure - refuse {
1293 if {"$setting" == "refuse" && [llength [msgsdb_get $n inbound]]} {
1294 usererror "You must delete the messages you have, first."
1300 set u [nickdb_get $n username]
1301 if {![string length $u]} {
1302 usererror "Sorry, you must register secure to have your messages mailed (to prevent the use of this feature for spamming)."
1305 set v [list mailto [ta_word] $u]
1307 unreliable - pester - remind {
1308 manyset [nickdb_get $n tellsec] sec
1309 switch -exact $sec {
1311 error "can't change message delivery conditions when message disposition prevents messages from being left"
1316 if {"$setting" != "unreliable"} {
1317 set every [parse_interval [ta_word] 300]
1320 if {"$setting" == "remind"} {
1322 set within [parse_interval [ta_word] 5]
1326 if {$within > $every} {
1327 error "remind interval must be at least time to respond"
1334 error "invalid tellme setting $setting"
1337 nickdb_set $n tell$sr $v
1338 ucmdr [tellme_${sr}_desc $v] {}
1341 proc lnick_checktold {luser} {
1342 set ml [msgsdb_get $luser outbound]
1343 if {![llength $ml]} return
1344 set is1 [expr {[llength $ml]==3}]
1345 set m1 "FYI, I haven't yet passed on your"
1347 set now [clock seconds]
1348 while {[llength $ml]} {
1350 set ml [lreplace $ml 0 2]
1351 set td [expr {$now-$t}]
1353 set iv [showinterval $td]
1355 set if1 "message to $r, $iv."
1357 set iv [showintervalsecs $td 0]
1358 set ifo "$r, $n messages, oldest $iv"
1359 set if1 "$n messages to $r, oldest $iv."
1362 sendprivmsg $luser "$m1 $if1"
1365 lappend ol " to $ifo[expr {[llength $ml] ? ";" : "."}]"
1368 sendprivmsg $luser "$m1 messages:"
1369 msendprivmsg $luser $ol
1376 if {![nickdb_exists $n]} {
1377 ucmdr {} "You are unknown to me and so have no settings. (Use `register'.)"
1379 if {![ta_anymore]} {
1381 foreach opt $settings {
1382 lappend ol [format "%-10s %s" $opt [set_show/$opt]]
1384 ucmdr {} [join $ol "\n"]
1387 if {[catch { info body set_show/$opt }]} {
1388 error "no setting $opt"
1390 if {![ta_anymore]} {
1391 ucmdr {} "$opt: [set_show/$opt]"
1393 nick_securitycheck 0
1394 if {[catch { info body set_set/$opt }]} {
1395 error "setting $opt cannot be set with `set'"
1402 def_ucmd identpass {
1403 set username [ta_word]
1404 set passmd5 [md5sum "[ta_word]\n"]
1408 set luser [irctolower $n]
1409 upvar #0 nick_onchans($luser) onchans
1410 if {![info exists onchans] || ![llength $onchans]} {
1411 ucmdr "You must be on a channel with me to identify yourself." {}
1413 check_username $username
1414 exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
1416 upvar #0 nick_username($luser) rec_username
1417 set rec_username $username
1418 ucmdr "Pleased to see you, $username." {}
1422 set target [ta_word]
1424 check_username $target
1427 upvar #0 lastsummon($target) ls
1428 set now [clock seconds]
1429 if {[info exists ls]} {
1430 set interval [expr {$now - $ls}]
1431 if {$interval < 30} {
1433 "Please be patient; $target was summoned only [showinterval $interval]."
1436 regsub {^[^!]*!} $p {} path
1438 exec userv --timeout 3 $target irc-summon $n $path \
1439 [expr {[ischan $dest] ? "$dest" : ""}] \
1442 regsub -all "\n" $rv { / } rv
1445 if {[regexp {^problem (.*)} $rv dummy problem]} {
1446 ucmdr {} "The user `$target' $problem."
1447 } elseif {[regexp {^ok ([^ ]+) ([0-9]+)$} $rv dummy tty idlesince]} {
1448 set idletime [expr {$now - $idlesince}]
1450 ucmdr {} {} {} "invites $target ($tty[expr {
1451 $idletime > 10 ? ", idle for [showintervalsecs $idletime 0]" : ""
1453 [ischan $dest] ? "join us here" : "talk to you"
1456 error "unexpected response from userv service: $rv"
1460 proc md5sum {value} { exec md5sum << $value }
1463 global lastseen nick
1466 set nlower [irctolower $ncase]
1468 set now [clock seconds]
1469 if {"$nlower" == "[irctolower $nick]"} {
1470 usererror "I am not self-aware."
1471 } elseif {![info exists lastseen($nlower)]} {
1472 set rstr "I've never seen $ncase."
1474 manyset $lastseen($nlower) realnick time what
1475 set howlong [expr {$now - $time}]
1476 set string [showinterval $howlong]
1477 set rstr "I last saw $realnick $string, $what."
1479 if {[ischan $dest]} {
1484 upvar #0 lookedfor($nlower) lf
1485 if {[info exists lf]} { set oldvalue $lf } else { set oldvalue {} }
1486 set lf [list [list $now $n $where]]
1487 foreach v $oldvalue {
1488 if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
1494 proc lnick_marktime_cancel {luser} {
1495 upvar #0 nick_markid($luser) mi
1496 if {![info exists mi]} return
1497 catch { after cancel $mi }
1501 proc lnick_marktime_doafter {luser why ms mentiontold} {
1502 lnick_marktime_cancel $luser
1503 upvar #0 nick_markid($luser) mi
1504 set mi [after $ms [list lnick_marktime_now $luser $why 0]]
1507 proc lnick_marktime_reset {luser} {
1508 set mt [nickdb_get $luser marktime]
1509 if {"$mt" == "off" || "$mt" == "once"} return
1510 lnick_marktime_doafter $luser "Time passes." [expr {$mt*1000}] 0
1513 proc lnick_marktime_start {luser why ms mentiontold} {
1514 set mt [nickdb_get $luser marktime]
1515 if {"$mt" == "off"} {
1516 lnick_marktime_cancel $luser
1517 after $ms [list lnick_checktold $luser]
1519 lnick_marktime_doafter $luser $why $ms $mentiontold
1523 proc lnick_marktime_now {luser why mentiontold} {
1524 upvar #0 nick_onchans($luser) oc
1526 set calling_nick $luser
1527 sendprivmsg $luser [lnick_pingstring $why $oc ""]
1528 if {$mentiontold} { lnick_checktold $luser }
1529 lnick_marktime_reset $luser
1532 proc lnick_pingstring {why oc apstring} {
1534 catch { exec uptime } uptime
1535 set nnicks [llength [array names nick_onchans]]
1537 {^ *([0-9:apm]+) +up.*, +(\d+) users?, +load average: +([0-9., ]+) *$} \
1538 $uptime dummy time users load]} {
1539 regsub -all , $load {} load
1540 set uptime "$time $nnicks/$users $load"
1542 append uptime ", $nnicks nicks"
1544 if {[llength $oc]} {
1548 upvar #0 chan_lastactivity($ch) la
1549 if {![info exists la]} continue
1550 if {$la <= $best_la} continue
1551 set since [showintervalsecs [expr {[clock seconds]-$la}] 1]
1552 set activity "$ch $since"
1559 append str " " $uptime " " $activity
1560 if {[string length $apstring]} { append str " " $apstring }
1566 set ln [irctolower $n]
1567 if {[ischan $dest]} {
1568 set oc [irctolower $dest]
1571 if {[info exists nick_onchans($ln)]} {
1572 set oc $nick_onchans($ln)
1576 if {[llength $oc]} { lnick_marktime_reset $ln }
1579 ucmdr {} [lnick_pingstring "Pong!" $oc $text]
1582 proc ensure_globalsecret {} {
1585 if {[info exists globalsecret]} return
1586 set gsfile [open /dev/urandom r]
1587 fconfigure $gsfile -translation binary
1588 set globalsecret [read $gsfile 32]
1589 binary scan $globalsecret H* globalsecret
1595 foreach chan [chandb_list] {
1596 if {[chandb_get $chan autojoin]} { dojoin $chan }