gnu: version-control: Add gitile service.

* gnu/services/version-control.scm (gitile-service-type): New variable.
* doc/guix.texi (Version Control Services): Document it.
* gnu/tests/version-control.scm (%test-gitile): New variable.

doc/guix.texi

@@ -25144,6 +25144,7 @@ of strings and G-expressions.
 @end table
 @end deffn
 
+@anchor{NGINX}
 @subsubheading NGINX
 
 @deffn {Scheme Variable} nginx-service-type
@@ -31544,6 +31545,137 @@ This setting controls the commands and features to enable within Gitolite.
 @end deftp
 
 
+@subsubheading Gitile Service
+
+@cindex Gitile service
+@cindex Git, forge
+@uref{https://git.lepiller.eu/gitile, Gitile} is a Git forge for viewing
+public git repository contents from a web browser.
+
+Gitile works best in collaboration with Gitolite, and will serve the public
+repositories from Gitolite by default.  The service should listen only on
+a local port, and a webserver should be configured to serve static resources.
+The gitile service provides an easy way to extend the Nginx service for
+that purpose (@pxref{NGINX}).
+
+The following example will configure Gitile to serve repositories from a
+custom location, with some default messages for the home page and the
+footers.
+
+@lisp
+(service gitile-service-type
+         (gitile-configuration
+           (repositories "/srv/git")
+           (base-git-url "https://myweb.site/git")
+           (index-title "My git repositories")
+           (intro '((p "This is all my public work!")))
+           (footer '((p "This is the end")))
+           (nginx-server-block
+             (nginx-server-configuration
+               (ssl-certificate
+                 "/etc/letsencrypt/live/myweb.site/fullchain.pem")
+               (ssl-certificate-key
+                 "/etc/letsencrypt/live/myweb.site/privkey.pem")
+               (listen '("443 ssl http2" "[::]:443 ssl http2"))
+               (locations
+                 (list
+                   ;; Allow for https anonymous fetch on /git/ urls.
+                   (git-http-nginx-location-configuration
+                     (git-http-configuration
+                       (uri-path "/git/")
+                       (git-root "/var/lib/gitolite/repositories")))))))))
+@end lisp
+
+In addition to the configuration record, you should configure your git
+repositories to contain some optional information.  First, your public
+repositories need to contain the @file{git-daemon-export-ok} magic file
+that allows Git to export the repository.  Gitile uses the presence of this
+file to detect public repositories it should make accessible.  To do so with
+Gitolite for instance, modify your @file{conf/gitolite.conf} to include
+this in the repositories you want to make public:
+
+@example
+repo foo
+    R = daemon
+@end example
+
+In addition, Gitile can read the repository configuration to display more
+infomation on the repository.  Gitile uses the gitweb namespace for its
+configuration.  As an example, you can use the following in your
+@file{conf/gitolite.conf}:
+
+@example
+repo foo
+    R = daemon
+    desc = A long description, optionally with <i>HTML</i>, shown on the index page
+    config gitweb.name = The Foo Project
+    config gitweb.synopsis = A short description, shown on the main page of the project
+@end example
+
+Do not forget to commit and push these changes once you are satisfied.  You
+may need to change your gitolite configuration to allow the previous
+configuration options to be set.  One way to do that is to add the
+following service definition:
+
+@lisp
+(service gitolite-service-type
+          (gitolite-configuration
+            (admin-pubkey (local-file "key.pub"))
+            (rc-file
+              (gitolite-rc-file
+                (umask #o0027)
+                ;; Allow to set any configuration key
+                (git-config-keys ".*")
+                ;; Allow any text as a valid configuration value
+                (unsafe-patt "^$")))))
+@end lisp
+
+@deftp {Data Type} gitile-configuration
+Data type representing the configuration for @code{gitile-service-type}.
+
+@table @asis
+@item @code{package} (default: @var{gitile})
+Gitile package to use.
+
+@item @code{host} (default: @code{"localhost"})
+The host on which gitile is listening.
+
+@item @code{port} (default: @code{8080})
+The port on which gitile is listening.
+
+@item @code{database} (default: @code{"/var/lib/gitile/gitile-db.sql"})
+The location of the database.
+
+@item @code{repositories} (default: @code{"/var/lib/gitolite/repositories"})
+The location of the repositories.  Note that only public repositories will
+be shown by Gitile.  To make a repository public, add an empty
+@file{git-daemon-export-ok} file at the root of that repository.
+
+@item @code{base-git-url}
+The base git url that will be used to show clone commands.
+
+@item @code{index-title} (default: @code{"Index"})
+The page title for the index page that lists all the available repositories.
+
+@item @code{intro} (default: @code{'()})
+The intro content, as a list of sxml expressions.  This is shown above the list
+of repositories, on the index page.
+
+@item @code{footer} (default: @code{'()})
+The footer content, as a list of sxml expressions.  This is shown on every
+page served by Gitile.
+
+@item @code{nginx-server-block}
+An nginx server block that will be extended and used as a reverse proxy by
+Gitile to serve its pages, and as a normal web server to serve its assets.
+
+You can use this block to add more custom URLs to your domain, such as a
+@code{/git/} URL for anonymous clones, or serving any other files you would
+like to serve.
+@end table
+@end deftp
+
+
 @node Game Services
 @subsection Game Services
 

gnu/services/version-control.scm

@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -59,7 +60,21 @@
             gitolite-rc-file-roles
             gitolite-rc-file-enable
 
-            gitolite-service-type))
+            gitolite-service-type
+
+            gitile-configuration
+            gitile-configuration-package
+            gitile-configuration-host
+            gitile-configuration-port
+            gitile-configuration-database
+            gitile-configuration-repositories
+            gitile-configuration-git-base-url
+            gitile-configuration-index-title
+            gitile-configuration-intro
+            gitile-configuration-footer
+            gitile-configuration-nginx
+
+            gitile-service-type))
 
 ;;; Commentary:
 ;;;
@@ -386,3 +401,114 @@ access to exported repositories under @file{/srv/git}."
 By default, the @code{git} user is used, but this is configurable.
 Additionally, Gitolite can integrate with with tools like gitweb or cgit to
 provide a web interface to view selected repositories.")))
+
+;;;
+;;; Gitile
+;;;
+
+(define-record-type* <gitile-configuration>
+  gitile-configuration make-gitile-configuration gitile-configuration?
+  (package gitile-configuration-package
+           (default gitile))
+  (host gitile-configuration-host
+        (default "127.0.0.1"))
+  (port gitile-configuration-port
+        (default 8080))
+  (database gitile-configuration-database
+            (default "/var/lib/gitile/gitile-db.sql"))
+  (repositories gitile-configuration-repositories
+                (default "/var/lib/gitolite/repositories"))
+  (base-git-url gitile-configuration-base-git-url)
+  (index-title gitile-configuration-index-title
+               (default "Index"))
+  (intro gitile-configuration-intro
+         (default '()))
+  (footer gitile-configuration-footer
+          (default '()))
+  (nginx gitile-configuration-nginx))
+
+(define (gitile-config-file host port database repositories base-git-url
+                            index-title intro footer)
+  (define build
+    #~(write `(config
+                (port #$port)
+                (host #$host)
+                (database #$database)
+                (repositories #$repositories)
+                (base-git-url #$base-git-url)
+                (index-title #$index-title)
+                (intro #$intro)
+                (footer #$footer))
+             (open-output-file #$output)))
+
+  (computed-file "gitile.conf" build))
+
+(define gitile-nginx-server-block
+  (match-lambda
+    (($ <gitile-configuration> package host port database repositories
+        base-git-url index-title intro footer nginx)
+     (list (nginx-server-configuration
+             (inherit nginx)
+             (locations
+               (append
+                 (list
+                   (nginx-location-configuration
+                            (uri "/")
+                            (body
+                              (list
+                                #~(string-append "proxy_pass http://" #$host
+                                                 ":" (number->string #$port)
+                                                 "/;")))))
+                 (map
+                   (lambda (loc)
+                     (nginx-location-configuration
+                       (uri loc)
+                       (body
+                         (list
+                           #~(string-append "root " #$package "/share/gitile/assets;")))))
+                   '("/css" "/js" "/images"))
+                 (nginx-server-configuration-locations nginx))))))))
+
+(define gitile-shepherd-service
+  (match-lambda
+    (($ <gitile-configuration> package host port database repositories
+        base-git-url index-title intro footer nginx)
+     (list (shepherd-service
+             (provision '(gitile))
+             (requirement '(loopback))
+             (documentation "gitile")
+             (start (let ((gitile (file-append package "/bin/gitile")))
+                          #~(make-forkexec-constructor
+                              `(,#$gitile "-c" #$(gitile-config-file
+                                                   host port database
+                                                   repositories
+                                                   base-git-url index-title
+                                                   intro footer))
+                              #:user "gitile"
+                              #:group "git")))
+             (stop #~(make-kill-destructor)))))))
+
+(define %gitile-accounts
+  (list (user-group
+         (name "git")
+         (system? #t))
+        (user-account
+          (name "gitile")
+          (group "git")
+          (system? #t)
+          (comment "Gitile user")
+          (home-directory "/var/empty")
+          (shell (file-append shadow "/sbin/nologin")))))
+
+(define gitile-service-type
+  (service-type
+    (name 'gitile)
+    (description "Run Gitile, a small Git forge.  Expose public repositories
+on the web.")
+    (extensions
+      (list (service-extension account-service-type
+                               (const %gitile-accounts))
+            (service-extension shepherd-root-service-type
+                               gitile-shepherd-service)
+            (service-extension nginx-service-type
+                               gitile-nginx-server-block)))))

gnu/tests/version-control.scm

@@ -38,7 +38,8 @@
   #:use-module (guix modules)
   #:export (%test-cgit
             %test-git-http
-            %test-gitolite))
+            %test-gitolite
+            %test-gitile))
 
 (define README-contents
   "Hello!  This is what goes inside the 'README' file.")
@@ -63,7 +64,10 @@
             (invoke git "commit" "-m" "That's a commit."))
 
           (mkdir-p "/srv/git")
-          (rename-file "/tmp/test-repo/.git" "/srv/git/test")))))
+          (rename-file "/tmp/test-repo/.git" "/srv/git/test")
+          (with-output-to-file "/srv/git/test/git-daemon-export-ok"
+            (lambda _
+              (display "")))))))
 
 (define %test-repository-service
   ;; Service that creates /srv/git/test.
@@ -416,3 +420,133 @@ HTTP-PORT."
    (name "gitolite")
    (description "Clone the Gitolite admin repository.")
    (value (run-gitolite-test))))
+
+;;;
+;;; Gitile.
+;;;
+
+(define %gitile-configuration-nginx
+  (nginx-server-configuration
+   (root "/does/not/exists")
+   (try-files (list "$uri" "=404"))
+   (listen '("19418"))
+   (ssl-certificate #f)
+   (ssl-certificate-key #f)))
+
+(define %gitile-os
+  ;; Operating system under test.
+  (simple-operating-system
+   (service dhcp-client-service-type)
+   (simple-service 'srv-git activation-service-type
+                   #~(mkdir-p "/srv/git"))
+   (service gitile-service-type
+            (gitile-configuration
+             (base-git-url "http://localhost")
+             (repositories "/srv/git")
+             (nginx %gitile-configuration-nginx)))
+   %test-repository-service))
+
+(define* (run-gitile-test #:optional (http-port 19418))
+  "Run tests in %GITOLITE-OS, which has nginx running and listening on
+HTTP-PORT."
+  (define os
+    (marionette-operating-system
+     %gitile-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((8081 . ,http-port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette)
+                       (web uri)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "gitile")
+
+          ;; XXX: Shepherd reads the config file *before* binding its control
+          ;; socket, so /var/run/shepherd/socket might not exist yet when the
+          ;; 'marionette' service is started.
+          (test-assert "shepherd socket ready"
+            (marionette-eval
+             `(begin
+                (use-modules (gnu services herd))
+                (let loop ((i 10))
+                  (cond ((file-exists? (%shepherd-socket-file))
+                         #t)
+                        ((> i 0)
+                         (sleep 1)
+                         (loop (- i 1)))
+                        (else
+                         'failure))))
+             marionette))
+
+          ;; Wait for nginx to be up and running.
+          (test-assert "nginx running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'nginx))
+             marionette))
+
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/nginx/pid")
+             marionette))
+
+          ;; Make sure Git test repository is created.
+          (test-assert "Git test repository"
+            (marionette-eval
+             '(file-exists? "/srv/git/test")
+             marionette))
+
+          (sleep 2)
+
+          ;; Make sure we can access pages that correspond to our repository.
+          (letrec-syntax ((test-url
+                           (syntax-rules ()
+                             ((_ path code)
+                              (test-equal (string-append "GET " path)
+                                code
+                                (let-values (((response body)
+                                              (http-get (string-append
+                                                         "http://localhost:8081"
+                                                         path))))
+                                  (response-code response))))
+                             ((_ path)
+                              (test-url path 200)))))
+            (test-url "/")
+            (test-url "/css/gitile.css")
+            (test-url "/test")
+            (test-url "/test/commits")
+            (test-url "/test/tree" 404)
+            (test-url "/test/tree/-")
+            (test-url "/test/tree/-/README")
+            (test-url "/test/does-not-exist" 404)
+            (test-url "/test/tree/-/does-not-exist" 404)
+            (test-url "/does-not-exist" 404))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "gitile-test" test))
+
+(define %test-gitile
+  (system-test
+   (name "gitile")
+   (description "Connect to a running Gitile server.")
+   (value (run-gitile-test))))