Vladimir Sedach

Have Emacs - Will Hack

November 1, 2019

Dumb IPv6 tricks: encode strings in interface identifiers

Topic: IPv6

IPv6 provides many great options for address assignment and network design for all kinds of applications, in ways that are simply impossible with IPv4, and are inherently more efficient and make network expansion and mergers easier. Tom Coffeen's excellent IPv6 Address Planning provides design guidelines, most of which are for the network prefix side (generally, the upper 64 bits of an IPv6 address).

Global scoped IPv6 addresses leave open the interface identifier (lower 64 bits). So far most writing has focused on automatically provided interface identifiers: derived from the interface MAC address, stateless address auto-configuration, or randomly generated.

64 bits is a lot. One technique I have not seen yet is the encoding of mnemonic strings (hostnames, role names, etc.) into the 64 bits of the interface identifier. A restricted, prefix (ex. Huffman) coded alphabet can fit many useful short names into 64 bits, but even a simple 5-bit alphabet (English upper case letters plus some characters like dash and underscore) can fit up to a twelve letter name.

The following example code uses a 5-bit alphabet with an optional numeric suffix to encode mnemonic strings in IPv6 interface identifiers:

;;; Copyright 2019 Vladimir Sedach <vas@oneofus.la>

;;; 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 3 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, see
;;; <https://www.gnu.org/licenses/>.

