CaaS / Lamina

Artifact 3fa2139c56cb8a9d95095f17fb7a8ec2eeada28c8605b76ff684787de8a01724:

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

;; 每仓一个 fossil server 子进程；服务端口注册到 lamina_repo_registry。
(defmodule lamina_repo_server
  (behaviour gen_server)
  (export all))

(defun get-port (slug)
  (get-port 'none slug))

(defun get-port (org-name slug)
  (case (lamina_repo_registry:get org-name slug)
    (`#(ok ,port) port)
    (_ 'undefined)))

(defun start-link (slug fossil-path)
  (start-link 'none slug fossil-path))

(defun start-link (org-name slug fossil-path)
  ;; 进程由 repo_mgr 持有 PID，不使用动态 local name（local name 必须是 atom）。
  (gen_server:start_link 'lamina_repo_server
                         (tuple org-name slug fossil-path)
                         (list)))

(defun init (slug-path)
  (process_flag 'trap_exit 'true)
  (let (((tuple org-name slug fossil-path) slug-path))
    (case (open-port org-name slug fossil-path 3)
      (`#(ok ,port ,portnum)
       (lamina_repo_registry:put org-name slug portnum)
       `#(ok #(,org-name ,slug ,fossil-path ,port ,portnum)))
      (`#(error ,reason) `#(stop ,reason)))))

(defun open-port (org-name slug fossil-path tries)
  (let ((bin (lamina_config:fossil-bin)))
    (if (is_atom bin)
        `#(error #(enoent "fossil 可执行文件未找到"))
        (try-open bin org-name slug fossil-path tries))))

(defun try-open (bin org-name slug fossil-path tries)
  (let* ((portnum (free-port))
         (args (server-args org-name slug fossil-path portnum))
         (home (lamina_fossil:to-charlist
                (filename:absname (lamina_config:get 'fossil_home "data/fossil-home")))))
    (filelib:ensure_dir (filename:join home "x"))
    (let ((result
           (catch
            (open_port (tuple 'spawn_executable (lamina_fossil:to-charlist bin))
                       (list 'stream 'in 'binary 'exit_status 'hide 'stderr_to_stdout
                             (tuple 'env (port-env home))
                             (tuple 'args args))))))
      (if (is_port result)
          (case (wait-ready result portnum 200 #"")
            ('ok `#(ok ,result ,portnum))
            (`#(error ,reason)
             (catch (port_close result))
             (if (> tries 1)
                 (try-open bin org-name slug fossil-path (- tries 1))
                 `#(error ,reason))))
          (if (> tries 1)
              (try-open bin org-name slug fossil-path (- tries 1))
              `#(error #(port-open ,result)))))))

;; fossil server ?OPTIONS? ?REPOSITORY?
;; --nojail：以 root 运行时默认 chroot，jail 里没有 /dev/null 和 /dev/urandom。
(defun server-args (org-name slug fossil-path portnum)
  (let ((path (lamina_fossil:to-charlist (filename:absname fossil-path)))
        (base (lamina_site_mgr:repo-base-url org-name slug))
        (https? (lists:prefix "https://"
                              (string:lowercase (lamina_site_mgr:site-url)))))
    (lists:append
     (list
      (list "server"
            "--localhost"
            "--nojail"
            "--port" (integer_to_list portnum)
            "--baseurl" base)
      (if https? (list "--https") '())
      (list path)))))

(defun port-env (home)
  (list (tuple "FOSSIL_HOME" home)
        (tuple "HOME" home)
        (tuple "USER" (os:getenv "USER" "lamina"))))

(defun wait-ready (port portnum attempts acc)
  (if (=:= attempts 0)
      `#(error #(timeout ,(binary_to_list acc)))
      (receive
        (`#(,port #(exit_status ,code))
         `#(error #(exit_status ,code ,(binary_to_list acc))))
        (`#(,port #(data ,data))
         (wait-ready port portnum attempts
                     (iolist_to_binary (list acc data))))
        (after 50
          (case (gen_tcp:connect "127.0.0.1" portnum
                                 (list 'binary (tuple 'active 'false)) 50)
            (`#(ok ,sock)
             (gen_tcp:close sock)
             'ok)
            (_ (wait-ready port portnum (- attempts 1) acc)))))))

(defun free-port ()
  (case (catch (gen_tcp:listen 0 (list 'binary
                                       (tuple 'active 'false)
                                       (tuple 'reuseaddr 'true)
                                       (tuple 'ip (tuple 127 0 0 1)))))
    (`#(ok ,sock)
     (let ((result (inet:port sock)))
       (gen_tcp:close sock)
       (case result
         (`#(ok ,port) port)
         (_ (random-port)))))
    (_ (random-port))))

(defun random-port ()
  (+ 20000 (erlang:phash2 (os:timestamp) 10000)))

(defun handle_call (_msg _from state) (tuple 'reply 'ok state))
(defun handle_cast (_msg state) `#(noreply ,state))

(defun handle_info (msg state)
  (let (((tuple org-name slug _fossil-path port _portnum) state))
    (case msg
      (`#(,port #(data ,_data)) `#(noreply ,state))
      (`#(EXIT ,port ,reason)
       (lamina_repo_registry:delete org-name slug)
       `#(stop #(port-exited ,reason)))
      (`#(,port #(exit_status ,code))
       (lamina_repo_registry:delete org-name slug)
       `#(stop #(port-exited ,code)))
      (_ `#(noreply ,state)))))

(defun terminate (_reason state)
  (let (((tuple org-name slug _fossil-path port _portnum) state))
    (catch (port_close port))
    (lamina_repo_registry:delete org-name slug)
    'ok))

(defun code-change (_old state _extra) `#(ok ,state))