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)
8 ((file-descriptor :initarg :descriptor
9 :reader socket-file-descriptor)
10 (family :initform (error "No socket family")
11 :reader socket-family)
12 (protocol :initarg :protocol
13 :reader socket-protocol
14 :documentation "Protocol used by the socket. If a
15 keyword, the symbol-name of the keyword will be passed to
16 GET-PROTOCOL-BY-NAME downcased, and the returned value used as
17 protocol. Other values are used as-is.")
20 :documentation "Type of the socket: :STREAM or :DATAGRAM.")
22 (:documentation "Common base class of all sockets, not ment to be
23 directly instantiated.")))
25 (defmethod print-object ((object socket) stream)
26 (print-unreadable-object (object stream :type t :identity t)
27 (princ "descriptor " stream)
28 (princ (slot-value object 'file-descriptor) stream)))
31 (defmethod shared-initialize :after ((socket socket) slot-names
35 (cond ((and protocol (keywordp protocol))
36 (get-protocol-by-name (string-downcase (symbol-name protocol))))
39 (fd (or (and (slot-boundp socket 'file-descriptor)
40 (socket-file-descriptor socket))
41 (sockint::socket (socket-family socket)
43 ((:datagram) sockint::sock-dgram)
44 ((:stream) sockint::sock-stream))
46 (if (= fd -1) (socket-error "socket"))
47 (setf (slot-value socket 'file-descriptor) fd
48 (slot-value socket 'protocol) proto-num
49 (slot-value socket 'type) type)
50 (sb-ext:finalize socket (lambda () (sockint::close fd)))))
54 (defgeneric make-sockaddr-for (socket &optional sockaddr &rest address)
55 (:documentation "Return a Socket Address object suitable for use with SOCKET.
56 When SOCKADDR is passed, it is used instead of a new object."))
58 (defgeneric free-sockaddr-for (socket sockaddr)
59 (:documentation "Deallocate a Socket Address object that was
60 created for SOCKET."))
62 (defmacro with-sockaddr-for ((socket sockaddr &optional sockaddr-args) &body body)
63 `(let ((,sockaddr (apply #'make-sockaddr-for ,socket nil ,sockaddr-args)))
64 (unwind-protect (progn ,@body)
65 (free-sockaddr-for ,socket ,sockaddr))))
67 ;; we deliberately redesign the "bind" interface: instead of passing a
68 ;; sockaddr_something as second arg, we pass the elements of one as
69 ;; multiple arguments.
71 (defgeneric socket-bind (socket &rest address)
72 (:documentation "Bind SOCKET to ADDRESS, which may vary according to
73 socket family. For the INET family, pass ADDRESS and PORT as two
74 arguments; for FILE address family sockets, pass the filename string.
77 (defmethod socket-bind ((socket socket)
79 (with-sockaddr-for (socket sockaddr address)
80 (if (= (sockint::bind (socket-file-descriptor socket)
82 (size-of-sockaddr socket))
84 (socket-error "bind"))))
87 (defgeneric socket-accept (socket)
88 (:documentation "Perform the accept(2) call, returning a
89 newly-created connected socket and the peer address as multiple
92 (defmethod socket-accept ((socket socket))
93 (with-sockaddr-for (socket sockaddr)
94 (let ((fd (sockint::accept (socket-file-descriptor socket)
96 (size-of-sockaddr socket))))
98 ((and (= fd -1) (= sockint::EAGAIN (sb-unix::get-errno)))
100 ((= fd -1) (socket-error "accept"))
102 (let ((s (make-instance (class-of socket)
103 :type (socket-type socket)
104 :protocol (socket-protocol socket)
106 (sb-ext:finalize s (lambda () (sockint::close fd))))
107 (multiple-value-list (bits-of-sockaddr socket sockaddr))))))))
109 (defgeneric socket-connect (socket &rest address)
110 (:documentation "Perform the connect(2) call to connect SOCKET to a
111 remote PEER. No useful return value."))
113 (defmethod socket-connect ((socket socket) &rest peer)
114 (with-sockaddr-for (socket sockaddr peer)
115 (if (= (sockint::connect (socket-file-descriptor socket)
117 (size-of-sockaddr socket))
119 (socket-error "connect"))))
121 (defgeneric socket-peername (socket)
122 (:documentation "Return the socket's peer; depending on the address
123 family this may return multiple values"))
125 (defmethod socket-peername ((socket socket))
126 (with-sockaddr-for (socket sockaddr)
127 (when (= (sockint::getpeername (socket-file-descriptor socket)
129 (size-of-sockaddr socket))
131 (socket-error "getpeername"))
132 (bits-of-sockaddr socket sockaddr)))
134 (defgeneric socket-name (socket)
135 (:documentation "Return the address (as vector of bytes) and port
136 that the socket is bound to, as multiple values."))
138 (defmethod socket-name ((socket socket))
139 (with-sockaddr-for (socket sockaddr)
140 (when (= (sockint::getsockname (socket-file-descriptor socket)
142 (size-of-sockaddr socket))
144 (socket-error "getsockname"))
145 (bits-of-sockaddr socket sockaddr)))
148 ;;; There are a whole bunch of interesting things you can do with a
149 ;;; socket that don't really map onto "do stream io", especially in
150 ;;; CL which has no portable concept of a "short read". socket-receive
151 ;;; allows us to read from an unconnected socket into a buffer, and
152 ;;; to learn who the sender of the packet was
154 (defgeneric socket-receive (socket buffer length
156 oob peek waitall element-type)
157 (:documentation "Read LENGTH octets from SOCKET into BUFFER (or a freshly-consed buffer if
158 NIL), using recvfrom(2). If LENGTH is NIL, the length of BUFFER is
159 used, so at least one of these two arguments must be non-NIL. If
160 BUFFER is supplied, it had better be of an element type one octet wide.
161 Returns the buffer, its length, and the address of the peer
162 that sent it, as multiple values. On datagram sockets, sets MSG_TRUNC
163 so that the actual packet length is returned even if the buffer was too
166 (defmethod socket-receive ((socket socket) buffer length
169 (element-type 'character))
170 (with-sockaddr-for (socket sockaddr)
172 (logior (if oob sockint::MSG-OOB 0)
173 (if peek sockint::MSG-PEEK 0)
174 (if waitall sockint::MSG-WAITALL 0)
175 #+linux sockint::MSG-NOSIGNAL ;don't send us SIGPIPE
176 (if (eql (socket-type socket) :datagram)
177 sockint::msg-TRUNC 0))))
178 (unless (or buffer length)
179 (error "Must supply at least one of BUFFER or LENGTH"))
181 (setf length (length buffer)))
182 (when buffer (setf element-type (array-element-type buffer)))
183 (unless (or (subtypep element-type 'character)
184 (subtypep element-type 'integer))
185 (error "Buffer element-type must be either a character or an integer subtype."))
187 (setf buffer (make-array length :element-type element-type)))
188 ;; really big FIXME: This whole copy-buffer thing is broken.
189 ;; doesn't support characters more than 8 bits wide, or integer
190 ;; types that aren't (unsigned-byte 8).
191 (let ((copy-buffer (sb-alien:make-alien (array (sb-alien:unsigned 8) 1) length)))
193 (sb-alien:with-alien ((sa-len sockint::socklen-t (size-of-sockaddr socket)))
195 (sockint::recvfrom (socket-file-descriptor socket)
200 (sb-alien:addr sa-len))))
202 ((and (= len -1) (= sockint::EAGAIN (sb-unix::get-errno))) nil)
203 ((= len -1) (socket-error "recvfrom"))
204 (t (loop for i from 0 below len
205 do (setf (elt buffer i)
207 ((or (eql element-type 'character) (eql element-type 'base-char))
208 (code-char (sb-alien:deref (sb-alien:deref copy-buffer) i)))
209 (t (sb-alien:deref (sb-alien:deref copy-buffer) i)))))
210 (apply #'values buffer len (multiple-value-list
211 (bits-of-sockaddr socket sockaddr)))))))
212 (sb-alien:free-alien copy-buffer))))))
214 (defgeneric socket-listen (socket backlog)
215 (:documentation "Mark SOCKET as willing to accept incoming connections. BACKLOG
216 defines the maximum length that the queue of pending connections may
217 grow to before new connection attempts are refused. See also listen(2)"))
219 (defmethod socket-listen ((socket socket) backlog)
220 (let ((r (sockint::listen (socket-file-descriptor socket) backlog)))
222 (socket-error "listen"))))
224 (defgeneric socket-open-p (socket)
225 (:documentation "Return true if SOCKET is open; otherwise, return false.")
226 (:method ((socket t)) (error 'type-error
227 :datum socket :expected-type 'socket)))
229 (defmethod socket-open-p ((socket socket))
230 (if (slot-boundp socket 'stream)
231 (open-stream-p (slot-value socket 'stream))
232 (/= -1 (socket-file-descriptor socket))))
234 (defgeneric socket-close (socket)
235 (:documentation "Close SOCKET. May throw any kind of error that
236 write(2) would have thrown. If SOCKET-MAKE-STREAM has been called,
237 calls CLOSE on that stream instead"))
239 (defmethod socket-close ((socket socket))
240 ;; the close(2) manual page has all kinds of warning about not
241 ;; checking the return value of close, on the grounds that an
242 ;; earlier write(2) might have returned successfully w/o actually
243 ;; writing the stuff to disk. It then goes on to define the only
244 ;; possible error return as EBADF (fd isn't a valid open file
245 ;; descriptor). Presumably this is an oversight and we could also
246 ;; get anything that write(2) would have given us.
248 ;; note that if you have a socket _and_ a stream on the same fd,
249 ;; the socket will avoid doing anything to close the fd in case
250 ;; the stream has done it already - if so, it may have been
251 ;; reassigned to some other file, and closing it would be bad
253 (let ((fd (socket-file-descriptor socket)))
254 (cond ((eql fd -1) ; already closed
256 ((slot-boundp socket 'stream)
257 (unwind-protect (close (slot-value socket 'stream)) ;; closes fd
258 (setf (slot-value socket 'file-descriptor) -1)
259 (slot-makunbound socket 'stream)))
261 (sb-ext:cancel-finalization socket)
263 (if (= (sockint::close fd) -1)
264 (socket-error "close"))
265 (bad-file-descriptor-error (c) (declare (ignore c)) nil)
268 (setf (slot-value socket 'file-descriptor) -1)
272 (defgeneric socket-make-stream (socket &rest args)
273 (:documentation "Find or create a STREAM that can be used for IO on
274 SOCKET (which must be connected). ARGS are passed onto
275 SB-SYS:MAKE-FD-STREAM."))
277 (defmethod socket-make-stream ((socket socket) &rest args)
279 (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
281 (setf stream (apply #'sb-sys:make-fd-stream
282 (socket-file-descriptor socket)
283 :name "a constant string"
286 (setf (slot-value socket 'stream) stream)
287 (sb-ext:cancel-finalization socket))
294 (define-condition socket-error (error)
295 ((errno :initform nil
297 :reader socket-error-errno)
298 (symbol :initform nil :initarg :symbol :reader socket-error-symbol)
299 (syscall :initform "outer space" :initarg :syscall :reader socket-error-syscall))
300 (:report (lambda (c s)
301 (let ((num (socket-error-errno c)))
302 (format s "Socket error in \"~A\": ~A (~A)"
303 (socket-error-syscall c)
304 (or (socket-error-symbol c) (socket-error-errno c))
305 #+cmu (sb-unix:get-unix-error-msg num)
306 #+sbcl (sb-int:strerror num)))))
307 (:documentation "Common base class of socket related conditions."))
309 ;;; watch out for slightly hacky symbol punning: we use both the value
310 ;;; and the symbol-name of sockint::efoo
312 (defmacro define-socket-condition (symbol name)
314 (define-condition ,name (socket-error)
315 ((symbol :reader socket-error-symbol :initform (quote ,symbol))))
317 (push (cons ,symbol (quote ,name)) *conditions-for-errno*)))
319 (defparameter *conditions-for-errno* nil)
320 ;;; this needs the rest of the list adding to it, really. They also
321 ;;; need symbols to be added to constants.ccon
322 ;;; I haven't yet thought of a non-kludgey way of keeping all this in
324 (define-socket-condition sockint::EADDRINUSE address-in-use-error)
325 (define-socket-condition sockint::EAGAIN interrupted-error)
326 (define-socket-condition sockint::EBADF bad-file-descriptor-error)
327 (define-socket-condition sockint::ECONNREFUSED connection-refused-error)
328 (define-socket-condition sockint::ETIMEDOUT operation-timeout-error)
329 (define-socket-condition sockint::EINTR interrupted-error)
330 (define-socket-condition sockint::EINVAL invalid-argument-error)
331 (define-socket-condition sockint::ENOBUFS no-buffers-error)
332 (define-socket-condition sockint::ENOMEM out-of-memory-error)
333 (define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error)
334 (define-socket-condition sockint::EPERM operation-not-permitted-error)
335 (define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
336 (define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
337 (define-socket-condition sockint::ENETUNREACH network-unreachable-error)
338 (define-socket-condition sockint::ENOTCONN not-connected-error)
340 (defun condition-for-errno (err)
341 (or (cdr (assoc err *conditions-for-errno* :test #'eql)) 'socket-error))
344 (defun socket-error (where)
345 ;; Peter's debian/x86 cmucl packages (and sbcl, derived from them)
346 ;; use a direct syscall interface, and have to call UNIX-GET-ERRNO
347 ;; to update the value that unix-errno looks at. On other CMUCL
348 ;; ports, (UNIX-GET-ERRNO) is not needed and doesn't exist
349 (when (fboundp 'unix::unix-get-errno) (unix::unix-get-errno))
350 (let ((condition (condition-for-errno sb-unix:unix-errno)))
351 (error condition :errno sb-unix:unix-errno :syscall where)))
354 (defun socket-error (where)
355 ;; FIXME: Our Texinfo documentation extracter need at least his to spit
356 ;; out the signature. Real documentation would be better...
358 (let* ((errno (sb-unix::get-errno))
359 (condition (condition-for-errno errno)))
360 (error condition :errno errno :syscall where)))
363 (defgeneric bits-of-sockaddr (socket sockaddr)
364 (:documentation "Return protocol-dependent bits of parameter
365 SOCKADDR, e.g. the Host/Port if SOCKET is an inet socket."))
367 (defgeneric size-of-sockaddr (socket)
368 (:documentation "Return the size of a sockaddr object for SOCKET."))