From 6dc1b99d34427d956664e082ff8862e81dd159ab Mon Sep 17 00:00:00 2001 From: Luis Oliveira Date: Sat, 4 Aug 2007 23:00:14 +0100 Subject: [PATCH] Implement inet_pton() in Lisp. - This makes the sockets::ipv6-disabled hack unnecessary. Remove it. - Added a regression test for ipv4 notation on ipv6 addresses. --- sockets/address.lisp | 89 ++++++++++++++++++++++++++++++-------------- tests/net.sockets-tests.lisp | 15 +++----- 2 files changed, 66 insertions(+), 38 deletions(-) diff --git a/sockets/address.lisp b/sockets/address.lisp index f726b2a..445fa57 100644 --- a/sockets/address.lisp +++ b/sockets/address.lisp @@ -90,36 +90,69 @@ ADDRESS-NAME reader.")) (princ (aref vector 2) s) (princ #\. s) (princ (aref vector 3) s)))) -#+windows -(defun %ipv6-string-to-vector (string) - (with-foreign-object (in6-sockaddr 'sockaddr-in6) - (bzero in6-sockaddr size-of-sockaddr-in6) - (with-foreign-object (length :int) - (setf (mem-ref length :int) size-of-sockaddr-in6) - (handler-case - (wsa-string-to-address string af-inet6 (null-pointer) in6-sockaddr - length) - (socket-error () (error 'parse-error))) - (in6-addr-to-ipv6-array - (foreign-slot-value in6-sockaddr 'sockaddr-in6 'addr))))) - -#+windows -(handler-case (%ipv6-string-to-vector "::") - (parse-error () (pushnew 'ipv6-disabled *features*))) - -#-windows -(defun %ipv6-string-to-vector (string) - (with-foreign-object (in6-addr :uint16 8) - (bzero in6-addr 16) - (handler-case (inet-pton af-inet6 string in6-addr) - (posix-error () (error 'parse-error))) - (in6-addr-to-ipv6-array in6-addr))) - +;;; TODO: add tests against inet_pton(). Optimize if necessary. +;;; (defun colon-separated-to-vector (string) - "Convert a colon-separated IPv6 address to -a (simple-array (unsigned-byte 16) 8)." + "Convert a colon-separated IPv6 address to a (simple-array ub16 8)." (check-type string string) - (%ipv6-string-to-vector string)) + (when (< (length string) 2) + (error 'parse-error)) + (flet ((handle-trailing-and-leading-colons (string) + (let ((start 0) + (end (length string)) + (trailing-colons-p nil)) + (when (char= #\: (char string 0)) + (if (char= #\: (char string 1)) + (incf start) + (error 'parse-error))) + (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))) + (emptyp (string) + (= 0 (length string))) + ;; we need to use this instead of dotted-to-vector because + ;; abbreviated IPv4 addresses are invalid in this context. + (ipv4-string-to-ub16-list (string) + (let ((tokens (split-sequence #\. string))) + (when (= (length tokens) 4) + (let ((ipv4 (map 'vector + (lambda (string) + (let ((x (ignore-errors + (parse-integer string)))) + (if (or (null x) (not (<= 0 x #xff))) + (error 'parse-error) + x))) + tokens))) + (list (dpb (aref ipv4 0) (byte 8 8) (aref ipv4 1)) + (dpb (aref ipv4 2) (byte 8 8) (aref ipv4 3))))))) + (parse-hex-ub16 (string) + (let ((x (ignore-errors (parse-integer string :radix 16)))) + (if (or (null x) (not (<= 0 x #xffff))) + (error 'parse-error) + x)))) + (multiple-value-bind (start end trailing-colons-p) + (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 + (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 + (cond + ((integerp token) (setf (aref vector i) token)) + ((emptyp token) (incf i (- 8 token-count))) + (t (setf (aref vector i) (parse-hex-ub16 token))))) + vector)))) (defun ipv4-on-ipv6-mapped-vector-p (vector) (and (dotimes (i 5 t) diff --git a/tests/net.sockets-tests.lisp b/tests/net.sockets-tests.lisp index bbc4563..8c40250 100644 --- a/tests/net.sockets-tests.lisp +++ b/tests/net.sockets-tests.lisp @@ -72,7 +72,6 @@ (address-to-vector "242.1.211.3") #(242 1 211 3) :ipv4) -#-sockets::ipv6-disabled (deftest address-to-vector.3 (address-to-vector "::") #(0 0 0 0 0 0 0 0) :ipv6) @@ -89,7 +88,6 @@ t) ;;; RT: should signal a PARSE-ERROR when given an invalid string. -#-sockets::ipv6-disabled (deftest ensure-address.1 (handler-case (ensure-address "ff0x::114") (parse-error () t)) @@ -141,14 +139,12 @@ (type-error () t)) t) -#-sockets::ipv6-disabled (deftest address-to-string.1 (mapcar (lambda (x) (address-to-string (make-address x))) '(#(127 0 0 1) #(255 255 255 255) #(0 0 0 0 0 0 0 0) #(0 0 0 0 0 0 0 1) #(1 0 0 0 0 0 0 0))) ("127.0.0.1" "255.255.255.255" "::" "::1" "1::")) -#-sockets::ipv6-disabled (deftest vector-to-colon-separated.1 (let ((ip #(0 0 0 255 255 255 0 0))) (values (vector-to-colon-separated ip) @@ -160,12 +156,10 @@ (address= +ipv4-loopback+ (make-address #(127 0 0 1))) t) -#-sockets::ipv6-disabled (deftest address=.2 (address= +ipv6-loopback+ (ensure-address "::1")) t) -#-sockets::ipv6-disabled (deftest copy-address.1 (loop for designator in (list "127.0.0.1" +max-ipv4-value+ "::" "::1") for addr1 = (ensure-address designator) @@ -181,19 +175,16 @@ (type-error () t)) t) -#-sockets::ipv6-disabled (deftest address.unspecified.1 (every #'inet-address-unspecified-p (mapcar #'ensure-address '("0.0.0.0" "::" "0:0:0:0:0:0:0:0"))) t) -#-sockets::ipv6-disabled (deftest address.loopback.1 (every #'inet-address-loopback-p (mapcar #'ensure-address '("127.0.0.1" "::1" "0:0::1"))) t) -#-sockets::ipv6-disabled (deftest address.multicast.1 (every #'inet-address-multicast-p (mapcar #'ensure-address @@ -201,11 +192,15 @@ "ff02::2" "ff0a::114" "ff05::1:3"))) t) -#-sockets::ipv6-disabled (deftest address.ipv6-ipv4-mapped.1 (ipv6-ipv4-mapped-p (ensure-address "::ffff:127.0.0.1")) t) +(deftest address.ipv6.1 + (address-to-vector "::1.2.3.4") + #(0 0 0 0 0 0 #x0102 #x0304) + :ipv6) + ;;;; Host Lookup #-no-internet-available -- 2.11.4.GIT