source: trunk/command.lisp @ 120

Last change on this file since 120 was 119, checked in by Erik Huelsmann, 19 years ago

Rename slots with same function in preparation of more DCC implementation:
{server-stream,dcc-stream} -> network-stream.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.0 KB
Line 
1;;;; $Id: command.lisp 119 2006-01-25 20:03:27Z ehuelsmann $
2;;;; $Source$
3
4;;;; See LICENSE for licensing information.
5
6(in-package :irc)
7
8(defgeneric pass (connection password))
9(defgeneric nick (connection new-nickname))
10(defgeneric user- (connection username mode &optional realname))
11(defgeneric oper (connection name password))
12(defgeneric mode (connection nickname mode))
13(defgeneric op (connection channel nickname))
14(defgeneric deop (connection channel nickname))
15(defgeneric voice (connection channel user))
16(defgeneric devoice (connection channel nickname))
17(defgeneric ban (connection channel mask))
18(defgeneric unban (connection channel mask))
19(defgeneric service (connection nickname distribution info))
20(defgeneric quit (connection &optional message))
21(defgeneric squit (connection server comment))
22(defgeneric join (connection channel))
23(defgeneric multi-join (connection channels))
24(defgeneric part (connection channel))
25(defgeneric part-all (connection))
26(defgeneric topic- (connection channel topic))
27(defgeneric names (connection channel &optional target))
28(defgeneric list- (connection &optional channel target))
29(defgeneric invite (connection user channel))
30(defgeneric kick (connection channel user &optional comment))
31(defgeneric privmsg (connection channel message))
32(defgeneric notice (connection target message))
33(defgeneric motd- (connection &optional target))
34(defgeneric lusers (connection &optional mask target))
35(defgeneric version (connection &optional target))
36(defgeneric stats (connection &optional query target))
37(defgeneric links (connection &optional remote-server server-mask))
38(defgeneric time- (connection &optional target))
39(defgeneric trace- (connection &optional target))
40(defgeneric admin (connection &optional target))
41(defgeneric info (connection &optional target))
42(defgeneric servlist (connection &optional mask type))
43(defgeneric squery (connection service-name text))
44(defgeneric who (connection &optional mask o))
45(defgeneric whois (connection mask &optional target))
46(defgeneric whowas (connection nickname &optional count target))
47(defgeneric kill (connection user &optional comment))
48(defgeneric ping (connection server))
49(defgeneric pong (connection server &optional server2))
50(defgeneric error- (connection message))
51(defgeneric away (connection message))
52(defgeneric rehash (connection))
53(defgeneric die (connection))
54(defgeneric restart- (connection))
55(defgeneric summon (connection nickname &optional target channel))
56(defgeneric users- (connection &optional target))
57(defgeneric wallops (connection message))
58(defgeneric userhost (connection nickname))
59(defgeneric ison (connection user))
60(defgeneric ctcp (connection target message))
61(defgeneric ctcp-chat-initiate (connection nickname))
62
63
64(defmethod pass ((connection connection) (password string))
65  "A \"PASS\" command is not required for a client connection to be
66registered, but it MUST precede the latter of the NICK/USER
67combination (for a user connection) or the SERVICE command (for a
68service connection). The RECOMMENDED order for a client to register is
69as follows:
70
71                           1. Pass message
72           2. Nick message                 2. Service message
73           3. User message
74
75Upon success, the client will receive an RPL_WELCOME (for users) or
76RPL_YOURESERVICE (for services) message indicating that the connection
77is now registered and known the to the entire IRC network.  The reply
78message MUST contain the full client identifier upon which it was
79registered."
80  (send-irc-message connection :pass nil password))
81
82(defmethod nick ((connection connection) (new-nickname string))
83  (send-irc-message connection :nick nil new-nickname))
84
85(defmethod user- ((connection connection) (username string)
86                  (mode integer) &optional (realname ""))
87  (send-irc-message connection :user realname username mode "*"))
88
89(defmethod oper ((connection connection) (name string) (password string))
90  (send-irc-message connection :oper nil name password))
91
92(defmethod mode ((connection connection) (nickname string) (mode string))
93  (send-irc-message connection :mode nil nickname mode))
94
95;; utility functions not part of the RFCs
96(defmethod op ((connection connection) (channel string) (nickname string))
97  (send-irc-message connection :mode nil channel "+o" nickname))
98
99(defmethod op ((connection connection) (channel channel) (user user))
100  (op connection (name channel) (nickname user)))
101
102(defmethod deop ((connection connection) (channel string) (nickname string))
103  (send-irc-message connection :mode nil channel "-o" nickname))
104
105(defmethod deop ((connection connection) (channel channel) (user user))
106  (deop connection (name channel) (nickname user)))
107
108(defmethod voice ((connection connection) (channel string) (nickname string))
109  (send-irc-message connection :mode nil channel "+v" nickname))
110
111(defmethod voice ((connection connection) (channel channel) (user user))
112  (voice connection (name channel) (nickname user)))
113
114(defmethod devoice ((connection connection) (channel string) (nickname string))
115  (send-irc-message connection :mode nil channel "-v" nickname))
116
117(defmethod devoice ((connection connection) (channel channel) (user user))
118  (devoice connection (name channel) (nickname user)))
119
120(defmethod ban ((connection connection) (channel string) (mask string))
121  (send-irc-message connection :mode nil channel "+b" mask))
122
123(defmethod ban ((connection connection) (channel channel) (mask string))
124  (ban connection (name channel) mask))
125
126;; unban or deban?
127(defmethod unban ((connection connection) (channel string) (mask string))
128  (send-irc-message connection :mode nil channel "-b" mask))
129
130(defmethod unban ((connection connection) (channel channel) (mask string))
131  (unban connection (name channel) mask))
132
133(defmethod service ((connection connection) (nickname string)
134                    (distribution string) (info string))
135  (send-irc-message connection :service info nickname "*" distribution 0 0 info))
136
137(defmethod quit ((connection connection) &optional (message *default-quit-message*))
138  (remove-all-channels connection)
139  (remove-all-users connection)
140  (unwind-protect
141      (send-irc-message connection :quit message)
142    #+(and sbcl (not sb-thread))
143    (sb-sys:invalidate-descriptor (sb-sys:fd-stream-fd
144                                   (network-stream connection)))
145    (close (network-stream connection))))
146
147(defmethod squit ((connection connection) (server string) (comment string))
148  (send-irc-message connection :squit comment server))
149
150(defmethod join ((connection connection) (channel string))
151  (send-irc-message connection :join nil channel))
152
153(defmethod join ((connection connection) (channel channel))
154  (join connection (name channel)))
155
156;; utility function not part of the RFC
157(defmethod multi-join ((connection connection) (channels list))
158  (dolist (channel channels)
159    (join connection channel)))
160
161(defmethod part ((connection connection) (channel string))
162  (send-irc-message connection :part nil channel))
163
164(defmethod part ((connection connection) (channel channel))
165  (part connection (name channel)))
166
167;; utility function not part of the RFC
168(defmethod part-all ((connection connection))
169  (dolist (channel (channels connection))
170    (part connection (name channel))))
171
172(defmethod topic- ((connection connection) (channel string) (topic string))
173  (send-irc-message connection :topic topic channel))
174
175(defmethod topic- ((connection connection) (channel channel) (topic string))
176  (topic- connection (name channel) topic))
177
178(defmethod names ((connection connection) (channel string)
179                  &optional (target ""))
180  (send-irc-message connection :names nil channel target))
181
182(defmethod names ((connection connection) (channel channel)
183                  &optional (target ""))
184  (names connection (name channel) target))
185
186(defmethod list- ((connection connection) &optional
187                  (channel "") (target ""))
188  (send-irc-message connection :list nil channel target))
189
190(defmethod invite ((connection connection) (nickname string) (channel string))
191  (send-irc-message connection :invite nil nickname channel))
192
193(defmethod invite ((connection connection) (user user) (channel channel))
194  (invite connection (nickname user) (name channel)))
195
196(defmethod kick ((connection connection) (channel string)
197                 (user string) &optional (comment ""))
198  (send-irc-message connection :kick comment channel user))
199
200(defmethod kick ((connection connection) (channel channel)
201                 (user user) &optional (comment ""))
202  (kick connection (name channel) (nickname user) comment))
203
204(defmethod privmsg ((connection connection) (target string) (message string))
205  (send-irc-message connection :privmsg message target))
206
207(defmethod privmsg ((connection connection) (user user) (message string))
208  (privmsg connection (nickname user) message))
209
210(defmethod privmsg ((connection connection) (channel channel) (message string))
211  (privmsg connection (name channel) message))
212
213(defmethod notice ((connection connection) (target string) (message string))
214  (send-irc-message connection :notice message target))
215
216(defmethod notice ((connection connection) (user user) (message string))
217  (notice connection (nickname user) message))
218
219(defmethod notice ((connection connection) (channel channel) (message string))
220  (notice connection (name channel) message))
221
222(defmethod motd- ((connection connection) &optional (target ""))
223  (send-irc-message connection :motd nil target))
224
225(defmethod lusers ((connection connection) &optional (mask "") (target ""))
226  (send-irc-message connection :lusers nil mask target))
227
228(defmethod version ((connection connection) &optional (target ""))
229  (send-irc-message connection :version nil target))
230
231(defmethod stats ((connection connection) &optional (query "") (target ""))
232  (send-irc-message connection :stats nil query target))
233
234(defmethod links ((connection connection) &optional (remote-server "")
235                  (server-mask ""))
236  (send-irc-message connection :links nil remote-server server-mask))
237
238(defmethod time- ((connection connection) &optional (target ""))
239  (send-irc-message connection :time nil target))
240
241(defun connect (&key (nickname *default-nickname*)
242                     (username nil)
243                     (realname nil)
244                     (password nil)
245                     (mode 0)
246                     (server *default-irc-server*)
247                     (port *default-irc-server-port*)
248                     (connection-type 'connection)
249                     (logging-stream t))
250  "Connect to server and return a connection object."
251  (let* ((stream (socket-connect server port))
252         (connection (make-connection :connection-type connection-type
253                                      :network-stream stream
254                                      :client-stream logging-stream
255                                      :server-name server))
256         (user (make-user connection
257                          :nickname nickname
258                          :username username
259                          :realname realname)))
260    (setf (user connection) user)
261    (unless (null password)
262      (pass connection password))
263    (nick connection nickname)
264    (user- connection (or username nickname) mode (or realname nickname))
265    (add-default-hooks connection)
266    connection))
267
268(defmethod trace- ((connection connection) &optional (target ""))
269  (send-irc-message connection :trace nil target))
270
271(defmethod admin ((connection connection) &optional (target ""))
272  (send-irc-message connection :admin nil target))
273
274(defmethod info ((connection connection) &optional (target ""))
275  (send-irc-message connection :info nil target))
276
277(defmethod servlist ((connection connection) &optional (mask "") (type ""))
278  (send-irc-message connection :servlist nil mask type))
279
280(defmethod squery ((connection connection) (service-name string) (text string))
281  (send-irc-message connection :squery text service-name))
282
283(defmethod who ((connection connection) &optional (mask "") (o ""))
284  (send-irc-message connection :who nil mask o))
285
286(defmethod whois ((connection connection) (mask string) &optional (target ""))
287  (send-irc-message connection :whois nil target mask))
288
289(defmethod whowas ((connection connection) (nickname string)
290                   &optional (count "") (target ""))
291  (send-irc-message connection :whowas nil nickname count target))
292
293(defmethod kill ((connection connection) (nickname string) &optional (comment ""))
294  (send-irc-message connection :kill comment nickname))
295
296(defmethod kill ((connection connection) (user user) &optional (comment ""))
297  (kill connection (nickname user) comment))
298
299(defmethod ping ((connection connection) (server string))
300  (send-irc-message connection :ping nil server))
301
302(defmethod pong ((connection connection) (server string) &optional (server2 ""))
303  (send-irc-message connection :pong nil server server2))
304
305(defmethod error- ((connection connection) (message string))
306  (send-irc-message connection :error message))
307
308(defmethod away ((connection connection) (message string))
309  (send-irc-message connection :away message))
310
311(defmethod rehash ((connection connection))
312  (send-irc-message connection :rehash))
313
314(defmethod die ((connection connection))
315  (send-irc-message connection :die))
316
317(defmethod restart- ((connection connection))
318  (send-irc-message connection :restart))
319
320(defmethod summon ((connection connection) (nickname string)
321                   &optional (target "") (channel ""))
322  (send-irc-message connection :summon nil nickname target channel))
323
324(defmethod users- ((connection connection) &optional (target ""))
325  (send-irc-message connection :users nil target))
326
327(defmethod wallops ((connection connection) (message string))
328  (send-irc-message connection :wallops message))
329
330(defmethod userhost ((connection connection) (nickname string))
331  (send-irc-message connection :userhost nil nickname))
332
333(defmethod userhost ((connection connection) (user user))
334  (userhost connection (nickname user)))
335
336(defmethod ison ((connection connection) (nickname string))
337  (send-irc-message connection :ison nil nickname))
338
339(defmethod ison ((connection connection) (user user))
340  (ison connection (nickname user)))
341
342;; utility functions not part of the RFC
343(defmethod ctcp ((connection connection) target message)
344  (send-irc-message connection :privmsg (make-ctcp-message message) target))
345
346#|
347There's too much wrong with this method to fix it now.
348
349(defmethod ctcp-chat-initiate ((connection connection) (nickname string))
350  #+sbcl
351  (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp))
352        (port 44347))
353    (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port) ; arbitrary port
354    (sb-bsd-sockets:socket-listen socket 1) ; accept one connection
355    (ctcp connection nickname
356          (format nil "DCC CHAT chat ~A ~A"
357                                        ; the use of hostname here is incorrect (it could be a firewall's IP)
358                  (host-byte-order (hostname (user connection))) port))
359    (make-dcc-connection :user (find-user connection nickname)
360                         :input-stream t
361                         :output-stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none)
362                         :socket socket))
363  #-sbcl (warn "ctcp-chat-initiate is not supported on this implementation.")
364  )
365|#
Note: See TracBrowser for help on using the repository browser.