projects/guix·blob dexed · refs

605 lines · 23.2 KiB

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