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
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Tanguy Le Carrour <tanguy@bioneland.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 mail)
#:use-module (guix gexp)
#:use-module (gnu packages)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu home services)
#:use-module (gnu home services shepherd)
#:use-module (ice-9 string-fun)
#:use-module (srfi srfi-26)
#:export (home-msmtp-configuration
home-msmtp-configuration?
home-msmtp-service-type
msmtp-account
msmtp-configuration))
(define raw-configuration-string? string?)
(define-maybe string)
(define-maybe boolean)
(define-maybe integer)
;; Serialization of 'msmtp'.
(define (uglify-symbol field-name)
(let* ((name (symbol->string field-name))
(ugly-name (string-replace-substring name "-" "_")))
(if (string-suffix? "?" ugly-name)
(string-drop-right ugly-name 1)
ugly-name)))
(define (configuration-serialize-maybe-string field-name value)
#~(if #$(maybe-value-set? value)
(string-append #$(uglify-symbol field-name) " " #$value "\n")
""))
(define (configuration-serialize-maybe-integer field-name value)
#~(if #$(maybe-value-set? value)
(string-append #$(uglify-symbol field-name) " " (number->string #$value) "\n")
""))
(define (configuration-serialize-maybe-boolean field-name value)
#~(if #$(maybe-value-set? value)
(string-append #$(uglify-symbol field-name) " " (if #$value "on" "off") "\n")
""))
(define (configuration-serialize-raw-configuration-string field-name value)
#~(if #$(string=? value "") "" (string-append #$value "\n")))
(define (account-serialize-name field-name value)
#~(string-append "\naccount " #$value "\n"))
(define (account-serialize-string field-name value)
#~(string-append " " #$(uglify-symbol field-name) " " #$value "\n"))
(define (account-serialize-string field-name value)
#~(string-append " " #$(uglify-symbol field-name) " " #$value "\n"))
(define (account-serialize-msmtp-configuration field-name value)
; FIXME Begin each line inside an account section with a space.
#~(string-append #$(serialize-configuration value msmtp-configuration-fields)))
(define (home-configuration-serialize-list-of-msmtp-accounts field-name value)
#~(string-append #$@(map (cut serialize-configuration <> msmtp-account-fields)
value)))
(define (home-configuration-serialize-msmtp-configuration field-name value)
#~(string-append "defaults\n"
#$(serialize-configuration value msmtp-configuration-fields)))
(define (home-configuration-serialize-string field-name value)
#~(string-append #$(uglify-symbol field-name) " " #$value "\n"))
(define (home-configuration-serialize-default-account field-name value)
#~(if #$(maybe-value-set? value)
(string-append "\naccount default : " #$value "\n")
""))
(define (home-configuration-serialize-raw-configuration-string field-name value)
#~(if #$(string=? value "") "" (string-append #$value "\n")))
;; Configuration of 'msmtp'.
(define (list-of-msmtp-accounts? lst)
;; FIXME `In procedure every: Wrong type argument: #<syntax-transformer msmtp-account?>`
;(every msmtp-account? lst))
#t)
;; Source <https://marlam.de/msmtp/msmtp.html#Configuration-files>.
(define-configuration msmtp-configuration
(auth?
maybe-boolean
"Enable or disable authentication.")
(tls?
maybe-boolean
"Enable or disable TLS (also known as SSL) for secured connections.")
(tls-starttls
maybe-boolean
"Choose the TLS variant: start TLS from within the session (‘on’, default),
or tunnel the session through TLS (‘off’).")
(tls-trust-file
maybe-string
"Activate server certificate verification using a list of
trusted Certification Authorities (CAs).")
(logfile
maybe-string
"Enable logging to the specified file. An empty argument disables logging.
The file name ‘-’ directs the log information to standard output.")
(host
maybe-string
"The SMTP server to send the mail to.")
(port
maybe-integer
"The port that the SMTP server listens on. The default is 25 (\"smtp\"),
unless TLS without STARTTLS is used, in which case it is 465 (\"smtps\").")
(user
maybe-string
"Set the user name for authentication.")
(from
maybe-string
"Set the envelope-from address.")
(passwordeval
maybe-string
"Set the password for authentication to the output (stdout) of the command cmd.")
(extra-content
(raw-configuration-string "")
"Extra content appended as-is to the configuration block. Run
@command{man msmtp} for more information about the configuration file
format.")
(prefix configuration-))
(define-configuration msmtp-account
(name
(string)
"The unique name of the account."
(serializer account-serialize-name))
(configuration
(msmtp-configuration)
"The configuration for this given account.")
(prefix account-))
(define-configuration home-msmtp-configuration
(defaults
(msmtp-configuration (msmtp-configuration))
"The configuration that will be set as default for all accounts.")
(accounts
(list-of-msmtp-accounts '())
"A list of @code{msmtp-account} records which contain
information about all your accounts.")
(default-account
maybe-string
"Set the default account."
(serializer home-configuration-serialize-default-account))
(extra-content
(raw-configuration-string "")
"Extra content appended as-is to the configuration file. Run
@command{man msmtp} for more information about the configuration file
format.")
(prefix home-configuration-))
(define (home-msmtp-files-service config)
(list
`(".config/msmtp/config"
,(mixed-text-file "config"
(serialize-configuration config home-msmtp-configuration-fields)))))
(define (home-msmtp-profile-service config)
(specifications->packages (list "msmtp")))
(define home-msmtp-service-type
(service-type (name 'home-msmtp)
(extensions
(list
(service-extension
home-profile-service-type
home-msmtp-profile-service)
(service-extension
home-files-service-type
home-msmtp-files-service)))
(default-value (home-msmtp-configuration))
(description "Configures msmtp.")))
|