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 ;;; Copyright © 2021 Julien Lepiller <julien@lepiller.eu>
   8 ;;;
   9 ;;; This file is part of GNU Guix.
  10 ;;;
  11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12 ;;; under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 3 of the License, or (at
  14 ;;; your option) any later version.
  15 ;;;
  16 ;;; GNU Guix is distributed in the hope that it will be useful, but
  17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 (define-module (gnu services version-control)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services base)
  27   #:use-module (gnu services shepherd)
  28   #:use-module (gnu services web)
  29   #:use-module (gnu system shadow)
  30   #:use-module (gnu packages version-control)
  31   #:use-module (gnu packages admin)
  32   #:use-module (guix records)
  33   #:use-module (guix gexp)
  34   #:use-module (guix store)
  35   #:use-module (srfi srfi-1)
  36   #:use-module (srfi srfi-26)
  37   #:use-module (ice-9 format)
  38   #:use-module (ice-9 match)
  39   #:export (git-daemon-service
  40             git-daemon-service-type
  41             git-daemon-configuration
  42             git-daemon-configuration?
  43
  44             git-http-configuration
  45             git-http-configuration?
  46             git-http-nginx-location-configuration
  47
  48             <gitolite-configuration>
  49             gitolite-configuration
  50             gitolite-configuration-package
  51             gitolite-configuration-user
  52             gitolite-configuration-rc-file
  53             gitolite-configuration-admin-pubkey
  54
  55             <gitolite-rc-file>
  56             gitolite-rc-file
  57             gitolite-rc-file-umask
  58             gitolite-rc-file-unsafe-pattern
  59             gitolite-rc-file-git-config-keys
  60             gitolite-rc-file-roles
  61             gitolite-rc-file-enable
  62
  63             gitolite-service-type
  64
  65             gitile-configuration
  66             gitile-configuration-package
  67             gitile-configuration-host
  68             gitile-configuration-port
  69             gitile-configuration-database
  70             gitile-configuration-repositories
  71             gitile-configuration-git-base-url
  72             gitile-configuration-index-title
  73             gitile-configuration-intro
  74             gitile-configuration-footer
  75             gitile-configuration-nginx
  76
  77             gitile-service-type))
  78
  79 ;;; Commentary:
  80 ;;;
  81 ;;; Version Control related services.
  82 ;;;
  83 ;;; Code:
  84
  85 \f
  86 ;;;
  87 ;;; Git daemon.
  88 ;;;
  89
  90 (define-record-type* <git-daemon-configuration>
  91   git-daemon-configuration
  92   make-git-daemon-configuration
  93   git-daemon-configuration?
  94   (package          git-daemon-configuration-package        ;file-like
  95                     (default git))
  96   (export-all?      git-daemon-configuration-export-all     ;boolean
  97                     (default #f))
  98   (base-path        git-daemon-configuration-base-path      ;string | #f
  99                     (default "/srv/git"))
 100   (user-path        git-daemon-configuration-user-path      ;string | #f
 101                     (default #f))
 102   (listen           git-daemon-configuration-listen         ;list of string
 103                     (default '()))
 104   (port             git-daemon-configuration-port           ;number | #f
 105                     (default #f))
 106   (whitelist        git-daemon-configuration-whitelist      ;list of string
 107                     (default '()))
 108   (extra-options    git-daemon-configuration-extra-options  ;list of string
 109                     (default '())))
 110
 111 (define git-daemon-shepherd-service
 112   (match-lambda
 113     (($ <git-daemon-configuration>
 114         package export-all? base-path user-path
 115         listen port whitelist extra-options)
 116      (let* ((git     (file-append package "/bin/git"))
 117             (command `(,git
 118                        "daemon" "--syslog" "--reuseaddr"
 119                        ,@(if export-all?
 120                              '("--export-all")
 121                              '())
 122                        ,@(if base-path
 123                              `(,(string-append "--base-path=" base-path))
 124                              '())
 125                        ,@(if user-path
 126                              `(,(string-append "--user-path=" user-path))
 127                              '())
 128                        ,@(map (cut string-append "--listen=" <>) listen)
 129                        ,@(if port
 130                              `(,(string-append
 131                                  "--port=" (number->string port)))
 132                              '())
 133                        ,@extra-options
 134                        ,@whitelist)))
 135        (list (shepherd-service
 136               (documentation "Run the git-daemon.")
 137               (requirement '(networking))
 138               (provision '(git-daemon))
 139               (start #~(make-forkexec-constructor '#$command
 140                                                   #:user "git-daemon"
 141                                                   #:group "git-daemon"))
 142               (stop #~(make-kill-destructor))))))))
 143
 144 (define %git-daemon-accounts
 145   ;; User account and group for git-daemon.
 146   (list (user-group
 147          (name "git-daemon")
 148          (system? #t))
 149         (user-account
 150          (name "git-daemon")
 151          (system? #t)
 152          (group "git-daemon")
 153          (comment "Git daemon user")
 154          (home-directory "/var/empty")
 155          (shell (file-append shadow "/sbin/nologin")))))
 156
 157 (define (git-daemon-activation config)
 158   "Return the activation gexp for git-daemon using CONFIG."
 159   (let ((base-path (git-daemon-configuration-base-path config)))
 160     #~(begin
 161         (use-modules (guix build utils))
 162         ;; Create the 'base-path' directory when it's not '#f'.
 163         (and=> #$base-path mkdir-p))))
 164
 165 (define git-daemon-service-type
 166   (service-type
 167    (name 'git-daemon)
 168    (extensions
 169     (list (service-extension shepherd-root-service-type
 170                              git-daemon-shepherd-service)
 171           (service-extension account-service-type
 172                              (const %git-daemon-accounts))
 173           (service-extension activation-service-type
 174                              git-daemon-activation)))
 175    (description
 176     "Expose Git repositories over the insecure @code{git://} TCP-based
 177 protocol.")
 178    (default-value (git-daemon-configuration))))
 179
 180 (define* (git-daemon-service #:key (config (git-daemon-configuration)))
 181   "Return a service that runs @command{git daemon}, a simple TCP server to
 182 expose repositories over the Git protocol for anonymous access.
 183
 184 The optional @var{config} argument should be a
 185 @code{<git-daemon-configuration>} object, by default it allows read-only
 186 access to exported repositories under @file{/srv/git}."
 187   (service git-daemon-service-type config))
 188
 189 \f
 190 ;;;
 191 ;;; HTTP access.  Add the result of calling
 192 ;;; git-http-nginx-location-configuration to an nginx-server-configuration's
 193 ;;; "locations" field.
 194 ;;;
 195
 196 (define-record-type* <git-http-configuration>
 197   git-http-configuration
 198   make-git-http-configuration
 199   git-http-configuration?
 200   (package          git-http-configuration-package        ;file-like
 201                     (default git))
 202   (git-root         git-http-configuration-git-root       ;string
 203                     (default "/srv/git"))
 204   (export-all?      git-http-configuration-export-all?    ;boolean
 205                     (default #f))
 206   (uri-path         git-http-configuration-uri-path       ;string
 207                     (default "/git/"))
 208   (fcgiwrap-socket  git-http-configuration-fcgiwrap-socket ;string
 209                     (default "127.0.0.1:9000")))
 210
 211 (define* (git-http-nginx-location-configuration #:optional
 212                                                 (config
 213                                                  (git-http-configuration)))
 214   (match config
 215     (($ <git-http-configuration> package git-root export-all?
 216                                  uri-path fcgiwrap-socket)
 217      (nginx-location-configuration
 218       (uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
 219       (body
 220        (list
 221         (list "fastcgi_pass " fcgiwrap-socket ";")
 222         (list "fastcgi_param SCRIPT_FILENAME "
 223               package "/libexec/git-core/git-http-backend"
 224               ";")
 225         "fastcgi_param QUERY_STRING $query_string;"
 226         "fastcgi_param REQUEST_METHOD $request_method;"
 227         "fastcgi_param CONTENT_TYPE $content_type;"
 228         "fastcgi_param CONTENT_LENGTH $content_length;"
 229         (if export-all?
 230             "fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
 231             "")
 232         (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
 233         "fastcgi_param PATH_INFO $1;"))))))
 234
 235 \f
 236 ;;;
 237 ;;; Gitolite
 238 ;;;
 239
 240 (define-record-type* <gitolite-rc-file>
 241   gitolite-rc-file make-gitolite-rc-file
 242   gitolite-rc-file?
 243   (umask           gitolite-rc-file-umask
 244                    (default #o0077))
 245   (unsafe-pattern  gitolite-rc-file-unsafe-pattern
 246                    (default #f))
 247   (git-config-keys gitolite-rc-file-git-config-keys
 248                    (default ""))
 249   (roles           gitolite-rc-file-roles
 250                    (default '(("READERS" . 1)
 251                               ("WRITERS" . 1))))
 252   (enable          gitolite-rc-file-enable
 253                    (default '("help"
 254                               "desc"
 255                               "info"
 256                               "perms"
 257                               "writable"
 258                               "ssh-authkeys"
 259                               "git-config"
 260                               "daemon"
 261                               "gitweb"))))
 262
 263 (define-gexp-compiler (gitolite-rc-file-compiler
 264                        (file <gitolite-rc-file>) system target)
 265   (match file
 266     (($ <gitolite-rc-file> umask unsafe-pattern git-config-keys roles enable)
 267      (apply text-file* "gitolite.rc"
 268       `("%RC = (\n"
 269         "    UMASK => " ,(format #f "~4,'0o" umask) ",\n"
 270         "    GIT_CONFIG_KEYS => '" ,git-config-keys "',\n"
 271         "    ROLES => {\n"
 272         ,@(map (match-lambda
 273                  ((role . value)
 274                   (simple-format #f "        ~A => ~A,\n" role value)))
 275                roles)
 276         "    },\n"
 277         "\n"
 278         "    ENABLE => [\n"
 279         ,@(map (lambda (value)
 280                  (simple-format #f "        '~A',\n" value))
 281                enable)
 282         "    ],\n"
 283         ");\n"
 284         "\n"
 285         ,(if unsafe-pattern
 286              (string-append "$UNSAFE_PATT = qr(" unsafe-pattern ");")
 287              "")
 288         "1;\n")))))
 289
 290 (define-record-type* <gitolite-configuration>
 291   gitolite-configuration make-gitolite-configuration
 292   gitolite-configuration?
 293   (package        gitolite-configuration-package
 294                   (default gitolite))
 295   (user           gitolite-configuration-user
 296                   (default "git"))
 297   (group          gitolite-configuration-group
 298                   (default "git"))
 299   (home-directory gitolite-configuration-home-directory
 300                   (default "/var/lib/gitolite"))
 301   (rc-file        gitolite-configuration-rc-file
 302                   (default (gitolite-rc-file)))
 303   (admin-pubkey   gitolite-configuration-admin-pubkey))
 304
 305 (define gitolite-accounts
 306   (match-lambda
 307     (($ <gitolite-configuration> package user group home-directory
 308                                  rc-file admin-pubkey)
 309      ;; User group and account to run Gitolite.
 310      (list (user-group (name user) (system? #t))
 311            (user-account
 312             (name user)
 313             (group group)
 314             (system? #t)
 315             (comment "Gitolite user")
 316             (home-directory home-directory))))))
 317
 318 (define gitolite-activation
 319   (match-lambda
 320     (($ <gitolite-configuration> package user group home
 321                                  rc-file admin-pubkey)
 322      #~(begin
 323          (use-modules (ice-9 match)
 324                       (guix build utils))
 325
 326          (let* ((user-info (getpwnam #$user))
 327                 (admin-pubkey #$admin-pubkey)
 328                 (pubkey-file (string-append
 329                               #$home "/"
 330                               (basename
 331                                (strip-store-file-name admin-pubkey))))
 332                 (rc-file #$(string-append home "/.gitolite.rc")))
 333
 334            ;; activate-users+groups in (gnu build activation) sets the
 335            ;; permission flags of home directories to #o700 and mentions that
 336            ;; services needing looser permissions should chmod it during
 337            ;; service activation.  We also want the git group to be able to
 338            ;; read from the gitolite home directory, so a chmod'ing we will
 339            ;; go!
 340            (chmod #$home #o750)
 341
 342            (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
 343            (copy-file #$rc-file rc-file)
 344            ;; ensure gitolite's user can read the configuration
 345            (chown rc-file
 346                   (passwd:uid user-info)
 347                   (passwd:gid user-info))
 348
 349            ;; The key must be writable, so copy it from the store
 350            (copy-file admin-pubkey pubkey-file)
 351
 352            (chmod pubkey-file #o500)
 353            (chown pubkey-file
 354                   (passwd:uid user-info)
 355                   (passwd:gid user-info))
 356
 357            ;; Set the git configuration, to avoid gitolite trying to use
 358            ;; the hostname command, as the network might not be up yet
 359            (with-output-to-file #$(string-append home "/.gitconfig")
 360              (lambda ()
 361                (display "[user]
 362         name = GNU Guix
 363         email = guix@localhost
 364 ")))
 365            ;; Run Gitolite setup, as this updates the hooks and include the
 366            ;; admin pubkey if specified. The admin pubkey is required for
 367            ;; initial setup, and will replace the previous key if run after
 368            ;; initial setup
 369            (match (primitive-fork)
 370              (0
 371               ;; Exit with a non-zero status code if an exception is thrown.
 372               (dynamic-wind
 373                 (const #t)
 374                 (lambda ()
 375                   (setenv "HOME" (passwd:dir user-info))
 376                   (setenv "USER" #$user)
 377                   (setgid (passwd:gid user-info))
 378                   (setuid (passwd:uid user-info))
 379                   (primitive-exit
 380                    (system* #$(file-append package "/bin/gitolite")
 381                             "setup"
 382                             "-m" "gitolite setup by GNU Guix"
 383                             "-pk" pubkey-file)))
 384                 (lambda ()
 385                   (primitive-exit 1))))
 386              (pid (waitpid pid)))
 387
 388            (when (file-exists? pubkey-file)
 389              (delete-file pubkey-file)))))))
 390
 391 (define gitolite-service-type
 392   (service-type
 393    (name 'gitolite)
 394    (extensions
 395     (list (service-extension activation-service-type
 396                              gitolite-activation)
 397           (service-extension account-service-type
 398                              gitolite-accounts)
 399           (service-extension profile-service-type
 400                              ;; The Gitolite package in Guix uses
 401                              ;; gitolite-shell in the authorized_keys file, so
 402                              ;; gitolite-shell needs to be on the PATH for
 403                              ;; gitolite to work.
 404                              (lambda (config)
 405                                (list
 406                                 (gitolite-configuration-package config))))))
 407    (description
 408     "Setup @command{gitolite}, a Git hosting tool providing access over SSH..
 409 By default, the @code{git} user is used, but this is configurable.
 410 Additionally, Gitolite can integrate with with tools like gitweb or cgit to
 411 provide a web interface to view selected repositories.")))
 412
 413 ;;;
 414 ;;; Gitile
 415 ;;;
 416
 417 (define-record-type* <gitile-configuration>
 418   gitile-configuration make-gitile-configuration gitile-configuration?
 419   (package gitile-configuration-package
 420            (default gitile))
 421   (host gitile-configuration-host
 422         (default "127.0.0.1"))
 423   (port gitile-configuration-port
 424         (default 8080))
 425   (database gitile-configuration-database
 426             (default "/var/lib/gitile/gitile-db.sql"))
 427   (repositories gitile-configuration-repositories
 428                 (default "/var/lib/gitolite/repositories"))
 429   (base-git-url gitile-configuration-base-git-url)
 430   (index-title gitile-configuration-index-title
 431                (default "Index"))
 432   (intro gitile-configuration-intro
 433          (default '()))
 434   (footer gitile-configuration-footer
 435           (default '()))
 436   (nginx gitile-configuration-nginx))
 437
 438 (define (gitile-config-file host port database repositories base-git-url
 439                             index-title intro footer)
 440   (define build
 441     #~(write `(config
 442                 (port #$port)
 443                 (host #$host)
 444                 (database #$database)
 445                 (repositories #$repositories)
 446                 (base-git-url #$base-git-url)
 447                 (index-title #$index-title)
 448                 (intro #$intro)
 449                 (footer #$footer))
 450              (open-output-file #$output)))
 451
 452   (computed-file "gitile.conf" build))
 453
 454 (define gitile-nginx-server-block
 455   (match-lambda
 456     (($ <gitile-configuration> package host port database repositories
 457         base-git-url index-title intro footer nginx)
 458      (list (nginx-server-configuration
 459              (inherit nginx)
 460              (locations
 461                (append
 462                  (list
 463                    (nginx-location-configuration
 464                             (uri "/")
 465                             (body
 466                               (list
 467                                 #~(string-append "proxy_pass http://" #$host
 468                                                  ":" (number->string #$port)
 469                                                  "/;")))))
 470                  (map
 471                    (lambda (loc)
 472                      (nginx-location-configuration
 473                        (uri loc)
 474                        (body
 475                          (list
 476                            #~(string-append "root " #$package "/share/gitile/assets;")))))
 477                    '("/css" "/js" "/images"))
 478                  (nginx-server-configuration-locations nginx))))))))
 479
 480 (define gitile-shepherd-service
 481   (match-lambda
 482     (($ <gitile-configuration> package host port database repositories
 483         base-git-url index-title intro footer nginx)
 484      (list (shepherd-service
 485              (provision '(gitile))
 486              (requirement '(loopback))
 487              (documentation "gitile")
 488              (start (let ((gitile (file-append package "/bin/gitile")))
 489                           #~(make-forkexec-constructor
 490                               `(,#$gitile "-c" #$(gitile-config-file
 491                                                    host port database
 492                                                    repositories
 493                                                    base-git-url index-title
 494                                                    intro footer))
 495                               #:user "gitile"
 496                               #:group "git")))
 497              (stop #~(make-kill-destructor)))))))
 498
 499 (define %gitile-accounts
 500   (list (user-group
 501          (name "git")
 502          (system? #t))
 503         (user-account
 504           (name "gitile")
 505           (group "git")
 506           (system? #t)
 507           (comment "Gitile user")
 508           (home-directory "/var/empty")
 509           (shell (file-append shadow "/sbin/nologin")))))
 510
 511 (define gitile-service-type
 512   (service-type
 513     (name 'gitile)
 514     (description "Run Gitile, a small Git forge.  Expose public repositories
 515 on the web.")
 516     (extensions
 517       (list (service-extension account-service-type
 518                                (const %gitile-accounts))
 519             (service-extension shepherd-root-service-type
 520                                gitile-shepherd-service)
 521             (service-extension nginx-service-type
 522                                gitile-nginx-server-block)))))