Hi there, Just FYI, for code that you want to share in a simple way, you can use pasterack.org (or gist.github.com ). Here's your code: http://pasterack.org/pastes/5961
On Sun, Jan 29, 2017 at 12:12 AM, Huang, Ying <huang_ying_cari...@163.com> wrote: > Hi, All, > > Previously I use imapfilter (https://github.com/lefcha/imapfilter) to > process mails from various mailing list. Recently, I use another mail > service, which doesn't support sever side searching, so imapfilter > doesn't work. So I write an IMAP filter with racket net/imap module. > Someone else may have similar requirement, so I paste it here. The code > is only for my own usage and for reference. > > #!/usr/bin/racket > #lang racket > > (require net/imap) > > (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-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 (imap-get-expunges-number imap) > (length (imap-get-expunges imap))) > > (define (imap-filter-move imap total . pattern_dest-mailboxes) > (let filter-move ([start 1] > [total total]) > (define (call-with-check-expunges thk cont) > (let* ([val-list (call-with-values thk list)] > [expunges-number (imap-get-expunges-number imap)]) > (if (> expunges-number 0) > (filter-move (- start expunges-number) > (- total expunges-number)) > (apply cont val-list)))) > (when (and (> total 0) > (<= start total) > (pair? pattern_dest-mailboxes)) > (let ([start (max start 1)]) > (call-with-check-expunges > (thunk (imap-fetch imap total start batch)) > (λ (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 > (thunk (imap-copy imap tm-msg-nums dest-mailbox)) > (λ (v) > (imap-store imap '+ tm-msg-nums > (list (symbol->imap-flag 'deleted))) > (imap-expunge imap) > (let ([expunges-number (imap-get-expunges-number > imap)]) > (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)))))) > (loop (cdr pds) total msgs))) > (filter-move (+ start (length msgs)) total))))))))) > > (define server "imap.your-server.com") > (define port 993) > (define username "your user name") > (define password "your password") > (define mailbox-name "your INBOX") > (define batch 10) > > (define (connect) > (parameterize ([imap-port-number port]) > (imap-connect server username 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"))) > (thunk (imap-disconnect imap)))) > > (main) > > Best Regards, > Huang, Ying > > -- > 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. > -- 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.
