[jackhill/guix/guix.git] / gnu / tests / version-control.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
;;;
;;; 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 cgit)
  #:use-module (gnu services ssh)
  #:use-module (gnu services web)
  #:use-module (gnu services networking)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages ssh)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:use-module (guix modules)
  #:export (%test-cgit
            %test-git-http
            %test-gitolite))

(define README-contents
  "Hello!  This is what goes inside the 'README' file.")

(define %make-git-repository
  ;; Create Git repository in /srv/git/test.
  (with-imported-modules (source-module-closure
                          '((guix build utils)))
    #~(begin
        (use-modules (guix build utils))

        (let ((git (string-append #$git "/bin/git")))
          (mkdir-p "/tmp/test-repo")
          (with-directory-excursion "/tmp/test-repo"
            (call-with-output-file "/tmp/test-repo/README"
              (lambda (port)
                (display #$README-contents port)))
            (invoke git "config" "--global" "user.email" "charlie@example.org")
            (invoke git "config" "--global" "user.name" "A U Thor")
            (invoke git "init")
            (invoke git "add" ".")
            (invoke git "commit" "-m" "That's a commit."))

          (mkdir-p "/srv/git")
          (rename-file "/tmp/test-repo/.git" "/srv/git/test")))))

(define %test-repository-service
  ;; Service that creates /srv/git/test.
  (simple-service 'make-git-repository activation-service-type
                  %make-git-repository))

(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"))
    (listen '("19418"))
    (ssl-certificate #f)
    (ssl-certificate-key #f))))

(define %cgit-os
  ;; Operating system under test.
  (let ((base-os
         (simple-operating-system
          (service dhcp-client-service-type)
          (service cgit-service-type
                   (cgit-configuration
                    (nginx %cgit-configuration-nginx)))
          %test-repository-service)))
    (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")

          ;; XXX: Shepherd reads the config file *before* binding its control
          ;; socket, so /var/run/shepherd/socket might not exist yet when the
          ;; 'marionette' service is started.
          (test-assert "shepherd socket ready"
            (marionette-eval
             `(begin
                (use-modules (gnu services herd))
                (let loop ((i 10))
                  (cond ((file-exists? (%shepherd-socket-file))
                         #t)
                        ((> i 0)
                         (sleep 1)
                         (loop (- i 1)))
                        (else
                         'failure))))
             marionette))

          ;; Wait for nginx to be up and running.
          (test-assert "nginx running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'nginx))
             marionette))

          ;; Wait for fcgiwrap to be up and running.
          (test-assert "fcgiwrap running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'fcgiwrap))
             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/tree/README")
            (test-url "/test/does-not-exist" 404)
            (test-url "/test/tree/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))))

\f
;;;
;;; Git server.
;;;

(define %git-nginx-configuration
  (nginx-configuration
   (server-blocks
    (list
     (nginx-server-configuration
      (listen '("19418"))
      (ssl-certificate #f)
      (ssl-certificate-key #f)
      (locations
       (list (git-http-nginx-location-configuration
              (git-http-configuration (export-all? #t)
                                      (uri-path "/git"))))))))))

(define %git-http-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service fcgiwrap-service-type)
   (service nginx-service-type %git-nginx-configuration)
   %test-repository-service))

(define* (run-git-http-test #:optional (http-port 19418))
  (define os
    (marionette-operating-system
     %git-http-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)
                             (guix build utils))
      #~(begin
          (use-modules (srfi srfi-64)
                       (rnrs io ports)
                       (gnu build marionette)
                       (guix build utils))

          (define marionette
            (make-marionette (list #$vm)))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "git-http")

          ;; Wait for nginx to be up and running.
          (test-assert "nginx running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'nginx))
             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 clone the repo from the host.
          (test-equal "clone"
            '#$README-contents
            (begin
              (invoke #$(file-append git "/bin/git") "clone" "-v"
                      "http://localhost:8080/git/test" "/tmp/clone")
              (call-with-input-file "/tmp/clone/README"
                get-string-all)))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "git-http" test))

(define %test-git-http
  (system-test
   (name "git-http")
   (description "Connect to a running Git HTTP server.")
   (value (run-git-http-test))))

\f
;;;
;;; Gitolite.
;;;

(define %gitolite-test-admin-keypair
  (computed-file
   "gitolite-test-admin-keypair"
   (with-imported-modules (source-module-closure
                           '((guix build utils)))
     #~(begin
         (use-modules (ice-9 match) (srfi srfi-26)
                      (guix build utils))

         (mkdir #$output)
         (invoke #$(file-append openssh "/bin/ssh-keygen")
                 "-f" (string-append #$output "/test-admin")
                 "-t" "rsa"
                 "-q"
                 "-N" "")))))

(define %gitolite-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service openssh-service-type)
   (service gitolite-service-type
            (gitolite-configuration
             (admin-pubkey
              (file-append %gitolite-test-admin-keypair "/test-admin.pub"))))))

(define (run-gitolite-test)
  (define os
    (marionette-operating-system
     %gitolite-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings `((2222 . 22)))))

  (define test
    (with-imported-modules '((gnu build marionette)
                             (guix build utils))
      #~(begin
          (use-modules (srfi srfi-64)
                       (rnrs io ports)
                       (gnu build marionette)
                       (guix build utils))

          (define marionette
            (make-marionette (list #$vm)))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "gitolite")

          ;; Wait for sshd to be up and running.
          (test-assert "service running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'ssh-daemon))
             marionette))

          (display #$%gitolite-test-admin-keypair)

          (setenv "GIT_SSH_VARIANT" "ssh")
          (setenv "GIT_SSH_COMMAND"
                  (string-join
                   '(#$(file-append openssh "/bin/ssh")
                     "-i" #$(file-append %gitolite-test-admin-keypair
                                         "/test-admin")
                     "-o" "UserKnownHostsFile=/dev/null"
                     "-o" "StrictHostKeyChecking=no")))

          (test-assert "cloning the admin repository"
            (invoke #$(file-append git "/bin/git")
                    "clone" "-v"
                    "ssh://git@localhost:2222/gitolite-admin"
                    "/tmp/clone"))

          (test-assert "admin key exists"
            (file-exists? "/tmp/clone/keydir/test-admin.pub"))

          (with-directory-excursion "/tmp/clone"
            (invoke #$(file-append git "/bin/git")
                    "-c" "user.name=Guix" "-c" "user.email=guix"
                    "commit"
                    "-m" "Test commit"
                    "--allow-empty")

            (test-assert "pushing, and the associated hooks"
              (invoke #$(file-append git "/bin/git") "push")))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "gitolite" test))

(define %test-gitolite
  (system-test
   (name "gitolite")
   (description "Clone the Gitolite admin repository.")
   (value (run-gitolite-test))))
Commit	Line	Data
032a2760	1	;;; GNU Guix --- Functional package management for GNU
e1cf4fd2	2	;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
bc58201e	3	;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
c24b1547	4	;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
f8e71068	5	;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
032a2760 OP	6	;;;
	7	;;; This file is part of GNU Guix.
	8	;;;
	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.
	13	;;;
	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.
	18	;;;
	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/>.
	21
	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)
e1cf4fd2	30	#:use-module (gnu services cgit)
f8e71068	31	#:use-module (gnu services ssh)
032a2760 OP	32	#:use-module (gnu services web)
	33	#:use-module (gnu services networking)
	34	#:use-module (gnu packages version-control)
f8e71068	35	#:use-module (gnu packages ssh)
032a2760 OP	36	#:use-module (guix gexp)
032a2760 OP	37	#:use-module (guix store)
e755692b	38	#:use-module (guix modules)
87dad874	39	#:export (%test-cgit
f8e71068 CB	40	%test-git-http
f8e71068 CB	41	%test-gitolite))
032a2760	42
e755692b LC	43	(define README-contents
	44	"Hello! This is what goes inside the 'README' file.")
	45
032a2760 OP	46	(define %make-git-repository
032a2760 OP	47	;; Create Git repository in /srv/git/test.
e755692b LC	48	(with-imported-modules (source-module-closure
	49	'((guix build utils)))
	50	#~(begin
	51	(use-modules (guix build utils))
	52
	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"
	57	(lambda (port)
	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")
	61	(invoke git "init")
	62	(invoke git "add" ".")
	63	(invoke git "commit" "-m" "That's a commit."))
	64
	65	(mkdir-p "/srv/git")
	66	(rename-file "/tmp/test-repo/.git" "/srv/git/test")))))
	67
	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))
032a2760 OP	72
	73	(define %cgit-configuration-nginx
	74	(list
	75	(nginx-server-configuration
	76	(root cgit)
	77	(locations
	78	(list
	79	(nginx-location-configuration
	80	(uri "@cgit")
	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"))
8b223cea	87	(listen '("19418"))
032a2760 OP	88	(ssl-certificate #f)
	89	(ssl-certificate-key #f))))
	90
	91	(define %cgit-os
	92	;; Operating system under test.
	93	(let ((base-os
	94	(simple-operating-system
39d7fdce	95	(service dhcp-client-service-type)
032a2760 OP	96	(service cgit-service-type
	97	(cgit-configuration
	98	(nginx %cgit-configuration-nginx)))
e755692b	99	%test-repository-service)))
032a2760 OP	100	(operating-system
	101	(inherit base-os)
	102	(packages (cons* git
	103	(operating-system-packages base-os))))))
	104
	105	(define* (run-cgit-test #:optional (http-port 19418))
	106	"Run tests in %CGIT-OS, which has nginx running and listening on
	107	HTTP-PORT."
	108	(define os
	109	(marionette-operating-system
	110	%cgit-os
	111	#:imported-modules '((gnu services herd)
	112	(guix combinators))))
	113
	114	(define vm
	115	(virtual-machine
	116	(operating-system os)
	117	(port-forwardings `((8080 . ,http-port)))))
	118
	119	(define test
	120	(with-imported-modules '((gnu build marionette))
	121	#~(begin
	122	(use-modules (srfi srfi-11) (srfi srfi-64)
	123	(gnu build marionette)
	124	(web uri)
	125	(web client)
	126	(web response))
	127
	128	(define marionette
	129	(make-marionette (list #$vm)))
	130
	131	(mkdir #$output)
	132	(chdir #$output)
	133
	134	(test-begin "cgit")
	135
bc58201e LC	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"
	140	(marionette-eval
	141	`(begin
	142	(use-modules (gnu services herd))
	143	(let loop ((i 10))
	144	(cond ((file-exists? (%shepherd-socket-file))
	145	#t)
	146	((> i 0)
	147	(sleep 1)
	148	(loop (- i 1)))
	149	(else
	150	'failure))))
	151	marionette))
	152
032a2760	153	;; Wait for nginx to be up and running.
c24b1547	154	(test-assert "nginx running"
032a2760 OP	155	(marionette-eval
	156	'(begin
	157	(use-modules (gnu services herd))
c24b1547	158	(start-service 'nginx))
032a2760 OP	159	marionette))
	160
	161	;; Wait for fcgiwrap to be up and running.
c24b1547	162	(test-assert "fcgiwrap running"
032a2760 OP	163	(marionette-eval
	164	'(begin
	165	(use-modules (gnu services herd))
c24b1547	166	(start-service 'fcgiwrap))
032a2760 OP	167	marionette))
	168
	169	;; Make sure the PID file is created.
	170	(test-assert "PID file"
	171	(marionette-eval
	172	'(file-exists? "/var/run/nginx/pid")
	173	marionette))
	174
	175	;; Make sure the configuration file is created.
	176	(test-assert "configuration file"
	177	(marionette-eval
	178	'(file-exists? "/etc/cgitrc")
	179	marionette))
	180
	181	;; Make sure Git test repository is created.
	182	(test-assert "Git test repository"
	183	(marionette-eval
	184	'(file-exists? "/srv/git/test")
	185	marionette))
	186
	187	;; Make sure we can access pages that correspond to our repository.
	188	(letrec-syntax ((test-url
	189	(syntax-rules ()
	190	((_ path code)
	191	(test-equal (string-append "GET " path)
	192	code
	193	(let-values (((response body)
	194	(http-get (string-append
	195	"http://localhost:8080"
	196	path))))
	197	(response-code response))))
	198	((_ path)
	199	(test-url path 200)))))
	200	(test-url "/")
	201	(test-url "/test")
	202	(test-url "/test/log")
	203	(test-url "/test/tree")
e755692b	204	(test-url "/test/tree/README")
032a2760	205	(test-url "/test/does-not-exist" 404)
e755692b	206	(test-url "/test/tree/does-not-exist" 404)
032a2760 OP	207	(test-url "/does-not-exist" 404))
	208
	209	(test-end)
	210	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	211
	212	(gexp->derivation "cgit-test" test))
	213
	214	(define %test-cgit
	215	(system-test
	216	(name "cgit")
	217	(description "Connect to a running Cgit server.")
	218	(value (run-cgit-test))))
87dad874 LC	219
	220	\f
	221	;;;
	222	;;; Git server.
	223	;;;
	224
	225	(define %git-nginx-configuration
	226	(nginx-configuration
	227	(server-blocks
	228	(list
	229	(nginx-server-configuration
8b223cea	230	(listen '("19418"))
87dad874 LC	231	(ssl-certificate #f)
	232	(ssl-certificate-key #f)
	233	(locations
	234	(list (git-http-nginx-location-configuration
	235	(git-http-configuration (export-all? #t)
	236	(uri-path "/git"))))))))))
	237
	238	(define %git-http-os
	239	(simple-operating-system
39d7fdce	240	(service dhcp-client-service-type)
87dad874 LC	241	(service fcgiwrap-service-type)
	242	(service nginx-service-type %git-nginx-configuration)
	243	%test-repository-service))
	244
	245	(define* (run-git-http-test #:optional (http-port 19418))
	246	(define os
	247	(marionette-operating-system
	248	%git-http-os
	249	#:imported-modules '((gnu services herd)
	250	(guix combinators))))
	251
	252	(define vm
	253	(virtual-machine
	254	(operating-system os)
	255	(port-forwardings `((8080 . ,http-port)))))
	256
	257	(define test
	258	(with-imported-modules '((gnu build marionette)
	259	(guix build utils))
	260	#~(begin
	261	(use-modules (srfi srfi-64)
	262	(rnrs io ports)
	263	(gnu build marionette)
	264	(guix build utils))
	265
	266	(define marionette
	267	(make-marionette (list #$vm)))
	268
	269	(mkdir #$output)
	270	(chdir #$output)
	271
	272	(test-begin "git-http")
	273
	274	;; Wait for nginx to be up and running.
c24b1547	275	(test-assert "nginx running"
87dad874 LC	276	(marionette-eval
	277	'(begin
	278	(use-modules (gnu services herd))
c24b1547	279	(start-service 'nginx))
87dad874 LC	280	marionette))
	281
	282	;; Make sure Git test repository is created.
	283	(test-assert "Git test repository"
	284	(marionette-eval
	285	'(file-exists? "/srv/git/test")
	286	marionette))
	287
	288	;; Make sure we can clone the repo from the host.
	289	(test-equal "clone"
	290	'#$README-contents
	291	(begin
	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"
	295	get-string-all)))
	296
	297	(test-end)
	298	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	299
	300	(gexp->derivation "git-http" test))
	301
	302	(define %test-git-http
	303	(system-test
	304	(name "git-http")
	305	(description "Connect to a running Git HTTP server.")
	306	(value (run-git-http-test))))
f8e71068 CB	307
	308	\f
	309	;;;
	310	;;; Gitolite.
	311	;;;
	312
	313	(define %gitolite-test-admin-keypair
	314	(computed-file
	315	"gitolite-test-admin-keypair"
	316	(with-imported-modules (source-module-closure
	317	'((guix build utils)))
	318	#~(begin
	319	(use-modules (ice-9 match) (srfi srfi-26)
	320	(guix build utils))
	321
	322	(mkdir #$output)
	323	(invoke #$(file-append openssh "/bin/ssh-keygen")
	324	"-f" (string-append #$output "/test-admin")
	325	"-t" "rsa"
	326	"-q"
	327	"-N" "")))))
	328
	329	(define %gitolite-os
	330	(simple-operating-system
39d7fdce	331	(service dhcp-client-service-type)
f8e71068 CB	332	(service openssh-service-type)
	333	(service gitolite-service-type
	334	(gitolite-configuration
	335	(admin-pubkey
	336	(file-append %gitolite-test-admin-keypair "/test-admin.pub"))))))
	337
	338	(define (run-gitolite-test)
	339	(define os
	340	(marionette-operating-system
	341	%gitolite-os
	342	#:imported-modules '((gnu services herd)
	343	(guix combinators))))
	344
	345	(define vm
	346	(virtual-machine
	347	(operating-system os)
	348	(port-forwardings `((2222 . 22)))))
	349
	350	(define test
	351	(with-imported-modules '((gnu build marionette)
	352	(guix build utils))
	353	#~(begin
	354	(use-modules (srfi srfi-64)
	355	(rnrs io ports)
	356	(gnu build marionette)
	357	(guix build utils))
	358
	359	(define marionette
	360	(make-marionette (list #$vm)))
	361
	362	(mkdir #$output)
	363	(chdir #$output)
	364
	365	(test-begin "gitolite")
	366
	367	;; Wait for sshd to be up and running.
	368	(test-assert "service running"
	369	(marionette-eval
	370	'(begin
	371	(use-modules (gnu services herd))
	372	(start-service 'ssh-daemon))
	373	marionette))
	374
	375	(display #$%gitolite-test-admin-keypair)
	376
	377	(setenv "GIT_SSH_VARIANT" "ssh")
	378	(setenv "GIT_SSH_COMMAND"
	379	(string-join
	380	'(#$(file-append openssh "/bin/ssh")
	381	"-i" #$(file-append %gitolite-test-admin-keypair
	382	"/test-admin")
	383	"-o" "UserKnownHostsFile=/dev/null"
	384	"-o" "StrictHostKeyChecking=no")))
	385
	386	(test-assert "cloning the admin repository"
	387	(invoke #$(file-append git "/bin/git")
	388	"clone" "-v"
	389	"ssh://git@localhost:2222/gitolite-admin"
	390	"/tmp/clone"))
	391
	392	(test-assert "admin key exists"
	393	(file-exists? "/tmp/clone/keydir/test-admin.pub"))
	394
	395	(with-directory-excursion "/tmp/clone"
396	(invoke #$(file-append git "/bin/git")
397	"-c" "user.name=Guix" "-c" "user.email=guix"
398	"commit"
399	"-m" "Test commit"
400	"--allow-empty")
401
402	(test-assert "pushing, and the associated hooks"
403	(invoke #$(file-append git "/bin/git") "push")))
404
405	(test-end)
406	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
407
408	(gexp->derivation "gitolite" test))
409
410	(define %test-gitolite
411	(system-test
412	(name "gitolite")
413	(description "Clone the Gitolite admin repository.")
414	(value (run-gitolite-test))))