(define-condition ipv6-address-operation-error ()
  ((op-desc  :reader   ipv6-address-operation-error-op-desc)
   (argument :initarg  :argument
             :reader   ipv6-address-operation-error-argument)
   (details  :initarg  :details
             :initform ()
             :reader   ipv6-address-operation-error-details))
  (:report (lambda (c s)
             (write-string (ipv6-address-operation-error-op-desc c) s)
             (princ (ipv6-address-operation-error-argument c) s)
             (write-char #\Space s)
             (dolist (x (ipv6-address-operation-error-details c))
               (princ x s)))))

(define-condition ipv6-parse-error
    (ipv6-address-operation-error parse-error)
  ((op-desc :initform "Error parsing IPv6 address, ")))

(defun parse-ipv6-address (address)
  (labels ((err (&rest details)
             (error 'ipv6-parse-error
                    :argument address :details details))
           (add-group (bit-address group empty-allowed)
             (logior
              (ash bit-address 16)
              (if (= 0 (fill-pointer group))
                  (if empty-allowed
                      0
                      (err "missing hexadecimal group"))
                  (handler-case (parse-integer group :radix 16)
                    (parse-error ()
                      (err "group " group
                           " is not valid hexadecimal")))))))
    (restart-case
        (with-input-from-string (s address)
          (do
           ((group (make-array 4 :element-type 'character
                                 :fill-pointer 0))
            (double-colon)
            (groups-read  0)
            (address-high 0)
            (address-low  0)
            (c (or (read-char s nil nil)
                   (err "trying to parse empty string"))
               (read-char s nil nil)))
           ((not c)
            (when (and (< groups-read 7) (not double-colon))
              (err "address is truncated, only "
                   (1+ groups-read)
                   " of 8 required groups provided"))
            (logior address-high (add-group address-low group t)))
            (cond
              ((char= #\: c)
               (setf address-low
                     (add-group
                      address-low group
                      (and (= groups-read 0)
                           (char= #\: (or (peek-char nil s nil nil)
                                          (err "is truncated")))))
                     (fill-pointer group) 0)
               (when (< 7 (incf groups-read))
                 (err "is longer than 8 groups of hex digits"))
               (when (char= #\: (or (peek-char nil s nil)
                                    (err "is truncated")))
                 (when double-colon
                   (err "has more than one :: double colon"))
                 (read-char s)
                 (setf double-colon t
                       address-high (ash address-low
                                         (* 16 (- 8 groups-read)))
                       address-low  0)))
              ((not (or (char<= #\0 c #\9)
                        (char<= #\a c #\f) (char<= #\A c #\F)))
               (err c " is not a valid hex digit"))
              ((not (vector-push c group))
               (err "group "group c" has too many bits")))))
      (use-value (address₁)
        :report "Try a different IPv6 address."
        :interactive (lambda ()
                       (princ "Enter a new IPv6 address: ")
                       (list (eval (read))))
        (parse-ipv6-address address₁)))))

(defun print-ipv6-address (ipv6-bit-address)
  (check-type ipv6-bit-address (unsigned-byte 128))
  (let ((a (make-array 8))
        run-start run-end run₁-start)
    (dotimes (i 8)
      (let ((x (ldb (byte 16 (- 112 (* i 16))) ipv6-bit-address)))
        (setf (aref a i) x)
        (if (= x 0)
            (if run-start
                (when (and run-end (not run₁-start)) ;; start new run
                  (setf run₁-start i))
                (setf run-start i))
            (cond (run₁-start (when (< (- run-end run-start)
                                       (- i run₁-start))
                                (setf run-start  run₁-start
                                      run-end    i))
                              (setf run₁-start nil))
                  ((and run-start (not run-end)) (setf run-end i))))))
    (when (and run-start (not run-end))
      (setf run-end 8))
    (when (or (not run-start) (= 1 (- run-end run-start)))
      (setf run-start -1 run-end -1))
    (string-downcase
     (with-output-to-string (s)
       (dotimes (i 8)
         (cond ((= i run-start) (princ #\: s)
                (when (= i 0) (princ #\: s)))
               ((< run-start i run-end))
               (t (write (aref a i) :stream s :base 16)
                  (unless (= i 7) (princ #\: s)))))))))

(define-condition ipv6-5bit-encode-error
    (ipv6-address-operation-error)
  ((op-desc
    :initform
    "Error encoding string as IPv6 interface identifier, ")))

(defun ipv6-5bit-encode (string network-prefix)
  (when (= 0 (ash network-prefix -64))
    (warn
     "The given network prefix ~S appears invalid. The high 64 bits are all 0."
     (print-ipv6-address network-prefix)))
  (flet ((err (&rest details)
           (error 'ipv6-5bit-encode-error
                  :argument string :details details)))
    (restart-case
        (do ((interface-identifier 0)
             (num-suffix 0)
             (i 0 (1+ i)))
            ((or (>= i (length string)) (< 0 num-suffix))
             (let ((bits-left (- 64 (* 5 i))))
               (when (< bits-left (integer-length num-suffix))
                 (err "too long to encode by "
                      (- (- bits-left (integer-length num-suffix)))
                      " bits"))
               (dpb (logior (ash interface-identifier bits-left)
                            num-suffix)
                    (byte 64 0)
                    network-prefix)))
          (flet ((pc (x)
                   (setf interface-identifier
                         (logior x (ash interface-identifier 5)))))
            (let ((c (char-upcase (char string i))))
              (cond
                ((char<= #\A c #\Z)
                 (pc (- (char-code c) 64)))
                ((char<= #\0 c #\9)
                 (pc 31)
                 (setf num-suffix (parse-integer string :start i)))
                ((case c
                   (#\_ (pc 27)) (#\- (pc 28)) (#\. (pc 29))
                   (#\@ (pc 30))))
                (t (err " cannot encode character " c))))))
      (use-value (string₁)
        :report "Try a different string to encode."
        :interactive (lambda ()
                       (princ "Enter a new string: ")
                       (list (eval (read))))
        (ipv6-5bit-encode string₁ network-prefix)))))

(define-condition ipv6-5bit-decode-error
    (ipv6-address-operation-error)
  ((op-desc
    :initform
    "Error decoding IPv6 address as 5-bit string, ")))

(defun ipv6-5bit-decode (bit-address)
  (with-output-to-string (s)
    (do ((i 0 (1+ i))
         (c))
        ((>= i 12))
      (write-char
       (case (setf c (ldb (byte 5 (- 59 (* i 5))) bit-address))
         (0  (error 'ipv6-5bit-decode-error
                    :argument (print-ipv6-address bit-address)))
         (27 #\_)
         (28 #\-)
         (29 #\.)
         (30 #\@)
         (31 (princ (ldb (byte (- 59 (* i 5)) 0) bit-address) s)
             (return))
         (t  (code-char (+ 64 c))))
       s))))

In the encoding, 0 is left unused, and #x1f is a suffix marker to indicate that the following low bits are to be parsed as an unsigned integer.

Now we can do:

CL-USER> (print-ipv6-address (ipv6-5bit-encode "db-east1" (parse-ipv6-address "2001:db8:1234::")))

"2001:db8:1234:0:20b8:50ce:9f00:1"

CL-USER> (ipv6-5bit-decode (parse-ipv6-address "2001:db8:1234:0:6065:2cf8:8585:3e01"))

"LARRY@DEPT1"