(define-module (mailsync) #:use-module (gnu home services shepherd) #:use-module (gnu home services) #:use-module (gnu packages mail) #:use-module (gnu packages admin) #:use-module (gnu services configuration) #:use-module (guix gexp) #:use-module (guix records) #:use-module (srfi srfi-1) #:export (mailsync-mailbox mailsync-mailbox? home-mailsync-configuration home-mailsync-configuration? home-mailsync-service-type)) (define (string-list? x) (and (list? x) (every string? x))) (define (string-or-file-like? x) (or (string? x) (file-like? x))) (define-maybe/no-serialization string-or-file-like) (define-configuration/no-serialization mailsync-mailbox (host (string) "The hostname of the IMAP server to synchronise with.") (port (integer 993) "The port to use to connect to the IMAP server.") (tls? (boolean #t) "Whether to connect with IMAPS or not.") (password-command (string) "The command to run to get the IMAP password") (user (string) "The IMAP username.") (listen-boxes (string-list (list "INBOX")) "The mailboxes to listen for changes to.") (post-sync (maybe-string-or-file-like) "A command to run after syncing the mailbox.") (id (symbol) "An unique identifier for this mailbox.")) (define (make-imapnotify-config mailbox syncer-id) (match-record mailbox (host port tls? password-command user listen-boxes post-sync) #~(format #f "{\"host\": ~s, \"port\": ~a, \"tls\": ~a, \"username\": ~s, \"passwordCmd\": ~s, \"onNewMail\": ~s, \"onNewMailPost\": ~s, \"wait\": 3, \"boxes\": ~a}" #$host #$port #$(if tls? "true" "false") #$user #$password-command #$(file-append shepherd (string-append "/bin/herd start " (symbol->string syncer-id))) #$(if (maybe-value-set? post-sync) post-sync "") #$(format #f "[~a]" (string-join (map (lambda (x) (format #f "~s" x)) listen-boxes) ", "))))) (define (make-isync-config mailbox) (match-record mailbox (host port tls? password-command user id) (format #f "IMAPAccount account Host ~a User ~a PassCmd ~s SSLType ~a IMAPStore remote Account account MaildirStore local SubFolders Verbatim Path ~~/.mail/~a/ Inbox ~~/.mail/~a/Inbox Channel channel Far :remote: Near :local: Create Both Expunge Both SyncState * Patterns *\n" host user password-command (if tls? "IMAPS" "STARTTLS") id id))) (define (mailsync-mailbox-list? x) (and (list? x) (every mailsync-mailbox? x))) (define-configuration/no-serialization home-mailsync-configuration (isync (file-like isync) "The @code{isync} package to use.") (goimapnotify (file-like go-gitlab.com-shackra-goimapnotify) "The @code{goimapnotify} package to use.") (mailboxes (mailsync-mailbox-list '()) "The mailboxes to synchronise.")) (define (home-mailsync-shepherd-service config) (match-record config (isync goimapnotify mailboxes) (apply append (map (lambda (mailbox) (let* ((id (mailsync-mailbox-id mailbox)) (syncer-id (symbol-append 'mailsync-syncer- id)) (listener-id (symbol-append 'mailsync-listener- id)) (isync-config-file (mixed-text-file "mbsyncrc" (make-isync-config mailbox))) (imapnotify-config-file (mixed-text-file "imapnotify-config.json" (make-imapnotify-config mailbox syncer-id)))) (list (shepherd-service (provision (list syncer-id)) (requirement '()) (one-shot? #t) (start #~(make-forkexec-constructor (list #$(file-append isync "/bin/mbsync") "--all" "--quiet" "--config" #$isync-config-file))) (actions (list (shepherd-configuration-action isync-config-file)))) (shepherd-service (provision (list listener-id)) (requirement (list syncer-id)) (one-shot? #f) (start #~(make-forkexec-constructor (list #$(file-append goimapnotify "/bin/goimapnotify") "-conf" #$imapnotify-config-file))) (stop #~(make-kill-destructor)) (actions (list (shepherd-configuration-action imapnotify-config-file))))))) mailboxes)))) (define home-mailsync-service-type (service-type (name 'home-mailsync) (extensions (list (service-extension home-shepherd-service-type home-mailsync-shepherd-service))) (default-value (home-mailsync-configuration)) (description "Sync email over imap with isync and imapnotify.")))