lacrum: $(SOURCES)

lacrum: $(SOURCES) $(GLOTAWK)

(*package-installed*  /name/ /pkg-opts/)

(*package-installed*  /name/ [ *:pkg-opts* /pkg-opts/ ])

   (handle
       (lambda (st)
         (log-error "change failed. this is where we would do some smart backing-outing."))
     (change-func))))

   (change-func)
   ))

                      (set-mog dp owner n-group mode))))))))

                      (set-mog dp mode owner group))))))))

;; You *can* use this... but we are running *inside awk*. so the gsubs
;; thing below may be faster and is certainly less cantankerous. use
;; it instead.

  (let ((alt-root-addendum
         (if *fact-alt-root* (list "-R" *fact-alt-root*) nil))
        (groups-addendum
         (if additional-groups
             (list "-G" (apply string-join "," additional-groups))
           nil)))
    (cond
     ((probe-success "grep" "-q" (sprintf "^%s:" user-name)
                     (*rooted* "/etc/passwd")))
     (true
      (change (sprintf "add local user %s" user-name)
              (lambda () (apply system-or-error
                                `("pw" ,@alt-root-addendum
                                  "useradd" "-n" ,user-name "-m"
                                  ,@group-addendum)))
              nil)))))

  (with-log-rule ("local user exists: %s" user-name)
    (let ((alt-root-addendum
           (if *fact-alt-root* (list "-R" *fact-alt-root*) nil))
          (groups-addendum
           (if additional-groups
               (list "-G" (apply string-join "," additional-groups))
             nil)))
      (cond
       ((probe-success "grep" "-q" (sprintf "^%s:" user-name)
                       (*rooted* "/etc/passwd")))
       (true
        (change (sprintf "add local user %s" user-name)
                (lambda () (apply system-or-error
                                  `("pw" ,@alt-root-addendum
                                    "useradd" "-n" ,user-name "-m"
                                    ,@group-addendum)))
                nil))))))

(defun package-installed (name pkg-opts)

(defun package-installed (name :kw pkg-opts)

                       `("pkg" ,@pkg-opts "install" "-y" ,name))))))))

                       `("pkg" ,@pkg-opts "install" "-y" ,name)))
              nil)))))

  (let ((alt-root
         (if *fact-alt-root* (list "-R" *fact-alt-root*) nil)))
    (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)))
                nil))))))

  (with-log-rule ("sysrc %s = %s" name value)
    (let ((alt-root
           (if *fact-alt-root* (list "-R" *fact-alt-root*) nil)))
      (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)))
                  nil)))))))

  (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)))
    (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. Say so.
     (true
      (apply system-or-error `("sysrc" ,@alt-root ,sub-s))
      (change (sprintf "sysrc %s += %s" name value)
              (lambda () true)
              nil)))))

  (with-log-rule ("sysrc %s += %s" name (repr sep-and-value))
    (let* ((alt-root
            (if *fact-alt-root* (list "-R" *fact-alt-root*) nil))
           (add-s (sprintf "%s+=%s" name sep-and-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. Say so.
       (true
        (apply system-or-error `("sysrc" ,@alt-root ,add-s))
        (change (sprintf "sysrc %s += %s" name sep-and-value)
                (lambda () true)
                nil))))))

  (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))))

  (with-log-rule ("sysrc %s -= %s" name (repr value))
    (let* ((alt-root
            (if *fact-alt-root* (list "-R" *fact-alt-root*) nil))
           (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)))))

  (let ((directive (sprintf "net.fibs=%d" n)))
    (file-exists-with-entire-contents
     "/boot/loader.conf.d/fibs.conf" "644" "root" "wheel"
     directive directive)))

  (with-log-rule ("configure %d fibs at boot" n)
    (let ((directive (sprintf "net.fibs=%d" n)))
      (file-exists-with-entire-contents
       "/boot/loader.conf.d/fibs.conf" "644" "root" "wheel"
       directive directive))))

  (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)))

  (with-log-rule ("load %s modules at boot" purpose-identifier)
    (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))))

  (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")))

  (with-log-rule ("OpenSSH listen only on %d addresses" (list-length 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"))))

  (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")))

  (with-log-rule ("OpenSSH using 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"))))

(setq *log-tags* '( :info :warning :error :probe :rule :change))

(setq *log-tags* '( :warning :error :probe :rule :change))
;; 
(setq *max-rule-indent* 6)

  (when (memq :rule *log-tags*)

  (when (and (memq :rule *log-tags*) (<= *indent* *max-rule-indent*))

  (when (memq :rule *log-tags*)

  (when (and (memq :rule *log-tags*) (<= *indent* *max-rule-indent*))

(defun zip args (apply mapcars list args))

;; defunning zip (args) to be (apply mapcars list args) evaluated args
;; too many times. well, macros evaluate things less times ;P
(macro zip
  (lambda (args)
    `(mapcars list ,@args)))

;; a "table" is a list like so:
;; (setq a-table '((:col1 :col2 :col3)
;;                 (1 2 3)
;;                 (4 5 6)))
;;
;; (table-to-alists a-table) => ( ((:col1 1) (:col2 2) (:col3 3))
;;                                ((:col1 4) (:col2 5) (:col3 6)) )

;; example: (setq ns '(a b c d e))
;;          (setq xs '((1 2 3 4 5) (6 7 8 9 10)))
;;          (do-table (ns xs)
;;             (print c))
;; => 3
;;    8
;;    ()

(defun table-to-alists (t)
  (let ((header (car t))
        (rows (cdr t)))
    (mapcar (lambda (r) (zip header r)) rows)))
;; those alists, then, can be passed to a lambda that takes keyword
;; arguments: for example,
;;
;; (mapcar-table (lambda (:kw col2) col2) a-table) => (2 5)
(defun mapcar-table (kwthunk table)
  (mapcar kwthunk (table-to-alists table)))
;; e.g. (do-table ((col2 col3) a-table)
;;         (print (+ col2 col3)))

    `(dolist (vlan ,(cadar args))
       (multilet (,(eval (caar args)) vlan)
                 ,@(cdr args)))))

    `(mapcar-table (lambda (:kw ,@(caar args))
                     ,@(cdr args))
                   ,(cadar args))))

   (true (assoc-path (cdr path) (cadr (assoc (car path) tree))))))

   (true
    (let ((next (cadr (assoc (car path) tree))))
      (cond
       ((null next) (error "assoc-path went astray: path %s, tree %s"
                           path tree))
       (true (assoc-path (cdr path) next)))))))