aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/version-control.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/version-control.scm')
-rw-r--r--gnu/services/version-control.scm40
1 files changed, 21 insertions, 19 deletions
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 2afdf4a29f..1a4adf28c8 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -303,7 +303,8 @@ access to exported repositories under @file{/srv/git}."
#$home "/"
(basename
(strip-store-file-name admin-pubkey)))))
- (use-modules (guix build utils))
+ (use-modules (ice-9 match)
+ (guix build utils))
(simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
(copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
@@ -328,24 +329,25 @@ access to exported repositories under @file{/srv/git}."
;; admin pubkey if specified. The admin pubkey is required for
;; initial setup, and will replace the previous key if run after
;; initial setup
- (let ((pid (primitive-fork)))
- (if (eq? pid 0)
- ;; Exit with a non-zero status code if an exception is thrown.
- (dynamic-wind
- (const #t)
- (lambda ()
- (setenv "HOME" (passwd:dir user-info))
- (setenv "USER" #$user)
- (setgid (passwd:gid user-info))
- (setuid (passwd:uid user-info))
- (primitive-exit
- (system* #$(file-append package "/bin/gitolite")
- "setup"
- "-m" "gitolite setup by GNU Guix"
- "-pk" pubkey-file)))
- (lambda ()
- (primitive-exit 1)))
- (waitpid pid)))
+ (match (peek "FORK" (primitive-fork))
+ (0
+ ;; Exit with a non-zero status code if an exception is thrown.
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setenv "HOME" (passwd:dir user-info))
+ (setenv "USER" #$user)
+ (setgid (passwd:gid user-info))
+ (setuid (passwd:uid user-info))
+ (peek "PID SHOULD BE 0")
+ (primitive-exit
+ (system* #$(file-append package "/bin/gitolite")
+ "setup"
+ "-m" "gitolite setup by GNU Guix"
+ "-pk" pubkey-file)))
+ (lambda ()
+ (primitive-exit 1))))
+ (pid (waitpid (peek "WAITING FOR PID ->" pid))))
(when (file-exists? pubkey-file)
(delete-file pubkey-file))))))