Phase 6: add IMAP search command
ober
abac3111ff40d9a6d5b2836acd06f1f365826fc5
--- a/README.md +++ b/README.md @@ -12,7 +12,7 @@ first implementation path. ## Current Status -Phase 5 is in progress: +Phase 6 is in progress: - CLI entry point. - Environment config helper. @@ -23,6 +23,7 @@ Phase 5 is in progress: - Raw message fetch. - `.eml` export. - Decoded `show` output through `jerboa-mail`. +- Search by from, subject, and since. - Smoke tests. - Makefile. - Project plan. --- a/protonmail/cli.ss +++ b/protonmail/cli.ss @@ -105,6 +105,10 @@ "\t" (assoc-value 'subject s "")))) + (define (print-summary-table summaries) + (println "UID\tDate\tFrom\tSubject") + (for-each print-summary-row summaries)) + (define (cmd-list args) (let* ([cfg (config-from-environment)] [folder (option-ref args "--folder" "INBOX")] @@ -113,8 +117,53 @@ (let ([summaries (run-network-command (lambda () (imap-list-message-summaries cfg folder limit)))]) - (println "UID\tDate\tFrom\tSubject") - (for-each print-summary-row summaries)))) + (print-summary-table summaries)))) + + (define month-names + '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) + + (define (ymd->imap-date s) + (if (and (= (string-length s) 10) + (char=? (string-ref s 4) #\-) + (char=? (string-ref s 7) #\-)) + (let ([year (substring s 0 4)] + [month (string->number (substring s 5 7))] + [day (string->number (substring s 8 10))]) + (if (and month day (>= month 1) (<= month 12) + (>= day 1) (<= day 31)) + (string-append + (number->string day) + "-" + (vector-ref month-names (- month 1)) + "-" + year) + (die 2 "invalid --since date; expected YYYY-MM-DD"))) + (die 2 "invalid --since date; expected YYYY-MM-DD"))) + + (define (search-criteria args) + (let ([from (option-ref args "--from" #f)] + [subject (option-ref args "--subject" #f)] + [since (option-ref args "--since" #f)]) + (let ([criteria '()]) + (when from + (set! criteria (cons (string-append "FROM " (imap-quote from)) criteria))) + (when subject + (set! criteria (cons (string-append "SUBJECT " (imap-quote subject)) criteria))) + (when since + (set! criteria (cons (string-append "SINCE " (ymd->imap-date since)) criteria))) + (reverse criteria)))) + + (define (cmd-search args) + (let* ([cfg (config-from-environment)] + [folder (option-ref args "--folder" "INBOX")] + [limit (option-number args "--limit" 20)] + [criteria (search-criteria args)]) + (require-complete-config cfg) + (let ([summaries (run-network-command + (lambda () + (imap-search-message-summaries cfg folder criteria limit)))]) + (print-summary-table summaries)))) (define (write-stdout-bytes bv) (let ([p (standard-output-port (buffer-mode block))]) @@ -217,6 +266,7 @@ [(string=? (car args) "doctor") (cmd-doctor)] [(string=? (car args) "folders") (cmd-folders)] [(string=? (car args) "list") (cmd-list (cdr args))] + [(string=? (car args) "search") (cmd-search (cdr args))] [(string=? (car args) "show") (cmd-show (cdr args))] [(string=? (car args) "raw") (cmd-raw (cdr args))] [(string=? (car args) "export-eml") (cmd-export-eml (cdr args))] --- a/protonmail/imap/client.ss +++ b/protonmail/imap/client.ss @@ -6,6 +6,7 @@ imap-probe imap-list-folders imap-list-message-summaries + imap-search-message-summaries imap-fetch-raw-message imap-quote imap-final-ok?) @@ -269,6 +270,29 @@ [uids (take-last limit (search-lines->uids search-lines))]) (map (lambda (uid) (summary-for-uid client uid)) uids))))) + (define (string-join strs sep) + (if (null? strs) + "" + (let loop ([xs (cdr strs)] [acc (car strs)]) + (if (null? xs) + acc + (loop (cdr xs) (string-append acc sep (car xs))))))) + + (define (imap-search-message-summaries cfg folder criteria limit) + (imap-with-session cfg + (lambda (client) + (require-ok 'imap-select + (imap-command client + (string-append "SELECT " (imap-quote folder)))) + (let* ([query (if (null? criteria) + "ALL" + (string-join criteria " "))] + [search-lines (require-ok 'imap-search + (imap-command client + (string-append "UID SEARCH " query)))] + [uids (take-last limit (search-lines->uids search-lines))]) + (map (lambda (uid) (summary-for-uid client uid)) uids))))) + (define (imap-fetch-raw-message cfg folder uid) (imap-with-session cfg (lambda (client)