chiark - git - mdw - zone/blob - 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 --------------------------------------------------