Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[feature] imapClient: Added STATUS command.

  • Loading branch information...
commit e7512ebc71fd652a70dfd22980b6e9b4ad54f4a7 1 parent f4af24f
@nrs135 nrs135 authored Aqua-Ye committed
View
2  libnet/imapClient.ml
@@ -29,7 +29,7 @@ let mail_recv_aux ?client_certificate ?verify_params ?(secure=false) sched
password=password;
commands=commands;
status={ ICC.flags=""; exists=(-1); recent=(-1); oks=[]; rwstatus="" };
- fetched=[]; list=[]; expunged=[];
+ fetched=[]; list=[]; expunged=[]; statused=[];
results=[];
from=""; dests=[]; data="" } in
let rec try_mx mail cont =
View
49 libnet/imapClientCore.proto
@@ -1,4 +1,4 @@
-% -*-erlang-*-
+% -*-proto-*-
%
% Copyright © 2011 MLstate
@@ -38,6 +38,7 @@
| ImapCreate of string
| ImapDelete of string
| ImapRename of (string * string)
+ | ImapStatus of (string * string)
| ImapExpunge
-type commands = command list
@@ -61,6 +62,7 @@
| FetchResult of (int * string * string) list
| StoreResult of (int * string) list
| ListResult of (string * string * string) list
+ | StatusResult of (string * string) list
| ExpungeResult of int list
| Error of string
@@ -73,6 +75,7 @@
status : status;
fetched : (int * string * string) list;
list : (string * string * string) list;
+ statused : (string * string) list;
expunged : int list;
results : results;
from : string;
@@ -115,6 +118,7 @@ let string_of_command = function
| ImapCreate s -> sprintf "CREATE %s" s
| ImapDelete s -> sprintf "DELETE %s" s
| ImapRename (f,t) -> sprintf "RENAME %s %s" f t
+ | ImapStatus (m,i) -> sprintf "STATUS %s %s" m i
| ImapExpunge -> "EXPUNGE"
let add_fetched str fetched =
match fetched with
@@ -139,6 +143,7 @@ let add_fetched str fetched =
-define (StarFetchLen (num:int, what, len:int)) = "* " num " FETCH (" what " {" len "}\r\n"
-define (StarFetch (num:int, result)) = "* " num " FETCH " result "\r\n"
-define (StarList (flags,rf,mailbox)) = "* LIST ("~ flags ") " rf " " mailbox "\r\n"
+-define (StarStatus (mailbox,items)) = "* STATUS "~ mailbox " (" items ")\r\n"
-define (Search (tag, params)) = tag " SEARCH " params "\r\n"
-define (UidSearch (tag, params)) = tag " UID SEARCH " params "\r\n"
-define (SearchCs (tag, cs, params)) = tag " SEARCH CHARSET " cs " " params "\r\n"
@@ -153,6 +158,7 @@ let add_fetched str fetched =
-define (Create (tag, mailbox)) = tag " CREATE " mailbox "\r\n"
-define (Delete (tag, mailbox)) = tag " DELETE " mailbox "\r\n"
-define (Rename (tag, frommb, tomb)) = tag " RENAME " frommb " " tomb "\r\n"
+-define (Status (tag, mailbox, items)) = tag " STATUS " mailbox " (" items ")\r\n"
-define (Expunge tag) = tag " EXPUNGE\r\n"
-define (Close tag) = tag " CLOSE\r\n"
@@ -164,6 +170,7 @@ let add_fetched str fetched =
-define (CreateOk (tag,str)) = tag " OK CREATE "~ str "\r\n"
-define (DeleteOk (tag,str)) = tag " OK DELETE "~ str "\r\n"
-define (RenameOk (tag,str)) = tag " OK RENAME "~ str "\r\n"
+-define (StatusOk (tag,str)) = tag " OK STATUS "~ str "\r\n"
-define (ExpungeOk (tag,str)) = tag " OK EXPUNGE "~ str "\r\n"
-define (CloseOk (tag,str)) = tag " OK CLOSE "~ str "\r\n"
-define (StarOk str) = "* OK " str "\r\n"
@@ -198,14 +205,6 @@ login(mail, tools, tag):
else
debug {{ eprintf "login received LOGIN OK: tag=%s flags=%s str=%s\n%!" tag _flags _str }}
commands(mail, tools)
-% let tag = {{ get_tag() }}
-% if {{ mail.readonly }}
-% then
-% send (Examine (tag, mail.mailbox));
-% select(mail, tools, tag, {{"EXAMINE"}})
-% else
-% send (Select (tag, mail.mailbox));
-% select(mail, tools, tag, {{"SELECT"}})
| err ->
debug {{ eprintf "ImapClientCore.login received err: %s\n%!" (string_of_msg err) }}
error({{ string_of_msg err }}, tools)
@@ -313,6 +312,14 @@ commands(mail, tools):
send (Delete (tag, mailbox));
wait_for_ok(mail, tools, tag, {{"delete"}}, {{"DELETE"}},
{{function DeleteOk (rt,s) -> Some (rt,s) | _ -> None}}, {{Ok "deleted"}})
+ | ImapStatus (mailbox, items) ->
+ if {{ items = "" || mailbox = "" }}
+ then
+ error({{ "Empty strings would make STATUS command invalid, use \"\" instead" }}, tools)
+ else
+ send (Status (tag, mailbox, items));
+ status(mail, tools, tag)
+ end
| ImapRename (frommb, tomb) ->
send (Rename (tag, frommb, tomb));
wait_for_ok(mail, tools, tag, {{"rename"}}, {{"RENAME"}},
@@ -536,6 +543,30 @@ list(mail, tools, tag):
| exn ->
check_exception(mail, tools, {{"list"}}, tag, exn)
+status(mail, tools, tag):
+ receive
+ | StarOk _str ->
+ debug {{ eprintf "status received * OK: %s\n" _str }}
+ status(mail, tools, tag)
+ | StarStatus (mailbox, items) ->
+ debug {{ eprintf "status received * STATUS: %s (%s)\n" mailbox items }}
+ let mail = {{ { mail with statused = ((mailbox,items)::mail.statused) } }}
+ status(mail, tools, tag)
+ | StatusOk (rtag,_str) ->
+ if {{ rtag <> tag }}
+ then
+ debug {{ eprintf "status received mismatched STATUS OK: rtag=%s tag=%s str=%s\n" rtag tag _str }}
+ error({{ sprintf "Tag mismatch: %s vs. %s" rtag tag }}, tools)
+ else
+ debug {{ eprintf "status received STATUS OK: tag=%s str=%s\n" tag _str }}
+ let mail = {{ { mail with results = ((StatusResult mail.statused)::mail.results) } }}
+ commands(mail, tools)
+ | err ->
+ check_error(mail, tools, {{"STATUS"}}, tag, err)
+ catch
+ | exn ->
+ check_exception(mail, tools, {{"status"}}, tag, exn)
+
expunge(mail, tools, tag):
receive
| Recent num ->
View
9 opabsl/mlbsl/bslMail.ml
@@ -114,6 +114,7 @@
let searchresult = ServerLib.static_field_of_name "SearchResult"
let fetchresult = ServerLib.static_field_of_name "FetchResult"
let storeresult = ServerLib.static_field_of_name "StoreResult"
+ let statusresult = ServerLib.static_field_of_name "StatusResult"
let listresult = ServerLib.static_field_of_name "ListResult"
let expungeresult = ServerLib.static_field_of_name "ExpungeResult"
let no = ServerLib.static_field_of_name "No"
@@ -141,6 +142,8 @@
in
let wrap_is (i,s) =
BslNativeLib.opa_tuple_2 (ServerLib.wrap_int i, ServerLib.wrap_string s) in
+ let wrap_ss (s1,s2) =
+ BslNativeLib.opa_tuple_2 (ServerLib.wrap_string s1, ServerLib.wrap_string s2) in
let wrap_iss (i1,s2,s3) =
BslNativeLib.opa_tuple_3 (ServerLib.wrap_int i1, ServerLib.wrap_string s2, ServerLib.wrap_string s3) in
let wrap_sss (s1,s2,s3) =
@@ -210,6 +213,11 @@
let rc = ServerLib.empty_record_constructor in
let rc = ServerLib.add_field rc storeresult opa_isl in
ServerLib.make_record rc
+ | ImapClientCore.StatusResult ssl ->
+ let opa_ssl = BslNativeLib.caml_list_to_opa_list wrap_ss ssl in
+ let rc = ServerLib.empty_record_constructor in
+ let rc = ServerLib.add_field rc statusresult opa_ssl in
+ ServerLib.make_record rc
| ImapClientCore.ListResult sssl ->
let opa_sssl = BslNativeLib.caml_list_to_opa_list wrap_sss sssl in
let rc = ServerLib.empty_record_constructor in
@@ -255,6 +263,7 @@
| Some "ImapCreate" -> ImapClientCore.ImapCreate (ServerLib.unwrap_string value)
| Some "ImapDelete" -> ImapClientCore.ImapDelete (ServerLib.unwrap_string value)
| Some "ImapRename" -> ImapClientCore.ImapRename (unwrap_ss value)
+ | Some "ImapStatus" -> ImapClientCore.ImapStatus (unwrap_ss value)
| Some "ImapExpunge" -> ImapClientCore.ImapExpunge
| _ -> assert false)
(unwrap_opa_email_imap_command command) ImapClientCore.ImapNoop)
View
2  stdlib/web/mail/email.opa
@@ -119,6 +119,7 @@ type Email.imap_command =
/ { ImapCreate : string }
/ { ImapDelete : string }
/ { ImapRename : (string, string) }
+ / { ImapStatus : (string, string) }
/ { ImapExpunge }
//type Email.imap_status = {
@@ -141,6 +142,7 @@ type Email.imap_result =
/ { FetchResult : list((int, string, string)) }
/ { StoreResult : list((int, string)) }
/ { ListResult : list((string, string, string)) }
+ / { StatusResult : list((string, string)) }
/ { ExpungeResult : list(int) }
/ { Error : string }
Please sign in to comment.
Something went wrong with that request. Please try again.