updates to guix
This commit is contained in:
Chris Cochrun
parent
cae9f94cbb
commit
a9d322bf37
6 changed files with 425 additions and 20 deletions
233
guix/home-services/mail.scm
Normal file
233
guix/home-services/mail.scm
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
|
||||
;;;
|
||||
;;; feature-isync.
|
||||
;;;
|
||||
|
||||
(define (prep-str sym str)
|
||||
(symbol-append sym '- (string->symbol str)))
|
||||
|
||||
(define (isync-channel id local remote)
|
||||
`((Channel ,(prep-str id local))
|
||||
(Near ,(format #f ":~a-local:~a" id local))
|
||||
(Far ,(format #f ":~a-remote:~a" id remote))
|
||||
,#~""))
|
||||
|
||||
(define (isync-group-with-channels id isync-mapping)
|
||||
(append
|
||||
(append-map
|
||||
(lambda (x) (isync-channel id (car x) (cdr x)))
|
||||
isync-mapping)
|
||||
`((Group ,(symbol-append id))
|
||||
,@(map
|
||||
(lambda (x) (list 'Channel (prep-str id (car x))))
|
||||
isync-mapping)
|
||||
,#~"")))
|
||||
|
||||
(define* (generate-isync-serializer
|
||||
host folders-mapping
|
||||
#:key
|
||||
(port #f)
|
||||
(auth-mechs #f)
|
||||
(subfolders 'Verbatim)
|
||||
(cipher-string #f)
|
||||
(pipeline-depth #f))
|
||||
(ensure-pred symbol? subfolders)
|
||||
|
||||
(define (isync-settings mail-directory mail-account)
|
||||
(let* ((id (mail-account-id mail-account))
|
||||
(user (or (mail-account-user mail-account)
|
||||
(mail-account-fqda mail-account)))
|
||||
(pass-cmd (mail-account-get-pass-cmd mail-account)))
|
||||
`(,#~(string-append "# Account '" #$(symbol->string id)
|
||||
" starts here")
|
||||
(IMAPAccount ,id)
|
||||
(Host ,host)
|
||||
,@(if (integer? port) `((Port ,port)) '())
|
||||
(User ,user)
|
||||
(PassCmd ,pass-cmd)
|
||||
,@(if (symbol? auth-mechs) `((AuthMechs ,auth-mechs)) '())
|
||||
(SSLType IMAPS)
|
||||
(CertificateFile /etc/ssl/certs/ca-certificates.crt)
|
||||
,@(if (symbol? cipher-string) `((CipherString ,cipher-string)) '())
|
||||
,@(if (integer? pipeline-depth) `((PipelineDepth ,pipeline-depth)) '())
|
||||
,#~""
|
||||
(IMAPStore ,(symbol-append id '-remote))
|
||||
(Account ,id)
|
||||
,#~""
|
||||
(MaildirStore ,(symbol-append id '-local))
|
||||
(SubFolders ,subfolders)
|
||||
(Path ,(string-append mail-directory "/accounts/" user "/"))
|
||||
(Inbox ,(string-append mail-directory "/accounts/" user "/inbox"))
|
||||
,#~""
|
||||
,@(isync-group-with-channels id folders-mapping))))
|
||||
isync-settings)
|
||||
|
||||
;; Directory names has lowercased spelling to match notmuch tags
|
||||
(define gmail-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "[Gmail]/Sent Mail")
|
||||
("drafts" . "[Gmail]/Drafts")
|
||||
("archive" . "[Gmail]/All Mail")
|
||||
("trash" . "[Gmail]/Trash")
|
||||
("spam" . "[Gmail]/Spam")))
|
||||
|
||||
(define gandi-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "Sent")
|
||||
("drafts" . "Drafts")
|
||||
("archive" . "Archive")
|
||||
("trash" . "Trash")
|
||||
("spam" . "Junk")))
|
||||
|
||||
(define gmx-fr-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "Envoy&AOk-s")
|
||||
("drafts" . "Brouillons")
|
||||
("archive" . "Archive")
|
||||
("trash" . "Corbeille")
|
||||
("spam" . "Junk")))
|
||||
|
||||
(define outlook-fr-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "&AMk-l&AOk-ments envoy&AOk-s") ;"Éléments envoyés"
|
||||
("drafts" . "Brouillons")
|
||||
("archive" . "Notes")
|
||||
("trash" . "&AMk-l&AOk-ments supprim&AOk-s") ;"Éléments supprimés"
|
||||
("spam" . "Courrier ind&AOk-sirable"))) ;"Courrier indésirable"
|
||||
|
||||
(define mailbox-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "Sent")
|
||||
("drafts" . "Drafts")
|
||||
("trash" . "Trash")
|
||||
("junk" . "Junk")
|
||||
("archive" . "Archive")))
|
||||
|
||||
(define hosteurope-de-folder-mapping
|
||||
'(("inbox" . "INBOX")
|
||||
("sent" . "Sent")
|
||||
("drafts" . "Entwurf")
|
||||
("trash" . "Trash")
|
||||
("spam" . "Spam")
|
||||
("archive" . "All")))
|
||||
|
||||
(define gmx-fr-isync-settings
|
||||
(generate-isync-serializer "imap.gmx.net" gmx-fr-folder-mapping))
|
||||
|
||||
(define ovh-isync-settings
|
||||
(generate-isync-serializer "ssl0.ovh.net" gandi-folder-mapping
|
||||
#:subfolders 'Legacy
|
||||
#:auth-mechs 'LOGIN))
|
||||
|
||||
(define gmail-isync-settings
|
||||
(generate-isync-serializer "imap.gmail.com" gmail-folder-mapping))
|
||||
|
||||
(define gandi-isync-settings
|
||||
(generate-isync-serializer "mail.gandi.net" gandi-folder-mapping))
|
||||
|
||||
(define mailbox-isync-settings
|
||||
(generate-isync-serializer "imap.mailbox.org" mailbox-folder-mapping))
|
||||
|
||||
(define hosteurope-de-isync-settings
|
||||
(generate-isync-serializer "imap.hosteurope.de" hosteurope-de-folder-mapping))
|
||||
|
||||
(define* (get-ovh-pro-isync-settings
|
||||
#:key
|
||||
(folder-mapping #f)
|
||||
(host-number #f))
|
||||
(ensure-pred list? folder-mapping)
|
||||
(generate-isync-serializer
|
||||
(string-append "pro" host-number ".mail.ovh.net")
|
||||
folder-mapping
|
||||
#:auth-mechs 'LOGIN
|
||||
#:subfolders 'Legacy))
|
||||
|
||||
(define ovh-pro2-fr-isync-settings
|
||||
(get-ovh-pro-isync-settings
|
||||
#:host-number "2"
|
||||
#:folder-mapping outlook-fr-folder-mapping))
|
||||
|
||||
(define (generic-isync-settings mail-directory mail-account)
|
||||
(let* ((user (mail-account-fqda mail-account)))
|
||||
`(,#~"# Do not know how to serialize generic accounts :("
|
||||
,#~(format #f "# ~a wasn't configured by rde," #$user)
|
||||
,#~"# Try to set another value for mail-account's type field.")))
|
||||
|
||||
(define %default-isync-serializers
|
||||
`((gmail . ,gmail-isync-settings)
|
||||
(gandi . ,gandi-isync-settings)
|
||||
(gmx-fr . ,gmx-fr-isync-settings)
|
||||
(ovh . ,ovh-isync-settings)
|
||||
(ovh-pro2-fr . ,ovh-pro2-fr-isync-settings)
|
||||
(mailbox . ,mailbox-isync-settings)
|
||||
(hosteurope-de . ,hosteurope-de-isync-settings)
|
||||
(generic . ,generic-isync-settings)))
|
||||
|
||||
(define default-isync-global-settings
|
||||
`((Create Both)
|
||||
(Expunge Both)
|
||||
(SyncState *)
|
||||
,#~""))
|
||||
|
||||
(define* (feature-isync
|
||||
#:key
|
||||
(mail-account-ids #f)
|
||||
(isync-global-settings default-isync-global-settings)
|
||||
(isync-serializers %default-isync-serializers)
|
||||
(isync-verbose #f))
|
||||
"Setup and configure isync. If MAIL-ACCOUNT-IDS not provided use all
|
||||
mail accounts. ISYNC-VERBOSE controls output verboseness of
|
||||
@file{mbsync}."
|
||||
(ensure-pred maybe-list? mail-account-ids)
|
||||
(ensure-pred list? isync-serializers)
|
||||
(ensure-pred list? isync-global-settings)
|
||||
|
||||
;; Sync mail deletion
|
||||
;; https://notmuchmail.org/pipermail/notmuch/2016/023112.html
|
||||
;; http://tiborsimko.org/mbsync-duplicate-uid.html
|
||||
|
||||
;; https://notmuchmail.org/emacstips/#index25h2
|
||||
|
||||
(define (get-home-services config)
|
||||
(require-value 'mail-accounts config
|
||||
"feature-isync can't operate without mail-accounts.")
|
||||
|
||||
(let* ((mail-accounts
|
||||
(filter (lambda (x) (eq? (mail-account-synchronizer x) 'isync))
|
||||
(get-value 'mail-accounts config)))
|
||||
(mail-directory-fn (get-value 'mail-directory-fn config))
|
||||
(mail-directory (mail-directory-fn config)))
|
||||
|
||||
(define (serialize-mail-acc mail-acc)
|
||||
((assoc-ref isync-serializers (mail-account-type mail-acc))
|
||||
mail-directory mail-acc))
|
||||
|
||||
(list
|
||||
(simple-service
|
||||
'isync-ensure-mail-dirs-exists
|
||||
home-activation-service-type
|
||||
#~(map mkdir-p
|
||||
'#$(map (lambda (acc)
|
||||
(string-append mail-directory "/accounts/"
|
||||
(mail-account-fqda acc)))
|
||||
mail-accounts)))
|
||||
(service
|
||||
home-isync-service-type
|
||||
(home-isync-configuration
|
||||
(config
|
||||
(append
|
||||
isync-global-settings
|
||||
(append-map serialize-mail-acc mail-accounts))))))))
|
||||
|
||||
;; MAYBE: Wrap it in a program-file to make it possible to call it
|
||||
;; with system*
|
||||
(define (isync-synchronize-cmd-fn mail-acc)
|
||||
(string-append "mbsync "
|
||||
(if isync-verbose "-V " "")
|
||||
(symbol->string (mail-account-id mail-acc))))
|
||||
|
||||
(feature
|
||||
(name 'isync)
|
||||
(values `((isync . #t)
|
||||
(isync-synchronize-cmd-fn . ,isync-synchronize-cmd-fn)))
|
||||
(home-services-getter get-home-services)))
|
||||
Loading…
Add table
Add a link
Reference in a new issue