gnu/services/version-control.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Nikita <nikita@n0.is>
   3 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
   4 ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
   5 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   6 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu services version-control)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services base)
  26   #:use-module (gnu services shepherd)
  27   #:use-module (gnu services web)
  28   #:use-module (gnu system shadow)
  29   #:use-module (gnu packages version-control)
  30   #:use-module (gnu packages admin)
  31   #:use-module (guix records)
  32   #:use-module (guix gexp)
  33   #:use-module (guix store)
  34   #:use-module (srfi srfi-1)
  35   #:use-module (srfi srfi-26)
  36   #:use-module (ice-9 format)
  37   #:use-module (ice-9 match)
  38   #:export (git-daemon-service
  39             git-daemon-service-type
  40             git-daemon-configuration
  41             git-daemon-configuration?
  42
  43             git-http-configuration
  44             git-http-configuration?
  45             git-http-nginx-location-configuration
  46
  47             <gitolite-configuration>
  48             gitolite-configuration
  49             gitolite-configuration-package
  50             gitolite-configuration-user
  51             gitolite-configuration-rc-file
  52             gitolite-configuration-admin-pubkey
  53
  54             <gitolite-rc-file>
  55             gitolite-rc-file
  56             gitolite-rc-file-umask
  57             gitolite-rc-file-git-config-keys
  58             gitolite-rc-file-roles
  59             gitolite-rc-file-enable
  60
  61             gitolite-service-type))
  62
  63 ;;; Commentary:
  64 ;;;
  65 ;;; Version Control related services.
  66 ;;;
  67 ;;; Code:
  68
  69 \f
  70 ;;;
  71 ;;; Git daemon.
  72 ;;;
  73
  74 (define-record-type* <git-daemon-configuration>
  75   git-daemon-configuration
  76   make-git-daemon-configuration
  77   git-daemon-configuration?
  78   (package          git-daemon-configuration-package        ;package
  79                     (default git))
  80   (export-all?      git-daemon-configuration-export-all     ;boolean
  81                     (default #f))
  82   (base-path        git-daemon-configuration-base-path      ;string | #f
  83                     (default "/srv/git"))
  84   (user-path        git-daemon-configuration-user-path      ;string | #f
  85                     (default #f))
  86   (listen           git-daemon-configuration-listen         ;list of string
  87                     (default '()))
  88   (port             git-daemon-configuration-port           ;number | #f
  89                     (default #f))
  90   (whitelist        git-daemon-configuration-whitelist      ;list of string
  91                     (default '()))
  92   (extra-options    git-daemon-configuration-extra-options  ;list of string
  93                     (default '())))
  94
  95 (define git-daemon-shepherd-service
  96   (match-lambda
  97     (($ <git-daemon-configuration>
  98         package export-all? base-path user-path
  99         listen port whitelist extra-options)
 100      (let* ((git     (file-append package "/bin/git"))
 101             (command `(,git
 102                        "daemon" "--syslog" "--reuseaddr"
 103                        ,@(if export-all?
 104                              '("--export-all")
 105                              '())
 106                        ,@(if base-path
 107                              `(,(string-append "--base-path=" base-path))
 108                              '())
 109                        ,@(if user-path
 110                              `(,(string-append "--user-path=" user-path))
 111                              '())
 112                        ,@(map (cut string-append "--listen=" <>) listen)
 113                        ,@(if port
 114                              `(,(string-append
 115                                  "--port=" (number->string port)))
 116                              '())
 117                        ,@extra-options
 118                        ,@whitelist)))
 119        (list (shepherd-service
 120               (documentation "Run the git-daemon.")
 121               (requirement '(networking))
 122               (provision '(git-daemon))
 123               (start #~(make-forkexec-constructor '#$command
 124                                                   #:user "git-daemon"
 125                                                   #:group "git-daemon"))
 126               (stop #~(make-kill-destructor))))))))
 127
 128 (define %git-daemon-accounts
 129   ;; User account and group for git-daemon.
 130   (list (user-group
 131          (name "git-daemon")
 132          (system? #t))
 133         (user-account
 134          (name "git-daemon")
 135          (system? #t)
 136          (group "git-daemon")
 137          (comment "Git daemon user")
 138          (home-directory "/var/empty")
 139          (shell (file-append shadow "/sbin/nologin")))))
 140
 141 (define (git-daemon-activation config)
 142   "Return the activation gexp for git-daemon using CONFIG."
 143   (let ((base-path (git-daemon-configuration-base-path config)))
 144     #~(begin
 145         (use-modules (guix build utils))
 146         ;; Create the 'base-path' directory when it's not '#f'.
 147         (and=> #$base-path mkdir-p))))
 148
 149 (define git-daemon-service-type
 150   (service-type
 151    (name 'git-daemon)
 152    (extensions
 153     (list (service-extension shepherd-root-service-type
 154                              git-daemon-shepherd-service)
 155           (service-extension account-service-type
 156                              (const %git-daemon-accounts))
 157           (service-extension activation-service-type
 158                              git-daemon-activation)))
 159    (description
 160     "Expose Git repositories over the insecure @code{git://} TCP-based
 161 protocol.")
 162    (default-value (git-daemon-configuration))))
 163
 164 (define* (git-daemon-service #:key (config (git-daemon-configuration)))
 165   "Return a service that runs @command{git daemon}, a simple TCP server to
 166 expose repositories over the Git protocol for annoymous access.
 167
 168 The optional @var{config} argument should be a
 169 @code{<git-daemon-configuration>} object, by default it allows read-only
 170 access to exported repositories under @file{/srv/git}."
 171   (service git-daemon-service-type config))
 172
 173 \f
 174 ;;;
 175 ;;; HTTP access.  Add the result of calling
 176 ;;; git-http-nginx-location-configuration to an nginx-server-configuration's
 177 ;;; "locations" field.
 178 ;;;
 179
 180 (define-record-type* <git-http-configuration>
 181   git-http-configuration
 182   make-git-http-configuration
 183   git-http-configuration?
 184   (package          git-http-configuration-package        ;package
 185                     (default git))
 186   (git-root         git-http-configuration-git-root       ;string
 187                     (default "/srv/git"))
 188   (export-all?      git-http-configuration-export-all?    ;boolean
 189                     (default #f))
 190   (uri-path         git-http-configuration-uri-path       ;string
 191                     (default "/git/"))
 192   (fcgiwrap-socket  git-http-configuration-fcgiwrap-socket ;string
 193                     (default "127.0.0.1:9000")))
 194
 195 (define* (git-http-nginx-location-configuration #:optional
 196                                                 (config
 197                                                  (git-http-configuration)))
 198   (match config
 199     (($ <git-http-configuration> package git-root export-all?
 200                                  uri-path fcgiwrap-socket)
 201      (nginx-location-configuration
 202       (uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
 203       (body
 204        (list
 205         (list "fastcgi_pass " fcgiwrap-socket ";")
 206         (list "fastcgi_param SCRIPT_FILENAME "
 207               package "/libexec/git-core/git-http-backend"
 208               ";")
 209         "fastcgi_param QUERY_STRING $query_string;"
 210         "fastcgi_param REQUEST_METHOD $request_method;"
 211         "fastcgi_param CONTENT_TYPE $content_type;"
 212         "fastcgi_param CONTENT_LENGTH $content_length;"
 213         (if export-all?
 214             "fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
 215             "")
 216         (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
 217         "fastcgi_param PATH_INFO $1;"))))))
 218
 219 \f
 220 ;;;
 221 ;;; Gitolite
 222 ;;;
 223
 224 (define-record-type* <gitolite-rc-file>
 225   gitolite-rc-file make-gitolite-rc-file
 226   gitolite-rc-file?
 227   (umask           gitolite-rc-file-umask
 228                    (default #o0077))
 229   (git-config-keys gitolite-rc-file-git-config-keys
 230                    (default ""))
 231   (roles           gitolite-rc-file-roles
 232                    (default '(("READERS" . 1)
 233                               ("WRITERS" . 1))))
 234   (enable          gitolite-rc-file-enable
 235                    (default '("help"
 236                               "desc"
 237                               "info"
 238                               "perms"
 239                               "writable"
 240                               "ssh-authkeys"
 241                               "git-config"
 242                               "daemon"
 243                               "gitweb"))))
 244
 245 (define-gexp-compiler (gitolite-rc-file-compiler
 246                        (file <gitolite-rc-file>) system target)
 247   (match file
 248     (($ <gitolite-rc-file> umask git-config-keys roles enable)
 249      (apply text-file* "gitolite.rc"
 250       `("%RC = (\n"
 251         "    UMASK => " ,(format #f "~4,'0o" umask) ",\n"
 252         "    GIT_CONFIG_KEYS => '" ,git-config-keys "',\n"
 253         "    ROLES => {\n"
 254         ,@(map (match-lambda
 255                  ((role . value)
 256                   (simple-format #f "        ~A => ~A,\n" role value)))
 257                roles)
 258         "    },\n"
 259         "\n"
 260         "    ENABLE => [\n"
 261         ,@(map (lambda (value)
 262                  (simple-format #f "        '~A',\n" value))
 263                enable)
 264         "    ],\n"
 265         ");\n"
 266         "\n"
 267         "1;\n")))))
 268
 269 (define-record-type* <gitolite-configuration>
 270   gitolite-configuration make-gitolite-configuration
 271   gitolite-configuration?
 272   (package        gitolite-configuration-package
 273                   (default gitolite))
 274   (user           gitolite-configuration-user
 275                   (default "git"))
 276   (group          gitolite-configuration-group
 277                   (default "git"))
 278   (home-directory gitolite-configuration-home-directory
 279                   (default "/var/lib/gitolite"))
 280   (rc-file        gitolite-configuration-rc-file
 281                   (default (gitolite-rc-file)))
 282   (admin-pubkey   gitolite-configuration-admin-pubkey))
 283
 284 (define gitolite-accounts
 285   (match-lambda
 286     (($ <gitolite-configuration> package user group home-directory
 287                                  rc-file admin-pubkey)
 288      ;; User group and account to run Gitolite.
 289      (list (user-group (name user) (system? #t))
 290            (user-account
 291             (name user)
 292             (group group)
 293             (system? #t)
 294             (comment "Gitolite user")
 295             (home-directory home-directory))))))
 296
 297 (define gitolite-activation
 298   (match-lambda
 299     (($ <gitolite-configuration> package user group home
 300                                  rc-file admin-pubkey)
 301      #~(begin
 302          (use-modules (ice-9 match)
 303                       (guix build utils))
 304
 305          (let* ((user-info (getpwnam #$user))
 306                 (admin-pubkey #$admin-pubkey)
 307                 (pubkey-file (string-append
 308                               #$home "/"
 309                               (basename
 310                                (strip-store-file-name admin-pubkey)))))
 311
 312            (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
 313            (copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
 314
 315            ;; The key must be writable, so copy it from the store
 316            (copy-file admin-pubkey pubkey-file)
 317
 318            (chmod pubkey-file #o500)
 319            (chown pubkey-file
 320                   (passwd:uid user-info)
 321                   (passwd:gid user-info))
 322
 323            ;; Set the git configuration, to avoid gitolite trying to use
 324            ;; the hostname command, as the network might not be up yet
 325            (with-output-to-file #$(string-append home "/.gitconfig")
 326              (lambda ()
 327                (display "[user]
 328         name = GNU Guix
 329         email = guix@localhost
 330 ")))
 331            ;; Run Gitolite setup, as this updates the hooks and include the
 332            ;; admin pubkey if specified. The admin pubkey is required for
 333            ;; initial setup, and will replace the previous key if run after
 334            ;; initial setup
 335            (match (primitive-fork)
 336              (0
 337               ;; Exit with a non-zero status code if an exception is thrown.
 338               (dynamic-wind
 339                 (const #t)
 340                 (lambda ()
 341                   (setenv "HOME" (passwd:dir user-info))
 342                   (setenv "USER" #$user)
 343                   (setgid (passwd:gid user-info))
 344                   (setuid (passwd:uid user-info))
 345                   (primitive-exit
 346                    (system* #$(file-append package "/bin/gitolite")
 347                             "setup"
 348                             "-m" "gitolite setup by GNU Guix"
 349                             "-pk" pubkey-file)))
 350                 (lambda ()
 351                   (primitive-exit 1))))
 352              (pid (waitpid pid)))
 353
 354            (when (file-exists? pubkey-file)
 355              (delete-file pubkey-file)))))))
 356
 357 (define gitolite-service-type
 358   (service-type
 359    (name 'gitolite)
 360    (extensions
 361     (list (service-extension activation-service-type
 362                              gitolite-activation)
 363           (service-extension account-service-type
 364                              gitolite-accounts)
 365           (service-extension profile-service-type
 366                              ;; The Gitolite package in Guix uses
 367                              ;; gitolite-shell in the authorized_keys file, so
 368                              ;; gitolite-shell needs to be on the PATH for
 369                              ;; gitolite to work.
 370                              (lambda (config)
 371                                (list
 372                                 (gitolite-configuration-package config))))))
 373    (description
 374     "Setup @command{gitolite}, a Git hosting tool providing access over SSH..
 375 By default, the @code{git} user is used, but this is configurable.
 376 Additionally, Gitolite can integrate with with tools like gitweb or cgit to
 377 provide a web interface to view selected repositories.")))