Fix bug in COLON-SEPARATED-TO-VECTOR.

- Handle leading and trailing single colons properly.
- Added regression test: COLON-SEPARATED-TO-VECTOR.1.

sockets/address.lisp

@@ -100,17 +100,21 @@ ADDRESS-NAME reader."))
   (flet ((handle-trailing-and-leading-colons (string)
            (let ((start 0)
                  (end (length string))
-                 (trailing-colons-p nil))
+                 (start-i 0)
+                 (trailing-colon-p nil)
+                 (tokens-from-leading-or-trailing-zeros 0))
              (when (char= #\: (char string 0))
-               (if (char= #\: (char string 1))
-                   (incf start)
-                   (error 'parse-error)))
+               (incf start)
+               (unless (char= #\: (char string 1))
+                 (setq start-i 1)
+                 (setq tokens-from-leading-or-trailing-zeros 1)))
              (when (char= #\: (char string (- end 1)))
-               (setq trailing-colons-p t)
-               (if (char= #\: (char string (- end 2)))
-                   (decf end)
-                   (error 'parse-error)))
-             (values start end trailing-colons-p)))
+               (setq trailing-colon-p t)
+               (unless (char= #\: (char string (- end 2)))
+                 (incf tokens-from-leading-or-trailing-zeros))
+               (decf end))
+             (values start end start-i trailing-colon-p
+                     tokens-from-leading-or-trailing-zeros)))
          (emptyp (string)
            (= 0 (length string)))
          ;; we need to use this instead of dotted-to-vector because
@@ -133,21 +137,21 @@ ADDRESS-NAME reader."))
              (if (or (null x) (not (<= 0 x #xffff)))
                  (error 'parse-error)
                  x))))
-    (multiple-value-bind (start end trailing-colons-p)
+    (multiple-value-bind (start end start-i trailing-colon-p extra-tokens)
         (handle-trailing-and-leading-colons string)
       (let* ((vector (make-array 8 :element-type 'ub16 :initial-element 0))
              (tokens (split-sequence #\: string :start start :end end))
              (empty-tokens (count-if #'emptyp tokens))
-             (token-count (length tokens)))
-        (unless trailing-colons-p
+             (token-count (+ (length tokens) extra-tokens)))
+        (unless trailing-colon-p
           (let ((ipv4 (ipv4-string-to-ub16-list (car (last tokens)))))
             (when ipv4
               (incf token-count)
               (setq tokens (nconc (butlast tokens) ipv4)))))
         (when (or (> token-count 8) (> empty-tokens 1)
                   (and (zerop empty-tokens) (/= token-count 8)))
           (error 'parse-error))
-        (loop for i from 0 and token in tokens do
+        (loop for i from start-i and token in tokens do
               (cond
                 ((integerp token) (setf (aref vector i) token))
                 ((emptyp token) (incf i (- 8 token-count)))

tests/net.sockets-tests.lisp

@@ -152,6 +152,20 @@
               (vector-to-colon-separated ip :upcase)))
   "::ff:ff:ff:0:0" "::ff:ff:ff:0:0" "::FF:FF:FF:0:0")
 
+(deftest colon-separated-to-vector.1
+    (mapcar #'colon-separated-to-vector
+            '(":ff::ff:" "::" "::1" "1::" ":2:3:4:5:6:7:8" "1:2:3:4:5:6:7:"
+              ":1::2:" "::127.0.0.1" ":1::127.0.0.1"))
+  (#(0 #xff 0 0 0 0 #xff 0)
+    #(0 0 0 0 0 0 0 0)
+    #(0 0 0 0 0 0 0 1)
+    #(1 0 0 0 0 0 0 0)
+    #(0 2 3 4 5 6 7 8)
+    #(1 2 3 4 5 6 7 0)
+    #(0 1 0 0 0 0 2 0)
+    #(0 0 0 0 0 0 #x7f00 1)
+    #(0 1 0 0 0 0 #x7f00 1)))
+
 (deftest address=.1
     (address= +ipv4-loopback+ (make-address #(127 0 0 1)))
   t)