mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-26 04:00:30 +02:00
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>
This commit is contained in:
Nguyễn Gia Phong
committed by
Ludovic Courtès
Ludovic Courtès
parent
6eb6971f4d
commit
3433fb987b
150
doc/guix.texi
150
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
|
||||
|
||||
@@ -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.")))
|
||||
|
||||
@@ -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))))))))
|
||||
|
||||
Reference in New Issue
Block a user