X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=072dc079986affa7b588fe05542f37a0fa3eedc7;hb=7e24349c17298e2959e853ea411b5f65d9f7f332;hp=c010811f5dc81275e4f3f6cb1c0ac49a7abd9bb9;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index c010811..072dc07 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -4,6 +4,7 @@
 ;;;; is deferred to inet.lisp, unix.lisp, etc
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
+
 (defclass socket ()
   ((file-descriptor :initarg :descriptor
                     :reader socket-file-descriptor)
@@ -19,7 +20,7 @@ protocol. Other values are used as-is.")
           :reader socket-type
           :documentation "Type of the socket: :STREAM or :DATAGRAM.")
    (stream))
-  (:documentation "Common base class of all sockets, not ment to be
+  (:documentation "Common base class of all sockets, not meant to be
 directly instantiated.")))
 
 (defmethod print-object ((object socket) stream)
@@ -95,7 +96,9 @@ values"))
                                sockaddr
                                (size-of-sockaddr socket))))
       (cond
-        ((and (= fd -1) (= sockint::EAGAIN (sb-unix::get-errno)))
+        ((and (= fd -1)
+              (member (sb-unix::get-errno)
+                      (list sockint::EAGAIN sockint::EINTR)))
          nil)
         ((= fd -1) (socket-error "accept"))
         (t (apply #'values
@@ -199,7 +202,10 @@ small"))
                                         sockaddr
                                         (sb-alien:addr sa-len))))
                 (cond
-                  ((and (= len -1) (= sockint::EAGAIN (sb-unix::get-errno))) nil)
+                  ((and (= len -1)
+                        (member (sb-unix::get-errno)
+                                (list sockint::EAGAIN sockint::EINTR)))
+                   nil)
                   ((= len -1) (socket-error "recvfrom"))
                   (t (loop for i from 0 below len
                            do (setf (elt buffer i)
@@ -211,6 +217,76 @@ small"))
                                                  (bits-of-sockaddr socket sockaddr)))))))
           (sb-alien:free-alien copy-buffer))))))
 
+(defmacro with-vector-sap ((name vector) &body body)
+  `(sb-sys:with-pinned-objects (,vector)
+     (let ((,name (sb-sys:vector-sap ,vector)))
+       ,@body)))
+
+(defgeneric socket-send (socket buffer length
+                                &key
+                                address
+                                external-format
+                                oob eor dontroute dontwait nosignal
+                                #+linux confirm #+linux more)
+  (:documentation
+   "Send LENGTH octets from BUFFER into SOCKET, using sendto(2). If BUFFER
+is a string, it will converted to octets according to EXTERNAL-FORMAT. If
+LENGTH is NIL, the length of the octet buffer is used. The format of ADDRESS
+depends on the socket type (for example for INET domain sockets it would
+be a list of an IP address and a port). If no socket address is provided,
+send(2) will be called instead. Returns the number of octets written."))
+
+(defmethod socket-send ((socket socket) buffer length
+                        &key
+                        address
+                        (external-format :default)
+                        oob eor dontroute dontwait nosignal
+                        #+linux confirm #+linux more)
+  (let* ((flags
+          (logior (if oob sockint::MSG-OOB 0)
+                  (if eor sockint::MSG-EOR 0)
+                  (if dontroute sockint::MSG-DONTROUTE 0)
+                  (if dontwait sockint::MSG-DONTWAIT 0)
+                  (if nosignal sockint::MSG-NOSIGNAL 0)
+                  #+linux (if confirm sockint::MSG-CONFIRM 0)
+                  #+linux (if more sockint::MSG-MORE 0)))
+         (buffer (etypecase buffer
+                   (string
+                    (sb-ext:string-to-octets buffer
+                                             :external-format external-format
+                                             :null-terminate nil))
+                   ((simple-array (unsigned-byte 8))
+                    buffer)
+                   ((array (unsigned-byte 8))
+                    (make-array (length buffer)
+                                :element-type '(unsigned-byte 8)
+                                :initial-contents buffer))))
+         (len (with-vector-sap (buffer-sap buffer)
+                (unless length
+                  (setf length (length buffer)))
+                (if address
+                    (with-sockaddr-for (socket sockaddr address)
+                      (sb-alien:with-alien ((sa-len sockint::socklen-t
+                                                    (size-of-sockaddr socket)))
+                        (sockint::sendto (socket-file-descriptor socket)
+                                         buffer-sap
+                                         length
+                                         flags
+                                         sockaddr
+                                         sa-len)))
+                    (sockint::send (socket-file-descriptor socket)
+                                   buffer-sap
+                                   length
+                                   flags)))))
+    (cond
+      ((and (= len -1)
+            (member (sb-unix::get-errno)
+                    (list sockint::EAGAIN sockint::EINTR)))
+       nil)
+      ((= len -1)
+       (socket-error "sendto"))
+      (t len))))
+
 (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