5 if {![info exists nick]} { set nick Blight }
6 if {![info exists ownfullname]} { set ownfullname "here to Help" }
7 set ownmailaddr blight@chiark.greenend.org.uk
12 set out_lag_very 15000
14 if {![info exists out_queue]} {
15 set out_creditms [expr {$out_maxburst*$out_interval}]
16 set out_creditat [clock seconds]
18 set out_lag_reported 0
19 set out_lag_reportwhen $out_creditat
22 if {![info exists globalsecret]} {
23 set gsfile [open /dev/urandom r]
24 fconfigure $gsfile -translation binary
25 set globalsecret [read $gsfile 32]
26 binary scan $globalsecret H* globalsecret
31 proc manyset {list args} {
32 foreach val $list var $args {
38 proc try_except_finally {try except finally} {
39 global errorInfo errorCode
40 set er [catch { uplevel 1 $try } emsg]
44 if {[catch { uplevel 1 $except } emsg3]} {
45 append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3"
48 set er2 [catch { uplevel 1 $finally } emsg2]
51 append ei "\nALSO ERROR CLEANING UP:\n$emsg2"
53 return -code $er -errorinfo $ei -errorcode $ec $emsg
55 return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2
63 global out_queue out_creditms out_creditat out_interval out_maxburst
64 global out_lag_lag out_lag_very
65 #set pr [lindex [info level 0] 0]
66 #puts $pr>[clock seconds]|$out_creditat|$out_creditms|[llength $out_queue]<
72 if {[llength $out_queue]*$out_interval > $out_lag_very} {
74 } elseif {[llength $out_queue]*$out_interval > $out_lag_lag} {
84 set now [clock seconds]
85 incr out_creditms [expr {($now - $out_creditat) * 1000}]
87 if {$out_creditms > $out_maxburst*$out_interval} {
88 set out_creditms [expr {$out_maxburst*$out_interval}]
93 proc out_runqueue {now} {
97 while {[llength $out_queue] && $out_creditms >= $out_interval} {
98 #puts rq>$now|$out_creditat|$out_creditms|[llength $out_queue]<
99 manyset [lindex $out_queue 0] orgwhen msg
100 set out_queue [lrange $out_queue 1 end]
101 if {[llength $out_queue]} {
102 append orgwhen "+[expr {$now - $orgwhen}]"
103 append orgwhen ([llength $out_queue])"
105 puts "$orgwhen -> $msg"
107 incr out_creditms -$out_interval
109 if {[llength $out_queue]} {
110 after $out_interval out_nextmessage
114 proc out_nextmessage {} {
116 set now [clock seconds]
117 incr out_creditms $out_interval
118 set out_creditat $now
122 proc sendout_priority {priority command args} {
123 global sock out_queue
124 if {[llength $args]} {
125 set la [lindex $args end]
126 set args [lreplace $args end end]
128 if {[regexp {[: ]} $i]} {
129 error "bad argument in output $i ($command $args)"
134 set args [lreplace $args 0 -1 $command]
135 set string [join $args { }]
136 set now [clock seconds]
137 set newe [list $now $string]
139 set out_queue [concat [list $newe] $out_queue]
141 lappend out_queue $newe
143 if {[llength $out_queue] == 1} {
148 proc sendout {command args} { eval sendout_priority [list 0 $command] $args }
154 proc logerror {data} {
159 global saveei saveec errorInfo errorCode
161 set saveei $errorInfo
162 set saveec $errorCode
164 puts ">$saveec|$saveei<"
174 global sock nick calling_nick errorInfo errorCode
176 if {[gets $sock line] == -1} { set terminate 1; return }
177 regsub -all "\[^ -\176\240-\376\]" $line ? line
182 catch { unset calling_nick }
186 if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
188 if {[regexp {^([^!]+)!} $prefix dummy maybenick]} {
189 set calling_nick $maybenick
190 if {"[irctolower $maybenick]" == "[irctolower $nick]"} return
195 if {![string length $line]} { return }
196 if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} {
197 log "bad command: $org"
200 set command [string toupper $command]
202 while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} {
203 lappend params $thisword
205 if {[regexp {^:(.*)} $line dummy thisword]} {
206 lappend params $thisword
207 } elseif {[string length $line]} {
208 log "junk at end: $org"
211 if {"$command" == "PRIVMSG" &&
212 [regexp {^[&#+!]} [lindex $params 0]] &&
213 ![regexp {^!} [lindex $params 1]]} {
214 # on-channel message, ignore
216 recordlastseen_p $prefix "talking on [lindex $params 0]" 1
220 log "[clock seconds] <- $org"
221 set procname msg_$command
222 if {[catch { info body $procname }]} { return }
224 eval [list $procname $prefix $command] $params
226 logerror "error: $emsg ($prefix $command $params)"
231 proc sendprivmsg {dest l} {
232 foreach v [split $l "\n"] {
233 sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v
236 proc sendaction_priority {priority dest what} {
237 sendout_priority $priority PRIVMSG $dest "\001ACTION $what\001"
239 proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } }
240 proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] }
242 proc prefix_none {} {
244 if {[string length $p]} { error "prefix specified" }
247 proc msg_PING {p c s1} {
252 proc check_nick {n} {
253 if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" }
254 if {[regexp {^[-0-9]} $n]} { error "bad nick start" }
258 return [regexp {^[&#+!]} $dest]
261 proc irctolower {v} {
262 foreach {from to} [list "\\\[" "{" \
266 regsub -all $from $v $to v
268 return [string tolower $v]
271 proc prefix_nick {} {
275 if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
277 if {"[irctolower $n]" == "[irctolower $nick]"} {
278 error "from myself" {} {}
282 proc showintervalsecs {howlong} {
283 return [showintervalsecs/[opt timeformat] $howlong]
286 proc showintervalsecs/ks {howlong} {
287 if {$howlong < 1000} {
290 if {$howlong < 1000000} {
297 set value [expr "$howlong.0 / $scale"]
298 foreach {min format} {100 %.0f 10 %.1f 1 %.2f} {
299 if {$value < $min} continue
300 return [format "$format${pfx}s" $value]
305 proc format_qty {qty unit} {
309 if {$qty != 1} { append o s }
313 proc showintervalsecs/hms {qty} {
314 set ul {second 60 minute 60 hour 24 day 7 week}
316 while {[llength $ul] > 1 && $qty >= [set uv [lindex $ul 1]]} {
317 set remainu [lindex $ul 0]
318 set remainv [expr {$qty % $uv}]
319 set qty [expr {($qty-$remainv)/$uv}]
320 set ul [lreplace $ul 0 1]
322 set o [format_qty $qty [lindex $ul 0]]
325 append o [format_qty $remainv $remainu]
330 proc showinterval {howlong} {
334 return "[showintervalsecs $howlong] ago"
338 proc showtime {when} {
339 return [showinterval [expr {[clock seconds] - $when}]]
342 proc def_msgproc {name argl body} {
343 proc msg_$name "varbase $argl" "\
344 upvar #0 msg/\$varbase/dest d\n\
345 upvar #0 msg/\$varbase/str s\n\
346 upvar #0 msg/\$varbase/accum a\n\
350 def_msgproc begin {dest str} {
356 def_msgproc append {str} {
358 if {[string length $s] && [string length $ns] > 65} {
359 msg__sendout $varbase
360 set s " [string trimleft $str]"
366 def_msgproc finish {} {
367 msg__sendout $varbase
373 def_msgproc _sendout {} {
374 lappend a [string trimright $s]
378 proc looking_whenwhere {when where} {
379 set str [showtime [expr {$when-1}]]
380 if {[string length $where]} { append str " on $where" }
384 proc recordlastseen_n {n how here} {
385 global lastseen lookedfor
386 set lastseen([irctolower $n]) [list $n [clock seconds] $how]
388 upvar #0 lookedfor([irctolower $n]) lf
389 if {[info exists lf]} {
390 switch -exact [llength $lf] {
395 manyset [lindex $lf 0] when who where
397 "FYI, $who was looking for you [looking_whenwhere $when $where]."]
400 msg_begin tosend $n "FYI, people have been looking for you:"
406 msg_append tosend " "
407 } elseif {$i == [llength $lf]} {
408 msg_append tosend " and "
411 msg_append tosend ", "
413 manyset $e when who where
415 "$who ([looking_whenwhere $when $where])$fin"
417 set ml [msg_finish tosend]
421 msendprivmsg_delayed 1000 $n $ml
425 proc recordlastseen_p {p how here} {
427 recordlastseen_n $n $how $here
430 proc chanmode_arg {} {
432 set rv [lindex $cm_args 0]
433 set cm_args [lreplace cm_args 0 0]
437 proc chanmode_o1 {m g p chan} {
438 global nick chan_initialop
440 set who [chanmode_arg]
441 recordlastseen_n $n "being nice to $who" 1
442 if {"[irctolower $who]" == "[irctolower $nick]"} {
443 set nl [irctolower $n]
444 upvar #0 nick_unique($n) u
445 if {[chandb_exists $chan]} {
446 sendprivmsg $n Thanks.
447 } elseif {![info exists u]} {
448 sendprivmsg $n {Op me while not on the channel, why don't you ?}
450 set chan_initialop([irctolower $chan]) $u
452 "Thanks. You can use `channel manager ...' to register this channel."
453 if {![nickdb_exists $n] || ![string length [nickdb_get $n username]]} {
455 "(But to do that you must register your nick securely first.)"
461 proc chanmode_o0 {m g p chan} {
464 set who [chanmode_arg]
465 recordlastseen_p $p "being mean to $who" 1
466 if {"[irctolower $who]" == "[irctolower $nick]"} {
467 set chandeop($chan) [list [clock seconds] $p]
471 proc msg_MODE {p c dest modelist args} {
472 if {![ischan $dest]} return
473 if {[regexp {^\-(.+)$} $modelist dummy modelist]} {
475 } elseif {[regexp {^\+(.+)$} $modelist dummy modelist]} {
478 error "invalid modelist"
480 foreach m [split $modelist] {
481 set procname chanmode_$m$give
482 if {[catch { info body $procname }]} {
483 recordlastseen_p $p "fiddling with $dest" 1
485 $procname $m $give $p $dest
490 proc channel_noone_seen {chan} {
492 foreach n [array names nick_onchans] {
493 upvar #0 nick_onchans($n) oc
494 set oc [grep tc {"$tc" != "$chan"} $oc]
498 proc process_kickpart {chan user} {
501 if {![ischan $chan]} { error "not a channel" }
502 if {"[irctolower $user]" == "[irctolower $nick]"} {
503 channel_noone_seen $chan
505 upvar #0 nick_onchans($user) oc
506 set lc [irctolower $chan]
507 set oc [grep tc {"$tc" != "$lc"} $oc]
508 if {![llength $oc]} { nick_forget $user }
512 proc msg_KICK {p c chans users comment} {
513 set chans [split $chans ,]
514 set users [split $users ,]
515 if {[llength $chans] > 1} {
516 foreach chan $chans user $users { process_kickpart $chan $user }
518 foreach user $users { process_kickpart [lindex $chans 0] $user }
522 proc msg_KILL {p c user why} {
527 set nick_arys {onchans username unique}
529 proc nick_forget {n} {
531 foreach ary $nick_arys {
532 upvar #0 nick_${ary}($n) av
540 set nick_case([irctolower $n]) $n
543 proc msg_NICK {p c newnick} {
544 global nick_arys nick_case
546 recordlastseen_n $n "changing nicks to $newnick" 0
547 recordlastseen_n $newnick "changing nicks from $n" 1
548 foreach ary $nick_arys {
549 upvar #0 nick_${ary}($n) old
550 upvar #0 nick_${ary}($newnick) new
551 if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
552 if {[info exists old]} { set new $old; unset old }
557 proc nick_ishere {n} {
559 upvar #0 nick_unique($n) u
560 if {![info exists u]} { set u [incr nick_counter].$n.[clock seconds] }
564 proc msg_JOIN {p c chan} {
566 recordlastseen_n $n "joining $chan" 1
567 upvar #0 nick_onchans($n) oc
568 lappend oc [irctolower $chan]
571 proc msg_PART {p c chan} {
573 recordlastseen_n $n "leaving $chan" 1
574 process_kickpart $chan $n
576 proc msg_QUIT {p c why} {
578 recordlastseen_n $n "leaving ($why)" 0
582 proc msg_PRIVMSG {p c dest text} {
584 if {[ischan $dest]} {
585 recordlastseen_n $n "invoking me in $dest" 1
588 recordlastseen_n $n "talking to me" 1
594 regsub {^! *} $text {} text
596 set procname ucmd/[string tolower $ucmd]
597 if {[catch { info body $procname }]} {
598 error "unknown command; try help for help"
602 sendprivmsg $n "error: $rv"
604 manyset $rv priv_msgs pub_msgs priv_acts pub_acts
605 foreach {td val} [list $n $priv_acts $output $pub_acts] {
606 foreach l [split $val "\n"] {
607 sendaction_priority 0 $td $l
610 foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
611 foreach l [split $val "\n"] {
618 proc msg_INVITE {p c n chan} {
619 after 1000 [list sendout JOIN $chan]
622 proc grep {var predicate list} {
626 if {[uplevel 1 [list expr $predicate]]} { lappend o $v }
631 proc msg_353 {p c dest type chan nicklist} {
632 global names_chans nick_onchans
633 if {![info exists names_chans]} { set names_chans {} }
634 set chan [irctolower $chan]
635 lappend names_chans $chan
636 channel_noone_seen $chan
637 foreach n [split $nicklist { }] {
638 regsub {^[@+]} $n {} n
639 if {![string length $n]} continue
641 upvar #0 nick_onchans($n) oc
647 proc msg_366 {p c args} {
648 global names_chans nick_onchans
649 if {[llength names_chans] > 1} {
650 foreach n [array names nick_onchans] {
651 upvar #0 nick_onchans($n) oc
652 set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
653 if {![llength $oc]} { nick_forget $n }
661 return [expr {!![string length $text]}]
666 if {[string length $text]} { error "too many parameters" }
671 if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} {
672 error "too few parameters"
684 proc def_ucmd {cmdname body} {
685 proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body"
688 proc ucmdr {priv pub args} {
689 return -code return [concat [list $priv $pub] $args]
695 catch { unset help_topics }
696 set f [open helpinfos r]
699 while {[gets $f l] >= 0} {
701 if {[regexp {^#.*} $l]} {
702 } elseif {[regexp {^ *$} $l]} {
703 if {[info exists topic]} {
704 set help_topics($topic) [join $lines "\n"]
708 } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
709 if {[info exists topic]} {
710 error "help $newtopic while in $topic"
714 } elseif {[regexp {^[^!#]} $l]} {
716 lappend lines [string trimright $l]
718 error "eh ? $lno: $l"
721 if {[info exists topic]} { error "unfinished topic $topic" }
728 if {[set lag [out_lagged]]} {
729 if {[ischan $dest]} { set replyto $dest } else { set replyto $n }
731 sendaction_priority 1 $replyto \
732 "is very lagged. Please ask for help again later."
735 sendaction_priority 1 $replyto \
736 "is lagged. Your help will arrive shortly ..."
740 upvar #0 help_topics([irctolower [string trim $text]]) info
741 if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
747 ucmdr $help_topics() {}
750 proc check_username {target} {
752 [string length $target] > 8 ||
753 [regexp {[^-0-9a-z]} $target] ||
754 ![regexp {^[a-z]} $target]
755 } { error "invalid username" }
758 proc somedb__head {} {
760 set idl [irctolower $id]
761 upvar #0 ${nickchan}db($idl) ndbe
762 binary scan $idl H* idh
763 set idfn $fprefix$idh
764 if {![info exists iddbe] && [file exists $idfn]} {
766 try_except_finally { set newval [read $f] } {} { close $f }
767 if {[llength $newval] % 2} { error "invalid length" }
773 proc def_somedb {name arglist body} {
774 foreach {nickchan fprefix} {nick users/n chan chans/c} {
775 proc ${nickchan}db_$name $arglist \
776 "set nickchan $nickchan; set fprefix $fprefix; somedb__head; $body"
780 def_somedb exists {id} {
781 return [info exists iddbe]
784 def_somedb delete {id} {
785 catch { unset iddbe }
789 set default_settings_nick {timeformat ks}
790 set default_settings_chan {autojoin 1}
792 def_somedb set {id args} {
793 upvar #0 default_settings_$nickchan def
794 if {![info exists iddbe]} { set iddbe $def }
795 foreach {key value} [concat $iddbe $args] { set a($key) $value }
797 foreach {key value} [array get a] { lappend newval $key $value }
798 set f [open $idfn.new w]
802 file rename -force $idfn.new $idfn
810 def_somedb get {id key} {
811 upvar #0 default_settings_$nickchan def
812 if {[info exists iddbe]} {
817 foreach {tkey value} $l {
818 if {"$tkey" == "$key"} { return $value }
820 error "unset setting $key"
825 if {[info exists calling_nick]} { set n $calling_nick } { set n {} }
826 return [nickdb_get $n $key]
829 proc check_notonchan {} {
831 if {[ischan $dest]} { error "that command must be sent privately" }
834 proc nick_securitycheck {strict} {
836 if {![nickdb_exists $n]} { error "you are unknown to me, use `register'." }
837 set wantu [nickdb_get $n username]
838 if {![string length $wantu]} {
840 error "that feature is only available to secure users, sorry."
845 upvar #0 nick_username($n) nu
846 if {![info exists nu]} {
847 error "nick $n is secure, you must identify yourself first."
849 if {"$wantu" != "$nu"} {
850 error "you are the wrong user - the nick $n belongs to $wantu, not $nu"
854 proc channel_securitycheck {channel n} {
855 # You must also call `nick_securitycheck 1'
856 set mgrs [chandb_get $channel managers]
857 if {[lsearch -exact [irctolower $mgrs] [irctolower $n]] < 0} {
858 error "you are not a manager of $channel"
862 proc def_chancmd {name body} {
863 proc channel/$name {} \
864 " upvar 1 target chan; upvar 1 n n; upvar 1 text text; $body"
867 def_chancmd manager {
869 switch -exact _$opcode {
872 if {[chandb_exists $chan]} {
873 set ml [chandb_get $chan managers]
875 set ml [list [irctolower $n]]
879 error "`channel manager' opcode must be one of + - ="
882 foreach nn [split $text " "] {
883 if {![string length $nn]} continue
885 set nn [irctolower $nn]
886 if {"$opcode" != "-"} {
889 set ml [grep nq {"$nq" != "$nn"} $ml]
893 chandb_set $chan managers $ml
894 ucmdr "Managers of $chan: $ml" {}
897 ucmdr {} {} "forgets about managing $chan." {}
901 def_chancmd autojoin {
903 switch -exact [string tolower $yesno] {
906 default { error "channel autojoin must be `yes' or `no' }
908 chandb_set $chan autojoin $nv
912 if {[chandb_exists $chan]} {
913 set l "Settings for $chan: autojoin "
914 append l [lindex {no yes} [chandb_get $chan autojoin]]
915 append l "\nManagers: "
916 append l [join [chandb_get $chan managers] " "]
919 ucmdr {} "The channel $chan is not managed."
924 if {[ischan $dest]} { set target $dest }
925 if {[ta_anymore]} { set target [ta_word] }
927 if {![info exists target]} { error "you must specify, or !... on, the channel" }
928 if {![ischan $target]} { error "not a valid channel" }
929 if {![chandb_exists $target]} { error "$target is not a managed channel." }
932 channel_securitycheck $target $n
933 sendout MODE $target +o $n
937 if {[ischan $dest]} { set target $dest }
943 if {[ischan $subcmd]} {
951 if {![info exists target]} { error "privately, you must specify a channel" }
952 set procname channel/$subcmd
953 if {"$subcmd" != "show"} {
954 if {[catch { info body $procname }]} { error "unknown channel setting $subcmd" }
957 if {[chandb_exists $target]} {
958 channel_securitycheck $target $n
960 upvar #0 chan_initialop([irctolower $target]) io
961 upvar #0 nick_unique($n) u
962 if {![info exists io]} { error "$target is not a managed channel" }
963 if {"$io" != "$u"} { error "you are not the interim manager of $target" }
964 if {"$subcmd" != "manager"} { error "use `channel manager' first" }
972 set target [ta_word]; ta_nomore
977 set myself [expr {"$target" != "$n"}]
979 upvar #0 nick_case([irctolower $target]) nc
981 if {[info exists nc]} {
982 upvar #0 nick_onchans($nc) oc
983 upvar #0 nick_username($nc) nu
984 if {[info exists oc]} { set nshow $nc }
986 if {![nickdb_exists $target]} {
987 set ol "$nshow is not a registered nick."
988 } elseif {[string length [set username [nickdb_get $target username]]]} {
989 set ol "The nick $nshow belongs to the user $username."
991 set ol "The nick $nshow is registered (but not to a username)."
993 if {![info exists nc] || ![info exists oc]} {
995 append ol "\nI can't see $nshow on anywhere."
997 append ol "\nYou aren't on any channels with me."
999 } elseif {![info exists nu]} {
1000 append ol "\n$nshow has not identified themselves."
1001 } elseif {![info exists username]} {
1002 append ol "\n$nshow has identified themselves as the user $nu."
1003 } elseif {"$nu" != "$username"} {
1004 append ol "\nHowever, $nshow is being used by the user $nu."
1006 append ol "\n$nshow has identified themselves to me."
1014 set old [nickdb_exists $n]
1015 if {$old} { nick_securitycheck 0 }
1016 switch -exact [string tolower [string trim $text]] {
1018 upvar #0 nick_username($n) nu
1019 if {![info exists nu]} {
1021 "You must identify yourself before using `register'. See `help identify', or use `register insecure'."
1023 nickdb_set $n username $nu
1024 ucmdr {} {} "makes a note of your username." {}
1028 ucmdr {} {} "forgets your nickname." {}
1031 nickdb_set $n username {}
1033 ucmdr {} "Security is now disabled for your nickname !"
1035 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."
1041 proc timeformat_desc {tf} {
1043 ks { return "Times will be displayed in seconds or kiloseconds." }
1044 hms { return "Times will be displayed in hours, minutes, etc." }
1045 default { error "invalid timeformat: $v" }
1049 proc def_setting {opt show_body set_body} {
1050 proc set_show/$opt {} "
1054 if {![string length $set_body]} return
1055 proc set_set/$opt {} "
1062 def_setting timeformat {
1063 set tf [nickdb_get $n timeformat]
1064 return "$tf: [timeformat_desc $tf]"
1066 set tf [string tolower [ta_word]]
1068 set desc [timeformat_desc $tf]
1069 nickdb_set $n timeformat $tf
1073 def_setting security {
1074 set s [nickdb_get $n username]
1075 if {[string length $s]} {
1076 return "Your nick, $n, is controlled by the user $s."
1078 return "Your nick, $n, is not secure."
1085 if {![nickdb_exists $n]} {
1086 ucmdr {} "You are unknown to me and so have no settings. (Use `register'.)"
1088 if {![ta_anymore]} {
1090 foreach proc [lsort [info procs]] {
1091 if {![regexp {^set_show/(.*)$} $proc dummy opt]} continue
1092 lappend ol [format "%-10s %s" $opt [set_show/$opt]]
1094 ucmdr {} [join $ol "\n"]
1097 if {[catch { info body set_show/$opt }]} {
1098 error "no setting $opt"
1100 if {![ta_anymore]} {
1101 ucmdr {} "$opt [set_show/$opt]"
1103 nick_securitycheck 0
1104 if {[catch { info body set_set/$opt }]} {
1105 error "setting $opt cannot be set with `set'"
1112 def_ucmd identpass {
1113 set username [ta_word]
1114 set passmd5 [md5sum "[ta_word]\n"]
1118 upvar #0 nick_onchans($n) onchans
1119 if {![info exists onchans] || ![llength $onchans]} {
1120 ucmdr "You must be on a channel with me to identify yourself." {}
1122 check_username $username
1123 exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
1125 upvar #0 nick_username($n) rec_username
1126 set rec_username $username
1127 ucmdr "Pleased to see you, $username." {}
1131 set target [ta_word]
1133 check_username $target
1136 upvar #0 lastsummon($target) ls
1137 set now [clock seconds]
1138 if {[info exists ls]} {
1139 set interval [expr {$now - $ls}]
1140 if {$interval < 30} {
1142 "Please be patient; $target was summoned only [showinterval $interval]."
1145 regsub {^[^!]*!} $p {} path
1147 exec userv --timeout 3 $target irc-summon $n $path \
1148 [expr {[ischan $dest] ? "$dest" : ""}] \
1151 regsub -all "\n" $rv { / } rv
1154 if {[regexp {^problem (.*)} $rv dummy problem]} {
1155 ucmdr {} "The user `$target' $problem."
1156 } elseif {[regexp {^ok ([^ ]+) ([0-9]+)$} $rv dummy tty idlesince]} {
1157 set idletime [expr {$now - $idlesince}]
1159 ucmdr {} {} {} "invites $target ($tty[expr {
1160 $idletime > 10 ? ", idle for [showintervalsecs $idletime]" : ""
1162 [ischan $dest] ? "join us here" : "talk to you"
1165 error "unexpected response from userv service: $rv"
1169 proc md5sum {value} { exec md5sum << $value }
1172 global lastseen nick
1175 set nlower [irctolower $ncase]
1177 set now [clock seconds]
1178 if {"$nlower" == "[irctolower $nick]"} {
1179 error "I am not self-aware."
1180 } elseif {![info exists lastseen($nlower)]} {
1181 set rstr "I've never seen $ncase."
1183 manyset $lastseen($nlower) realnick time what
1184 set howlong [expr {$now - $time}]
1185 set string [showinterval $howlong]
1186 set rstr "I last saw $realnick $string, $what."
1188 if {[ischan $dest]} {
1193 upvar #0 lookedfor($nlower) lf
1194 if {[info exists lf]} { set oldvalue $lf } else { set oldvalue {} }
1195 set lf [list [list $now $n $where]]
1196 foreach v $oldvalue {
1197 if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
1203 if {![info exists sock]} {
1204 set sock [socket $host $port]
1205 fconfigure $sock -buffering line
1206 #fconfigure $sock -translation binary
1207 fconfigure $sock -translation crlf
1209 sendout USER blight 0 * $ownfullname
1211 fileevent $sock readable onread
1216 #if {![regexp {tclsh} $argv0]} {