3 ;;; IPv6 address family support
5 ;;; (c) 2014 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software Foundation,
22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 ;;;--------------------------------------------------------------------------
27 ;;; Basic address type.
30 "The type of unsigned 128-bit values."
34 (defclass ip6addr (ipaddr)
35 ((addr :type u128 :initarg :addr :reader ipaddr-addr)))
37 (defmethod family-addrclass ((family (eql :ipv6))) 'ip6addr)
39 (defmethod ipaddr-family ((addr ip6addr)) :ipv6)
40 (defmethod ipaddr-width ((class (eql 'ip6addr))) 128)
41 (defmethod ipaddr-rrtype ((addr ip6addr)) :aaaa)
43 (defun parse-partial-ip6addr (str
44 &key (start 0) (end nil)
46 "Parse (a substring of) STR as a partial IPv6 address.
48 Specifically, the address is assumed to have the following syntax.
52 WORDS ::= WORD {`:' WORD}*
53 BYTES ::= BYTE {`.' BYTE}*
54 ADDR ::= [WORDS [`::']] WORDS [`:' BYTES] | [WORDS] `::' [WORDS]
56 There are a number of constraints not expressed in this simple syntax."
58 (labels ((parse-v6 (start end min max shiftp)
59 ;; Abbreviation for parsing a sequence of WORDs.
60 (parse-partial-address str :start start :end end
61 :delim #\: :radix 16 :width 16
62 :min min :max max :shiftp shiftp
63 :what "IPv6 address"))
65 (parse-v4 (start end min max shiftp)
66 ;; Abbreviation for parsing a sequence of BYTEs.
67 (parse-partial-address str :start start :end end
68 :delim #\. :radix 10 :width 8
69 :min min :max max :shiftp shiftp
70 :what "IPv4-in-IPv6 address"))
72 (parse-low-seq (start end min max shiftp)
73 ;; Parse a sequence [WORDS] | [WORDS `:'] BYTES.
75 (let ((last-colon (position #\: str :from-end t
76 :start start :end end))
77 (dotp (position #\. str :start start :end end)))
80 ;; No dots, so no bytes to deal with.
81 (parse-v6 start end min max shiftp))
84 ;; No colons, so no words to deal with. Ensure that
85 ;; the bytes are in the right place. This is a little
90 (error "Invalid IPv4-in-IPv6 address"))
91 (parse-v4 start end min (min max 32) t))
94 ;; Both. The boundary is at the 32-bit mark -- after
95 ;; any necessary shifting.
97 (error "Invalid IPv4-in-IPv6 address"))
98 (multiple-value-bind (v6-addr v6-lo v6-hi)
100 (let ((want (round-up (- max 32) 16)))
101 (parse-v6 start last-colon want want t))
102 (parse-v6 start last-colon
103 (max (- min 32) 1) (- max 32) nil))
104 (multiple-value-bind (v4-addr v4-lo v4-hi)
105 (parse-v4 (1+ last-colon) end
106 (max (- min (- v6-hi v6-lo)) 1) 32 t)
107 (declare (ignore v4-hi))
108 (values (logior (ash v6-addr 32) v4-addr)
111 (let ((split (search "::" str :start2 start :end2 end)))
113 (multiple-value-bind (left-addr left-lo left-hi)
114 (parse-v6 start split 0 max t)
115 (let ((left-bits (- left-hi left-lo)))
116 (multiple-value-bind (right-addr right-lo right-hi)
117 (parse-low-seq (+ split 2) end
118 0 (max (- max left-bits) 0) nil)
119 (declare (ignore right-hi))
120 (values (logior left-addr right-addr) right-lo left-hi))))
121 (parse-low-seq start end (max min 1) max t)))))
123 (defmethod parse-partial-ipaddr ((class (eql 'ip6addr)) str
124 &key (start 0) (end nil) (min 0) (max 128))
125 (parse-partial-ip6addr str :start start :end end :min min :max max))
127 (defmethod ipaddr-string ((ip ip6addr))
128 "Convert IP into an IPv6-syntax address string."
129 (let ((words (make-array 8 :element-type '(unsigned-byte 16)))
130 (addr (ipaddr-addr ip))
132 (best-start nil) (best-length 0)
135 ;; First step: parse the address into words. We could save consing by
136 ;; grabbing bytes out of the address, but it's not like we have a
137 ;; performance problem.
140 (ldb (byte 16 (- 112 (* i 16))) addr)))
142 ;; Second step: identify the leftmost longest run of zeros.
145 (zerop (aref words i)))
149 (let ((run-length (- i run-start)))
150 (when (> run-length best-length)
151 (setf best-start run-start
152 best-length run-length)))
153 (setf run-start nil)))
158 ;; Third step: output the two parts of the address either side of the
159 ;; longest zero run. If there are no zero words in the address, just
160 ;; write the whole thing.
161 (with-output-to-string (out)
162 (flet ((chunk (start end)
166 (format out "~(~X~)" (aref words i))
168 (when (>= i end) (return))
169 (write-char #\: out))))))
170 (cond ((null best-start)
174 (write-string "::" out)
175 (chunk (+ best-start best-length) 8)))))))
177 ;;;--------------------------------------------------------------------------
180 (defmethod ipmask ((addr ip6addr) (mask ip6addr))
183 (defclass ip6net (ipnet)
184 ((net :type ip6addr :initarg :net :reader ipnet-net)
185 (mask :type u128 :initarg :mask :reader ipnet-mask)))
187 (defmethod ipaddr-ipnet ((addr ip6addr) mask)
188 (make-instance 'ip6net :net addr :mask mask))
190 (defmethod ipnet-broadcast ((ipn ip6net)) nil)
192 ;;;--------------------------------------------------------------------------
195 (defmethod reverse-domain-component-width ((ipaddr ip6addr)) 4)
196 (defmethod reverse-domain-radix ((ipaddr ip6addr)) 16)
197 (defmethod reverse-domain-suffix ((ipaddr ip6addr)) "ip6.arpa")
199 ;;;----- That's all, folks --------------------------------------------------