From a539be5d6c2ba4a6a68d761a6bcce977f9de2b19 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 14 Mar 2008 19:44:25 +0000
Subject: [PATCH] 1.0.15.32: shinier SB-BSD-SOCKET:MAKE-INET-ADDRESS

 * Check the input string for wellformedness, and construct a
   specialized vector.
---
 NEWS                             |  3 +++
 contrib/sb-bsd-sockets/inet.lisp | 28 ++++++++++++++++++++++++----
 version.lisp-expr                |  2 +-
 3 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 7b330170e..6752da1de 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,9 @@ changes in sbcl-1.0.16 relative to 1.0.15:
   * optimization: modular arithmetic for a particular requested width
     is implemented using a tagged representation unless a better 
     representation is available.
+  * bug fix: SB-BSD-SOCKETS:MAKE-INET-ADDRESS checks the input string
+    for wellformedness and returns a specialized vector. (reported by
+    Francois-Rene Rideau)
   * bug fix: FIND-CLASS was not thread-safe. (reported by Attila Lendvai)
   * bug fix: ~R was broken for vigtillions. (thanks to Luis Oliveira)
   * bug fix: attempt to obtain *SCHEDULER-LOCK* recursively when
diff --git a/contrib/sb-bsd-sockets/inet.lisp b/contrib/sb-bsd-sockets/inet.lisp
index e6265ed45..716095cf5 100644
--- a/contrib/sb-bsd-sockets/inet.lisp
+++ b/contrib/sb-bsd-sockets/inet.lisp
@@ -22,10 +22,30 @@ 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
diff --git a/version.lisp-expr b/version.lisp-expr
index b8ba138c2..7e0d1182d 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.15.31"
+"1.0.15.32"
-- 
2.11.4.GIT