summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-17 23:03:50 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-17 23:03:50 +0100
commit83c9e00ffbd41776c003f6992e9d613a5434fff9 (patch)
tree7cc5f33bd3066ee3f4b4ceb103162c6936499329
parent32c72dd99cd2986856182910c7dee18d643e8d07 (diff)
downloadguix-83c9e00ffbd41776c003f6992e9d613a5434fff9.tar.gz
services: getmail: Use 'match-record'.
Fixes a regression introduced in
44554e7133aa60e1b453436be1e80394189cabd9 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.
-rw-r--r--gnu/services/getmail.scm64
1 files changed, 31 insertions, 33 deletions
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm
index 0a1c34cfd3..fb82d054ca 100644
--- a/gnu/services/getmail.scm
+++ b/gnu/services/getmail.scm
@@ -216,16 +216,15 @@ lines.")
    "Extra options to include."))
 
 (define (serialize-getmail-configuration-file field-name val)
-  (match val
-    (($ <getmail-configuration-file> location
-                                     retriever destination options)
-     #~(string-append
-        "[retriever]\n"
-        #$(serialize-getmail-retriever-configuration #f retriever)
-        "\n[destination]\n"
-        #$(serialize-getmail-destination-configuration #f destination)
-        "\n[options]\n"
-        #$(serialize-getmail-options-configuration #f options)))))
+  (match-record val <getmail-configuration-file>
+    (retriever destination options)
+    #~(string-append
+       "[retriever]\n"
+       #$(serialize-getmail-retriever-configuration #f retriever)
+       "\n[destination]\n"
+       #$(serialize-getmail-destination-configuration #f destination)
+       "\n[options]\n"
+       #$(serialize-getmail-options-configuration #f options))))
 
 (define-configuration getmail-configuration-file
   (retriever
@@ -339,29 +338,28 @@ notifications.  This depends on the server supporting the IDLE extension.")
 
 (define (getmail-shepherd-services configs)
   "Return a list of <shepherd-service> for CONFIGS."
-  (map (match-lambda
-         (($ <getmail-configuration> location name package
-                                     user group directory rcfile idle
-                                     environment-variables)
-          (shepherd-service
-           (documentation "Run getmail.")
-           (provision (list (symbol-append 'getmail- name)))
-           (requirement '(networking))
-           (start #~(make-forkexec-constructor
-                     `(#$(file-append package "/bin/getmail")
-                       ,(string-append "--getmaildir=" #$directory)
-                       #$@(map (lambda (idle)
-                                 (string-append "--idle=" idle))
-                               idle)
-                       ,(string-append "--rcfile=" #$rcfile))
-                     #:user #$user
-                     #:group #$group
-                     #:environment-variables
-                     (list #$@environment-variables)
-                     #:log-file
-                     #$(string-append "/var/log/getmail-"
-                                      (symbol->string name))))
-           (stop #~(make-kill-destructor)))))
+  (map (lambda (config)
+         (match-record config <getmail-configuration>
+           (name package user group directory rcfile idle environment-variables)
+           (shepherd-service
+            (documentation "Run getmail.")
+            (provision (list (symbol-append 'getmail- name)))
+            (requirement '(networking))
+            (start #~(make-forkexec-constructor
+                      `(#$(file-append package "/bin/getmail")
+                        ,(string-append "--getmaildir=" #$directory)
+                        #$@(map (lambda (idle)
+                                  (string-append "--idle=" idle))
+                                idle)
+                        ,(string-append "--rcfile=" #$rcfile))
+                      #:user #$user
+                      #:group #$group
+                      #:environment-variables
+                      (list #$@environment-variables)
+                      #:log-file
+                      #$(string-append "/var/log/getmail-"
+                                       (symbol->string name))))
+            (stop #~(make-kill-destructor)))))
        configs))
 
 (define getmail-service-type