projects/guix·blob python-team · refs

528 lines · 17.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2023 Tanguy Le Carrour <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (gnu home services mail)
20 #:use-module (guix records)
21 #:use-module (guix gexp)
22 #:use-module (gnu services)
23 #:use-module (gnu services configuration)
24 #:use-module (gnu home services)
25 #:use-module (gnu home services utils)
26 #:use-module (gnu home services shepherd)
27 #:use-module (gnu packages mail)
28 #:use-module (ice-9 match)
29 #:use-module (ice-9 string-fun)
30 #:use-module (srfi srfi-1)
31 #:use-module (srfi srfi-26)
32 #:export (home-msmtp-configuration
33 home-msmtp-configuration?
34 home-msmtp-configuration-defaults
35 home-msmtp-configuration-accounts
36 home-msmtp-configuration-default-account
37 home-msmtp-configuration-extra-content
38 home-msmtp-service-type
39 msmtp-configuration
40 msmtp-configuration-auth?
41 msmtp-configuration-tls?
42 msmtp-configuration-tls-starttls?
43 msmtp-configuration-tls-trust-file
44 msmtp-configuration-log-file
45 msmtp-configuration-host
46 msmtp-configuration-port
47 msmtp-configuration-user
48 msmtp-configuration-from
49 msmtp-configuration-password-eval
50 msmtp-configuration-extra-content
51 msmtp-account
52 msmtp-account-name
53 msmtp-account-configuration
54
55 goimapnotify-tls-options-configuration
56 goimapnotify-tls-options-configuration?
57 goimapnotify-tls-options-configuration-reject-unauthorized?
58 goimapnotify-tls-options-configuration-starttls?
59 goimapnotify-box-configuration
60 goimapnotify-box-configuration?
61 goimapnotify-box-configuration-mailbox
62 goimapnotify-box-configuration-on-new-mail
63 goimapnotify-box-configuration-on-new-mail-post
64 goimapnotify-box-configuration-on-changed-mail
65 goimapnotify-box-configuration-on-changed-mail-post
66 goimapnotify-box-configuration-on-deleted-mail
67 goimapnotify-box-configuration-on-deleted-mail-post
68 goimapnotify-configuration
69 goimapnotify-configuration?
70 goimapnotify-configuration-host
71 goimapnotify-configuration-host-command
72 goimapnotify-configuration-port
73 goimapnotify-configuration-tls?
74 goimapnotify-configuration-tls-options
75 goimapnotify-configuration-idle-logout-timeout
76 goimapnotify-configuration-user-name
77 goimapnotify-configuration-user-name-command
78 goimapnotify-configuration-alias
79 goimapnotify-configuration-password
80 goimapnotify-configuration-password-command
81 goimapnotify-configuration-xo-auth2?
82 goimapnotify-configuration-wait
83 goimapnotify-configuration-boxes
84 home-goimapnotify-configuration
85 home-goimapnotify-configuration?
86 home-goimapnotify-configuration-goimapnotify
87 home-goimapnotify-configuration-configurations
88 home-goimapnotify-service-type))
89
90(define (string-or-gexp? obj)
91 (or (string? obj)
92 (gexp? obj)))
93
94(define-maybe string (prefix msmtp-configuration-))
95(define-maybe boolean (prefix msmtp-configuration-))
96(define-maybe integer (prefix msmtp-configuration-))
97(define-maybe string-or-gexp (prefix msmtp-configuration-))
98
99;; Serialization of 'msmtp'.
100(define (uglify-symbol field-name)
101 (let* ((name (symbol->string field-name))
102 (ugly-name (string-replace-substring name "-" "_")))
103 (if (string-suffix? "?" ugly-name)
104 (string-drop-right ugly-name 1)
105 ugly-name)))
106
107(define (msmtp-configuration-serialize-boolean field-name value)
108 #~(string-append #$(uglify-symbol field-name) " "
109 (if #$value "on" "off") "\n"))
110
111(define (msmtp-configuration-serialize-string field-name value)
112 #~(string-append #$(uglify-symbol field-name) " " #$value "\n"))
113
114(define msmtp-configuration-serialize-string-or-gexp
115 msmtp-configuration-serialize-string)
116
117(define (msmtp-configuration-serialize-maybe-string-no-underscore field-name value)
118 #~(if #$(maybe-value-set? value)
119 (string-append
120 #$(string-replace-substring (uglify-symbol field-name) "_" "") " " #$value "\n")
121 ""))
122
123(define (msmtp-configuration-serialize-integer field-name value)
124 #~(string-append #$(uglify-symbol field-name) " "
125 (number->string #$value) "\n"))
126
127(define (msmtp-configuration-serialize-extra-content field-name value)
128 #~(if (string=? #$value "") "" (string-append #$value "\n")))
129
130(define (msmtp-account-serialize-name field-name value)
131 #~(string-append "\naccount " #$value "\n"))
132
133(define (msmtp-account-serialize-msmtp-configuration field-name value)
134 #~(string-append #$(serialize-configuration value msmtp-configuration-fields)))
135
136(define (home-msmtp-configuration-serialize-list-of-msmtp-accounts field-name value)
137 #~(string-append #$@(map (cut serialize-configuration <> msmtp-account-fields)
138 value)))
139
140(define (home-msmtp-configuration-serialize-msmtp-configuration field-name value)
141 #~(string-append "defaults\n"
142 #$(serialize-configuration value msmtp-configuration-fields)))
143
144(define (home-msmtp-configuration-serialize-default-account field-name value)
145 #~(if #$(maybe-value-set? value)
146 (string-append "\naccount default : " #$value "\n")
147 ""))
148
149(define (home-msmtp-configuration-serialize-extra-content field-name value)
150 #~(if (string=? #$value "") "" (string-append #$value "\n")))
151
152;; Configuration of 'msmtp'.
153;; Source <https://marlam.de/msmtp/msmtp.html#Configuration-files>.
154(define-configuration msmtp-configuration
155 (auth?
156 maybe-boolean
157 "Enable or disable authentication.")
158
159 (tls?
160 maybe-boolean
161 "Enable or disable TLS (also known as SSL) for secured connections.")
162
163 (tls-starttls?
164 maybe-boolean
165 "Choose the TLS variant: start TLS from within the session (‘on’, default),
166or tunnel the session through TLS (‘off’).")
167
168 (tls-trust-file
169 maybe-string
170 "Activate server certificate verification using a list of
171trusted Certification Authorities (CAs).")
172
173 (log-file
174 maybe-string
175 "Enable logging to the specified file. An empty argument disables logging.
176The file name ‘-’ directs the log information to standard output."
177 (serializer msmtp-configuration-serialize-maybe-string-no-underscore))
178
179 (host
180 maybe-string
181 "The SMTP server to send the mail to.")
182
183 (port
184 maybe-integer
185 "The port that the SMTP server listens on. The default is 25 (\"smtp\"),
186unless TLS without STARTTLS is used, in which case it is 465 (\"smtps\").")
187
188 (user
189 maybe-string
190 "Set the user name for authentication.")
191
192 (from
193 maybe-string
194 "Set the envelope-from address.")
195
196 (password-eval
197 maybe-string-or-gexp
198 "Set the password for authentication to the output (stdout) of the command cmd."
199 (serializer msmtp-configuration-serialize-maybe-string-no-underscore))
200
201 (extra-content
202 (string "")
203 "Extra content appended as-is to the configuration block. Run
204@command{man msmtp} for more information about the configuration file
205format."
206 (serializer msmtp-configuration-serialize-extra-content))
207
208 (prefix msmtp-configuration-))
209
210(define-configuration msmtp-account
211 (name
212 (string)
213 "The unique name of the account."
214 (serializer msmtp-account-serialize-name))
215
216 (configuration
217 (msmtp-configuration)
218 "The configuration for this given account.")
219
220 (prefix msmtp-account-))
221
222(define (list-of-msmtp-accounts? lst)
223 (every msmtp-account? lst))
224
225(define-configuration home-msmtp-configuration
226 (defaults
227 (msmtp-configuration (msmtp-configuration))
228 "The configuration that will be set as default for all accounts.")
229
230 (accounts
231 (list-of-msmtp-accounts '())
232 "A list of @code{msmtp-account} records which contain
233information about all your accounts.")
234
235 (default-account
236 maybe-string
237 "Set the default account."
238 (serializer home-msmtp-configuration-serialize-default-account))
239
240 (extra-content
241 (string "")
242 "Extra content appended as-is to the configuration file. Run
243@command{man msmtp} for more information about the configuration file
244format."
245 (serializer home-msmtp-configuration-serialize-extra-content))
246
247 (prefix home-msmtp-configuration-))
248
249(define (home-msmtp-files config)
250 (list
251 `(".config/msmtp/config"
252 ,(mixed-text-file "msmtp-config"
253 (serialize-configuration config home-msmtp-configuration-fields)))))
254
255(define (home-msmtp-profile-entries config)
256 (list msmtp))
257
258(define home-msmtp-service-type
259 (service-type (name 'home-msmtp)
260 (extensions
261 (list (service-extension home-profile-service-type
262 home-msmtp-profile-entries)
263 (service-extension home-files-service-type
264 home-msmtp-files)))
265 (default-value (home-msmtp-configuration))
266 (description "Configure msmtp, a simple
267@acronym{SMTP, Simple Mail Transfer Protocol} client that can relay email
268to SMTP servers.")))
269
270
271;;; Goimapnotify.
272
273(define (camelize-field-name field-name)
274 (let ((str (object->camel-case-string field-name)))
275 (if (string-suffix? "?" str)
276 (string-drop-right str 1)
277 str)))
278
279(define (goimapnotify-serialize-field field-name val)
280 "The mapping is used to serialize certain FIELD-NAMES specially."
281 (let* ((field-name-mapping '((host-command . hostCmd)
282 (user-name . username)
283 (user-name-command . usernameCmd)
284 (password-command . passwordCmd)))
285 (field-name* (or (assq-ref field-name-mapping field-name)
286 field-name)))
287 #~(format #f "~a: ~s~%"
288 #$(camelize-field-name field-name*)
289 #$val)))
290
291(define (goimapnotify-serialize-boolean field-name val)
292 (goimapnotify-serialize-field field-name (if val ''true ''false)))
293
294(define-configuration goimapnotify-tls-options-configuration
295 (reject-unauthorized?
296 (boolean #f)
297 "Whether to reject unauthorized TLS certificates.")
298
299 (starttls?
300 (boolean #f)
301 "Whether to use STARTTLS.")
302
303 (prefix goimapnotify-))
304
305;; XXX: The 'define-maybe' macros of the MSMTP configuration already define
306;; the maybe types, so we just need to define the extra serializers.
307
308(define (goimapnotify-serialize-string field-name val)
309 (goimapnotify-serialize-field field-name val))
310
311(define (goimapnotify-serialize-maybe-string field-name val)
312 (if (maybe-value-set? val)
313 (goimapnotify-serialize-string field-name val)
314 ""))
315
316(define goimapnotify-serialize-string-or-gexp
317 goimapnotify-serialize-string)
318
319(define (goimapnotify-serialize-maybe-string-or-gexp field-name val)
320 (if (and (maybe-value-set? val)
321 (string-or-gexp? val))
322 (goimapnotify-serialize-string-or-gexp field-name val)
323 ""))
324
325(define-configuration goimapnotify-box-configuration
326 (mailbox
327 string
328 "The mailbox to monitor.")
329
330 (on-new-mail
331 maybe-string-or-gexp
332 "The command to execute when new mail arrives.")
333
334 (on-new-mail-post
335 maybe-string-or-gexp
336 "The command to execute after the new-mail command.")
337
338 (on-changed-mail
339 maybe-string-or-gexp
340 "The command to execute when mail is changed.")
341
342 (on-changed-mail-post
343 maybe-string-or-gexp
344 "The command to execute after the changed-mail command.")
345
346 (on-deleted-mail
347 maybe-string-or-gexp
348 "The command to execute when mail is deleted.")
349
350 (on-deleted-mail-post
351 maybe-string-or-gexp
352 "The command to execute after the deleted-mail command.")
353
354 (prefix goimapnotify-))
355
356(define (goimapnotify-serialize-integer field-name val)
357 (goimapnotify-serialize-field field-name val))
358
359(define (goimapnotify-serialize-maybe-integer field-name val)
360 (if (maybe-value-set? val)
361 (goimapnotify-serialize-integer field-name val)
362 ""))
363
364(define (serialize-goimapnotify-tls-options-configuration field-name val)
365 (let ((serialization (serialize-configuration val goimapnotify-tls-options-configuration-fields)))
366 #~(begin
367 (use-modules (ice-9 format) (ice-9 string-fun))
368 (format #f "~a:
369 ~a~%"
370 '#$(camelize-field-name field-name)
371 (string-replace-substring #$serialization "\n" "\n ")))))
372
373(define-maybe goimapnotify-tls-options-configuration)
374
375(define (list-of-goimapnotify-boxes-configurations? lst)
376 (and (not (null? lst))
377 (every goimapnotify-box-configuration? lst)))
378
379(define (serialize-list-of-goimapnotify-boxes-configurations field-name value)
380 (let ((serializations (cons 'list
381 (map (cut serialize-configuration <>
382 goimapnotify-box-configuration-fields)
383 value))))
384 #~(begin
385 (use-modules (ice-9 format) (ice-9 string-fun))
386 (format #f "~a:
387~{ - ~a~%~}"
388 '#$(camelize-field-name field-name)
389 (map (lambda (s)
390 (string-replace-substring s "\n" "\n "))
391 #$serializations)))))
392
393(define-configuration goimapnotify-configuration
394 (host
395 string
396 "The IMAP server hostname.")
397
398 (host-command
399 maybe-string-or-gexp
400 "The command to retrieve the IMAP server hostname.")
401
402 (port
403 (integer 993)
404 "The port that the IMAP server listens on.")
405
406 (tls?
407 (boolean #f)
408 "Enable or disable TLS.")
409
410 (tls-options
411 maybe-goimapnotify-tls-options-configuration
412 "TLS options for the IMAP connection."
413 (serializer serialize-maybe-goimapnotify-tls-options-configuration))
414
415 (idle-logout-timeout
416 maybe-integer
417 "The idle logout timeout in minutes.")
418
419 (user-name
420 maybe-string
421 "The user-name for authentication.")
422
423 (user-name-command
424 maybe-string-or-gexp
425 "The command to retrieve the user-name.")
426
427 (alias
428 maybe-string
429 "An alias for the account.")
430
431 (password
432 maybe-string
433 "The password for authentication.")
434
435 (password-command
436 maybe-string-or-gexp
437 "The command to retrieve the password.")
438
439 (xo-auth2?
440 (boolean #f)
441 "Enable or disable XOAUTH2 authentication.")
442
443 (wait
444 maybe-integer
445 "The delay in seconds before the mail syncing is triggered.")
446
447 (boxes
448 list-of-goimapnotify-boxes-configurations
449 "The mailboxes to monitor."
450 (serializer serialize-list-of-goimapnotify-boxes-configurations))
451
452 (prefix goimapnotify-))
453
454;; Serialize virtualhosts and components last.
455(define (serialize-goimapnotify-configuration config)
456 (define (boxes? field)
457 (eq? (configuration-field-name field) 'boxes))
458 (let ((rest (filter boxes? goimapnotify-configuration-fields)))
459 #~(string-append #$(serialize-configuration config rest)
460 #$(serialize-list-of-goimapnotify-boxes-configurations
461 'boxes
462 (goimapnotify-configuration-boxes config)))))
463
464(define (list-of-goimapnotify-configurations? lst)
465 (every goimapnotify-configuration? lst))
466
467(define (serialize-list-of-goimapnotify-configurations field-name value)
468 (let ((serializations (cons 'list
469 (map (cut serialize-configuration <>
470 goimapnotify-configuration-fields)
471 value))))
472 #~(begin
473 (use-modules (ice-9 format) (ice-9 string-fun))
474 (format #f "~a:
475~{ - ~a~%~}"
476 '#$(camelize-field-name field-name)
477 (map (lambda (s)
478 (string-replace-substring s "\n" "\n "))
479 #$serializations)))))
480
481(define-configuration home-goimapnotify-configuration
482 (goimapnotify
483 (file-like goimapnotify)
484 "The @code{goimapnotify} package to use."
485 empty-serializer)
486 (configurations
487 (list-of-goimapnotify-configurations)
488 "A list of @code{goimapnotify-configuration} records which contain
489information about all your accounts configurations.")
490 (shepherd-requirement
491 (list-of-symbols '())
492 "A list of services that should be started before this service. For
493example, to make the service start after the gpg-agent service
494(@pxref{GNU Privacy Guard}), one could write the following:
495
496@lisp
497(shepherd-requirement '(gpg-agent))
498@end lisp
499"
500 empty-serializer))
501
502(define (home-goimapnotify-shepherd-service config)
503 (define contents
504 (serialize-configuration config home-goimapnotify-configuration-fields))
505
506 (match-record config <home-goimapnotify-configuration>
507 (goimapnotify configurations shepherd-requirement)
508 (list
509 (shepherd-service
510 (provision '(goimapnotify))
511 (requirement shepherd-requirement)
512 (modules '((shepherd support))) ;for '%user-log-dir'
513 (documentation "Run a goimapnotify process")
514 (start #~(make-forkexec-constructor
515 (list
516 #$(file-append goimapnotify "/bin/goimapnotify")
517 "-conf" #$(mixed-text-file "goimapnotify.yaml" contents))
518 #:log-file
519 (string-append %user-log-dir "/goimapnotify.log")))
520 (stop #~(make-kill-destructor))))))
521
522(define home-goimapnotify-service-type
523 (service-type
524 (name 'home-goimapnotify)
525 (extensions
526 (list (service-extension home-shepherd-service-type
527 home-goimapnotify-shepherd-service)))
528 (description "Configures the @code{goimapnotify} IMAP mailbox notifier.")))