| 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 -------------------------------------------------- |