~ruther/guix-local

032a2760eef6dc64fa36f2fb3a211b755d5124bb — Oleg Pykhalov 8 years ago e797e94
gnu: services: 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.
* gnu/tests/version-control.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Version Control): Document the cgit service.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
4 files changed, 360 insertions(+), 1 deletions(-)

M doc/guix.texi
M gnu/local.mk
M gnu/services/version-control.scm
A gnu/tests/version-control.scm
M doc/guix.texi => doc/guix.texi +65 -0
@@ 17000,6 17000,71 @@ Extra options will be passed to @code{git daemon}, please run
@end table
@end deftp

@subsubheading Cgit Service

@cindex Cgit service
@cindex Git, web interface
@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


M gnu/local.mk => gnu/local.mk +1 -0
@@ 501,6 501,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/tests/networking.scm			\
  %D%/tests/rsync.scm				\
  %D%/tests/ssh.scm				\
  %D%/tests/version-control.scm			\
  %D%/tests/virtualization.scm			\
  %D%/tests/web.scm


M gnu/services/version-control.scm => gnu/services/version-control.scm +118 -1
@@ 1,6 1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 21,18 22,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-repository-directory

            <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 162,97 @@ 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))


;;;
;;; Cgit
;;;

(define-record-type* <cgit-configuration-file>
  cgit-configuration-file
  make-cgit-configuration-file
  cgit-configuration-file?
  (css                  cgit-configuration-file-css                  ; string
                        (default "/share/cgit/cgit.css"))
  (logo                 cgit-configuration-file-logo                 ; string
                        (default "/share/cgit/cgit.png"))
  (robots               cgit-configuration-file-robots               ; list
                        (default '("noindex" "nofollow")))
  (virtual-root         cgit-configuration-file-virtual-root         ; string
                        (default "/"))
  (repository-directory cgit-configuration-file-repository-directory ; string
                        (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)
     (apply text-file* "cgitrc"
            (letrec-syntax ((option (syntax-rules ()
                                      ((_ key value)
                                       (if value
                                           `(,key "=" ,value "\n")
                                           '()))))
                            (key/value (syntax-rules ()
                                         ((_ (key value) rest ...)
                                          (append (option key value)
                                                  (key/value rest ...)))
                                         ((_)
                                          '()))))
              (key/value ("css" css)
                         ("logo" logo)
                         ("robots" (cgit-configuration-robots-string robots))
                         ("virtual-root" virtual-root)
                         ("scan-path" 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
  #~(begin
      (use-modules (guix build utils))
      (mkdir-p "/var/cache/cgit")
      (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))))

A gnu/tests/version-control.scm => gnu/tests/version-control.scm +176 -0
@@ 0,0 1,176 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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" "--bare")))

(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")
             marionette))

          ;; 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:8080"
                                                         path))))
                                  (response-code response))))
                             ((_ path)
                              (test-url path 200)))))
            (test-url "/")
            (test-url "/test")
            (test-url "/test/log")
            (test-url "/test/tree")
            (test-url "/test/does-not-exist" 404)
            (test-url "/does-not-exist" 404))

          (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))))