;; SPDX-License-Identifier: BSD-2-Clause

;; Herein, we shall generally use "file-path" to mean a path as
;; written in a rule, e.g. /etc/passwd; and the shorter "fp" to mean
;; that path as accessible during the build process, e.g.
;; /home/jaredj/buildin-ma-jails/jail326/root/etc/passwd.

(defun sed (script file-path)
  (let ((new (make-temp-filename-from file-path))
        (fp (*rooted* file-path))
        (nfp (*rooted* new)))
    (system-or-error "sed" "-e" script fp :gt nfp)
    (copy-ogm file-path new)
    (system-or-error "mv" nfp fp)))

;; e.g.
;; (defun do-a-thing-with-a-file (file-path)
;;   (with-existing-rooted-plain-file-a-rule
;;         (file-path fp)
;;         ("we are doing a thing with file %s" file-path)
;;     (do-thing-with fp))))
;;
;; fp in the above example is *introduced* inside the first argument
;; of w-e-r-p-f-a-r.
(macro with-existing-rooted-plain-file-a-rule
  (lambda (args)
    (let ((file-path-name (caar args))
          (fpname (cadar args))
          (rule-log-args (cadr args))
          (body (cddr args)))
      `(with-log-rule ,rule-log-args
         (let ((,fpname (*rooted* ,file-path-name)))
           (if (-f ,fpname)
               (progn ,@body)
             (log-warning "plain file %s not found. no changes made" ,fpname)))))))

(defun replace-line-in-file (file-path detect-regex replace-line)
  (with-existing-rooted-plain-file-a-rule (file-path fp)
      ("replace-line-in-file: in %s, regex %s -> line %s" file-path detect-regex replace-line)
    (let ((script (sprintf "/%s/c \\\n%s\n" detect-regex replace-line)))
      (if (probe-sed-would-change script file-path)
          (sed script file-path)
        (log-info "no change necessary")))))

;; this only adds to the _end_ of the file, at present
(defun add-line-to-file (file-path line detect-regex)
  (with-existing-rooted-plain-file-a-rule (file-path fp)
      ("add-line-to-file: in %s, add %s" file-path line)
    (let* ((grep-command (if detect-regex
                             (list "grep" detect-regex fp)
                           (list "grep" "-xF" line fp)))
           (output (apply probe-output grep-command))
           (script (sprintf "$a\\\n%s\n" line)))
      (if (null output)
          (sed script file-path)
        (log-info "no change necessary")))))

(defun delete-lines-matching (file-path regex)
  (with-existing-rooted-plain-file-a-rule (file-path fp)
      ("delete-lines-matching: in %s, regex %s" file-path regex)
    (let* ((script (sprintf "/%s/d" regex)))
      (if (probe-sed-would-change script file-path)
          (sed script file-path)
        (log-info "no change necessary")))))

(defun file-exists (file-path owner group mode)
  (with-log-rule ("file-exists: %s, owned by %d:%d, mode %s"
                  file-path owner group mode)
    (let ((fp (*rooted* file-path)))
      (cond
       ((-f fp)
        (if (equal (get-ogm file-path) (list owner group mode))
              (log-info "no change necessary")
            (set-ogm file-path owner group mode)))
       ((-e fp)
        (error "%s exists but is not a plain file" fp))
       (true 
        (system-or-error "touch" fp)
        (set-ogm file-path owner group mode))))))

(defun file-does-not-exist (file-path)
  (with-log-rule ("file-does-not-exist: %s" file-path)
    (let ((fp (*rooted* file-path)))
      (cond
       ((-f fp)
        (system-or-error "rm" fp))
       (true
        (log-info "no change necessary"))))))

(defun dir-exists (dir-path owner group mode)
  (with-log-rule ("dir-exists: %s" dir-path)
    (let ((dp (*rooted* dir-path)))
      (cond
       ((-d dp)
        (if (equal (get-ogm dp) (list owner group mode))
            (log-info "no change necessary")
          (set-ogm dp owner group mode)))
       ((-e dp)
        (error "%s exists but is not a directory" dp))
       (true
        (system-or-error "mkdir" dp)
        (set-ogm dp owner n-group mode))))))

(defun editing-nonexistent-file-error (file-path)
  (error "editing nonexistent file %s. ensure file-exists first" file-path))

(defun file-has-immediate-contents (file-path contents)
  (with-log-rule ("file-has-immediate-contents: %s (contents not shown)"
                  file-path)
    (let ((new (make-temp-filename-from file-path))
          (fp (*rooted* file-path))
          (new-fp (*rooted* new)))
      (if (-f fp)
          (progn
            (with-output-to ">" new-fp (printf "%s" contents))
            (if (equal (crypto-digest fp)
                       (crypto-digest new-fp))
                (progn
                  (log-info "no change necessary")
                  (system "rm" "-f" new-fp))
              (copy-ogm file-path new)
              (system-or-error "mv" new-fp fp)))
        (editing-nonexistent-file-error file-path)))))

(defun file-text-copied-from (dest-file-path src-file-path)
  ;; We're not going to assume the src-file-path has the right perms.
  ;; Also the src-file-path is expected to be outside any chroot.
  (when (not (-f src-file-path))
    (error "source file %s does not exist" src-file-path))
  (with-existing-rooted-plain-file-a-rule (dest-file-path dfp)
      ("file-contents-copied-from: %s <- %s" dest-file-path src-file-path)
    (if (equal (crypto-digest dfp) (crypto-digest src-file-path))
        (log-info "no change necessary")
      (let ((tmp  (make-temp-filename-from dest-file-path))
            (dfp-tmp (*rooted* tmp)))
        (with-input-from "<" src-file-path
          (with-output-to ">" dfp-tmp
            (dolines (lambda (l) (printf "%s\n" l)))))
        (copy-ogm dest-file-path tmp)
        (system-or-error "mv" dfp-tmp dfp)))))

(defun file-contents-from-m4-template (dest tmpl vars)
  (when (not (-f tmpl))
    (error "nonexistent template %s" tmpl))
  (with-existing-rooted-plain-file-a-rule (dest dfp)
      (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))
         (if (equal (crypto-digest rft)
                    (crypto-digest dfp))
             (log-info "no change necessary")
           (copy-ogm dest ft)
           (system-or-error "mv" rft dfp))))))

(defun file-exists-with-entire-contents (file-path o g m desc contents)
  (file-exists file-path o g m)
  (file-has-immediate-contents file-path contents))

(defun local-user-exists (user-name additional-groups)
  (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)))
    (if (probe-success "grep" "-q" (sprintf "^%s:" user-name)
                       (*rooted* "/etc/passwd"))
        (log-info "no change necessary")
      (apply system-or-error `("pw" ,@alt-root-addendum
                               "useradd" "-n" ,user-name "-m"
                               ,@group-addendum)))))

