Hi, Tim, Tim Hanson <tbh...@gmail.com> writes:
> I should have dug around in sirmail sooner. Armed with the hint about > parametrize I've now found this: > > (if (get-pref 'sirmail:use-ssl?) > (let-values ([(in out) (ssl-connect server port-no)]) > (imap-connect* in out (USERNAME) passwd mailbox-name)) > (parameterize ([imap-port-number port-no]) > (imap-connect server (USERNAME) > passwd > mailbox-name))) > > I guess I naively thought I'd be able to do something like this > > (let-values > ([(imap-connection messages# nu) > (parameterize ([imap-port-number port]) > (imap-connect hostname mailaddress password folder > #:tls? tls-before? #:try-tls? try-tls?))]) > > but so far I think it has worked only with an account that uses #:try-tls?, > not yet for #:tls?. > > I had seen > > https://docs.racket-lang.org/net/imap.html#%28def._%28%28lib._net%2Fimap..rkt%29._imap-connect%2A%29%29 > > in the docs, but wasn't sure how to do it. I can try following the example > above. Recently, I just implemented an IMAP mail filter based on net/imap. Hope it is useful for you. Best Regards, Huang, Ying #!/usr/bin/env racket #lang racket (require net/imap) (define read-string-batch 4096) (define (read-string/all [in (current-input-port)]) (apply string-append (for/list ([str (in-producer (λ () (read-string read-string-batch in)) eof)]) str))) (define (process/out/s command #:set-pwd? [set-pwd? (member (system-type) '(unix macosx))]) (let ([outp null]) (dynamic-wind values (thunk (set! outp (car (process/ports #f (current-input-port) (current-error-port) command #:set-pwd? set-pwd?))) (read-string/all outp)) (thunk (when (port? outp) (close-input-port outp)))))) (define (process/out/ss command #:set-pwd? [set-pwd? (member (system-type) '(unix macosx))]) (string-trim (process/out/s command #:set-pwd? set-pwd?))) (define (imap-fetch imap total start len) (let* ([end (min (add1 total) (+ start len))] [msg-nums (sequence->list (in-range start end))]) (when (pair? msg-nums) (imap-get-messages imap msg-nums '(header))))) (define (messages-filter messages start pattern) (for/fold ([result empty]) ([msg messages] [num (in-naturals start)]) (let ([header (car msg)]) (if (regexp-match? pattern header) (cons num result) result)))) (define (messages-remove messages start to-remove-msg-nums) (reverse (for/fold ([result empty]) ([msg messages] [num (in-naturals start)]) (if (member num to-remove-msg-nums eqv?) result (cons msg result))))) (define (header-contain header pattern) (regexp (format "(?im:^~a: .*~a.*$)" header pattern))) (define (imap-get-expunges-number imap) (length (imap-get-expunges imap))) (define (call-with-check-expunges imap thk with without) (let* ([val-list (call-with-values thk list)] [expunges-number (imap-get-expunges-number imap)]) (if (> expunges-number 0) (with expunges-number) (apply without val-list)))) (define (imap-filter-move imap total . pattern_dest-mailboxes) (let filter-move ([start 1] [total total]) (when (and (> total 0) (<= start total) (pair? pattern_dest-mailboxes)) (let ([start (max start 1)]) (call-with-check-expunges imap (thunk (imap-fetch imap total start batch)) (λ (expunges-number) (filter-move (- start expunges-number) (- total expunges-number))) (λ (msgs) (let loop ([pds pattern_dest-mailboxes] [total total] [msgs msgs]) (if (and (pair? pds) (pair? msgs)) (let* ([pattern_dest-mailbox (car pds)] [pattern (first pattern_dest-mailbox)] [dest-mailbox (second pattern_dest-mailbox)] [tm-msg-nums (messages-filter msgs start pattern)]) (if (pair? tm-msg-nums) (call-with-check-expunges imap (thunk (imap-copy imap tm-msg-nums dest-mailbox)) (λ (expunges-number) (filter-move (- start expunges-number) (- total expunges-number))) (λ (v) (call-with-check-expunges imap (thunk (imap-store imap '+ tm-msg-nums (list (symbol->imap-flag 'deleted))) (imap-expunge imap)) (λ (expunges-number) (if (= expunges-number (length tm-msg-nums)) (loop (cdr pds) (- total expunges-number) (messages-remove msgs start tm-msg-nums)) (filter-move (- start expunges-number) (- total expunges-number)))) (λ (v) (loop (cdr pds) total msgs))))) (loop (cdr pds) total msgs))) (filter-move (+ start (length msgs)) total))))))))) (define server "imap.mail-server") (define port 993) (define username "you") (define mailbox-name "INBOX") (define batch 10) (define (connect) (parameterize ([imap-port-number port]) (imap-connect server username (process/out/ss (string-append "get password")) mailbox-name #:tls? #t))) (define (main) (define-values (imap total recent) (connect)) (dynamic-wind values (thunk (imap-filter-move imap total `(,(header-contain "Mailing-list" "racket-users@googlegroups.com") "racket-user") `(,(header-contain "Mailing-list" "us...@plt-scheme.org") "racket-user") `(,(header-contain "Mailing-list" "racket-...@googlegroups.com") "racket-devel") `(,(header-contain "Mailing-list" "d...@plt-scheme.org") "racket-devel") `(,(header-contain "List-Post" "guix-de...@gnu.org")))) (thunk (imap-disconnect imap)))) (main) -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
