CaaS / Lamina

Artifact 7f374c5546bf16b556cf454d508cc414c693bdb5114d1f3127ae4fd55ab8ee9b:

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

;; Fossil -> Git 单向导出。
;; 当前 Fossil CLI 使用 `git export --autopush URL`，它覆盖了旧版文档中的
;; git setup + git push 两步，并且会在 mirror 目录中保存增量导出状态。
(defmodule lamina_fossil_git
  (export all))

(defun timeout-ms () 300000)

(defun export (repo-path git-url git-username git-token)
  (let ((url (credential-url git-url git-username git-token))
        (mirror (lists:flatten (list repo-path ".git-mirror"))))
    (lamina_fossil:run
     (list "git" "export" mirror "--autopush" url "-R" repo-path)
     (timeout-ms))))

(defun push (repo-path git-url git-username git-token)
  (export repo-path git-url git-username git-token))

(defun status (repo-path)
  (lamina_fossil:run (list "git" "status" "-R" repo-path)))

;; file://、ssh 等不需要把平台表单凭据嵌入 URL；HTTP(S) 才在 authority 中
;; 注入百分号编码后的用户名和令牌，避免特殊字符破坏 URL。
(defun credential-url (url username token)
  (let ((s (to-str url)))
    (if (or (lists:prefix "http://" s) (lists:prefix "https://" s))
        (let* ((scheme-len (if (lists:prefix "https://" s) 8 7))
               (scheme (lists:sublist s scheme-len))
               (rest (lists:nthtail scheme-len s)))
          (case (string:split rest "/" 'leading)
            (`(,authority ,path)
             (if (lists:member 64 authority)
                 s
                 (lists:flatten
                  (list scheme (url-encode username) ":" (url-encode token) "@"
                        authority "/" path))))
            (_ s)))
        s)))

(defun url-encode (value)
  (url-encode (to-str value) '()))

(defun url-encode (chars acc)
  (case chars
    ('() (lists:flatten (lists:reverse acc)))
    (`(,char . ,rest)
     (if (url-safe? char)
         (url-encode rest (cons (list char) acc))
         (url-encode rest (cons (percent-char char) acc))))))

(defun url-safe? (char)
  (or (and (>= char 48) (=< char 57))
      (and (>= char 65) (=< char 90))
      (and (>= char 97) (=< char 122))
      (lists:member char (list 45 46 95 126))))

(defun percent-char (char)
  (let ((hex "0123456789ABCDEF"))
    (list 37 (lists:nth (+ 1 (div char 16)) hex)
          (lists:nth (+ 1 (rem char 16)) hex))))

(defun to-str (value)
  (cond
    ((is_binary value) (binary_to_list value))
    ((is_list value) value)
    ((or (=:= 'undefined value) (=:= 'null value)) "")
    ('true (lists:flatten (io_lib:format "~p" (list value))))))