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 15:56

Artifact 5fd3087460fce3444d99f7a153ceece236fa49e2899ecf75acb098b8ce390bff:


(defmodule nemoptera_validate
  (export all))

(defun reserved ()
  '("login" "logout" "setup" "admin" "timeline" "rss" "atom"
    "organizations" "static" "favicon.ico" "robots.txt" "assets"))

(defun check-slug (slug)
  (let ((name (nemoptera_text:to-str slug)))
    (cond
      ((nemoptera_text:blank? name) `#(error "Name is required."))
      ((lists:member (string:lowercase name) (reserved))
       `#(error "That name is reserved."))
      ((case (re:run name "^[A-Za-z0-9][A-Za-z0-9-]{0,63}$")
         (`#(match ,_) 'false)
         (_ 'true))
       `#(error "Use letters, numbers, and hyphens, starting with a letter or number."))
      ('true 'ok))))

(defun check-repo-path (org-name slug except-id)
  (case (check-slug slug)
    ('ok (path-free? org-name slug except-id))
    (error error)))

(defun check-org-name (name except-id)
  (case (check-slug name)
    ('ok
     (cond
       ((org-taken? name except-id) `#(error "An organization with that name already exists."))
       ((loose-repo-taken? name) `#(error "That name is already used by a repository."))
       ('true 'ok)))
    (error error)))

(defun path-free? (org-name slug except-id)
  (cond
    ((and (=:= org-name 'none) (org-taken? slug 0))
     `#(error "That name is already used by an organization."))
    ((repo-taken? org-name slug except-id)
     `#(error "That repository path is already in use."))
    ('true 'ok)))

(defun org-taken? (name except-id)
  (case (nemoptera_db:q "SELECT id FROM organizations WHERE name=? AND id<>?;" (list name except-id))
    (`((,_)) 'true)
    (_ 'false)))

(defun loose-repo-taken? (name)
  (case (nemoptera_db:q "SELECT id FROM repositories WHERE name=? AND organization_id IS NULL;" (list name))
    (`((,_)) 'true)
    (_ 'false)))

(defun repo-taken? (org-name slug except-id)
  (let ((rows (if (=:= org-name 'none)
                  (nemoptera_db:q "SELECT id FROM repositories WHERE name=? AND organization_id IS NULL AND id<>?;"
                                 (list slug except-id))
                  (nemoptera_db:q "SELECT r.id FROM repositories r JOIN organizations o ON o.id=r.organization_id WHERE r.name=? AND o.name=? AND r.id<>?;"
                                 (list slug org-name except-id)))))
    (case rows
      (`((,_)) 'true)
      (_ 'false))))

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.