[jackhill/guix/guix.git] / gnu / services / version-control.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Nikita <nikita@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.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services version-control)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services web)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages admin)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #: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?

            git-http-configuration
            git-http-configuration?
            git-http-nginx-location-configuration

            <gitolite-configuration>
            gitolite-configuration
            gitolite-configuration-package
            gitolite-configuration-user
            gitolite-configuration-rc-file
            gitolite-configuration-admin-pubkey

            <gitolite-rc-file>
            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:
;;;
;;; Version Control related services.
;;;
;;; Code:

\f
;;;
;;; Git daemon.
;;;

(define-record-type* <git-daemon-configuration>
  git-daemon-configuration
  make-git-daemon-configuration
  git-daemon-configuration?
  (package          git-daemon-configuration-package        ;package
                    (default git))
  (export-all?      git-daemon-configuration-export-all     ;boolean
                    (default #f))
  (base-path        git-daemon-configuration-base-path      ;string | #f
                    (default "/srv/git"))
  (user-path        git-daemon-configuration-user-path      ;string | #f
                    (default #f))
  (listen           git-daemon-configuration-listen         ;list of string
                    (default '()))
  (port             git-daemon-configuration-port           ;number | #f
                    (default #f))
  (whitelist        git-daemon-configuration-whitelist      ;list of string
                    (default '()))
  (extra-options    git-daemon-configuration-extra-options  ;list of string
                    (default '())))

(define git-daemon-shepherd-service
  (match-lambda
    (($ <git-daemon-configuration>
        package export-all? base-path user-path
        listen port whitelist extra-options)
     (let* ((git     (file-append package "/bin/git"))
            (command `(,git
                       "daemon" "--syslog" "--reuseaddr"
                       ,@(if export-all?
                             '("--export-all")
                             '())
                       ,@(if base-path
                             `(,(string-append "--base-path=" base-path))
                             '())
                       ,@(if user-path
                             `(,(string-append "--user-path=" user-path))
                             '())
                       ,@(map (cut string-append "--listen=" <>) listen)
                       ,@(if port
                             `(,(string-append
                                 "--port=" (number->string port)))
                             '())
                       ,@extra-options
                       ,@whitelist)))
       (list (shepherd-service
              (documentation "Run the git-daemon.")
              (requirement '(networking))
              (provision '(git-daemon))
              (start #~(make-forkexec-constructor '#$command
                                                  #:user "git-daemon"
                                                  #:group "git-daemon"))
              (stop #~(make-kill-destructor))))))))

(define %git-daemon-accounts
  ;; User account and group for git-daemon.
  (list (user-group
         (name "git-daemon")
         (system? #t))
        (user-account
         (name "git-daemon")
         (system? #t)
         (group "git-daemon")
         (comment "Git daemon user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define (git-daemon-activation config)
  "Return the activation gexp for git-daemon using CONFIG."
  (let ((base-path (git-daemon-configuration-base-path config)))
    #~(begin
        (use-modules (guix build utils))
        ;; Create the 'base-path' directory when it's not '#f'.
        (and=> #$base-path mkdir-p))))

(define git-daemon-service-type
  (service-type
   (name 'git-daemon)
   (extensions
    (list (service-extension shepherd-root-service-type
                             git-daemon-shepherd-service)
          (service-extension account-service-type
                             (const %git-daemon-accounts))
          (service-extension activation-service-type
                             git-daemon-activation)))
   (description
    "Expose Git repositories over the insecure @code{git://} TCP-based
protocol.")
   (default-value (git-daemon-configuration))))

(define* (git-daemon-service #:key (config (git-daemon-configuration)))
  "Return a service that runs @command{git daemon}, a simple TCP server to
expose repositories over the Git protocol for annoymous access.

The optional @var{config} argument should be a
@code{<git-daemon-configuration>} object, by default it allows read-only
access to exported repositories under @file{/srv/git}."
  (service git-daemon-service-type config))

\f
;;;
;;; HTTP access.  Add the result of calling
;;; git-http-nginx-location-configuration to an nginx-server-configuration's
;;; "locations" field.
;;;

(define-record-type* <git-http-configuration>
  git-http-configuration
  make-git-http-configuration
  git-http-configuration?
  (package          git-http-configuration-package        ;package
                    (default git))
  (git-root         git-http-configuration-git-root       ;string
                    (default "/srv/git"))
  (export-all?      git-http-configuration-export-all?    ;boolean
                    (default #f))
  (uri-path         git-http-configuration-uri-path       ;string
                    (default "/git/"))
  (fcgiwrap-socket  git-http-configuration-fcgiwrap-socket ;string
                    (default "127.0.0.1:9000")))

(define* (git-http-nginx-location-configuration #:optional
                                                (config
                                                 (git-http-configuration)))
  (match config
    (($ <git-http-configuration> package git-root export-all?
                                 uri-path fcgiwrap-socket)
     (nginx-location-configuration
      (uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
      (body
       (list
        (list "fastcgi_pass " fcgiwrap-socket ";")
        (list "fastcgi_param SCRIPT_FILENAME "
              package "/libexec/git-core/git-http-backend"
              ";")
        "fastcgi_param QUERY_STRING $query_string;"
        "fastcgi_param REQUEST_METHOD $request_method;"
        "fastcgi_param CONTENT_TYPE $content_type;"
        "fastcgi_param CONTENT_LENGTH $content_length;"
        (if export-all?
            "fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
            "")
        (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))))
                (rc-file #$(string-append home "/.gitolite.rc")))

           (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
           (copy-file #$rc-file rc-file)
           ;; ensure gitolite's user can read the configuration
           (chown rc-file
                  (passwd:uid user-info)
                  (passwd:gid user-info))

           ;; 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.")))
Commit	Line	Data
e01e2c6c	1	;;; GNU Guix --- Functional package management for GNU
3c986a7d	2	;;; Copyright © 2016 Nikita <nikita@n0.is>
e01e2c6c	3	;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
032a2760	4	;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
8b223cea	5	;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
f8e71068	6	;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
e01e2c6c	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)
032a2760	27	#:use-module (gnu services web)
e01e2c6c	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)
032a2760	33	#:use-module (guix store)
e01e2c6c	34	#:use-module (srfi srfi-1)
e01e2c6c	35	#:use-module (srfi srfi-26)
f8e71068	36	#:use-module (ice-9 format)
e01e2c6c	37	#:use-module (ice-9 match)
	38	#:export (git-daemon-service
	39	git-daemon-service-type
	40	git-daemon-configuration
032a2760 OP	41	git-daemon-configuration?
032a2760 OP	42
41034934 AW	43	git-http-configuration
41034934 AW	44	git-http-configuration?
f8e71068 CB	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))
e01e2c6c	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
a222b734 LC	158	git-daemon-activation)))
a222b734 LC	159	(description
f8df4763	160	"Expose Git repositories over the insecure @code{git://} TCP-based
a222b734 LC	161	protocol.")
a222b734 LC	162	(default-value (git-daemon-configuration))))
e01e2c6c	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))
032a2760 OP	172
032a2760 OP	173	\f
41034934 AW	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;"))))))
f8e71068 CB	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
4e3ed9ba JL	310	(strip-store-file-name admin-pubkey))))
4e3ed9ba JL	311	(rc-file #$(string-append home "/.gitolite.rc")))
f8e71068 CB	312
f8e71068 CB	313	(simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
4e3ed9ba JL	314	(copy-file #$rc-file rc-file)
	315	;; ensure gitolite's user can read the configuration
	316	(chown rc-file
	317	(passwd:uid user-info)
	318	(passwd:gid user-info))
f8e71068 CB	319
	320	;; The key must be writable, so copy it from the store
	321	(copy-file admin-pubkey pubkey-file)
	322
	323	(chmod pubkey-file #o500)
	324	(chown pubkey-file
	325	(passwd:uid user-info)
	326	(passwd:gid user-info))
	327
	328	;; Set the git configuration, to avoid gitolite trying to use
	329	;; the hostname command, as the network might not be up yet
	330	(with-output-to-file #$(string-append home "/.gitconfig")
	331	(lambda ()
	332	(display "[user]
	333	name = GNU Guix
	334	email = guix@localhost
	335	")))
	336	;; Run Gitolite setup, as this updates the hooks and include the
	337	;; admin pubkey if specified. The admin pubkey is required for
	338	;; initial setup, and will replace the previous key if run after
	339	;; initial setup
	340	(match (primitive-fork)
	341	(0
	342	;; Exit with a non-zero status code if an exception is thrown.
	343	(dynamic-wind
	344	(const #t)
	345	(lambda ()
	346	(setenv "HOME" (passwd:dir user-info))
	347	(setenv "USER" #$user)
	348	(setgid (passwd:gid user-info))
	349	(setuid (passwd:uid user-info))
	350	(primitive-exit
	351	(system* #$(file-append package "/bin/gitolite")
	352	"setup"
	353	"-m" "gitolite setup by GNU Guix"
	354	"-pk" pubkey-file)))
	355	(lambda ()
	356	(primitive-exit 1))))
	357	(pid (waitpid pid)))
	358
	359	(when (file-exists? pubkey-file)
	360	(delete-file pubkey-file)))))))
	361
	362	(define gitolite-service-type
	363	(service-type
	364	(name 'gitolite)
	365	(extensions
	366	(list (service-extension activation-service-type
	367	gitolite-activation)
	368	(service-extension account-service-type
	369	gitolite-accounts)
	370	(service-extension profile-service-type
	371	;; The Gitolite package in Guix uses
	372	;; gitolite-shell in the authorized_keys file, so
	373	;; gitolite-shell needs to be on the PATH for
	374	;; gitolite to work.
	375	(lambda (config)
	376	(list
	377	(gitolite-configuration-package config))))))
	378	(description
	379	"Setup @command{gitolite}, a Git hosting tool providing access over SSH..
	380	By default, the @code{git} user is used, but this is configurable.
	381	Additionally, Gitolite can integrate with with tools like gitweb or cgit to
	382	provide a web interface to view selected repositories.")))