Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/hudelements/data/tcl/irk/lib/irkreceive.tcl @ 7086

Last change on this file since 7086 was 5781, checked in by rgrieder, 15 years ago

Reverted trunk again. We might want to find a way to delete these revisions again (x3n's changes are still available as diff in the commit mails).

  • Property svn:eol-style set to native
File size: 15.3 KB
Line 
1# irkreceive.tcl:
2#
3# Various commands invoked in response to input received from the server:
4
5namespace eval irk {
6
7    # This procedure deals with the PING special action:
8
9    proc RECV,PING {token nick user comm dest rest} {
10        variable state
11
12        if {[catch {set sock $state($token,socket)}]} {
13            error "$token: not a valid IRK connection"
14        }
15        puts $sock "PONG :$comm $rest"
16
17        return ""
18    }
19
20    # This procedure deals with the NOTICE special action:
21
22    proc RECV,NOTICE {token nick user comm dest rest} {
23        variable state
24
25        append state($token,GLOBALNOTICES) "$rest\n"
26
27        return ""
28    }
29
30
31    # This procedure deals with the ERROR special action:
32
33    proc RECV,ERROR {token nick user comm dest rest} {
34        variable state
35
36        set rest [eval concat $rest]
37        append state($token,ERRORS) "$nick $dest $rest\n"
38#       puts "Got ERROR: $token $nick ---> $dest: $rest"
39        orxonox::execute error "Got ERROR: $token $nick ---> $dest: $rest"
40
41        return ""
42    }
43
44    # This procedure deals with the AWAY response:
45
46    proc RECV,AWAY {token nick user comm dest rest} {
47        set id [lindex $rest 0]
48        set rest [lrange $rest 1 end]
49        set rest [lreplace $rest 0 0 [string range [lindex $rest 0] 1 end]]
50        set rest [eval concat $rest]
51        puts "$id is away: $rest"
52
53        return ""
54    }
55   
56    # This procedure deals with the WHOIS USER message:
57
58    proc RECV,WHOIS,NICK,USER {token nick user comm dest rest} {
59        variable state
60
61        # Split the rest of the line on space:
62
63        foreach {unick uuser uhost ustar urnm} [split $rest " "] break
64
65        # If the WHOIS information is about this user, save it specially:
66
67        if {[isus $token $unick]} {
68            set state($token,uuser)     $uuser
69            set state($token,uhost)     $uhost
70            set state($token,urnm)      $urnm
71        }
72
73        # Save the information for a regular user:
74
75        set state($token,ident,$unick,uuser)    $uuser
76        set state($token,ident,$unick,uhost)    $uhost
77        set state($token,ident,$unick,urnm)     $urnm
78    }
79
80    # This procedure deals with the WHOIS SERVER message:
81
82    proc RECV,WHOIS,NICK,SERVER {token nick user comm dest rest} {
83        variable state
84
85        # Split the rest of the line on space:
86
87        foreach {unick userv} [split $rest " "] break
88
89        # If the WHOIS information is about this user, save it specially:
90
91        if {[isus $token $unick]} {
92            set state($token,userv) $userv
93        }
94
95        # Save the information for a regular user:
96
97        set state($token,ident,$unick,userv) $userv
98    }
99
100    # This procedure deals with the WHOIS IDENT message
101
102    proc RECV,WHOIS,NICK,IDENT {token nick user comm dest rest} {
103        variable state
104
105        # Extract the nick of the user who has identified
106
107        set unick [lindex [split $rest " "] 0]
108
109        # If the WHOIS information is about this user, save it specially:
110
111        if {[isus $token $unick]} {
112            set state($token,ident) 1
113        }
114
115        # Save the information for a regular user:
116
117        set state($token,ident,$unick,ident) 1
118    }   
119
120    # This procedure deals with the WHOIS CONNECTTIME message:
121
122    proc RECV,WHOIS,NICK,CONNECTTIME {token nick user comm dest rest} {
123        variable state
124
125        # Split the rest of the input on space:
126
127        foreach {unick idle connecttime} [split $rest " "] break
128
129        # Format the connect time for this user:
130
131        set connecttime [clock format $connecttime]
132
133        # If the WHOIS information is about this user, save it specially:
134
135        if {[isus $token $unick]} {
136            set state($token,connecttime) $connecttime
137        }
138
139        # Save the information for a regular user:
140
141        set state($token,ident,$unick,connecttime) $connecttime
142    }
143
144    # Handle the WHOIS CHANNELS message:
145
146    proc RECV,WHOIS,NICK,CHANNELS {token nick user comm dest rest} {
147        variable state
148
149        # Split the rest on space.
150
151        set rest [split $rest " "]
152
153        # Get the nick for which this is the channel list:
154
155        set unick [lindex $rest 0]
156        set rest [lrange $rest 1 end]
157
158        # The first channel may have an extra ":", if it does get rid of it.
159
160        set firstchan [lindex $rest 0]
161        if {[string match ":*" $firstchan]} {
162            set rest [lreplace $rest 0 0 [string range $firstchan 1 end]]
163        }
164
165        # If the WHOIS information is about this user, save it specially:
166
167        if {[isus $token $unick]} {
168            set state($token,channels) $channels
169        }
170
171        # Save the information for a regular user:
172
173        set state($token,ident,$unick,channels) $rest
174    }
175
176    # This procedure deals with the WHOIS END message:
177
178    proc RECV,WHOIS,NICK,END {token nick user comm dest rest} {
179        variable state
180
181        set state($token,whois,done) 1
182    }
183
184    # This procedure deals with various MOTD actions:
185
186    proc RECV,MOTD {token nick user comm dest rest} {
187        variable state
188
189        append state($token,MOTD) "${rest}\n"
190
191        return ""
192    }
193
194    # This procedure deals with PONG actions:
195
196    proc RECV,PONG {token nick user comm dest rest} {
197        variable state
198
199        if {[info exists state($token,PINGSTART)]} {
200            set elapsed \
201                [expr [clock clicks -millis] - $state($token,PINGSTART)]
202            puts "$nick: $elapsed msecs"
203            unset state($token,PINGSTART)
204        }
205
206        return ""
207    }
208
209    # This procedure deals with NOTICE received from a regular user:
210
211    proc RECV,NOTICE,USER {token nick user comm dest rest} {
212        if {[string match "\001*" [lindex $rest 0]]} {
213            set rest [ctcpcleanup $rest]
214            RECV,NOTICE,CTCP,USER $token $nick $user $comm $dest \
215                    [lindex $rest 0] [lrange $rest 1 end]
216        } else {
217            set rest [eval concat $rest]
218            puts "$nick sends $dest a notice: $rest"
219        }
220
221        return ""
222    }
223
224    # This procedure helps with CTCP notice actions:
225
226    proc RECV,NOTICE,CTCP,USER {token nick user comm dest action rest} {
227        variable state
228
229        if {[info exists state($token,response,ctcp,$action)]} {
230            $state($token,response,ctcp,$action) \
231                                        $token $nick $user $comm $dest \
232                                        $action $rest
233        } else {
234            $state($token,response,ctcp,error) \
235                                        $token $nick $user $comm $dest \
236                                        $action $rest
237        }
238
239        return ""
240    }
241
242    # This procedure deals with JOIN actions:
243
244    proc RECV,JOIN {token nick user comm dest rest} {
245        variable state
246
247        # Check if it's us that joined the channel or someone else.
248
249        if {[isus $token $nick]} {
250#           puts "You joined $dest"
251          orxonox::irc::info $token "You joined $dest"
252
253            addChannel $token $dest
254        } else {
255#           puts "$nick joined $dest"
256          orxonox::irc::info $token "$nick joined $dest"
257
258            addToChannel $token $nick $dest
259        }
260
261        return ""
262    }
263
264    # This procedure deals with PART actions:
265
266    proc RECV,PART {token nick user comm dest rest} {
267        variable state
268
269        set chan [string tolower $dest]
270
271        if {[isus $token $nick]} {
272#           puts "You left channel $chan"
273          orxonox::irc::info $token "You left channel $chan"
274        } else {
275#           puts "$nick left [string tolower $dest]"
276          orxonox::irc::info $token "$nick left [string tolower $dest]"
277        }           
278        removeFromChannel $token $nick $chan
279        removeFromChannel $token @$nick $chan
280
281        return ""
282    }
283
284    # This procedure deals with MODE actions:
285
286    proc RECV,MODE {token nick user comm dest rest} {
287        set rest [eval concat $rest]
288#       puts "$nick sets mode $dest $rest"
289      orxonox::irc::info "$nick $token sets mode $dest $rest"
290
291        return ""
292    }
293
294    # This procedure deals with NICK actions:
295
296    proc RECV,NICK {token nick user comm dest rest} {
297        variable state
298
299        set newnick [string range $dest 0 end]
300
301        # If our nick changed, remember it as the nick associated with
302        # this connection:
303
304        if {[isus $token $nick]} {
305            set state($token,nick) $newnick
306            set state($token,$newnick,PRIVMSG)  $state(PRIVMSG,unsolicited)
307            catch {unset state($token,$nick,PRIVMSG)}
308        }
309
310        # Replace the old nick with the new in all channels that we're on:
311
312        replaceAllChannels $token $nick $newnick
313
314#       puts "$nick ${user} ($token) changes his/her nickname to $newnick"
315      orxonox::irc::info $token "$nick changes his/her nickname to $newnick"
316
317        return ""
318    }
319
320    # This procedure deals with QUIT actions:
321
322    proc RECV,QUIT {token nick user comm dest rest} {
323        variable state
324
325        set rest [eval concat $rest]
326#       puts "Received QUIT $token $nick $rest"
327      orxonox::irc::info $token "Received QUIT $token $nick $rest"
328
329        if {[string match ":*" $dest]} {
330            set dest [string range $dest 1 end]
331        }
332        if {[isus $token $nick]} {
333#           puts "You left the server $state($token,host) ($dest $rest)"
334          orxonox::irc::info $token "You left the server $state($token,host) ($dest $rest)"
335            forgetConnection $token
336        } else {
337            puts "$nick quits IRK ($dest $rest)"
338            removeFromAllChannels $token $nick
339            removeFromAllChannels $token @$nick
340        }
341
342        return ""
343    }
344
345    # This procedure deals with expected PRIVMSG actions:
346
347    proc RECV,PRIVMSG {token nick user comm dest rest} {
348        if {[string match "\001*" [lindex $rest 0]]} {
349            set rest [ctcpcleanup $rest]
350            RECV,PRIVMSG,CTCP,CHANNEL $token $nick $user $comm $dest \
351                    [lindex $rest 0] [lrange $rest 1 end]
352        } else {
353#           puts "$nick$dest: [eval concat $rest]"
354          orxonox::irc::say $token $nick [eval concat $rest]
355        }
356
357        return ""
358    }
359
360    # This procedure handles CTCP actions on the channel:
361
362    proc RECV,PRIVMSG,CTCP,CHANNEL {token nick user comm dest action rest} {
363        variable state
364
365        if {[info exists state($token,channel,ctcp,$action)]} {
366            $state($token,channel,ctcp,$action) \
367                                        $token $nick $user $comm $dest \
368                                        $action $rest
369        } else {
370            $state($token,channel,ctcp,error) \
371                                        $token $nick $user $comm $dest \
372                                        $action $rest
373        }
374
375        return ""
376    }
377
378    # This procedure stores the result of USERHOST actions:
379
380    proc RECV,USERHOST {token nick user comm dest rest} {
381        return ""
382    }
383
384    # This procedure stores the channel topic:
385
386    proc RECV,CHANNEL,TOPIC {token nick user comm dest rest} {
387        variable state
388
389        set chan [lindex $rest 0]
390        set rest [lrange $rest 1 end]
391        if {[string match ":*" [lindex $rest 0]]} {
392            set rest [lreplace $rest 0 0 \
393                               [string range [lindex $rest 0] 1 end]]
394        }
395        set state($token,$chan,TOPIC) $rest
396        set state($token,$chan,TOPIC,SETBY) $nick
397        set state($token,$chan,TOPIC,SETAT) [clock format [clock seconds]]
398
399        return ""
400    }
401
402    # This procedure stores the channel byline:
403
404    proc RECV,CHANNEL,SETBY {token nick user comm dest rest} {
405        variable state
406
407        set chan [lindex $rest 0]
408        set rest [lrange $rest 1 end]
409        if {[string match ":*" [lindex $rest 0]]} {
410            set rest [lreplace $rest 0 0 \
411                               [string range [lindex $rest 0] 1 end]]
412        }
413        set state($token,$chan,TOPIC,SETBY) [lindex $rest 0]
414        set state($token,$chan,TOPIC,SETAT) [clock format [lindex $rest 1]]
415
416        return ""
417    }
418
419    # This procedure deals with unsolicited PRIVMSG actions:
420
421    proc RECV,PRIVMSG,unsolicited {token nick user comm dest rest} {
422        if {[string match "\001*" [lindex $rest 0]]} {
423            set rest [ctcpcleanup $rest]
424            RECV,PRIVMSG,CTCP,USER $token $nick $user $comm $dest \
425                    [lindex $rest 0] [lrange $rest 1 end]
426        } else {
427#           puts "$nick: [eval concat $rest]"
428          orxonox::irc::privmsg $nick $nick [eval concat $rest]
429        }
430
431        return ""
432    }
433
434    # This procedure helps with CTCP private messages:
435
436    proc RECV,PRIVMSG,CTCP,USER {token nick user comm dest action rest} {
437        variable state
438
439        if {[info exists state($token,cmd,ctcp,$action)]} {
440            $state($token,cmd,ctcp,$action) \
441                                        $token $nick $user $comm $dest \
442                                        $action $rest
443        } else {
444            $state($token,cmd,ctcp,error) \
445                                        $token $nick $user $comm $dest \
446                                        $action $rest
447        }
448
449        return ""
450    }
451
452    # This procedure deals with a KICK action:
453
454    proc RECV,KICK {token nick user comm dest rest} {
455        set kicked [lindex $rest 0]
456        if {[string match ":*" $kicked]} {
457            set kicked [string range $kicked 1 end]
458        }
459        set reason [eval concat [lrange $rest 1 end]]
460        if {[string match ":*" $reason]} {
461            set reason [string range $reason 1 end]
462        }
463
464        if {[isus $token $kicked]} {
465#           puts "$nick kicked you from $dest because $reason"
466          orxonox::irc::info $token "$nick kicked you from $dest because $reason"
467
468            removeChannel $token $dest
469        } else {
470#           puts "$nick kicks $kicked from $dest because $reason"
471          orxonox::irc::info $token "$nick kicks $kicked from $dest because $reason"
472
473            removeFromChannel $token $kicked $dest
474            removeFromChannel $token @$kicked $dest
475        }
476
477        return ""
478    }
479
480    # These procedures collect the name list for a channel:
481
482    proc RECV,CHANNEL,NAMELIST {token nick user comm dest rest} {
483        variable state
484
485        # Scan forward in $rest for the channel name:
486
487        for {set i 0; set l [llength $rest]} {$i < $l} {incr i} {
488            if {[string match "#*" [lindex $rest $i]]} {
489                break
490            }
491        }
492
493        # Didn't find it?
494
495        if {$i == $l} {
496            return
497        }
498
499        # Extract the channel name and the rest of the input:
500
501        set chan [lindex $rest $i]
502        set rest [lrange $rest [expr $i + 1] end]
503        set rest [lreplace $rest 0 0 [string range [lindex $rest 0] 1 end]]
504        set rest [eval concat $rest]
505
506        if {![info exists state($token,$chan,NAMES)]} {
507            set state($token,$chan,NAMES) ""
508        }
509        set state($token,$chan,NAMES) [concat $state($token,$chan,NAMES) $rest]
510
511        return ""
512    }
513
514    proc RECV,CHANNEL,NAMELIST,END {token nick user comm dest rest} {
515        variable state
516
517        set chan [lindex $rest 0]
518        set $state($token,$chan,NAMES) [split $state($token,$chan,NAMES) " "]
519    }
520
521    # This procedure deals with a request from the server to send a PONG
522    # with a given code.
523
524    proc RECV,PONG,REQUEST {token nick user comm dest rest} {
525        set pongcode [lindex $rest [expr [llength $rest] - 1]]
526        puts $token "PONG $pongcode"
527
528        return ""
529    }
530
531    # This procedure deals with a CTCP PING request:
532
533    proc RECV,CTCP,PING {token nick user comm dest action rest} {
534        variable state
535
536        if {[catch {set sock $state($token,socket)}]} {
537            error "$token: not a valid IRK connection"
538        }
539        puts $sock "NOTICE $nick :\001PING ${rest}\001"
540
541        return ""
542    }
543
544    # This procedure deals with a CTCP TIME request:
545
546    proc RECV,CTCP,TIME {token nick user comm dest action rest} {
547        variable state
548
549        if {[catch {set sock $state($token,socket)}]} {
550            error "$token: not a valid IRK connection"
551        }
552        puts $sock \
553            "NOTICE $nick :\001TIME :[clock format [clock seconds]]\001"
554
555        return ""
556    }
557
558    # This procedure deals with a CTCP VERSION request:
559
560    proc RECV,CTCP,VERSION {token nick user comm dest action rest} {
561        variable state
562        global tcl_platform
563
564        if {[catch {set sock $state($token,socket)}]} {
565            error "$token: not a valid IRK connection"
566        }
567        set version "$state(-useragent):$state(-version):$tcl_platform(os)"
568        puts $sock "NOTICE $nick :\001VERSION ${version}\001"
569    }
570
571    # This procedure deals with a CTCP USERINFO request:
572
573    proc RECV,CTCP,USERINFO {token nick user comm dest action rest} {
574        variable state
575
576        if {[catch {set sock $state($token,socket)}]} {
577            error "$token: not a valid IRK connection"
578        }
579        puts $sock "NOTICE $nick :\001USERINFO $state(-$token,user)\001"
580    }
581
582    # This procedure deals with CTCP ACTION messages:
583
584    proc RECV,CTCP,ACTION {token nick user comm dest action rest} {
585#       puts "$nick $rest"
586      orxonox::irc::action $token $nick $rest
587
588        return ""
589    }
590
591    # This procedure is a catch all for CTCP actions that we do not
592    # understand:
593
594    proc RECV,CTCP,ERROR {token nick user comm dest action rest} {
595        variable state
596
597        if {[catch {set sock $state($token,socket)}]} {
598            error "$token: not a valid IRC connection"
599        }
600        if {[llength $rest] > 0} {
601            puts $sock \
602                "NOTICE $nick :\001ERRMSG $action $rest: unknown CTCP\001"
603        } else {
604            puts $sock "NOTICE $nick :\001ERRMSG $action: unknown CTCP\001"
605        }
606    }
607
608    # This is the default action, used by the default dispatcher
609    # when no action can be found for the given $token, $nick, $user,
610    # $comm, and $dest.
611
612    proc defaultAction {token nick user comm dest rest} {
613#       puts "$token: $nick $user: $comm -> $dest ... [eval concat $rest]"
614      orxonox::execute log "$token: $nick $user: $comm -> $dest ... [eval concat $rest]"
615
616        return ""
617    }
618}
Note: See TracBrowser for help on using the repository browser.