Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[enhance] bslMail: switched the smtpServer into CPS

  • Loading branch information...
commit 32e2e4d241a8a0692b891afc65ba7566463c0a69 1 parent 57f483c
Frederic Ye Aqua-Ye authored
8 libnet/smtpServer.ml
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -45,14 +45,14 @@ type options =
opt_dialog: string;
opt_on_server_close : Scheduler.t -> unit;
opt_name: string;
- opt_email_handler : SCC.email -> int * string
+ opt_email_handler : SCC.email -> ((int * string) -> unit) -> unit
}
-let handle_email { SCC.from=_from; dests=_dests; body=_body } =
+let handle_email { SCC.from=_from; dests=_dests; body=_body } k =
#<If$minlevel 10>Logger.debug "handle_email:\n";
Logger.debug "FROM: %s TO: [%s]\n" _from (String.concat ", " _dests);
Logger.debug "%s\n" (Rcontent.get_content _body)#<End>;
- 250, "Ok"
+ k (250, "Ok")
let default_options =
{ opt_addr = "0.0.0.0";
14 libnet/smtpServerCore.proto
View
@@ -1,7 +1,7 @@
% -*-erlang-*-
%
-% Copyright © 2011 MLstate
+% Copyright © 2011, 2012 MLstate
%
% This file is part of OPA.
%
@@ -34,7 +34,7 @@
server_port: int;
hello_message: string;
client_domain: string;
- callback: email -> int * string;
+ callback: email -> ((int * string) -> unit) -> unit;
verify: string -> int * string;
expand: string -> (int * string) list;
extended: bool
@@ -168,12 +168,16 @@ get_data(state : state, email : email, last_was_crlf : bool):
catch
| exn -> error({{ sprintf "exn: %s" (Printexc.to_string exn) }}, state)
-process_email(state:state, email:email):
- debug {{ eprintf "process_email\n"; Pervasives.flush stderr }}
- let reply = {{ Ns (state.callback email) }}
+send_response(reply, state):
send(reply);
wait_for_quit(state)
+process_email(state:state, email:email):
+ debug {{ eprintf "process_email\n"; Pervasives.flush stderr }}
+ let cpl = !"state.callback" << state.callback email >>
+ let res = {{ Ns(fst cpl, snd cpl) }}
+ send_response(res, state)
+
wait_for_quit(state):
receive
| Vrfy str -> let resp = {{ state.verify str }} send(Ns resp); wait_for_quit(state)
18 opabsl/mlbsl/bslMail.ml
View
@@ -63,26 +63,26 @@
##module mailserver
- ##register init_server : int, string, SSL.secure_type, \
- (opa[string], opa[list(string)], opa[string] -> opa[tuple_2(int, string)]) -> void
- let init_server port addr secure_type handler =
+ ##register [cps-bypass] init_server : int, string, SSL.secure_type, \
+ (opa[string], opa[list(string)], opa[string], continuation(opa[tuple_2(int, string)]) -> void), continuation(opa[void]) -> void
+ let init_server port addr secure_type handler cvoid =
let ssl_certificate, ssl_verify_params = secure_type in
- let caml_handler email =
+ let caml_handler email k =
let f = ServerLib.wrap_string email.SmtpServerCore.from in
let c = Rcontent.get_content email.SmtpServerCore.body in
let c = ServerLib.wrap_string c in
let t = BslNativeLib.caml_list_to_opa_list ServerLib.wrap_string email.SmtpServerCore.dests in
- let res = handler f t c in
- let i, s = BslNativeLib.ocaml_tuple_2 res in
- ServerLib.unwrap_int i, ServerLib.unwrap_string s
+ handler f t c (QmlCpsServerLib.cont_ml (
+ fun res -> let i, s = BslNativeLib.ocaml_tuple_2 res in
+ k (ServerLib.unwrap_int i, ServerLib.unwrap_string s)))
in
- Runtime.add_smtpServer "smtpServer" {
+ let _ = Runtime.add_smtpServer "smtpServer" {
SmtpServer.default_options with
SmtpServer.opt_addr = addr;
SmtpServer.opt_port = port;
SmtpServer.opt_ssl_certificate = ssl_certificate;
SmtpServer.opt_ssl_verify_params = ssl_verify_params;
SmtpServer.opt_email_handler = caml_handler;
- }
+ } in QmlCpsServerLib.return cvoid ServerLib.void
##endmodule
Please sign in to comment.
Something went wrong with that request. Please try again.