(*file-contents-from-m4-template*  /dest/ /tmpl/ /vars/)

(*file-contents-from-gsubs-template*  /dest/ /tmpl/ /vars/)

Make sure the plain file /dest/ contains the filled-in ~m4~ template
stored in the file /tmpl/, where m4 is run with ~-D~ (define) switches
for each of the /vars/, which should be of the shape ~(("name1"
"value1") ("name2" "value2")...)~. See m4(1). Make sure none of the
values can contain any of the names. m4 is not my favorite templating
language, but it's part of POSIX and of the FreeBSD base system.

Make sure the plain file /dest/ contains a copy of the template stored
in the file /tmpl/, but with all the substitutions /vars/ made first.
For each pair (e.g. ~("VAR1" "value1")~) in /vars/, ~VAR1~ is
substituted with ~value1~, using the gsub function. The intended use
for this is to write files that contain double-quote characters or
backslashes, without having to write glotawk string literals with lots
of escaping. Accordingly, the VAR1's should be sequences of characters
that contrast with the syntax of the file.

;;
;; emacs: (put 'with-existing-rooted-plain-file-a-rule 'lisp-indent-function 2)

      (label
       ((make-dash-D
               (lambda (kv)
                 (let ((k (car kv)) (v (cadr kv)))
                   (sprintf "-D%s:%s" k v)))))
       (let ((ft (make-temp-filename-from "fcfm4t-XXXXXXXX"))
             (rft (*rooted* ft))
             (dash-Ds (mapcar make-dash-D vars)))
         (apply system-or-error `("m4" ,@dash-Ds :gt ,rft))
         (copy-mog dest ft)
         (cond
          (equal (crypto-digest rft) (crypto-digest dfp))
          (true (change-file dest "replace with templated contents"
                  (lambda () (system-or-error "mv" rft dfp))
                  nil)))))))

      ("file-contents-from-m4-template: %s <- %s" dest tmpl)
    (label
     ((make-dash-D
       (lambda (kv)
         (let ((k (car kv)) (v (cadr kv)))
           (sprintf "-D%s:%s" k v)))))
     (let* ((ft (make-temp-filename-from "fcfm4t"))
            (rft (*rooted* ft))
            (dash-Ds (mapcar make-dash-D vars)))
       (apply system-or-error `("m4" ,@dash-Ds :gt ,rft))
       (copy-mog dest ft)
       (cond
        (equal (crypto-digest rft) (crypto-digest dfp))
        (true (change-file dest "replace with templated contents"
                           (lambda () (system-or-error "mv" rft dfp))
                           nil)))))))
(defun file-contents-from-gsubs-template (dest tmpl vars)
  (when (not (-f tmpl))
    (error "nonexistent template %s" tmpl))
  (with-existing-rooted-plain-file-a-rule (dest dfp)
      ("file-contents-from-gsubs-template: %s <- %s" dest tmpl)
    (let* ((ft (make-temp-filename-from "fcfgst"))
           (rft (*rooted* ft)))
      (with-input-from "<" tmpl
        ;; emacs: (put 'with-secret-output-to 'lisp-indent-function 2)
        (with-secret-output-to ">" rft
          (dolines
           (lambda (line)
             (printf "%s\n" (foldl (lambda (line varpair)
                                     (gsub (car varpair) (cadr varpair) line))
                                   line
                                   vars))))))
      (close tmpl)
      (close rft)
      (copy-mog dest ft)
      (cond
       ((equal (crypto-digest rft) (crypto-digest dfp))
        (system "rm" "-f" rft))
       (true (change-file dest "replace with templated contents"
                          (lambda () (system-or-error "mv" rft dfp))
                          nil))))))

(defun file-exists-with-contents-from-m4 (file-path m o g tmpl vars)
  (file-exists file-path m o g)
  (file-contents-from-m4-template file-path tmpl vars))

(defun file-exists-with-contents-gsubbed (file-path m o g tmpl vars)
  (file-exists file-path m o g)
  (file-contents-from-gsubs-template file-path tmpl vars))
(defun file-exists-with-text-copied-from (dest-file-path m o g src-file-path)
  (file-exists dest-file-path m o g)
  (file-text-copied-from dest-file-path src-file-path))

    
;; op is :set, :add, or :remove
(defun sysrc (op name value)

(defun sysrc-set (name value)

    (let ((setting (sprintf "%s=%s" name value)))
      (cond
       ((apply probe-success `("sysrc" "-c" ,@alt-root ,setting)))
       (true
        (change (sprintf "sysrc %s = %s" name value)
                (lambda () (apply system-or-error
                                  `("sysrc" ,@alt-root ,setting)))))))))
