From: Mark Wooding Date: Tue, 15 Apr 2014 15:42:05 +0000 (+0100) Subject: net.lisp, zone.lisp: Support for IPv6 addresses. X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/commitdiff_plain/a2267e14628e71bdac3a67f1aca1686ee03eccc4?hp=32ebbe9b0fcc1a698c6ffec760259c5f7e953a9d net.lisp, zone.lisp: Support for IPv6 addresses. This just pretty much slots in now. After an awful lot of work making slots which are exactly the right shape! --- diff --git a/Makefile b/Makefile index 7decd8f..6cbf595 100644 --- 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 index 0000000..3c37907 --- /dev/null +++ b/addr-family-ipv6.lisp @@ -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 -------------------------------------------------- diff --git a/net.lisp b/net.lisp index c8852f9..7cd7e6d 100644 --- 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) diff --git a/zone.asd b/zone.asd index d090da7..b0544a1 100644 --- 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")) diff --git a/zone.lisp b/zone.lisp index 735e87f..d25986a 100644 --- 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)))