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 2176b8eb401378961f82b94e99c387391b2764038823308647d41e601ae2a746:


;; 仓库路由注册表。ETS 由这个常驻进程持有,避免仓库进程退出时丢失整张表。
(defmodule lamina_repo_registry
  (behaviour gen_server)
  (export all))

(defun table () 'lamina_repo_registry_table)

(defun key (org-name slug)
  (tuple (norm-org org-name) (to-str slug)))

;; SQLite 文本是 binary,URL 路径是 charlist;ETS 键必须统一。
(defun norm-org (org-name)
  (cond
    ((or (=:= org-name 'none) (=:= org-name 'undefined) (=:= org-name 'null)) 'none)
    ((is_binary org-name) (norm-org (binary_to_list org-name)))
    ((or (=:= org-name "") (=:= org-name #"")) 'none)
    ('true org-name)))

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

(defun start-link ()
  (gen_server:start_link #(local lamina_repo_registry)
                         'lamina_repo_registry 'none (list)))

(defun start_link () (start-link))

(defun init (_)
  (case (ets:info (table))
    ('undefined
     (ets:new (table) (list 'named_table 'public 'set
                            (tuple 'read_concurrency 'true))))
    (_ 'ok))
  (tuple 'ok 'ok))

(defun put (slug port)
  (put 'none slug port))

(defun put (org-name slug port)
  (case (ets:info (table))
    ('undefined 'undefined)
    (_ (ets:insert (table) (tuple (key org-name slug) port)))))

(defun get (slug)
  (get 'none slug))

(defun get (org-name slug)
  (case (ets:lookup (table) (key org-name slug))
    (`(#(,_key ,port)) `#(ok ,port))
    (_ 'undefined)))

(defun delete (slug)
  (delete 'none slug))

(defun delete (org-name slug)
  (case (ets:info (table))
    ('undefined 'ok)
    (_ (ets:delete (table) (key org-name slug)))))

(defun clear ()
  (case (ets:info (table))
    ('undefined 'ok)
    (_ (ets:delete_all_objects (table)))))

(defun handle_call (_msg _from state) (tuple 'reply 'ok state))
(defun handle_cast (_msg state) `#(noreply ,state))
(defun handle_info (_msg state) `#(noreply ,state))
(defun terminate (_reason _state) 'ok)
(defun code-change (_old state _extra) `#(ok ,state))

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.