New dns-mode command for IPv6 address conversion

This converts IPv6 addresses to a format suitable for
reverse lookup zone files.  (Bug#26820)
* lisp/textmodes/dns-mode.el (dns-mode-map, dns-mode-menu):
Add dns-mode-ipv6-to-nibbles.
(dns-mode-ipv6-to-nibbles, dns-mode-reverse-and-expand-ipv6):
New functions.
* test/lisp/dns-mode-tests.el: New file.
; * etc/NEWS: Mention this.

3 files changed, 160 insertions, 1 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 2ca91d5d793..2a7c48d8119 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -850,6 +850,10 @@ This is done with the help of 'c-or-c++-mode' function which analyses
 contents of the buffer to determine whether it's a C or C++ source
 file.
 
+---
+** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses
+to a format suitable for reverse lookup zone files.
+
 ** Flymake
 
 +++
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index cc8bad6337b..7bdadbfe6f1 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -147,6 +147,7 @@ manually with \\[dns-mode-soa-increment-serial]."
 (defvar dns-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\C-c\C-s" 'dns-mode-soa-increment-serial)
+    (define-key map "\C-c\C-e" 'dns-mode-ipv6-to-nibbles)
     map)
   "Keymap for DNS master file mode.")
 
@@ -158,7 +159,8 @@ manually with \\[dns-mode-soa-increment-serial]."
 (easy-menu-define dns-mode-menu dns-mode-map
   "DNS Menu."
   '("DNS"
-    ["Increment SOA serial" dns-mode-soa-increment-serial t]))
+    ["Increment SOA serial" dns-mode-soa-increment-serial t]
+    ["Convert IPv6 address to nibbles" dns-mode-ipv6-to-nibbles t]))
 
 ;; Mode.
 
@@ -254,6 +256,101 @@ This function is run from `before-save-hook'."
            ;; We return nil in case this is used in write-contents-functions.
            nil)))
 
+;;;###autoload
+(defun dns-mode-ipv6-to-nibbles (&optional negate-prefix)
+  "Convert an IPv6 address around or before point.
+Replace the address by its ip6.arpa-representation for use in
+reverse zone files, placing the original address in the kill ring.
+
+The address can be: a complete address (no prefix designator);
+with a normal prefix designator (e.g. /48), in which case only
+the required number of nibbles are output; or with a negative
+prefix designator (e.g. /-112), in which case only the part of
+the address *not* covered by the absolute value of the prefix
+length is output, as a relative address (without \".ip6.arpa.\" at
+the end).  This is useful when $ORIGIN is specified in the zone file.
+
+Optional prefix argument NEGATE-PREFIX negates the value of the
+detected prefix length.
+
+Examples:
+
+2001:db8::12  =>
+2.1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa.
+
+2001:db8::12/32  =>
+8.b.d.0.1.0.0.2.ip6.arpa.
+
+2001:db8::12/-32  =>
+2.1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0
+
+::42/112 (with prefix argument) =>
+2.4.0.0"
+  (interactive "P")
+  (skip-syntax-backward " ")
+  (skip-syntax-backward "w_.")
+  (re-search-forward "\\([[:xdigit:]:]+\\)\\(/-?[0-9]\\{2,3\\}\\)?")
+  (kill-new (match-string 0))
+  (let ((address (match-string 1))
+        (prefix-length (match-string 2)))
+    (when prefix-length
+      (setq prefix-length (string-to-number (substring prefix-length 1)))
+      (if negate-prefix
+          (setq prefix-length (- prefix-length))))
+    (replace-match
+     (save-match-data
+       (dns-mode-reverse-and-expand-ipv6 address prefix-length)))))
+
+(defun dns-mode-reverse-and-expand-ipv6 (address &optional prefix-length)
+  "Convert an IPv6 address to (parts of) an ip6.arpa nibble format.
+ADDRESS is an IPv6 address in the usual colon-separated
+format, without a prefix designator at the end.
+
+Optional PREFIX-LENGTH is a number whose absolute value is the
+length in bits of the network part of the address.  If nil,
+return an absolute address representing the full IPv6 address.
+If positive, return an absolute address representing the network
+prefix indicated.  If negative, return a relative address
+representing the host parts of the address with respect to the
+indicated network prefix.
+
+See `dns-mode-ipv6-to-nibbles' for examples."
+  (let* ((chunks (split-string address ":"))
+         (prefix-length-nibbles (if prefix-length
+                                    (ceiling (abs prefix-length) 4)
+                                  32))
+         (filler-chunks (- 8 (length (remove "" chunks))))
+         (expanded-address
+          (apply #'concat
+                 (cl-loop with filler-done = nil
+                          for chunk in chunks
+                          if (and (not filler-done)
+                                  (string= "" chunk))
+                          append (prog1
+                                     (cl-loop repeat filler-chunks
+                                              collect "0000")
+                                   (setq filler-done t))
+                          else
+                          if (not (string= "" chunk))
+                          collect (format "%04x"
+                                          (string-to-number chunk 16)))))
+         (rev-address-nibbles
+          (nreverse (if (and prefix-length
+                             (cl-minusp prefix-length))
+                        (substring expanded-address prefix-length-nibbles)
+                      (substring expanded-address 0 prefix-length-nibbles)))))
+    (with-temp-buffer
+      (cl-loop for char across rev-address-nibbles
+               do
+               (insert char)
+               (insert "."))
+      (if (and prefix-length
+               (cl-minusp prefix-length))
+          (delete-char -1)
+        (insert "ip6.arpa."))
+      (insert " ")
+      (buffer-string))))
+
 (provide 'dns-mode)
 
 ;;; dns-mode.el ends here
diff --git a/test/lisp/dns-mode-tests.el b/test/lisp/dns-mode-tests.el
new file mode 100644
index 00000000000..34e86201d82
--- /dev/null
+++ b/test/lisp/dns-mode-tests.el
@@ -0,0 +1,58 @@
+;;; dns-mode-tests.el --- Test suite for dns-mode  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Peder O. Klingenberg <peder@klingenberg.no>
+;; Keywords: dns zone
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'dns-mode)
+
+;;; IPv6 reverse zones
+(ert-deftest dns-mode-ipv6-conversion ()
+  (let ((address "2001:db8::42"))
+    (should (equal (dns-mode-reverse-and-expand-ipv6 address)
+                   "2.4.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa. "))
+    (should (equal (dns-mode-reverse-and-expand-ipv6 address 32)
+                   "8.b.d.0.1.0.0.2.ip6.arpa. "))
+    (should (equal (dns-mode-reverse-and-expand-ipv6 address -112)
+                   "2.4.0.0 "))))
+
+(ert-deftest dns-mode-ipv6-text-replacement ()
+  (let ((address "2001:db8::42/32"))
+    (with-temp-buffer
+      ;; Conversion with point directly after address
+      (insert address)
+      (dns-mode-ipv6-to-nibbles nil)
+      (should (equal (buffer-string) "8.b.d.0.1.0.0.2.ip6.arpa. "))
+      ;; Kill ring contains the expected
+      (erase-buffer)
+      (yank)
+      (should (equal (buffer-string) address))
+      ;; Point at beginning of address (and prefix arg to command)
+      (goto-char (point-min))
+      (dns-mode-ipv6-to-nibbles t)
+      (should (equal (buffer-string) "2.4.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 "))
+      ;; Point separated from address by whitespace
+      (erase-buffer)
+      (insert address)
+      (insert " ")
+      (dns-mode-ipv6-to-nibbles nil)
+      (should (equal (buffer-string) "8.b.d.0.1.0.0.2.ip6.arpa.  ")))))