guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 3433fb987bbc826a585a0d4d0a80e1f5369769a3
Author: Nguyễn Gia Phong <[email protected]>
AuthorDate: Mon Nov 17 15:46:53 2025 +0900
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
Signed-off-by: Ludovic Courtès <[email protected]>
---
doc/guix.texi | 150 +++++++++++++++++++++++
gnu/services/version-control.scm | 257 ++++++++++++++++++++++++++++++++++++++-
gnu/tests/version-control.scm | 75 +++++++++++-
3 files changed, 480 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9924f4771f..8841a483a8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -149,6 +149,7 @@ Copyright @copyright{} 2025 Rodion Goritskov@*
Copyright @copyright{} 2025 dan@*
Copyright @copyright{} 2025 Noé Lopez@*
Copyright @copyright{} 2026 David Elsing@*
+Copyright @copyright{} 2026 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
@@ -43773,6 +43774,155 @@ 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 @var{name} for @code{/doc/@var{name}/...} to be treated as
+@code{/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-authentication?} (default: @code{#f}) (type: boolean)
+Enable automatic login for requests from localhost.
+
+@item @code{localhost?} (default: @code{#f}) (type: boolean)
+Listen on @code{127.0.0.1} only.
+
+@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{list-repositories?} (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{scgi?} (default: @code{#f}) (type: boolean)
+Accept SCGI rather than HTTP.
+
+@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-certificate} (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 a7f40812a6..dba38faa46 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2021 Julien Lepiller <[email protected]>
;;; Copyright © 2025 Tomas Volf <[email protected]>
;;; Copyright © 2025 Evgeny Pisemsky <[email protected]>
+;;; Copyright © 2026 Nguyễn Gia Phong <[email protected]>
;;;
;;; 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,44 @@
gitile-configuration-footer
gitile-configuration-nginx
- gitile-service-type))
+ gitile-service-type
+
+ fossil-configuration
+ fossil-configuration-fields
+ 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-authentication?
+ fossil-configuration-main-menu
+ fossil-configuration-max-latency
+ fossil-configuration-port
+ fossil-configuration-list-repositories?
+ fossil-configuration-redirect-to-https?
+ fossil-configuration-skin
+ fossil-configuration-socket-file
+ fossil-configuration-socket-mode
+ fossil-configuration-th-trace?
+ fossil-configuration-tls-certificate
+ fossil-configuration-tls-private-key
+
+ fossil-service-type))
;;; Commentary:
;;;
@@ -603,3 +643,218 @@ 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 @var{name} for @code{/doc/@var{name}/...}
+to be treated as @code{/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-authentication? (boolean #f)
+ "Enable automatic login for requests from localhost.")
+ (localhost? (boolean #f) "Listen on @code{127.0.0.1} only.")
+ (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.")
+ (list-repositories? (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}.")
+ (scgi? (boolean #f) "Accept SCGI rather than HTTP.")
+ (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-certificate 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 <fossil-configuration> (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 <fossil-configuration> (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 <fossil-configuration>
+ (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 list-repositories?
+ local-authentication? localhost? main-menu max-latency port
+ redirect-to-https? scgi? skin socket-file socket-mode
+ th-trace? tls-certificate 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-authentication? '("--localauth") '())
+ #$@(if localhost? '("--localhost") '())
+ #$@(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 scgi? '("--scgi") '())
+ #$@(if list-repositories? '("--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-certificate)
+ (list "--cert" tls-certificate)
+ '())
+ #$@(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 HTTP server
+for the Fossil software configuration management system."))))
+
+(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 HTTP server for the Fossil software configuration management
+system. In addition to distributed version control, Fossil also supports
+bug tracking, wiki, forum, email alerts, chat, and technotes.")))
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index 8426555a18..9df3aa9dbd 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 <[email protected]>
;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]>
;;; Copyright © 2018 Christopher Baines <[email protected]>
+;;; Copyright © 2026 Nguyễn Gia Phong <[email protected]>
;;;
;;; 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,74 @@ 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))))))))
