chiark / gitweb /
net.lisp, zone.lisp: Support for IPv6 addresses.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 15 Apr 2014 15:42:05 +0000 (16:42 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 15 Apr 2014 16:12:28 +0000 (17:12 +0100)
This just pretty much slots in now.  After an awful lot of work making
slots which are exactly the right shape!

Makefile
addr-family-ipv6.lisp [new file with mode: 0644]
net.lisp
zone.asd
zone.lisp

index 7decd8f..6cbf595 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@ SOURCES = \
        frontend.lisp \
        zone.lisp \
        net.lisp serv.lisp sys.lisp \
-       addr-family-ipv4.lisp
+       addr-family-ipv4.lisp addr-family-ipv6.lisp
 
 CLEANFILES += zone
 all:: zone
diff --git a/addr-family-ipv6.lisp b/addr-family-ipv6.lisp
new file mode 100644 (file)
index 0000000..3c37907
--- /dev/null
@@ -0,0 +1,199 @@
+;;; -*-lisp-*-
+;;;
+;;; IPv6 address family support
+;;;
+;;; (c) 2014 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package #:net)
+
+;;;--------------------------------------------------------------------------
+;;; Basic address type.
+
+(deftype u128 ()
+  "The type of unsigned 128-bit values."
+  '(unsigned-byte 128))
+
+(export 'ip6addr)
+(defclass ip6addr (ipaddr)
+  ((addr :type u128 :initarg :addr :reader ipaddr-addr)))
+
+(defmethod family-addrclass ((family (eql :ipv6))) 'ip6addr)
+
+(defmethod ipaddr-family ((addr ip6addr)) :ipv6)
+(defmethod ipaddr-width ((class (eql 'ip6addr))) 128)
+(defmethod ipaddr-rrtype ((addr ip6addr)) :aaaa)
+
+(defun parse-partial-ip6addr (str
+                             &key (start 0) (end nil)
+                                  (min 0) (max 128))
+  "Parse (a substring of) STR as a partial IPv6 address.
+
+   Specifically, the address is assumed to have the following syntax.
+
+       WORD ::= HEXIT+
+       BYTE ::= DIGIT+
+       WORDS ::= WORD {`:' WORD}*
+       BYTES ::= BYTE {`.' BYTE}*
+       ADDR ::= [WORDS [`::']] WORDS [`:' BYTES] | [WORDS] `::' [WORDS]
+
+   There are a number of constraints not expressed in this simple syntax."
+
+  (labels ((parse-v6 (start end min max shiftp)
+            ;; Abbreviation for parsing a sequence of WORDs.
+            (parse-partial-address str :start start :end end
+                                   :delim #\: :radix 16 :width 16
+                                   :min min :max max :shiftp shiftp
+                                   :what "IPv6 address"))
+
+          (parse-v4 (start end min max shiftp)
+            ;; Abbreviation for parsing a sequence of BYTEs.
+            (parse-partial-address str :start start :end end
+                                   :delim #\. :radix 10 :width 8
+                                   :min min :max max :shiftp shiftp
+                                   :what "IPv4-in-IPv6 address"))
+
+          (parse-low-seq (start end min max shiftp)
+            ;; Parse a sequence [WORDS] | [WORDS `:'] BYTES.
+
+            (let ((last-colon (position #\: str :from-end t
+                                        :start start :end end))
+                  (dotp (position #\. str :start start :end end)))
+
+              (cond ((not dotp)
+                     ;; No dots, so no bytes to deal with.
+                     (parse-v6 start end min max shiftp))
+
+                    ((not last-colon)
+                     ;; No colons, so no words to deal with.  Ensure that
+                     ;; the bytes are in the right place.  This is a little
+                     ;; fiddly.
+                     (when (if shiftp
+                               (> max 32)
+                               (< max 32))
+                       (error "Invalid IPv4-in-IPv6 address"))
+                     (parse-v4 start end min (min max 32) t))
+
+                    (t
+                     ;; Both.  The boundary is at the 32-bit mark -- after
+                     ;; any necessary shifting.
+                     (unless (> max 32)
+                       (error "Invalid IPv4-in-IPv6 address"))
+                     (multiple-value-bind (v6-addr v6-lo v6-hi)
+                         (if shiftp
+                             (let ((want (round-up (- max 32) 16)))
+                               (parse-v6 start last-colon want want t))
+                             (parse-v6 start last-colon
+                                       (max (- min 32) 1) (- max 32) nil))
+                       (multiple-value-bind (v4-addr v4-lo v4-hi)
+                           (parse-v4 (1+ last-colon) end
+                                     (max (- min (- v6-hi v6-lo)) 1) 32 t)
+                         (declare (ignore v4-hi))
+                         (values (logior (ash v6-addr 32) v4-addr)
+                                 v4-lo v6-hi))))))))
+
+    (let ((split (search "::" str :start2 start :end2 end)))
+      (if split
+         (multiple-value-bind (left-addr left-lo left-hi)
+             (parse-v6 start split 0 max t)
+           (let ((left-bits (- left-hi left-lo)))
+             (multiple-value-bind (right-addr right-lo right-hi)
+                 (parse-low-seq (+ split 2) end
+                                0 (max (- max left-bits) 0) nil)
+               (declare (ignore right-hi))
+               (values (logior left-addr right-addr) right-lo left-hi))))
+         (parse-low-seq start end (max min 1) max t)))))
+
+(defmethod parse-partial-ipaddr ((class (eql 'ip6addr)) str
+                                &key (start 0) (end nil) (min 0) (max 128))
+  (parse-partial-ip6addr str :start start :end end :min min :max max))
+
+(defmethod ipaddr-string ((ip ip6addr))
+  "Convert IP into an IPv6-syntax address string."
+  (let ((words (make-array 8 :element-type '(unsigned-byte 16)))
+       (addr (ipaddr-addr ip))
+       (i 0)
+       (best-start nil) (best-length 0)
+       (run-start nil))
+
+    ;; First step: parse the address into words.  We could save consing by
+    ;; grabbing bytes out of the address, but it's not like we have a
+    ;; performance problem.
+    (dotimes (i 8)
+      (setf (aref words i)
+           (ldb (byte 16 (- 112 (* i 16))) addr)))
+
+    ;; Second step: identify the leftmost longest run of zeros.
+    (loop
+      (if (and (< i 8)
+              (zerop (aref words i)))
+         (unless run-start
+           (setf run-start i))
+         (when run-start
+           (let ((run-length (- i run-start)))
+             (when (> run-length best-length)
+               (setf best-start run-start
+                     best-length run-length)))
+           (setf run-start nil)))
+      (when (>= i 8)
+       (return))
+      (incf i))
+
+    ;; Third step: output the two parts of the address either side of the
+    ;; longest zero run.  If there are no zero words in the address, just
+    ;; write the whole thing.
+    (with-output-to-string (out)
+      (flet ((chunk (start end)
+              (when (< start end)
+                (let ((i start))
+                  (loop
+                    (format out "~(~X~)" (aref words i))
+                    (incf i)
+                    (when (>= i end) (return))
+                    (write-char #\: out))))))
+       (cond (best-start
+              (chunk 0 best-start)
+              (write-string "::" out)
+              (chunk (+ best-start best-length) 8))
+             (t
+              (chunk 0 8)))))))
+
+;;;--------------------------------------------------------------------------
+;;; IPv6 networks.
+
+(defmethod ipmask ((addr ip6addr) (mask ip6addr))
+  (ipaddr-addr mask))
+
+(defclass ip6net (ipnet)
+  ((net :type ip6addr :initarg :net :reader ipnet-net)
+   (mask :type u128 :initarg :mask :reader ipnet-mask)))
+
+(defmethod ipaddr-ipnet ((addr ip6addr) mask)
+  (make-instance 'ip6net :net addr :mask mask))
+
+(defmethod ipnet-broadcast ((ipn ip6net)) nil)
+
+;;;--------------------------------------------------------------------------
+;;; Reverse lookups.
+
+(defmethod reverse-domain-component-width ((ipaddr ip6addr)) 4)
+(defmethod reverse-domain-radix ((ipaddr ip6addr)) 16)
+(defmethod reverse-domain-suffix ((ipaddr ip6addr)) "ip6.arpa")
+
+;;;----- That's all, folks --------------------------------------------------
index c8852f9..7cd7e6d 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -156,8 +156,8 @@ (defgeneric ipaddr-comparable-p (addr-a addr-b)
     (eq (class-of addr-a) (class-of addr-b))))
 
 (defun guess-address-class (str &key (start 0) (end nil))
-  (declare (ignore str start end))
-  'ip4addr)
+  (cond ((position #\: str :start start :end end) 'ip6addr)
+       (t 'ip4addr)))
 
 (defgeneric parse-partial-ipaddr (class str &key start end min max)
   (:method ((object t) str &rest keywords)
index d090da7..b0544a1 100644 (file)
--- a/zone.asd
+++ b/zone.asd
@@ -9,6 +9,7 @@
               (:file "sys")
               (:file "net")
               (:file "addr-family-ipv4")
+              (:file "addr-family-ipv6")
               (:file "serv")
               (:file "zone")
               (:file "frontend"))
index 735e87f..d25986a 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -609,6 +609,10 @@ (defzoneparse :a (name data rec)
   ":a IPADDR"
   (zone-set-address #'rec data :make-ptr-p t :family :ipv4))
 
+(defzoneparse :aaaa (name data rec)
+  ":aaaa IPADDR"
+  (zone-set-address #'rec data :make-ptr-p t :family :ipv6))
+
 (defzoneparse :addr (name data rec)
   ":addr IPADDR"
   (zone-set-address #'rec data :make-ptr-p t))
@@ -983,6 +987,7 @@ (defgeneric bind-record-type (type)
 (export 'bind-record-format-args)
 (defgeneric bind-record-format-args (type data)
   (:method ((type (eql :a)) data) (list "~A" (ipaddr-string data)))
+  (:method ((type (eql :aaaa)) data) (list "~A" (ipaddr-string data)))
   (:method ((type (eql :ptr)) data) (list "~A" (bind-hostname data)))
   (:method ((type (eql :cname)) data) (list "~A" (bind-hostname data)))
   (:method ((type (eql :ns)) data) (list "~A" (bind-hostname data)))