0.8.12.54:

	Various rather urgent sb-grovel and sb-bsd-sockets fixes.

	* sb-grovel uses WITH-ALIEN now for the WITH-* macros,
	  to allow use of SB-ALIEN:ADDR on variables allocated that way.
	* sb-bsd-sockets: name-service code now return addresses as vectors
	  again.
	* sb-bsd-sockets: fix socket-receive into relative workingness
	  again: use (deref (deref array) i) instead of (deref array i);
	  type-convert the results

diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp
index e8004f4..22f6793 100644 (file)
--- a/contrib/sb-bsd-sockets/constants.lisp
+++ b/contrib/sb-bsd-sockets/constants.lisp
@@ -94,6 +94,9 @@
  (:integer msg-trunc "MSG_TRUNC")
  (:integer msg-waitall "MSG_WAITALL")
 
+ ;; for socket-receive
+ (:type socklen-t "socklen_t")
+
  #|
  ;;; stat is nothing to do with sockets, but I keep it around for testing
  ;;; the ffi glue
@@ -166,7 +169,7 @@
                                 (len integer)
                                 (flags integer)
                                 (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
-                                (socklen (* integer))))
+                                (socklen (* socklen-t))))
  (:function gethostbyname ("gethostbyname" (* hostent) (name c-string)))
  (:function gethostbyaddr ("gethostbyaddr" (* hostent)
                                           (addr (* t))

diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index 8015908..ab5b81e 100644 (file)
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -40,8 +40,10 @@ eventually, so that we can do DNS lookups in parallel with other things
                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)))
+                            (assert (= length 4))
+                            (let ((addr (make-array 4 :element-type '(unsigned-byte 8))))
+                              (loop for i from 0 below length
+                                    do (setf (elt addr i) (sb-alien:deref ad i)))))
                          (#.sockint::af-local
                           (sb-alien:cast ad sb-alien:c-string))))))
     (make-instance 'host-ent

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 384ca10..03b6344 100644 (file)
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -173,24 +173,34 @@ small"))
        (error "Must supply at least one of BUFFER or LENGTH"))
       (unless length
        (setf length (length buffer)))
+      (when buffer (setf element-type (array-element-type buffer)))
+      (unless (or (subtypep element-type 'character)
+                 (subtypep element-type 'integer))
+       (error "Buffer element-type must be either a character or an integer subtype."))
       (unless buffer
        (setf buffer (make-array length :element-type element-type)))
-      (let ((copy-buffer (sb-alien:make-alien (array sb-alien:unsigned 1) length)))
+      ;; really big FIXME: This whole copy-buffer thing is broken.
+      ;; doesn't support characters more than 8 bits wide, or integer
+      ;; types that aren't (unsigned-byte 8).
+      (let ((copy-buffer (sb-alien:make-alien (array (sb-alien:unsigned 8) 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))
+           (sb-alien:with-alien ((sa-len sockint::socklen-t (size-of-sockaddr socket)))
              (let ((len
                     (sockint::recvfrom (socket-file-descriptor socket)
                                        copy-buffer
                                        length
                                        flags
                                        sockaddr
-                                       (sb-alien:cast sa-len (* integer)))))
+                                       (sb-alien:addr sa-len))))
                (cond
                  ((and (= len -1) (= sockint::EAGAIN (sb-unix::get-errno))) nil)
                  ((= len -1) (socket-error "recvfrom"))
                  (t (loop for i from 0 below len
-                          do (setf (elt buffer i) (sb-alien:deref copy-buffer i)))
+                          do (setf (elt buffer i)
+                                   (cond
+                                     ((or (eql element-type 'character) (eql element-type 'base-char))
+                                      (code-char (sb-alien:deref (sb-alien:deref copy-buffer) i)))
+                                     (t (sb-alien:deref (sb-alien:deref copy-buffer) i)))))
                     (apply #'values buffer len (multiple-value-list
                                                 (bits-of-sockaddr socket sockaddr)))))))
          (sb-alien:free-alien copy-buffer))))))

diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index 5d15ab0..3fec556 100644 (file)
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -102,6 +102,11 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
       (setf (elt buffer i) c))))
 
+#+internet-available
+(deftest name-service-return-type
+  (vectorp (host-ent-address (get-host-by-address #(127 0 0 1))))
+  t)
+
 ;;; these require that the echo services are turned on in inetd
 #+internet-available
 (deftest simple-tcp-client
@@ -116,6 +121,18 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
   t)
 
 #+internet-available
+(deftest sockaddr-return-type
+  (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
+    (unwind-protect 
+        (progn
+          (socket-connect s #(127 0 0 1) 7)
+          (multiple-value-bind (host port) (socket-peername s)
+            (and (vectorp host)
+                 (numberp port))))
+      (socket-close s)))
+  t)
+
+#+internet-available
 (deftest simple-udp-client
   (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
         (data (make-string 200)))

diff --git a/contrib/sb-grovel/foreign-glue.lisp b/contrib/sb-grovel/foreign-glue.lisp
index 457e453..a98cca1 100644 (file)
--- a/contrib/sb-grovel/foreign-glue.lisp
+++ b/contrib/sb-grovel/foreign-glue.lisp
@@ -365,7 +365,7 @@ deeply nested structures."
                                         (symbol-name ',name) "-"
                                         (symbol-name x))
                            ,(symbol-package name))))
-          `(let ((,var ,'(,(intern (format nil "ALLOCATE-~A" name)))))
+          `(sb-alien:with-alien ((,var (* ,',name) ,'(,(intern (format nil "ALLOCATE-~A" name)))))
              (unwind-protect
                  (progn
                    (progn ,@(mapcar (lambda (pair)

diff --git a/version.lisp-expr b/version.lisp-expr
index 1c77f5b..5ffaf57 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.12.53"
+"0.8.12.54"