[bug#28283] Status: [PATCH 1/1] gnu: services: version-control: Add cgit.

[Oleg Pykhalov <go.wigust@gmail.com>]

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

Hello Ludovic,

ludo@gnu.org (Ludovic Courtès) writes:

> Oleg Pykhalov <go.wigust@gmail.com> skribis:
>
>> Then I added new field to record:
>>
>> (define-record-type* <nginx-server-configuration>
>>   …
>>   (try-files           nginx-server-configuration-try-files
>>                        (default '())))
>>
>>
>> Testing:
>>
>> natsu@magnolia ~/src/guix-devel-nginx-test$ guix environment guix -- make check-system TESTS=nginx
>> ;;; note: source file /home/natsu/src/guix-wigust/wigust/packages/emacs.scm
>> ;;;       newer than compiled /home/natsu/.cache/guile/ccache/2.2-LE-8-3.A/home/natsu/src/guix-wigust/wigust/packages/emacs.scm.go
>> Compiling Scheme modules...
>>   LOAD     (gnu services web)
>> ;;; note: source file ./gnu/services/web.scm
>> ;;;       newer than compiled /home/natsu/src/guix-devel-nginx-test/gnu/services/web.go
>>   GUILEC   gnu/services/web.go
>> warning: failed to load '(gnu tests web)':
>> ERROR: In procedure allocate-struct: Wrong type argument in position 2: 9
>> Running 0 system tests...
>
> It’s also a case where the ABI breaks, and thus dependent modules need
> to be recompiled: “rm gnu/tests/web.go && make”.
>
> Does that make sense?

It does make, but doesn't work for me.  Probably there were other *.go
files which needed to delete.  So, I made ‘make clean-go’ and ‘make’.
It was overkill of course.

‘try-files’ are in ‘<nginx-server-configuration>’ in origin/master now,
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=4d14808af4c01b4fb0a4564584aa68f0e53c4ef4

> Minor issues:
>
>> +@subsubheading cgit service
>
> Please capitalize titles: “Cgit Service”

Done.

>> +@uref{https://git.zx2c4.com/cgit/, cgit} is a hyperfast web
>> +frontend for git repositories written in C.
>
> “Git”, not “git”.  

Done.

> Also, not hypersuperlatives please.  :-)

Done.

> So what about this:
>
>   @uref{https://git.zx2c4.com/cgit/, cgit} is a Web interface to Git
>   repositories, written in C.  It allows users to look at Git
>   repository contents and history through their Web browsers.
>
>> +The following example will configure the service with default values.
>> +By default, cgit can be accessed on port 80 (@code{http://localhost:80}).
>> +
>> +@example
>> +(service nginx-service-type)
>> +(service fcgiwrap-service-type)
>> +(service cgit-service-type)
>> +@end example
>
> Please add a sentence above or below the example like “This example
> shows …”.

Sorry, I don't understand what do you mean.  There is a sentence above
example that answers a question “What does example do?” and I guess
“What does example show?”.

>> +@table @asis
>> +@item @code{css} (default: @code{"/share/cgit/cgit.css"})
>> +Url which specifies the css document to include in all cgit pages.
>> +
>> +@item @code{logo} (default: @code{"/share/cgit/cgit.png"})
>> +Url which specifies the source of an image which will be used as a logo
>> +on all cgit pages.
>> +
>> +@item @code{virtual-root} (default: @code{"/"})
>> +Url which, if specified, will be used as root for all cgit links.
>
> s/Url/URL/

Done.

>> +@item @code{scan-path} (default: @code{"/srv/git"})
>> +A path which will be scanned for repositories.
>
> Rather: “Name of the directory to scan for repositories.”

Done.

> Can you also rename ‘scan-path’ to ‘repository-directory’ or something
> like that?  (Not “path.”)

Done.

>> +@item @code{robots} (default: @code{(list "noindex" "nofollow")})
>> +Text used as content for the "robots" meta-tag.
>
> Write ``robots'' (literally) so that Texinfo typesets things correctly.

Done.

>> --- a/gnu/services/web.scm
>> +++ b/gnu/services/web.scm
>> @@ -99,6 +99,8 @@
>>                         (default '()))
>>    (index               nginx-server-configuration-index
>>                         (default (list "index.html")))
>> +  (try-files           nginx-server-configuration-try-files
>> +                       (default #f))
>>    (ssl-certificate     nginx-server-configuration-ssl-certificate
>>                         (default "/etc/nginx/cert.pem"))
>>    (ssl-certificate-key nginx-server-configuration-ssl-certificate-key
>> @@ -179,6 +181,7 @@ of index files."
>>           (nginx-server-configuration-ssl-certificate-key server))
>>          (root (nginx-server-configuration-root server))
>>          (index (nginx-server-configuration-index server))
>> +        (try-files (nginx-server-configuration-try-files server))
>>          (server-tokens? (nginx-server-configuration-server-tokens? server))
>>          (locations (nginx-server-configuration-locations server)))
>>      (define-syntax-parameter <> (syntax-rules ()))
>> @@ -207,6 +210,7 @@ of index files."
>>       (and/l ssl-certificate-key "      ssl_certificate_key " <> ";\n")
>>       "      root " root ";\n"
>>       "      index " (config-index-strings index) ";\n"
>> +     "      try_files " (config-index-strings try-files) ";\n"
>>       "      server_tokens " (if server-tokens? "on" "off") ";\n"
>>       "\n"
>>       (map emit-nginx-location-config locations)
>
> Could you submit these nginx changes separately for discussion?  We’ll
> also need to document them.  Maybe Cc Chris Baines and other nginx
> people.

Done with Julien Lepiller.

Attached a new patch.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnu/services/version-control.scm --]
[-- Type: text/x-patch, Size: 7638 bytes --]

From 64b328c90fbaedca4b081fb33af6e3dbae27eeb6 Mon Sep 17 00:00:00 2001
From: Oleg Pykhalov <go.wigust@gmail.com>
Date: Thu, 28 Sep 2017 20:02:35 +0300
Subject: [PATCH] gnu: services: version-control: Add cgit.

* gnu/services/version-control.scm
(<cgit-configuration-file>, <cgit-configuration>): New record types.
(cgit-configuration-robots-string, cgit-activation,
cgit-configuration-nginx-config): New procedures.
(%cgit-configuration-nginx, cgit-service-type): New variables.
* doc/guix.texi (Version Control): Document the cgit service.
---
 doc/guix.texi                    |  63 ++++++++++++++++++++++
 gnu/services/version-control.scm | 109 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 171 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1b329d255..4bdbe4b70 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17000,6 +17000,69 @@ Extra options will be passed to @code{git daemon}, please run
 @end table
 @end deftp
 
+@subsubheading Cgit service
+
+@uref{https://git.zx2c4.com/cgit/, Cgit} is a web frontend for Git
+repositories written in C.
+
+The following example will configure the service with default values.
+By default, Cgit can be accessed on port 80 (@code{http://localhost:80}).
+
+@example
+(service nginx-service-type)
+(service fcgiwrap-service-type)
+(service cgit-service-type)
+@end example
+
+@deftp {Data Type} cgit-configuration
+Data type representing the configuration of Cgit.
+This type has the following parameters:
+
+@table @asis
+@item @code{config-file} (default: @code{(cgit-configuration-file)})
+The configuration file to use for Cgit.  This can be set to a
+@dfn{cgit-configuration-file} record value, or any gexp
+(@pxref{G-Expressions}).
+
+For example, to instead use a local file, the @code{local-file} function
+can be used:
+
+@example
+(service cgit-service-type
+         (cgit-configuration
+           (config-file (local-file "./my-cgitrc.conf"))))
+@end example
+
+@item @code{package} (default: @code{cgit})
+The Cgit package to use.
+
+@end table
+@end deftp
+
+@deftp {Data Type} cgit-configuration-file
+Data type representing the configuration options for Cgit.
+This type has the following parameters:
+
+@table @asis
+@item @code{css} (default: @code{"/share/cgit/cgit.css"})
+URL which specifies the css document to include in all Cgit pages.
+
+@item @code{logo} (default: @code{"/share/cgit/cgit.png"})
+URL which specifies the source of an image which will be used as a logo
+on all Cgit pages.
+
+@item @code{virtual-root} (default: @code{"/"})
+URL which, if specified, will be used as root for all Cgit links.
+
+@item @code{repository-directory} (default: @code{"/srv/git"})
+Name of the directory to scan for repositories.
+
+@item @code{robots} (default: @code{(list "noindex" "nofollow")})
+Text used as content for the ``robots'' meta-tag.
+
+@end table
+@end deftp
+
 @node Setuid Programs
 @subsection Setuid Programs
 
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 107bc8e77..50b09c0ce 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -21,18 +21,40 @@
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #: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 records)
   #:use-module (guix gexp)
+  #:use-module (guix store)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (git-daemon-service
             git-daemon-service-type
             git-daemon-configuration
-            git-daemon-configuration?))
+            git-daemon-configuration?
+
+            <cgit-configuration-file>
+            cgit-configuration-file
+            cgit-configuration-file?
+            cgit-configuration-file-css
+            cgit-configuration-file-logo
+            cgit-configuration-file-robots
+            cgit-configuration-file-virtual-root
+            cgit-configuration-file-scan-path
+
+            <cgit-configuration>
+            cgit-configuration
+            cgit-configuration?
+            cgit-configuration-config-file
+            cgit-configuration-package
+
+            %cgit-configuration-nginx
+            cgit-configuration-nginx-config
+
+            cgit-service-type))
 
 ;;; Commentary:
 ;;;
@@ -139,3 +161,88 @@ The optional @var{config} argument should be a
 @code{<git-daemon-configuration>} object, by default it allows read-only
 access to exported repositories under @file{/srv/git}."
   (service git-daemon-service-type config))
+
+\f
+;;;
+;;; Cgit
+;;;
+
+(define-record-type* <cgit-configuration-file>
+  cgit-configuration-file make-cgit-configuration-file
+  cgit-configuration-file?
+  (css cgit-configuration-file-css
+       (default "/share/cgit/cgit.css"))
+  (logo cgit-configuration-file-logo
+        (default "/share/cgit/cgit.png"))
+  (robots cgit-configuration-file-robots
+          (default '("noindex" "nofollow")))
+  (virtual-root cgit-configuration-file-virtual-root
+                (default "/"))
+  (repository-directory cgit-configuration-file-repository-directory
+                        (default "/srv/git")))
+
+(define (cgit-configuration-robots-string robots)
+  (string-join robots ", "))
+
+(define-gexp-compiler (cgit-configuration-file-compiler
+                       (file <cgit-configuration-file>) system target)
+  (match file
+    (($ <cgit-configuration-file> css logo
+                                  robots virtual-root repository-directory)
+     (text-file
+      "cgitrc"
+      (string-concatenate
+       (filter-map
+        (match-lambda
+          ((key . #f) #f)
+          ((key . value) (string-append key "=" value "\n")))
+        `(("css" . ,css)
+          ("logo" . ,logo)
+          ("robots" . ,(cgit-configuration-robots-string robots))
+          ("virtual-root" . ,virtual-root)
+          ("repository-directory" . ,repository-directory))))))))
+
+(define %cgit-configuration-nginx
+  (list
+   (nginx-server-configuration
+    (root cgit)
+    (locations
+     (list
+      (nginx-location-configuration
+       (uri "@cgit")
+       (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
+               "fastcgi_param PATH_INFO $uri;"
+               "fastcgi_param QUERY_STRING $args;"
+               "fastcgi_param HTTP_HOST $server_name;"
+               "fastcgi_pass 127.0.0.1:9000;")))))
+    (try-files (list "$uri" "@cgit"))
+    (https-port #f)
+    (ssl-certificate #f)
+    (ssl-certificate-key #f))))
+
+(define-record-type* <cgit-configuration>
+  cgit-configuration make-cgit-configuration
+  cgit-configuration?
+  (config-file cgit-configuration-config-file
+               (default (cgit-configuration-file)))
+  (package cgit-configuration-package
+           (default cgit))
+  (nginx cgit-configuration-nginx
+         (default %cgit-configuration-nginx)))
+
+(define (cgit-activation config)
+  ;; Cgit compiled with default configuration path
+  #~(copy-file #$(cgit-configuration-config-file config) "/etc/cgitrc"))
+
+(define (cgit-configuration-nginx-config config)
+  (cgit-configuration-nginx config))
+
+(define cgit-service-type
+  (service-type
+   (name 'cgit)
+   (extensions
+    (list (service-extension activation-service-type
+                             cgit-activation)
+          (service-extension nginx-service-type
+                             cgit-configuration-nginx-config)))
+   (default-value (cgit-configuration))))
-- 
2.14.1


[-- Attachment #3: Type: text/plain, Size: 142 bytes --]


I also wrote a test, but I don't understand why Cgit cannot find
test repository.

;;; (response (404 "…No repositories found…"))


[-- Attachment #4: gnu/tests/version-control.scm --]
[-- Type: text/plain, Size: 5556 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests version-control)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services version-control)
  #:use-module (gnu services web)
  #:use-module (gnu services networking)
  #:use-module (gnu packages version-control)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:export (%test-cgit))

(define %make-git-repository
  ;; Create Git repository in /srv/git/test.
  #~(begin
      (mkdir-p "/srv/git/test")
      (system* (string-append #$git "/bin/git") "-C" "/srv/git/test" "init")))

(define %cgit-configuration-nginx
  (list
   (nginx-server-configuration
    (root cgit)
    (locations
     (list
      (nginx-location-configuration
       (uri "@cgit")
       (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
               "fastcgi_param PATH_INFO $uri;"
               "fastcgi_param QUERY_STRING $args;"
               "fastcgi_param HTTP_HOST $server_name;"
               "fastcgi_pass 127.0.0.1:9000;")))))
    (try-files (list "$uri" "@cgit"))
    (http-port 19418)
    (https-port #f)
    (ssl-certificate #f)
    (ssl-certificate-key #f))))

(define %cgit-os
  ;; Operating system under test.
  (let ((base-os
         (simple-operating-system
          (dhcp-client-service)
          (service nginx-service-type)
          (service fcgiwrap-service-type)
          (service cgit-service-type
                   (cgit-configuration
                    (nginx %cgit-configuration-nginx)))
          (simple-service 'make-git-repository activation-service-type
                          %make-git-repository))))
    (operating-system
      (inherit base-os)
      (packages (cons* git
                       (operating-system-packages base-os))))))

(define* (run-cgit-test #:optional (http-port 19418))
  "Run tests in %CGIT-OS, which has nginx running and listening on
HTTP-PORT."
  (define os
    (marionette-operating-system
     %cgit-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings `((8080 . ,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 "cgit")

          ;; Wait for nginx to be up and running.
          (test-eq "service running"
            'running!
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'nginx)
                'running!)
             marionette))

          ;; Wait for fcgiwrap to be up and running.
          (test-eq "service running"
            'running!
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'fcgiwrap)
                'running!)
             marionette))

          ;; Make sure the PID file is created.
          (test-assert "PID file"
            (marionette-eval
             '(file-exists? "/var/run/nginx/pid")
             marionette))

          ;; Make sure the configuration file is created.
          (test-assert "Configuration file"
            (marionette-eval
             '(file-exists? "/etc/cgitrc")
             marionette))

          ;; Make sure Git test repository is created.
          (test-assert "Git test repository"
            (marionette-eval
             '(file-exists? "/srv/git/test/.git")
             marionette))

          ;; Retrieve the index.html file we put in /srv.
          (test-equal "http-get"
            '(200)
            (let-values (((response text)
                          (http-get "http://localhost:8080"
                                    #:decode-body? #t)))
              ;; TODO Leave only response-code.
              (pk 'response (list (response-code response) text))))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "cgit-test" test))

(define %test-cgit
  (system-test
   (name "cgit")
   (description "Connect to a running CGIT server.")
   (value (run-cgit-test))))

[-- Attachment #5: Type: text/plain, Size: 1236 bytes --]


I wish to make a VM with ‘guix system vm gnu/tests/version-control.scm’,
but it's not working.  It also doesn't work for ‘gnu/tests/web.scm’ and
‘gnu/tests/rsync.scm’.  But I sure it worked with ‘gnu/tests/rsync.scm’.

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix system vm gnu/tests/web.scm
Backtrace:
           5 (primitive-load "/gnu/store/zh0lb2g15hirq7zw2477w7s5ww7dxkv0-guix-0.…")
In guix/ui.scm:
  1375:12  4 (run-guix-command _ . _)
In ice-9/boot-9.scm:
    837:9  3 (catch _ _ #<procedure 7fb95f8569d8 at guix/ui.scm:451:2 (key c)> _)
    837:9  2 (catch _ _ #<procedure 7fb95f8569f0 at guix/ui.scm:539:6 (key proc …> …)
In guix/scripts/system.scm:
   1034:8  1 (_)
   904:28  0 (process-action vm _ ((argument . "gnu/tests/web.scm") (action . #) …))

guix/scripts/system.scm:904:28: In procedure process-action:
guix/scripts/system.scm:904:28: In procedure struct_vtable: Wrong type argument in position 1 (expecting struct): #<unspecified>
--8<---------------cut here---------------end--------------->8---

Then I prepared a VM declaration in system-cgit.scm.  It works and I got
response 200.  So, I have no idea why test fails.


[-- Attachment #6: system-cgit.scm --]
[-- Type: text/plain, Size: 2912 bytes --]

;; This is an operating system configuration template
;; for a "bare bones" setup, with no X11 display server.

(use-modules (gnu))
(use-service-modules networking version-control web)
(use-package-modules curl version-control)

(define %make-git-repository
  ;; Create Git repository in /srv/git/test.
  #~(begin
      (mkdir-p "/srv/git/test")
      (system* (string-append #$git "/bin/git") "-C" "/srv/git/test" "init")))

(define %cgit-configuration-nginx
  (list
   (nginx-server-configuration
    (root cgit)
    (locations
     (list
      (nginx-location-configuration
       (uri "@cgit")
       (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
               "fastcgi_param PATH_INFO $uri;"
               "fastcgi_param QUERY_STRING $args;"
               "fastcgi_param HTTP_HOST $server_name;"
               "fastcgi_pass 127.0.0.1:9000;")))))
    (try-files (list "$uri" "@cgit"))
    (http-port 19418)
    (https-port #f)
    (ssl-certificate #f)
    (ssl-certificate-key #f))))

(operating-system
  (host-name "komputilo")
  (timezone "Europe/Moscow")
  (locale "en_US.utf8")

  ;; Assuming /dev/sdX is the target hard disk, and "my-root" is
  ;; the label of the target root file system.
  (bootloader (grub-configuration (target "/dev/sda")
                                  (terminal-outputs '(console))))
  (file-systems (cons (file-system
                        (device "my-root")
                        (title 'label)
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))

  ;; This is where user accounts are specified.  The "root"
  ;; account is implicit, and is initially created with the
  ;; empty password.
  (users (cons (user-account
                (name "alice")
                (comment "Bob's sister")
                (group "users")

                ;; Adding the account to the "wheel" group
                ;; makes it a sudoer.  Adding it to "audio"
                ;; and "video" allows the user to play sound
                ;; and access the webcam.
                (supplementary-groups '("wheel"
                                        "audio" "video"))
                (home-directory "/home/alice"))
               %base-user-accounts))

  (packages (cons* git
                   curl
                   %base-packages))

  ;; Add services to the baseline: a DHCP client and
  ;; an SSH server.
  (services (cons* (dhcp-client-service)
                   (service nginx-service-type)
                   (service fcgiwrap-service-type)
                   (service cgit-service-type
                            (cgit-configuration
                             (nginx %cgit-configuration-nginx)))
                   (simple-service 'make-git-repository activation-service-type
                                   %make-git-repository)
                   %base-services)))

[-- Attachment #7: Type: text/plain, Size: 20 bytes --]


Thanks for review!