Permalink
Browse files

[feature] imapClient: Implemented COPY command.

  • Loading branch information...
1 parent c077cc1 commit f4af24f16f8c8d40a87ca5a908662431c0e8b6b1 @nrs135 nrs135 committed with Aqua-Ye Apr 3, 2012
Showing with 45 additions and 2 deletions.
  1. +43 −2 libnet/imapClientCore.proto
  2. +1 −0 opabsl/mlbsl/bslMail.ml
  3. +1 −0 stdlib/web/mail/email.opa
@@ -33,6 +33,7 @@
| ImapStore of (bool * string * string * string)
| ImapSearch of (bool * string)
| ImapSearchCs of (bool * string * string)
+ | ImapCopy of (bool * string * string)
| ImapList of (string * string)
| ImapCreate of string
| ImapDelete of string
@@ -65,8 +66,6 @@
-type results = result list
- %mailbox : string;
- %readonly : bool;
-type mail = {
username : string;
password : string;
@@ -108,6 +107,7 @@ let string_of_command = function
| ImapExamine s -> sprintf "EXAMINE %s" s
| ImapNoop -> "NOOP"
| ImapFetch (uid,seq,items) -> sprintf "%sFETCH %s %s" (if uid then "UID " else "") seq items
+ | ImapCopy (uid,seq,m) -> sprintf "%sCOPY %s %s" (if uid then "UID " else "") seq m
| ImapStore (uid,seq,din,dinval) -> sprintf "%sSTORE %s %s %s" (if uid then "UID " else "") seq din dinval
| ImapSearch (uid,s) -> sprintf "%sSEARCH %s" (if uid then "UID " else "") s
| ImapSearchCs (uid,cs,s) -> sprintf "%sSEARCH CHARSET %s %s" (if uid then "UID " else "") cs s
@@ -147,6 +147,8 @@ let add_fetched str fetched =
-define (UidFetch (tag, seq, items)) = tag " UID FETCH " seq " " items "\r\n"
-define (Store (tag, seq, din, dinval)) = tag " STORE " seq " " din " " dinval "\r\n"
-define (UidStore (tag, seq, din, dinval)) = tag " UID STORE " seq " " din " " dinval "\r\n"
+-define (Copy (tag, seq, mailbox)) = tag " COPY " seq " " mailbox "\r\n"
+-define (UidCopy (tag, seq, mailbox)) = tag " UID COPY " seq " " mailbox "\r\n"
-define (List (tag, rf, mailbox)) = tag " LIST " rf " " mailbox "\r\n"
-define (Create (tag, mailbox)) = tag " CREATE " mailbox "\r\n"
-define (Delete (tag, mailbox)) = tag " DELETE " mailbox "\r\n"
@@ -157,6 +159,7 @@ let add_fetched str fetched =
-define (NoopOk (tag,str)) = tag " OK NOOP "~ str "\r\n"
-define (FetchOk (tag,str)) = tag " OK " "UID "? "FETCH "~ str "\r\n"
-define (StoreOk (tag,str)) = tag " OK " "UID "? "STORE "~ str "\r\n"
+-define (CopyOk (tag,str)) = tag " OK " "UID "? "COPY "~ str "\r\n"
-define (ListOk (tag,str)) = tag " OK LIST "~ str "\r\n"
-define (CreateOk (tag,str)) = tag " OK CREATE "~ str "\r\n"
-define (DeleteOk (tag,str)) = tag " OK DELETE "~ str "\r\n"
@@ -294,6 +297,14 @@ commands(mail, tools):
send (List (tag, rf, mailbox));
list(mail, tools, tag)
end
+ | ImapCopy (uid, seq, mailbox) ->
+ if {{ uid }}
+ then
+ send (UidCopy (tag, seq, mailbox));
+ copy(mail, tools, tag)
+ else
+ send (Copy (tag, seq, mailbox));
+ copy(mail, tools, tag)
| ImapCreate mailbox ->
send (Create (tag, mailbox));
wait_for_ok(mail, tools, tag, {{"create"}}, {{"CREATE"}},
@@ -475,6 +486,32 @@ store(mail, tools, tag):
| exn ->
check_exception(mail, tools, {{"store"}}, tag, exn)
+copy(mail, tools, tag):
+ receive
+ | CopyOk (rtag,_str) ->
+ if {{ rtag <> tag }}
+ then
+ debug {{ eprintf "copy received mismatched COPY OK: rtag=%s tag=%s str=%s\n" rtag tag _str }}
+ error({{ sprintf "Tag mismatch: %s vs. %s" rtag tag }}, tools)
+ else
+ debug {{ eprintf "fetch received COPY OK: tag=%s str=%s\n" tag _str }}
+ let mail = {{ { mail with results = ((Ok "copied")::mail.results) } }}
+ commands(mail, tools)
+ | FlagsOk (rtag,flags,_str) ->
+ if {{ rtag <> tag }}
+ then
+ debug {{ eprintf "copy received mismatched COPY OK: rtag=%s tag=%s flags=%s str=%s\n" rtag tag flags _str }}
+ error({{ sprintf "Tag mismatch: %s vs. %s" rtag tag }}, tools)
+ else
+ debug {{ eprintf "fetch received COPY OK: tag=%s flags=%s str=%s\n" tag flags _str }}
+ let mail = {{ { mail with results = ((Ok flags)::mail.results) } }}
+ commands(mail, tools)
+ | err ->
+ check_error(mail, tools, {{"COPY"}}, tag, err)
+ catch
+ | exn ->
+ check_exception(mail, tools, {{"copy"}}, tag, exn)
+
list(mail, tools, tag):
receive
| StarOk _str ->
@@ -501,6 +538,10 @@ list(mail, tools, tag):
expunge(mail, tools, tag):
receive
+ | Recent num ->
+ debug {{ eprintf "expunge received * RECENT: %d\n" num }}
+ let mail = [[ {mail with status={mail.status with recent=num}} ]]
+ expunge(mail, tools, tag)
| StarExpunge num ->
debug {{ eprintf "expunge received * EXPUNGE: %d\n" num }}
let mail = {{ { mail with expunged = (num::mail.expunged) } }}
View
@@ -250,6 +250,7 @@
| Some "ImapStore" -> ImapClientCore.ImapStore (unwrap_bsss value)
| Some "ImapSearch" -> ImapClientCore.ImapSearch (unwrap_bs value)
| Some "ImapSearchCs" -> ImapClientCore.ImapSearchCs (unwrap_bss value)
+ | Some "ImapCopy" -> ImapClientCore.ImapCopy (unwrap_bss value)
| Some "ImapList" -> ImapClientCore.ImapList (unwrap_ss value)
| Some "ImapCreate" -> ImapClientCore.ImapCreate (ServerLib.unwrap_string value)
| Some "ImapDelete" -> ImapClientCore.ImapDelete (ServerLib.unwrap_string value)
@@ -114,6 +114,7 @@ type Email.imap_command =
/ { ImapStore : (bool, string, string, string) }
/ { ImapSearch : (bool, string) }
/ { ImapSearchCs : (bool, string, string) }
+ / { ImapCopy : (bool, string, string) }
/ { ImapList : (string, string) }
/ { ImapCreate : string }
/ { ImapDelete : string }

0 comments on commit f4af24f

Please sign in to comment.