[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: sb-bsd-sockets: Minor, mostly cosmetic, changes
From:       "Jan Moringen" <scymtym () users ! sourceforge ! net>
Date:       2014-09-27 18:31:53
Message-ID: E1XXwmi-0007VK-Sp () sfs-ml-2 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  8e7b76732e065fcf85f0108015a6df047847d019 (commit)
      from  9531069cba0bafd9969be164abb12ec6fb5ca348 (commit)

- Log -----------------------------------------------------------------
commit 8e7b76732e065fcf85f0108015a6df047847d019
Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date:   Fri Apr 18 20:59:55 2014 +0200

    sb-bsd-sockets: Minor, mostly cosmetic, changes
---
 contrib/sb-bsd-sockets/defpackage.lisp    |    4 +-
 contrib/sb-bsd-sockets/inet.lisp          |    5 ++-
 contrib/sb-bsd-sockets/local.lisp         |   29 ++++++++++++--------
 contrib/sb-bsd-sockets/sb-bsd-sockets.asd |    9 +++++-
 contrib/sb-bsd-sockets/sockets.lisp       |   41 +++++++++++++++--------------
 5 files changed, 50 insertions(+), 38 deletions(-)

diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index a690fbb..f95bd86 100644
--- a/contrib/sb-bsd-sockets/defpackage.lisp
+++ b/contrib/sb-bsd-sockets/defpackage.lisp
@@ -6,7 +6,7 @@
 
 (defpackage "SB-BSD-SOCKETS"
   (:export socket local-socket local-abstract-socket inet-socket
-           make-inet-socket
+           make-inet-socket ; deprecated
            socket-bind socket-accept socket-connect
            socket-send socket-receive
            socket-name socket-peername socket-listen
@@ -56,7 +56,7 @@ arguments to fit Lisp style more closely."))
 ;;; thread-safe on OS X, but they probably can't be any worse than
 ;;; gethostbyname and gethostbyaddr.
 ;;;
-;;; CLH: getaddrinfo seems to be broken is broken on x86-64/darwin
+;;; CLH: getaddrinfo seems to be broken on x86-64/darwin
 #-(or win32 (and x86-64 darwin))
 (let ((addr (sb-alien::find-dynamic-foreign-symbol-address "getaddrinfo")))
   (when addr
diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index 55f62bb..6b5cead 100644
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -14,8 +14,7 @@ Examples:
  (make-instance 'inet-socket :type :datagram :protocol :udp)
 ")))
 
-;;; XXX should we *...* this?
-(defparameter inet-address-any (vector 0 0 0 0))
+(defparameter *inet-address-any* (vector 0 0 0 0))
 
 (defmethod socket-namestring ((socket inet-socket))
   (ignore-errors
@@ -172,10 +171,12 @@ a list of protocol aliases"
 ;;; bits-of-sockaddr
 
 (defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address)
+  (check-type address (or null (cons sequence (cons (unsigned-byte 16)))))
   (let ((host (first address))
         (port (second address))
         (sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
     (when (and host port)
+      (assert (= (length host) 4))
       (let ((in-port (sockint::sockaddr-in-port sockaddr))
             (in-addr (sockint::sockaddr-in-addr sockaddr)))
         (declare (fixnum port))
diff --git a/contrib/sb-bsd-sockets/local.lisp b/contrib/sb-bsd-sockets/local.lisp
index 1c9e9ae..55dd7a6 100644
--- a/contrib/sb-bsd-sockets/local.lisp
+++ b/contrib/sb-bsd-sockets/local.lisp
@@ -2,7 +2,8 @@
 
 (defclass local-socket (socket)
   ((family :initform sockint::af-local))
-  (:documentation "Class representing local domain (AF_LOCAL) sockets,
+  (:documentation
+   "Class representing local domain (AF_LOCAL) sockets,
 also known as unix-domain sockets."))
 
 (defmethod socket-namestring ((socket local-socket))
@@ -12,8 +13,9 @@ also known as unix-domain sockets."))
   (ignore-errors (socket-peername socket)))
 
 (defmethod make-sockaddr-for ((socket local-socket)
-                              &optional sockaddr &rest address &aux (filename (first address)))
-  (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
+                              &optional sockaddr &rest address)
+  (let ((filename (first address))
+        (sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
     (setf (sockint::sockaddr-un-family sockaddr) sockint::af-local)
     (when filename
       (setf (sockint::sockaddr-un-path sockaddr) filename))
@@ -28,31 +30,34 @@ also known as unix-domain sockets."))
 (defmethod bits-of-sockaddr ((socket local-socket) sockaddr)
   "Return the file name of the local socket address SOCKADDR."
   (let ((name (sockint::sockaddr-un-path sockaddr)))
-    (if (zerop (length name)) nil name)))
+    (unless (zerop (length name)) name)))
 
 (defclass local-abstract-socket (local-socket) ()
-  (:documentation "Class representing local domain (AF_LOCAL) sockets with
-addresses in the abstract namespace."))
+  (:documentation
+   "Class representing local domain (AF_LOCAL) sockets with addresses
+in the abstract namespace."))
 
 (defmethod make-sockaddr-for ((socket local-abstract-socket)
-                              &optional sockaddr &rest address
-                              &aux (path (first address)))
-  (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un-abstract)))
+                              &optional sockaddr &rest address)
+  (check-type address (or null (cons (or string pathname) null)))
+  (let ((path (first address))
+        (sockaddr (or sockaddr (sockint::allocate-sockaddr-un-abstract)))
         (len 0))
     (setf (sockint::sockaddr-un-abstract-family sockaddr) sockint::af-local)
-    ;;First byte of the path is always 0.
+    ;; First byte of the path is always 0.
     (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr) 0) 0)
 
     (when path
       (when (stringp path)
         (setf path (sb-ext:string-to-octets path)))
       (setf len (min (- sockint::size-of-sockaddr-un-abstract 3) (length path)))
-      ;;We fill in the rest of the path starting at index 1.
+      ;; We fill in the rest of the path starting at index 1.
       (loop for i from 0 below len
             do (setf (sb-alien:deref (sockint::sockaddr-un-abstract-path
                                       sockaddr)
                                      (1+ i))
                      (elt path i))))
+
     (values sockaddr (+ 3 len))))
 
 (defmethod free-sockaddr-for ((socket local-abstract-socket) sockaddr)
@@ -67,7 +72,7 @@ addresses in the abstract namespace."))
          (path (make-array `(,path-len)
                            :element-type '(unsigned-byte 8)
                            :initial-element 0)))
-    ;;exclude the first byte (it's always null) of the address
+    ;; Exclude the first byte (it's always null) of the address.
     (loop for i from 1 to path-len
           do (setf (elt path (1- i))
                    (sb-alien:deref (sockint::sockaddr-un-abstract-path sockaddr)
diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
index cc5af7d..f639620 100644
--- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
+++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
@@ -21,11 +21,16 @@
    (:file "local" :depends-on ("sockets" "split"))
    (:file "name-service" :depends-on ("sockets"))
    (:file "misc" :depends-on ("sockets"))
-   (:static-file "NEWS")
+
+   ;; FIXME at least NEWS and TODO actually exist in the
+   ;; filesystem. However, their all-uppercase names are translated to
+   ;; all-lowercase in logical pathname translation.
+   ;; (:static-file "NEWS")
    ;; (:static-file "INSTALL")
    ;; (:static-file "README")
    ;; (:static-file "index.html")
-   (:static-file "TODO"))
+   ;; (:static-file "TODO")
+   )
   :perform (load-op :after (o c) (provide 'sb-bsd-sockets))
   :perform (test-op (o c) (test-system 'sb-bsd-sockets/tests)))
 
diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 790fbe4..79f0702 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -1,4 +1,4 @@
-(in-package "SB-BSD-SOCKETS")
+(in-package :sb-bsd-sockets)
 
 ;;;; Methods, classes, functions for sockets.  Protocol-specific stuff
 ;;;; is deferred to inet.lisp, unix.lisp, etc
@@ -15,7 +15,7 @@
 (defclass socket ()
   ((file-descriptor :initarg :descriptor
                     :reader socket-file-descriptor)
-   (family :initform (error "No socket family")
+   (family :initform (error "No socket family") ; subclasses supply initforms
            :reader socket-family)
    (protocol :initarg :protocol
              :reader socket-protocol
@@ -29,7 +29,9 @@ protocol. Other values are used as-is.")
    #+win32
    (non-blocking-p :type (member t nil) :initform nil)
    (stream))
-  (:documentation "Common base class of all sockets, not meant to be
+  (:default-initargs
+   :type (sb-int:missing-arg))
+  (:documentation "Common superclass of all sockets, not meant to be
 directly instantiated.")))
 
 (defmethod print-object ((object socket) stream)
@@ -64,7 +66,7 @@ directly instantiated.")))
                                     ((:datagram) sockint::sock-dgram)
                                     ((:stream) sockint::sock-stream))
                                   proto-num))))
-      (if (= fd -1) (socket-error "socket"))
+      (when (= fd -1) (socket-error "socket"))
       (setf (slot-value socket 'file-descriptor) fd
             (slot-value socket 'protocol) proto-num
             (slot-value socket 'type) type)
@@ -99,11 +101,11 @@ See also bind(2)"))
 (defmethod socket-bind ((socket socket)
                         &rest address)
   (with-sockaddr-for (socket sockaddr address)
-    (if (= (sockint::bind (socket-file-descriptor socket)
-                          sockaddr
-                          (size-of-sockaddr socket))
-           -1)
-        (socket-error "bind"))))
+    (when (= (sockint::bind (socket-file-descriptor socket)
+                            sockaddr
+                            (size-of-sockaddr socket))
+             -1)
+      (socket-error "bind"))))
 
 
 (defgeneric socket-accept (socket)
@@ -122,14 +124,14 @@ values"))
                       (list sockint::EAGAIN sockint::EINTR)))
          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))
-                                     :dont-save t))
-                  (multiple-value-list (bits-of-sockaddr socket sockaddr))))))))
+        (t (multiple-value-call #'values
+             (let ((socket (make-instance (class-of socket)
+                                          :type (socket-type socket)
+                                          :protocol (socket-protocol socket)
+                                          :descriptor fd)))
+               (sb-ext:finalize socket (lambda () (sockint::close fd))
+                                :dont-save t))
+             (bits-of-sockaddr socket sockaddr)))))))
 
 (defgeneric socket-connect (socket &rest address)
   (:documentation "Perform the connect(2) call to connect SOCKET to a
@@ -525,14 +527,13 @@ request an input stream and get an output stream in response\)."
 
 #+sbcl
 (defun socket-error (where)
-  ;; FIXME: Our Texinfo documentation extracter need at least his to spit
-  ;; out the signature. Real documentation would be better...
+  ;; FIXME: Our Texinfo documentation extractor needs at least this to
+  ;; spit out the signature. Real documentation would be better...
   ""
   (let* ((errno (socket-errno))
          (condition (condition-for-errno errno)))
     (error condition :errno errno  :syscall where)))
 
-
 (defgeneric bits-of-sockaddr (socket sockaddr)
   (:documentation "Return protocol-dependent bits of parameter
 SOCKADDR, e.g. the Host/Port if SOCKET is an inet socket."))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Meet PCI DSS 3.0 Compliance Requirements with EventLog Analyzer
Achieve PCI DSS 3.0 Compliant Status with Out-of-the-box PCI DSS Reports
Are you Audit-Ready for PCI DSS 3.0 Compliance? Download White paper
Comply to PCI DSS 3.0 Requirement 10 and 11.5 with EventLog Analyzer
http://pubads.g.doubleclick.net/gampad/clk?id=154622311&iu=/4140/ostg.clktrk
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread] 

Configure | About | News | Add a list | Sponsored by KoreLogic