Menu
▾
▴
[Sbcl-commits] CVS: sbcl/contrib/sb-bsd-sockets constants.lisp,1.5,1.6 inet.lisp,1.4,1.5 local.lisp,1.3,1.4 name-service.lisp,1.5,1.6 sockets.lisp,1.6,1.7 sockopt.lisp,1.3,1.4
|
From: Andreas F. <ant...@us...> - 2004-05-27 13:58:39
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3294/contrib/sb-bsd-sockets Modified Files: constants.lisp inet.lisp local.lisp name-service.lisp sockets.lisp sockopt.lisp Log Message: 0.8.10.56: MORE ALIENS! sb-grovel now defines alien structures. Affected: ... sb-grovel, obviously. Reworked the def-to-lisp mechanism a bit and then hacked foreign-glue. .... array-data.lisp isn't needed by sb-grovel any more, and any code that uses it will probably break anyway; removed it. .... The Manual: Now there's a section on sb-grovel usage. sb-grovel's README is no more. ... sb-bsd-sockets: It had to learn to use aliens instead of non-typechecked lisp arrays. I hope there are no memory leaks. ... ditto for sb-posix. Thanks to vja for patches & patiently testing my changes on x86 and SPARC. Index: constants.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/constants.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- constants.lisp 3 Sep 2003 09:05:02 -0000 1.5 +++ constants.lisp 27 May 2004 13:58:15 -0000 1.6 @@ -104,23 +104,27 @@ (buf (* t)))) |# (:structure protoent ("struct protoent" - ((* t) name "char *" "p_name") + (c-string-pointer name "char *" "p_name") ((* (* t)) aliases "char **" "p_aliases") (integer proto "int" "p_proto"))) (:function getprotobyname ("getprotobyname" (* t) (name c-string))) (:integer inaddr-any "INADDR_ANY") (:structure in-addr ("struct in_addr" - ((array (unsigned 8) 4) addr "u_int32_t" "s_addr"))) + ((array (unsigned 8)) addr "u_int32_t" "s_addr"))) (:structure sockaddr-in ("struct sockaddr_in" (integer family "sa_family_t" "sin_family") - ((array (unsigned 8) 2) port "u_int16_t" "sin_port") - ((array (unsigned 8) 4) addr "struct in_addr" "sin_addr"))) + ;; These two could be in-port-t and + ;; in-addr-t, but then we'd throw away the + ;; convenience (and byte-order agnosticism) + ;; of the old sb-grovel scheme. + ((array (unsigned 8)) port "u_int16_t" "sin_port") + ((array (unsigned 8)) addr "struct in_addr" "sin_addr"))) (:structure sockaddr-un ("struct sockaddr_un" (integer family "sa_family_t" "sun_family") - ((array (unsigned 8) 108) path "char" "sun_path"))) + (c-string path "char" "sun_path"))) (:structure hostent ("struct hostent" - ((* t) name "char *" "h_name") + (c-string-pointer name "char *" "h_name") ((* c-string) aliases "char **" "h_aliases") (integer type "int" "h_addrtype") (integer length "int" "h_length") @@ -131,26 +135,26 @@ (protocol integer))) (:function bind ("bind" integer (sockfd integer) - (my-addr (* t)) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (addrlen integer))) (:function listen ("listen" integer (socket integer) (backlog integer))) (:function accept ("accept" integer (socket integer) - (my-addr (* t)) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (addrlen integer :in-out))) (:function getpeername ("getpeername" integer (socket integer) - (her-addr (* t)) + (her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (addrlen integer :in-out))) (:function getsockname ("getsockname" integer (socket integer) - (my-addr (* t)) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (addrlen integer :in-out))) (:function connect ("connect" integer (socket integer) - (his-addr (* t)) + (his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (addrlen integer ))) (:function close ("close" integer @@ -160,10 +164,10 @@ (buf (* t)) (len integer) (flags integer) - (sockaddr (* t)) + (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (socklen (* integer)))) - (:function gethostbyname ("gethostbyname" (* t ) (name c-string))) - (:function gethostbyaddr ("gethostbyaddr" (* t ) + (:function gethostbyname ("gethostbyname" (* hostent) (name c-string))) + (:function gethostbyaddr ("gethostbyaddr" (* hostent) (addr (* t)) (len integer) (af integer))) @@ -182,5 +186,5 @@ (level integer) (optname integer) (optval (* t)) - (optlen integer :in-out)))) + (optlen (* integer))))) ) Index: inet.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/inet.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- inet.lisp 11 Feb 2004 11:00:40 -0000 1.4 +++ inet.lisp 27 May 2004 13:58:15 -0000 1.5 @@ -26,10 +26,9 @@ (defun make-inet-address (dotted-quads) "Return a vector of octets given a string DOTTED-QUADS in the format \"127.0.0.1\"" - (coerce - (mapcar #'parse-integer - (split dotted-quads nil '(#\.))) - 'vector)) + (map 'vector + #'parse-integer + (split dotted-quads nil '(#\.)))) ;;; getprotobyname only works in the internet domain, which is why this ;;; is here @@ -38,52 +37,49 @@ using getprotobyname(2) which typically looks in NIS or /etc/protocols" ;; for extra brownie points, could return canonical protocol name ;; and aliases as extra values - (let ((ent (sb-grovel::foreign-vector (sockint::getprotobyname name) 1 - sockint::size-of-protoent))) + (let ((ent (sockint::getprotobyname name))) (sockint::protoent-proto ent))) - -;;; sockaddr protocol -;;; (1) sockaddrs are represented as the semi-foreign array-of-octets -;;; thing -;;; (2) a protocol provides make-sockaddr-for, size-of-sockaddr, +;;; our protocol provides make-sockaddr-for, size-of-sockaddr, ;;; bits-of-sockaddr (defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address &aux (host (first address)) (port (second address))) (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-in)))) (when (and host port) + (setf host (coerce host '(simple-array (unsigned-byte 8) (4)))) ;; port and host are represented in C as "network-endian" unsigned ;; integers of various lengths. This is stupid. The value of the ;; integer doesn't matter (and will change depending on your ;; machine's endianness); what the bind(2) call is interested in ;; is the pattern of bytes within that integer. - + ;; We have no truck with such dreadful type punning. Octets to ;; octets, dust to dust. (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet) - (setf (sockint::sockaddr-in-port sockaddr 0) (ldb (byte 8 8) port)) - (setf (sockint::sockaddr-in-port sockaddr 1) (ldb (byte 8 0) port)) - - (setf (sockint::sockaddr-in-addr sockaddr 0) (elt host 0)) - (setf (sockint::sockaddr-in-addr sockaddr 1) (elt host 1)) - (setf (sockint::sockaddr-in-addr sockaddr 2) (elt host 2)) - (setf (sockint::sockaddr-in-addr sockaddr 3) (elt host 3))) + (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0) (ldb (byte 8 8) port)) + (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1) (ldb (byte 8 0) port)) + + (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 0) (elt host 0)) + (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 1) (elt host 1)) + (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 2) (elt host 2)) + (setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 3) (elt host 3))) sockaddr)) +(defmethod free-sockaddr-for ((socket inet-socket) sockaddr) + (sockint::free-sockaddr-in sockaddr)) + (defmethod size-of-sockaddr ((socket inet-socket)) sockint::size-of-sockaddr-in) (defmethod bits-of-sockaddr ((socket inet-socket) sockaddr) "Returns address and port of SOCKADDR as multiple values" (values - (vector - (sockint::sockaddr-in-addr sockaddr 0) - (sockint::sockaddr-in-addr sockaddr 1) - (sockint::sockaddr-in-addr sockaddr 2) - (sockint::sockaddr-in-addr sockaddr 3)) - (+ (* 256 (sockint::sockaddr-in-port sockaddr 0)) - (sockint::sockaddr-in-port sockaddr 1)))) + (coerce (loop for i from 0 below 4 + collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i)) + '(vector (unsigned-byte 8) 4)) + (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0)) + (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1)))) (defun make-inet-socket (type protocol) "Make an INET socket. Deprecated in favour of make-instance" Index: local.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/local.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- local.lisp 11 Feb 2004 11:00:40 -0000 1.3 +++ local.lisp 27 May 2004 13:58:15 -0000 1.4 @@ -19,22 +19,17 @@ (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un)))) (setf (sockint::sockaddr-un-family sockaddr) sockint::af-local) (when filename - (loop for c across filename - ;; XXX magic constant ew ew ew. should grovel this from - ;; system headers - for i from 0 to (min 107 (1- (length filename))) - do (setf (sockint::sockaddr-un-path sockaddr i) (char-code c)) - finally - (setf (sockint::sockaddr-un-path sockaddr (1+ i)) 0))) + (setf (sockint::sockaddr-un-path sockaddr) filename)) sockaddr)) +(defmethod free-sockaddr-for ((socket local-socket) sockaddr) + (sockint::free-sockaddr-un sockaddr)) + (defmethod size-of-sockaddr ((socket local-socket)) sockint::size-of-sockaddr-un) (defmethod bits-of-sockaddr ((socket local-socket) sockaddr) "Return the file name of the local socket address SOCKADDR." - (let ((name (sb-c-call::%naturalize-c-string - (sb-sys:sap+ (sb-grovel::array-data-address sockaddr) - sockint::offset-of-sockaddr-un-path)))) + (let ((name (sockint::sockaddr-un-path sockaddr))) (if (zerop (length name)) nil name))) Index: name-service.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/name-service.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- name-service.lisp 11 Feb 2004 11:00:40 -0000 1.5 +++ name-service.lisp 27 May 2004 13:58:16 -0000 1.6 @@ -31,44 +31,42 @@ "Returns a HOST-ENT instance for HOST-NAME or throws some kind of condition. HOST-NAME may also be an IP address in dotted quad notation or some other weird stuff - see gethostbyname(3) for grisly details." - (let ((h (sockint::gethostbyname host-name))) - (make-host-ent h))) + (make-host-ent (sockint::gethostbyname host-name))) (defun get-host-by-address (address) "Returns a HOST-ENT instance for ADDRESS, which should be a vector of -(integer 0 255), or throws some kind of error. See gethostbyaddr(3) for + (integer 0 255), or throws some kind of error. See gethostbyaddr(3) for grisly details." - (let ((packed-addr (sockint::allocate-in-addr))) - (loop for i from 0 to 3 - do (setf (sockint::in-addr-addr packed-addr i) (elt address i))) - (make-host-ent - (sb-sys:with-pinned-objects (packed-addr) - (sockint::gethostbyaddr (sb-grovel::array-data-address packed-addr) - 4 - sockint::af-inet))))) + (sockint::with-in-addr packed-addr () + (let ((addr-vector (coerce address 'vector))) + (loop for i from 0 below (length addr-vector) + do (setf (sb-alien:deref (sockint::in-addr-addr packed-addr) i) + (elt addr-vector i))) + (make-host-ent (sockint::gethostbyaddr packed-addr + 4 + sockint::af-inet))))) (defun make-host-ent (h) (if (sb-grovel::foreign-nullp h) (name-service-error "gethostbyname")) - (let* ((local-h (sb-grovel::foreign-vector h 1 sockint::size-of-hostent)) - (length (sockint::hostent-length local-h)) - (aliases - (loop for i = 0 then (1+ i) - for al = (sb-sys:sap-ref-sap - (sb-sys:int-sap (sockint::hostent-aliases local-h)) - (* i 4)) - until (= (sb-sys:sap-int al) 0) - collect (sb-c-call::%naturalize-c-string al))) - (address0 (sb-sys:sap-ref-sap (sb-sys:int-sap (sockint::hostent-addresses local-h)) 0)) + (let* ((length (sockint::hostent-length h)) + (aliases (loop for i = 0 then (1+ i) + for al = (sb-alien:deref (sockint::hostent-aliases h) i) + while al + collect al)) + (address0 (sockint::hostent-addresses h)) (addresses - (loop for i = 0 then (+ length i) - for ad = (sb-sys:sap-ref-32 address0 i) - while (> ad 0) - collect - (sb-grovel::foreign-vector (sb-sys:sap+ address0 i) 1 length)))) + (loop for i = 0 then (1+ i) + for ad = (sb-alien:deref address0 i) + until (sb-alien:null-alien ad) + collect (ecase (sockint::hostent-type h) + (#.sockint::af-inet + (loop for i from 0 below length + collect (sb-alien:deref ad i))) + (#.sockint::af-local + (sb-alien:cast ad sb-alien:c-string)))))) (make-instance 'host-ent - :name (sb-c-call::%naturalize-c-string - (sb-sys:int-sap (sockint::hostent-name local-h))) - :type (sockint::hostent-type local-h) + :name (sockint::hostent-name h) + :type (sockint::hostent-type h) :aliases aliases :addresses addresses))) @@ -143,4 +141,3 @@ (defun get-name-service-error-message (num) (hstrerror num)) ) - Index: sockets.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sockets.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- sockets.lisp 11 Feb 2004 11:00:40 -0000 1.6 +++ sockets.lisp 27 May 2004 13:58:16 -0000 1.7 @@ -49,6 +49,15 @@ (:documentation "Return a Socket Address object suitable for use with SOCKET. When SOCKADDR is passed, it is used instead of a new object.")) +(defgeneric free-sockaddr-for (socket sockaddr) + (:documentation "Deallocate a Socket Address object that was +created for SOCKET.")) + +(defmacro with-sockaddr-for ((socket sockaddr sockaddr-args) &body body) + `(let ((,sockaddr (apply #'make-sockaddr-for ,socket nil ,sockaddr-args))) + (unwind-protect (progn ,@body) + (free-sockaddr-for ,socket ,sockaddr)))) + ;; we deliberately redesign the "bind" interface: instead of passing a ;; sockaddr_something as second arg, we pass the elements of one as ;; multiple arguments. @@ -61,11 +70,10 @@ (defmethod socket-bind ((socket socket) &rest address) - (let ((sockaddr (apply #'make-sockaddr-for socket nil address))) - (if (= (sb-sys:with-pinned-objects (sockaddr) - (sockint::bind (socket-file-descriptor socket) - (sb-grovel::array-data-address sockaddr) - (size-of-sockaddr socket))) + (with-sockaddr-for (socket sockaddr address) + (if (= (sockint::bind (socket-file-descriptor socket) + sockaddr + (size-of-sockaddr socket)) -1) (socket-error "bind")))) @@ -76,44 +84,41 @@ values")) (defmethod socket-accept ((socket socket)) - (let ((sockaddr (make-sockaddr-for socket))) - (sb-sys:with-pinned-objects (sockaddr) - (let ((fd (sockint::accept (socket-file-descriptor socket) - (sb-grovel::array-data-address sockaddr) - (size-of-sockaddr socket)))) - (apply #'values - (if (= fd -1) - (socket-error "accept") - (let ((s (make-instance (class-of socket) - :type (socket-type socket) - :protocol (socket-protocol socket) - :descriptor fd))) - (sb-ext:finalize s (lambda () (sockint::close fd))))) - (multiple-value-list (bits-of-sockaddr socket sockaddr))))))) + (with-sockaddr-for (socket sockaddr nil) + (let ((fd (sockint::accept (socket-file-descriptor socket) + sockaddr + (size-of-sockaddr socket)))) + (apply #'values + (if (= fd -1) + (socket-error "accept") + (let ((s (make-instance (class-of socket) + :type (socket-type socket) + :protocol (socket-protocol socket) + :descriptor fd))) + (sb-ext:finalize s (lambda () (sockint::close fd))))) + (multiple-value-list (bits-of-sockaddr socket sockaddr)))))) (defgeneric socket-connect (socket &rest address) (:documentation "Perform the connect(2) call to connect SOCKET to a remote PEER. No useful return value.")) (defmethod socket-connect ((socket socket) &rest peer) - (let* ((sockaddr (apply #'make-sockaddr-for socket nil peer))) - (if (= (sb-sys:with-pinned-objects (sockaddr) - (sockint::connect (socket-file-descriptor socket) - (sb-grovel::array-data-address sockaddr) - (size-of-sockaddr socket))) + (with-sockaddr-for (socket sockaddr peer) + (if (= (sockint::connect (socket-file-descriptor socket) + sockaddr + (size-of-sockaddr socket)) -1) - (socket-error "connect") ))) + (socket-error "connect")))) (defgeneric socket-peername (socket) (:documentation "Return the socket's peer; depending on the address family this may return multiple values")) (defmethod socket-peername ((socket socket)) - (let* ((sockaddr (make-sockaddr-for socket))) - (when (= (sb-sys:with-pinned-objects (sockaddr) - (sockint::getpeername (socket-file-descriptor socket) - (sb-grovel::array-data-address sockaddr) - (size-of-sockaddr socket))) + (with-sockaddr-for (socket sockaddr address) + (when (= (sockint::getpeername (socket-file-descriptor socket) + sockaddr + (size-of-sockaddr socket)) -1) (socket-error "getpeername")) (bits-of-sockaddr socket sockaddr))) @@ -123,11 +128,10 @@ that the socket is bound to, as multiple values.")) (defmethod socket-name ((socket socket)) - (let* ((sockaddr (make-sockaddr-for socket))) - (when (= (sb-sys:with-pinned-objects (sockaddr) - (sockint::getsockname (socket-file-descriptor socket) - (sb-grovel::array-data-address sockaddr) - (size-of-sockaddr socket))) + (with-sockaddr-for (socket sockaddr nil) + (when (= (sockint::getsockname (socket-file-descriptor socket) + sockaddr + (size-of-sockaddr socket)) -1) (socket-error "getsockname")) (bits-of-sockaddr socket sockaddr))) @@ -152,34 +156,38 @@ small")) (defmethod socket-receive ((socket socket) buffer length - &key - oob peek waitall - (element-type 'character)) - (let ((flags - (logior (if oob sockint::MSG-OOB 0) - (if peek sockint::MSG-PEEK 0) - (if waitall sockint::MSG-WAITALL 0) - sockint::MSG-NOSIGNAL ;don't send us SIGPIPE - (if (eql (socket-type socket) :datagram) - sockint::msg-TRUNC 0))) - (sockaddr (make-sockaddr-for socket))) - (unless (or buffer length) - (error "Must supply at least one of BUFFER or LENGTH")) - (unless buffer - (setf buffer (make-array length :element-type element-type))) - (sb-alien:with-alien ((sa-len (array (sb-alien:unsigned 32) 2))) - (setf (sb-alien:deref sa-len 0) (size-of-sockaddr socket)) - (sb-sys:with-pinned-objects (buffer sockaddr) - (let ((len - (sockint::recvfrom (socket-file-descriptor socket) - (sb-grovel::array-data-address buffer) - (or length (length buffer)) - flags - (sb-grovel::array-data-address sockaddr) - (sb-alien:cast sa-len (* integer))))) - (when (= len -1) (socket-error "recvfrom")) - (apply #'values buffer len (multiple-value-list - (bits-of-sockaddr socket sockaddr)))))))) + &key + oob peek waitall + (element-type 'character)) + (with-sockaddr-for (socket sockaddr nil) + (let ((flags + (logior (if oob sockint::MSG-OOB 0) + (if peek sockint::MSG-PEEK 0) + (if waitall sockint::MSG-WAITALL 0) + #+linux sockint::MSG-NOSIGNAL ;don't send us SIGPIPE + (if (eql (socket-type socket) :datagram) + sockint::msg-TRUNC 0)))) + (unless (or buffer length) + (error "Must supply at least one of BUFFER or LENGTH")) + (unless length + (setf length (length buffer))) + (let ((copy-buffer (sb-alien:make-alien (array sb-alien:unsigned 1) length))) + (unwind-protect + (sb-alien:with-alien ((sa-len (array (sb-alien:unsigned 32) 2))) + (setf (sb-alien:deref sa-len 0) (size-of-sockaddr socket)) + (let ((len + (sockint::recvfrom (socket-file-descriptor socket) + copy-buffer + length + flags + sockaddr + (sb-alien:cast sa-len (* integer))))) + (when (= len -1) (socket-error "recvfrom")) + (loop for i from 0 below len + do (setf (elt buffer i) (sb-alien:deref copy-buffer i))) + (apply #'values buffer len (multiple-value-list + (bits-of-sockaddr socket sockaddr))))) + (sb-alien:free-alien copy-buffer)))))) Index: sockopt.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sockopt.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- sockopt.lisp 11 Feb 2004 11:00:40 -0000 1.3 +++ sockopt.lisp 27 May 2004 13:58:16 -0000 1.4 @@ -20,7 +20,7 @@ fact that most of these take different data types - some are integers, some are booleans, some are foreign struct instances, etc etc -(define-socket-option lisp-name level number mangle-arg size mangle-return) + (define-socket-option lisp-name level number mangle-arg size mangle-return) macro-expands to two functions that define lisp-name and (setf ,lisp-name) and calls the functions mangle-arg and mangle-return on outgoing and incoming @@ -41,15 +41,15 @@ Code for options that not every system has should be conditionalised: -(if (boundp 'sockint::IP_RECVIF) - (define-socket-option so-receive-interface (getprotobyname "ip") - sockint::IP_RECVIF ... )) + (if (boundp 'sockint::IP_RECVIF) + (define-socket-option so-receive-interface (getprotobyname "ip") + sockint::IP_RECVIF ... )) |# (defmacro define-socket-option - (lisp-name level number mangle-arg size mangle-return) + (lisp-name level number buffer-type mangle-arg mangle-return mangle-setf-buffer) (let ((find-level (if (numberp (eval level)) level @@ -57,48 +57,36 @@ `(progn (export ',lisp-name) (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket))) - (let ((buf (make-array sockint::size-of-int - :element-type '(unsigned-byte 8) - :initial-element 0))) - (sb-sys:with-pinned-objects (buf) - (if (= -1 (sockint::getsockopt - fd ,find-level ,number (sb-grovel::array-data-address buf) ,size)) - (socket-error "getsockopt") - (,mangle-return buf ,size))))) + (sb-alien:with-alien ((size sb-alien:integer) + (buffer ,buffer-type)) + (setf size (sb-alien:alien-size ,buffer-type :bytes)) + (if (= -1 (sockint::getsockopt fd ,find-level ,number + (sb-alien:addr buffer) + (sb-alien:addr size))) + (socket-error "getsockopt") + (,mangle-return buffer size)))) (defun (setf ,lisp-name) (new-val socket &aux (fd (socket-file-descriptor socket))) - (if (= -1 - (sb-sys:without-gcing - (sockint::setsockopt - fd ,find-level ,number (funcall (function ,mangle-arg) new-val ,size) - ,size))) - (socket-error "setsockopt")))))) + (sb-alien:with-alien ((buffer ,buffer-type)) + (setf buffer ,(if mangle-arg + `(,mangle-arg new-val) + `new-val)) + (when (= -1 (sockint::setsockopt fd ,find-level ,number + (,mangle-setf-buffer buffer) + ,(if (eql buffer-type 'sb-alien:c-string) + `(length new-val) + `(sb-alien:alien-size ,buffer-type :bytes)))) + (socket-error "setsockopt"))))))) ;;; sockopts that have integer arguments -(defun int-to-foreign (x size) - ;; can't use with-alien, as the variables it creates only have - ;; dynamic scope. can't use the passed-in size because sap-alien - ;; is a macro and evaluates its second arg at read time - (let* ((v (make-array size :element-type '(unsigned-byte 8) - :initial-element 0)) - (d (sb-grovel::array-data-address v)) - (alien (sb-alien:sap-alien - d; (sb-sys:int-sap d) - (* (sb-alien:signed #.(* 8 sockint::size-of-int)))))) - (setf (sb-alien:deref alien 0) x) - alien)) - -(defun buffer-to-int (x size) - (declare (ignore size)) - (let ((alien (sb-alien:sap-alien - (sb-grovel::array-data-address x) - (* (sb-alien:signed #.(* 8 sockint::size-of-int)))))) - (sb-alien:deref alien))) +(defun foreign-int-to-integer (buffer size) + (assert (= size (sb-alien:alien-size sb-alien:integer :bytes))) + buffer) (defmacro define-socket-option-int (name level number) `(define-socket-option ,name ,level ,number - int-to-foreign sockint::size-of-int buffer-to-int)) + sb-alien:integer nil foreign-int-to-integer sb-alien:addr)) (define-socket-option-int sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat) @@ -110,20 +98,22 @@ sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf) (define-socket-option-int sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf) -(define-socket-option-int +#+linux(define-socket-option-int sockopt-priority sockint::sol-socket sockint::so-priority) ;;; boolean options are integers really -(defun bool-to-foreign (x size) - (int-to-foreign (if x 1 0) size)) +(defun foreign-int-to-bool (x size) + (if (zerop (foreign-int-to-integer x size)) + nil + t)) -(defun buffer-to-bool (x size) - (not (= (buffer-to-int x size) 0))) +(defun bool-to-foreign-int (val) + (if val 1 0)) (defmacro define-socket-option-bool (name level number) `(define-socket-option ,name ,level ,number - bool-to-foreign sockint::size-of-int buffer-to-bool)) + sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr)) (define-socket-option-bool sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr) @@ -131,9 +121,9 @@ sockopt-keep-alive sockint::sol-socket sockint::so-keepalive) (define-socket-option-bool sockopt-oob-inline sockint::sol-socket sockint::so-oobinline) -(define-socket-option-bool +#+linux(define-socket-option-bool sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat) -(define-socket-option-bool +#+linux(define-socket-option-bool sockopt-pass-credentials sockint::sol-socket sockint::so-passcred) (define-socket-option-bool sockopt-debug sockint::sol-socket sockint::so-debug) @@ -144,19 +134,12 @@ (define-socket-option-bool sockopt-tcp-nodelay :tcp sockint::tcp-nodelay) -(defun string-to-foreign (string size) - (declare (ignore size)) - (let ((data (sb-grovel::array-data-address string))) - (sb-alien:sap-alien data (* t)))) - -(defun buffer-to-string (x size) - (declare (ignore size)) - (sb-c-call::%naturalize-c-string - (sb-grovel::array-data-address x))) +(defun identity-1 (x &rest args) + (declare (ignore args)) + x) -(define-socket-option sockopt-bind-to-device sockint::sol-socket - sockint::so-bindtodevice string-to-foreign sockint::ifnamsiz - buffer-to-string) +#+linux(define-socket-option sockopt-bind-to-device sockint::sol-socket + sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity) ;;; other kinds of socket option |