[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: sb-bsd-sockets: Separate internet protocol sockets into inet{, 4}.lisp
From: "Jan Moringen" <scymtym () users ! sourceforge ! net>
Date: 2014-09-27 18:31:55
Message-ID: E1XXwml-0008Aa-Hr () sfs-ml-3 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via 41bdba2c98bd49ce5055817382831e333f8f88b8 (commit)
from 8e7b76732e065fcf85f0108015a6df047847d019 (commit)
- Log -----------------------------------------------------------------
commit 41bdba2c98bd49ce5055817382831e333f8f88b8
Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Fri Apr 18 19:53:50 2014 +0200
sb-bsd-sockets: Separate internet protocol sockets into inet{,4}.lisp
---
contrib/sb-bsd-sockets/inet.lisp | 111 +----------------------------
contrib/sb-bsd-sockets/inet4.lisp | 112 +++++++++++++++++++++++++++++
contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 5 +-
3 files changed, 116 insertions(+), 112 deletions(-)
diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index 6b5cead..ca3cfd0 100644
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -1,60 +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)
-")))
-
-(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
@@ -166,58 +112,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)
- (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))
- ;; 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..71ea2a2
--- /dev/null
+++ b/contrib/sb-bsd-sockets/inet4.lisp
@@ -0,0 +1,112 @@
+(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)
+")))
+
+(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)
+ (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))
+ ;; 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 f639620..d4a2bee 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"))
-----------------------------------------------------------------------
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