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.

diff --git a/extra/imap/imap-tests.factor b/extra/imap/imap-tests.factor
index 15c5271dcd55a9267c390f6e5aa795dcfb7c54d3..04729d3d74d3aaf826f2a9333809a480d8a2c1f8 100644 (file)
--- a/extra/imap/imap-tests.factor
+++ b/extra/imap/imap-tests.factor
@@ -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 )

diff --git a/extra/imap/imap.factor b/extra/imap/imap.factor
index 2b75fc6f0cbc1e03b3bab9eb0655f9a31a8e8596..271ccff0a40a311463594ceb27d5d9e555eae7eb 100644 (file)
--- a/extra/imap/imap.factor
+++ b/extra/imap/imap.factor
@@ -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