e01e2c6c |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> |
3 | ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. |
6 | ;;; |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
8 | ;;; under the terms of the GNU General Public License as published by |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
10 | ;;; your option) any later version. |
11 | ;;; |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 | ;;; GNU General Public License for more details. |
16 | ;;; |
17 | ;;; You should have received a copy of the GNU General Public License |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
19 | |
20 | (define-module (gnu services version-control) |
21 | #:use-module (gnu services) |
22 | #:use-module (gnu services base) |
23 | #:use-module (gnu services shepherd) |
24 | #:use-module (gnu system shadow) |
25 | #:use-module (gnu packages version-control) |
26 | #:use-module (gnu packages admin) |
27 | #:use-module (guix records) |
28 | #:use-module (guix gexp) |
29 | #:use-module (srfi srfi-1) |
30 | #:use-module (srfi srfi-26) |
31 | #:use-module (ice-9 match) |
32 | #:export (git-daemon-service |
33 | git-daemon-service-type |
34 | git-daemon-configuration |
35 | git-daemon-configuration?)) |
36 | |
37 | ;;; Commentary: |
38 | ;;; |
39 | ;;; Version Control related services. |
40 | ;;; |
41 | ;;; Code: |
42 | |
43 | \f |
44 | ;;; |
45 | ;;; Git daemon. |
46 | ;;; |
47 | |
48 | (define-record-type* <git-daemon-configuration> |
49 | git-daemon-configuration |
50 | make-git-daemon-configuration |
51 | git-daemon-configuration? |
52 | (package git-daemon-configuration-package ;package |
53 | (default git)) |
54 | (export-all? git-daemon-configuration-export-all ;boolean |
55 | (default #f)) |
56 | (base-path git-daemon-configuration-base-path ;string | #f |
57 | (default "/srv/git")) |
58 | (user-path git-daemon-configuration-user-path ;string | #f |
59 | (default #f)) |
60 | (listen git-daemon-configuration-listen ;list of string |
61 | (default '())) |
62 | (port git-daemon-configuration-port ;number | #f |
63 | (default #f)) |
64 | (whitelist git-daemon-configuration-whitelist ;list of string |
65 | (default '())) |
66 | (extra-options git-daemon-configuration-extra-options ;list of string |
67 | (default '()))) |
68 | |
69 | (define git-daemon-shepherd-service |
70 | (match-lambda |
71 | (($ <git-daemon-configuration> |
72 | package export-all? base-path user-path |
73 | listen port whitelist extra-options) |
74 | (let* ((git (file-append package "/bin/git")) |
75 | (command `(,git |
76 | "daemon" "--syslog" "--reuseaddr" |
77 | ,@(if export-all? |
78 | '("--export-all") |
79 | '()) |
80 | ,@(if base-path |
81 | `(,(string-append "--base-path=" base-path)) |
82 | '()) |
83 | ,@(if user-path |
84 | `(,(string-append "--user-path=" user-path)) |
85 | '()) |
86 | ,@(map (cut string-append "--listen=" <>) listen) |
87 | ,@(if port |
88 | `(,(string-append |
89 | "--port=" (number->string port))) |
90 | '()) |
91 | ,@extra-options |
92 | ,@whitelist))) |
93 | (list (shepherd-service |
94 | (documentation "Run the git-daemon.") |
95 | (requirement '(networking)) |
96 | (provision '(git-daemon)) |
97 | (start #~(make-forkexec-constructor '#$command |
98 | #:user "git-daemon" |
99 | #:group "git-daemon")) |
100 | (stop #~(make-kill-destructor)))))))) |
101 | |
102 | (define %git-daemon-accounts |
103 | ;; User account and group for git-daemon. |
104 | (list (user-group |
105 | (name "git-daemon") |
106 | (system? #t)) |
107 | (user-account |
108 | (name "git-daemon") |
109 | (system? #t) |
110 | (group "git-daemon") |
111 | (comment "Git daemon user") |
112 | (home-directory "/var/empty") |
113 | (shell (file-append shadow "/sbin/nologin"))))) |
114 | |
115 | (define (git-daemon-activation config) |
116 | "Return the activation gexp for git-daemon using CONFIG." |
117 | (let ((base-path (git-daemon-configuration-base-path config))) |
118 | #~(begin |
119 | (use-modules (guix build utils)) |
120 | ;; Create the 'base-path' directory when it's not '#f'. |
121 | (and=> #$base-path mkdir-p)))) |
122 | |
123 | (define git-daemon-service-type |
124 | (service-type |
125 | (name 'git-daemon) |
126 | (extensions |
127 | (list (service-extension shepherd-root-service-type |
128 | git-daemon-shepherd-service) |
129 | (service-extension account-service-type |
130 | (const %git-daemon-accounts)) |
131 | (service-extension activation-service-type |
132 | git-daemon-activation))))) |
133 | |
134 | (define* (git-daemon-service #:key (config (git-daemon-configuration))) |
135 | "Return a service that runs @command{git daemon}, a simple TCP server to |
136 | expose repositories over the Git protocol for annoymous access. |
137 | |
138 | The optional @var{config} argument should be a |
139 | @code{<git-daemon-configuration>} object, by default it allows read-only |
140 | access to exported repositories under @file{/srv/git}." |
141 | (service git-daemon-service-type config)) |