add NETWORK:{CLEAN-/ETC/NETWORK/INTERFACES,PRESERVE-STATIC-ONCE}

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

3 files changed, 90 insertions, 1 deletions

diff --git a/src/package.lisp b/src/package.lisp
index 00d069c..9f5ad8e 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -86,6 +86,7 @@
            #:escape-sh-command
            #:defpackage-consfig
            #:lambda-ignoring-args
+           #:parse-cidr
 
            #:*consfigurator-debug-level*
            #:with-indented-inform
@@ -618,7 +619,9 @@
   (:export #:aliases
            #:ipv4
            #:ipv6
-           #:static))
+           #:clean-/etc/network/interfaces
+           #:static
+           #:preserve-static-once))
 
 (defpackage :consfigurator.property.libvirt
   (:use #:cl #:alexandria #:consfigurator)
diff --git a/src/property/network.lisp b/src/property/network.lisp
index c0085ab..94aa949 100644
--- a/src/property/network.lisp
+++ b/src/property/network.lisp
@@ -47,6 +47,19 @@ in which case you can use this property)."
   (:desc (format nil "Has public IPv6 ~{~A~^, ~}" addresses))
   (:hostattrs (apply #'pushnew-hostattrs :ipv6 (flatten addresses))))
 
+(defproplist clean-/etc/network/interfaces :posix ()
+  "Empty /etc/network/interfaces in preparation for configuring interfaces using
+/etc/network/interfaces.d.  On fresh installs this property should not be
+necessary, but it is useful for removing configuration inserted by your VPS
+hosting provider, for example."
+  (:hostattrs (os:required 'os:debianlike))
+  (file:has-content "/etc/network/interfaces"
+    ;; This is the contents of the file on fresh Debian "bullseye" installs --
+    ;; the IPv4 loopback interface is no longer configured here.
+    '("# interfaces(5) file used by ifup(8) and ifdown(8)"
+      "# Include files from /etc/network/interfaces.d:"
+      "source /etc/network/interfaces.d/*")))
+
 (defprop static :posix (interface address &optional gateway &rest options)
   "Configures an interface with a static IP address.
 OPTIONS is a list of even length of alternating keys and values."
@@ -66,3 +79,45 @@ OPTIONS is a list of even length of alternating keys and values."
                     interface (if (find #\. address) "inet" "inet6"))
             (loop for (k v) on options by #'cddr
                   collect (format nil "	~A ~A" k v))))))
+
+;; Based on Propellor's Network.preserveStatic property.
+(defprop preserve-static-once :posix (&optional interface &rest options)
+  "Writes configuration to bring up INTERFACE, statically, with the IP addresses
+and routing configuration currently associated with the interface, assuming
+that INTERFACE has already been brought up by other means, such as DHCP.
+INTERFACE defaults to the interface of the default route.  This property does
+nothing if the interface configuration file already exists.  OPTIONS is a list
+of even length of alternating keys and values.
+
+IPv6 addresses are ignored, as it is assumed these use stateless configuration
+of some form, which is best implemented using a property which does not query
+the networking stack's current state like this one does."
+  (:hostattrs (os:required 'os:debianlike))
+  (:apply
+   (let* ((default
+            (loop for line in (runlines "ip" "route" "list" "scope" "global")
+                  when (string-prefix-p "default " line)
+                    return (words line)))
+          (interface (or interface (fifth default)))
+          (gateway (and (string= (fifth default) interface) (third default)))
+          (file (merge-pathnames (string->filename interface)
+                                 #P"/etc/network/interfaces.d/")))
+     (if (remote-exists-p file)
+         :no-change
+         (file:has-content file
+           (cons
+            (strcat "auto " interface)
+            (loop for line in (runlines "ip" "-o" "addr" "show" interface
+                                        "scope" "global")
+                  for fields = (words line)
+                  when (string= "inet" (third fields))
+                    collect (strcat "iface " interface " inet static")
+                    and nconc (multiple-value-bind (addr nm)
+                                  (parse-cidr (fourth fields))
+                                (list (strcat "	address " addr)
+                                      (strcat "	netmask " nm)))
+                    and if gateway collect (strcat "	gateway " gateway)
+                          end
+                    and nconc
+                        (loop for (k v) on options by #'cddr
+                              collect (format nil "	~A ~A" k v)))))))))
diff --git a/src/util.lisp b/src/util.lisp
index 74aea8d..73810ae 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -266,6 +266,37 @@ expansion as a starting point for your own DEFPACKAGE form for your consfig."
          (declare (ignore ,ignore) ,@declarations)
          ,@forms))))
 
+(defun parse-cidr (address-with-suffix)
+  (destructuring-bind (address cidr)
+      (split-string address-with-suffix :separator "/")
+    (unless cidr
+      (simple-program-error "~A is not in CIDR notation."
+                            address-with-suffix))
+    (values
+     address
+     (loop with cidr = (parse-integer cidr)
+           with type = (if (or (> cidr 32) (find #\: address)) 6 4)
+           with block-digits = (if (= type 4) 8 16)
+           repeat (if (= type 4) 4 8)
+           for digits = (min cidr block-digits)
+           do (decf cidr digits)
+           collect (parse-integer
+                    (with-output-to-string (s)
+                      (loop repeat digits do (princ #\1 s))
+                      (loop repeat (- block-digits digits) do (princ #\0 s)))
+                    :radix 2)
+             into accum
+           finally (return (if (= type 4)
+                               (format nil "~{~D~^.~}" accum)
+                               (with-output-to-string (s)
+                                 (loop for blocks on accum
+                                       if (> (car blocks) 0)
+                                         do (format s "~X" (car blocks))
+                                         and if (cdr blocks) do (princ #\: s)
+                                               end
+                                       else do (princ #\: s)
+                                               (loop-finish)))))))))
+
 
 ;;;; Progress & debug printing