blob: f5c3536788d4179d5589879bd56b12b8842aed5e (
plain)
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
|
(define-module (jd features mail)
#:use-module (rde packages)
#:use-module (rde exceptions)
#:use-module (rde features)
#:use-module (rde predicates)
#:use-module (rde features emacs)
#:use-module (rde features mail)
#:use-module ((rde features mail providers) #:prefix mail-providers:)
#:use-module (gnu packages mail)
#:use-module (gnu packages emacs-xyz)
#:use-module (rde packages emacs-xyz)
#:use-module (rde packages mail)
#:use-module (rde serializers elisp)
#:use-module (rde home services mail)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu home services)
#:use-module (gnu home-services mail)
#:use-module (gnu home services mcron)
#:use-module (gnu home-services version-control)
#:use-module (gnu home services xdg)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (guix gexp)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:export (feature-l2md* feature-mail-mcron))
(define* (feature-l2md*
#:key
(l2md l2md))
"Configure l2md MDA."
(ensure-pred file-like? l2md)
(define (get-home-services config)
(require-value 'mail-directory-fn config)
(require-value 'mailing-lists config)
(define mail-dir ((get-value 'mail-directory-fn config) config))
(define mls (filter (lambda (x) (eq? (mailing-list-synchronizer x) 'l2md))
(get-value 'mailing-lists config)))
(define (get-repo-config ml)
(let ((repo-config (mailing-list-config ml)))
(if (eq? %unset-value (l2md-repo-maildir repo-config))
(l2md-repo
(inherit repo-config)
(maildir (string-append
mail-dir "/lists/" (mailing-list-fqda ml) "/archive")))
repo-config)))
;; <https://git.kernel.org/pub/scm/linux/kernel/git/dborkman/l2md.git/about/>
;; Applying patches <https://git.kyleam.com/piem/about/>
(define add-ml-tag
(map (lambda (x)
(format
#f "notmuch tag +~a -- path:lists/~a/**"
;; TODO: Use new tag not to retag already existing entities.
;; Do it before new tag will be romved
;; TODO: Fix order of items in post-new hook
(mailing-list-id x) (mailing-list-fqda x)))
mls))
(list
(simple-service
'l2md-add-tags-to-mailing-list
home-notmuch-service-type
(home-notmuch-extension
(post-new
(list
#~(begin (for-each system '#$add-ml-tag))))))
(service
home-l2md-service-type
(home-l2md-configuration
(l2md l2md)
(oneshot 1)
(repos (map get-repo-config mls))))))
(feature
(name 'l2md)
(home-services-getter get-home-services)
(values `((l2md . ,l2md)))))
(define* (feature-mail-mcron
#:key
(time-spec '(next-minute
(range 0 60 20))))
"Configure mcron to invoke other email commands based on the other
features that have been enabled."
(define (get-home-services config)
(list
(when (get-value 'isync config)
(let* ((sync-cmd (list `(,((get-value 'mbsync config) config) "-a")))
(notmuch-cmd (if (get-value 'notmuch config)
(list `(,(file-append (get-value 'notmuch config) "/bin/notmuch")
"new"))
(list)))
(l2md-cmd (if (get-value 'l2md config)
(list `(,(file-append (get-value 'l2md config) "/bin/l2md")))
(list))))
(simple-service
'isync-mcron-job
home-mcron-service-type
(list
#~(job '#$time-spec
(lambda ()
(setenv "DISPLAY" ":0")
#$@(map (lambda (x) `(system* ,@x))
(append sync-cmd l2md-cmd notmuch-cmd))))))))))
(feature
(name 'mail-mcron)
(home-services-getter get-home-services)))
|
