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