X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=4a5249f55c53d7ec17ac55d52ab9dd4872d9f28d;hb=78fa16bf55be44cc16845be84d98023e83fb14bc;hp=c189e5cb0104e251cb369f3ee573a08ad030b8d9;hpb=bb9313c336417fedcdee98d5eaef3db75d6026dc;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index c189e5c..4a5249f 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -3,19 +3,25 @@
 ;;;; Methods, classes, functions for sockets.  Protocol-specific stuff
 ;;;; is deferred to inet.lisp, unix.lisp, etc
 
-#|| <h2>SOCKETs</h2>
-
-|#
-
 (eval-when (:load-toplevel :compile-toplevel :execute)
 (defclass socket ()
   ((file-descriptor :initarg :descriptor
 		    :reader socket-file-descriptor)
-   (family :initform (error "No socket family") :reader socket-family)
-   (protocol :initarg :protocol :reader socket-protocol)
-   (type  :initarg :type :reader socket-type)
-   (stream))))
-  
+   (family :initform (error "No socket family")
+	   :reader socket-family)
+   (protocol :initarg :protocol
+	     :reader socket-protocol
+	     :documentation "Protocol used by the socket. If a
+keyword, the symbol-name of the keyword will be passed to
+GET-PROTOCOL-BY-NAME downcased, and the returned value used as
+protocol. Other values are used as-is.")
+   (type  :initarg :type
+	  :reader socket-type
+	  :documentation "Type of the socket: :STREAM or :DATAGRAM.")
+   (stream))
+  (:documentation "Common base class of all sockets, not ment to be
+directly instantiated.")))
+
 (defmethod print-object ((object socket) stream)
   (print-unreadable-object (object stream :type t :identity t)
                            (princ "descriptor " stream)
@@ -173,28 +179,38 @@ 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)))))
+					(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))))))
 
-
-
 (defgeneric socket-listen (socket backlog)
   (:documentation "Mark SOCKET as willing to accept incoming connections.  BACKLOG
 defines the maximum length that the queue of pending connections may
@@ -273,7 +289,8 @@ SB-SYS:MAKE-FD-STREAM."))
                        (socket-error-syscall c)
                        (or (socket-error-symbol c) (socket-error-errno c))
                        #+cmu (sb-unix:get-unix-error-msg num)
-                       #+sbcl (sb-int:strerror num))))))
+                       #+sbcl (sb-int:strerror num)))))
+  (:documentation "Common base class of socket related conditions."))
 
 ;;; watch out for slightly hacky symbol punning: we use both the value
 ;;; and the symbol-name of sockint::efoo
@@ -321,6 +338,9 @@ SB-SYS:MAKE-FD-STREAM."))
 
 #+sbcl
 (defun socket-error (where)
+  ;; FIXME: Our Texinfo documentation extracter need at least his to spit
+  ;; out the signature. Real documentation would be better...
+  ""
   (let* ((errno  (sb-unix::get-errno))
          (condition (condition-for-errno errno)))
     (error condition :errno errno  :syscall where)))