Merge remote-tracking branch 'origin/master' into staging
[jackhill/guix/guix.git] / gnu / services / version-control.scm
index 7166ed3..1366992 100644 (file)
@@ -1,8 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
+;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
   #:use-module (guix store)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (git-daemon-service
             git-daemon-service-type
             git-daemon-configuration
             git-daemon-configuration?
 
-            <cgit-configuration-file>
-            cgit-configuration-file
-            cgit-configuration-file?
-            cgit-configuration-file-css
-            cgit-configuration-file-logo
-            cgit-configuration-file-robots
-            cgit-configuration-file-virtual-root
-            cgit-configuration-file-repository-directory
-
-            <cgit-configuration>
-            cgit-configuration
-            cgit-configuration?
-            cgit-configuration-config-file
-            cgit-configuration-package
+            git-http-configuration
+            git-http-configuration?
+            git-http-nginx-location-configuration
 
-            %cgit-configuration-nginx
-            cgit-configuration-nginx-config
+            <gitolite-configuration>
+            gitolite-configuration
+            gitolite-configuration-package
+            gitolite-configuration-user
+            gitolite-configuration-rc-file
+            gitolite-configuration-admin-pubkey
 
-            cgit-service-type
+            <gitolite-rc-file>
+            gitolite-rc-file
+            gitolite-rc-file-umask
+            gitolite-rc-file-git-config-keys
+            gitolite-rc-file-roles
+            gitolite-rc-file-enable
 
-            git-http-configuration
-            git-http-configuration?
-            git-http-nginx-location-configuration))
+            gitolite-service-type))
 
 ;;; Commentary:
 ;;;
@@ -173,107 +171,6 @@ access to exported repositories under @file{/srv/git}."
   (service git-daemon-service-type config))
 
 \f
