gnu/tests/version-control.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
   3 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu tests version-control)
  21   #:use-module (gnu tests)
  22   #:use-module (gnu system)
  23   #:use-module (gnu system file-systems)
  24   #:use-module (gnu system shadow)
  25   #:use-module (gnu system vm)
  26   #:use-module (gnu services)
  27   #:use-module (gnu services version-control)
  28   #:use-module (gnu services web)
  29   #:use-module (gnu services networking)
  30   #:use-module (gnu packages version-control)
  31   #:use-module (guix gexp)
  32   #:use-module (guix store)
  33   #:export (%test-cgit))
  34
  35 (define %make-git-repository
  36   ;; Create Git repository in /srv/git/test.
  37   #~(begin
  38       (mkdir-p "/srv/git/test")
  39       (system* (string-append #$git "/bin/git") "-C" "/srv/git/test"
  40                "init" "--bare")))
  41
  42 (define %cgit-configuration-nginx
  43   (list
  44    (nginx-server-configuration
  45     (root cgit)
  46     (locations
  47      (list
  48       (nginx-location-configuration
  49        (uri "@cgit")
  50        (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
  51                "fastcgi_param PATH_INFO $uri;"
  52                "fastcgi_param QUERY_STRING $args;"
  53                "fastcgi_param HTTP_HOST $server_name;"
  54                "fastcgi_pass 127.0.0.1:9000;")))))
  55     (try-files (list "$uri" "@cgit"))
  56     (http-port 19418)
  57     (https-port #f)
  58     (ssl-certificate #f)
  59     (ssl-certificate-key #f))))
  60
  61 (define %cgit-os
  62   ;; Operating system under test.
  63   (let ((base-os
  64          (simple-operating-system
  65           (dhcp-client-service)
  66           (service nginx-service-type)
  67           (service fcgiwrap-service-type)
  68           (service cgit-service-type
  69                    (cgit-configuration
  70                     (nginx %cgit-configuration-nginx)))
  71           (simple-service 'make-git-repository activation-service-type
  72                           %make-git-repository))))
  73     (operating-system
  74       (inherit base-os)
  75       (packages (cons* git
  76                        (operating-system-packages base-os))))))
  77
  78 (define* (run-cgit-test #:optional (http-port 19418))
  79   "Run tests in %CGIT-OS, which has nginx running and listening on
  80 HTTP-PORT."
  81   (define os
  82     (marionette-operating-system
  83      %cgit-os
  84      #:imported-modules '((gnu services herd)
  85                           (guix combinators))))
  86
  87   (define vm
  88     (virtual-machine
  89      (operating-system os)
  90      (port-forwardings `((8080 . ,http-port)))))
  91
  92   (define test
  93     (with-imported-modules '((gnu build marionette))
  94       #~(begin
  95           (use-modules (srfi srfi-11) (srfi srfi-64)
  96                        (gnu build marionette)
  97                        (web uri)
  98                        (web client)
  99                        (web response))
 100
 101           (define marionette
 102             (make-marionette (list #$vm)))
 103
 104           (mkdir #$output)
 105           (chdir #$output)
 106
 107           (test-begin "cgit")
 108
 109           ;; Wait for nginx to be up and running.
 110           (test-eq "service running"
 111             'running!
 112             (marionette-eval
 113              '(begin
 114                 (use-modules (gnu services herd))
 115                 (start-service 'nginx)
 116                 'running!)
 117              marionette))
 118
 119           ;; Wait for fcgiwrap to be up and running.
 120           (test-eq "service running"
 121             'running!
 122             (marionette-eval
 123              '(begin
 124                 (use-modules (gnu services herd))
 125                 (start-service 'fcgiwrap)
 126                 'running!)
 127              marionette))
 128
 129           ;; Make sure the PID file is created.
 130           (test-assert "PID file"
 131             (marionette-eval
 132              '(file-exists? "/var/run/nginx/pid")
 133              marionette))
 134
 135           ;; Make sure the configuration file is created.
 136           (test-assert "configuration file"
 137             (marionette-eval
 138              '(file-exists? "/etc/cgitrc")
 139              marionette))
 140
 141           ;; Make sure Git test repository is created.
 142           (test-assert "Git test repository"
 143             (marionette-eval
 144              '(file-exists? "/srv/git/test")
 145              marionette))
 146
 147           ;; Make sure we can access pages that correspond to our repository.
 148           (letrec-syntax ((test-url
 149                            (syntax-rules ()
 150                              ((_ path code)
 151                               (test-equal (string-append "GET " path)
 152                                 code
 153                                 (let-values (((response body)
 154                                               (http-get (string-append
 155                                                          "http://localhost:8080"
 156                                                          path))))
 157                                   (response-code response))))
 158                              ((_ path)
 159                               (test-url path 200)))))
 160             (test-url "/")
 161             (test-url "/test")
 162             (test-url "/test/log")
 163             (test-url "/test/tree")
 164             (test-url "/test/does-not-exist" 404)
 165             (test-url "/does-not-exist" 404))
 166
 167           (test-end)
 168           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 169
 170   (gexp->derivation "cgit-test" test))
 171
 172 (define %test-cgit
 173   (system-test
 174    (name "cgit")
 175    (description "Connect to a running Cgit server.")
 176    (value (run-cgit-test))))