X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Finet.lisp;h=57ab02c87c08669ee1eecf643e98ca7a45bb72da;hb=fd79e33e6b6dacdc52cf6668a5bb7adf75aad6c1;hp=51e79d39bef822a4fc68e33c2b70abc19ae747b2;hpb=8a3c76ab9725a199aa06a0abc018e096271a0f75;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index 51e79d3..57ab02c 100644
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -22,10 +22,37 @@ Examples:
 
 (defun make-inet-address (dotted-quads)
   "Return a vector of octets given a string DOTTED-QUADS in the format
-\"127.0.0.1\""
-  (map 'vector
-       #'parse-integer
-       (split dotted-quads nil '(#\.))))
+\"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
+         :reader unknown-protocol-name))
+  (:report (lambda (c s)
+             (format s "Protocol not found: ~a" (prin1-to-string
+                                                 (unknown-protocol-name c))))))
 
 ;;; getprotobyname only works in the internet domain, which is why this
 ;;; is here
@@ -35,6 +62,8 @@ using getprotobyname(2) which typically looks in NIS or /etc/protocols"
   ;; for extra brownie points, could return canonical protocol name
   ;; and aliases as extra values
   (let ((ent (sockint::getprotobyname name)))
+    (if (sb-alien::null-alien ent)
+        (error 'unknown-protocol :name name))
     (sockint::protoent-proto ent)))
 
 ;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
@@ -52,7 +81,7 @@ using getprotobyname(2) which typically looks in NIS or /etc/protocols"
 
       ;; 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 (sockint::sockaddr-in-port sockaddr) 0) (ldb (byte 8 8) port))
       (setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1) (ldb (byte 8 0) port))
@@ -73,11 +102,11 @@ using getprotobyname(2) which typically looks in NIS or /etc/protocols"
   "Returns address and port of SOCKADDR as multiple values"
   (values
    (coerce (loop for i from 0 below 4
-		 collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
-	   '(vector (unsigned-byte 8) 4))
+                 collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
+           '(vector (unsigned-byte 8) 4))
    (+ (* 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))