1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
3 ;;; Copyright © 2017, 2018 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)
43 (define README-contents
44 "Hello! This is what goes inside the 'README' file.")
46 (define %make-git-repository
47 ;; Create Git repository in /srv/git/test.
48 (with-imported-modules (source-module-closure
49 '((guix build utils)))
51 (use-modules (guix build utils))
53 (let ((git (string-append #$git "/bin/git")))
54 (mkdir-p "/tmp/test-repo")
55 (with-directory-excursion "/tmp/test-repo"
56 (call-with-output-file "/tmp/test-repo/README"
58 (display #$README-contents port)))
59 (invoke git "config" "--global" "user.email" "charlie@example.org")
60 (invoke git "config" "--global" "user.name" "A U Thor")
62 (invoke git "add" ".")
63 (invoke git "commit" "-m" "That's a commit."))
66 (rename-file "/tmp/test-repo/.git" "/srv/git/test")))))
68 (define %test-repository-service
69 ;; Service that creates /srv/git/test.
70 (simple-service 'make-git-repository activation-service-type
71 %make-git-repository))
73 (define %cgit-configuration-nginx
75 (nginx-server-configuration
79 (nginx-location-configuration
81 (body '("fastcgi_param SCRIPT_FILENAME $document_root/lib/cgit/cgit.cgi;"
82 "fastcgi_param PATH_INFO $uri;"
83 "fastcgi_param QUERY_STRING $args;"
84 "fastcgi_param HTTP_HOST $server_name;"
85 "fastcgi_pass 127.0.0.1:9000;")))))
86 (try-files (list "$uri" "@cgit"))
89 (ssl-certificate-key #f))))
92 ;; Operating system under test.
94 (simple-operating-system
95 (service dhcp-client-service-type)
96 (service cgit-service-type
98 (nginx %cgit-configuration-nginx)))
99 %test-repository-service)))
103 (operating-system-packages base-os))))))
105 (define* (run-cgit-test #:optional (http-port 19418))
106 "Run tests in %CGIT-OS, which has nginx running and listening on
109 (marionette-operating-system
111 #:imported-modules '((gnu services herd)
112 (guix combinators))))
116 (operating-system os)
117 (port-forwardings `((8080 . ,http-port)))))
120 (with-imported-modules '((gnu build marionette))
122 (use-modules (srfi srfi-11) (srfi srfi-64)
123 (gnu build marionette)
129 (make-marionette (list #$vm)))
136 ;; XXX: Shepherd reads the config file *before* binding its control
137 ;; socket, so /var/run/shepherd/socket might not exist yet when the
138 ;; 'marionette' service is started.
139 (test-assert "shepherd socket ready"
142 (use-modules (gnu services herd))
144 (cond ((file-exists? (%shepherd-socket-file))
153 ;; Wait for nginx to be up and running.
154 (test-assert "nginx running"
157 (use-modules (gnu services herd))
158 (start-service 'nginx))
161 ;; Wait for fcgiwrap to be up and running.
162 (test-assert "fcgiwrap running"
165 (use-modules (gnu services herd))
166 (start-service 'fcgiwrap))
169 ;; Make sure the PID file is created.
170 (test-assert "PID file"
172 '(file-exists? "/var/run/nginx/pid")
175 ;; Make sure the configuration file is created.
176 (test-assert "configuration file"
178 '(file-exists? "/etc/cgitrc")
181 ;; Make sure Git test repository is created.
182 (test-assert "Git test repository"
184 '(file-exists? "/srv/git/test")
187 ;; Make sure we can access pages that correspond to our repository.
188 (letrec-syntax ((test-url
191 (test-equal (string-append "GET " path)
193 (let-values (((response body)
194 (http-get (string-append
195 "http://localhost:8080"
197 (response-code response))))
199 (test-url path 200)))))
202 (test-url "/test/log")
203 (test-url "/test/tree")
204 (test-url "/test/tree/README")
205 (test-url "/test/does-not-exist" 404)
206 (test-url "/test/tree/does-not-exist" 404)
207 (test-url "/does-not-exist" 404))
210 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
212 (gexp->derivation "cgit-test" test))
217 (description "Connect to a running Cgit server.")
218 (value (run-cgit-test))))
225 (define %git-nginx-configuration
229 (nginx-server-configuration
232 (ssl-certificate-key #f)
234 (list (git-http-nginx-location-configuration
235 (git-http-configuration (export-all? #t)
236 (uri-path "/git"))))))))))
239 (simple-operating-system
240 (service dhcp-client-service-type)
241 (service fcgiwrap-service-type)
242 (service nginx-service-type %git-nginx-configuration)
243 %test-repository-service))
245 (define* (run-git-http-test #:optional (http-port 19418))
247 (marionette-operating-system
249 #:imported-modules '((gnu services herd)
250 (guix combinators))))
254 (operating-system os)
255 (port-forwardings `((8080 . ,http-port)))))
258 (with-imported-modules '((gnu build marionette)
261 (use-modules (srfi srfi-64)
263 (gnu build marionette)
267 (make-marionette (list #$vm)))
272 (test-begin "git-http")
274 ;; Wait for nginx to be up and running.
275 (test-assert "nginx running"
278 (use-modules (gnu services herd))
279 (start-service 'nginx))
282 ;; Make sure Git test repository is created.
283 (test-assert "Git test repository"
285 '(file-exists? "/srv/git/test")
288 ;; Make sure we can clone the repo from the host.
292 (invoke #$(file-append git "/bin/git") "clone" "-v"
293 "http://localhost:8080/git/test" "/tmp/clone")
294 (call-with-input-file "/tmp/clone/README"
298 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
300 (gexp->derivation "git-http" test))
302 (define %test-git-http
305 (description "Connect to a running Git HTTP server.")
306 (value (run-git-http-test))))
313 (define %gitolite-test-admin-keypair
315 "gitolite-test-admin-keypair"
316 (with-imported-modules (source-module-closure
317 '((guix build utils)))
319 (use-modules (ice-9 match) (srfi srfi-26)
323 (invoke #$(file-append openssh "/bin/ssh-keygen")
324 "-f" (string-append #$output "/test-admin")
330 (simple-operating-system
331 (service dhcp-client-service-type)
332 (service openssh-service-type)
333 (service gitolite-service-type
334 (gitolite-configuration
336 (file-append %gitolite-test-admin-keypair "/test-admin.pub"))))))
338 (define (run-gitolite-test)
340 (marionette-operating-system
342 #:imported-modules '((gnu services herd)
343 (guix combinators))))
347 (operating-system os)
348 (port-forwardings `((2222 . 22)))))
351 (with-imported-modules '((gnu build marionette)
354 (use-modules (srfi srfi-64)
356 (gnu build marionette)
360 (make-marionette (list #$vm)))
365 (test-begin "gitolite")
367 ;; Wait for sshd to be up and running.
368 (test-assert "service running"
371 (use-modules (gnu services herd))
372 (start-service 'ssh-daemon))
375 (display #$%gitolite-test-admin-keypair)
377 (setenv "GIT_SSH_VARIANT" "ssh")
378 (setenv "GIT_SSH_COMMAND"
380 '(#$(file-append openssh "/bin/ssh")
381 "-i" #$(file-append %gitolite-test-admin-keypair
383 "-o" "UserKnownHostsFile=/dev/null"
384 "-o" "StrictHostKeyChecking=no")))
386 (test-assert "cloning the admin repository"
387 (invoke #$(file-append git "/bin/git")
389 "ssh://git@localhost:2222/gitolite-admin"
392 (test-assert "admin key exists"
393 (file-exists? "/tmp/clone/keydir/test-admin.pub"))
395 (with-directory-excursion "/tmp/clone"
396 (invoke #$(file-append git "/bin/git")
397 "-c" "user.name=Guix" "-c" "user.email=guix"
402 (test-assert "pushing, and the associated hooks"
403 (invoke #$(file-append git "/bin/git") "push")))
406 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
408 (gexp->derivation "gitolite" test))
410 (define %test-gitolite
413 (description "Clone the Gitolite admin repository.")
414 (value (run-gitolite-test))))