Infrastructure as a Service / Nemoptera

Artifact 02595abb39b59b5e7e88f2bd7b604cac8d898e838b81806db0845212a94d18b3:

• File src/fossil/nemoptera_fossil_repo.lfe — part of check-in [14d905c889] at 2026-11-08 15:25:21 on branch trunk — refactor(core): 重命名项目为 Nemoptera (user: pluto size: 2828)

(defmodule nemoptera_fossil_repo
  (export all))

(defun init (repo-path admin-user project-name project-description)
  (nemoptera_fossil:run
   (list "init" "-A" admin-user
         "--project-name" project-name
         "--project-desc" project-description
         repo-path)))

(defun clone (remote-url repo-path admin-user)
  (nemoptera_fossil:run
   (list "clone" remote-url repo-path "--admin-user" admin-user)
   (nemoptera_fossil:clone-timeout-ms)))

(defun set-user-password (repo-path username password)
  (nemoptera_fossil:run
   (list "user" "password" username password "-R" repo-path)))

(defun set-setup-capability (repo-path username)
  (nemoptera_fossil:run
   (list "user" "capabilities" username "s" "-R" repo-path)))

(defun set-description (repo-path name description)
  (let ((sql (lists:flatten
              (list
               "INSERT OR REPLACE INTO config(name,value,mtime) VALUES"
               "('project-name','" (nemoptera_text:sql-quote name) "',julianday('now')),"
               "('project-description','" (nemoptera_text:sql-quote description) "',julianday('now'));"))))
    (nemoptera_fossil:run (list "sql" "-R" repo-path sql))))

(defun configure-web (repo-path)
  (let ((menu (lists:flatten
               (list
                "Home /home * {} "
                "Timeline /timeline * {} "
                "Files /dir?ci=tip&type=tree * {} "
                "Branches /brlist * {} "
                "Tags /taglist * {} "
                "Tickets /ticket * {} "
                "Wiki /wiki * {} "
                "Forum /forum * {} "
                "Search /search * {}")))
        (sql-prefix "INSERT OR REPLACE INTO config(name,value,mtime) VALUES"))
    (case (nemoptera_fossil:run
           (list "sql" "-R" repo-path
                 (lists:flatten
                  (list sql-prefix
                        "('mainmenu','" menu "',julianday('now'));"
                        "UPDATE user SET cap=cap||'h' WHERE login='nobody' AND instr(cap,'h')=0;"))))
      (`#(ok ,_) (nemoptera_fossil_skin:apply repo-path))
      (error error))))

(defun sync (remote-url repo-path)
  (nemoptera_fossil:run
   (list "sync" remote-url "-R" repo-path)
   (nemoptera_fossil:clone-timeout-ms)))

(defun last-timeline (repo-path)
  (case (nemoptera_fossil:run
         (list "sql" "-R" repo-path
               "SELECT strftime('%Y-%m-%d %H:%M',mtime,'localtime') FROM event ORDER BY mtime DESC LIMIT 1;"))
    (`#(ok ,out)
     (case (parse-stamp out)
       ("unknown" "unknown")
       ("" "unknown")
       (stamp (string:trim stamp))))
    (_ "unknown")))

(defun parse-stamp (out)
  (case (re:run (nemoptera_text:to-str out)
                "[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}"
                (list (tuple 'capture 'first 'list)))
    (`#(match (,text)) text)
    (_ "unknown")))