1 (in-package "SB-BSD-SOCKETS")
3 ;;;; Methods, classes, functions for sockets. Protocol-specific stuff
4 ;;;; is deferred to inet.lisp, unix.lisp, etc
6 (eval-when (:load-toplevel :compile-toplevel :execute)
9 ((file-descriptor :initarg :descriptor
10 :reader socket-file-descriptor)
11 (family :initform (error "No socket family")
12 :reader socket-family)
13 (protocol :initarg :protocol
14 :reader socket-protocol
15 :documentation "Protocol used by the socket. If a
16 keyword, the symbol-name of the keyword will be passed to
17 GET-PROTOCOL-BY-NAME downcased, and the returned value used as
18 protocol. Other values are used as-is.")
21 :documentation "Type of the socket: :STREAM or :DATAGRAM.")
23 (:documentation "Common base class of all sockets, not meant to be
24 directly instantiated.")))
26 (defmethod print-object ((object socket) stream)
27 (print-unreadable-object (object stream :type t :identity t)
28 (format stream "~@[~A, ~]~@[peer: ~A, ~]fd: ~A"
29 (socket-namestring object)
30 (socket-peerstring object)
31 (slot-value object 'file-descriptor))))
33 (defgeneric socket-namestring (socket))
35 (defmethod socket-namestring (socket)
38 (defgeneric socket-peerstring (socket))
40 (defmethod socket-peerstring (socket)
43 (defmethod shared-initialize :after ((socket socket) slot-names
47 (cond ((and protocol (keywordp protocol))
48 (get-protocol-by-name (string-downcase (symbol-name protocol))))
51 (fd (or (and (slot-boundp socket 'file-descriptor)
52 (socket-file-descriptor socket))
53 (sockint::socket (socket-family socket)
55 ((:datagram) sockint::sock-dgram)
56 ((:stream) sockint::sock-stream))
58 (if (= fd -1) (socket-error "socket"))
59 (setf (slot-value socket 'file-descriptor) fd
60 (slot-value socket 'protocol) proto-num
61 (slot-value socket 'type) type)
62 (sb-ext:finalize socket (lambda () (sockint::close fd))
67 (defgeneric make-sockaddr-for (socket &optional sockaddr &rest address)
68 (:documentation "Return a Socket Address object suitable for use with SOCKET.
69 When SOCKADDR is passed, it is used instead of a new object."))
71 (defgeneric free-sockaddr-for (socket sockaddr)
72 (:documentation "Deallocate a Socket Address object that was
73 created for SOCKET."))
75 (defmacro with-sockaddr-for ((socket sockaddr &optional sockaddr-args) &body body)
76 `(let ((,sockaddr (apply #'make-sockaddr-for ,socket nil ,sockaddr-args)))
77 (unwind-protect (progn ,@body)
78 (free-sockaddr-for ,socket ,sockaddr))))
80 ;; we deliberately redesign the "bind" interface: instead of passing a
81 ;; sockaddr_something as second arg, we pass the elements of one as
82 ;; multiple arguments.
84 (defgeneric socket-bind (socket &rest address)
85 (:documentation "Bind SOCKET to ADDRESS, which may vary according to
86 socket family. For the INET family, pass ADDRESS and PORT as two
87 arguments; for FILE address family sockets, pass the filename string.
90 (defmethod socket-bind ((socket socket)
92 (with-sockaddr-for (socket sockaddr address)
93 (if (= (sockint::bind (socket-file-descriptor socket)
95 (size-of-sockaddr socket))
97 (socket-error "bind"))))
100 (defgeneric socket-accept (socket)
101 (:documentation "Perform the accept(2) call, returning a
102 newly-created connected socket and the peer address as multiple
105 (defmethod socket-accept ((socket socket))
106 (with-sockaddr-for (socket sockaddr)
107 (let ((fd (sockint::accept (socket-file-descriptor socket)
109 (size-of-sockaddr socket))))
112 (member (sb-unix::get-errno)
113 (list sockint::EAGAIN sockint::EINTR)))
115 ((= fd -1) (socket-error "accept"))
117 (let ((s (make-instance (class-of socket)
118 :type (socket-type socket)
119 :protocol (socket-protocol socket)
121 (sb-ext:finalize s (lambda () (sockint::close fd))
123 (multiple-value-list (bits-of-sockaddr socket sockaddr))))))))
125 (defgeneric socket-connect (socket &rest address)
126 (:documentation "Perform the connect(2) call to connect SOCKET to a
127 remote PEER. No useful return value."))
129 (defmethod socket-connect ((socket socket) &rest peer)
130 (with-sockaddr-for (socket sockaddr peer)
131 (if (= (sockint::connect (socket-file-descriptor socket)
133 (size-of-sockaddr socket))
135 (socket-error "connect"))))
137 (defgeneric socket-peername (socket)
138 (:documentation "Return the socket's peer; depending on the address
139 family this may return multiple values"))
141 (defmethod socket-peername ((socket socket))
142 (with-sockaddr-for (socket sockaddr)
143 (when (= (sockint::getpeername (socket-file-descriptor socket)
145 (size-of-sockaddr socket))
147 (socket-error "getpeername"))
148 (bits-of-sockaddr socket sockaddr)))
150 (defgeneric socket-name (socket)
151 (:documentation "Return the address (as vector of bytes) and port
152 that the socket is bound to, as multiple values."))
154 (defmethod socket-name ((socket socket))
155 (with-sockaddr-for (socket sockaddr)
156 (when (= (sockint::getsockname (socket-file-descriptor socket)
158 (size-of-sockaddr socket))
160 (socket-error "getsockname"))
161 (bits-of-sockaddr socket sockaddr)))
164 ;;; There are a whole bunch of interesting things you can do with a
165 ;;; socket that don't really map onto "do stream io", especially in
166 ;;; CL which has no portable concept of a "short read". socket-receive
167 ;;; allows us to read from an unconnected socket into a buffer, and
168 ;;; to learn who the sender of the packet was
170 (defgeneric socket-receive (socket buffer length
172 oob peek waitall dontwait element-type)
174 "Read LENGTH octets from SOCKET into BUFFER (or a freshly-consed
175 buffer if NIL), using recvfrom(2). If LENGTH is NIL, the length of
176 BUFFER is used, so at least one of these two arguments must be
177 non-NIL. If BUFFER is supplied, it had better be of an element type
178 one octet wide. Returns the buffer, its length, and the address of the
179 peer that sent it, as multiple values. On datagram sockets, sets
180 MSG_TRUNC so that the actual packet length is returned even if the
181 buffer was too small."))
183 (defmethod socket-receive ((socket socket) buffer length
185 oob peek waitall dontwait
186 (element-type 'character))
187 (with-sockaddr-for (socket sockaddr)
189 (logior (if oob sockint::MSG-OOB 0)
190 (if peek sockint::MSG-PEEK 0)
191 (if waitall sockint::MSG-WAITALL 0)
192 (if dontwait sockint::MSG-DONTWAIT 0)
193 #+linux sockint::MSG-NOSIGNAL ;don't send us SIGPIPE
194 (if (eql (socket-type socket) :datagram)
195 sockint::msg-TRUNC 0))))
196 (unless (or buffer length)
197 (error "Must supply at least one of BUFFER or LENGTH"))
199 (setf length (length buffer)))
200 (when buffer (setf element-type (array-element-type buffer)))
201 (unless (or (subtypep element-type 'character)
202 (subtypep element-type 'integer))
203 (error "Buffer element-type must be either a character or an integer subtype."))
205 (setf buffer (make-array length :element-type element-type)))
206 ;; really big FIXME: This whole copy-buffer thing is broken.
207 ;; doesn't support characters more than 8 bits wide, or integer
208 ;; types that aren't (unsigned-byte 8).
209 (let ((copy-buffer (sb-alien:make-alien (array (sb-alien:unsigned 8) 1) length)))
211 (sb-alien:with-alien ((sa-len sockint::socklen-t (size-of-sockaddr socket)))
213 (sockint::recvfrom (socket-file-descriptor socket)
218 (sb-alien:addr sa-len))))
221 (member (sb-unix::get-errno)
222 (list sockint::EAGAIN sockint::EINTR)))
224 ((= len -1) (socket-error "recvfrom"))
225 (t (loop for i from 0 below len
226 do (setf (elt buffer i)
228 ((or (eql element-type 'character) (eql element-type 'base-char))
229 (code-char (sb-alien:deref (sb-alien:deref copy-buffer) i)))
230 (t (sb-alien:deref (sb-alien:deref copy-buffer) i)))))
231 (apply #'values buffer len (multiple-value-list
232 (bits-of-sockaddr socket sockaddr)))))))
233 (sb-alien:free-alien copy-buffer))))))
235 (defmacro with-vector-sap ((name vector) &body body)
236 `(sb-sys:with-pinned-objects (,vector)
237 (let ((,name (sb-sys:vector-sap ,vector)))
240 (defgeneric socket-send (socket buffer length
244 oob eor dontroute dontwait nosignal
245 #+linux confirm #+linux more)
247 "Send LENGTH octets from BUFFER into SOCKET, using sendto(2). If BUFFER
248 is a string, it will converted to octets according to EXTERNAL-FORMAT. If
249 LENGTH is NIL, the length of the octet buffer is used. The format of ADDRESS
250 depends on the socket type (for example for INET domain sockets it would
251 be a list of an IP address and a port). If no socket address is provided,
252 send(2) will be called instead. Returns the number of octets written."))
254 (defmethod socket-send ((socket socket) buffer length
257 (external-format :default)
258 oob eor dontroute dontwait nosignal
259 #+linux confirm #+linux more)
261 (logior (if oob sockint::MSG-OOB 0)
262 (if eor sockint::MSG-EOR 0)
263 (if dontroute sockint::MSG-DONTROUTE 0)
264 (if dontwait sockint::MSG-DONTWAIT 0)
265 #-darwin (if nosignal sockint::MSG-NOSIGNAL 0)
266 #+linux (if confirm sockint::MSG-CONFIRM 0)
267 #+linux (if more sockint::MSG-MORE 0)))
268 (buffer (etypecase buffer
270 (sb-ext:string-to-octets buffer
271 :external-format external-format
272 :null-terminate nil))
273 ((simple-array (unsigned-byte 8))
275 ((array (unsigned-byte 8))
276 (make-array (length buffer)
277 :element-type '(unsigned-byte 8)
278 :initial-contents buffer))))
279 (len (with-vector-sap (buffer-sap buffer)
281 (setf length (length buffer)))
283 (with-sockaddr-for (socket sockaddr address)
284 (sb-alien:with-alien ((sa-len sockint::socklen-t
285 (size-of-sockaddr socket)))
286 (sockint::sendto (socket-file-descriptor socket)
292 (sockint::send (socket-file-descriptor socket)
298 (member (sb-unix::get-errno)
299 (list sockint::EAGAIN sockint::EINTR)))
302 (socket-error "sendto"))
305 (defgeneric socket-listen (socket backlog)
306 (:documentation "Mark SOCKET as willing to accept incoming connections. BACKLOG
307 defines the maximum length that the queue of pending connections may
308 grow to before new connection attempts are refused. See also listen(2)"))
310 (defmethod socket-listen ((socket socket) backlog)
311 (let ((r (sockint::listen (socket-file-descriptor socket) backlog)))
313 (socket-error "listen"))))
315 (defgeneric socket-open-p (socket)
316 (:documentation "Return true if SOCKET is open; otherwise, return false.")
317 (:method ((socket t)) (error 'type-error
318 :datum socket :expected-type 'socket)))
320 (defmethod socket-open-p ((socket socket))
321 (if (slot-boundp socket 'stream)
322 (open-stream-p (slot-value socket 'stream))
323 (/= -1 (socket-file-descriptor socket))))
325 (defgeneric socket-close (socket &key abort)
327 "Close SOCKET, unless it was already closed.
329 If SOCKET-MAKE-STREAM has been called, calls CLOSE using ABORT on that stream.
330 Otherwise closes the socket file descriptor using close(2)."))
332 (defmethod socket-close ((socket socket) &key abort)
333 ;; the close(2) manual page has all kinds of warning about not
334 ;; checking the return value of close, on the grounds that an
335 ;; earlier write(2) might have returned successfully w/o actually
336 ;; writing the stuff to disk. It then goes on to define the only
337 ;; possible error return as EBADF (fd isn't a valid open file
338 ;; descriptor). Presumably this is an oversight and we could also
339 ;; get anything that write(2) would have given us.
341 ;; note that if you have a socket _and_ a stream on the same fd,
342 ;; the socket will avoid doing anything to close the fd in case
343 ;; the stream has done it already - if so, it may have been
344 ;; reassigned to some other file, and closing it would be bad
345 (let ((fd (socket-file-descriptor socket)))
346 (flet ((drop-it (&optional streamp)
347 (setf (slot-value socket 'file-descriptor) -1)
349 (slot-makunbound socket 'stream)
350 (sb-ext:cancel-finalization socket))
355 ((slot-boundp socket 'stream)
356 (close (slot-value socket 'stream) :abort abort)
357 ;; Don't do this if there was an error from CLOSE -- the stream is
362 (when (minusp (sockint::close fd))
363 (socket-error "close"))
364 (bad-file-descriptor-error ()
370 (defgeneric socket-make-stream (socket &key input output
371 element-type external-format
374 (:documentation "Find or create a STREAM that can be used for IO on
375 SOCKET \(which must be connected\). Specify whether the stream is for
376 INPUT, OUTPUT, or both \(it is an error to specify neither\). ELEMENT-TYPE
377 and EXTERNAL-FORMAT are as per OPEN. TIMEOUT specifies a read timeout
380 (defmethod socket-make-stream ((socket socket)
382 (element-type 'character)
384 (external-format :default)
388 "Default method for SOCKET objects.
390 An ELEMENT-TYPE of :DEFAULT will construct a bivalent stream, capable of both
391 binary and character IO. Acceptable values for BUFFERING are :FULL, :LINE
392 and :NONE. Streams will have no TIMEOUT by default. If AUTO-CLOSE is true, the
393 underlying OS socket is automatically closed after the stream and the socket
394 have been garbage collected. If SERVE-EVENTS is true, blocking IO on the
395 socket will dispatch to the recursive event loop -- the default is currently
396 true, but this liable to change.
398 The stream for SOCKET will be cached, and a second invocation of this method
399 will return the same stream. This may lead to oddities if this function is
400 invoked with inconsistent arguments \(e.g., one might request an input stream
401 and get an output stream in response\)."
403 (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
405 (setf stream (sb-sys:make-fd-stream
406 (socket-file-descriptor socket)
407 :name (format nil "socket~@[ ~A~]~@[, peer: ~A~]"
408 (socket-namestring socket)
409 (socket-peerstring socket))
413 :element-type element-type
415 :external-format external-format
417 :auto-close auto-close
418 :serve-events serve-events))
419 (setf (slot-value socket 'stream) stream))
420 (sb-ext:cancel-finalization socket)
427 (define-condition socket-error (error)
428 ((errno :initform nil
430 :reader socket-error-errno)
431 (symbol :initform nil :initarg :symbol :reader socket-error-symbol)
432 (syscall :initform "outer space" :initarg :syscall :reader socket-error-syscall))
433 (:report (lambda (c s)
434 (let ((num (socket-error-errno c)))
435 (format s "Socket error in \"~A\": ~A (~A)"
436 (socket-error-syscall c)
437 (or (socket-error-symbol c) (socket-error-errno c))
438 #+cmu (sb-unix:get-unix-error-msg num)
439 #+sbcl (sb-int:strerror num)))))
440 (:documentation "Common base class of socket related conditions."))
442 ;;; watch out for slightly hacky symbol punning: we use both the value
443 ;;; and the symbol-name of sockint::efoo
445 (defmacro define-socket-condition (symbol name)
447 (define-condition ,name (socket-error)
448 ((symbol :reader socket-error-symbol :initform (quote ,symbol))))
450 (push (cons ,symbol (quote ,name)) *conditions-for-errno*)))
452 (defparameter *conditions-for-errno* nil)
453 ;;; this needs the rest of the list adding to it, really. They also
454 ;;; need symbols to be added to constants.ccon
455 ;;; I haven't yet thought of a non-kludgey way of keeping all this in
457 (define-socket-condition sockint::EADDRINUSE address-in-use-error)
458 (define-socket-condition sockint::EAGAIN interrupted-error)
459 (define-socket-condition sockint::EBADF bad-file-descriptor-error)
460 (define-socket-condition sockint::ECONNREFUSED connection-refused-error)
461 (define-socket-condition sockint::ETIMEDOUT operation-timeout-error)
462 (define-socket-condition sockint::EINTR interrupted-error)
463 (define-socket-condition sockint::EINVAL invalid-argument-error)
464 (define-socket-condition sockint::ENOBUFS no-buffers-error)
465 (define-socket-condition sockint::ENOMEM out-of-memory-error)
466 (define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error)
467 (define-socket-condition sockint::EPERM operation-not-permitted-error)
468 (define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
469 (define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
470 (define-socket-condition sockint::ENETUNREACH network-unreachable-error)
471 (define-socket-condition sockint::ENOTCONN not-connected-error)
473 (defun condition-for-errno (err)
474 (or (cdr (assoc err *conditions-for-errno* :test #'eql)) 'socket-error))
477 (defun socket-error (where)
478 ;; Peter's debian/x86 cmucl packages (and sbcl, derived from them)
479 ;; use a direct syscall interface, and have to call UNIX-GET-ERRNO
480 ;; to update the value that unix-errno looks at. On other CMUCL
481 ;; ports, (UNIX-GET-ERRNO) is not needed and doesn't exist
482 (when (fboundp 'unix::unix-get-errno) (unix::unix-get-errno))
483 (let ((condition (condition-for-errno sb-unix:unix-errno)))
484 (error condition :errno sb-unix:unix-errno :syscall where)))
487 (defun socket-error (where)
488 ;; FIXME: Our Texinfo documentation extracter need at least his to spit
489 ;; out the signature. Real documentation would be better...
491 (let* ((errno (sb-unix::get-errno))
492 (condition (condition-for-errno errno)))
493 (error condition :errno errno :syscall where)))
496 (defgeneric bits-of-sockaddr (socket sockaddr)
497 (:documentation "Return protocol-dependent bits of parameter
498 SOCKADDR, e.g. the Host/Port if SOCKET is an inet socket."))
500 (defgeneric size-of-sockaddr (socket)
501 (:documentation "Return the size of a sockaddr object for SOCKET."))