gnu: dovecot: Use standard mkdir-p/perms.

* gnu/services/mail.scm (%dovecot-activation): Use (gnu build utils).
This commit is contained in:
Julien Lepiller 2022-10-15 09:19:38 +02:00
parent 62a3756bd9
commit 853b49c419
No known key found for this signature in database
GPG key ID: 53D457B2D636EE82

View file

@ -35,6 +35,7 @@ (define-module (gnu services mail)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages dav) #:use-module (gnu packages dav)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (guix modules)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -1512,64 +1513,61 @@ (define (%dovecot-activation config)
(lambda () (lambda ()
(serialize-configuration config (serialize-configuration config
dovecot-configuration-fields))))))) dovecot-configuration-fields)))))))
#~(begin (with-imported-modules (source-module-closure '((gnu build activation)))
(use-modules (guix build utils)) #~(begin
(define (mkdir-p/perms directory owner perms) (use-modules (guix build utils) (gnu build activation))
(mkdir-p directory) (define (build-subject parameters)
(chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner)) (string-concatenate
(chmod directory perms)) (map (lambda (pair)
(define (build-subject parameters) (let ((k (car pair)) (v (cdr pair)))
(string-concatenate (define (escape-char str chr)
(map (lambda (pair) (string-join (string-split str chr) (string #\\ chr)))
(let ((k (car pair)) (v (cdr pair))) (string-append "/" k "="
(define (escape-char str chr) (escape-char (escape-char v #\=) #\/))))
(string-join (string-split str chr) (string #\\ chr))) (filter (lambda (pair) (cdr pair)) parameters))))
(string-append "/" k "=" (define* (create-self-signed-certificate-if-absent
(escape-char (escape-char v #\=) #\/)))) #:key private-key public-key (owner (getpwnam "root"))
(filter (lambda (pair) (cdr pair)) parameters)))) (common-name (gethostname))
(define* (create-self-signed-certificate-if-absent (organization-name "Guix")
#:key private-key public-key (owner (getpwnam "root")) (organization-unit-name "Default Self-Signed Certificate")
(common-name (gethostname)) (subject-parameters `(("CN" . ,common-name)
(organization-name "Guix") ("O" . ,organization-name)
(organization-unit-name "Default Self-Signed Certificate") ("OU" . ,organization-unit-name)))
(subject-parameters `(("CN" . ,common-name) (subject (build-subject subject-parameters)))
("O" . ,organization-name) ;; Note that by default, OpenSSL outputs keys in PEM format. This
("OU" . ,organization-unit-name))) ;; is what we want.
(subject (build-subject subject-parameters))) (unless (file-exists? private-key)
;; Note that by default, OpenSSL outputs keys in PEM format. This (cond
;; is what we want. ((zero? (system* (string-append #$openssl "/bin/openssl")
(unless (file-exists? private-key) "genrsa" "-out" private-key "2048"))
(cond (chown private-key (passwd:uid owner) (passwd:gid owner))
((zero? (system* (string-append #$openssl "/bin/openssl") (chmod private-key #o400))
"genrsa" "-out" private-key "2048")) (else
(chown private-key (passwd:uid owner) (passwd:gid owner)) (format (current-error-port)
(chmod private-key #o400)) "Failed to create private key at ~a.\n" private-key))))
(else (unless (file-exists? public-key)
(format (current-error-port) (cond
"Failed to create private key at ~a.\n" private-key)))) ((zero? (system* (string-append #$openssl "/bin/openssl")
(unless (file-exists? public-key) "req" "-new" "-x509" "-key" private-key
(cond "-out" public-key "-days" "3650"
((zero? (system* (string-append #$openssl "/bin/openssl") "-batch" "-subj" subject))
"req" "-new" "-x509" "-key" private-key (chown public-key (passwd:uid owner) (passwd:gid owner))
"-out" public-key "-days" "3650" (chmod public-key #o444))
"-batch" "-subj" subject)) (else
(chown public-key (passwd:uid owner) (passwd:gid owner)) (format (current-error-port)
(chmod public-key #o444)) "Failed to create public key at ~a.\n" public-key)))))
(else (let ((user (getpwnam "dovecot")))
(format (current-error-port) (mkdir-p/perms "/var/run/dovecot" user #o755)
"Failed to create public key at ~a.\n" public-key))))) (mkdir-p/perms "/var/lib/dovecot" user #o755)
(let ((user (getpwnam "dovecot"))) (mkdir-p/perms "/etc/dovecot" user #o755)
(mkdir-p/perms "/var/run/dovecot" user #o755) (copy-file #$(plain-file "dovecot.conf" config-str)
(mkdir-p/perms "/var/lib/dovecot" user #o755) "/etc/dovecot/dovecot.conf")
(mkdir-p/perms "/etc/dovecot" user #o755) (mkdir-p/perms "/etc/dovecot/private" user #o700)
(copy-file #$(plain-file "dovecot.conf" config-str) (create-self-signed-certificate-if-absent
"/etc/dovecot/dovecot.conf") #:private-key "/etc/dovecot/private/default.pem"
(mkdir-p/perms "/etc/dovecot/private" user #o700) #:public-key "/etc/dovecot/default.pem"
(create-self-signed-certificate-if-absent #:owner (getpwnam "root")
#:private-key "/etc/dovecot/private/default.pem" #:common-name (format #f "Dovecot service on ~a" (gethostname))))))))
#:public-key "/etc/dovecot/default.pem"
#:owner (getpwnam "root")
#:common-name (format #f "Dovecot service on ~a" (gethostname)))))))
(define (dovecot-shepherd-service config) (define (dovecot-shepherd-service config)
"Return a list of <shepherd-service> for CONFIG." "Return a list of <shepherd-service> for CONFIG."