Fosi Fossil Service
Small teams. Open source. Built on Fossil.

CaaS / Lamina

Unified Management for Fossil Repositories

Public | Owner: CaaS | Default branch: trunk | Last update: 2026-10-25 00:41

Artifact fc7ee4edeb3deaef249570d924344cb9fc58f8c2668c01213a9e5bf0346b58e5:


;; Setup 安装向导页面(GET /setup, POST /setup/step/:n)
(defmodule lamina_setup_pages
  (export all))

(defun steps ()
  (list "Welcome" "Site Settings" "Database" "Storage" "Admin Account" "Finish"))

(defun show (req)
  (if (=:= 'true (lamina_setup:installed?))
      (redirect "/login")
      (render-step (lamina_setup:current-step) req "")))

;; POST /setup/step/:n —— n 为刚提交的步骤号
(defun step (req)
  (if (=:= 'true (lamina_setup:installed?))
      (redirect "/login")
      (let ((n (step-number (maps:get 'bindings req))))
        (handle-step n (maps:get 'params req #M()) req))))

(defun step-number (bindings)
  (let ((v (case (maps:find 'n bindings)
             (`#(ok ,x) x)
             ('error
              (case (maps:find #"n" bindings)
                (`#(ok ,x) x)
                ('error "1"))))))
    (case (catch (list_to_integer (if (is_binary v) (binary_to_list v) v)))
      (`#(EXIT ,_) 1)
      (n n))))

(defun handle-step (n params req)
  (let ((state (lamina_setup:get-state)))
    (let ((result
           (case n
             (1 (if (lamina_setup:all-ok? (lamina_setup:check-env))
                    (progn (lamina_setup:advance state 2) 'ok)
                    `#(error "环境检测未通过,请修复失败项后再继续")))
             (2 (lamina_setup:save-site state params))
             (3 (lamina_setup:save-db state params))
             (4 (lamina_setup:save-storage state params))
             (5 (lamina_setup:save-admin state params))
             (6 (lamina_setup:finalize state))
             (_ `#(error "未知步骤")))))
      (if (=:= 'ok result)
          (case n
            ;; 第 6 步完成后进入登录页(M3 实现,暂由公开首页代替提示)
            (6 (redirect "/"))
            (_ (render-step (lamina_setup:current-step) req "")))
          (render-step (lamina_setup:current-step) req
                       (case result
                         (`#(error ,msg) msg)
                         (_ "未知错误")))))))

;;---- 渲染 ----

(defun render-step (step req err)
  (let ((body (step-body step req)))
    (html 200 (page step err body))))

(defun step-body (step req)
  (case step
    (1 (render-welcome))
    (2 (render-site))
    (3 (render-db))
    (4 (render-storage))
    (5 (render-admin))
    (6 (render-finish req))))

(defun heading (n name)
  (concat-strings
   (list "<h1>Setup</h1><p class=\"kicker\">Step " (integer_to_list n)
         " of 6 - " name "</p>")))

(defun render-welcome ()
  (concat-strings
   (list
    (heading 1 "Welcome")
    "<p>This wizard will help you set up lamina, a simple code hosting platform for small teams, built on Fossil SCM.</p>"
    "<p>You will be guided through a few basic configuration steps.</p>"
    "<hr><h2>License</h2>"
    "<p>lamina is open source software, released under the <a href=\"https://opensource.org/licenses/MIT\">MIT License</a>.</p>"
    "<hr><h2>Prerequisites</h2>"
    "<p>Before you begin, please make sure the following requirements are met:</p>"
    "<ul class=\"check\">"
    (checks-html (lamina_setup:check-env))
    "</ul>"
    (next-button))))

(defun checks-html (checks)
  (string:join
   (lists:map
    (lambda (c)
      (concat-strings
       (list "<li class=\"" (if (maps:get 'ok c) "ok" "fail") "\">"
             (if (maps:get 'ok c) "Pass" "Fail")
             " - <b>" (escape (maps:get 'name c)) "</b>: " (escape (maps:get 'detail c))
             "</li>")))
    checks)
   ""))

(defun render-site ()
  (concat-strings
   (list
    (heading 2 "Site Settings")
    "<p>These values appear on the public site, login page, and repository skin.</p>"
    (field "site_name" "Site name" "lamina")
    (field "site_url" "Site URL" "http://localhost:8827")
    (next-button))))

(defun render-db ()
  (concat-strings
   (list
    (heading 3 "Database")
    "<p>SQLite3 database file path. The directory will be created if it does not exist.</p>"
    (field "db_path" "Database path" "data/lamina.db")
    (next-button))))

(defun render-storage ()
  (concat-strings
   (list
    (heading 4 "Storage")
    "<p>Directory used to store Fossil repository files.</p>"
    (field "repo_dir" "Repository directory" "data/repos")
    (next-button))))

(defun render-admin ()
  (concat-strings
   (list
    (heading 5 "Admin Account")
    "<p>Create the single administrator account for this site.</p>"
    (field "username" "Username" "admin")
    (password-field "password" "Password (at least 8 characters)")
    (password-field "password2" "Confirm password")
    (next-button))))

(defun render-finish (_req)
  (let ((s (lamina_setup:get-state)))
    (concat-strings
     (list
      (heading 6 "Finish")
      "<p>Review the configuration, then write files, generate the secret key, and create the admin account.</p>"
      "<hr><h2>Summary</h2><ul class=\"check\">"
      "<li>Site name: " (escape (maps:get 'site_name s "")) "</li>"
      "<li>Site URL: " (escape (maps:get 'site_url s "")) "</li>"
      "<li>Database: " (escape (maps:get 'db_path s "")) "</li>"
      "<li>Repository directory: " (escape (maps:get 'repo_dir s "")) "</li>"
      "<li>Administrator: " (escape (maps:get 'username s "")) "</li>"
      "</ul>"
      (next-button)))))

;;---- HTML 片段 ----

(defun field (name label default)
  (concat-strings
   (list "<label>" (escape label) "<input type=\"text\" name=\""
         (escape name) "\" value=\"" (escape default) "\"></label>")))

(defun password-field (name label)
  (concat-strings
   (list "<label>" label "<input type=\"password\" name=\"" name "\"></label>")))

(defun next-button ()
  "<button class=\"btn\" type=\"submit\">Next -&gt;</button>")

(defun page (step err body)
  (concat-strings
   (list
    "<!DOCTYPE html><html lang=\"en\"><head><meta charset=\"utf-8\">"
    "<meta name=\"color-scheme\" content=\"light only\">"
    "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">"
    "<title>Setup · lamina</title><style>" (lamina_ui:setup-css) "</style></head><body>"
    "<div class=\"shell\"><div class=\"top\"><div><a class=\"brand\" href=\"/setup\">lamina</a>"
    "<p class=\"tag\">Simple code hosting for small teams</p></div></div>"
    "<div class=\"wrap\"><nav class=\"steps\">" (steps-html step) "</nav>"
    "<div class=\"main\">"
    (if (=:= "" err) "" (list "<div class=\"err\">" (escape err) "</div>"))
    "<form method=\"POST\" action=\"/setup/step/" (integer_to_list step) "\">"
    body
    "</form></div></div>"
    "<div class=\"foot\"><span>lamina v0.1.0</span><nav>"
    "<a href=\"https://fossil-scm.org/home/doc/trunk/www/index.wiki\">Documentation</a>"
    "<a href=\"https://fossil-scm.org\">Source</a></nav></div></div></body></html>")))

(defun steps-html (cur)
  (string:join
   (lists:map
    (lambda (i)
      (let ((name (lists:nth i (steps))))
        (concat-strings
         (list "<div" (if (=:= i cur) " class=\"cur\"" "") ">"
               (integer_to_list i) ". " name "</div>"))))
    (lists:seq 1 6))
   ""))

;;---- helpers ----

(defun redirect (path)
  `#(redirect ,path))

(defun html (code body)
  `#(status ,code #M(#"content-type" #"text/html; charset=utf-8") ,(list_to_binary body)))

(defun concat-strings (parts)
  (lists:flatten parts))

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

(defun escape (value)
  (let ((s (to-str value)))
    (string:replace
     (string:replace
      (string:replace
       (string:replace
        (string:replace s "&" "&amp;" 'all)
        "<" "&lt;" 'all)
       ">" "&gt;" 'all)
      "\"" "&quot;" 'all)
     "'" "&#39;" 'all)))

Clone

You can clone this repository with the following command:

fossil clone https://fosi.dev/CaaS/Lamina

Contribute

The best way to contribute is through e-mail. See the project documentation for more details.