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