aboutsummaryrefslogtreecommitdiff
path: root/tw/services/mail.scm
blob: 59cb1bf28740fcb62d5fd6c769d0d4ae8ead8875 (about) (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
(define-module (tw services mail)
  #:use-module (gnu)
  #:use-module ((gnu packages admin) #:select (shadow))
  #:use-module ((gnu packages mail) #:select (nullmailer))
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system privilege)
  #:use-module (guix gexp)
  #:use-module (guix modules)  ; `source-module-closure'
  #:use-module (guix records)
  #:use-module (tw services secrets)
  #:export (mta-configuration
            mta-service-type))

(define-configuration/no-serialization mta-configuration
  (host-name string "The system's host name, which is needed by nullmailer.")
  (user (string "mail") "The UNIX user name to allocate for the MTA.")
  ;; Setuid programs are created before user accounts.  When we first activate
  ;; this service, the "mail" user does not exist and if we try to make
  ;; `privileged-program' use it as a string, it fails.
  (user-id (integer 469) "The user ID of the UNIX user to create.  This ID
must be known in order to install the setuid programs.")
  (group (string "mail") "The UNIX user group to allocate for the MTA."))

(define (mta-accounts config)
  (match-record config <mta-configuration> (user user-id group)
    (list (user-account
           (name user) (group group) (uid user-id) (system? #t)
           (comment "Nullmailer daemon user")
           (home-directory "/var/spool/nullmailer")
           (shell (file-append shadow "/sbin/nologin")))
          (user-group (name group) (system? #t)))))

(define (mta-secrets config)
  (match-record config <mta-configuration> (user group)
    (list (secret (encrypted-file (local-file "files/nullmailer-remotes.enc"))
                  (destination "/etc/nullmailer/remotes")
                  (user user) (group group)))))

(define (mta-setuid-programs config)
  ;; Allow any user to send mail.  This also prevents annoying failures
  ;; when root tries to send mail, since nullmailer-send cannot read the
  ;; messages it puts in the queue with 0600 permissions.
  (match-record config <mta-configuration> (user-id)
    (map (lambda (prog)
           (privileged-program
            (program (file-append nullmailer prog))
            (setuid? #t) (user user-id)))
         '("/sbin/sendmail" "/bin/mailq"))))

(define (mta-shepherd-services config)
  (match-record config <mta-configuration> (user group)
    (list (shepherd-service
           (documentation "Run a basic Mail Transfer Agent.")
           (provision '(nullmailer))
           (start #~(make-forkexec-constructor
                     (list #$(file-append nullmailer "/sbin/nullmailer-send"))
                     #:user #$user #:group #$group))
           (stop #~(make-kill-destructor))))))

;; Ideally we'd use `etc-service-type' here, but that would install
;; /etc/nullmailer as a directory symlink pointing into /gnu/store, which
;; blocks installation of /etc/nullmailer/remotes later.
(define (mta-activation config)
  (match-record config <mta-configuration> (host-name user)
    (with-imported-modules (source-module-closure '((guix build utils)))
      #~(begin
          (use-modules ((srfi srfi-26) #:select (cut))
                       ((guix build utils) #:select (mkdir-p)))
          (define (rm-f path)
            (false-if-exception (delete-file path)))
          (define (mkdir-if-not-exist path)
            (catch 'system-error (lambda () (mkdir path))
              (lambda args
                (or (= EEXIST (system-error-errno args))
                    (apply throw args)))))

          (rm-f "/etc/nullmailer")
          (mkdir-p "/etc/nullmailer")
          (for-each (lambda (source target)
                      (rm-f target)
                      (symlink source target))
                    '(#$(plain-file "nm-me" host-name)
                      #$(plain-file "nm-adminaddr" "timo@twilken.net")
                      #$(plain-file "nm-allmailfrom" "cron@twilken.net"))
                    '("/etc/nullmailer/me"
                      "/etc/nullmailer/adminaddr"
                      "/etc/nullmailer/allmailfrom"))

          ;; Create nullmailer's data directories and socket.
          ;; No idea why it doesn't do this itself.
          (let ((dirs '("/var/spool/nullmailer/queue"
                        "/var/spool/nullmailer/failed"
                        "/var/spool/nullmailer/tmp"))
                (trigger-path "/var/spool/nullmailer/trigger"))
            (for-each mkdir-if-not-exist dirs)
            (unless (file-exists? trigger-path)
              (system* #$(file-append coreutils "/bin/mkfifo") "-m" "600" trigger-path))
            (let ((user (getpw #$user)))
              (for-each (cut chown <> (passwd:uid user) (passwd:gid user))
                        (cons trigger-path dirs))))))))

(define mta-service-type
  (service-type
   (name 'mta)
   (description "Run the Mail Transfer Agent @code{nullmailer}, to forward system emails.")
   (extensions (list (service-extension shepherd-root-service-type mta-shepherd-services)
                     (service-extension privileged-program-service-type mta-setuid-programs)
                     (service-extension account-service-type mta-accounts)
                     (service-extension activation-service-type mta-activation)
                     (service-extension secrets-service-type mta-secrets)))))