firewall-cmd: --reload less often & respect SERVICE:NO-SERVICES-P

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

2 files changed, 165 insertions, 81 deletions

diff --git a/src/package.lisp b/src/package.lisp
index f5d4ba4..d7c7bdb 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -161,6 +161,10 @@
            #:mktemp
            #:with-remote-current-directory
            #:run-failed
+           #:failed-cmd
+           #:failed-stdout
+           #:failed-stderr
+           #:failed-exit-code
            #:runlines
            #:test
            #:remote-exists-p
@@ -839,7 +843,8 @@
   (:local-nicknames (#:cmd          #:consfigurator.property.cmd)
                     (#:file         #:consfigurator.property.file)
                     (#:apt          #:consfigurator.property.apt)
-                    (#:os           #:consfigurator.property.os))
+                    (#:os           #:consfigurator.property.os)
+                    (#:service      #:consfigurator.property.service))
   (:export #:installed
            #:service
            #:policy
diff --git a/src/property/firewalld.lisp b/src/property/firewalld.lisp
index f4d7a25..1c93653 100644
--- a/src/property/firewalld.lisp
+++ b/src/property/firewalld.lisp
@@ -23,35 +23,96 @@
   (os:etypecase
     (debianlike (apt:installed "firewalld"))))
 
-(defprop %firewall-cmd :posix (file warning &rest args)
+;; We employ three strategies for determining whether or not a change was
+;; already applied: checking for exit status zero from a firewall-cmd(1) query
+;; subcommand like --query-masquerade, looking for certain warning messages in
+;; the output, and checking whether certain files under /etc/firewalld change.
+;; It would be better if we could just look for the warnings, but
+;; firewall-cmd(1) is not consistent about emitting a warning when no change
+;; was made -- for example, --set-target always just says "success", but
+;; --add-service will say "ALREADY_ENABLED".  We can't completely rely on file
+;; content changes either because this is no use when changing the runtime
+;; configuration, and if we make no change to a built-in zone, or similar, the
+;; corresponding .xml file may not exist either before or after running the
+;; command, and given how WITH-CHANGE-IF-CHANGES-FILE works, this means we
+;; would fail to return :NO-CHANGE.
+;;
+;; We incorporate :CHECK into :APPLY here because for most commands we need to
+;; check runtime and permanent configuration separately, and two properties is
+;; unwieldy.  Previously we updated only the permanent configuration, and then
+;; did 'firewall-cmd --reload' when we detected that a change had been made.
+;; However, that has the side effect of wiping out configuration which should
+;; only ever be part of the runtime configuration, perhaps added by scripts.
+;; A disadvantage of the current approach is that it is probably more likely
+;; to lead to inconsistent runtime configurations.
+;;
+;; Both WARNING and APPLY are usually different for unapplication, so we rely
+;; on WITH-UNAPPLY together with another application of this property when we
+;; want to make a property unapplicable, rather than defining :UNAPPLY here.
+(defprop %firewall-cmd :posix
+    (runtimep &key file warning check complement-check
+              apply (offline-apply apply) (--permanent t)
+              &aux (check-fn (if complement-check #'plusp #'zerop)))
   (:apply
-   ;; --add-service will always tell us ALREADY_ENABLED if nothing was
-   ;; changed, but --set-target won't tell us whether a change was made, so we
-   ;; have to be prepared to look at whether the file changed, too.
-   ;;
-   ;; If we make no change to a builtin zone, or similar, then the
-   ;; corresponding .xml file may not exist either before or after running the
-   ;; command, and given how WITH-CHANGE-IF-CHANGES-FILE works, that means we
-   ;; fail to return :NO-CHANGE.  However, we have enough :CHECK subroutines
-   ;; defined to avoid this situation actually arising.
-   (flet ((run ()
-            (let ((output (mrun "firewall-cmd" args)))
-              (and warning (search warning output) :no-change))))
-     (aprog1 (if file
-                 (with-change-if-changes-file
-                     ((merge-pathnames file #P"/etc/firewalld/")) (run))
-                 (run))
-       (unless (eql it :no-change)
-         (mrun "firewall-cmd" "--reload"))))))
+   (setq check (ensure-list check) apply (ensure-list apply))
+   (labels ((search-warning (output)
+              (and warning (search output warning) :no-change))
+            (permanent-change ()
+              (search-warning
+               (if (service:no-services-p)
+                   ;; Contrary to its manpage, firewall-offline-cmd(1) often
+                   ;; exits nonzero when issuing the ALREADY_ENABLED,
+                   ;; NOT_ENABLED and ZONE_ALREADY_SET warnings.
+                   (handler-bind
+                       ((run-failed
+                          (lambda (c)
+                            (when (and warning
+                                       (search warning (failed-stdout c)))
+                              (return-from permanent-change :no-change)))))
+                     (apply #'mrun "firewall-offline-cmd" offline-apply))
+                   (if --permanent
+                       (apply #'mrun "firewall-cmd" "--permanent" apply)
+                       (apply #'mrun "firewall-cmd" apply))))))
+     (let* ((runtime-check
+              (or (service:no-services-p)
+                  (and runtimep check
+                       (funcall
+                        check-fn
+                        (apply #'mrun :for-exit "firewall-cmd" check)))))
+            (permanent-check
+              (and check
+                   (funcall check-fn
+                            (apply #'mrun :for-exit
+                                   (if (service:no-services-p)
+                                       "firewall-offline-cmd"
+                                       '("firewall-cmd" "--permanent"))
+                                   check))))
+            (runtime (if (or runtime-check (not runtimep))
+                         :no-change
+                         (search-warning (apply #'mrun "firewall-cmd" apply))))
+            (permanent
+              (if permanent-check
+                  :no-change
+                  (if file
+                      (with-change-if-changes-file
+                          ((merge-pathnames file #P"/etc/firewalld/"))
+                        (permanent-change))
+                      (permanent-change)))))
+       (and (eql :no-change permanent) (eql :no-change runtime) :no-change)))))
 
 
 ;;;; Setting contents of XML configuration files
 
+(defprop %reloaded :posix ()
+  (:apply (if (service:no-services-p)
+              :no-change
+              (mrun "firewall-cmd" "--reload"))))
+
 (defproplist %setxml :posix (type name xml)
   (installed)
   (on-change
       (file:exists-with-content #?"/etc/firewalld/${type}/${name}.xml" xml)
-    (cmd:single "firewall-cmd" "--reload")))
+    (%reloaded)))
 
 (defproplist service :posix (service xml)
   (:desc #?"firewalld knows service ${service}")
@@ -82,37 +143,48 @@ FIREWALLD:POLICY.)"
 
 ;;;; Incremental configuration of zones
 
-(defprop has-zone :posix (zone)
+(defproplist has-zone :posix (zone)
   "Ensure that the zone ZONE exists.
 
 You will not usually need to call this property directly; it is applied by
 properties which add services, interfaces etc. to zones."
   (:desc #?"firewalld zone ${zone} exists")
-  (:check (zerop (mrun :for-exit "firewall-cmd" "--permanent"
-                       #?"--zone=${zone}" "--get-target")))
-  (:apply (mrun "firewall-cmd" "--permanent" #?"--new-zone=${zone}"))
-  (:unapply (mrun "firewall-cmd" "--permanent" #?"--delete-zone=${zone}")))
+  (with-unapply
+    (%firewall-cmd nil :check `(,#?"--zone=${zone}" "--get-target")
+                       :apply #?"--new-zone=${zone}")
+    :unapply
+    (%firewall-cmd nil :complement-check t
+                       :check `(,#?"--zone=${zone}" "--get-target")
+                       :apply #?"--delete-zone=${zone}")))
 
 (defproplist zone-target :posix (zone target)
   (:desc #?"firewalld zone ${zone} has target ${target}")
-  (:check (string= target
-                   (stripln (run :may-fail "firewall-cmd" "--permanent"
-                                 #?"--zone=${zone}" "--get-target"))))
+  (:check (if (service:no-services-p)
+              (string= target
+                       (stripln (run :may-fail "firewall-offline-cmd"
+                                     #?"--zone=${zone}" "--get-target")))
+              (string= target
+                       (stripln
+                        (run :may-fail "firewall-cmd" "--permanent"
+                             #?"--zone=${zone}" "--get-target")))))
   (installed)
   (has-zone zone)
-  (%firewall-cmd #?"zones/${zone}.xml" nil "--permanent"
-                 #?"--zone=${zone}" #?"--set-target=${target}"))
+  (on-change (%firewall-cmd
+              nil :file #?"zones/${zone}.xml"
+              :apply `(,#?"--zone=${zone}" ,#?"--set-target=${target}"))
+    (%reloaded)))
 
 (defprop %default-route-zoned :posix (zone)
   (:apply
-   (if-let ((default-route-interface
-             (loop for line in (runlines "ip" "route" "list" "scope" "global")
-                   when (string-prefix-p "default " line)
-                     return (fifth (words line)))))
-     (%firewall-cmd #?"zones/${zone}.xml" nil
-                    "--permanent" #?"--zone=${zone}"
-                    #?"--change-interface=${default-route-interface}")
-     (failed-change "Could not determine the interface of the default route."))))
+   (aif (loop for line in (runlines "ip" "route" "list" "scope" "global")
+              when (string-prefix-p "default " line)
+                return (fifth (words line)))
+        (%firewall-cmd
+         t :file #?"zones/${zone}.xml"
+         :check `(,#?"--zone=${zone}" ,#?"--query-interface=${it}")
+         :apply `(,#?"--zone=${zone}" ,#?"--change-interface=${it}"))
+        (failed-change
+         "Could not determine the interface of the default route."))))
 
 (defproplist default-route-zoned-once :posix (&optional (zone "public"))
   "Bind the interface of the default route to zone ZONE, only if this property
@@ -140,77 +212,83 @@ only FIREWALLD:DEFAULT-ZONE."
 
 (defproplist zone-has-interface :posix (zone interface)
   (:desc #?"firewalld zone ${zone} has interface ${interface}")
-  (:check (zerop (mrun :for-exit "firewall-cmd" "--permanent"
-                       #?"--zone=${zone}"
-                       #?"--query-interface=${interface}")))
   (with-unapply
     (installed)
     (has-zone zone)
-    (%firewall-cmd #?"zones/${zone}.xml" nil
-                   "--permanent" #?"--zone=${zone}"
-                   #?"--change-interface=${interface}")
-    :unapply (%firewall-cmd #?"zones/${zone}.xml" nil
-                            "--permanent" #?"--zone=${zone}"
-                            #?"--remove-interface=${interface}")))
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml"
+     :check `(,#?"--zone=${zone}" ,#?"--query-interface=${interface}")
+     :apply `(,#?"--zone=${zone}" ,#?"--change-interface=${interface}"))
+    :unapply
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml" :complement-check t
+     :check `(,#?"--zone=${zone}" ,#?"--query-interface=${interface}")
+     :apply `(,#?"--zone=${zone}" ,#?"--remove-interface=${interface}"))))
 
 (defproplist zone-has-service :posix (zone service)
   (:desc #?"firewalld zone ${zone} has service ${service}")
-  (:check (zerop (mrun :for-exit "firewall-cmd" "--permanent"
-                       #?"--zone=${zone}" #?"--query-service=${service}")))
   (with-unapply
     (installed)
     (has-zone zone)
-    (%firewall-cmd #?"zones/${zone}.xml" "ALREADY_ENABLED"
-                   "--permanent" #?"--zone=${zone}"
-                   #?"--add-service=${service}")
-    :unapply (%firewall-cmd #?"zones/${zone}.xml" "NOT_ENABLED"
-                            "--permanent" #?"--zone=${zone}"
-                            #?"--remove-service=${service}")))
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml"
+     :warning "ALREADY_ENABLED"
+     :check `(,#?"--zone=${zone}" ,#?"--query-service=${service}")
+     :apply `(,#?"--zone=${zone}" ,#?"--add-service=${service}"))
+    :unapply
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml" :warning "NOT_ENABLED"
+     :complement-check t
+     :check `(,#?"--zone=${zone}" ,#?"--query-service=${service}")
+     :apply `(,#?"--zone=${zone}" ,#?"--remove-service=${service}")
+     :offline-apply
+     `(,#?"--zone=${zone}" ,#?"--remove-service-from-zone=${service}"))))
 
 (defproplist zone-masquerade :posix (zone)
   (:desc #?"firewalld zone ${zone} has masquerade")
-  (:check (zerop (mrun :for-exit "firewall-cmd" "--permanent"
-                       #?"--zone=${zone}" "--query-masquerade")))
   (with-unapply
     (installed)
     (has-zone zone)
-    (%firewall-cmd #?"zones/${zone}.xml" "ALREADY_ENABLED"
-                   "--permanent"
-                   #?"--zone=${zone}" "--add-masquerade")
-    :unapply (%firewall-cmd #?"zones/${zone}.xml" "NOT_ENABLED"
-                            "--permanent"
-                            #?"--zone=${zone}" "--remove-masquerade")))
+    (%firewall-cmd t :file #?"zones/${zone}.xml" :warning "ALREADY_ENABLED"
+                     :check `(,#?"--zone=${zone}" "--query-masquerade")
+                     :apply `(,#?"--zone=${zone}" "--add-masquerade"))
+    :unapply
+    (%firewall-cmd t :file #?"zones/${zone}.xml" :warning "NOT_ENABLED"
+                     :complement-check t
+                     :check `(,#?"--zone=${zone}" "--query-masquerade")
+                     :apply `(,#?"--zone=${zone}" "--remove-masquerade"))))
 
 (defproplist zone-rich-rule :posix (zone rule)
   (:desc #?"firewalld zone ${zone} has rich rule \"${rule}\"")
-  (:check (zerop (mrun :for-exit "firewall-cmd"
-                       "--permanent" #?"--zone=${zone}"
-                       (strcat "--query-rich-rule=" rule))))
   (with-unapply
     (installed)
     (has-zone zone)
-    (%firewall-cmd #?"zones/${zone}.xml" "ALREADY_ENABLED"
-                   "--permanent" #?"--zone=${zone}"
-                   (strcat "--add-rich-rule=" rule))
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml" :warning "ALREADY_ENABLED"
+     :check `(,#?"--zone=${zone}" ,#?"--query-rich-rule=${rule}")
+     :apply `(,#?"--zone=${zone}" ,#?"--add-rich-rule=${rule}"))
     :unapply
-    (%firewall-cmd #?"zones/${zone}.xml" "NOT_ENABLED"
-                   "--permanent" #?"--zone=${zone}"
-                   (strcat "--remove-rich-rule=" rule))))
+    (%firewall-cmd
+     t :file #?"zones/${zone}.xml" :warning "NOT_ENABLED"
+     :complement-check t
+     :check `(,#?"--zone=${zone}" ,#?"--query-rich-rule=${rule}")
+     :apply `(,#?"--zone=${zone}" ,#?"--remove-rich-rule=${rule}"))))
 
 ;; Note that direct rules will be deprecated as of firewalld 1.0.0, as
 ;; policies and rich rules should be able to cover all uses of direct rules.
 ;;     <https://firewalld.org/2021/06/the-upcoming-1-0-0>
 (defpropspec zone-direct-rule :posix (&rest rule-args)
   (:desc #?"firewalld has direct rule \"@{rule-args}\"")
-  (:check (zerop (mrun :for-exit "firewall-cmd"
-                       "--permanent" "--direct" "--query-rule" rule-args)))
   `(with-unapply
      (installed)
-     (%firewall-cmd "direct.xml" "ALREADY_ENABLED"
-                    "--permanent" "--direct" "--add-rule" ,@rule-args)
+     (%firewall-cmd t :file "direct.xml" :warning "ALREADY_ENABLED"
+                      :check ("--direct" "--query-rule" ,@rule-args)
+                      :apply ("--direct" "--add-rule" ,@rule-args))
      :unapply
-     (%firewall-cmd "direct.xml" "NOT_ENABLED"
-                    "--permanent" "--direct" "--remove-rule" ,@rule-args)))
+     (%firewall-cmd t :file "direct.xml" :warning "NOT_ENABLED"
+                      :complement-check t
+                      :check ("--direct" "--query-rule" ,@rule-args)
+                      :apply ("--direct" "--remove-rule" ,@rule-args))))
 
 
 ;;;; Daemon configuration
@@ -219,5 +297,6 @@ only FIREWALLD:DEFAULT-ZONE."
   (:desc #?"firewalld default zone is ${zone}")
   (installed)
   (has-zone zone)
-  (%firewall-cmd "firewalld.conf" "ZONE_ALREADY_SET"
-                 #?"--set-default-zone=${zone}"))
+  (%firewall-cmd nil
+                 :file "firewalld.conf" :warning "ZONE_ALREADY_SET"
+                 :--permanent nil :apply #?"--set-default-zone=${zone}"))