[bug#30809] [PATCH 2/2] services: Add Gitolite.

[Clément Lassieur]

Christopher Baines <address@hidden> writes:

> * gnu/services/version-control.scm (<gitolite-configuration>,
> <gitolite-rc-file>): New record types.
> (gitolite-accounts, gitolite-setup, gitolite-activation): New procedures.
> (gitolite-service-type): New variables.
> * gnu/tests/version-control.scm (%gitolite-test-admin-keypair, %gitolite-os,
> %test-gitolite): New variables.
> (run-gitolite-test): New procedure.
> * doc/guix.texi (Version Control): Document the gitolite service.
> ---
>  doc/guix.texi                    |  90 ++++++++++++++++
>  gnu/services/version-control.scm | 169 ++++++++++++++++++++++++++++++-
>  gnu/tests/version-control.scm    | 103 ++++++++++++++++++-
>  3 files changed, 360 insertions(+), 2 deletions(-)

Great :-)

[...]

> address@hidden @code{admin-pubkey} (default: @var{#f})
> +A ``file-like'' object (@pxref{G-Expressions, file-like objects}) used to
> +setup Gitolite.  This can be omitted once Gitolite has successfully been
> +setup.

It looks like almost everything else can be ommited once Gitolite has
successfully been setup :-), I put another comment about it below.

[...]

> +(define-record-type* <gitolite-configuration>
> +  gitolite-configuration make-gitolite-configuration
> +  gitolite-configuration?
> +  (package      gitolite-configuration-package
> +                (default gitolite))
> +  (user         gitolite-configuration-user
> +                (default "git"))
> +  (rc-file      gitolite-configuration-rc-file
> +                (default (gitolite-rc-file)))
> +  (admin-pubkey gitolite-configuration-admin-pubkey
> +                (default #f)))
> +
> +(define (gitolite-accounts config)
> +  (let ((user (gitolite-configuration-user config)))
> +    ;; User group and account to run Gitolite.
> +    (list (user-group (name user) (system? #t))
> +          (user-account
> +           (name user)
> +           (group user)

It would be great to make the group and home directory configurable
too.  I personally use other settings for them.

> +           (system? #t)
> +           (comment "Gitolite user")
> +           (home-directory "/var/lib/gitolite")))))
> +
> +(define gitolite-setup
> +  (match-lambda
> +    (($ <gitolite-configuration> package user rc-file admin-pubkey)
> +     #~(begin
> +         (use-modules (ice-9 match)
> +                      (guix build utils))
> +         (if (not (file-exists? "/var/lib/gitolite/.gitolite"))

'unless', instead of 'if not'.

Also, is there a way to update the config once .gitolite exists?  If the
users update their config, they'd expect the new config to be applied I
guess.  Maybe we could override the symlink in that case.  Would that be
safe?  WDYT?

> +             (let ((user-info (getpwnam #$user)))
> +               (simple-format #t "guix: gitolite: installing ~A\n"
> +                              #$rc-file)
> +               (symlink #$rc-file "/var/lib/gitolite/.gitolite.rc")
> +
> +               ;; The key must be writable, so copy it from the store
> +               (copy-file #$admin-pubkey "/var/lib/gitolite/id_rsa.pub")
> +
> +               (chmod "/var/lib/gitolite/id_rsa.pub" #o500)
> +               (chown "/var/lib/gitolite/id_rsa.pub"
> +                      (passwd:uid user-info)
> +                      (passwd:gid user-info))
> +
> +               ;; Set the git configuration, to avoid gitolite trying to use
> +               ;; the hostname command, as the network might not be up yet
> +               (with-output-to-file "/var/lib/gitolite/.gitconfig"
> +                 (lambda ()
> +                   (display "[user]
> +        name = GNU Guix
> +        email = address@hidden
> +")))
> +
> +               (match (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))
> +                      (primitive-exit
> +                       (system* #$(file-append package "/bin/gitolite")
> +                                "setup"
> +                                "-pk" "/var/lib/gitolite/id_rsa.pub")))
> +                    (lambda ()
> +                      (primitive-exit 1))))
> +                 (pid (waitpid pid)))
> +
> +               (delete-file "/var/lib/gitolite/id_rsa.pub")))))))

[...]

> diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm

Could you add your copyright header for this file?

> index 3b935a1b4..e4cd3fc3f 100644
> --- a/gnu/tests/version-control.scm
> +++ b/gnu/tests/version-control.scm
> @@ -27,14 +27,17 @@
>    #: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-git-http
> +            %test-gitolite))
>  
>  (define README-contents
>    "Hello!  This is what goes inside the 'README' file.")
> @@ -300,3 +303,101 @@ HTTP-PORT."
>     (name "git-http")
>     (description "Connect to a running Git HTTP server.")
>     (value (run-git-http-test))))
> +
> +
> +;;;
> +;;; Gitolite.
> +;;;
> +
> +(define %gitolite-test-admin-keypair
> +  (computed-file
> +   "gitolite-test-admin-keypair"
> +   (with-imported-modules (source-module-closure
> +                            '((guix build utils)))
                              ^
Here indentation is not correct ;-)

> +     #~(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 "/id_rsa")
> +                 "-t" "rsa"
> +                 "-q"
> +                 "-N" "")))))

[...]

> +  (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-eq "service running"
> +            'running!
> +            (marionette-eval
> +             '(begin
> +                (use-modules (gnu services herd))
> +                (start-service 'ssh-daemon)
> +                'running!)
> +             marionette))

Here the test produces a false positive because the return value of
'start-service' isn't used.  It should be

(test-assert ... (start-service ...))

instead.

> +          (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 
> "/id_rsa")
> +                     "-o" "UserKnownHostsFile=/dev/null"
> +                     "-o" "StrictHostKeyChecking=no")))
> +
> +          ;; Make sure we can clone the repo from the host.
> +          (test-eq "clone"
> +            #t
> +            (invoke #$(file-append git "/bin/git")
> +                    "clone" "-v"
> +                    "ssh://address@hidden:2222/gitolite-admin"
> +                    "/tmp/clone"))
> +
> +          (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))))

Also, did you encounter bugs https://bugs.gnu.org/25957 and
https://bugs.gnu.org/30401?  Do you know if they are still here?

Thank you very much!
Clément