services: getmail: Use 'match-record'.
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:
		
							parent
							
								
									32c72dd99c
								
							
						
					
					
						commit
						83c9e00ffb
					
				
					 1 changed files with 31 additions and 33 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue