1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
3 ;;; Copyright © 2017-2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
4 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
5 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
7 ;;; This file is part of GNU Guix.
9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by
11 ;;; the Free Software Foundation; either version 3 of the License, or (at
12 ;;; your option) any later version.
14 ;;; GNU Guix is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 (define-module (gnu tests version-control)
23 #:use-module (gnu tests)
24 #:use-module (gnu system)
25 #:use-module (gnu system file-systems)
26 #:use-module (gnu system shadow)
27 #:use-module (gnu system vm)
28 #:use-module (gnu services)
29 #:use-module (gnu services version-control)
30 #:use-module (gnu services cgit)
31 #:use-module (gnu services ssh)
32 #:use-module (gnu services web)
33 #:use-module (gnu services networking)
34 #:use-module (gnu packages version-control)
35 #:use-module (gnu packages ssh)
36 #:use-module (guix gexp)
37 #:use-module (guix store)
38 #:use-module (guix modules)
44 (define README-contents
45 "Hello! This is what goes inside the 'README' file.")
47 (define %make-git-repository
48 ;; Create Git repository in /srv/git/test.
49 (with-imported-modules (source-module-closure
50 '((guix build utils)))
52 (use-modules (guix build utils))
54 (let ((git (string-append #$git "/bin/git")))
55 (mkdir-p "/tmp/test-repo")
56 (with-directory-excursion "/tmp/test-repo"
57 (call-with-output-file "/tmp/test-repo/README"
59 (display #$README-contents port)))
60 (invoke git "config" "--global" "user.email" "charlie@example.org")
61 (invoke git "config" "--global" "user.name" "A U Thor")
63 (invoke git "add" ".")
64 (invoke git "commit" "-m" "That's a commit."))
67 (rename-file "/tmp/test-repo/.git" "/srv/git/test")
68 (with-output-to-file "/srv/git/test/git-daemon-export-ok"
72 (define %test-repository-service
73 ;; Service that creates /srv/git/test.
74 (simple-service 'make-git-repository activation-service-type
75 %make-git-repository))
77 (define %cgit-configuration-nginx
79 (nginx-server-configuration
83 (nginx-location-configuration
85 (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
86 "fastcgi_param PATH_INFO $uri;"
87 "fastcgi_param QUERY_STRING $args;"
88 "fastcgi_param HTTP_HOST $server_name;"
89 "fastcgi_pass 127.0.0.1:9000;")))))
90 (try-files (list "$uri" "@cgit"))
93 (ssl-certificate-key #f))))
96 ;; Operating system under test.
98 (simple-operating-system
99 (service dhcp-client-service-type)
100 (service cgit-service-type
102 (nginx %cgit-configuration-nginx)))
103 %test-repository-service)))
107 (operating-system-packages base-os))))))
109 (define* (run-cgit-test #:optional (http-port 19418))
110 "Run tests in %CGIT-OS, which has nginx running and listening on
113 (marionette-operating-system
115 #:imported-modules '((gnu services herd)
116 (guix combinators))))
120 (operating-system os)
121 (port-forwardings `((8080 . ,http-port)))))
124 (with-imported-modules '((gnu build marionette))
126 (use-modules (srfi srfi-11) (srfi srfi-64)
127 (gnu build marionette)
133 (make-marionette (list #$vm)))
135 (test-runner-current (system-test-runner #$output))
138 ;; XXX: Shepherd reads the config file *before* binding its control
139 ;; socket, so /var/run/shepherd/socket might not exist yet when the
140 ;; 'marionette' service is started.
141 (test-assert "shepherd socket ready"
144 (use-modules (gnu services herd))
146 (cond ((file-exists? (%shepherd-socket-file))
155 ;; Wait for nginx to be up and running.
156 (test-assert "nginx running"
157 (wait-for-file "/var/run/nginx/pid" marionette))
159 ;; Wait for fcgiwrap to be up and running.
160 (test-assert "fcgiwrap running"
161 (wait-for-tcp-port 9000 marionette))
163 ;; Make sure the PID file is created.
164 (test-assert "PID file"
166 '(file-exists? "/var/run/nginx/pid")
169 ;; Make sure the configuration file is created.
170 (test-assert "configuration file"
172 '(file-exists? "/etc/cgitrc")
175 ;; Make sure Git test repository is created.
176 (test-assert "Git test repository"
178 '(file-exists? "/srv/git/test")
181 ;; Make sure we can access pages that correspond to our repository.
182 (letrec-syntax ((test-url
185 (test-equal (string-append "GET " path)
187 (let-values (((response body)
188 (http-get (string-append
189 "http://localhost:8080"
191 (response-code response))))
193 (test-url path 200)))))
196 (test-url "/test/log")
197 (test-url "/test/tree")
198 (test-url "/test/tree/README")
199 (test-url "/test/does-not-exist" 404)
200 (test-url "/test/tree/does-not-exist" 404)
201 (test-url "/does-not-exist" 404))
205 (gexp->derivation "cgit-test" test))
210 (description "Connect to a running Cgit server.")
211 (value (run-cgit-test))))
218 (define %git-nginx-configuration
222 (nginx-server-configuration
225 (ssl-certificate-key #f)
227 (list (git-http-nginx-location-configuration
228 (git-http-configuration (export-all? #t)
229 (uri-path "/git"))))))))))
232 (simple-operating-system
233 (service dhcp-client-service-type)
234 (service fcgiwrap-service-type)
235 (service nginx-service-type %git-nginx-configuration)
236 %test-repository-service))
238 (define* (run-git-http-test #:optional (http-port 19418))
240 (marionette-operating-system
242 #:imported-modules '((gnu services herd)
243 (guix combinators))))
247 (operating-system os)
248 (port-forwardings `((8080 . ,http-port)))))
251 (with-imported-modules '((gnu build marionette)
254 (use-modules (srfi srfi-64)
256 (gnu build marionette)
260 (make-marionette (list #$vm)))
262 (test-runner-current (system-test-runner #$output))
263 (test-begin "git-http")
265 ;; Wait for nginx to be up and running.
266 (test-assert "nginx running"
267 (wait-for-file "/var/run/nginx/pid" marionette))
269 ;; Make sure Git test repository is created.
270 (test-assert "Git test repository"
272 '(file-exists? "/srv/git/test")
275 (test-assert "fcgiwrap listens"
276 ;; Wait for fcgiwrap to be ready before cloning.
277 (wait-for-tcp-port 9000 marionette))
279 ;; Make sure we can clone the repo from the host.
283 (invoke #$(file-append git "/bin/git") "clone" "-v"
284 "http://localhost:8080/git/test" "/tmp/clone")
285 (call-with-input-file "/tmp/clone/README"
290 (gexp->derivation "git-http" test))
292 (define %test-git-http
295 (description "Connect to a running Git HTTP server.")
296 (value (run-git-http-test))))
303 (define %gitolite-test-admin-keypair
305 "gitolite-test-admin-keypair"
306 (with-imported-modules (source-module-closure
307 '((guix build utils)))
309 (use-modules (ice-9 match) (srfi srfi-26)
313 (invoke #$(file-append openssh "/bin/ssh-keygen")
314 "-f" (string-append #$output "/test-admin")
320 (simple-operating-system
321 (service dhcp-client-service-type)
322 (service openssh-service-type)
323 (service gitolite-service-type
324 (gitolite-configuration
326 (file-append %gitolite-test-admin-keypair "/test-admin.pub"))))))
328 (define (run-gitolite-test)
330 (marionette-operating-system
332 #:imported-modules '((gnu services herd)
333 (guix combinators))))
337 (operating-system os)
338 (port-forwardings `((2222 . 22)))))
341 (with-imported-modules '((gnu build marionette)
344 (use-modules (srfi srfi-64)
346 (gnu build marionette)
350 (make-marionette (list #$vm)))
352 (test-runner-current (system-test-runner #$output))
353 (test-begin "gitolite")
355 ;; Wait for sshd to be up and running.
356 (test-assert "service running"
359 (use-modules (gnu services herd))
360 (start-service 'ssh-daemon))
363 (display #$%gitolite-test-admin-keypair)
365 (setenv "GIT_SSH_VARIANT" "ssh")
366 (setenv "GIT_SSH_COMMAND"
368 '(#$(file-append openssh "/bin/ssh")
369 "-i" #$(file-append %gitolite-test-admin-keypair
371 "-o" "UserKnownHostsFile=/dev/null"
372 "-o" "StrictHostKeyChecking=no")))
374 (test-assert "cloning the admin repository"
375 (invoke #$(file-append git "/bin/git")
377 "ssh://git@localhost:2222/gitolite-admin"
380 (test-assert "admin key exists"
381 (file-exists? "/tmp/clone/keydir/test-admin.pub"))
383 (with-directory-excursion "/tmp/clone"
384 (invoke #$(file-append git "/bin/git")
385 "-c" "user.name=Guix" "-c" "user.email=guix"
390 (test-assert "pushing, and the associated hooks"
391 (invoke #$(file-append git "/bin/git") "push")))
395 (gexp->derivation "gitolite" test))
397 (define %test-gitolite
400 (description "Clone the Gitolite admin repository.")
401 (value (run-gitolite-test))))
407 (define %gitile-configuration-nginx
408 (nginx-server-configuration
409 (root "/does/not/exists")
410 (try-files (list "$uri" "=404"))
413 (ssl-certificate-key #f)))
416 ;; Operating system under test.
417 (simple-operating-system
418 (service dhcp-client-service-type)
419 (simple-service 'srv-git activation-service-type
420 #~(mkdir-p "/srv/git"))
421 (service gitile-service-type
422 (gitile-configuration
423 (base-git-url "http://localhost")
424 (repositories "/srv/git")
425 (nginx %gitile-configuration-nginx)))
426 %test-repository-service))
428 (define* (run-gitile-test #:optional (http-port 19418))
429 "Run tests in %GITOLITE-OS, which has nginx running and listening on
432 (marionette-operating-system
434 #:imported-modules '((gnu services herd)
435 (guix combinators))))
439 (operating-system os)
440 (port-forwardings `((8081 . ,http-port)))
444 (with-imported-modules '((gnu build marionette))
446 (use-modules (srfi srfi-11) (srfi srfi-64)
447 (gnu build marionette)
453 (make-marionette (list #$vm)))
455 (test-runner-current (system-test-runner #$output))
456 (test-begin "gitile")
458 ;; XXX: Shepherd reads the config file *before* binding its control
459 ;; socket, so /var/run/shepherd/socket might not exist yet when the
460 ;; 'marionette' service is started.
461 (test-assert "shepherd socket ready"
464 (use-modules (gnu services herd))
466 (cond ((file-exists? (%shepherd-socket-file))
475 ;; Wait for nginx to be up and running.
476 (test-assert "nginx running"
477 (wait-for-file "/var/run/nginx/pid" marionette))
479 ;; Make sure Git test repository is created.
480 (test-assert "Git test repository"
482 '(file-exists? "/srv/git/test")
487 ;; Make sure we can access pages that correspond to our repository.
488 (letrec-syntax ((test-url
491 (test-equal (string-append "GET " path)
493 (let-values (((response body)
494 (http-get (string-append
495 "http://localhost:8081"
497 (response-code response))))
499 (test-url path 200)))))
501 (test-url "/css/gitile.css")
503 (test-url "/test/commits")
504 (test-url "/test/tree" 404)
505 (test-url "/test/tree/-")
506 (test-url "/test/tree/-/README")
507 (test-url "/test/does-not-exist" 404)
508 (test-url "/test/tree/-/does-not-exist" 404)
509 (test-url "/does-not-exist" 404))
513 (gexp->derivation "gitile-test" test))
518 (description "Connect to a running Gitile server.")
519 (value (run-gitile-test))))