imap: fix parse-store-mail parsing because it breaks on gmail

gmail responses include lines with the order of UID and FLAGS reversed
to indicate the previous flags for a mail. Just ignore those lines
because they aren't useful and non-standard.
db4
Björn Lindqvist 2014-10-08 00:03:36 +02:00 committed by John Benediktsson
parent d8121a9622
commit c6d419e0fe
2 changed files with 29 additions and 16 deletions

View File

@ -1,6 +1,6 @@
USING: accessors arrays assocs calendar calendar.format
combinators continuations destructors formatting fry grouping.extras imap
io.streams.duplex kernel math math.parser math.ranges
imap.private io.streams.duplex kernel math math.parser math.ranges
math.statistics namespaces random sequences sets sorting
splitting strings system tools.test ;
FROM: pcre => findall ;
@ -34,6 +34,12 @@ ERROR: no-imap-test-host ;
: imap-test ( result quot -- )
'[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline
: base-folder ( -- s )
os name>> cpu name>> "-" glue ;
: test-folder ( s -- s )
[ base-folder "/" ] dip 3append ;
[ t ] [
get-test-host <imap4ssl> [ duplex-stream? ] with-disposal
] unit-test
@ -63,12 +69,6 @@ ERROR: no-imap-test-host ;
"ALL" "" search-mails
] imap-test
: base-folder ( -- s )
os name>> cpu name>> "-" glue ;
: test-folder ( s -- s )
[ base-folder "/" ] dip 3append ;
! Create delete select again.
[ 0 ] [
"örjan" test-folder
@ -127,11 +127,14 @@ ERROR: no-imap-test-host ;
! Create a folder hierarchy
[ t ] [
"*" test-folder list-folders length
"foo/bar/baz/日本語" test-folder [
create-folder
"foo/bar/baz/日本語" test-folder
[ '[ _ delete-folder ] ignore-errors ]
[
"*" test-folder list-folders length
swap create-folder
"*" test-folder list-folders length 4 - =
] [ delete-folder ] bi
]
[ delete-folder ] tri
] imap-test
! A gmail compliant way of creating a folder hierarchy.
@ -177,6 +180,14 @@ ERROR: no-imap-test-host ;
internal-date>timestamp timestamp?
] imap-test
! Response parsing
{ { 8132 { "\\Seen" } } f } [
"(FLAGS (\\Seen) UID 8132)" parse-store-mail-line
! Weird non-standard(?) response format gmail uses to indicate the
! previous mail flags. Just ignore it.
"(UID 1234 FLAGS (\\Seen))" parse-store-mail-line
] unit-test
! Just an interesting verb to gmail thread mails. Wonder if you can
! avoid the double fetch-mails?
: threaded-mailbox ( uids -- threads )

View File

@ -96,11 +96,13 @@ CONSTANT: IMAP4_SSL_PORT 993
first "\\* STATUS \"[^\"]+\" \\(([^\\)]+)\\)" pcre:findall first last last
" " split 2 group [ string>number ] assoc-map ;
: parse-store-mail ( seq -- assoc )
but-last [
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall
: parse-store-mail-line ( str -- pair/f )
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [
first 1 tail values first2 [ " " split ] dip string>number swap 2array
] map ;
] if-empty ;
: parse-store-mail ( seq -- assoc )
but-last [ parse-store-mail-line ] map sift ;
PRIVATE>
@ -181,6 +183,6 @@ TUPLE: imap-settings host email password ;
swap >>password
swap >>email
swap >>host ; inline
: with-imap-settings ( imap-settings quot -- )
[ [ host>> ] [ email>> ] [ password>> ] tri ] dip with-imap ; inline