-;;;
-;;; Cgit
-;;;
-
-(define-record-type* <cgit-configuration-file>
-  cgit-configuration-file
-  make-cgit-configuration-file
-  cgit-configuration-file?
-  (css                  cgit-configuration-file-css                  ; string
-                        (default "/share/cgit/cgit.css"))
-  (logo                 cgit-configuration-file-logo                 ; string
-                        (default "/share/cgit/cgit.png"))
-  (robots               cgit-configuration-file-robots               ; list
-                        (default '("noindex" "nofollow")))
-  (virtual-root         cgit-configuration-file-virtual-root         ; string
-                        (default "/"))
-  (repository-directory cgit-configuration-file-repository-directory ; string
-                        (default "/srv/git")))
-
-(define (cgit-configuration-robots-string robots)
-  (string-join robots ", "))
-
-(define-gexp-compiler (cgit-configuration-file-compiler
-                       (file <cgit-configuration-file>) system target)
-  (match file
-    (($ <cgit-configuration-file> css logo
-                                  robots virtual-root repository-directory)
-     (apply text-file* "cgitrc"
-            (letrec-syntax ((option (syntax-rules ()
-                                      ((_ key value)
-                                       (if value
-                                           `(,key "=" ,value "\n")
-                                           '()))))
-                            (key/value (syntax-rules ()
-                                         ((_ (key value) rest ...)
-                                          (append (option key value)
-                                                  (key/value rest ...)))
-                                         ((_)
-                                          '()))))
-              (key/value ("css" css)
-                         ("logo" logo)
-                         ("robots" (cgit-configuration-robots-string robots))
-                         ("virtual-root" virtual-root)
-                         ("scan-path" repository-directory)))))))
-
-(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 '("80"))
-    (ssl-certificate #f)
-    (ssl-certificate-key #f))))
-
-(define-record-type* <cgit-configuration>
-  cgit-configuration make-cgit-configuration
-  cgit-configuration?
-  (config-file cgit-configuration-config-file
-               (default (cgit-configuration-file)))
-  (package cgit-configuration-package
-           (default cgit))
-  (nginx cgit-configuration-nginx
-         (default %cgit-configuration-nginx)))
-
-(define (cgit-activation config)
-  ;; Cgit compiled with default configuration path
-  #~(begin
-      (use-modules (guix build utils))
-      (mkdir-p "/var/cache/cgit")
-      (copy-file #$(cgit-configuration-config-file config) "/etc/cgitrc")))
-
-(define (cgit-configuration-nginx-config config)
-  (cgit-configuration-nginx config))
-
-(define cgit-service-type
-  (service-type
-   (name 'cgit)
-   (extensions
-    (list (service-extension activation-service-type
-                             cgit-activation)
-          (service-extension nginx-service-type
-                             cgit-configuration-nginx-config)
-
-          ;; Make sure fcgiwrap is instantiated.
-          (service-extension fcgiwrap-service-type
-                             (const #t))))
-   (default-value (cgit-configuration))
-   (description
-    "Run the Cgit web interface, which allows users to browse Git
-repositories.")))
-
-\f
 ;;;
 ;;; HTTP access.  Add the result of calling
 ;;; git-http-nginx-location-configuration to an nginx-server-configuration's
@@ -318,3 +215,163 @@ repositories.")))
             "")
         (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
         "fastcgi_param PATH_INFO $1;"))))))
+
+\f
+;;;
+;;; Gitolite
+;;;
+
+(define-record-type* <gitolite-rc-file>
+  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 <gitolite-rc-file>) system target)
+  (match file
+    (($ <gitolite-rc-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>
+  gitolite-configuration make-gitolite-configuration
+  gitolite-configuration?
+  (package        gitolite-configuration-package
+                  (default gitolite))
+  (user           gitolite-configuration-user
+                  (default "git"))
+  (group          gitolite-configuration-group
+                  (default "git"))
+  (home-directory gitolite-configuration-home-directory
+                  (default "/var/lib/gitolite"))
+  (rc-file        gitolite-configuration-rc-file
+                  (default (gitolite-rc-file)))
+  (admin-pubkey   gitolite-configuration-admin-pubkey))
+
+(define gitolite-accounts
+  (match-lambda
+    (($ <gitolite-configuration> package user group home-directory
+                                 rc-file admin-pubkey)
+     ;; User group and account to run Gitolite.
+     (list (user-group (name user) (system? #t))
+           (user-account
+            (name user)
+            (group group)
+            (system? #t)
+            (comment "Gitolite user")
+            (home-directory home-directory))))))
+
+(define gitolite-activation
+  (match-lambda
+    (($ <gitolite-configuration> package user group home
+                                 rc-file admin-pubkey)
+     #~(begin
+         (use-modules (ice-9 match)
+                      (guix build utils))
+
+         (let* ((user-info (getpwnam #$user))
+                (admin-pubkey #$admin-pubkey)
+                (pubkey-file (string-append
+                              #$home "/"
+                              (basename
+                               (strip-store-file-name admin-pubkey)))))
+
+           (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
+           (copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
+
+           ;; The key must be writable, so copy it from the store
+           (copy-file admin-pubkey pubkey-file)
+
+           (chmod pubkey-file #o500)
+           (chown pubkey-file
+                  (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 #$(string-append home "/.gitconfig")
+             (lambda ()
+               (display "[user]
+        name = GNU Guix
+        email = guix@localhost
+")))
+           ;; Run Gitolite setup, as this updates the hooks and include the
+           ;; admin pubkey if specified. The admin pubkey is required for
+           ;; initial setup, and will replace the previous key if run after
+           ;; initial setup
+           (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"
+                            "-m" "gitolite setup by GNU Guix"
+                            "-pk" pubkey-file)))
+                (lambda ()
+                  (primitive-exit 1))))
+             (pid (waitpid pid)))
+
+           (when (file-exists? pubkey-file)
+             (delete-file pubkey-file)))))))
+
+(define gitolite-service-type
+  (service-type
+   (name 'gitolite)
+   (extensions
+    (list (service-extension activation-service-type
+                             gitolite-activation)
+          (service-extension account-service-type
+                             gitolite-accounts)
+          (service-extension profile-service-type
+                             ;; The Gitolite package in Guix uses
+                             ;; gitolite-shell in the authorized_keys file, so
+                             ;; gitolite-shell needs to be on the PATH for
+                             ;; gitolite to work.
+                             (lambda (config)
+                               (list
+                                (gitolite-configuration-package config))))))
+   (description
+    "Setup @command{gitolite}, a Git hosting tool providing access over SSH..
+By default, the @code{git} user is used, but this is configurable.
+Additionally, Gitolite can integrate with with tools like gitweb or cgit to
+provide a web interface to view selected repositories.")))