1 (in-package "SB-BSD-SOCKETS")
3 ;;;; Methods, classes, functions for sockets. Protocol-specific stuff
4 ;;;; is deferred to inet.lisp, unix.lisp, etc
10 (eval-when (:load-toplevel :compile-toplevel :execute)
12 ((file-descriptor :initarg :descriptor
13 :reader socket-file-descriptor)
14 (family :initform (error "No socket family") :reader socket-family)
15 (protocol :initarg :protocol :reader socket-protocol)
16 (type :initarg :type :reader socket-type)
19 (defmethod print-object ((object socket) stream)
20 (print-unreadable-object (object stream :type t :identity t)
21 (princ "descriptor " stream)
22 (princ (slot-value object 'file-descriptor) stream)))
25 (defmethod shared-initialize :after ((socket socket) slot-names
29 (cond ((and protocol (keywordp protocol))
30 (get-protocol-by-name (string-downcase (symbol-name protocol))))
33 (fd (or (and (slot-boundp socket 'file-descriptor)
34 (socket-file-descriptor socket))
35 (sockint::socket (socket-family socket)
37 ((:datagram) sockint::sock-dgram)
38 ((:stream) sockint::sock-stream))
40 (if (= fd -1) (socket-error "socket"))
41 (setf (slot-value socket 'file-descriptor) fd
42 (slot-value socket 'protocol) proto-num
43 (slot-value socket 'type) type)
44 (sb-ext:finalize socket (lambda () (sockint::close fd)))))
48 (defgeneric make-sockaddr-for (socket &optional sockaddr &rest address)
49 (:documentation "Return a Socket Address object suitable for use with SOCKET.
50 When SOCKADDR is passed, it is used instead of a new object."))
52 ;; we deliberately redesign the "bind" interface: instead of passing a
53 ;; sockaddr_something as second arg, we pass the elements of one as
54 ;; multiple arguments.
56 (defgeneric socket-bind (socket &rest address)
57 (:documentation "Bind SOCKET to ADDRESS, which may vary according to
58 socket family. For the INET family, pass ADDRESS and PORT as two
59 arguments; for FILE address family sockets, pass the filename string.
62 (defmethod socket-bind ((socket socket)
64 (let ((sockaddr (apply #'make-sockaddr-for socket nil address)))
65 (if (= (sb-sys:with-pinned-objects (sockaddr)
66 (sockint::bind (socket-file-descriptor socket)
67 (sockint::array-data-address sockaddr)
68 (size-of-sockaddr socket)))
70 (socket-error "bind"))))
73 (defgeneric socket-accept (socket)
74 (:documentation "Perform the accept(2) call, returning a
75 newly-created connected socket and the peer address as multiple
78 (defmethod socket-accept ((socket socket))
79 (let ((sockaddr (make-sockaddr-for socket)))
80 (sb-sys:with-pinned-objects (sockaddr)
81 (let ((fd (sockint::accept (socket-file-descriptor socket)
82 (sockint::array-data-address sockaddr)
83 (size-of-sockaddr socket))))
86 (socket-error "accept")
87 (let ((s (make-instance (class-of socket)
88 :type (socket-type socket)
89 :protocol (socket-protocol socket)
91 (sb-ext:finalize s (lambda () (sockint::close fd)))))
92 (multiple-value-list (bits-of-sockaddr socket sockaddr)))))))
94 (defgeneric socket-connect (socket &rest address)
95 (:documentation "Perform the connect(2) call to connect SOCKET to a
96 remote PEER. No useful return value."))
98 (defmethod socket-connect ((socket socket) &rest peer)
99 (let* ((sockaddr (apply #'make-sockaddr-for socket nil peer)))
100 (if (= (sb-sys:with-pinned-objects (sockaddr)
101 (sockint::connect (socket-file-descriptor socket)
102 (sockint::array-data-address sockaddr)
103 (size-of-sockaddr socket)))
105 (socket-error "connect") )))
107 (defgeneric socket-peername (socket)
108 (:documentation "Return the socket's peer; depending on the address
109 family this may return multiple values"))
111 (defmethod socket-peername ((socket socket))
112 (let* ((sockaddr (make-sockaddr-for socket)))
113 (when (= (sb-sys:with-pinned-objects (sockaddr)
114 (sockint::getpeername (socket-file-descriptor socket)
115 (sockint::array-data-address sockaddr)
116 (size-of-sockaddr socket)))
118 (socket-error "getpeername"))
119 (bits-of-sockaddr socket sockaddr)))
121 (defgeneric socket-name (socket)
122 (:documentation "Return the address (as vector of bytes) and port
123 that the socket is bound to, as multiple values."))
125 (defmethod socket-name ((socket socket))
126 (let* ((sockaddr (make-sockaddr-for socket)))
127 (when (= (sb-sys:with-pinned-objects (sockaddr)
128 (sockint::getsockname (socket-file-descriptor socket)
129 (sockint::array-data-address sockaddr)
130 (size-of-sockaddr socket)))
132 (socket-error "getsockname"))
133 (bits-of-sockaddr socket sockaddr)))
136 ;;; There are a whole bunch of interesting things you can do with a
137 ;;; socket that don't really map onto "do stream io", especially in
138 ;;; CL which has no portable concept of a "short read". socket-receive
139 ;;; allows us to read from an unconnected socket into a buffer, and
140 ;;; to learn who the sender of the packet was
142 (defgeneric socket-receive (socket buffer length
144 oob peek waitall element-type)
145 (:documentation "Read LENGTH octets from SOCKET into BUFFER (or a freshly-consed buffer if
146 NIL), using recvfrom(2). If LENGTH is NIL, the length of BUFFER is
147 used, so at least one of these two arguments must be non-NIL. If
148 BUFFER is supplied, it had better be of an element type one octet wide.
149 Returns the buffer, its length, and the address of the peer
150 that sent it, as multiple values. On datagram sockets, sets MSG_TRUNC
151 so that the actual packet length is returned even if the buffer was too
154 (defmethod socket-receive ((socket socket) buffer length
157 (element-type 'character))
159 (logior (if oob sockint::MSG-OOB 0)
160 (if peek sockint::MSG-PEEK 0)
161 (if waitall sockint::MSG-WAITALL 0)
162 sockint::MSG-NOSIGNAL ;don't send us SIGPIPE
163 (if (eql (socket-type socket) :datagram)
164 sockint::msg-TRUNC 0)))
165 (sockaddr (make-sockaddr-for socket)))
166 (unless (or buffer length)
167 (error "Must supply at least one of BUFFER or LENGTH"))
169 (setf buffer (make-array length :element-type element-type)))
170 (sb-alien:with-alien ((sa-len (array (sb-alien:unsigned 32) 2)))
171 (setf (sb-alien:deref sa-len 0) (size-of-sockaddr socket))
172 (sb-sys:with-pinned-objects (buffer sockaddr)
174 (sockint::recvfrom (socket-file-descriptor socket)
175 (sockint::array-data-address buffer)
176 (or length (length buffer))
178 (sockint::array-data-address sockaddr)
179 (sb-alien:cast sa-len (* integer)))))
180 (when (= len -1) (socket-error "recvfrom"))
181 (apply #'values buffer len (multiple-value-list
182 (bits-of-sockaddr socket sockaddr))))))))
186 (defgeneric socket-listen (socket backlog)
187 (:documentation "Mark SOCKET as willing to accept incoming connections. BACKLOG
188 defines the maximum length that the queue of pending connections may
189 grow to before new connection attempts are refused. See also listen(2)"))
191 (defmethod socket-listen ((socket socket) backlog)
192 (let ((r (sockint::listen (socket-file-descriptor socket) backlog)))
194 (socket-error "listen"))))
196 (defgeneric socket-close (socket)
197 (:documentation "Close SOCKET. May throw any kind of error that write(2) would have
198 thrown. If SOCKET-MAKE-STREAM has been called, calls CLOSE on that
201 (defmethod socket-close ((socket socket))
202 ;; the close(2) manual page has all kinds of warning about not
203 ;; checking the return value of close, on the grounds that an
204 ;; earlier write(2) might have returned successfully w/o actually
205 ;; writing the stuff to disk. It then goes on to define the only
206 ;; possible error return as EBADF (fd isn't a valid open file
207 ;; descriptor). Presumably this is an oversight and we could also
208 ;; get anything that write(2) would have given us.
210 ;; What we do: we catch EBADF. It should only ever happen if
211 ;; (a) someone's closed the socket already (stream closing seems
212 ;; to have this effect) or (b) the caller is messing around with
213 ;; socket internals. That's not supported, dude
215 (if (slot-boundp socket 'stream)
216 (close (slot-value socket 'stream)) ;; closes socket as well
218 (if (= (sockint::close (socket-file-descriptor socket)) -1)
219 (socket-error "close"))
220 (bad-file-descriptor-error (c) (declare (ignore c)) nil)
221 (:no-error (c) (declare (ignore c)) nil))))
223 (defgeneric socket-make-stream (socket &rest args)
224 (:documentation "Find or create a STREAM that can be used for IO
225 on SOCKET (which must be connected). ARGS are passed onto
226 SB-SYS:MAKE-FD-STREAM."))
228 (defmethod socket-make-stream ((socket socket) &rest args)
230 (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
232 (setf stream (apply #'sb-sys:make-fd-stream
233 (socket-file-descriptor socket)
234 :name "a constant string"
236 (setf (slot-value socket 'stream) stream)
237 (sb-ext:cancel-finalization socket))
244 (define-condition socket-error (error)
245 ((errno :initform nil
247 :reader socket-error-errno)
248 (symbol :initform nil :initarg :symbol :reader socket-error-symbol)
249 (syscall :initform "outer space" :initarg :syscall :reader socket-error-syscall))
250 (:report (lambda (c s)
251 (let ((num (socket-error-errno c)))
252 (format s "Socket error in \"~A\": ~A (~A)"
253 (socket-error-syscall c)
254 (or (socket-error-symbol c) (socket-error-errno c))
255 #+cmu (sb-unix:get-unix-error-msg num)
256 #+sbcl (sb-int:strerror num))))))
258 ;;; watch out for slightly hacky symbol punning: we use both the value
259 ;;; and the symbol-name of sockint::efoo
261 (defmacro define-socket-condition (symbol name)
263 (define-condition ,name (socket-error)
264 ((symbol :reader socket-error-symbol :initform (quote ,symbol))))
265 (push (cons ,symbol (quote ,name)) *conditions-for-errno*)))
267 (defparameter *conditions-for-errno* nil)
268 ;;; this needs the rest of the list adding to it, really. They also
270 ;;; - conditions to be exported in the DEFPACKAGE form
271 ;;; - symbols to be added to constants.ccon
272 ;;; I haven't yet thought of a non-kludgey way of keeping all this in
274 (define-socket-condition sockint::EADDRINUSE address-in-use-error)
275 (define-socket-condition sockint::EAGAIN interrupted-error)
276 (define-socket-condition sockint::EBADF bad-file-descriptor-error)
277 (define-socket-condition sockint::ECONNREFUSED connection-refused-error)
278 (define-socket-condition sockint::EINTR interrupted-error)
279 (define-socket-condition sockint::EINVAL invalid-argument-error)
280 (define-socket-condition sockint::ENOBUFS no-buffers-error)
281 (define-socket-condition sockint::ENOMEM out-of-memory-error)
282 (define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error)
283 (define-socket-condition sockint::EPERM operation-not-permitted-error)
284 (define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
285 (define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
286 (define-socket-condition sockint::ENETUNREACH network-unreachable-error)
289 (defun condition-for-errno (err)
290 (or (cdr (assoc err *conditions-for-errno* :test #'eql)) 'socket-error))
293 (defun socket-error (where)
294 ;; Peter's debian/x86 cmucl packages (and sbcl, derived from them)
295 ;; use a direct syscall interface, and have to call UNIX-GET-ERRNO
296 ;; to update the value that unix-errno looks at. On other CMUCL
297 ;; ports, (UNIX-GET-ERRNO) is not needed and doesn't exist
298 (when (fboundp 'unix::unix-get-errno) (unix::unix-get-errno))
299 (let ((condition (condition-for-errno sb-unix:unix-errno)))
300 (error condition :errno sb-unix:unix-errno :syscall where)))
303 (defun socket-error (where)
304 (let* ((errno (sb-unix::get-errno))
305 (condition (condition-for-errno errno)))
306 (error condition :errno errno :syscall where)))
309 (defgeneric bits-of-sockaddr (socket sockaddr)
310 (:documentation "Return protocol-dependent bits of parameter
311 SOCKADDR, e.g. the Host/Port if SOCKET is an inet socket."))
313 (defgeneric size-of-sockaddr (socket)
314 (:documentation "Return the size of a sockaddr object for SOCKET."))