chiark / gitweb /
zone.lisp: Stringify the zone name at construction time.
[zone] / addr-family-ipv6.lisp
1 ;;; -*-lisp-*-
2 ;;;
3 ;;; IPv6 address family support
4 ;;;
5 ;;; (c) 2014 Straylight/Edgeware
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
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.
14 ;;;
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.
19 ;;;
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.
23
24 (in-package #:net)
25
26 ;;;--------------------------------------------------------------------------
27 ;;; Basic address type.
28
29 (deftype u128 ()
30   "The type of unsigned 128-bit values."
31   '(unsigned-byte 128))
32
33 (export 'ip6addr)
34 (defclass ip6addr (ipaddr)
35   ((addr :type u128 :initarg :addr :reader ipaddr-addr)))
36
37 (defmethod family-addrclass ((family (eql :ipv6))) 'ip6addr)
38
39 (defmethod ipaddr-family ((addr ip6addr)) :ipv6)
40 (defmethod ipaddr-width ((class (eql 'ip6addr))) 128)
41 (defmethod ipaddr-rrtype ((addr ip6addr)) :aaaa)
42
43 (defun parse-partial-ip6addr (str
44                               &key (start 0) (end nil)
45                                    (min 0) (max 128))
46   "Parse (a substring of) STR as a partial IPv6 address.
47
48    Specifically, the address is assumed to have the following syntax.
49
50         WORD ::= HEXIT+
51         BYTE ::= DIGIT+
52         WORDS ::= WORD {`:' WORD}*
53         BYTES ::= BYTE {`.' BYTE}*
54         ADDR ::= [WORDS [`::']] WORDS [`:' BYTES] | [WORDS] `::' [WORDS]
55
56    There are a number of constraints not expressed in this simple syntax."
57
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"))
64
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"))
71
72            (parse-low-seq (start end min max shiftp)
73              ;; Parse a sequence [WORDS] | [WORDS `:'] BYTES.
74
75              (let ((last-colon (position #\: str :from-end t
76                                          :start start :end end))
77                    (dotp (position #\. str :start start :end end)))
78
79                (cond ((not dotp)
80                       ;; No dots, so no bytes to deal with.
81                       (parse-v6 start end min max shiftp))
82
83                      ((not last-colon)
84                       ;; No colons, so no words to deal with.  Ensure that
85                       ;; the bytes are in the right place.  This is a little
86                       ;; fiddly.
87                       (when (if shiftp
88                                 (> max 32)
89                                 (< max 32))
90                         (error "Invalid IPv4-in-IPv6 address"))
91                       (parse-v4 start end min (min max 32) t))
92
93                      (t
94                       ;; Both.  The boundary is at the 32-bit mark -- after
95                       ;; any necessary shifting.
96                       (unless (> max 32)
97                         (error "Invalid IPv4-in-IPv6 address"))
98                       (multiple-value-bind (v6-addr v6-lo v6-hi)
99                           (if shiftp
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)
109                                   v4-lo v6-hi))))))))
110
111     (let ((split (search "::" str :start2 start :end2 end)))
112       (if split
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)))))
122
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))
126
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))
131         (i 0)
132         (best-start nil) (best-length 0)
133         (run-start nil))
134
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.
138     (dotimes (i 8)
139       (setf (aref words i)
140             (ldb (byte 16 (- 112 (* i 16))) addr)))
141
142     ;; Second step: identify the leftmost longest run of zeros.
143     (loop
144       (if (and (< i 8)
145                (zerop (aref words i)))
146           (unless run-start
147             (setf run-start i))
148           (when run-start
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)))
154       (when (>= i 8)
155         (return))
156       (incf i))
157
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.  There's a special case here for the
161     ;; IPv6-mapped IPv4 address space ::ffff:0.0.0.0/96.
162     (with-output-to-string (out)
163       (flet ((chunk (start end)
164                (when (< start end)
165                  (let ((i start))
166                    (loop
167                      (format out "~(~X~)" (aref words i))
168                      (incf i)
169                      (when (>= i end) (return))
170                      (write-char #\: out))))))
171         (cond ((< best-length 2)
172                (chunk 0 8))
173               ((and (= best-start 0)
174                     (or (and (= best-length 5)
175                              (= (aref words 5) #xffff))
176                         (= best-length 6)))
177                (let ((v4addr (make-instance 'ip4addr
178                                             :addr (ldb (byte 32 0) addr))))
179                  (write-string "::" out)
180                  (when (= best-length 5)
181                    (chunk 5 6)
182                    (write-char #\: out))
183                  (write-string (ipaddr-string v4addr) out)))
184               (t
185                (chunk 0 best-start)
186                (write-string "::" out)
187                (chunk (+ best-start best-length) 8)))))))
188
189 ;;;--------------------------------------------------------------------------
190 ;;; IPv6 networks.
191
192 (defmethod ipmask ((addr ip6addr) (mask ip6addr))
193   (ipaddr-addr mask))
194
195 (defclass ip6net (ipnet)
196   ((net :type ip6addr :initarg :net :reader ipnet-net)
197    (mask :type u128 :initarg :mask :reader ipnet-mask)))
198
199 (defmethod ipaddr-ipnet ((addr ip6addr) mask)
200   (make-instance 'ip6net :net addr :mask mask))
201
202 (defmethod ipnet-broadcast ((ipn ip6net)) nil)
203
204 ;;;--------------------------------------------------------------------------
205 ;;; Reverse lookups.
206
207 (defmethod reverse-domain-component-width ((ipaddr ip6addr)) 4)
208 (defmethod reverse-domain-radix ((ipaddr ip6addr)) 16)
209 (defmethod reverse-domain-suffix ((ipaddr ip6addr)) "ip6.arpa")
210
211 ;;;----- That's all, folks --------------------------------------------------