234 lines
7.6 KiB
Scheme
234 lines
7.6 KiB
Scheme
|
||
;;;
|
||
;;; 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)))
|