summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2018-09-29 21:18:45 -0400
committerMark H Weaver <mhw@netris.org>2018-09-29 21:18:45 -0400
commit17bea1803cf706d8db053d8d73302a4455684d29 (patch)
tree073d30a8ff065d4e08cc4901f7e97e72a9de68a6 /gnu
parente72ca4111fce4b05bf2a685e451f26e06680e36c (diff)
Revert "services: Add Gitolite."
This reverts commit 258a6d944ed891fa92fa87a16731e5dfe0bac477.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/version-control.scm179
-rw-r--r--gnu/tests/version-control.scm114
2 files changed, 2 insertions, 291 deletions
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index cc8cd220211..58274c8beed 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -3,7 +3,6 @@
3;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> 3;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
4;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com> 4;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
5;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> 5;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
6;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
7;;; 6;;;
8;;; This file is part of GNU Guix. 7;;; This file is part of GNU Guix.
9;;; 8;;;
@@ -41,23 +40,7 @@
41 40
42 git-http-configuration 41 git-http-configuration
43 git-http-configuration? 42 git-http-configuration?
44 git-http-nginx-location-configuration 43 git-http-nginx-location-configuration))
45
46 <gitolite-configuration>
47 gitolite-configuration
48 gitolite-configuration-package
49 gitolite-configuration-user
50 gitolite-configuration-rc-file
51 gitolite-configuration-admin-pubkey
52
53 <gitolite-rc-file>
54 gitolite-rc-file
55 gitolite-rc-file-umask
56 gitolite-rc-file-git-config-keys
57 gitolite-rc-file-roles
58 gitolite-rc-file-enable
59
60 gitolite-service-type))
61 44
62;;; Commentary: 45;;; Commentary:
63;;; 46;;;
@@ -214,163 +197,3 @@ access to exported repositories under @file{/srv/git}."
214 "") 197 "")
215 (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";") 198 (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
216 "fastcgi_param PATH_INFO $1;")))))) 199 "fastcgi_param PATH_INFO $1;"))))))
217
218
219;;;
220;;; Gitolite
221;;;
222
223(define-record-type* <gitolite-rc-file>
224 gitolite-rc-file make-gitolite-rc-file
225 gitolite-rc-file?
226 (umask gitolite-rc-file-umask
227 (default #o0077))
228 (git-config-keys gitolite-rc-file-git-config-keys
229 (default ""))
230 (roles gitolite-rc-file-roles
231 (default '(("READERS" . 1)
232 ("WRITERS" . 1))))
233 (enable gitolite-rc-file-enable
234 (default '("help"
235 "desc"
236 "info"
237 "perms"
238 "writable"
239 "ssh-authkeys"
240 "git-config"
241 "daemon"
242 "gitweb"))))
243
244(define-gexp-compiler (gitolite-rc-file-compiler
245 (file <gitolite-rc-file>) system target)
246 (match file
247 (($ <gitolite-rc-file> umask git-config-keys roles enable)
248 (apply text-file* "gitolite.rc"
249 `("%RC = (\n"
250 " UMASK => " ,(format #f "~4,'0o" umask) ",\n"
251 " GIT_CONFIG_KEYS => '" ,git-config-keys "',\n"
252 " ROLES => {\n"
253 ,@(map (match-lambda
254 ((role . value)
255 (simple-format #f " ~A => ~A,\n" role value)))
256 roles)
257 " },\n"
258 "\n"
259 " ENABLE => [\n"
260 ,@(map (lambda (value)
261 (simple-format #f " '~A',\n" value))
262 enable)
263 " ],\n"
264 ");\n"
265 "\n"
266 "1;\n")))))
267
268(define-record-type* <gitolite-configuration>
269 gitolite-configuration make-gitolite-configuration
270 gitolite-configuration?
271 (package gitolite-configuration-package
272 (default gitolite))
273 (user gitolite-configuration-user
274 (default "git"))
275 (group gitolite-configuration-group
276 (default "git"))
277 (home-directory gitolite-configuration-home-directory
278 (default "/var/lib/gitolite"))
279 (rc-file gitolite-configuration-rc-file
280 (default (gitolite-rc-file)))
281 (admin-pubkey gitolite-configuration-admin-pubkey))
282
283(define gitolite-accounts
284 (match-lambda
285 (($ <gitolite-configuration> package user group home-directory
286 rc-file admin-pubkey)
287 ;; User group and account to run Gitolite.
288 (list (user-group (name user) (system? #t))
289 (user-account
290 (name user)
291 (group group)
292 (system? #t)
293 (comment "Gitolite user")
294 (home-directory home-directory))))))
295
296(define gitolite-activation
297 (match-lambda
298 (($ <gitolite-configuration> package user group home
299 rc-file admin-pubkey)
300 #~(begin
301 (use-modules (ice-9 match)
302 (guix build utils))
303
304 (let* ((user-info (getpwnam #$user))
305 (admin-pubkey #$admin-pubkey)
306 (pubkey-file (string-append
307 #$home "/"
308 (basename
309 (strip-store-file-name admin-pubkey)))))
310
311 (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
312 (copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
313
314 ;; The key must be writable, so copy it from the store
315 (copy-file admin-pubkey pubkey-file)
316
317 (chmod pubkey-file #o500)
318 (chown pubkey-file
319 (passwd:uid user-info)
320 (passwd:gid user-info))
321
322 ;; Set the git configuration, to avoid gitolite trying to use
323 ;; the hostname command, as the network might not be up yet
324 (with-output-to-file #$(string-append home "/.gitconfig")
325 (lambda ()
326 (display "[user]
327 name = GNU Guix
328 email = guix@localhost
329")))
330 ;; Run Gitolite setup, as this updates the hooks and include the
331 ;; admin pubkey if specified. The admin pubkey is required for
332 ;; initial setup, and will replace the previous key if run after
333 ;; initial setup
334 (match (primitive-fork)
335 (0
336 ;; Exit with a non-zero status code if an exception is thrown.
337 (dynamic-wind
338 (const #t)
339 (lambda ()
340 (setenv "HOME" (passwd:dir user-info))
341 (setenv "USER" #$user)
342 (setgid (passwd:gid user-info))
343 (setuid (passwd:uid user-info))
344 (primitive-exit
345 (system* #$(file-append package "/bin/gitolite")
346 "setup"
347 "-m" "gitolite setup by GNU Guix"
348 "-pk" pubkey-file)))
349 (lambda ()
350 (primitive-exit 1))))
351 (pid (waitpid pid)))
352
353 (when (file-exists? pubkey-file)
354 (delete-file pubkey-file)))))))
355
356(define gitolite-service-type
357 (service-type
358 (name 'gitolite)
359 (extensions
360 (list (service-extension activation-service-type
361 gitolite-activation)
362 (service-extension account-service-type
363 gitolite-accounts)
364 (service-extension profile-service-type
365 ;; The Gitolite package in Guix uses
366 ;; gitolite-shell in the authorized_keys file, so
367 ;; gitolite-shell needs to be on the PATH for
368 ;; gitolite to work.
369 (lambda (config)
370 (list
371 (gitolite-configuration-package config))))))
372 (description
373 "Setup @command{gitolite}, a Git hosting tool providing access over SSH..
374By default, the @code{git} user is used, but this is configurable.
375Additionally, Gitolite can integrate with with tools like gitweb or cgit to
376provide a web interface to view selected repositories.")))
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index 4409b8a12b3..3b935a1b485 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -2,7 +2,6 @@
2;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com> 2;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
3;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
4;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> 4;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
5;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
6;;; 5;;;
7;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
8;;; 7;;;
@@ -28,17 +27,14 @@
28 #:use-module (gnu services) 27 #:use-module (gnu services)
29 #:use-module (gnu services version-control) 28 #:use-module (gnu services version-control)
30 #:use-module (gnu services cgit) 29 #:use-module (gnu services cgit)
31 #:use-module (gnu services ssh)
32 #:use-module (gnu services web) 30 #:use-module (gnu services web)
33 #:use-module (gnu services networking) 31 #:use-module (gnu services networking)
34 #:use-module (gnu packages version-control) 32 #:use-module (gnu packages version-control)
35 #:use-module (gnu packages ssh)
36 #:use-module (guix gexp) 33 #:use-module (guix gexp)
37 #:use-module (guix store) 34 #:use-module (guix store)
38 #:use-module (guix modules) 35 #:use-module (guix modules)
39 #:export (%test-cgit 36 #:export (%test-cgit
40 %test-git-http 37 %test-git-http))
41 %test-gitolite))
42 38
43(define README-contents 39(define README-contents
44 "Hello! This is what goes inside the 'README' file.") 40 "Hello! This is what goes inside the 'README' file.")
@@ -304,111 +300,3 @@ HTTP-PORT."
304 (name "git-http") 300 (name "git-http")
305 (description "Connect to a running Git HTTP server.") 301 (description "Connect to a running Git HTTP server.")
306 (value (run-git-http-test)))) 302 (value (run-git-http-test))))
307
308
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
331 (dhcp-client-service)
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))))