On Wed, 2014-09-17 at 10:08 +0200, Hans Hübner wrote:
> I'm going to come up with a more complete IPv6 update to
> sb-bsd-sockets in the next few days and try to get it merged into
> SBCL.
In the meantime, I extended the patch you mentioned to the attached
form.
Should I polish it, get it reviewed by other SBCL developers and commit
it or would you prefer to write IPv6 support yourself, maybe using the
patch as a starting point? (I'm not asking sarcastically since you may
have a very different implementation in mind)
Kind regards,
Jan
From 2f0da13e0388f5254f855e42f025a8a688380fa0 Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmori...@techfak.uni-bielefeld.de>
Date: Fri, 18 Apr 2014 19:53:50 +0200
Subject: [PATCH 1/4] Separate inet and inet4 in contrib/sb-bsd-sockets
---
contrib/sb-bsd-sockets/inet.lisp | 110 +----------------------------
contrib/sb-bsd-sockets/inet4.lisp | 111 ++++++++++++++++++++++++++++++
contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 5 +-
3 files changed, 115 insertions(+), 111 deletions(-)
create mode 100644 contrib/sb-bsd-sockets/inet4.lisp
diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index 42f207e..608c96e 100644
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -1,61 +1,6 @@
(in-package :sb-bsd-sockets)
-;;; Our class and constructor
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defclass inet-socket (socket)
- ((family :initform sockint::AF-INET))
- (:documentation "Class representing TCP and UDP sockets.
-
-Examples:
-
- (make-instance 'inet-socket :type :stream :protocol :tcp)
-
- (make-instance 'inet-socket :type :datagram :protocol :udp)
-")))
-
-;;; XXX should we *...* this?
-(defparameter inet-address-any (vector 0 0 0 0))
-
-(defmethod socket-namestring ((socket inet-socket))
- (ignore-errors
- (multiple-value-bind (addr port) (socket-name socket)
- (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
-
-(defmethod socket-peerstring ((socket inet-socket))
- (ignore-errors
- (multiple-value-bind (addr port) (socket-peername socket)
- (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
-
-;;; binding a socket to an address and port. Doubt that anyone's
-;;; actually using this much, to be honest.
-
-(defun make-inet-address (dotted-quads)
- "Return a vector of octets given a string DOTTED-QUADS in the format
-\"127.0.0.1\". Signals an error if the string is malformed."
- (declare (type string dotted-quads))
- (labels ((oops ()
- (error "~S is not a string designating an IP address."
- dotted-quads))
- (check (x)
- (if (typep x '(unsigned-byte 8))
- x
- (oops))))
- (let* ((s1 (position #\. dotted-quads))
- (s2 (if s1 (position #\. dotted-quads :start (1+ s1)) (oops)))
- (s3 (if s2 (position #\. dotted-quads :start (1+ s2)) (oops)))
- (u0 (parse-integer dotted-quads :end s1))
- (u1 (parse-integer dotted-quads :start (1+ s1) :end s2))
- (u2 (parse-integer dotted-quads :start (1+ s2) :end s3)))
- (multiple-value-bind (u3 end) (parse-integer dotted-quads :start (1+ s3) :junk-allowed t)
- (unless (= end (length dotted-quads))
- (oops))
- (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
- (setf (aref vector 0) (check u0)
- (aref vector 1) (check u1)
- (aref vector 2) (check u2)
- (aref vector 3) (check u3))
- vector)))))
+;;;
(define-condition unknown-protocol ()
((name :initarg :name
@@ -147,56 +92,3 @@ a list of protocol aliases"
(get-it))
:error
(error 'unknown-protocol :name name))))
-
-;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
-;;; bits-of-sockaddr
-
-(defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address)
- (let ((host (first address))
- (port (second address))
- (sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
- (when (and host port)
- (let ((in-port (sockint::sockaddr-in-port sockaddr))
- (in-addr (sockint::sockaddr-in-addr sockaddr)))
- (declare (fixnum port))
- ;; port and host are represented in C as "network-endian" unsigned
- ;; integers of various lengths. This is stupid. The value of the
- ;; integer doesn't matter (and will change depending on your
- ;; machine's endianness); what the bind(2) call is interested in
- ;; is the pattern of bytes within that integer.
-
- ;; We have no truck with such dreadful type punning. Octets to
- ;; octets, dust to dust.
- (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
- (setf (sb-alien:deref in-port 0) (ldb (byte 8 8) port))
- (setf (sb-alien:deref in-port 1) (ldb (byte 8 0) port))
-
- (setf (sb-alien:deref in-addr 0) (elt host 0))
- (setf (sb-alien:deref in-addr 1) (elt host 1))
- (setf (sb-alien:deref in-addr 2) (elt host 2))
- (setf (sb-alien:deref in-addr 3) (elt host 3))))
- sockaddr))
-
-(defmethod free-sockaddr-for ((socket inet-socket) sockaddr)
- (sockint::free-sockaddr-in sockaddr))
-
-(defmethod size-of-sockaddr ((socket inet-socket))
- sockint::size-of-sockaddr-in)
-
-(defmethod bits-of-sockaddr ((socket inet-socket) sockaddr)
- "Returns address and port of SOCKADDR as multiple values"
- (declare (type (sb-alien:alien
- (* (sb-alien:struct sb-bsd-sockets-internal::sockaddr-in)))
- sockaddr))
- (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
- (loop for i below 4
- do (setf (aref vector i)
- (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i)))
- (values
- vector
- (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
- (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1)))))
-
-(defun make-inet-socket (type protocol)
- "Make an INET socket. Deprecated in favour of make-instance"
- (make-instance 'inet-socket :type type :protocol protocol))
diff --git a/contrib/sb-bsd-sockets/inet4.lisp b/contrib/sb-bsd-sockets/inet4.lisp
new file mode 100644
index 0000000..635f02e
--- /dev/null
+++ b/contrib/sb-bsd-sockets/inet4.lisp
@@ -0,0 +1,111 @@
+(in-package :sb-bsd-sockets)
+
+;;; Our class and constructor
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defclass inet-socket (socket)
+ ((family :initform sockint::AF-INET))
+ (:documentation "Class representing TCP and UDP over IPv4 sockets.
+
+Examples:
+
+ (make-instance 'inet-socket :type :stream :protocol :tcp)
+
+ (make-instance 'inet-socket :type :datagram :protocol :udp)
+")))
+
+;;; XXX should we *...* this?
+(defparameter inet-address-any (vector 0 0 0 0))
+
+(defmethod socket-namestring ((socket inet-socket))
+ (ignore-errors
+ (multiple-value-bind (addr port) (socket-name socket)
+ (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
+(defmethod socket-peerstring ((socket inet-socket))
+ (ignore-errors
+ (multiple-value-bind (addr port) (socket-peername socket)
+ (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
+;;; binding a socket to an address and port. Doubt that anyone's
+;;; actually using this much, to be honest.
+
+(defun make-inet-address (dotted-quads)
+ "Return a vector of octets given a string DOTTED-QUADS in the format
+\"127.0.0.1\". Signals an error if the string is malformed."
+ (declare (type string dotted-quads))
+ (labels ((oops ()
+ (error "~S is not a string designating an IP address."
+ dotted-quads))
+ (check (x)
+ (if (typep x '(unsigned-byte 8))
+ x
+ (oops))))
+ (let* ((s1 (position #\. dotted-quads))
+ (s2 (if s1 (position #\. dotted-quads :start (1+ s1)) (oops)))
+ (s3 (if s2 (position #\. dotted-quads :start (1+ s2)) (oops)))
+ (u0 (parse-integer dotted-quads :end s1))
+ (u1 (parse-integer dotted-quads :start (1+ s1) :end s2))
+ (u2 (parse-integer dotted-quads :start (1+ s2) :end s3)))
+ (multiple-value-bind (u3 end) (parse-integer dotted-quads :start (1+ s3) :junk-allowed t)
+ (unless (= end (length dotted-quads))
+ (oops))
+ (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
+ (setf (aref vector 0) (check u0)
+ (aref vector 1) (check u1)
+ (aref vector 2) (check u2)
+ (aref vector 3) (check u3))
+ vector)))))
+
+;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
+;;; bits-of-sockaddr
+
+(defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address)
+ (let ((host (first address))
+ (port (second address))
+ (sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
+ (when (and host port)
+ (let ((in-port (sockint::sockaddr-in-port sockaddr))
+ (in-addr (sockint::sockaddr-in-addr sockaddr)))
+ (declare (fixnum port))
+ ;; port and host are represented in C as "network-endian" unsigned
+ ;; integers of various lengths. This is stupid. The value of the
+ ;; integer doesn't matter (and will change depending on your
+ ;; machine's endianness); what the bind(2) call is interested in
+ ;; is the pattern of bytes within that integer.
+
+ ;; We have no truck with such dreadful type punning. Octets to
+ ;; octets, dust to dust.
+ (setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
+ (setf (sb-alien:deref in-port 0) (ldb (byte 8 8) port))
+ (setf (sb-alien:deref in-port 1) (ldb (byte 8 0) port))
+
+ (setf (sb-alien:deref in-addr 0) (elt host 0))
+ (setf (sb-alien:deref in-addr 1) (elt host 1))
+ (setf (sb-alien:deref in-addr 2) (elt host 2))
+ (setf (sb-alien:deref in-addr 3) (elt host 3))))
+ sockaddr))
+
+(defmethod free-sockaddr-for ((socket inet-socket) sockaddr)
+ (sockint::free-sockaddr-in sockaddr))
+
+(defmethod size-of-sockaddr ((socket inet-socket))
+ sockint::size-of-sockaddr-in)
+
+(defmethod bits-of-sockaddr ((socket inet-socket) sockaddr)
+ "Returns address and port of SOCKADDR as multiple values"
+ (declare (type (sb-alien:alien
+ (* (sb-alien:struct sb-bsd-sockets-internal::sockaddr-in)))
+ sockaddr))
+ (let ((vector (make-array 4 :element-type '(unsigned-byte 8))))
+ (loop for i below 4
+ do (setf (aref vector i)
+ (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i)))
+ (values
+ vector
+ (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
+ (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1)))))
+
+(defun make-inet-socket (type protocol)
+ "Make an INET socket. Deprecated in favour of make-instance"
+ (make-instance 'inet-socket :type type :protocol protocol))
diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
index cc5af7d..b29ab9c 100644
--- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
+++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
@@ -17,8 +17,9 @@
:depends-on ("win32-constants") :if-feature :win32)
(:file "sockets" :depends-on ("constants" "win32-sockets"))
(:file "sockopt" :depends-on ("sockets"))
- (:file "inet" :depends-on ("sockets" "split"))
- (:file "local" :depends-on ("sockets" "split"))
+ (:file "inet" :depends-on ("sockets"))
+ (:file "inet4" :depends-on ("sockets"))
+ (:file "local" :depends-on ("sockets"))
(:file "name-service" :depends-on ("sockets"))
(:file "misc" :depends-on ("sockets"))
(:static-file "NEWS")
--
2.1.0
From 9f80730931eb57427f9881efe4ac1cb3946499e1 Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmori...@techfak.uni-bielefeld.de>
Date: Sun, 3 Mar 2013 20:14:47 +0100
Subject: [PATCH 2/4] Initial addition of inet6.lisp
---
contrib/sb-bsd-sockets/constants.lisp | 14 +++++
contrib/sb-bsd-sockets/defpackage.lisp | 2 +-
contrib/sb-bsd-sockets/inet4.lisp | 14 +++--
contrib/sb-bsd-sockets/inet6.lisp | 100 ++++++++++++++++++++++++++++++
contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 1 +
contrib/sb-bsd-sockets/sockets.lisp | 10 +--
6 files changed, 131 insertions(+), 10 deletions(-)
create mode 100644 contrib/sb-bsd-sockets/inet6.lisp
diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp
index de0e2e8..6cd4155 100644
--- a/contrib/sb-bsd-sockets/constants.lisp
+++ b/contrib/sb-bsd-sockets/constants.lisp
@@ -171,6 +171,20 @@
;; of the old sb-grovel scheme.
((array (unsigned 8)) port "u_int16_t" "sin_port")
((array (unsigned 8)) addr "struct in_addr" "sin_addr")))
+ (:structure in6-addr ("struct in6_addr"
+ ((array (unsigned 8)) addr "unsigned char" "s6_addr[16]")))
+ (:structure sockaddr-in6 ("struct sockaddr_in6"
+ #+darwin ((unsigned 8) len "__uint8_t" "sin_len")
+ (integer family "sa_family_t" "sin6_family")
+ ;; These two could be in-port-t and
+ ;; in-addr-t, but then we'd throw away the
+ ;; convenience (and byte-order agnosticism)
+ ;; of the old sb-grovel scheme.
+ ((array (unsigned 8)) port "u_int16_t" "sin6_port")
+ ((array (unsigned 8)) flowinfo "u_int32_t" "sin6_flowinfo")
+
+ ((array (unsigned 8)) addr "struct in_addr6" "sin6_addr")
+ ((array (unsigned 8)) scope-id "u_int32_t" "sin6_scope_id")))
(:structure sockaddr-un ("struct sockaddr_un"
(integer family "sa_family_t" "sun_family")
(c-string path "char" "sun_path")))
diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index a690fbb..956c851 100644
--- a/contrib/sb-bsd-sockets/defpackage.lisp
+++ b/contrib/sb-bsd-sockets/defpackage.lisp
@@ -5,7 +5,7 @@
(:use "COMMON-LISP" "SB-ALIEN" "SB-EXT"))
(defpackage "SB-BSD-SOCKETS"
- (:export socket local-socket local-abstract-socket inet-socket
+ (:export socket local-socket local-abstract-socket inet-socket inet6-socket
make-inet-socket
socket-bind socket-accept socket-connect
socket-send socket-receive
diff --git a/contrib/sb-bsd-sockets/inet4.lisp b/contrib/sb-bsd-sockets/inet4.lisp
index 635f02e..655821a 100644
--- a/contrib/sb-bsd-sockets/inet4.lisp
+++ b/contrib/sb-bsd-sockets/inet4.lisp
@@ -17,15 +17,21 @@ Examples:
;;; XXX should we *...* this?
(defparameter inet-address-any (vector 0 0 0 0))
+(defun address-numbers/v4 (address)
+ (coerce address 'list))
+
+(defun endpoint-string/v4 (address port)
+ (format nil "~{~A~^.~}:~A" (address-numbers/v4 address) port))
+
(defmethod socket-namestring ((socket inet-socket))
(ignore-errors
- (multiple-value-bind (addr port) (socket-name socket)
- (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+ (multiple-value-bind (address port) (socket-name socket)
+ (endpoint-string/v4 address port))))
(defmethod socket-peerstring ((socket inet-socket))
(ignore-errors
- (multiple-value-bind (addr port) (socket-peername socket)
- (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+ (multiple-value-bind (address port) (socket-peername socket)
+ (endpoint-string/v4 address port))))
;;; binding a socket to an address and port. Doubt that anyone's
;;; actually using this much, to be honest.
diff --git a/contrib/sb-bsd-sockets/inet6.lisp b/contrib/sb-bsd-sockets/inet6.lisp
new file mode 100644
index 0000000..b3808e6
--- /dev/null
+++ b/contrib/sb-bsd-sockets/inet6.lisp
@@ -0,0 +1,100 @@
+(in-package :sb-bsd-sockets)
+
+;;; Socket class and constructor
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defclass inet6-socket (socket)
+ ((family :initform sockint::AF-INET6))
+ (:documentation "Class representing TCP and UDP over IPv6 sockets.
+
+Examples:
+
+ (make-instance 'inet-socket6 :type :stream :protocol :tcp)
+
+ (make-instance 'inet-socket6 :type :datagram :protocol :udp)
+")))
+
+(defparameter *inet6-address-any* (vector 0 0 0 0))
+
+(defun address-numbers/v6 (address)
+ (loop for i from 0 below 8 by 2
+ collect (let ((number (+ (* 256 (aref address i))
+ (aref address (1+ i)))))
+ (unless (zerop number) number))))
+
+(defun endpoint-string/v6 (address port)
+ (format nil "~{~@[~(~X~)~]~^:~}:~A"
+ (address-numbers/v6 address) port))
+
+(defmethod socket-namestring ((socket inet6-socket))
+ (ignore-errors
+ (multiple-value-bind (address port) (socket-name socket)
+ (endpoint-string/v6 address port))))
+
+(defmethod socket-peerstring ((socket inet6-socket))
+ (ignore-errors
+ (multiple-value-bind (address port) (socket-peername socket)
+ (endpoint-string/v6 address port))))
+
+;; Binding a socket to an address and port. Doubt that anyone's
+;; actually using this much, to be honest.
+(defun make-inet6-address (colon-separated-integers)
+ "Return a vector of octets given a TODO. Signals an error if the string is malformed."
+ (declare (type string colon-separated-integers))
+ (let ((address (make-array 16 :element-type '(unsigned-byte 8)))
+ (i 0))
+ (dolist (component (split colon-separated-integers 8 '(#\:)))
+ (multiple-value-bind (high low)
+ (floor (parse-integer component :radix 16) 256)
+ (check-type high (unsigned-byte 8) #+maybe octet)
+ (check-type low (unsigned-byte 8) #+maybe octet)
+ (setf (aref address i) high
+ (aref address (1+ i)) low)
+ (incf i 2)))
+ address))
+
+;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
+;;; bits-of-sockaddr
+
+(defmethod make-sockaddr-for ((socket inet6-socket) &optional sockaddr
+ &rest address)
+ (let ((host (first address))
+ (port (second address))
+ (sockaddr (or sockaddr (sockint::allocate-sockaddr-in6))))
+ (when (and host port)
+ (setf host (coerce host '(simple-array (unsigned-byte 8) (16))))
+ ;; port and host are represented in C as "network-endian" unsigned
+ ;; integers of various lengths. This is stupid. The value of the
+ ;; integer doesn't matter (and will change depending on your
+ ;; machine's endianness); what the bind(2) call is interested in
+ ;; is the pattern of bytes within that integer.
+
+ ;; We have no truck with such dreadful type punning. Octets to
+ ;; octets, dust to dust.
+
+ (setf (sockint::sockaddr-in6-family sockaddr) sockint::af-inet6)
+ (setf (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 0) (ldb (byte 8 8) port))
+ (setf (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 1) (ldb (byte 8 0) port))
+ (dotimes (i 4)
+ (setf (sb-alien:deref (sockint::sockaddr-in6-flowinfo sockaddr) i) 0))
+
+ (dotimes (i 16)
+ (setf (sb-alien:deref (sockint::sockaddr-in6-addr sockaddr) i) (elt host i)))
+ (dotimes (i 4)
+ (setf (sb-alien:deref (sockint::sockaddr-in6-scope-id sockaddr) i) 0)))
+ sockaddr))
+
+(defmethod free-sockaddr-for ((socket inet6-socket) sockaddr)
+ (sockint::free-sockaddr-in6 sockaddr))
+
+(defmethod size-of-sockaddr ((socket inet6-socket))
+ sockint::size-of-sockaddr-in6)
+
+(defmethod bits-of-sockaddr ((socket inet6-socket) sockaddr)
+ "Returns address and port of SOCKADDR as multiple values"
+ (values
+ (coerce (loop for i from 0 below 16
+ collect (sb-alien:deref (sockint::sockaddr-in6-addr sockaddr) i))
+ '(vector (unsigned-byte 8) 16))
+ (+ (* 256 (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 0))
+ (sb-alien:deref (sockint::sockaddr-in6-port sockaddr) 1))))
diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
index b29ab9c..1948848 100644
--- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
+++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
@@ -19,6 +19,7 @@
(:file "sockopt" :depends-on ("sockets"))
(:file "inet" :depends-on ("sockets"))
(:file "inet4" :depends-on ("sockets"))
+ (:file "inet6" :depends-on ("sockets" "split"))
(:file "local" :depends-on ("sockets"))
(:file "name-service" :depends-on ("sockets"))
(:file "misc" :depends-on ("sockets"))
diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index ed863ae..aea084c 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -137,11 +137,11 @@ values"))
(defmethod socket-connect ((socket socket) &rest peer)
(with-sockaddr-for (socket sockaddr peer)
- (if (= (sockint::connect (socket-file-descriptor socket)
- sockaddr
- (size-of-sockaddr socket))
- -1)
- (socket-error "connect"))))
+ (when (= (sockint::connect (socket-file-descriptor socket)
+ sockaddr
+ (size-of-sockaddr socket))
+ -1)
+ (socket-error "connect"))))
(defgeneric socket-peername (socket)
(:documentation "Return the socket's peer; depending on the address
--
2.1.0
From 3965cdd98aed322ec7bade381c8f293a7a66c80e Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmori...@techfak.uni-bielefeld.de>
Date: Fri, 18 Apr 2014 20:59:55 +0200
Subject: [PATCH 3/4] Cosmetic changes in sb-bsd-sockets
---
contrib/sb-bsd-sockets/defpackage.lisp | 4 ++--
contrib/sb-bsd-sockets/sockets.lisp | 10 ++++++----
2 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index 956c851..38cd8a4 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 inet6-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/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index aea084c..128031c 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -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)
@@ -525,7 +527,7 @@ 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
+ ;; FIXME: Our Texinfo documentation extracter need at least this to spit
;; out the signature. Real documentation would be better...
""
(let* ((errno (socket-errno))
--
2.1.0
From b2322bc28039e7fbf0a141a80609c94db0f900ed Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmori...@techfak.uni-bielefeld.de>
Date: Fri, 18 Apr 2014 21:18:11 +0200
Subject: [PATCH 4/4] Moved protocol into contrib/sb-bsd-sockets/protocol.lisp
---
contrib/sb-bsd-sockets/misc.lisp | 6 --
contrib/sb-bsd-sockets/name-service.lisp | 3 -
contrib/sb-bsd-sockets/protocol.lisp | 132 ++++++++++++++++++++++++++++++
contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 33 ++++----
contrib/sb-bsd-sockets/sockets.lisp | 112 -------------------------
5 files changed, 151 insertions(+), 135 deletions(-)
create mode 100644 contrib/sb-bsd-sockets/protocol.lisp
diff --git a/contrib/sb-bsd-sockets/misc.lisp b/contrib/sb-bsd-sockets/misc.lisp
index e38a613..66152ff 100644
--- a/contrib/sb-bsd-sockets/misc.lisp
+++ b/contrib/sb-bsd-sockets/misc.lisp
@@ -9,9 +9,6 @@
;;; XXX bad (sizeof (int) ==4 ) assumptions
-(defgeneric non-blocking-mode (socket)
- (:documentation "Is SOCKET in non-blocking mode?"))
-
#-win32
(defmethod non-blocking-mode ((socket socket))
(let ((fd (socket-file-descriptor socket)))
@@ -25,9 +22,6 @@
(defmethod non-blocking-mode ((socket socket))
(slot-value socket 'non-blocking-p))
-(defgeneric (setf non-blocking-mode) (non-blocking-p socket)
- (:documentation "Put SOCKET in non-blocking mode - or not, according to NON-BLOCKING-P"))
-
#-win32
(defmethod (setf non-blocking-mode) (non-blocking-p (socket socket))
(declare (optimize (speed 3)))
diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index ba7d2f2..f1d708a 100644
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -13,9 +13,6 @@
:documentation "A list of addresses for this host."))
(:documentation "This class represents the results of an address lookup."))
-(defgeneric host-ent-address (host-ent)
- (:documentation "Returns some valid address for HOST-ENT."))
-
(defmethod host-ent-address ((host-ent host-ent))
(car (host-ent-addresses host-ent)))
diff --git a/contrib/sb-bsd-sockets/protocol.lisp b/contrib/sb-bsd-sockets/protocol.lisp
new file mode 100644
index 0000000..a6642bd
--- /dev/null
+++ b/contrib/sb-bsd-sockets/protocol.lisp
@@ -0,0 +1,132 @@
+(cl:in-package #:sb-bsd-sockets)
+
+;;; Addresses
+
+(defgeneric make-sockaddr-for (socket &optional sockaddr &rest address)
+ (:documentation "Return a Socket Address object suitable for use with SOCKET.
+When SOCKADDR is passed, it is used instead of a new object."))
+
+(defgeneric free-sockaddr-for (socket sockaddr)
+ (:documentation "Deallocate a Socket Address object that was created
+for SOCKET."))
+
+(defgeneric bits-of-sockaddr (socket sockaddr)
+ (:documentation "Return as multiple values protocol-dependent bits
+of parameter SOCKADDR, e.g. the host/port if SOCKET is an inet
+socket."))
+
+(defgeneric size-of-sockaddr (socket)
+ (:documentation "Return the size of a sockaddr object for SOCKET."))
+
+;;; Sockets
+
+(defgeneric socket-name (socket)
+ (:documentation "Return the address (as vector of bytes) and port
+ that the socket is bound to, as multiple values."))
+
+(defgeneric socket-peername (socket)
+ (:documentation "Return the socket's peer; depending on the address
+ family this may return multiple values"))
+
+(defgeneric socket-namestring (socket)
+ (:method ((socket t))
+ nil)
+ (:documentation "TODO"))
+
+(defgeneric socket-peerstring (socket)
+ (:method ((socket t))
+ nil)
+ (:documentation "TODO"))
+
+(defgeneric socket-open-p (socket)
+ (:documentation "Return true if SOCKET is open; otherwise, return false.")
+ (:method ((socket t)) (error 'type-error
+ :datum socket :expected-type 'socket)))
+
+(defgeneric socket-close (socket &key abort)
+ (:documentation
+ "Close SOCKET, unless it was already closed.
+
+If SOCKET-MAKE-STREAM has been called, calls CLOSE using ABORT on that
+stream. Otherwise closes the socket file descriptor using
+close(2)."))
+
+(defgeneric socket-bind (socket &rest address)
+ (:documentation "Bind SOCKET to ADDRESS, which may vary according to
+socket family. For the INET family, pass ADDRESS and PORT as two
+arguments; for FILE address family sockets, pass the filename string.
+See also bind(2)"))
+
+(defgeneric socket-accept (socket)
+ (:documentation "Perform the accept(2) call, returning a
+newly-created connected socket and the peer address as multiple
+values"))
+
+(defgeneric socket-connect (socket &rest address)
+ (:documentation "Perform the connect(2) call to connect SOCKET to a
+ remote PEER. No useful return value."))
+
+(defgeneric socket-receive (socket buffer length
+ &key
+ oob peek waitall dontwait element-type)
+ (:documentation
+ "Read LENGTH octets from SOCKET into BUFFER (or a freshly-consed
+buffer if NIL), using recvfrom(2). If LENGTH is NIL, the length of
+BUFFER is used, so at least one of these two arguments must be
+non-NIL. If BUFFER is supplied, it had better be of an element type
+one octet wide. Returns the buffer, its length, and the address of the
+peer that sent it, as multiple values. On datagram sockets, sets
+MSG_TRUNC so that the actual packet length is returned even if the
+buffer was too small."))
+
+(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."))
+
+(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 grow to before new connection attempts are
+refused. See also listen(2)"))
+
+(defgeneric socket-shutdown (socket &key direction)
+ (:documentation
+ "Indicate that no communication in DIRECTION will be performed on SOCKET.
+
+DIRECTION has to be one of :INPUT, :OUTPUT or :IO.
+
+After a shutdown, no input and/or output of the indicated DIRECTION
+can be performed on SOCKET."))
+
+(defgeneric socket-make-stream (socket &key input output
+ element-type external-format
+ buffering
+ timeout)
+ (:documentation "Find or create a STREAM that can be used for IO on
+SOCKET \(which must be connected\). Specify whether the stream is for
+INPUT, OUTPUT, or both \(it is an error to specify neither\).
+ELEMENT-TYPE and EXTERNAL-FORMAT are as per OPEN. TIMEOUT specifies a
+read timeout for the stream."))
+
+(defgeneric non-blocking-mode (socket)
+ (:documentation "Is SOCKET in non-blocking mode?"))
+
+(defgeneric (setf non-blocking-mode) (non-blocking-p socket)
+ (:documentation "Put SOCKET in non-blocking mode - or not, according
+to NON-BLOCKING-P"))
+
+;;; Name service
+
+(defgeneric host-ent-address (host-ent)
+ (:documentation "Returns some valid address for HOST-ENT."))
diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
index 1948848..f950a58 100644
--- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
+++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
@@ -1,6 +1,6 @@
;;; -*- Lisp -*-
-(defsystem sb-bsd-sockets
+(defsystem :sb-bsd-sockets
:version "0.58"
:defsystem-depends-on (sb-grovel)
#+sb-building-contrib :pathname
@@ -9,19 +9,24 @@
((:file "defpackage")
(:file "split" :depends-on ("defpackage"))
(:file "win32-lib" :if-feature :win32)
- (:sb-grovel-constants-file "constants" :package :sockint
- :depends-on ("defpackage") :if-feature (:not :win32))
- (:sb-grovel-constants-file "win32-constants" :package
- :sockint :depends-on ("defpackage" "win32-lib") :if-feature :win32)
- (:file "win32-sockets"
- :depends-on ("win32-constants") :if-feature :win32)
- (:file "sockets" :depends-on ("constants" "win32-sockets"))
+ (:sb-grovel-constants-file "constants"
+ :package :sockint
+ :depends-on ("defpackage")
+ :if-feature (:not :win32))
+ (:sb-grovel-constants-file "win32-constants"
+ :package :sockint
+ :depends-on ("defpackage" "win32-lib")
+ :if-feature :win32)
+ (:file "protocol" :depends-on ("defpackage"))
+ (:file "win32-sockets" :depends-on ("protocol" "win32-constants")
+ :if-feature :win32)
+ (:file "sockets" :depends-on ("protocol" "constants" "win32-sockets"))
(:file "sockopt" :depends-on ("sockets"))
- (:file "inet" :depends-on ("sockets"))
- (:file "inet4" :depends-on ("sockets"))
- (:file "inet6" :depends-on ("sockets" "split"))
- (:file "local" :depends-on ("sockets"))
- (:file "name-service" :depends-on ("sockets"))
+ (:file "inet" :depends-on ("protocol" "sockets"))
+ (:file "inet4" :depends-on ("protocol" "sockets"))
+ (:file "inet6" :depends-on ("protocol" "sockets" "split"))
+ (:file "local" :depends-on ("protocol" "sockets"))
+ (:file "name-service" :depends-on ("protocol" "sockets"))
(:file "misc" :depends-on ("sockets"))
(:static-file "NEWS")
;; (:static-file "INSTALL")
@@ -31,7 +36,7 @@
:perform (load-op :after (o c) (provide 'sb-bsd-sockets))
:perform (test-op (o c) (test-system 'sb-bsd-sockets/tests)))
-(defsystem sb-bsd-sockets/tests
+(defsystem :sb-bsd-sockets/tests
:depends-on (sb-rt sb-bsd-sockets #-win32 sb-posix)
:components ((:file "tests"))
:perform (test-op (o c)
diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 128031c..b2c8390 100644
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -5,7 +5,6 @@
(eval-when (:load-toplevel :compile-toplevel :execute)
-
;;; Winsock is different w.r.t errno
(defun socket-errno ()
"Get socket error code, usually from errno, but see #+win32."
@@ -41,16 +40,6 @@ directly instantiated.")))
(socket-peerstring object)
(slot-value object 'file-descriptor))))
-(defgeneric socket-namestring (socket))
-
-(defmethod socket-namestring (socket)
- nil)
-
-(defgeneric socket-peerstring (socket))
-
-(defmethod socket-peerstring (socket)
- nil)
-
(defmethod shared-initialize :after ((socket socket) slot-names
&key protocol type
&allow-other-keys)
@@ -75,14 +64,6 @@ directly instantiated.")))
-(defgeneric make-sockaddr-for (socket &optional sockaddr &rest address)
- (:documentation "Return a Socket Address object suitable for use with SOCKET.
-When SOCKADDR is passed, it is used instead of a new object."))
-
-(defgeneric free-sockaddr-for (socket sockaddr)
- (:documentation "Deallocate a Socket Address object that was
-created for SOCKET."))
-
(defmacro with-sockaddr-for ((socket sockaddr &optional sockaddr-args) &body body)
`(let ((,sockaddr (apply #'make-sockaddr-for ,socket nil ,sockaddr-args)))
(unwind-protect (progn ,@body)
@@ -92,12 +73,6 @@ created for SOCKET."))
;; sockaddr_something as second arg, we pass the elements of one as
;; multiple arguments.
-(defgeneric socket-bind (socket &rest address)
- (:documentation "Bind SOCKET to ADDRESS, which may vary according to
-socket family. For the INET family, pass ADDRESS and PORT as two
-arguments; for FILE address family sockets, pass the filename string.
-See also bind(2)"))
-
(defmethod socket-bind ((socket socket)
&rest address)
(with-sockaddr-for (socket sockaddr address)
@@ -108,10 +83,6 @@ See also bind(2)"))
(socket-error "bind"))))
-(defgeneric socket-accept (socket)
- (:documentation "Perform the accept(2) call, returning a
-newly-created connected socket and the peer address as multiple
-values"))
(defmethod socket-accept ((socket socket))
(with-sockaddr-for (socket sockaddr)
@@ -133,10 +104,6 @@ values"))
:dont-save t))
(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
- remote PEER. No useful return value."))
-
(defmethod socket-connect ((socket socket) &rest peer)
(with-sockaddr-for (socket sockaddr peer)
(when (= (sockint::connect (socket-file-descriptor socket)
@@ -145,10 +112,6 @@ values"))
-1)
(socket-error "connect"))))
-(defgeneric socket-peername (socket)
- (:documentation "Return the socket's peer; depending on the address
- family this may return multiple values"))
-
(defmethod socket-peername ((socket socket))
(with-sockaddr-for (socket sockaddr)
(when (= (sockint::getpeername (socket-file-descriptor socket)
@@ -158,10 +121,6 @@ values"))
(socket-error "getpeername"))
(bits-of-sockaddr socket sockaddr)))
-(defgeneric socket-name (socket)
- (:documentation "Return the address (as vector of bytes) and port
- that the socket is bound to, as multiple values."))
-
(defmethod socket-name ((socket socket))
(with-sockaddr-for (socket sockaddr)
(when (= (sockint::getsockname (socket-file-descriptor socket)
@@ -178,19 +137,6 @@ values"))
;;; allows us to read from an unconnected socket into a buffer, and
;;; to learn who the sender of the packet was
-(defgeneric socket-receive (socket buffer length
- &key
- oob peek waitall dontwait element-type)
- (:documentation
- "Read LENGTH octets from SOCKET into BUFFER (or a freshly-consed
-buffer if NIL), using recvfrom(2). If LENGTH is NIL, the length of
-BUFFER is used, so at least one of these two arguments must be
-non-NIL. If BUFFER is supplied, it had better be of an element type
-one octet wide. Returns the buffer, its length, and the address of the
-peer that sent it, as multiple values. On datagram sockets, sets
-MSG_TRUNC so that the actual packet length is returned even if the
-buffer was too small."))
-
(defmethod socket-receive ((socket socket) buffer length
&key
oob peek waitall dontwait
@@ -248,20 +194,6 @@ buffer was too small."))
(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
@@ -313,33 +245,16 @@ send(2) will be called instead. Returns the number of octets written."))
(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
-grow to before new connection attempts are refused. See also listen(2)"))
-
(defmethod socket-listen ((socket socket) backlog)
(let ((r (sockint::listen (socket-file-descriptor socket) backlog)))
(if (= r -1)
(socket-error "listen"))))
-(defgeneric socket-open-p (socket)
- (:documentation "Return true if SOCKET is open; otherwise, return false.")
- (:method ((socket t)) (error 'type-error
- :datum socket :expected-type 'socket)))
-
(defmethod socket-open-p ((socket socket))
(if (slot-boundp socket 'stream)
(open-stream-p (slot-value socket 'stream))
(/= -1 (socket-file-descriptor socket))))
-(defgeneric socket-close (socket &key abort)
- (:documentation
- "Close SOCKET, unless it was already closed.
-
-If SOCKET-MAKE-STREAM has been called, calls CLOSE using ABORT on that stream.
-Otherwise closes the socket file descriptor using close(2)."))
-
(defmethod socket-close ((socket socket) &key abort)
;; the close(2) manual page has all kinds of warning about not
;; checking the return value of close, on the grounds that an
@@ -378,15 +293,6 @@ Otherwise closes the socket file descriptor using close(2)."))
(declare (ignore r))
(drop-it))))))))
-(defgeneric socket-shutdown (socket &key direction)
- (:documentation
- "Indicate that no communication in DIRECTION will be performed on SOCKET.
-
-DIRECTION has to be one of :INPUT, :OUTPUT or :IO.
-
-After a shutdown, no input and/or output of the indicated DIRECTION
-can be performed on SOCKET."))
-
(defmethod socket-shutdown ((socket socket) &key direction)
(let* ((fd (socket-file-descriptor socket))
(how (ecase direction
@@ -396,16 +302,6 @@ can be performed on SOCKET."))
(when (minusp (sockint::shutdown fd how))
(socket-error "shutdown"))))
-(defgeneric socket-make-stream (socket &key input output
- element-type external-format
- buffering
- timeout)
- (:documentation "Find or create a STREAM that can be used for IO on
-SOCKET \(which must be connected\). Specify whether the stream is for
-INPUT, OUTPUT, or both \(it is an error to specify neither\). ELEMENT-TYPE
-and EXTERNAL-FORMAT are as per OPEN. TIMEOUT specifies a read timeout
-for the stream."))
-
(defmethod socket-make-stream ((socket socket)
&key input output
(element-type 'character)
@@ -533,11 +429,3 @@ request an input stream and get an output stream in response\)."
(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."))
-
-(defgeneric size-of-sockaddr (socket)
- (:documentation "Return the size of a sockaddr object for SOCKET."))
--
2.1.0
_______________________________________________
Usocket-devel mailing list
Usocket-devel@common-lisp.net
http://mailman.common-lisp.net/cgi-bin/mailman/listinfo/usocket-devel
