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
9 if {![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
18 proc sendout
{command args
} {
20 if {[llength $args]} {
21 set la
[lindex $args end
]
22 set args
[lreplace $args end end
]
24 if {[regexp {[: ]} $i]} {
25 error "bad argument in output $i ($command $args)"
30 set args
[lreplace $args 0 -1 $command]
31 set string [join $args { }]
32 puts "[clock seconds] -> $string"
40 proc logerror
{data
} {
45 global saveei saveec errorInfo errorCode
50 puts ">$saveec|$saveei<"
62 if {[gets $sock line
] == -1} { set terminate
1; return }
63 regsub -all "\[^ -\176\240-\376\]" $line ? line
65 if {[regexp -nocase {^
:([^
]+) (.
*)} $line dummy prefix remain
]} {
67 if {[regexp {^
([^
!]+)!} $prefix dummy maybenick
] &&
68 "[irctolower $maybenick]" == "[irctolower $nick]"} return
72 if {![string length
$line]} { return }
73 if {![regexp -nocase {^
([0-9a-z
]+) *(.
*)} $line dummy command line
]} {
74 log
"bad command: $org"
77 set command
[string toupper
$command]
79 while {[regexp {^
([^
:]+) *(.
*)} $line dummy thisword line
]} {
80 lappend params
$thisword
82 if {[regexp {^
:(.
*)} $line dummy thisword
]} {
83 lappend params
$thisword
84 } elseif
{[string length
$line]} {
85 log
"junk at end: $org"
88 if {"$command" == "PRIVMSG" &&
89 [regexp {^
[&#+!]} [lindex $params 0]] &&
90 ![regexp {^
!} [lindex $params 1]]} {
91 # on-channel message, ignore
93 recordlastseen_p
$prefix "talking on [lindex $params 0]" 1
97 log
"[clock seconds] <- $org"
98 set procname msg_
$command
99 if {[catch { info body
$procname }]} { return }
101 eval [list $procname $prefix $command] $params
103 logerror
"error: $emsg ($prefix $command $params)"
108 proc sendprivmsg
{dest l
} {
109 sendout
[expr {[ischan
$dest] ?
"PRIVMSG" : "NOTICE"}] $dest $l
111 proc sendaction
{dest what
} { sendout PRIVMSG
$dest "\001ACTION $what\001" }
112 proc msendprivmsg
{dest ll
} { foreach l
$ll { sendprivmsg
$dest $l } }
113 proc msendprivmsg_delayed
{delay dest ll
} { after $delay [list msendprivmsg
$dest $ll] }
115 proc prefix_none
{} {
117 if {[string length
$p]} { error "prefix specified" }
120 proc msg_PING
{p c s1
} {
125 proc check_nick
{n
} {
126 if {[regexp -nocase {[^
][\\`_^
{|
}a-z0-9-
]} $n]} { error "bad char in nick" }
127 if {[regexp {^
[-0-9]} $n]} { error "bad nick start" }
131 return [regexp {^
[&#+!]} $dest]
134 proc irctolower
{v
} {
135 foreach {from to
} [list "\\\[" "{" \
139 regsub -all $from $v $to v
141 return [string tolower
$v]
144 proc prefix_nick
{} {
148 if {![regexp {^
([^
!]+)!} $p dummy n
]} { error "not from nick" }
150 if {"[irctolower $n]" == "[irctolower $nick]"} {
151 error "from myself" {} {}
155 proc showintervalsecs
{howlong
} {
156 if {$howlong < 1000} {
159 if {$howlong < 1000000} {
166 set value
[expr "$howlong.0 / $scale"]
167 foreach {min
format} {100 %.0f
10 %.1f
1 %.2f
} {
168 if {$value < $min} continue
169 return [format "$format${pfx}s" $value]
174 proc showinterval
{howlong
} {
178 return "[showintervalsecs $howlong] ago"
182 proc showtime
{when
} {
183 return [showinterval
[expr {[clock seconds
] - $when}]]
186 proc def_msgproc
{name argl body
} {
187 proc msg_
$name "varbase $argl" "\
188 upvar #0 msg/\$varbase/dest d\n\
189 upvar #0 msg/\$varbase/str s\n\
190 upvar #0 msg/\$varbase/accum a\n\
194 def_msgproc begin
{dest str
} {
200 def_msgproc
append {str
} {
202 if {[string length
$s] && [string length
$ns] > 65} {
203 msg__sendout
$varbase
204 set s
" [string trimleft $str]"
210 def_msgproc finish
{} {
211 msg__sendout
$varbase
217 def_msgproc _sendout
{} {
218 lappend a
[string trimright
$s]
222 proc looking_whenwhere
{when where
} {
223 set str
[showtime
[expr {$when-1}]]
224 if {[string length
$where]} { append str
" on $where" }
228 proc recordlastseen_n
{n how here
} {
229 global lastseen lookedfor
230 set lastseen
([irctolower
$n]) [list $n [clock seconds
] $how]
232 upvar #0 lookedfor([irctolower $n]) lf
233 if {[info exists lf
]} {
234 switch -exact [llength $lf] {
239 manyset
[lindex $lf 0] when who where
241 "FYI, $who was looking for you [looking_whenwhere $when $where]."]
244 msg_begin tosend
$n "FYI, people have been looking for you:"
250 msg_append tosend
" "
251 } elseif
{$i == [llength $lf]} {
252 msg_append tosend
" and "
255 msg_append tosend
", "
257 manyset
$e when who where
259 "$who ([looking_whenwhere $when $where])$fin"
261 set ml
[msg_finish tosend
]
265 msendprivmsg_delayed
1000 $n $ml
269 proc recordlastseen_p
{p how here
} {
271 recordlastseen_n
$n $how $here
274 proc chanmode_arg
{} {
276 set rv
[lindex $cm_args 0]
277 set cm_args
[lreplace cm_args
0 0]
281 proc chanmode_o1
{m g p chan
} {
284 set who
[chanmode_arg
]
285 recordlastseen_n
$n "being nice to $who" 1
286 if {"[irctolower $who]" == "[irctolower $nick]"} {
287 sendprivmsg
$n Thanks.
291 proc chanmode_o0
{m g p chan
} {
294 set who
[chanmode_arg
]
295 recordlastseen_p
$p "being mean to $who" 1
296 if {"[irctolower $who]" == "[irctolower $nick]"} {
297 set chandeop
($chan) [list [clock seconds
] $p]
301 proc msg_MODE
{p c dest modelist args
} {
302 if {![ischan
$dest]} return
303 if {[regexp {^
\-(.
+)$} $modelist dummy modelist
]} {
305 } elseif
{[regexp {^
\+(.
+)$} $modelist dummy modelist
]} {
308 error "invalid modelist"
310 foreach m
[split $modelist] {
311 set procname chanmode_
$m$give
312 if {[catch { info body
$procname }]} {
313 recordlastseen_p
$p "fiddling with $dest" 1
315 $procname $m $give $p $dest
320 proc process_kickpart
{chan user
} {
322 if {![ischan
$chan]} { error "not a channel" }
324 upvar #0 nick_onchans($user) oc
325 set lc
[irctolower
$chan]
326 set oc
[grep tc
{"$tc" != "$lc"} $oc]
329 proc msg_KICK
{p c chans users comment
} {
330 set chans
[split $chans ,]
331 set users
[split $users ,]
332 if {[llength $chans] > 1} {
333 foreach chan
$chans user
$users { process_kickpart
$chan $user }
335 foreach user
$users { process_kickpart
[lindex $chans 0] $user }
339 proc msg_KILL
{p c user why
} {
343 set nick_arys
{onchans username
}
345 proc nick_forget
{n
} {
347 foreach ary
$nick_arys {
348 upvar #0 nick_${ary}($n) av
353 proc msg_NICK
{p c newnick
} {
356 recordlastseen_n
$n "changing nicks to $newnick" 0
357 recordlastseen_n
$newnick "changing nicks from $n" 1
358 foreach ary
$nick_arys {
359 upvar #0 nick_${ary}($n) old
360 upvar #0 nick_${ary}($newnick) new
361 if {[info exists new
]} { error "nick collision ?! $ary $n $newnick" }
362 if {[info exists old
]} { set new
$old; unset old
}
366 proc msg_JOIN
{p c chan
} {
368 recordlastseen_n
$n "joining $chan" 1
369 upvar #0 nick_onchans($n) oc
370 lappend oc
[irctolower
$chan]
372 proc msg_PART
{p c chan
} {
374 recordlastseen_n
$n "leaving $chan" 1
375 process_kickpart
$chan $n
377 proc msg_QUIT
{p c why
} {
379 recordlastseen_n
$n "leaving ($why)" 0
383 proc msg_PRIVMSG
{p c dest
text} {
385 if {[ischan
$dest]} {
386 recordlastseen_n
$n "invoking me in $dest" 1
389 recordlastseen_n
$n "talking to me" 1
394 regsub {^
! *} $text {} text
396 set procname ucmd
/[string tolower
$ucmd]
397 if {[catch { info body
$procname }]} {
398 error "unknown command; try help for help"
402 sendprivmsg
$n "error: $rv"
404 manyset
$rv priv_msgs pub_msgs priv_acts pub_acts
405 foreach {td val
} [list $n $priv_msgs $output $pub_msgs] {
406 foreach l
[split $val "\n"] {
410 foreach {td val
} [list $n $priv_acts $output $pub_acts] {
411 foreach l
[split $val "\n"] {
418 proc msg_INVITE
{p c n chan
} {
419 after 1000 [list sendout JOIN
$chan]
422 proc grep
{var predicate
list} {
426 if {[uplevel 1 [list expr $predicate]]} { lappend o
$v }
431 proc msg_353
{p c dest type chan nicklist
} {
432 global names_chans nick_onchans
433 if {![info exists names_chans
]} { set names_chans
{} }
434 set chan
[irctolower
$chan]
435 lappend names_chans
$chan
436 foreach n
[array names nick_onchans
] {
437 upvar #0 nick_onchans($n) oc
438 set oc
[grep tc
{"$tc" != "$chan"} $oc]
440 foreach n
[split $nicklist { }] {
441 regsub {^
[@+]} $n {} n
443 if {![string length
$n]} continue
444 upvar #0 nick_onchans($n) oc
449 proc msg_366
{p c args
} {
450 global names_chans nick_onchans
451 if {[llength names_chans
] > 1} {
452 foreach n
[array names nick_onchans
] {
453 upvar #0 nick_onchans($n) oc
454 set oc
[grep tc
{[lsearch -exact $tc $names_chans] >= 0} $oc]
455 if {![llength $oc]} { nick_forget
$n }
463 if {[string length
$text]} { error "too many parameters" }
468 if {![regexp {^
([^
]+) *(.
*)} $text dummy firstword
text]} {
469 error "too few parameters"
481 proc def_ucmd
{cmdname body
} {
482 proc ucmd
/$cmdname {p dest
} " upvar 1 text text\n$body"
485 proc ucmdr
{priv pub args
} {
486 return -code return [concat [list $priv $pub] $args]
489 proc ucmd_sendhelp
{} {
491 {Commands currently understood
:
492 help get this
list of commands
493 seen
<nick
> ask
after someone
(I'll
tell them you asked
)
494 summon
<username
> invite a logged-on user onto IRC
495 Send commands to me by
/msg
, or say them in channel with
! in front.
} {}
497 # register register your nick (you must auth[*] first)
498 #[*]auth: /blight in ircII, or /msg blight authuser <username> <pass>
501 def_ucmd help
{ ta_nomore
; ucmd_sendhelp
}
503 def_ucmd ?
{ ta_nomore
; ucmd_sendhelp
}
505 proc manyset
{list args
} {
506 foreach val
$list var
$args {
516 [string length
$target] > 8 ||
517 [regexp {[^
-0-9a-z
]} $target] ||
518 ![regexp {^
[a-z
]} $target]
519 } { error "invalid username" }
522 upvar #0 lastsummon($target) ls
523 set now
[clock seconds
]
524 if {[info exists ls
]} {
525 set interval
[expr {$now - $ls}]
526 if {$interval < 30} {
528 "Please be patient; $target was summoned only [showinterval $interval]."
531 regsub {^
[^
!]*!} $p {} path
533 exec userv
--timeout 3 $target irc-summon
$n $path \
534 [expr {[ischan
$dest] ?
"$dest" : ""}] \
537 regsub -all "\n" $rv { / } rv
540 if {[regexp {^problem
(.
*)} $rv dummy problem
]} {
541 ucmdr
{} "The user `$target' $problem."
542 } elseif
{[regexp {^ok
([^
]+) ([0-9]+)$} $rv dummy tty idlesince
]} {
543 set idletime
[expr {$now - $idlesince}]
545 ucmdr
{} {} {} "invites $target ($tty[expr {
546 $idletime > 10 ? ", idle
for [showintervalsecs
$idletime]" : ""
548 [ischan $dest] ? "join us here
" : "talk to you
"
551 error "unexpected response from userv service: $rv"
555 proc md5sum
{value
} { exec md5sum
<< $value }
561 set nlower
[irctolower
$ncase]
563 set now
[clock seconds
]
564 if {"$nlower" == "[irctolower $nick]"} {
565 error "I am not self-aware."
566 } elseif
{![info exists lastseen
($nlower)]} {
567 set rstr
"I've never seen $ncase."
569 manyset
$lastseen($nlower) realnick
time what
570 set howlong
[expr {$now - $time}]
571 set string [showinterval
$howlong]
572 set rstr
"I last saw $realnick $string, $what."
574 if {[ischan
$dest]} {
579 upvar #0 lookedfor($nlower) lf
580 if {[info exists lf
]} { set oldvalue
$lf } else { set oldvalue
{} }
581 set lf
[list [list $now $n $where]]
582 foreach v
$oldvalue {
583 if {"[irctolower [lindex $v 1]]" == "[irctolower $n]"} continue
589 if {![info exists sock
]} {
590 set sock
[socket $host $port]
591 fconfigure $sock -buffering line
592 #fconfigure $sock -translation binary
593 fconfigure $sock -translation crlf
595 sendout USER blight
0 * $ownfullname
597 fileevent $sock readable onread
600 #if {![regexp {tclsh} $argv0]} {