From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:42034) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1evreP-0002Yd-O7 for guix-patches@gnu.org; Tue, 13 Mar 2018 17:40:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1evreN-0004i6-CZ for guix-patches@gnu.org; Tue, 13 Mar 2018 17:40:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:52154) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1evreN-0004hv-7Y for guix-patches@gnu.org; Tue, 13 Mar 2018 17:40:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1evreM-0008EW-UL for guix-patches@gnu.org; Tue, 13 Mar 2018 17:40:02 -0400 Subject: [bug#30809] [PATCH 1/2] services: Add gitolite. References: <87woyfzmir.fsf@cbaines.net> In-Reply-To: <87woyfzmir.fsf@cbaines.net> Resent-Message-ID: From: Christopher Baines Date: Tue, 13 Mar 2018 21:39:32 +0000 Message-Id: <20180313213933.11268-1-mail@cbaines.net> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 30809@debbugs.gnu.org --- gnu/services/version-control.scm | 158 ++++++++++++++++++++++++++++++++++++++- gnu/tests/version-control.scm | 103 ++++++++++++++++++++++++- 2 files changed, 259 insertions(+), 2 deletions(-) diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index afead87ec..60c3f8b81 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -40,7 +40,23 @@ git-http-configuration git-http-configuration? - git-http-nginx-location-configuration)) + git-http-nginx-location-configuration + + + gitolite-configuration + gitolite-configuration-package + gitolite-configuration-user + gitolite-configuration-rc-file + gitolite-configuration-admin-pubkey + + + gitolite-rc-file + gitolite-rc-file-umask + gitolite-rc-file-git-config-keys + gitolite-rc-file-roles + gitolite-rc-file-enable + + gitolite-service-type)) ;;; Commentary: ;;; @@ -197,3 +213,143 @@ access to exported repositories under @file{/srv/git}." "") (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";") "fastcgi_param PATH_INFO $1;")))))) + + +;;; +;;; Gitolite +;;; + +(define-record-type* + gitolite-rc-file make-gitolite-rc-file + gitolite-rc-file? + (umask gitolite-rc-file-umask + (default #o0077)) + (git-config-keys gitolite-rc-file-git-config-keys + (default ".*")) + (roles gitolite-rc-file-roles + (default '(("READERS" . 1) + ("WRITERS" . 1)))) + (enable gitolite-rc-file-enable + (default '("help" + "desc" + "info" + "perms" + "writable" + "ssh-authkeys" + "git-config" + "daemon" + "gitweb")))) + +(define-gexp-compiler (gitolite-rc-file-compiler + (file ) system target) + (match file + (($ umask git-config-keys roles enable) + (apply text-file* "gitolite.rc" + `("%RC = (\n" + " UMASK => " ,(format #f "~4,'0o" umask) ",\n" + " GIT_CONFIG_KEYS => '" ,git-config-keys "',\n" + " ROLES => {\n" + ,@(map (match-lambda + ((role . value) + (simple-format #f " ~A => ~A,\n" role value))) + roles) + " },\n" + "\n" + " ENABLE => [\n" + ,@(map (lambda (value) + (simple-format #f " '~A',\n" value)) + enable) + " ],\n" + ");\n" + "\n" + "1;\n"))))) + +(define-record-type* + 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) + (system? #t) + (comment "Gitolite daemon user") + (home-directory "/var/lib/gitolite"))))) + +(define gitolite-setup + (match-lambda + (($ package user rc-file admin-pubkey) + #~(begin + (use-modules (ice-9 match) + (guix build utils)) + (if (not (file-exists? "/var/lib/gitolite/.gitolite")) + (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 = guix@localhost +"))) + + (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"))))))) + +(define (gitolite-activation config) + (if (gitolite-configuration-admin-pubkey config) + (gitolite-setup config) + #~(display + "guix: Skipping gitolite setup as the admin-pubkey has not been provided\n"))) + +(define gitolite-service-type + (service-type + (name 'gitolite) + (extensions + (list (service-extension activation-service-type + gitolite-activation) + (service-extension account-service-type + gitolite-accounts))) + (default-value (gitolite-configuration)) + (description + ""))) diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index 802473973..c6dc0457c 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.") @@ -306,3 +309,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))) + #~(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 %gitolite-os + (simple-operating-system + (dhcp-client-service) + (service openssh-service-type) + (service gitolite-service-type + (gitolite-configuration + (admin-pubkey + (file-append %gitolite-test-admin-keypair "/id_rsa.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-eq "service running" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'ssh-daemon) + 'running!) + 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 "/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://git@localhost: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 "Connect to a running Git HTTP server.") + (value (run-gitolite-test)))) -- 2.16.2