From 93ef009a91e0ce17b7cd4c5d9f274263cf45b6e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nguy=E1=BB=85n=20Gia=20Phong?= Date: Mon, 17 Nov 2025 15:46:53 +0900 Subject: [PATCH] services: Add fossil-service-type. * gnu/services/version-control.scm (fossil-service-type, fossil-configuration): New public variables. * gnu/tests/version-control.scm (%test-fossil): Add system tests. * doc/guix.texi (Version Control Services): Add Fossil documentation. Change-Id: I84e09fe8c11e161ed7c4bdba42b0ae38ef4c2096 --- doc/guix.texi | 143 ++++++++++++++++++ gnu/services/version-control.scm | 245 ++++++++++++++++++++++++++++++- gnu/tests/version-control.scm | 67 ++++++++- 3 files changed, 453 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index b08c30cb954..c2fe0e8b693 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -147,6 +147,7 @@ Copyright @copyright{} 2025 Edouard Klein@* Copyright @copyright{} 2025 Rodion Goritskov@* Copyright @copyright{} 2025 dan@* Copyright @copyright{} 2025 Noé Lopez@* +Copyright @copyright{} 2025 Nguyễn Gia Phong@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -43248,6 +43249,148 @@ like to serve. @end table @end deftp +@anchor{fossil-service-type} +@subsubheading Fossil Service + +@cindex Fossil service +@cindex Fossil, forge +@uref{https://fossil-scm.org, Fossil} is a distributed +software configuration management system. In addition to version control +like Git, Fossil also supports bug tracking, wiki, forum, chat, etc., +all accessible via its built-in web interface. + +Fossil is highly reliable thanks to its robust file format based on SQLite +with atomic transactions. Its server is CPU, memory and bandwidth efficient +enough run comfortably on a cheap VPS or single board computer, +and be accessed over suboptimal connections. + +The following example will configure Fossil to listen on a unix socket +behind a reverse proxy and serve repositories from a custom location. + +@lisp +(service fossil-service-type + (fossil-configuration + (repository "/srv/museum") + (repo-list? #t) + (base-url "https://museum.example") + (socket-file "/var/run/fossil.sock") + (compress? #f))) +@end lisp + +@deftp {Data Type} fossil-configuration +Available @code{fossil-configuration} fields are: + +@table @asis +@item @code{package} (default: @code{fossil}) (type: package) +The Fossil package to use. + +@item @code{user} (default: @code{"fossil"}) (type: string) +The user running the Fossil server. + +@item @code{group} (default: @code{"fossil"}) (type: string) +The user group running the Fossil server. + +@item @code{log-file} (default: @code{"/var/log/fossil.log"}) (type: string) +The path to the server's log. + +@item @code{repository} (default: @code{"/var/lib/fossil"}) (type: string) +The name of the Fossil repository to be served, or a directory +containing one or more repositories with names ending in @code{.fossil}. +In the latter case, a prefix of the URL pathname is used to search the +directory for an appropriate repository. Files not matching the pattern +@code{*.fossil*} will be served as static content. Invoke @command{fossil +server --help} for more information. + +@item @code{acme?} (default: @code{#f}) (type: boolean) +Deliver files from the @code{.well-known} subdirectory. + +@item @code{base-url} (type: maybe-string) +The URL used as the base (useful for reverse proxies) + +@item @code{chroot} (type: maybe-string) +The directory to use for chroot instead of @code{repository}. + +@item @code{ckout-alias} (type: maybe-string) +The NAME for /doc/NAME/... to be treated as /doc/ckout/... + +@item @code{compress?} (default: @code{#t}) (type: boolean) +Compress HTTP response. + +@item @code{create?} (default: @code{#f}) (type: boolean) +Create a new @code{repository} if it does not already exist. + +@item @code{error-log-file} (type: maybe-string) +The path for HTTP error log. + +@item @code{ext-root} (type: maybe-string) +The document root for the /ext extension mechanism. + +@item @code{files} (type: maybe-list-of-strings) +The glob patterns for static files. + +@item @code{from} (type: maybe-string) +The path to be used as the diff baseline for the /ckout page. + +@item @code{jail?} (default: @code{#t}) (type: boolean) +Whether to enter the chroot jail after dropping root privileges. + +@item @code{js-mode} (type: maybe-fossil-js-mode) +How JavaScript is delivered with pages, either @code{'inline} at the end +of the HTML file, as @code{'separate} HTTP requests, or one single HTTP +request for all JavaScript @code{'bundled} together. Depending on the +needs of any given page, @code{'inline} and @code{'bundled} modes might +result in a single amalgamated script or several, but both approaches +result in fewer HTTP requests than the @code{'separate} mode. + +@item @code{https?} (default: @code{#f}) (type: boolean) +Indicate that the requests are coming through a reverse proxy that has +already translated HTTPS into HTTP. + +@item @code{ip} (type: maybe-string) +The IP for the server to listen on. + +@item @code{local-auth?} (default: @code{#f}) (type: boolean) +Enable automatic login for requests from localhost. + +@item @code{main-menu} (type: maybe-string) +The file whose contents is to override the repository's @code{mainmenu} +setting. + +@item @code{max-latency} (type: maybe-number) +The maximum latency in seconds for a single HTTP request. + +@item @code{port} (default: @code{8080}) (type: port-number) +The port number for the server to listen on. + +@item @code{repo-list?} (default: @code{#f}) (type: boolean) +If @code{repository} is dir, URL @code{/} lists repos. + +@item @code{redirect-to-https?} (default: @code{#t}) (type: boolean) +If set to @code{#f}, do not force redirects to HTTPS regardless of the +repository setting @code{redirect-to-https}. + +@item @code{skin} (type: maybe-string) +The skin label to use, overriding repository settings. + +@item @code{socket-file} (type: maybe-string) +The unix-domain socket to use instead of TCP/IP. + +@item @code{socket-mode} (default: @code{0o640}) (type: mode-number) +The file permissions to set for the unix socket. + +@item @code{th-trace?} (default: @code{#f}) (type: boolean) +Trace TH1 execution (for debugging purposes). + +@item @code{tls-cert} (type: maybe-string) +The certicate file (@file{fullchain.pem}) with which to enable TLS +(HTTPS) encryption. + +@item @code{tls-private-key} (type: maybe-string) +The file storing the TLS private key. + +@end table + +@end deftp @node Game Services @subsection Game Services diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index a7f40812a6c..b42a9eb8343 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2021 Julien Lepiller ;;; Copyright © 2025 Tomas Volf <~@wolfsden.cz> ;;; Copyright © 2025 Evgeny Pisemsky +;;; Copyright © 2025 Nguyễn Gia Phong ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,12 +27,14 @@ (define-module (gnu services version-control) #:use-module (gnu services) #:use-module (gnu services base) + #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu services web) #:use-module (gnu system shadow) #:use-module (gnu packages version-control) #:use-module (gnu packages admin) #:use-module (guix deprecation) + #:use-module (guix packages) #:use-module (guix records) #:use-module (guix gexp) #:use-module (guix store) @@ -93,7 +96,43 @@ gitile-configuration-footer gitile-configuration-nginx - gitile-service-type)) + gitile-service-type + + fossil-configuration + fossil-configuration? + fossil-configuration-package + fossil-configuration-user + fossil-configuration-group + fossil-configuration-log-file + fossil-configuration-repository + fossil-configuration-acme? + fossil-configuration-base-url + fossil-configuration-chroot + fossil-configuration-ckout-alias + fossil-configuration-compress? + fossil-configuration-create? + fossil-configuration-error-log-file + fossil-configuration-ext-root + fossil-configuration-files + fossil-configuration-from + fossil-configuration-jail? + fossil-configuration-js-mode + fossil-configuration-https? + fossil-configuration-ip + fossil-configuration-local-auth? + fossil-configuration-main-menu + fossil-configuration-max-latency + fossil-configuration-port + fossil-configuration-repo-list? + fossil-configuration-redirect-to-https? + fossil-configuration-skin + fossil-configuration-socket-file + fossil-configuration-socket-mode + fossil-configuration-th-trace? + fossil-configuration-tls-cert + fossil-configuration-tls-private-key + + fossil-service-type)) ;;; Commentary: ;;; @@ -603,3 +642,207 @@ on the web.") gitile-shepherd-service) (service-extension nginx-service-type gitile-nginx-server-block))))) + + +;;; +;;; Fossil HTTP server. +;;; + +(define (port-number? n) + (and (integer? n) + (> n 0) + (< n (expt 2 16)))) + +(define (mode-number? n) + (and (integer? n) + (>= n 0) + (<= n #o777))) + +(define (fossil-js-mode? x) + (and (memq x '(inline separate bundled)) + #t)) + +(define-maybe/no-serialization number) +(define-maybe/no-serialization string) +(define-maybe/no-serialization list-of-strings) +(define-maybe/no-serialization fossil-js-mode) + +(define-configuration/no-serialization fossil-configuration + (package (package fossil) + "The Fossil package to use.") + (user (string "fossil") + "The user running the Fossil server.") + (group (string "fossil") + "The user group running the Fossil server.") + (log-file (string "/var/log/fossil.log") + "The path to the server's log.") + (repository (string "/var/lib/fossil") + "The name of the Fossil repository to be served, or a directory +containing one or more repositories with names ending in @code{.fossil}. + +In the latter case, a prefix of the URL pathname is used +to search the directory for an appropriate repository. +Files not matching the pattern @code{*.fossil*} +will be served as static content. Invoke @command{fossil server --help} +for more information.") + (acme? (boolean #f) + "Deliver files from the @code{.well-known} subdirectory.") + (base-url maybe-string + "The URL used as the base (useful for reverse proxies)") + (chroot maybe-string + "The directory to use for chroot instead of @code{repository}.") + (ckout-alias maybe-string + "The NAME for /doc/NAME/... to be treated as /doc/ckout/...") + (compress? (boolean #t) "Compress HTTP response.") + (create? (boolean #f) + "Create a new @code{repository} if it does not already exist.") + (error-log-file maybe-string "The path for HTTP error log.") + (ext-root maybe-string "The document root for the /ext extension mechanism.") + (files maybe-list-of-strings "The glob patterns for static files.") + (from maybe-string + "The path to be used as the diff baseline for the /ckout page.") + (jail? (boolean #t) + "Whether to enter the chroot jail after dropping root privileges.") + (js-mode maybe-fossil-js-mode + "How JavaScript is delivered with pages, either @code{'inline} +at the end of the HTML file, as @code{'separate} HTTP requests, +or one single HTTP request for all JavaScript @code{'bundled} together. + +Depending on the needs of any given page, @code{'inline} +and @code{'bundled} modes might result in a single amalgamated script +or several, but both approaches result in fewer HTTP requests +than the @code{'separate} mode.") + (https? (boolean #f) + "Indicate that the requests are coming through a reverse proxy +that has already translated HTTPS into HTTP.") + (ip maybe-string "The IP for the server to listen on.") + (local-auth? (boolean #f) + "Enable automatic login for requests from localhost.") + (main-menu maybe-string ; TODO: structure + "The file whose contents is to override +the repository's @code{mainmenu} setting.") + (max-latency maybe-number + "The maximum latency in seconds for a single HTTP request.") + (port (port-number 8080) "The port number for the server to listen on.") + (repo-list? (boolean #f) + "If @code{repository} is dir, URL @code{/} lists repos.") + (redirect-to-https? (boolean #t) + "If set to @code{#f}, do not force redirects to HTTPS +regardless of the repository setting @code{redirect-to-https}.") + (skin maybe-string "The skin label to use, overriding repository settings.") + (socket-file maybe-string + "The unix-domain socket to use instead of TCP/IP.") + (socket-mode (mode-number #o640) + "The file permissions to set for the unix socket.") + (th-trace? (boolean #f) + "Trace TH1 execution (for debugging purposes).") + (tls-cert maybe-string + "The certicate file (@file{fullchain.pem}) +with which to enable TLS (HTTPS) encryption.") + (tls-private-key maybe-string "The file storing the TLS private key.")) + +(define (fossil-accounts config) + (match-record config (user group) + (list (user-group (name group) + (system? #t)) + (user-account (name user) + (group group) + (system? #t) + (comment "Fossil server user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin")))))) + +(define (fossil-activation config) + (match-record config (user create? repository) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (let* ((pw (getpwnam #$user)) + (uid (passwd:uid pw)) + (gid (passwd:gid pw))) + (unless #$create? (chown #$repository uid gid))))))) + +(define (fossil-shepherd-service config) + (match-record config + (package user group log-file repository acme? base-url + chroot ckout-alias compress? create? error-log-file ext-root + files from https? ip jail? js-mode local-auth? main-menu + max-latency port redirect-to-https? repo-list? skin + socket-file socket-mode th-trace? tls-cert tls-private-key) + (shepherd-service + (provision '(fossil)) + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list #$(file-append package "/bin/fossil") + "server" + #$@(if acme? '("--acme") '()) + #$@(if (maybe-value-set? base-url) + (list "--baseurl" base-url) + '()) + #$@(if (maybe-value-set? chroot) + (list "--chroot" chroot) + '()) + #$@(if (maybe-value-set? ckout-alias) + (list "--ckout-alias" ckout-alias) + '()) + #$@(if compress? '() '("--nocompress")) + #$@(if create? '("--create") '()) + #$@(if (maybe-value-set? error-log-file) + (list "--errorlog" error-log-file) + '()) + #$@(if (maybe-value-set? ext-root) + (list "--extroot" ext-root) + '()) + #$@(if (maybe-value-set? files) + (list "--files" (string-join files ",")) + '()) + #$@(if (maybe-value-set? from) (list "--from" from) '()) + #$@(if https? '("--https") '()) + #$@(if jail? '() '("--nojail")) + #$@(if (maybe-value-set? js-mode) + (list "--jsmode" (symbol->string js-mode)) + '()) + #$@(if local-auth? '("--localauth") '()) + #$@(if (maybe-value-set? main-menu) + (list "--mainmenu" main-menu) + '()) + #$@(if (maybe-value-set? max-latency) + (list "--max-latency" + (number->string max-latency)) + '()) + #$@(if redirect-to-https? '() '("--nossl")) + #$@(if repo-list? '("--repolist") '()) + #$@(if (maybe-value-set? skin) (list "--skin" skin) '()) + #$@(if (maybe-value-set? socket-file) + (list "--socket-name" socket-file + "--socket-mode" socket-mode + "--socket-owner" + (simple-format #f "~a:~a" user group)) + (list "--port" + (if (maybe-value-set? ip) + (simple-format #f "~a:~a" ip port) + (number->string port)))) + #$@(if th-trace? '("--th-trace") '()) + #$@(if (maybe-value-set? tls-cert) + (list "--cert" tls-cert) + '()) + #$@(if (maybe-value-set? tls-private-key) + (list "--pkey" tls-private-key) + '()) + "--user" #$user + #$repository) + #:user #$user + #:group #$group + #:log-file #$log-file)) + (stop #~(make-kill-destructor)) + (documentation "Run the Fossil SCM's HTTP server.")))) + +(define fossil-service-type + (service-type + (name 'fossil) + (extensions + (list (service-extension account-service-type fossil-accounts) + (service-extension activation-service-type fossil-activation) + (service-extension shepherd-root-service-type + (compose list fossil-shepherd-service)))) + (description "Run the Fossil SCM's HTTP server."))) diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index 8426555a18f..221a389add0 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017-2018, 2020-2022 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Christopher Baines +;;; Copyright © 2025 Nguyễn Gia Phong ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +40,8 @@ #:export (%test-cgit %test-git-http %test-gitolite - %test-gitile)) + %test-gitile + %test-fossil)) (define README-contents "Hello! This is what goes inside the 'README' file.") @@ -519,3 +521,66 @@ HTTP-PORT." (name "gitile") (description "Connect to a running Gitile server.") (value (run-gitile-test)))) + + +;;; +;;; Fossil server. +;;; + +(define %test-fossil + (system-test + (name "fossil") + (description "Connect to a running Fossil server.") + (value + (gexp->derivation (string-append name "-test") + (let* ((port 8080) + (base-url (simple-format #f "http://localhost:~a" port)) + (index-url (string-append base-url "/index")) + (os (marionette-operating-system + (simple-operating-system + (service dhcpcd-service-type) + (service fossil-service-type + (fossil-configuration + (repository "/tmp/test.fossil") + (base-url base-url) + (create? #t) + (port port)))))) + (vm (virtual-machine (operating-system os) + (port-forwardings (list (cons port port)))))) + (with-imported-modules '((gnu build marionette) + (guix build utils)) + #~(begin + (use-modules (gnu build marionette) + (guix build utils) + (srfi srfi-64) + (srfi srfi-71) + (web client) + (web response)) + (define marionette (make-marionette (list #$vm))) + (test-runner-current (system-test-runner #$output)) + (test-begin #$name) + (test-assert "server running" + (wait-for-tcp-port #$port marionette)) + (test-assert "server log file" + (wait-for-file "/var/log/fossil.log" marionette)) + (test-assert "cloning" + (begin + (setenv "HOME" #$output) ; fossil writes to $HOME + (invoke/quiet #$(file-append fossil "/bin/fossil") "clone" + "--admin-user" "alice" + "--httptrace" + "--verbose" + #$base-url + (string-append #$output "/test.fossil")))) + (test-assert "index redirect" + (let ((response text + (http-get #$base-url #:decode-body? #t))) + (and (= 302 (response-code response)) + (string-contains text #$index-url)))) + (test-equal "index page" + 200 (response-code (http-get #$index-url))) + (test-equal "tarball download" + 200 (response-code + (http-get (string-append #$base-url + "/tarball/test.tar.gz")))) + (test-end))))))))