CaaS / Lamina

Artifact 91c52bf4b5d6243c1e576268410c2faddce55466705611ffd6f850e47d27e35f:

• File src/config/lamina_config.lfe — part of check-in [432128758e] at 2026-10-23 13:56:37 on branch Dev — feat(app): 初始代码 (user: pluto size: 2843)

;; lamina 运行时配置（data/lamina.conf，Erlang term 格式）
;;
;; 文件由 Setup 向导生成（M2），形如：
;;   (site_name "lamina") —— 即 erlang term：{site_name, "lamina"}.
;;   {site_url, "https://..."}.
;;   {db_path, "data/lamina.db"}.
;;   {repo_dir, "data/repos"}.
;; fossil_bin 可选，缺省从 PATH 解析。
(defmodule lamina_config
  (export all))

(defun default-conf-path () "data/lamina.conf")

(defun default-site-name () "lamina")

;; 首次访问时加载并缓存到 persistent_term；path 缺省 data/lamina.conf
(defun load ()
  (load (default-conf-path)))

(defun load (path)
  (case (file:consult path)
    (`#(ok ,terms)
     (let ((conf (maps:from_list terms)))
       (let ((checked (check-fossil-bin conf)))
         (case checked
           (`#(ok ,c)
            (persistent_term:put 'lamina_conf c)
            `#(ok ,c))
           (other other)))))
    (`#(error ,reason)
     `#(error ,(tuple 'consult-failed path reason)))))

;; 测试/进程内注入配置
(defun put (conf)
  (persistent_term:put 'lamina_conf conf))

(defun reload ()
  (persistent_term:erase 'lamina_conf)
  (load))

;; 读取键值；未加载时尝试惰性加载，仍无则返回 default
(defun get (key default)
  (let ((conf (current-conf)))
    (case (maps:find key conf)
      (`#(ok ,v) v)
      ('error default))))

(defun get-conf ()
  (current-conf))

;; 解析 fossil 可执行文件：显式配置优先，其次 PATH
(defun fossil-bin ()
  (let ((conf (current-conf)))
    (case (maps:find 'fossil_bin conf)
      (`#(ok ,bin) bin)
      ('error
       (case (which-fossil (path-dirs))
         (`#(ok ,p) p)
         ('error 'fossil))))))

;;---- internal ----

(defun current-conf ()
  (case (persistent_term:get 'lamina_conf 'error)
    ('error
     (case (load)
       (`#(ok ,c) c)
       (_ #M())))
    (c c)))

(defun check-fossil-bin (conf)
  ;; fossil_bin 缺省不在此校验（延迟到 fossil:run），显式配置则要求存在
  (case (maps:find 'fossil_bin conf)
    ('error `#(ok ,conf))
    (`#(ok ,bin)
     (case (file:read_file_info bin)
       (`#(ok ,_info) `#(ok ,conf))
       (`#(error ,reason)
        `#(error ,(tuple 'fossil-bin-not-found bin reason)))))))

(defun path-dirs ()
  (let ((env (os:getenv "PATH" "")))
    (string:split env ":" 'all)))

(defun which-fossil (dirs)
  (case dirs
    ('() 'error)
    (`(,dir . ,rest)
     (let ((candidate (filename:join dir "fossil")))
       (case (file:read_file_info candidate)
         (`#(ok ,info)
          (if (executable? info)
              `#(ok ,candidate)
              (which-fossil rest)))
         (`#(error ,_) (which-fossil rest)))))))

(defun executable? (info)
  ;; file_info 元组：1=记录名, 2=size, 3=type, 4=access, 5-7=时间, 8=mode
  (let ((mode (element 8 info)))
    (/= 0 (band mode 511))))