1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 宋文武 <iyzsong@member.fsf.org>
;;;
;;; 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 home services git)
#:use-module (gnu home services)
#:use-module (gnu services configuration)
#:use-module (gnu packages version-control)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (home-git-service-type
home-git-configuration))
(define (git-option-value? value)
(or (unspecified? value)
(string? value)
(integer? value)
(boolean? value)))
(define (serialize-git-option-value value)
(cond
((string? value) (with-output-to-string (lambda () (write value))))
((integer? value) (number->string value))
((boolean? value) (if value "true" "false"))))
(define (git-options? options)
"Return #t if OPTIONS is a well-formed sexp for git options."
(define git-variable?
(match-lambda
((key value) (and (symbol? key) (git-option-value? value)))
(_ #f)))
(every
(match-lambda
(((section subsection) variables ..1)
(and (symbol? section)
(string? subsection)
(every git-variable? variables)))
((section variables ..1)
(and (symbol? section)
(every git-variable? variables)))
(_ #f))
options))
(define (serialize-git-options options)
"Return the @command{git-config} text form for OPTIONS."
(define serialize-section
(match-lambda
((section variables ..1)
(with-output-to-string
(lambda ()
(match section
((section subsection)
(simple-format #t "[~a ~s]~%" section subsection))
(_
(simple-format #t "[~a]~%" section)))
(for-each
(match-lambda
((key value)
(simple-format #t "\t~a = ~a~%"
key (serialize-git-option-value value))))
variables))))))
(string-concatenate (map serialize-section options)))
(define-configuration/no-serialization home-git-configuration
(package
(package git)
"The Git package to use.")
(enable-send-email?
(boolean #t)
"Whether to install git email tools from the package's @code{send-email}
output.")
(user.name
(git-option-value *unspecified*)
"The human-readable name used in the author and committer identity when
creating commit or tag objects, or when writing reflogs. If you need the
author or committer to be different, the @code{author.name} or
@code{committer.name} can be set.")
(user.email
(git-option-value *unspecified*)
"The email address used in the author and committer identity when creating
commit or tag objects, or when writing reflogs. If you need the author or
committer to be different, the @code{author.email} or @code{committer.email}
can be set.")
(user.signingKey
(git-option-value *unspecified*)
"If @command{git-tag} or @command{git-commit} is not selecting the key you
want it to automatically when creating a signed tag or commit, you can
override the default selection with this variable. This option is passed
unchanged to gpg’s @code{--local-user} parameter, so you may specify a key
using any method that gpg supports.")
(author.name
(git-option-value *unspecified*)
"The human-readable name used in the author identity when creating commit
or tag objects, or when writing reflogs.")
(author.email
(git-option-value *unspecified*)
"The email address used in the author identity when creating commit or tag
objects, or when writing reflogs.")
(committer.name
(git-option-value *unspecified*)
"The human-readable name used in the committer identity when creating
commit or tag objects, or when writing reflogs.")
(committer.email
(git-option-value *unspecified*)
"The email address used in the author identity when creating commit or tag
objects, or when writing reflogs.")
(commit.gpgSign
(git-option-value *unspecified*)
"A boolean to specify whether all commits should be GPG signed.")
(sendemail.smtpServer
(git-option-value *unspecified*)
"If set, specifies the outgoing SMTP server to
use (e.g. @code{smtp.example.com} or a raw IP address). If unspecified, and if
@var{sendemail.sendmailcmd} is also unspecified, the default is to search for
@command{sendmail} in $PATH if such a program is available, falling back to
@code{localhost} otherwise.")
(sendemail.smtpServerPort
(git-option-value *unspecified*)
"Specifies a port different from the default port (SMTP servers typically
listen to smtp port 25, but may also listen to submission port 587, or the
common SSL smtp port 465); symbolic port names (e.g. @code{submission} instead
of 587) are also accepted.")
(sendemail.smtpUser
(git-option-value *unspecified*)
"Username for SMTP-AUTH. If a username is not specified, then
authentication is not attempted.")
(sendemail.smtpPass
(git-option-value *unspecified*)
"Password for SMTP-AUTH. If not specified, then a password is obtained
using @command{git-credential}.")
(sendemail.smtpEncryption
(git-option-value *unspecified*)
"Specify the encryption to use, either @code{ssl} or @code{tls}. Any other
value reverts to plain SMTP.")
(sendemail.sendmailcmd
(git-option-value *unspecified*)
"Specify a command to run to send the email. The command should be
sendmail-like; specifically, it must support the @code{-i} option. The
command will be executed in the shell if necessary.")
(extra-options
(git-options '())
"Extra configuration options for Git."))
(define (home-git-configuration-final-options config)
(let* ((fields
(filter
(lambda (field)
(eq? (configuration-field-type field) 'git-option-value))
home-git-configuration-fields))
(options
(filter
(match-lambda
((section (key value)) (not (unspecified? value))))
(map (lambda (field)
(let* ((name (configuration-field-name field))
(section+key (map string->symbol
(string-split (symbol->string name) #\.)))
(value ((configuration-field-getter field) config)))
`(,(car section+key) (,(cadr section+key) ,value))))
fields)))
(extra-options (home-git-configuration-extra-options config))
(merge-options (lambda (options) ;merge options by section
(fold
(lambda (e prev)
(match e
((section variables ..1)
(begin
(let ((v (assv-ref prev section)))
(assv-set! prev section
(if v (append v variables)
variables)))))))
'() options))))
(merge-options (append options extra-options))))
(define (home-git-environment-variables config)
(let ((gitconfig (serialize-git-options
(home-git-configuration-final-options config))))
`(("GIT_CONFIG_SYSTEM" . ,(plain-file "gitconfig" gitconfig)))))
(define (home-git-profile config)
(let ((package (home-git-configuration-package config)))
(if (home-git-configuration-enable-send-email? config)
`(,package (,package "send-email"))
`(,package))))
(define home-git-service-type
(service-type (name 'home-git)
(extensions
(list (service-extension
home-environment-variables-service-type
home-git-environment-variables)
(service-extension
home-profile-service-type
home-git-profile)))
(default-value (home-git-configuration))
(description
"Install and configure the Git distributed revision control
system.")))
|