summary refs log tree commit diff
path: root/gnu/home/services/mail.scm
blob: 5445c82c67fd28faa351b39c05ccfdc1177ad294 (plain) (blame)
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
215
216
217
218
219
220
221
222
;;; 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 services)
  #:use-module (gnu services configuration)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu packages mail)
  #:use-module (ice-9 string-fun)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (home-msmtp-configuration
            home-msmtp-configuration?
            home-msmtp-configuration-defaults
            home-msmtp-configuration-accounts
            home-msmtp-configuration-default-account
            home-msmtp-configuration-extra-content
            home-msmtp-service-type
            msmtp-configuration
            msmtp-configuration-auth?
            msmtp-configuration-tls?
            msmtp-configuration-tls-starttls?
            msmtp-configuration-tls-trust-file
            msmtp-configuration-log-file
            msmtp-configuration-host
            msmtp-configuration-port
            msmtp-configuration-user
            msmtp-configuration-from
            msmtp-configuration-password-eval
            msmtp-configuration-extra-content
            msmtp-account
            msmtp-account-name
            msmtp-account-configuration))

(define-maybe string (prefix msmtp-configuration-))
(define-maybe boolean (prefix msmtp-configuration-))
(define-maybe integer (prefix msmtp-configuration-))

;; 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 (msmtp-configuration-serialize-boolean field-name value)
  #~(string-append #$(uglify-symbol field-name) " "
                   (if #$value "on" "off") "\n"))

(define (msmtp-configuration-serialize-string field-name value)
  #~(string-append #$(uglify-symbol field-name) " " #$value "\n"))

(define (msmtp-configuration-serialize-maybe-string-no-underscore field-name value)
  #~(if #$(maybe-value-set? value)
      (string-append
        #$(string-replace-substring (uglify-symbol field-name) "_" "") " " #$value "\n")
      ""))

(define (msmtp-configuration-serialize-integer field-name value)
  #~(string-append #$(uglify-symbol field-name) " "
                   (number->string #$value) "\n"))

(define (msmtp-configuration-serialize-extra-content field-name value)
  #~(if (string=? #$value "") "" (string-append #$value "\n")))

(define (msmtp-account-serialize-name field-name value)
  #~(string-append "\naccount " #$value "\n"))

(define (msmtp-account-serialize-msmtp-configuration field-name value)
  #~(string-append #$(serialize-configuration value msmtp-configuration-fields)))

(define (home-msmtp-configuration-serialize-list-of-msmtp-accounts field-name value)
  #~(string-append #$@(map (cut serialize-configuration <> msmtp-account-fields)
                           value)))

(define (home-msmtp-configuration-serialize-msmtp-configuration field-name value)
  #~(string-append "defaults\n"
                   #$(serialize-configuration value msmtp-configuration-fields)))

(define (home-msmtp-configuration-serialize-default-account field-name value)
  #~(if #$(maybe-value-set? value)
      (string-append "\naccount default : " #$value "\n")
      ""))

(define (home-msmtp-configuration-serialize-extra-content field-name value)
  #~(if (string=? #$value "") "" (string-append #$value "\n")))

;; Configuration of 'msmtp'.
;; 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).")

  (log-file
   maybe-string
   "Enable logging to the specified file. An empty argument disables logging.
The file name ‘-’ directs the log information to standard output."
   (serializer msmtp-configuration-serialize-maybe-string-no-underscore))

  (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.")

  (password-eval
    maybe-string
    "Set the password for authentication to the output (stdout) of the command cmd."
    (serializer msmtp-configuration-serialize-maybe-string-no-underscore))

  (extra-content
   (string "")
   "Extra content appended as-is to the configuration block.  Run
@command{man msmtp} for more information about the configuration file
format."
   (serializer msmtp-configuration-serialize-extra-content))

  (prefix msmtp-configuration-))

(define-configuration msmtp-account
  (name
   (string)
   "The unique name of the account."
   (serializer msmtp-account-serialize-name))

  (configuration
   (msmtp-configuration)
   "The configuration for this given account.")

  (prefix msmtp-account-))

(define (list-of-msmtp-accounts? lst)
  (every msmtp-account? lst))

(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-msmtp-configuration-serialize-default-account))

  (extra-content
   (string "")
   "Extra content appended as-is to the configuration file.  Run
@command{man msmtp} for more information about the configuration file
format."
   (serializer home-msmtp-configuration-serialize-extra-content))

  (prefix home-msmtp-configuration-))

(define (home-msmtp-files config)
  (list
   `(".config/msmtp/config"
     ,(mixed-text-file "msmtp-config"
                       (serialize-configuration config home-msmtp-configuration-fields)))))

(define (home-msmtp-profile-entries config)
  (list msmtp))

(define home-msmtp-service-type
  (service-type (name 'home-msmtp)
                (extensions
                 (list (service-extension home-profile-service-type
                                          home-msmtp-profile-entries)
                       (service-extension home-files-service-type
                                          home-msmtp-files)))
                (default-value (home-msmtp-configuration))
                (description "Configure msmtp, a simple
@acronym{SMTP, Simple Mail Transfer Protocol} client that can relay email
to SMTP servers.")))