X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=03b63443f9ad2efa8c7d5d1ca649f81dc41721b7;hb=73f066da2ffbfd709a9d68f07d245e4142231ee7;hp=caaccc890e31a8aa7c21d9b7538873a6b0b184d7;hpb=a47a7fa6e6164ab94ea7b3c9e0025a062c44fcde;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index caaccc8..03b6344 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -88,15 +88,17 @@ values"))
     (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))))))
+      (cond
+	((and (= fd -1) (= sockint::EAGAIN (sb-unix::get-errno)))
+	 nil)
+	((= fd -1) (socket-error "accept"))
+	(t (apply #'values
+		  (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
@@ -171,22 +173,36 @@ small"))
 	(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)))
+      (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)))
+      ;; 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)))))
-		(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: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)
+				    (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))))))
 
 
@@ -278,19 +294,19 @@ SB-SYS:MAKE-FD-STREAM."))
   `(progn
      (define-condition ,name (socket-error)
        ((symbol :reader socket-error-symbol :initform (quote ,symbol))))
+     (export ',name)
      (push (cons ,symbol (quote ,name)) *conditions-for-errno*)))
 
 (defparameter *conditions-for-errno* nil)
 ;;; this needs the rest of the list adding to it, really.  They also
-;;; need
-;;; - conditions to be exported in the DEFPACKAGE form
-;;; - symbols to be added to constants.ccon
+;;; need symbols to be added to constants.ccon
 ;;; I haven't yet thought of a non-kludgey way of keeping all this in
 ;;; the same place
 (define-socket-condition sockint::EADDRINUSE address-in-use-error)
 (define-socket-condition sockint::EAGAIN interrupted-error)
 (define-socket-condition sockint::EBADF bad-file-descriptor-error)
 (define-socket-condition sockint::ECONNREFUSED connection-refused-error)
+(define-socket-condition sockint::ETIMEDOUT operation-timeout-error)
 (define-socket-condition sockint::EINTR interrupted-error)
 (define-socket-condition sockint::EINVAL invalid-argument-error)
 (define-socket-condition sockint::ENOBUFS no-buffers-error)