chiark / gitweb /
Nick registration, preferences, etc.
[ircbot] / bot.tcl
CommitLineData
9bc33297
IJ
1#!/usr/bin/tclsh8.2
2
3set host chiark
4set port 6667
7ce72032 5if {![info exists nick]} { set nick Blight }
a69f7d2c 6if {![info exists ownfullname]} { set ownfullname "here to Help" }
e1ba63be 7set ownmailaddr blight@chiark.greenend.org.uk
e1ba63be
IJ
8
9if {![info exists globalsecret]} {
10 set gsfile [open /dev/urandom r]
11 fconfigure $gsfile -translation binary
12 set globalsecret [read $gsfile 32]
13 binary scan $globalsecret H* globalsecret
14 close $gsfile
15 unset gsfile
16}
9bc33297 17
7a70431a
IJ
18proc try_except_finally {try except finally} {
19 global errorInfo errorCode
20 set er [catch { uplevel 1 $try } emsg]
21 if {$er} {
22 set ei $errorInfo
23 set ec $errorCode
24 if {[catch { uplevel 1 $except } emsg3]} {
25 append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3"
26 }
27 }
28 set er2 [catch { uplevel 1 $finally } emsg2]
29 if {$er} {
30 if {$er2} {
31 append ei "\nALSO ERROR CLEANING UP:\n$emsg2"
32 }
33 return -code $er -errorinfo $ei -errorcode $ec $emsg
34 } elseif {$er2} {
35 return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2
36 } else {
37 return $emsg
38 }
39}
40
cc2d31de
IJ
41proc sendout {command args} {
42 global sock
9bc33297
IJ
43 if {[llength $args]} {
44 set la [lindex $args end]
45 set args [lreplace $args end end]
46 foreach i $args {
47 if {[regexp {[: ]} $i]} {
cc2d31de 48 error "bad argument in output $i ($command $args)"
9bc33297
IJ
49 }
50 }
cc2d31de 51 lappend args :$la
9bc33297
IJ
52 }
53 set args [lreplace $args 0 -1 $command]
cc2d31de 54 set string [join $args { }]
83dd1224 55 puts "[clock seconds] -> $string"
9bc33297
IJ
56 puts $sock $string
57}
9bc33297
IJ
58
59proc log {data} {
60 puts $data
61}
62
63proc logerror {data} {
64 log $data
cc2d31de
IJ
65}
66
67proc saveeic {} {
68 global saveei saveec errorInfo errorCode
69
70 set saveei $errorInfo
71 set saveec $errorCode
72
73 puts ">$saveec|$saveei<"
74}
75
76proc bgerror {msg} {
77 global save
78 logerror $msg
79 saveeic
80}
9bc33297
IJ
81
82proc onread {args} {
d83fb8db 83 global sock nick calling_nick
9bc33297 84
cc2d31de
IJ
85 if {[gets $sock line] == -1} { set terminate 1; return }
86 regsub -all "\[^ -\176\240-\376\]" $line ? line
9bc33297
IJ
87 set org $line
88 if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
89 set line $remain
a056c4bd
IJ
90 if {[regexp {^([^!]+)!} $prefix dummy maybenick] &&
91 "[irctolower $maybenick]" == "[irctolower $nick]"} return
d83fb8db 92 set calling_nick $maybenick
9bc33297
IJ
93 } else {
94 set prefix {}
d83fb8db 95 catch { unset calling_nick }
9bc33297 96 }
cc2d31de 97 if {![string length $line]} { return }
9bc33297
IJ
98 if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
99 log "bad command: $org"
100 return
101 }
cc2d31de 102 set command [string toupper $command]
9bc33297 103 set params {}
cc2d31de 104 while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} {
9bc33297
IJ
105 lappend params $thisword
106 }
107 if {[regexp {^:(.*)} $line dummy thisword]} {
108 lappend params $thisword
109 } elseif {[string length $line]} {
110 log "junk at end: $org"
111 return
112 }
cc2d31de
IJ
113 if {"$command" == "PRIVMSG" &&
114 [regexp {^[&#+!]} [lindex $params 0]] &&
115 ![regexp {^!} [lindex $params 1]]} {
116 # on-channel message, ignore
422f52e4 117 catch {
83dd1224 118 recordlastseen_p $prefix "talking on [lindex $params 0]" 1
422f52e4 119 }
cc2d31de
IJ
120 return
121 }
83dd1224 122 log "[clock seconds] <- $org"
9bc33297 123 set procname msg_$command
cc2d31de 124 if {[catch { info body $procname }]} { return }
9bc33297
IJ
125 if {[catch {
126 eval [list $procname $prefix $command] $params
127 } emsg]} {
128 logerror "error: $emsg ($prefix $command $params)"
cc2d31de 129 saveeic
9bc33297
IJ
130 }
131}
132
7ce72032
IJ
133proc sendprivmsg {dest l} {
134 sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $l
83dd1224 135}
7ce72032
IJ
136proc sendaction {dest what} { sendout PRIVMSG $dest "\001ACTION $what\001" }
137proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } }
138proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] }
83dd1224 139
cc2d31de
IJ
140proc prefix_none {} {
141 upvar 1 p p
9bc33297 142 if {[string length $p]} { error "prefix specified" }
cc2d31de 143}
9bc33297 144
cc2d31de
IJ
145proc msg_PING {p c s1} {
146 prefix_none
147 sendout PONG $s1
9bc33297
IJ
148}
149
cc2d31de
IJ
150proc check_nick {n} {
151 if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" }
152 if {[regexp {^[-0-9]} $n]} { error "bad nick start" }
153}
154
422f52e4
IJ
155proc ischan {dest} {
156 return [regexp {^[&#+!]} $dest]
157}
158
159proc irctolower {v} {
160 foreach {from to} [list "\\\[" "{" \
161 "\\\]" "}" \
162 "\\\\" "|" \
163 "~" "^"] {
164 regsub -all $from $v $to v
165 }
166 return [string tolower $v]
167}
168
cc2d31de
IJ
169proc prefix_nick {} {
170 global nick
171 upvar 1 p p
172 upvar 1 n n
173 if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
174 check_nick $n
a056c4bd
IJ
175 if {"[irctolower $n]" == "[irctolower $nick]"} {
176 error "from myself" {} {}
177 }
422f52e4
IJ
178}
179
7ce72032 180proc showintervalsecs {howlong} {
d83fb8db
IJ
181 return [showintervalsecs/[opt timeformat] $howlong]
182}
183
184proc showintervalsecs/ks {howlong} {
7ce72032
IJ
185 if {$howlong < 1000} {
186 return "${howlong}s"
83dd1224
IJ
187 } else {
188 if {$howlong < 1000000} {
189 set pfx k
190 set scale 1000
191 } else {
192 set pfx M
193 set scale 1000000
194 }
195 set value [expr "$howlong.0 / $scale"]
196 foreach {min format} {100 %.0f 10 %.1f 1 %.2f} {
197 if {$value < $min} continue
7ce72032 198 return [format "$format${pfx}s" $value]
83dd1224
IJ
199 }
200 }
201}
202
d83fb8db
IJ
203proc format_qty {qty unit} {
204 set o $qty
205 append o " "
206 append o $unit
207 if {$qty != 1} { append o s }
208 return $o
209}
210
211proc showintervalsecs/hms {qty} {
212 set ul {second 60 minute 60 hour 24 day 7 week}
213 set remainv 0
214 while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} {
215 set remainu [lindex $ul 0]
216 set remainv [expr {$qty % $uv}]
217 set qty [expr {($qty-$remainv)/$uv}]
218 set ul [lreplace $ul 0 1]
219 }
220 set o [format_qty $qty [lindex $ul 0]]
221 if {$remainv} {
222 append o " "
223 append o [format_qty $remainv $remainu]
224 }
225 return $o
226}
227
7ce72032
IJ
228proc showinterval {howlong} {
229 if {$howlong <= 0} {
230 return {just now}
231 } else {
232 return "[showintervalsecs $howlong] ago"
233 }
234}
235
83dd1224
IJ
236proc showtime {when} {
237 return [showinterval [expr {[clock seconds] - $when}]]
238}
239
240proc def_msgproc {name argl body} {
241 proc msg_$name "varbase $argl" "\
242 upvar #0 msg/\$varbase/dest d\n\
243 upvar #0 msg/\$varbase/str s\n\
244 upvar #0 msg/\$varbase/accum a\n\
245$body"
246}
247
248def_msgproc begin {dest str} {
249 set d $dest
250 set s $str
251 set a {}
252}
253
254def_msgproc append {str} {
255 set ns "$s$str"
256 if {[string length $s] && [string length $ns] > 65} {
257 msg__sendout $varbase
258 set s " [string trimleft $str]"
259 } else {
260 set s $ns
261 }
262}
263
264def_msgproc finish {} {
265 msg__sendout $varbase
266 unset s
267 unset d
268 return $a
269}
270
271def_msgproc _sendout {} {
272 lappend a [string trimright $s]
273 set s {}
274}
275
276proc looking_whenwhere {when where} {
277 set str [showtime [expr {$when-1}]]
278 if {[string length $where]} { append str " on $where" }
279 return $str
280}
281
282proc recordlastseen_n {n how here} {
283 global lastseen lookedfor
422f52e4 284 set lastseen([irctolower $n]) [list $n [clock seconds] $how]
83dd1224
IJ
285 if {!$here} return
286 upvar #0 lookedfor([irctolower $n]) lf
287 if {[info exists lf]} {
288 switch -exact [llength $lf] {
289 0 {
290 set ml {}
291 }
292 1 {
293 manyset [lindex $lf 0] when who where
294 set ml [list \
295 "FYI, $who was looking for you [looking_whenwhere $when $where]."]
296 }
297 default {
298 msg_begin tosend $n "FYI, people have been looking for you:"
299 set i 0
300 set fin ""
301 foreach e $lf {
302 incr i
303 if {$i == 1} {
304 msg_append tosend " "
305 } elseif {$i == [llength $lf]} {
306 msg_append tosend " and "
307 set fin .
308 } else {
309 msg_append tosend ", "
310 }
311 manyset $e when who where
312 msg_append tosend \
313 "$who ([looking_whenwhere $when $where])$fin"
314 }
315 set ml [msg_finish tosend]
316 }
317 }
318 unset lf
319 msendprivmsg_delayed 1000 $n $ml
320 }
422f52e4
IJ
321}
322
83dd1224 323proc recordlastseen_p {p how here} {
422f52e4 324 prefix_nick
83dd1224 325 recordlastseen_n $n $how $here
422f52e4
IJ
326}
327
328proc chanmode_arg {} {
329 upvar 2 args cm_args
330 set rv [lindex $cm_args 0]
331 set cm_args [lreplace cm_args 0 0]
332 return $rv
333}
334
83dd1224
IJ
335proc chanmode_o1 {m g p chan} {
336 global nick
337 prefix_nick
338 set who [chanmode_arg]
339 recordlastseen_n $n "being nice to $who" 1
340 if {"[irctolower $who]" == "[irctolower $nick]"} {
7ce72032 341 sendprivmsg $n Thanks.
83dd1224
IJ
342 }
343}
344
422f52e4
IJ
345proc chanmode_o0 {m g p chan} {
346 global nick chandeop
347 prefix_nick
348 set who [chanmode_arg]
83dd1224 349 recordlastseen_p $p "being mean to $who" 1
422f52e4
IJ
350 if {"[irctolower $who]" == "[irctolower $nick]"} {
351 set chandeop($chan) [list [clock seconds] $p]
352 }
cc2d31de 353}
9bc33297 354
422f52e4
IJ
355proc msg_MODE {p c dest modelist args} {
356 if {![ischan $dest]} return
357 if {[regexp {^\-(.+)$} $modelist dummy modelist]} {
358 set give 0
359 } elseif {[regexp {^\+(.+)$} $modelist dummy modelist]} {
360 set give 1
361 } else {
362 error "invalid modelist"
363 }
364 foreach m [split $modelist] {
365 set procname chanmode_$m$give
366 if {[catch { info body $procname }]} {
83dd1224 367 recordlastseen_p $p "fiddling with $dest" 1
422f52e4
IJ
368 } else {
369 $procname $m $give $p $dest
370 }
371 }
372}
373
a056c4bd
IJ
374proc process_kickpart {chan user} {
375 check_nick $user
376 if {![ischan $chan]} { error "not a channel" }
377
378 upvar #0 nick_onchans($user) oc
379 set lc [irctolower $chan]
380 set oc [grep tc {"$tc" != "$lc"} $oc]
d83fb8db 381 if {![llength $oc]} { nick_forget $user }
a056c4bd
IJ
382}
383
384proc msg_KICK {p c chans users comment} {
385 set chans [split $chans ,]
386 set users [split $users ,]
387 if {[llength $chans] > 1} {
388 foreach chan $chans user $users { process_kickpart $chan $user }
389 } else {
390 foreach user $users { process_kickpart [lindex $chans 0] $user }
391 }
392}
393
394proc msg_KILL {p c user why} {
395 nick_forget $user
396}
397
398set nick_arys {onchans username}
399
400proc nick_forget {n} {
401 global nick_arys
402 foreach ary $nick_arys {
403 upvar #0 nick_${ary}($n) av
404 catch { unset av }
405 }
406}
407
83dd1224 408proc msg_NICK {p c newnick} {
a056c4bd 409 global nick_arys
83dd1224
IJ
410 prefix_nick
411 recordlastseen_n $n "changing nicks to $newnick" 0
412 recordlastseen_n $newnick "changing nicks from $n" 1
a056c4bd
IJ
413 foreach ary $nick_arys {
414 upvar #0 nick_${ary}($n) old
415 upvar #0 nick_${ary}($newnick) new
416 if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
417 if {[info exists old]} { set new $old; unset old }
418 }
83dd1224
IJ
419}
420
a056c4bd
IJ
421proc msg_JOIN {p c chan} {
422 prefix_nick
423 recordlastseen_n $n "joining $chan" 1
424 upvar #0 nick_onchans($n) oc
425 lappend oc [irctolower $chan]
426}
427proc msg_PART {p c chan} {
428 prefix_nick
429 recordlastseen_n $n "leaving $chan" 1
430 process_kickpart $chan $n
431}
432proc msg_QUIT {p c why} {
433 prefix_nick
434 recordlastseen_n $n "leaving ($why)" 0
435 nick_forget $n
436}
422f52e4 437
cc2d31de
IJ
438proc msg_PRIVMSG {p c dest text} {
439 prefix_nick
422f52e4 440 if {[ischan $dest]} {
83dd1224 441 recordlastseen_n $n "invoking me in $dest" 1
422f52e4 442 set output $dest
cc2d31de 443 } else {
83dd1224 444 recordlastseen_n $n "talking to me" 1
422f52e4
IJ
445 set output $n
446 }
447
448 if {[catch {
449 regsub {^! *} $text {} text
450 set ucmd [ta_word]
83dd1224 451 set procname ucmd/[string tolower $ucmd]
422f52e4
IJ
452 if {[catch { info body $procname }]} {
453 error "unknown command; try help for help"
454 }
83dd1224 455 $procname $p $dest
422f52e4 456 } rv]} {
7ce72032 457 sendprivmsg $n "error: $rv"
422f52e4 458 } else {
7ce72032 459 manyset $rv priv_msgs pub_msgs priv_acts pub_acts
7a70431a 460 foreach {td val} [list $n $priv_acts $output $pub_acts] {
7ce72032 461 foreach l [split $val "\n"] {
7a70431a 462 sendaction $td $l
7ce72032
IJ
463 }
464 }
7a70431a 465 foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
422f52e4 466 foreach l [split $val "\n"] {
7a70431a 467 sendprivmsg $td $l
422f52e4
IJ
468 }
469 }
470 }
471}
472
a056c4bd
IJ
473proc msg_INVITE {p c n chan} {
474 after 1000 [list sendout JOIN $chan]
475}
476
477proc grep {var predicate list} {
478 set o {}
479 upvar 1 $var v
480 foreach v $list {
481 if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
482 }
483 return $o
484}
485
486proc msg_353 {p c dest type chan nicklist} {
487 global names_chans nick_onchans
488 if {![info exists names_chans]} { set names_chans {} }
489 set chan [irctolower $chan]
490 lappend names_chans $chan
491 foreach n [array names nick_onchans] {
492 upvar #0 nick_onchans($n) oc
493 set oc [grep tc {"$tc" != "$chan"} $oc]
494 }
495 foreach n [split $nicklist { }] {
496 regsub {^[@+]} $n {} n
497 check_nick $n
498 if {![string length $n]} continue
499 upvar #0 nick_onchans($n) oc
500 lappend oc $chan
501 }
502}
503
504proc msg_366 {p c args} {
505 global names_chans nick_onchans
506 if {[llength names_chans] > 1} {
507 foreach n [array names nick_onchans] {
508 upvar #0 nick_onchans($n) oc
509 set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
510 if {![llength $oc]} { nick_forget $n }
511 }
512 }
513 unset names_chans
514}
515
11d9bff9
IJ
516proc ta_anymore {} {
517 upvar 1 text text
518 return [expr {!![string length $text]}]
519}
520
422f52e4
IJ
521proc ta_nomore {} {
522 upvar 1 text text
523 if {[string length $text]} { error "too many parameters" }
524}
525
526proc ta_word {} {
527 upvar 1 text text
528 if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} {
529 error "too few parameters"
530 }
531 return $firstword
532}
533
534proc ta_nick {} {
535 upvar 1 text text
536 set v [ta_word]
537 check_nick $v
538 return $v
539}
540
83dd1224
IJ
541proc def_ucmd {cmdname body} {
542 proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body"
543}
544
7ce72032
IJ
545proc ucmdr {priv pub args} {
546 return -code return [concat [list $priv $pub] $args]
422f52e4 547}
e1ba63be 548
e6cc22dc
IJ
549proc loadhelp {} {
550 global help_topics
551
552 catch { unset help_topics }
553 set f [open helpinfos r]
d83fb8db
IJ
554 try_except_finally {
555 set lno 0
556 while {[gets $f l] >= 0} {
557 incr lno
558 if {[regexp {^#.*} $l]} {
559 } elseif {[regexp {^ *$} $l]} {
560 if {[info exists topic]} {
561 set help_topics($topic) [join $lines "\n"]
562 unset topic
563 unset lines
564 }
565 } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
566 if {[info exists topic]} {
567 error "help $newtopic while in $topic"
568 }
569 set topic $newtopic
570 set lines {}
571 } elseif {[regexp {^[^!#]} $l]} {
572 set topic
573 lappend lines [string trimright $l]
574 } else {
575 error "eh ? $lno: $l"
e6cc22dc 576 }
e6cc22dc 577 }
d83fb8db
IJ
578 if {[info exists topic]} { error "unfinished topic $topic" }
579 } {} {
580 close $f
e6cc22dc 581 }
422f52e4
IJ
582}
583
e6cc22dc
IJ
584def_ucmd help {
585 upvar #0 help_topics([irctolower [string trim $text]]) info
4fd2739c 586 if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
e6cc22dc
IJ
587 ucmdr $info {}
588}
e1ba63be 589
e6cc22dc
IJ
590def_ucmd ? {
591 global help_topics
592 ucmdr $help_topics() {}
593}
e1ba63be 594
422f52e4
IJ
595proc manyset {list args} {
596 foreach val $list var $args {
597 upvar 1 $var my
598 set my $val
599 }
600}
601
4fd2739c 602proc check_username {target} {
7ce72032
IJ
603 if {
604 [string length $target] > 8 ||
605 [regexp {[^-0-9a-z]} $target] ||
606 ![regexp {^[a-z]} $target]
607 } { error "invalid username" }
4fd2739c
IJ
608}
609
7a70431a
IJ
610proc nickdb__head {} {
611 uplevel 1 {
612 set nl [irctolower $n]
613 upvar #0 nickdb($nl) ndbe
614 binary scan $nl H* nh
d83fb8db 615 set nfn users/n$nh
7a70431a 616 if {![info exists ndbe] && [file exists $nfn]} {
d83fb8db 617 set f [open $nfn r]
7a70431a
IJ
618 try_except_finally { set newval [read $f] } {} { close $f }
619 if {[llength $newval] % 2} { error "invalid length" }
620 set ndbe $newval
621 }
622 }
623}
624
625proc def_nickdb {name arglist body} {
626 proc nickdb_$name $arglist "nickdb__head; $body"
627}
628
629def_nickdb exists {n} {
630 return [info exists ndbe]
631}
632
633def_nickdb delete {n} {
634 catch { unset ndbe }
635 file delete $nfn
636}
637
638set default_settings {timeformat ks}
639
640def_nickdb set {n args} {
641 global default_settings
642 if {![info exists ndbe]} { set ndbe $default_settings }
643 foreach {key value} [concat $ndbe $args] { set a($key) $value }
644 set newval {}
645 foreach {key value} [array get a] { lappend newval $key $value }
646 set f [open $nfn.new w]
647 try_except_finally {
648 puts $f $newval
649 close $f
650 file rename -force $nfn.new $nfn
651 } {
7a70431a 652 } {
d83fb8db 653 catch { close $f }
7a70431a
IJ
654 }
655 set ndbe $newval
656}
657
d83fb8db
IJ
658proc opt {key} {
659 global calling_nick
660 if {[info exists calling_nick]} { set n $calling_nick } { set n {} }
661 return [nickdb_opt $n $key]
662}
663
7a70431a
IJ
664def_nickdb opt {n key} {
665 global default_settings
666 if {[info exists ndbe]} {
667 set l $ndbe
668 } else {
669 set l $default_settings
670 }
671 foreach {tkey value} $l {
672 if {"$tkey" == "$key"} { return $value }
673 }
674 error "unset setting $key"
675}
676
677proc check_notonchan {} {
678 upvar 1 dest dest
679 if {[ischan $dest]} { error "that command must be sent privately" }
680}
681
682proc nick_securitycheck {strict} {
683 upvar 1 n n
684 if {![nickdb_exists $n]} { error "you are unknown to me, use `register'." }
685 set wantu [nickdb_opt $n username]
686 if {![string length $wantu]} {
687 if {$strict} {
688 error "that feature is only available to secure users, sorry."
689 } else {
690 return
691 }
692 }
693 upvar #0 nick_username($n) nu
694 if {![info exists nu]} {
695 error "nick $n is secure, you must identify yourself first."
696 }
697 if {"$wantu" != "$nu"} {
698 error "you are the wrong user - the nick $n belongs to $wantu, not $nu"
699 }
700}
701
702def_ucmd register {
703 prefix_nick
704 check_notonchan
705 set old [nickdb_exists $n]
706 if {$old} { nick_securitycheck 0 }
707 switch -exact [string tolower [string trim $text]] {
708 {} {
709 upvar #0 nick_username($n) nu
710 if {![info exists nu]} {
711 ucmdr {} \
712 "You must identify yourself before using `register'. See `help identify'."
713 }
714 nickdb_set $n username $nu
715 ucmdr {} {} "makes a note of your username." {}
716 }
717 delete {
718 nickdb_delete $n
719 ucmdr {} {} "forgets your nickname." {}
720 }
721 insecure {
722 nickdb_set $n username {}
723 if {$old} {
724 ucmdr {} "Security is now disabled for your nickname !"
725 } else {
726 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."
727 }
728 }
729 }
11d9bff9
IJ
730}
731
732proc timeformat_desc {tf} {
733 switch -exact $tf {
734 ks { return "Times will be displayed in kiloseconds or seconds." }
735 hms { return "Times will be displayed in hours, minutes, etc." }
736 default { error "invalid timeformat: $v" }
737 }
738}
739
740proc def_setting {opt show_body set_body} {
741 proc set_show/$opt {} "
742 upvar 1 n n
743 set opt $opt
744 $show_body"
745 if {![string length $set_body]} return
746 proc set_set/$opt {} "
747 upvar 1 n n
748 upvar 1 text text
749 set opt $opt
750 $set_body"
751}
752
753def_setting timeformat {
754 set tf [nickdb_opt $n timeformat]
755 return "$tf: [timeformat_desc $tf]"
756} {
757 set tf [string tolower [ta_word]]
758 ta_nomore
759 set desc [timeformat_desc $tf]
760 nickdb_set $n timeformat $tf
761 ucmdr {} $desc
762}
763
764def_setting security {
765 set s [nickdb_opt $n username]
766 if {[string length $s]} {
767 return "Your nick, $n, is controlled by the user $s."
768 } else {
769 return "Your nick, $n, is not secure."
770 }
771} {}
772
773def_ucmd set {
774 prefix_nick
775 check_notonchan
776 if {![nickdb_exists $n]} {
d83fb8db 777 ucmdr {} "You are unknown to me and so have no settings. (Use `register'.)"
11d9bff9
IJ
778 }
779 if {![ta_anymore]} {
780 set ol {}
781 foreach proc [lsort [info procs]] {
782 if {![regexp {^set_show/(.*)$} $proc dummy opt]} continue
783 lappend ol [format "%-10s %s" $opt [set_show/$opt]]
784 }
785 ucmdr {} [join $ol "\n"]
786 } else {
787 set opt [ta_word]
788 if {[catch { info body set_show/$opt }]} {
789 error "no setting $opt"
790 }
791 if {![ta_anymore]} {
792 ucmdr {} "$opt [set_show/$opt]"
793 } else {
794 if {[catch { info body set_set/$opt }]} {
795 error "setting $opt cannot be set with `set'"
796 }
797 set_set/$opt
798 }
799 }
800}
7a70431a 801
4fd2739c
IJ
802def_ucmd identpass {
803 set username [ta_word]
d83fb8db 804 set passmd5 [md5sum "[ta_word]\n"]
4fd2739c
IJ
805 ta_nomore
806 prefix_nick
11d9bff9 807 check_notonchan
4fd2739c
IJ
808 upvar #0 nick_onchans($n) onchans
809 if {![info exists onchans] || ![llength $onchans]} {
7a70431a 810 ucmdr "You must be on a channel with me to identify yourself." {}
4fd2739c
IJ
811 }
812 check_username $username
813 exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
814 irc-identpass $n
815 upvar #0 nick_username($n) rec_username
816 set rec_username $username
7a70431a 817 ucmdr "Pleased to see you, $username." {}
4fd2739c
IJ
818}
819
820def_ucmd summon {
821 set target [ta_word]
822 ta_nomore
823 check_username $target
7ce72032
IJ
824 prefix_nick
825
826 upvar #0 lastsummon($target) ls
827 set now [clock seconds]
828 if {[info exists ls]} {
829 set interval [expr {$now - $ls}]
830 if {$interval < 30} {
831 ucmdr {} \
832 "Please be patient; $target was summoned only [showinterval $interval]."
833 }
834 }
835 regsub {^[^!]*!} $p {} path
836 if {[catch {
837 exec userv --timeout 3 $target irc-summon $n $path \
838 [expr {[ischan $dest] ? "$dest" : ""}] \
839 < /dev/null
840 } rv]} {
841 regsub -all "\n" $rv { / } rv
842 error $rv
843 }
844 if {[regexp {^problem (.*)} $rv dummy problem]} {
8a8d337d 845 ucmdr {} "The user `$target' $problem."
7ce72032
IJ
846 } elseif {[regexp {^ok ([^ ]+) ([0-9]+)$} $rv dummy tty idlesince]} {
847 set idletime [expr {$now - $idlesince}]
848 set ls $now
849 ucmdr {} {} {} "invites $target ($tty[expr {
850 $idletime > 10 ? ", idle for [showintervalsecs $idletime]" : ""
851 }]) to [expr {
852 [ischan $dest] ? "join us here" : "talk to you"
853 }]."
854 } else {
855 error "unexpected response from userv service: $rv"
856 }
857}
858
a69f7d2c
IJ
859proc md5sum {value} { exec md5sum << $value }
860
83dd1224 861def_ucmd seen {
422f52e4 862 global lastseen nick
83dd1224
IJ
863 prefix_nick
864 set ncase [ta_nick]
865 set nlower [irctolower $ncase]
422f52e4 866 ta_nomore
83dd1224
IJ
867 set now [clock seconds]
868 if {"$nlower" == "[irctolower $nick]"} {
422f52e4 869 error "I am not self-aware."
83dd1224
IJ
870 } elseif {![info exists lastseen($nlower)]} {
871 set rstr "I've never seen $ncase."
422f52e4 872 } else {
83dd1224
IJ
873 manyset $lastseen($nlower) realnick time what
874 set howlong [expr {$now - $time}]
875 set string [showinterval $howlong]
876 set rstr "I last saw $realnick $string, $what."
877 }
878 if {[ischan $dest]} {
879 set where $dest
880 } else {
881 set where {}
882 }
883 upvar #0 lookedfor($nlower) lf
884 if {[info exists lf]} { set oldvalue $lf } else { set oldvalue {} }
885 set lf [list [list $now $n $where]]
886 foreach v $oldvalue {
887 if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
888 lappend lf $v
cc2d31de 889 }
83dd1224 890 ucmdr {} $rstr
cc2d31de
IJ
891}
892
893if {![info exists sock]} {
894 set sock [socket $host $port]
895 fconfigure $sock -buffering line
896 #fconfigure $sock -translation binary
897 fconfigure $sock -translation crlf
898
b3d361ab 899 sendout USER blight 0 * $ownfullname
cc2d31de
IJ
900 sendout NICK $nick
901 fileevent $sock readable onread
902}
903
e6cc22dc
IJ
904loadhelp
905
8979e0d6
IJ
906#if {![regexp {tclsh} $argv0]} {
907# vwait terminate
908#}