me/guix
Archived
1
0
Fork 0
Code Activity

services: getmail: Use 'match-record'.

Browse source 
Fixes a regression introduced in
44554e7133 whereby the wrong record fields
would be accessed, leading to a <location> record being spliced in the
result.

* gnu/services/getmail.scm (serialize-getmail-configuration-file): Use
'match-record' instead of 'match'.
(getmail-shepherd-services): Likewise.
This commit is contained in:
Ludovic Courtès 2022-11-17 23:03:50 +01:00
parent 32c72dd99c
commit 83c9e00ffb
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 31 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
gnu/services/getmail.scm
View file

@ -216,16 +216,15 @@ lines.")
"Extra options to include.")) "Extra options to include."))
(define (serialize-getmail-configuration-file field-name val) (define (serialize-getmail-configuration-file field-name val)
(match val (match-record val <getmail-configuration-file>
(($ <getmail-configuration-file> location (retriever destination options)
retriever destination options) #~(string-append
#~(string-append "[retriever]\n"
"[retriever]\n" #$(serialize-getmail-retriever-configuration #f retriever)
#$(serialize-getmail-retriever-configuration #f retriever) "\n[destination]\n"
"\n[destination]\n" #$(serialize-getmail-destination-configuration #f destination)
#$(serialize-getmail-destination-configuration #f destination) "\n[options]\n"
"\n[options]\n" #$(serialize-getmail-options-configuration #f options))))
#$(serialize-getmail-options-configuration #f options)))))
(define-configuration getmail-configuration-file (define-configuration getmail-configuration-file
(retriever (retriever
@ -339,29 +338,28 @@ notifications. This depends on the server supporting the IDLE extension.")
(define (getmail-shepherd-services configs) (define (getmail-shepherd-services configs)
"Return a list of <shepherd-service> for CONFIGS." "Return a list of <shepherd-service> for CONFIGS."
(map (match-lambda (map (lambda (config)
(($ <getmail-configuration> location name package (match-record config <getmail-configuration>
user group directory rcfile idle (name package user group directory rcfile idle environment-variables)
environment-variables) (shepherd-service
(shepherd-service (documentation "Run getmail.")
(documentation "Run getmail.") (provision (list (symbol-append 'getmail- name)))
(provision (list (symbol-append 'getmail- name))) (requirement '(networking))
(requirement '(networking)) (start #~(make-forkexec-constructor
(start #~(make-forkexec-constructor `(#$(file-append package "/bin/getmail")
`(#$(file-append package "/bin/getmail") ,(string-append "--getmaildir=" #$directory)
,(string-append "--getmaildir=" #$directory) #$@(map (lambda (idle)
#$@(map (lambda (idle) (string-append "--idle=" idle))
(string-append "--idle=" idle)) idle)
idle) ,(string-append "--rcfile=" #$rcfile))
,(string-append "--rcfile=" #$rcfile)) #:user #$user
#:user #$user #:group #$group
#:group #$group #:environment-variables
#:environment-variables (list #$@environment-variables)
(list #$@environment-variables) #:log-file
#:log-file #$(string-append "/var/log/getmail-"
#$(string-append "/var/log/getmail-" (symbol->string name))))
(symbol->string name)))) (stop #~(make-kill-destructor)))))
(stop #~(make-kill-destructor)))))
configs)) configs))
(define getmail-service-type (define getmail-service-type