gnu/services/version-control.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Nils Gillmann <ng0@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 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu services version-control)
  23   #:use-module (gnu services)
  24   #:use-module (gnu services base)
  25   #:use-module (gnu services shepherd)
  26   #:use-module (gnu services web)
  27   #:use-module (gnu system shadow)
  28   #:use-module (gnu packages version-control)
  29   #:use-module (gnu packages admin)
  30   #:use-module (guix records)
  31   #:use-module (guix gexp)
  32   #:use-module (guix store)
  33   #:use-module (srfi srfi-1)
  34   #:use-module (srfi srfi-26)
  35   #:use-module (ice-9 match)
  36   #:export (git-daemon-service
  37             git-daemon-service-type
  38             git-daemon-configuration
  39             git-daemon-configuration?
  40
  41             git-http-configuration
  42             git-http-configuration?
  43             git-http-nginx-location-configuration))
  44
  45 ;;; Commentary:
  46 ;;;
  47 ;;; Version Control related services.
  48 ;;;
  49 ;;; Code:
  50
  51 \f
  52 ;;;
  53 ;;; Git daemon.
  54 ;;;
  55
  56 (define-record-type* <git-daemon-configuration>
  57   git-daemon-configuration
  58   make-git-daemon-configuration
  59   git-daemon-configuration?
  60   (package          git-daemon-configuration-package        ;package
  61                     (default git))
  62   (export-all?      git-daemon-configuration-export-all     ;boolean
  63                     (default #f))
  64   (base-path        git-daemon-configuration-base-path      ;string | #f
  65                     (default "/srv/git"))
  66   (user-path        git-daemon-configuration-user-path      ;string | #f
  67                     (default #f))
  68   (listen           git-daemon-configuration-listen         ;list of string
  69                     (default '()))
  70   (port             git-daemon-configuration-port           ;number | #f
  71                     (default #f))
  72   (whitelist        git-daemon-configuration-whitelist      ;list of string
  73                     (default '()))
  74   (extra-options    git-daemon-configuration-extra-options  ;list of string
  75                     (default '())))
  76
  77 (define git-daemon-shepherd-service
  78   (match-lambda
  79     (($ <git-daemon-configuration>
  80         package export-all? base-path user-path
  81         listen port whitelist extra-options)
  82      (let* ((git     (file-append package "/bin/git"))
  83             (command `(,git
  84                        "daemon" "--syslog" "--reuseaddr"
  85                        ,@(if export-all?
  86                              '("--export-all")
  87                              '())
  88                        ,@(if base-path
  89                              `(,(string-append "--base-path=" base-path))
  90                              '())
  91                        ,@(if user-path
  92                              `(,(string-append "--user-path=" user-path))
  93                              '())
  94                        ,@(map (cut string-append "--listen=" <>) listen)
  95                        ,@(if port
  96                              `(,(string-append
  97                                  "--port=" (number->string port)))
  98                              '())
  99                        ,@extra-options
 100                        ,@whitelist)))
 101        (list (shepherd-service
 102               (documentation "Run the git-daemon.")
 103               (requirement '(networking))
 104               (provision '(git-daemon))
 105               (start #~(make-forkexec-constructor '#$command
 106                                                   #:user "git-daemon"
 107                                                   #:group "git-daemon"))
 108               (stop #~(make-kill-destructor))))))))
 109
 110 (define %git-daemon-accounts
 111   ;; User account and group for git-daemon.
 112   (list (user-group
 113          (name "git-daemon")
 114          (system? #t))
 115         (user-account
 116          (name "git-daemon")
 117          (system? #t)
 118          (group "git-daemon")
 119          (comment "Git daemon user")
 120          (home-directory "/var/empty")
 121          (shell (file-append shadow "/sbin/nologin")))))
 122
 123 (define (git-daemon-activation config)
 124   "Return the activation gexp for git-daemon using CONFIG."
 125   (let ((base-path (git-daemon-configuration-base-path config)))
 126     #~(begin
 127         (use-modules (guix build utils))
 128         ;; Create the 'base-path' directory when it's not '#f'.
 129         (and=> #$base-path mkdir-p))))
 130
 131 (define git-daemon-service-type
 132   (service-type
 133    (name 'git-daemon)
 134    (extensions
 135     (list (service-extension shepherd-root-service-type
 136                              git-daemon-shepherd-service)
 137           (service-extension account-service-type
 138                              (const %git-daemon-accounts))
 139           (service-extension activation-service-type
 140                              git-daemon-activation)))
 141    (description
 142     "Expose Git respositories over the insecure @code{git://} TCP-based
 143 protocol.")
 144    (default-value (git-daemon-configuration))))
 145
 146 (define* (git-daemon-service #:key (config (git-daemon-configuration)))
 147   "Return a service that runs @command{git daemon}, a simple TCP server to
 148 expose repositories over the Git protocol for annoymous access.
 149
 150 The optional @var{config} argument should be a
 151 @code{<git-daemon-configuration>} object, by default it allows read-only
 152 access to exported repositories under @file{/srv/git}."
 153   (service git-daemon-service-type config))
 154
 155 \f
 156 ;;;
 157 ;;; HTTP access.  Add the result of calling
 158 ;;; git-http-nginx-location-configuration to an nginx-server-configuration's
 159 ;;; "locations" field.
 160 ;;;
 161
 162 (define-record-type* <git-http-configuration>
 163   git-http-configuration
 164   make-git-http-configuration
 165   git-http-configuration?
 166   (package          git-http-configuration-package        ;package
 167                     (default git))
 168   (git-root         git-http-configuration-git-root       ;string
 169                     (default "/srv/git"))
 170   (export-all?      git-http-configuration-export-all?    ;boolean
 171                     (default #f))
 172   (uri-path         git-http-configuration-uri-path       ;string
 173                     (default "/git/"))
 174   (fcgiwrap-socket  git-http-configuration-fcgiwrap-socket ;string
 175                     (default "127.0.0.1:9000")))
 176
 177 (define* (git-http-nginx-location-configuration #:optional
 178                                                 (config
 179                                                  (git-http-configuration)))
 180   (match config
 181     (($ <git-http-configuration> package git-root export-all?
 182                                  uri-path fcgiwrap-socket)
 183      (nginx-location-configuration
 184       (uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
 185       (body
 186        (list
 187         (list "fastcgi_pass " fcgiwrap-socket ";")
 188         (list "fastcgi_param SCRIPT_FILENAME "
 189               package "/libexec/git-core/git-http-backend"
 190               ";")
 191         "fastcgi_param QUERY_STRING $query_string;"
 192         "fastcgi_param REQUEST_METHOD $request_method;"
 193         "fastcgi_param CONTENT_TYPE $content_type;"
 194         "fastcgi_param CONTENT_LENGTH $content_length;"
 195         (if export-all?
 196             "fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
 197             "")
 198         (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
 199         "fastcgi_param PATH_INFO $1;"))))))