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, 2018 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu tests version-control)
  22   #:use-module (gnu tests)
  23   #:use-module (gnu system)
  24   #:use-module (gnu system file-systems)
  25   #:use-module (gnu system shadow)
  26   #:use-module (gnu system vm)
  27   #:use-module (gnu services)
  28   #:use-module (gnu services version-control)
  29   #:use-module (gnu services web)
  30   #:use-module (gnu services networking)
  31   #:use-module (gnu packages version-control)
  32   #:use-module (guix gexp)
  33   #:use-module (guix store)
  34   #:use-module (guix modules)
  35   #:export (%test-cgit
  36             %test-git-http))
  37
  38 (define README-contents
  39   "Hello!  This is what goes inside the 'README' file.")
  40
  41 (define %make-git-repository
  42   ;; Create Git repository in /srv/git/test.
  43   (with-imported-modules (source-module-closure
  44                           '((guix build utils)))
  45     #~(begin
  46         (use-modules (guix build utils))
  47
  48         (let ((git (string-append #$git "/bin/git")))
  49           (mkdir-p "/tmp/test-repo")
  50           (with-directory-excursion "/tmp/test-repo"
  51             (call-with-output-file "/tmp/test-repo/README"
  52               (lambda (port)
  53                 (display #$README-contents port)))
  54             (invoke git "config" "--global" "user.email" "charlie@example.org")
  55             (invoke git "config" "--global" "user.name" "A U Thor")
  56             (invoke git "init")
  57             (invoke git "add" ".")
  58             (invoke git "commit" "-m" "That's a commit."))
  59
  60           (mkdir-p "/srv/git")
  61           (rename-file "/tmp/test-repo/.git" "/srv/git/test")))))
  62
  63 (define %test-repository-service
  64   ;; Service that creates /srv/git/test.
  65   (simple-service 'make-git-repository activation-service-type
  66                   %make-git-repository))
  67
  68 (define %cgit-configuration-nginx
  69   (list
  70    (nginx-server-configuration
  71     (root cgit)
  72     (locations
  73      (list
  74       (nginx-location-configuration
  75        (uri "@cgit")
  76        (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
  77                "fastcgi_param PATH_INFO $uri;"
  78                "fastcgi_param QUERY_STRING $args;"
  79                "fastcgi_param HTTP_HOST $server_name;"
  80                "fastcgi_pass 127.0.0.1:9000;")))))
  81     (try-files (list "$uri" "@cgit"))
  82     (listen '("19418"))
  83     (ssl-certificate #f)
  84     (ssl-certificate-key #f))))
  85
  86 (define %cgit-os
  87   ;; Operating system under test.
  88   (let ((base-os
  89          (simple-operating-system
  90           (dhcp-client-service)
  91           (service cgit-service-type
  92                    (cgit-configuration
  93                     (nginx %cgit-configuration-nginx)))
  94           %test-repository-service)))
  95     (operating-system
  96       (inherit base-os)
  97       (packages (cons* git
  98                        (operating-system-packages base-os))))))
  99
 100 (define* (run-cgit-test #:optional (http-port 19418))
 101   "Run tests in %CGIT-OS, which has nginx running and listening on
 102 HTTP-PORT."
 103   (define os
 104     (marionette-operating-system
 105      %cgit-os
 106      #:imported-modules '((gnu services herd)
 107                           (guix combinators))))
 108
 109   (define vm
 110     (virtual-machine
 111      (operating-system os)
 112      (port-forwardings `((8080 . ,http-port)))))
 113
 114   (define test
 115     (with-imported-modules '((gnu build marionette))
 116       #~(begin
 117           (use-modules (srfi srfi-11) (srfi srfi-64)
 118                        (gnu build marionette)
 119                        (web uri)
 120                        (web client)
 121                        (web response))
 122
 123           (define marionette
 124             (make-marionette (list #$vm)))
 125
 126           (mkdir #$output)
 127           (chdir #$output)
 128
 129           (test-begin "cgit")
 130
 131           ;; XXX: Shepherd reads the config file *before* binding its control
 132           ;; socket, so /var/run/shepherd/socket might not exist yet when the
 133           ;; 'marionette' service is started.
 134           (test-assert "shepherd socket ready"
 135             (marionette-eval
 136              `(begin
 137                 (use-modules (gnu services herd))
 138                 (let loop ((i 10))
 139                   (cond ((file-exists? (%shepherd-socket-file))
 140                          #t)
 141                         ((> i 0)
 142                          (sleep 1)
 143                          (loop (- i 1)))
 144                         (else
 145                          'failure))))
 146              marionette))
 147
 148           ;; Wait for nginx to be up and running.
 149           (test-eq "nginx running"
 150             'running!
 151             (marionette-eval
 152              '(begin
 153                 (use-modules (gnu services herd))
 154                 (start-service 'nginx)
 155                 'running!)
 156              marionette))
 157
 158           ;; Wait for fcgiwrap to be up and running.
 159           (test-eq "fcgiwrap running"
 160             'running!
 161             (marionette-eval
 162              '(begin
 163                 (use-modules (gnu services herd))
 164                 (start-service 'fcgiwrap)
 165                 'running!)
 166              marionette))
 167
 168           ;; Make sure the PID file is created.
 169           (test-assert "PID file"
 170             (marionette-eval
 171              '(file-exists? "/var/run/nginx/pid")
 172              marionette))
 173
 174           ;; Make sure the configuration file is created.
 175           (test-assert "configuration file"
 176             (marionette-eval
 177              '(file-exists? "/etc/cgitrc")
 178              marionette))
 179
 180           ;; Make sure Git test repository is created.
 181           (test-assert "Git test repository"
 182             (marionette-eval
 183              '(file-exists? "/srv/git/test")
 184              marionette))
 185
 186           ;; Make sure we can access pages that correspond to our repository.
 187           (letrec-syntax ((test-url
 188                            (syntax-rules ()
 189                              ((_ path code)
 190                               (test-equal (string-append "GET " path)
 191                                 code
 192                                 (let-values (((response body)
 193                                               (http-get (string-append
 194                                                          "http://localhost:8080"
 195                                                          path))))
 196                                   (response-code response))))
 197                              ((_ path)
 198                               (test-url path 200)))))
 199             (test-url "/")
 200             (test-url "/test")
 201             (test-url "/test/log")
 202             (test-url "/test/tree")
 203             (test-url "/test/tree/README")
 204             (test-url "/test/does-not-exist" 404)
 205             (test-url "/test/tree/does-not-exist" 404)
 206             (test-url "/does-not-exist" 404))
 207
 208           (test-end)
 209           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 210
 211   (gexp->derivation "cgit-test" test))
 212
 213 (define %test-cgit
 214   (system-test
 215    (name "cgit")
 216    (description "Connect to a running Cgit server.")
 217    (value (run-cgit-test))))
 218
 219 \f
 220 ;;;
 221 ;;; Git server.
 222 ;;;
 223
 224 (define %git-nginx-configuration
 225   (nginx-configuration
 226    (server-blocks
 227     (list
 228      (nginx-server-configuration
 229       (listen '("19418"))
 230       (ssl-certificate #f)
 231       (ssl-certificate-key #f)
 232       (locations
 233        (list (git-http-nginx-location-configuration
 234               (git-http-configuration (export-all? #t)
 235                                       (uri-path "/git"))))))))))
 236
 237 (define %git-http-os
 238   (simple-operating-system
 239    (dhcp-client-service)
 240    (service fcgiwrap-service-type)
 241    (service nginx-service-type %git-nginx-configuration)
 242    %test-repository-service))
 243
 244 (define* (run-git-http-test #:optional (http-port 19418))
 245   (define os
 246     (marionette-operating-system
 247      %git-http-os
 248      #:imported-modules '((gnu services herd)
 249                           (guix combinators))))
 250
 251   (define vm
 252     (virtual-machine
 253      (operating-system os)
 254      (port-forwardings `((8080 . ,http-port)))))
 255
 256   (define test
 257     (with-imported-modules '((gnu build marionette)
 258                              (guix build utils))
 259       #~(begin
 260           (use-modules (srfi srfi-64)
 261                        (rnrs io ports)
 262                        (gnu build marionette)
 263                        (guix build utils))
 264
 265           (define marionette
 266             (make-marionette (list #$vm)))
 267
 268           (mkdir #$output)
 269           (chdir #$output)
 270
 271           (test-begin "git-http")
 272
 273           ;; Wait for nginx to be up and running.
 274           (test-eq "nginx running"
 275             'running!
 276             (marionette-eval
 277              '(begin
 278                 (use-modules (gnu services herd))
 279                 (start-service 'nginx)
 280                 'running!)
 281              marionette))
 282
 283           ;; Make sure Git test repository is created.
 284           (test-assert "Git test repository"
 285             (marionette-eval
 286              '(file-exists? "/srv/git/test")
 287              marionette))
 288
 289           ;; Make sure we can clone the repo from the host.
 290           (test-equal "clone"
 291             '#$README-contents
 292             (begin
 293               (invoke #$(file-append git "/bin/git") "clone" "-v"
 294                       "http://localhost:8080/git/test" "/tmp/clone")
 295               (call-with-input-file "/tmp/clone/README"
 296                 get-string-all)))
 297
 298           (test-end)
 299           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 300
 301   (gexp->derivation "git-http" test))
 302
 303 (define %test-git-http
 304   (system-test
 305    (name "git-http")
 306    (description "Connect to a running Git HTTP server.")
 307    (value (run-git-http-test))))