;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Sou Bunnbu ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2019 Benjamin Slade ;;; Copyright © 2019 Arun Isaac ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu packages sawfish) #:use-module ((guix licenses) #:select (gpl2+)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages autotools) #:use-module (gnu packages dbm) #:use-module (gnu packages gettext) #:use-module (gnu packages gtk) #:use-module (gnu packages libffi) #:use-module (gnu packages multiprecision) #:use-module (gnu packages pkg-config) #:use-module (gnu packages readline) #:use-module (gnu packages texinfo) #:use-module (gnu packages base) #:use-module (gnu packages xorg)) (define-public librep (package (name "librep") (version "0.92.7") (source (origin (method url-fetch) (uri (string-append "http://download.tuxfamily.org/librep/" "librep_" version ".tar.xz")) (sha256 (base32 "1bmcjl1x1rdh514q9z3hzyj
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services getmail)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages mail)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages tls)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:use-module (srfi srfi-1)
  #:export (getmail-retriever-configuration
            getmail-retriever-configuration-extra-parameters
            getmail-destination-configuration
            getmail-options-configuration
            getmail-configuration-file
            getmail-configuration
            getmail-service-type))

;;; Commentary:
;;;
;;; Service for the getmail mail retriever.
;;;
;;; Code:

(define (uglify-field-name field-name)
  (let ((str (symbol->string field-name)))
    (string-join (string-split (if (string-suffix? "?" str)
                                   (substring str 0 (1- (string-length str)))
                                   str)
                               #\-)
                 "_")))

(define (serialize-field field-name val)
  #~(let ((val '#$val))
      (format #f "~a = ~a\n"
              #$(uglify-field-name field-name)
              (cond
               ((list? val)
                (string-append
                 "("
                 (string-concatenate
                  (map (lambda (list-val)
                         (format #f "\"~a\", " list-val))
                       val))
                 ")"))
               (else
                val)))))

(define (serialize-string field-name val)
  (if (string=? val "")
      ""
      (serialize-field field-name val)))

(define (string-or-filelike? val)
  (or (string? val)
      (file-like? val)))
(define (serialize-string-or-filelike field-name val)
  (if (equal? val "")
      ""
      (serialize-field field-name val)))

(define (serialize-boolean field-name val)
  (serialize-field field-name (if val "true" "false")))

(define (non-negative-integer? val)
  (and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
  (serialize-field field-name val))

(define serialize-list serialize-field)

(define parameter-alist? list?)
(define (serialize-parameter-alist field-name val)
  #~(string-append
     #$@(map (match-lambda
               ((key . value)
                (serialize-field key value)))
             val)))

(define (serialize-getmail-retriever-configuration field-name val)
  (serialize-configuration val getmail-retriever-configuration-fields))

(define-configuration getmail-retriever-configuration
  (type
   (string "SimpleIMAPSSLRetriever")
   "The type of mail retriever to use.  Valid values include
@samp{passwd} and @samp{static}.")
  (server
   string
   "Name or IP address of the server to retrieve mail from.")
  (username
   string
   "Username to login to the mail server with.")
  (port
   (non-negative-integer #f)
   "Port number to connect to.")
  (password
   (string "")
   "Override fields from passwd.")
  (password-command
   (list '())
   "Override fields from passwd.")
  (keyfile
   (string "")
   "PEM-formatted key file to use for the TLS negotiation.")
  (certfile
   (string "")
   "PEM-formatted certificate file to use for the TLS negotiation.")
  (ca-certs
   (string "")
   "CA certificates to use.")
  (extra-parameters
   (parameter-alist '())
   "Extra retriever parameters."))

(define (serialize-getmail-destination-configuration field-name val)
  (serialize-configuration val getmail-destination-configuration-fields))

(define-configuration getmail-destination-configuration
  (type
   string
   "The type of mail destination.  Valid values include @samp{Maildir},
@samp{Mboxrd} and @samp{MDA_external}.")
  (path
   (string-or-filelike "")
   "The path option for the mail destination.  The behaviour depends on the
chosen type.")
  (extra-parameters
   (parameter-alist '())
   "Extra destination parameters"))

(define (serialize-getmail-options-configuration field-name val)