[bug#49886] [PATCH] Add gitile and gitile service

[Julien Lepiller <julien@lepiller.eu>]

[-- Attachment #1: Type: text/plain, Size: 196 bytes --]

Hi guix!

Attached is a small patch series that adds gitile and the associated
service type. Gitile is a small git forge project I have, and some of
you expressed their interest, so here it is :)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gnu-Add-gitile.patch --]
[-- Type: text/x-patch, Size: 6749 bytes --]

From 38773e575b313caedfc788d4e28fd219265b4254 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 5 Aug 2021 02:57:32 +0200
Subject: [PATCH 1/2] gnu: Add gitile.

* gnu/packages/version-control.scm (gitile): New variable.
---
 gnu/packages/version-control.scm | 109 +++++++++++++++++++++++++++++++
 1 file changed, 109 insertions(+)

diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index ac61b97f59..29dc86be8c 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -39,6 +39,7 @@
 ;;; Copyright © 2021 LibreMiami <packaging-guix@libremiami.org>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 François J. <francois-oss@avalenn.eu>
+;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -93,6 +94,7 @@
   #:use-module (gnu packages golang)
   #:use-module (gnu packages groff)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages image)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mail)
@@ -114,6 +116,7 @@
   #:use-module (gnu packages readline)
   #:use-module (gnu packages rsync)
   #:use-module (gnu packages sqlite)
+  #:use-module (gnu packages texinfo)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages xml)
   #:use-module (gnu packages emacs)
@@ -1517,6 +1520,112 @@ also walk each side of a merge and test those changes individually.")
 control to Git repositories.")
     (license license:gpl2)))
 
+;; gitile requires a more recent version than the latest release.
+(define guile-syntax-highlight-for-gitile
+  (let ((commit "51727cbb7fc05ef743aab2d7b16314ea1ed790e4")
+        (revision "0"))
+    (package
+      (inherit guile-syntax-highlight)
+      (version (git-version "0.1" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                       (url "https://git.dthompson.us/guile-syntax-highlight.git")
+                       (commit commit)))
+                (file-name (git-file-name "guile-syntax-highlight" version))
+                (sha256
+                 (base32
+                  "1cvacy4y5qxajygb1qg8hvhjdf2xnnwnm5j918cabsi8wfwchig7"))))
+      (native-inputs
+       `(("autoconf" ,autoconf)
+         ("automake" ,automake)
+         ("texinfo" ,texinfo)
+         ,@(package-native-inputs guile-syntax-highlight))))))
+
+(define-public gitile
+  (package
+    (name "gitile")
+    (version "0.1")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+              (url "https://git.lepiller.eu/git/gitile")
+              (commit version)))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "1ciwvqlc0nnzcxx3wjdsrm8i1h9965clv56nzcw7yyhml8ds42dk"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:modules ((guix build utils)
+                  (guix build gnu-build-system)
+                  (ice-9 rdelim)
+                  (ice-9 popen))
+       #:make-flags (list "GUILE_AUTO_COMPILE=0")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'install-assets
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((assets (string-append (assoc-ref outputs "out")
+                                          "/share/gitile/assets")))
+               (mkdir-p assets)
+               (copy-recursively "assets" assets))))
+         (add-after 'install 'install-bin
+           (lambda* (#:key outputs #:allow-other-keys)
+             (install-file "scripts/gitile"
+                           (string-append (assoc-ref outputs "out")
+                                          "/bin"))))
+         (add-after 'install-bin 'wrap-program
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             ;; Wrap the 'cuirass' command to refer to the right modules.
+             (let* ((out    (assoc-ref outputs "out"))
+                    (commonmark (assoc-ref inputs "guile-commonmark"))
+                    (git    (assoc-ref inputs "guile-git"))
+                    (bytes  (assoc-ref inputs "guile-bytestructures"))
+                    (fibers (assoc-ref inputs "guile-fibers"))
+                    (gcrypt (assoc-ref inputs "guile-gcrypt"))
+                    (syntax-highlight (assoc-ref inputs "guile-syntax-highlight"))
+                    (deps   (list out commonmark git bytes fibers gcrypt
+                                  syntax-highlight))
+                    (guile  (assoc-ref %build-inputs "guile"))
+                    (effective (read-line
+                                (open-pipe* OPEN_READ
+                                            (string-append guile "/bin/guile")
+                                            "-c" "(display (effective-version))")))
+                    (mods   (string-drop-right  ;drop trailing colon
+                             (string-join deps
+                                          (string-append "/share/guile/site/"
+                                                         effective ":")
+                                          'suffix)
+                             1))
+                    (objs   (string-drop-right
+                             (string-join deps
+                                          (string-append "/lib/guile/" effective
+                                                         "/site-ccache:")
+                                          'suffix)
+                             1)))
+               (wrap-program (string-append out "/bin/gitile")
+                 `("GUILE_LOAD_PATH" ":" prefix (,mods))
+                 `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,objs)))))))))
+    (native-inputs
+     `(("autoconf" ,autoconf)
+       ("automake" ,automake)
+       ("guile" ,guile-3.0)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("guile" ,guile-3.0)
+       ("guile-commonmark" ,guile-commonmark)
+       ("guile-fibers" ,guile-fibers)
+       ("guile-gcrypt" ,guile-gcrypt)
+       ("guile-git" ,guile-git)
+       ("guile-syntax-highlight" ,guile-syntax-highlight)
+       ("gnutls" ,gnutls)))
+    (home-page "https://git.lepiller.eu/gitile")
+    (synopsis "Simple git forge written in Guile")
+    (description "Gitile is a git forge written in Guile that lets you
+visualize your public Git repositories on a web interface.")
+    (license license:agpl3+)))
+
 (define-public pre-commit
   (package
     (name "pre-commit")
-- 
2.32.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-gnu-version-control-Add-gitile-service.patch --]
[-- Type: text/x-patch, Size: 9779 bytes --]

From 3cd7ef0ae922d77ff5d29c831dbdf8d350210fb7 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 5 Aug 2021 03:46:40 +0200
Subject: [PATCH 2/2] gnu: version-control: Add gitile service.

* gnu/services/version-control.scm (gitile-service-type): New variable.
* doc/guix.texi (Version Control Services): Document it.
---
 doc/guix.texi                    |  79 ++++++++++++++++++++
 gnu/services/version-control.scm | 124 ++++++++++++++++++++++++++++++-
 2 files changed, 202 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a826171f34..e5e989c223 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -31440,6 +31440,85 @@ 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 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
+                   (git-http-nginx-location-configuration
+                     (git-http-configuration
+                       (uri-path "/git/")
+                       (git-root "/var/lib/gitolite/repositories")))))))))
+@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.
+@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 8cb5633165..f28206b239 100644
--- a/gnu/services/version-control.scm
+++ b/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.
 ;;;
@@ -58,7 +59,22 @@
             gitolite-rc-file-roles
             gitolite-rc-file-enable
 
-            gitolite-service-type))
+            gitolite-service-type
+
+            <gitile-configuration>
+            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-server-block
+
+            gitile-service-type))
 
 ;;; Commentary:
 ;;;
@@ -380,3 +396,109 @@ 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 "localhost"))
+  (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-server-block nginx-configuration-nginx-server-block))
+
+(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-server-block)
+     (list (nginx-server-configuration
+             (inherit nginx-server-block)
+             (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-server-block))))))))
+
+(define gitile-shepherd-service
+  (match-lambda
+    (($ <gitile-configuration> package host port database repositories
+        base-git-url index-title intro footer nginx-server-block)
+     (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-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)
+    (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)))))
-- 
2.32.0