CaaS / Lamina

Artifact ffe9629dc874738d3b23cfb5b39352c6273558cbc909ca3502e4275887448b67:

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

;; fossil CLI 执行器。
;; 所有参数通过 open_port 传递，不经过 shell；输出统一收集 stdout/stderr。
(defmodule lamina_fossil
  (export all))

(defun default-timeout-ms () 120000)
(defun clone-timeout-ms () 300000)

(defun run (args)
  (run args (default-timeout-ms)))

(defun run (args timeout-ms)
  (let ((bin (lamina_config:fossil-bin)))
    (if (is_atom bin)
        `#(error #(enoent "fossil 可执行文件未找到（检查配置 fossil_bin 或 PATH）"))
        (run-bin bin args timeout-ms))))

;; 公开给测试使用：可用任意可执行文件验证退出码、超时和输出收集。
(defun run-bin (bin args timeout-ms)
  (let ((cmd-args (lists:map (lambda (a) (to-charlist a)) args))
        (home (to-charlist (lamina_config:get 'fossil_home "data/fossil-home"))))
    (filelib:ensure_dir (filename:join home "x"))
    (case (catch
           (open_port (tuple 'spawn_executable (to-charlist bin))
                      (list 'stream 'in 'binary 'exit_status 'hide 'stderr_to_stdout
                            (tuple 'env (list (tuple "FOSSIL_HOME" home)
                                              (tuple "USER" (os:getenv "USER" "lamina"))))
                            (tuple 'args cmd-args))))
      (`#(EXIT ,reason) (open-error reason))
      (port (collect port #"" timeout-ms)))))

(defun collect (port acc timeout-ms)
  (receive
    (`#(,port #(data ,data))
     (collect port (iolist_to_binary (list acc data)) timeout-ms))
    (`#(,port #(exit_status 0))
     `#(ok ,(binary_to_list acc)))
    (`#(,port #(exit_status ,code))
     `#(error #(exit_status ,code ,(binary_to_list acc))))
    (after timeout-ms
      (catch (port_close port))
      `#(error timeout))))

(defun open-error (reason)
  (let ((text (lists:flatten (io_lib:format "~p" (list reason)))))
    (cond
      ((or (=:= reason 'enoent) (lists:member "enoent" (string:lexemes text "{} ,")))
       `#(error #(enoent ,text)))
      ((or (=:= reason 'eacces) (lists:member "eacces" (string:lexemes text "{} ,")))
       `#(error #(eacces ,text)))
      ('true `#(error #(enoent ,text))))))

(defun error-message (reason)
  (case reason
    (`#(enoent ,_) "找不到 fossil 可执行文件或目标路径")
    (`#(eacces ,_) "fossil 或目标目录没有访问权限")
    (`#(exit_status ,code ,out)
     (lists:flatten (io_lib:format "fossil 退出码 ~p: ~s" (list code out))))
    ('timeout "fossil 命令超时")
    (`#(timeout ,out)
     (if (=:= "" out)
         "fossil server 启动超时"
         (lists:flatten (io_lib:format "fossil server 启动超时: ~s" (list out)))))
    (`#(port-open ,detail)
     (lists:flatten (io_lib:format "无法启动 fossil server: ~p" (list detail))))
    (_ (lists:flatten (io_lib:format "fossil 命令失败: ~p" (list reason))))))

(defun to-charlist (a)
  (cond
    ((is_binary a) (binary_to_list a))
    ((is_list a) a)
    ('true (lists:flatten (io_lib:format "~p" (list a))))))