Commit | Line | Data |
---|---|---|
dfa6197c FT |
1 | ;;;; COMMON-NET -- Abstract networking library |
2 | ||
3 | (eval-when (:compile-toplevel :load-toplevel :execute) | |
4 | (unless (find-package :common-net) | |
5 | (defpackage :common-net | |
6 | (:nicknames :net) | |
7 | (:use :cl)))) | |
8 | (in-package :common-net) | |
9 | ||
10 | ;;; General declarations | |
11 | ||
dfa6197c | 12 | (defclass address () ()) |
dfa6197c FT |
13 | (defclass host-address (address) ()) |
14 | ||
15 | (defclass inet-address (address) ()) | |
dfa6197c FT |
16 | (defclass inet-host-address (inet-address host-address) ()) |
17 | ||
18 | (defgeneric format-address (address)) | |
b5018cad | 19 | (defgeneric connected-address-p (address)) |
dfa6197c FT |
20 | (defgeneric connect-to-address (target &key local)) |
21 | (defgeneric bind-to-address (address)) | |
22 | (defgeneric close-socket (socket)) | |
23 | (defgeneric socket-open-p (socket)) | |
24 | (defgeneric socket-local-address (socket)) | |
25 | (defgeneric socket-remote-address (socket)) | |
26 | ||
27 | (defclass socket () ()) | |
28 | (defclass listen-socket (socket) ()) | |
29 | (defclass stream-socket (socket) ; Gray stream superclasses are added for implementations that support it. | |
30 | ((mode :initform :byte) | |
31 | (byte-buffer :initform (make-array '(16) :element-type '(unsigned-byte 8) :adjustable t) | |
32 | :type (array (unsigned-byte 8))) | |
33 | (byte-read-pos :initform 0 :type integer) | |
34 | (byte-write-pos :initform 0 :type integer) | |
35 | (char-buffer :initform (make-array '(16) :element-type 'character :adjustable t :fill-pointer 0) | |
36 | :type (array character)) | |
37 | (char-read-pos :initform 0 :type integer) | |
38 | encoder decoder)) | |
39 | (defclass datagram-socket (socket) ()) | |
40 | ||
41 | (defgeneric accept (socket)) | |
42 | (defgeneric socket-send (socket data &key start end no-hang)) | |
43 | (defgeneric socket-send-to (socket data dest &key start end from no-hang)) | |
44 | (defgeneric socket-recv-into (socket buf &key start end no-hang)) | |
45 | (defgeneric socket-recv (socket &key no-hang max-len)) | |
46 | ||
47 | (defgeneric stream-socket-mode (socket)) | |
48 | (defgeneric stream-socket-decode-characters (socket charset)) | |
49 | ||
50 | (defmethod socket-recv ((socket socket) &key no-hang (max-len 65536)) | |
51 | (let ((buf (make-array (list max-len) :element-type '(unsigned-byte 8)))) | |
52 | (multiple-value-bind (len from to) | |
53 | (socket-recv-into socket buf :no-hang no-hang) | |
54 | (if (null len) | |
55 | (values nil nil nil) | |
56 | (values (subseq buf 0 len) from to))))) | |
57 | ||
dfa6197c FT |
58 | (defmethod print-object ((address address) stream) |
59 | (if *print-escape* | |
60 | (format stream "#<~S ~A>" (class-name (class-of address)) (format-address address)) | |
61 | (princ (format-address address) stream)) | |
62 | address) | |
63 | ||
b5018cad FT |
64 | (defmethod connected-address-p ((address inet-host-address)) |
65 | nil) | |
66 | ||
dfa6197c | 67 | (export '(address host-address inet-address inet-host-address |
bdc87fbb | 68 | format-address |
dfa6197c FT |
69 | connect-to-address bind-to-address close-socket |
70 | socket-local-address socket-remote-address | |
71 | accept socket-send socket-send-to socket-recv-into socket-recv)) | |
72 | ||
dfa6197c FT |
73 | (defmethod stream-socket-mode ((socket stream-socket)) |
74 | (slot-value socket 'mode)) | |
75 | ||
76 | (defmethod stream-socket-decode-characters ((socket stream-socket) charset) | |
77 | (unless (eq (stream-socket-mode socket) :byte) | |
78 | (simple-socket-error socket "~S is already in character-decoding mode." socket)) | |
79 | (setf (slot-value socket 'encoder) (charcode:make-encoder charset) | |
80 | (slot-value socket 'decoder) (charcode:make-decoder charset) | |
81 | (slot-value socket 'mode) :character)) | |
82 | ||
83 | ;;; Utility macros | |
84 | ||
85 | (defmacro with-open-socket ((var socket) &body body) | |
86 | (let ((sk (gensym))) | |
87 | `(let* ((,sk ,socket) | |
88 | (,var ,sk)) | |
89 | (unwind-protect (locally ,@body) | |
90 | (close-socket ,sk))))) | |
91 | ||
92 | (defmacro with-connection ((var target &key local charset) &body body) | |
93 | `(with-open-socket (,var (connect-to-address ,target :local ,local)) | |
94 | ,@(when charset (list `(stream-socket-decode-characters ,var ,charset))) | |
95 | ,@body)) | |
96 | ||
97 | (defmacro with-bound-socket ((var address) &body body) | |
98 | `(with-open-socket (,var (bind-to-address ,address)) | |
99 | ,@body)) | |
100 | ||
101 | (export '(with-open-socket with-connection with-bound-socket)) | |
102 | ||
103 | ;;; Common condition types | |
104 | ||
105 | (define-condition socket-condition (condition) | |
106 | ((socket :initarg :socket :type socket))) | |
107 | ||
b5018cad FT |
108 | (define-condition network-error (error) ()) |
109 | ||
d1cf3c66 FT |
110 | (define-condition simple-network-error (network-error simple-error) ()) |
111 | ||
112 | (defun simple-network-error (format &rest args) | |
113 | (error 'simple-network-error :format-control format :format-arguments args)) | |
114 | ||
b5018cad FT |
115 | (define-condition socket-error (socket-condition network-error) ()) |
116 | ||
117 | (define-condition address-busy (network-error) | |
dfa6197c FT |
118 | ((address :initarg :address :type address)) |
119 | (:report (lambda (c s) | |
120 | (format s "The address ~A is busy." (format-address (slot-value c 'address)))))) | |
121 | ||
b5018cad | 122 | (define-condition connection-refused (network-error) |
dfa6197c FT |
123 | ((address :initarg :address :type address)) |
124 | (:report (lambda (c s) | |
125 | (format s "Connection to ~A was refused by the remote host." (format-address (slot-value c 'address)))))) | |
126 | ||
b5018cad | 127 | (define-condition socket-closed (socket-error) () |
dfa6197c FT |
128 | (:report (lambda (c s) |
129 | (format s "The socket ~S is closed." (slot-value c 'socket))))) | |
130 | ||
131 | (define-condition socket-disconnected (socket-closed) () | |
132 | (:report (lambda (c s) | |
133 | (format s "The socket ~S has been closed from the other side." (slot-value c 'socket))))) | |
134 | ||
b5018cad | 135 | (define-condition simple-socket-error (simple-error socket-error) ()) |
dfa6197c FT |
136 | |
137 | (defun simple-socket-error (socket format &rest args) | |
138 | (error 'simple-socket-error :socket socket :format-control format :format-arguments args)) | |
139 | ||
b5018cad FT |
140 | (export '(socket-condition network-error socket-error |
141 | address-busy connection-refused | |
142 | socket-closed socket-disconnected simple-socket-error)) | |
143 | ||
dfa6197c FT |
144 | ;;; Gray stream implementation for stream sockets |
145 | ||
b5018cad | 146 | (define-condition stream-mode-error (socket-error stream-error) |
dfa6197c FT |
147 | ((expected-mode :initarg :expected-mode)) |
148 | (:report (lambda (c s) | |
149 | (with-slots (expected-mode socket) c | |
150 | (format s "Tried to use ~S in ~A mode, but it is in ~A mode." socket expected-mode (stream-socket-mode socket)))))) | |
151 | ||
152 | (defun gray-stream-element-type (socket) | |
153 | (declare (type stream-socket socket)) | |
154 | (ecase (slot-value socket 'mode) | |
155 | ((:byte) '(unsigned-byte 8)) | |
156 | ((:character) 'character))) | |
157 | ||
158 | (defun gray-open-stream-p (socket) | |
159 | (declare (type stream-socket socket)) | |
160 | (socket-open-p socket)) | |
161 | ||
162 | (defun fill-byte-buffer (socket bytes &optional no-hang) | |
163 | (declare (type stream-socket socket) | |
164 | (type fixnum bytes)) | |
165 | (with-slots (byte-buffer byte-read-pos byte-write-pos) socket | |
166 | (loop (unless (< (- byte-write-pos byte-read-pos) bytes) (return t)) | |
167 | (when (< (- (length byte-buffer) byte-read-pos) bytes) | |
168 | (adjust-array byte-buffer (list (+ byte-read-pos bytes 128)))) | |
169 | (let ((recv-len (socket-recv-into socket byte-buffer :start byte-write-pos :no-hang no-hang))) | |
170 | (cond ((null recv-len) | |
171 | (unless no-hang | |
172 | (error "~S returned NIL even when called blocking." 'socket-recv-into)) | |
173 | (return :wait)) | |
174 | ((= recv-len 0) | |
175 | (return nil))) | |
176 | (incf byte-write-pos recv-len))))) | |
177 | ||
178 | (defun trim-byte-buffer (socket) | |
179 | (declare (type stream-socket socket)) | |
180 | (with-slots (byte-buffer byte-read-pos byte-write-pos) socket | |
181 | (replace byte-buffer byte-buffer :start2 byte-read-pos :end2 byte-write-pos) | |
182 | (decf byte-write-pos byte-read-pos) | |
183 | (setf byte-read-pos 0) | |
184 | (when (> (length byte-buffer) (* byte-write-pos 2)) | |
185 | (adjust-array byte-buffer (list byte-write-pos))))) | |
186 | ||
187 | (defun gray-stream-read-byte (socket) | |
188 | (declare (type stream-socket socket)) | |
189 | (unless (fill-byte-buffer socket 1) | |
190 | (return-from gray-stream-read-byte :eof)) | |
191 | (unless (eq (stream-socket-mode socket) :byte) | |
192 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :byte)) | |
193 | (with-slots (byte-buffer byte-read-pos) socket | |
194 | (prog1 (aref byte-buffer byte-read-pos) | |
195 | (when (> (incf byte-read-pos) 128) | |
196 | (trim-byte-buffer socket))))) | |
197 | ||
198 | (defun gray-stream-write-byte (socket byte) | |
199 | (declare (type stream-socket socket)) | |
200 | (unless (eq (stream-socket-mode socket) :byte) | |
201 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :byte)) | |
202 | (let ((buf (make-array '(1) :element-type '(unsigned-byte 8) :initial-element byte))) | |
203 | (loop (when (> (socket-send socket buf) 0) | |
204 | (return))))) | |
205 | ||
206 | (defun fill-char-buffer (socket chars &optional no-hang) | |
207 | (declare (type stream-socket socket)) | |
208 | (unless (eq (stream-socket-mode socket) :character) | |
209 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
210 | (with-slots (decoder byte-buffer byte-read-pos byte-write-pos char-buffer char-read-pos) socket | |
211 | (loop (unless (< (- (length char-buffer) char-read-pos) chars) (return t)) | |
212 | (case (fill-byte-buffer socket chars no-hang) | |
213 | ((nil) (return nil)) | |
214 | ((:wait) (return :wait))) | |
215 | (funcall decoder byte-buffer char-buffer :start byte-read-pos :end byte-write-pos) | |
216 | (setf byte-read-pos 0 | |
217 | byte-write-pos 0)))) | |
218 | ||
219 | (defun trim-char-buffer (socket) | |
220 | (declare (type stream-socket socket)) | |
221 | (with-slots (char-buffer char-read-pos) socket | |
222 | (replace char-buffer char-buffer :start2 char-read-pos) | |
223 | (decf (fill-pointer char-buffer) char-read-pos) | |
224 | (setf char-read-pos 0))) | |
225 | ||
226 | (defun gray-stream-read-char (socket) | |
227 | (declare (type stream-socket socket)) | |
228 | (unless (eq (stream-socket-mode socket) :character) | |
229 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
230 | (unless (fill-char-buffer socket 1) | |
231 | (return-from gray-stream-read-char :eof)) | |
232 | (with-slots (char-buffer char-read-pos) socket | |
233 | (prog1 (aref char-buffer char-read-pos) | |
234 | (when (>= (incf char-read-pos) 64) | |
235 | (trim-char-buffer socket))))) | |
236 | ||
237 | (defun gray-stream-unread-char (socket char) | |
238 | (declare (type stream-socket socket)) | |
239 | (unless (eq (stream-socket-mode socket) :character) | |
240 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
241 | (with-slots (char-buffer char-read-pos) socket | |
242 | (when (= char-read-pos 0) | |
243 | (let ((len (length char-buffer))) | |
244 | (when (< (array-dimension char-buffer 0) (+ len 16)) | |
245 | (adjust-array char-buffer (list (setf (fill-pointer char-buffer) (+ len 16))))) | |
246 | (replace char-buffer char-buffer :start1 16 :end2 len))) | |
247 | (setf (aref char-buffer (decf char-read-pos)) char) | |
248 | nil)) | |
249 | ||
250 | (defun gray-stream-read-char-no-hang (socket) | |
251 | (declare (type stream-socket socket)) | |
252 | (unless (eq (stream-socket-mode socket) :character) | |
253 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
46ab5dc9 | 254 | (case (fill-char-buffer socket 1 t) |
dfa6197c FT |
255 | ((nil) (return-from gray-stream-read-char-no-hang :eof)) |
256 | ((:wait) (return-from gray-stream-read-char-no-hang nil))) | |
257 | (with-slots (char-buffer char-read-pos) socket | |
258 | (prog1 (aref char-buffer char-read-pos) | |
259 | (when (>= (incf char-read-pos) 64) | |
260 | (trim-char-buffer socket))))) | |
261 | ||
262 | (defun gray-stream-peek-char (socket) | |
263 | (declare (type stream-socket socket)) | |
264 | (unless (eq (stream-socket-mode socket) :character) | |
265 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
266 | (unless (fill-char-buffer socket 1) | |
267 | (return-from gray-stream-peek-char :eof)) | |
268 | (with-slots (char-buffer char-read-pos) socket | |
269 | (aref char-buffer char-read-pos))) | |
270 | ||
271 | (defun gray-stream-listen (socket) | |
272 | (declare (type stream-socket socket)) | |
273 | (unless (eq (stream-socket-mode socket) :character) | |
274 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
275 | (case (fill-char-buffer socket 1) | |
276 | ((nil :wait) (return-from gray-stream-listen nil))) | |
277 | (with-slots (char-buffer char-read-pos) socket | |
278 | (aref char-buffer char-read-pos))) | |
279 | ||
280 | (defun gray-stream-write-char (socket char) | |
281 | (declare (type stream-socket socket)) | |
282 | (unless (eq (stream-socket-mode socket) :character) | |
283 | (error 'stream-mode-error :stream socket :socket socket :expected-mode :character)) | |
284 | (with-slots (encoder) socket | |
285 | (let ((seq (make-array '(1) :element-type 'character :initial-element char)) | |
286 | (outbuf (make-array '(16) :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0))) | |
287 | (funcall encoder seq outbuf) | |
288 | (let ((pos 0)) | |
289 | (loop (unless (< pos (length outbuf)) (return)) | |
290 | (incf pos (socket-send socket outbuf :start pos))))))) | |
291 | ||
292 | (defun gray-stream-read-sequence (socket seq start end) | |
293 | (declare (type stream-socket socket)) | |
294 | (ecase (stream-socket-mode socket) | |
295 | ((:byte) | |
296 | (fill-byte-buffer socket (- end start)) | |
297 | (with-slots (byte-buffer byte-read-pos byte-write-pos) socket | |
298 | (replace seq byte-buffer :start1 start :start2 byte-read-pos :end1 end :end2 byte-write-pos) | |
299 | (let ((len (min (- end start) (- byte-write-pos byte-read-pos)))) | |
300 | (when (> (incf byte-read-pos len) 128) | |
301 | (trim-byte-buffer socket)) | |
302 | (+ start len)))) | |
303 | ((:character) | |
304 | (fill-char-buffer socket (- end start)) | |
305 | (with-slots (char-buffer char-read-pos) socket | |
306 | (replace seq char-buffer :start1 start :start2 char-read-pos :end1 end :end2 (length char-buffer)) | |
307 | (let ((len (min (- end start) (- (length char-buffer) char-read-pos)))) | |
308 | (when (> (incf char-read-pos len) 128) | |
309 | (trim-char-buffer socket)) | |
310 | (+ start len)))))) | |
311 | ||
312 | (defmethod gray-stream-write-sequence (socket seq start end) | |
313 | (declare (type stream-socket socket)) | |
314 | (let ((end (or end (length seq)))) | |
315 | (ecase (stream-socket-mode socket) | |
316 | ((:byte) | |
317 | (loop (unless (< start end) (return seq)) | |
318 | (incf start (socket-send socket seq :start start :end end)))) | |
319 | ((:character) | |
320 | (with-slots (encoder) socket | |
321 | (let ((outbuf (make-array (list (- end start)) :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)) | |
322 | (pos 0)) | |
323 | (funcall encoder seq outbuf :start start :end end) | |
324 | (loop (unless (< pos (length outbuf)) (return seq)) | |
325 | (incf pos (socket-send socket outbuf :start pos))))))))) | |
326 | ||
327 | ;;; IPv4 addresses | |
328 | ||
b5018cad FT |
329 | (defclass ipv4-address (inet-address) |
330 | ((host-bytes :type (array (unsigned-byte 8) 4)))) | |
dfa6197c | 331 | |
b5018cad | 332 | (defclass ipv4-host-address (ipv4-address inet-host-address) ()) |
dfa6197c | 333 | |
b5018cad | 334 | (defun parse-dotted-quad (string) |
dfa6197c FT |
335 | (let ((o 0) |
336 | (start 0) | |
337 | (string (concatenate 'string string ".")) | |
338 | (buf (make-array '(4) :element-type '(unsigned-byte 8)))) | |
339 | (dotimes (i (length string)) | |
340 | (let ((ch (elt string i))) | |
341 | (cond ((eql ch #\.) | |
342 | (if (< o 4) | |
343 | (progn (setf (aref buf o) (let ((n (parse-integer string :start start :end i))) | |
344 | (if (and n (<= 0 n 255)) | |
345 | n | |
b5018cad | 346 | (error "IPv4 dotted-quad numbers must be octets")))) |
dfa6197c FT |
347 | (setf start (1+ i)) |
348 | (incf o)) | |
349 | (error "Too many octets in IPv4 address"))) | |
350 | ((char<= #\0 ch #\9) | |
351 | nil) | |
352 | (t (error "Invalid character ~S in IPv4 address" ch))))) | |
353 | (if (< o 4) | |
354 | (error "Too few octets in IPv4 address") | |
b5018cad FT |
355 | buf))) |
356 | ||
cc4296f0 | 357 | (defmethod initialize-instance :after ((instance ipv4-address) &key host-bytes host-string host-address) |
b5018cad | 358 | (let ((octets (or host-bytes |
cc4296f0 FT |
359 | (when host-address |
360 | (check-type host-address ipv4-address) | |
361 | (slot-value host-address 'host-bytes)) | |
b5018cad FT |
362 | (when host-string (parse-dotted-quad host-string)) |
363 | '(0 0 0 0)))) | |
364 | (assert (and (typep octets 'sequence) | |
365 | (= (length octets) 4) | |
366 | (every #'(lambda (o) (typep o '(unsigned-byte 8))) octets)) | |
367 | (octets)) | |
368 | (setf (slot-value instance 'host-bytes) | |
369 | (make-array '(4) | |
370 | :element-type '(unsigned-byte 8) | |
371 | :initial-contents octets)))) | |
372 | ||
373 | (defun parse-ipv4-host-address (string) | |
374 | (make-instance 'ipv4-host-address :host-string string)) | |
dfa6197c | 375 | |
dfa6197c | 376 | (defmethod format-address ((address ipv4-address)) |
b5018cad | 377 | (with-slots (host-bytes) address |
dfa6197c | 378 | (format nil "~D.~D.~D.~D" |
b5018cad FT |
379 | (aref host-bytes 0) |
380 | (aref host-bytes 1) | |
381 | (aref host-bytes 2) | |
382 | (aref host-bytes 3)))) | |
dfa6197c | 383 | |
cc4296f0 FT |
384 | (defparameter *ipv4-localhost* (make-instance 'ipv4-host-address :host-bytes '(127 0 0 1))) |
385 | ||
386 | (export '(ipv4-address ipv4-host-address make-ipv4-address parse-ipv4-address *ipv4-localhost*)) | |
dfa6197c FT |
387 | |
388 | ;;; IPv6 addresses | |
389 | ||
b5018cad FT |
390 | (defclass ipv6-address (inet-address) |
391 | ((host-bytes :initarg :bytes :type (array (unsigned-byte 8) 16)))) | |
dfa6197c | 392 | |
b5018cad FT |
393 | (defclass ipv6-host-address (ipv6-address inet-host-address) ()) |
394 | ||
395 | (defun parse-ipv6-string (string) | |
dfa6197c FT |
396 | (declare (ignore string)) |
397 | (error "IPv6 parsing not implemented yet")) | |
398 | ||
cc4296f0 | 399 | (defmethod initialize-instance :after ((instance ipv6-address) &key host-bytes host-string host-address) |
b5018cad | 400 | (let ((octets (or host-bytes |
cc4296f0 FT |
401 | (when host-address |
402 | (check-type host-address ipv6-address) | |
403 | (slot-value host-address 'host-bytes)) | |
b5018cad FT |
404 | (when host-string (parse-ipv6-string host-string)) |
405 | '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))) | |
406 | (assert (and (typep octets 'sequence) | |
407 | (= (length octets) 16) | |
408 | (every #'(lambda (o) (typep o '(unsigned-byte 8))) octets)) | |
409 | (octets)) | |
410 | (setf (slot-value instance 'host-bytes) | |
411 | (make-array '(16) | |
412 | :element-type '(unsigned-byte 8) | |
413 | :initial-contents octets)))) | |
414 | ||
415 | (defun parse-ipv6-host-address (string) | |
416 | (make-instance 'ipv6-host-address :host-string string)) | |
417 | ||
cc4296f0 FT |
418 | (defparameter *ipv6-localhost* (make-instance 'ipv6-host-address :host-bytes '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1))) |
419 | ||
420 | (export '(ipv6-address ipv6-host-address parse-ipv6-address *ipv6-localhost*)) | |
dfa6197c FT |
421 | |
422 | ;;; TCP code | |
423 | ||
424 | (defclass inet-port-address (inet-address) | |
b5018cad FT |
425 | ((port :initarg :port :type (unsigned-byte 16)))) |
426 | ||
427 | (defmethod format-address ((address inet-port-address)) | |
428 | (with-slots (port) address | |
429 | (format nil "~A:~D" (call-next-method) port))) | |
dfa6197c FT |
430 | |
431 | (defclass tcp-address (inet-port-address) ()) | |
b5018cad FT |
432 | (defclass tcp4-address (tcp-address ipv4-address) ()) |
433 | (defclass tcp6-address (tcp-address ipv6-address) ()) | |
dfa6197c | 434 | |
b5018cad FT |
435 | (defmethod connected-address-p ((address tcp-address)) t) |
436 | ||
816e0c9b FT |
437 | (defun tcp-address-for (host-address port) |
438 | (check-type port (unsigned-byte 16)) | |
439 | (etypecase host-address | |
440 | (ipv4-address (make-instance 'tcp4-address :host-address host-address :port port)) | |
441 | (ipv6-address (make-instance 'tcp6-address :host-address host-address :port port)))) | |
442 | ||
443 | (export '(tcp-address tcp4-address tcp6-address tcp-address-for)) | |
dfa6197c FT |
444 | |
445 | ;;; UDP code | |
446 | ||
447 | (defclass udp-address (inet-port-address) ()) | |
b5018cad FT |
448 | (defclass udp4-address (udp-address ipv4-address) ()) |
449 | (defclass udp6-address (udp-address ipv6-address) ()) | |
dfa6197c | 450 | |
b5018cad | 451 | (defmethod connected-address-p ((address tcp-address)) nil) |
dfa6197c | 452 | |
816e0c9b FT |
453 | (defun udp-address-for (host-address port) |
454 | (check-type port (unsigned-byte 16)) | |
455 | (etypecase host-address | |
456 | (ipv4-address (make-instance 'udp4-address :host-address host-address :port port)) | |
457 | (ipv6-address (make-instance 'udp6-address :host-address host-address :port port)))) | |
458 | ||
459 | (export '(udp-address udp4-address udp6-address udp-address-for)) | |
dfa6197c FT |
460 | |
461 | ;;; Unix sockets | |
462 | ||
463 | (defclass local-address (address) | |
145f3cee | 464 | ((path :type (or pathname nil)))) |
b5018cad FT |
465 | |
466 | (defmethod initialize-instance :after ((instance local-address) &key path) | |
145f3cee | 467 | (setf (slot-value instance 'path) (and path (pathname path)))) |
dfa6197c FT |
468 | |
469 | (defmethod format-address ((address local-address)) | |
145f3cee FT |
470 | (let ((path (slot-value address 'path))) |
471 | (and path (namestring path)))) | |
dfa6197c FT |
472 | |
473 | (defclass local-stream-address (local-address) ()) | |
474 | (defclass local-seq-address (local-address) ()) | |
475 | (defclass local-datagram-address (local-address) ()) | |
476 | ||
b5018cad FT |
477 | (defmethod connected-address-p ((address local-stream-address)) t) |
478 | (defmethod connected-address-p ((address local-seq-address)) t) | |
479 | (defmethod connected-address-p ((address local-datagram-address)) nil) | |
dfa6197c | 480 | |
b5018cad | 481 | (export '(local-address local-stream-address local-seq-address local-datagram-address)) |