HGRC Quarry Fossil Service
Simple tools for lasting software

Infrastructure as a Service / Nemoptera

A solid foundation to fork, tweak, and enhance.

Public | Owner: Infrastructure as a Service | Default branch: trunk | Last update: 2026-11-08 16:13

Artifact 3f390ca50da09bf7ed2aea2dcb2c5640ded71d2dd50b4af6111ddf3539497460:


(defmodule nemoptera_mgr
  (behaviour gen_server)
  (export all))

(defun start_link ()
  (gen_server:start_link #(local nemoptera_mgr) 'nemoptera_mgr 'none '()))

(defun start-repo (org-name slug fossil-path)
  (gen_server:call 'nemoptera_mgr
                   (tuple 'start (nemoptera_registry:norm-org org-name)
                          (nemoptera_text:to-str slug)
                          (nemoptera_text:to-str fossil-path))
                   30000))

(defun stop-repo (org-name slug)
  (gen_server:call 'nemoptera_mgr
                   (tuple 'stop (nemoptera_registry:norm-org org-name)
                          (nemoptera_text:to-str slug))
                   30000))

(defun init (_)
  (process_flag 'trap_exit 'true)
  (erlang:send_after 200 (self) 'start-all)
  `#(ok #M()))

(defun handle_call (message _from state)
  (case message
    (`#(start ,org ,slug ,path)
     (case (maps:find (tuple org slug) state)
       (`#(ok ,(tuple pid _old _))
        (if (and (is_pid pid) (is_process_alive pid))
            `#(reply ok ,state)
            (start-and-reply org slug path state)))
       (_ (start-and-reply org slug path state))))
    (`#(stop ,org ,slug)
     (let ((key (tuple org slug)))
       (case (maps:find key state)
         (`#(ok ,(tuple pid _path _))
          (if (is_pid pid) (catch (gen_server:stop pid 'normal 3000)) 'ok)
          (nemoptera_registry:delete org slug)
          `#(reply ok ,(maps:remove key state)))
         (_ `#(reply ok ,state)))))
    (_ `#(reply unknown ,state))))

(defun handle_info (message state)
  (case message
    ('start-all (start-all state))
    (`#(EXIT ,pid ,_reason)
     (case (find-pid pid state)
       ('none `#(noreply ,state))
       (key
        (let (((tuple org slug) key)
              ((tuple _pid path _tries) (maps:get key state)))
          (logger:warning "repository ~s stopped" (list (nemoptera_site:repo-path org slug)))
          (erlang:send_after 1000 (self) (tuple 'restart org slug path))
          `#(noreply ,(maps:put key (tuple 'undefined path 1) state))))))
    (`#(restart ,org ,slug ,path)
     (case (start-child org slug path)
       (`#(ok ,pid) `#(noreply ,(maps:put (tuple org slug) (tuple pid path 0) state)))
       (_ `#(noreply ,state))))
    (_ `#(noreply ,state))))

(defun start-all (state)
  (case (catch
         (nemoptera_db:q
          "SELECT COALESCE(o.name,''), r.name, r.fossil_path
           FROM repositories r LEFT JOIN organizations o ON o.id=r.organization_id;" '()))
    (rows (when (is_list rows))
      `#(noreply ,(lists:foldl #'start-row/2 state rows)))
    (_ `#(noreply ,state))))

(defun start-row (row state)
  (case row
    (`(,org ,slug ,path)
     (let ((org-name (nemoptera_registry:norm-org org)))
       (case (start-child org-name (nemoptera_text:to-str slug) (nemoptera_text:to-str path))
         (`#(ok ,pid)
          (maps:put (tuple org-name (nemoptera_text:to-str slug)) (tuple pid (nemoptera_text:to-str path) 0) state))
         (_ state))))
    (_ state)))

(defun start-and-reply (org slug path state)
  (case (start-child org slug path)
    (`#(ok ,pid)
     `#(reply ok ,(maps:put (tuple org slug) (tuple pid path 0) state)))
    (`#(error ,reason) `#(reply #(error ,reason) ,state))))

(defun start-child (org slug path)
  (case (catch (nemoptera_server:start_link org slug path))
    (`#(ok ,pid) `#(ok ,pid))
    (`#(error ,reason) `#(error ,reason))
    (`#(EXIT ,reason) `#(error ,reason))
    (other `#(error ,other))))

(defun find-pid (wanted state)
  (let ((found (lists:filter
                (lambda (entry)
                  (let* (((tuple _key value) entry)
                         ((tuple pid _path _tries) value))
                    (=:= pid wanted)))
                (maps:to_list state))))
    (case found
      ('() 'none)
      (`(,(tuple key _) . ,_) key))))

(defun handle_cast (_message state) `#(noreply ,state))
(defun terminate (_reason state)
  (lists:foreach
   (lambda (entry)
     (let* (((tuple key value) entry)
            ((tuple org slug) key)
            ((tuple pid _path _tries) value))
       (if (is_pid pid) (catch (gen_server:stop pid 'normal 2000)) 'ok)
       (nemoptera_registry:delete org slug)))
   (maps:to_list state))
  'ok)
(defun code_change (_old state _extra) `#(ok ,state))

Clone

You can clone this repository with the following command:

fossil clone https://hgrc.dev/IaaS/Nemoptera Nemoptera.fossil

Contribute

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