Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/archive/mac_HS16/data/tcl/irk/lib/irkconnect.tcl @ 12337

Last change on this file since 12337 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: 5.9 KB
Line 
1# irkconnect.tcl:
2#
3# This file provides the IRK commands to connect to remote servers
4# as well as some attendant utility procedures:
5
6namespace eval ::irk {
7
8    # The "connect" procedure returns a token
9    # for the connection to this server.
10    #
11    # symsrv            The symbolic name of the server to connect to.
12    # nick              The nick name to use.
13    # user              The user name to use.
14    # pass              The password to use.
15    # disp              The command dispatcher expression to use.
16
17    proc connect {{symsrv ""} {nick ""} {user ""} {pass ""} {disp ""}} {
18        variable state
19
20        # Auto initialize the list of connections. We do this so that
21        # the list is not reset each time the irk.tcl file is sourced.
22
23        if {![info exists state(connections)]} {
24            set state(connections) {}
25        }
26
27        # Try to convert the symbolic server name to a
28        # server description. This may throw an error,
29        # we propagate it.
30
31        set servdesc [locate $symsrv]
32
33        # If the nickname is not specified, there must be
34        # a nick setting in the state array; use that
35
36        if {![string compare $nick ""]} {
37            if {![info exists state(-$symsrv,nick)]} {
38                error "No nick given or set in global state"
39            }
40            set nick $state(-$symsrv,nick)
41        }
42
43        # If a global nick is not set, save this nick for use
44        # as a global nick.
45
46        if {![info exists state(-$symsrv,nick)]} {
47            set state(-$symsrv,nick) $nick
48        }
49
50        # If user is not supplied, see if there is a global
51        # user registered in the IRK package state. If not,
52        # invent a user.
53
54        if {![string compare $user ""]} {
55            if {[info exists state(-$symsrv,user)]} {
56                set user $state(-$symsrv,user)
57            } else {
58                set user $nick
59                set state(-$symsrv,user) $user
60            }
61        }
62
63        # If a password is not supplied, see if there is a global
64        # one registered. If so, use that. Otherwise, do not
65        # use a password.
66
67        if {![string compare $pass ""]} {
68            if {[info exists state(-$symsrv,pass)]} {
69                set pass $state(-$symsrv,pass)
70            }
71        }
72
73        # If a dispatcher expression is not supplied, there must be a
74        # global dispatcher expression in the state array, and use that.
75
76        if {![string compare $disp ""]} {
77            if {![info exists state(dispatcher)]} {
78                error "ERROR: o dispatch given or found in global state"
79            }
80            set disp $state(dispatcher)
81        }
82
83        # Try to connect to the given server.
84
85        set h [lindex $servdesc 0]
86        set p [randselect [lindex $servdesc 1]]
87
88        set s [opensocket $h $p]
89
90        # The socket is line buffered and consumed by the
91        # supplied consumer
92
93        fconfigure $s -translation auto -buffering line
94        fileevent $s readable [list ::irk::consumer $s]
95
96
97        # Identify ourselves to the IRK server: If a password is given
98        # send that first. Then send the nick name and user name.
99
100        if {[string compare $pass ""]} {
101            puts $s "PASS $pass"
102        }
103
104        puts $s "NICK $nick"
105        puts $s "USER $user $h $h :$user"
106
107        # Make a connection token:
108
109        set contok [contok $s $symsrv]
110
111        # Save the state for this new connection
112
113        lappend state(connections) $contok
114
115        set state($contok,port) $p
116        set state($contok,host) $h
117        set state($contok,symsrv) $symsrv
118        set state($contok,nick) $nick
119        set state($contok,user) $user
120        set state($contok,pass) $pass
121        set state($contok,disp) $disp
122
123        # Set up some default behavior for the connection:
124
125        setupDefaultActions $contok $nick
126
127        # Collect information about who the server thinks we are
128
129        puts $s "WHOIS $nick"
130
131        # Finally return the token for this connection:
132
133        return $contok
134    }
135
136    # This procedure makes an easy to remember connection token. It takes
137    # the symbolic server's name and appends _<n> to it, where n is an
138    # integer starting at 0 and monotonically increasing for every new
139    # connection to that server.
140    #
141    # Once it figures out what the connection token is going to be,
142    # it associates it with the given socket so it can be used.
143
144    proc contok {sock symsrv} {
145        variable state
146
147        # Compute the symbolic name for this connection:
148
149        if {![info exists state($symsrv,counter)]} {
150            set state($symsrv,counter) 0
151        }
152        set contok ${symsrv}_$state($symsrv,counter)
153        incr state($symsrv,counter)
154
155        # Associate the symbolic name with the socket:
156
157        set state($contok,socket) $sock
158        set state($sock,contok) $contok
159
160        return $contok
161    }
162
163    # The locate procedure tries to convert the symbolic name for
164    # a connection to a server/port specification.
165
166    proc locate {s} {
167        variable symsrv
168        variable state
169
170        # If the caller specified "" as the name of the server, select
171        # a random one from the list of known servers.
172
173        if {![string compare $s ""]} {
174            set s [randselect $state(servers)]
175        }
176
177        # Now see if the requested server exists:
178
179        if {![info exists symsrv($s)]} {
180            error \
181                "Could not find a match for symbolic IRK server name \"$s\""
182        }
183
184        # It does, return the server specification:
185
186        return $symsrv($s)
187    }
188
189    # opensocket connects to the requested server and port, either
190    # directly or through a SOCKS5 proxy.
191
192    proc opensocket {server port} {
193        variable state
194
195        if {[info exists state(-socksproxy)] \
196                && [info exists state(-socksport)]} {
197            set sock [socket $state(-socksproxy) $state(-socksport)]
198            return [::socks::init $sock $server $port]
199        }
200
201        return [socket $server $port]
202    }
203
204    # The disconnect procedure disconnects from a given connection
205    # identified by its symbolic name, and cleans up state associated
206    # with the connection.
207
208    proc disconnect {contok} {
209        variable state
210
211        if {[catch {set s $state($contok,socket)} err]} {
212            error "ERROR: $contok: No such IRC connection"
213        }
214
215        # Send a QUIT message.
216
217        if {[info exists state(quitmsg)]} {
218            set q ":$state($contok,nick) $state(quitmsg)"
219        } else {
220            set q ":$state($contok,nick) quit"
221        }
222        puts $s "QUIT $q"
223
224        # Try to close the connection with the server.
225
226        catch {close $s}
227
228        # And clean up all state associated with this connection:
229
230        array unset state $contok,*
231       
232        # Remove this connection from the list of active connections:
233
234        set i [lsearch $state(connections) $s]
235        set state(connections) [lreplace $state(connections) $i $i]
236
237        return ""
238    }
239}
Note: See TracBrowser for help on using the repository browser.