(defun package-installed (name pkg-opts)
  (let* ((pkg-opts (if *fact-alt-root*
                       (append (list "-r" *fact-alt-root*) pkg-opts)
                     pkg-opts))
         (installed (apply probe-success `("pkg" ,@pkg-opts
                                           "info" "-e" name))))
    (if installed
        (log-info "no change necessary")
      ;; "If pkg is already installed, nothing is done."
      (apply system-or-error `("pkg" ,@pkg-opts "bootstrap"))
      (apply system-or-error `("pkg" ,@pkg-opts "install" "-y" ,name)))))

;; if we have a sysrc variable whose name is "varname", whose existing
;; value is "value1 value2", and we run "sysrc varname+=value3", then
;; sysrc says "varname: value1 value2 -> value1 value2 value3".
;; between the colon and the arrow is the old value; between the arrow
;; and the end of the line is the new value.
(defun parse-sysrc-output (output)
  (let* ((just-old-and-new (trim (sub "^[^:]+:" "" res)))
         (oan (split just-old-and-new " -> "))
         (o (car oan))
         (n (cadr oan)))
    (list o n)))
    
;; op is :set, :add, or :remove
(defun sysrc (op name value)
  (let ((alt-root
         (if *fact-alt-root* (list "-R" *fact-alt-root*) nil)))
    (cond
     ((eq op :set)
      (let ((setting (sprintf "%s=%s" name value)))
        (if (apply probe-success `("sysrc" "-c" ,@alt-root ,setting))
            (log-info "no change necessary")
          (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)))
        (if (equal o n)
            ;; 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).
            (log-info "no change necessary")
          ;; 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. :)
          ;;
          ;; -- except here in lacrum, we aren't separating checks and
          ;; changes yet, nor worrying about how to undo a change, so
          ;; we shall just be happy. we did the change!
          true)))
     ((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)))
        (if (equal o n)
            (log-info "no change necessary")
          ;; while checking it we removed it. be happy
          true)))
     (true
      (error "unknown sysrc op %s; use :set, :add, or :remove" op)))))