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 <ludo@gnu.org>

3 files changed, 480 insertions, 2 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 9924f4771f2..8841a483a8d 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 a7f40812a6c..dba38faa460 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2025 Tomas Volf <~@wolfsden.cz>
 ;;; Copyright © 2025 Evgeny Pisemsky <mail@pisemsky.site>
+;;; Copyright © 2026 Nguyễn Gia Phong <cnx@loang.net>
 ;;;
 ;;; 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 8426555a18f..9df3aa9dbd4 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 <ludo@gnu.org>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2026 Nguyễn Gia Phong <cnx@loang.net>
 ;;;
 ;;; 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))))))))