(defun sysrc-add (name sep-and-value)
  ;; You can't sysrc -c ...+=... But if you try to add a value
  ;; onto a variable when it's already in there, nothing happens:
  ;; the += operation is idempotent. But we don't want to just
  ;; always say we changed it: that'll drown real changes in
  ;; chaff.
  ;;
  ;; If we are trying to add value3 and it wasn't there to begin
  ;; with, the old value will be different from the new value. but
  ;; if it was already in there, the two complete values will be
  ;; the same.
  (let* ((add-s (sprintf "%s+=$s" name value))
         (res (apply output-of `("sysrc" ,@alt-root ,add-s)))
         (old-and-new (parse-sysrc-output res))
         (o (car old-and-new))
         (n (cadr old-and-new)))

     ((eq op :set)
      (let ((setting (sprintf "%s=%s" name value)))
        (cond
         ((apply probe-success `("sysrc" "-c" ,@alt-root ,setting)))
         (true
          (change (sprintf "sysrc %s = %s" name value)
                  (lambda () (apply system-or-error
                                    `("sysrc" ,@alt-root ,setting))))))))
     ((eq op :add)
      ;; You can't sysrc -c ...+=... But if you try to add a value
      ;; onto a variable when it's already in there, nothing happens:
      ;; the += operation is idempotent. But we don't want to just
      ;; always say we changed it: that'll drown real changes in
      ;; chaff.
      ;;
      ;;
      ;; If we are trying to add value3 and it wasn't there to begin
      ;; with, the old value will be different from the new value. but
      ;; if it was already in there, the two complete values will be
      ;; the same.
      (let* ((add-s (sprintf "%s+=$s" name value))
             (sub-s (sprintf "%s-=%s" name value))
             (res (apply output-of `("sysrc" ,@alt-root ,add-s)))
             (old-and-new (parse-sysrc-output res))
             (o (car old-and-new))
             (n (cadr old-and-new)))
        (cond
         ;; The value was unchanged by our snooping. That means the
         ;; thing we were trying to add is already in there, so our
         ;; check succeeds and our change will not be done (nor
         ;; superfluously reported).
         ((equal o n))
         ;; We changed it while trying to check. The added value will
         ;; be on the end, so if we remove it, everything will be
         ;; back how we found it, so we can then change it. :)
         (true
          (apply system-or-error `("sysrc" ,@alt-root ,sub-s))
          (change (sprintf "sysrc %s += %s" name value)
                  (lambda ()
                    (apply system-or-error `("sysrc" ,@alt-root ,add-s)))
                  nil)))))
     ((eq op :remove)
      ;; Same as above: you can't check (-c) with -=.
      (let* ((sub-s (sprintf "%s-=%s" name value))
             (res (apply output-of `("sysrc" ,@alt-root ,sub-s)))
             (old-and-new (parse-sysrc-output res))
             (o (car old-and-new))
             (n (cadr old-and-new)))
        (when (not (equal o n))
          ;; while checking it we removed it. uhhhrrr... log a change.
          ;; get better at preparing backouts in the future.
          (change (sprintf "sysrc %s -= %s" name value)
                  (lambda ())
                  nil))))

     ;; The value was unchanged by our snooping. That means the
     ;; thing we were trying to add is already in there, so our
     ;; check succeeds and our change will not be done (nor
     ;; superfluously reported).
     ((equal o n))
     ;; We changed it while trying to check. Say so.

      (error "unknown sysrc op %s; use :set, :add, or :remove" op)))))

      (apply system-or-error `("sysrc" ,@alt-root ,sub-s))
      (change (sprintf "sysrc %s += %s" name value)
              (lambda () true)
              nil)))))
(defun sysrc-remove (name value)
  ;; Same as above: you can't check (-c) with -=.
  (let* ((sub-s (sprintf "%s-=%s" name value))
         (res (apply output-of `("sysrc" ,@alt-root ,sub-s)))
         (old-and-new (parse-sysrc-output res))
         (o (car old-and-new))
         (n (cadr old-and-new)))
    (when (not (equal o n))
      ;; while checking it we removed it. uhhhrrr... log a change.
      ;; get better at preparing backouts in the future.
      (change (sprintf "sysrc %s -= %s" name value)
              (lambda () true)
              nil))))
(defun FreeBSD-boot-fibs (n)
  (let ((directive (sprintf "net.fibs=%d" n)))
    (file-exists-with-entire-contents
     "/boot/loader.conf.d/fibs.conf" "644" "root" "wheel"
     directive directive)))
(defun FreeBSD-boot-load-modules (purpose-identifier module-names)
  (let* ((loads (mapcar
                 (lambda (na) (sprintf "%s_load=\"YES\"" na))
                 module-names))
         (file-contents (apply string-join "\n" loads)))
    (file-exists-with-entire-contents
     (sprintf "/boot/loader.conf.d/%s.conf" purpose-identifier)
     "644" "root" "wheel"
     (sprintf "load modules: %s" (apply string-join " " module-names))
     file-contents)))

;; (put 'with-existing-rooted-plain-file-a-rule 'lisp-indent-function 2)

(defun openssh-listen-only-on ips
  (let ((c "/etc/ssh/sshd_config")
        (lines
         (string-join "\n" (mapcar
                            (lambda (a) (sprintf "ListenAddress %s" a))
                            ips))))
    (delete-lines-matching c "^ListenAddress")
    (insert-line-before c lines "^#ListenAddress")))
;; implements QAK
(defun openssh-keys-only ()
  (let ((c "/etc/ssh/sshd_config"))
    (delete-lines-matching c "^PasswordAuthentication")
    (insert-line-before c "PasswordAuthentication no"
                        "^#PasswordAuthentication")
    (delete-lines-matching c "^KbdInteractiveAuthentication")
    (insert-line-before c "KbdInteractiveAuthentication no"
                        "^#KbdInteractiveAuthentication")))

;; security..." -- md5(1)

;; security..." -- md5(1). Also truncating the hash prevents length
;; extension attacks, to which un-truncated SHA-2 hashes are
;; vulnerable.

(defun assoc-path (path tree)
  (cond
   ((null path) tree)
   (true (assoc-path (cdr path) (cadr (assoc (car path) tree))))))
(macro push (args)
  `(setq ,(cadr args) (cons ,(car args) ,(cadr args))))