bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: Add fossil-service-type.

Browse source 
* 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
This commit is contained in:
Nguyễn Gia Phong 2025-11-17 15:46:53 +09:00 • committed by Nguyễn Gia Phong
parent 19fc23fd89
commit 93ef009a91
No known key found for this signature in database
GPG key ID: 84B69CE6F3F6B767
3 changed files with 453 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

143
doc/guix.texi
View file

@ -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

245
gnu/services/version-control.scm
View file

@ -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 © 2025 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,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 <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 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.")))

67
gnu/tests/version-control.scm
View file

@ -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 © 2025 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,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))))))))