How to handle errors from Https_client?

This is a multi-part message in MIME format.
--------------060502050602000508060606
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 7bit

Hi,

Using Https_client with OCamlnet 3.6.3 and 3.7.3 some exceptions seem to escape the pipeline.
For example if I take examples/netclient/simple/http_download.ml, and initialize Https_client according to the docs and trigger an https error on purpose (try to use HTTPS on an HTTP port):
Fatal error: exception Invalid_argument("remove_resource: the group is terminated")

Also if I take examples/netclient/simple/http_mt.ml and initialize Https_client as the docs suggest I get
this on an https error:
Thread 1 killed on uncaught exception Invalid_argument("remove_resource: the group is terminated")

With Http_client and pipeline#add_with_callback everything is fine: I get my callback invoked,
and I can check http_call#status for the actual error, and the pipeline keeps working.

With Https_client and the Convenience module I get the exception but since it creates a new pipeline each time I can just wrap it and catch the exception there, and keep using it after the first error.
With the pipeline it looks like after the first https error the pipeline becomes unusable.

What am I doing wrong?

I have attached a testcase, let me know if you need more info.

Best regards,
--Edwin



--------------060502050602000508060606
Content-Type: text/x-ocaml;
 name="http_mt.ml"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="http_mt.ml"

(* HTTP Pipelines and multithreading
 *
 *
 * This is the recommended solution for multi-threaded apps:
 * A designated HTTP thread handles all HTTP requests, and the other threads
 * of the program send their HTTP requests to the HTTP thread. The HTTP
 * thread can process several requests in parallel.
 *)

(* Compile with:
 * ocamlfind ocamlopt -o t -package netclient,threads -linkpkg -thread http_mt.ml
 *)


open Http_client

exception HTTP_Job of http_call * (http_call -> unit)
  (* This is not an exception in the usual sense, but simply a tagged
   * pair (call, f_done). This pair is pushed onto the event queue to
   * send another HTTP request [call] to the HTTP thread. When the
   * request is processed, the function [f_done] is called. Note that
   * [f_done] is called in the context of the HTTP thread, and it must
   * arrange some synchronisation with the calling thread to return
   * the result.
   *)


let http_esys = ref None

let get_http_esys() =
  match !http_esys with
    | None -> failwith "No event system"
    | Some e -> e

let http_keep_alive_group = ref None 

let get_http_keep_alive_group() =
  match !http_keep_alive_group with
    | None -> failwith "No keep alive group"
    | Some g -> g


let http_init() =
  let esys = Unixqueue.create_unix_event_system() in
  let keep_alive_group = Unixqueue.new_group esys in
  http_esys := Some esys;
  http_keep_alive_group := Some keep_alive_group
;;


let http_thread() =
  (* Create the HTTP pipeline for a known event system: *)
  let esys = get_http_esys() in
  let pipeline = new pipeline in
  pipeline # set_event_system esys;
  Ssl.init ~thread_safe:true ();
  let ctx = Ssl.create_context Ssl.TLSv1 Ssl.Client_context in
  let tct = Https_client.https_transport_channel_type ctx in
  pipeline # configure_transport Http_client.https_cb_id tct;

  (* In order to keep the event system active when there are no HTTP requests
   * to process, we add an artificial timer that never times out (-1.0).
   * The timer is bound to a Unixqueue group, and by clearing this group
   * the timer can be deleted.
   *)
  let keep_alive_group = get_http_keep_alive_group() in
  let w = Unixqueue.new_wait_id esys in
  Unixqueue.add_resource esys keep_alive_group (Unixqueue.Wait w,(-1.0));

  (* We arrange now that whenever a HTTP_Job arrives on the event queue,
   * a new HTTP call is started.
   *)
  Unixqueue.add_handler
    esys
    keep_alive_group
    (fun _ _ event ->
       match event with
	 | Unixqueue.Extra (HTTP_Job (call, f_done)) ->
	     pipeline # add_with_callback call f_done
	 | _ ->
	     raise Equeue.Reject  (* The event is not for us *)
    );

  (* Now start the event queue. It returns when all jobs are done and
   * the keep_alive_group is cleared.
   *)
  Unixqueue.run esys;
  ()
;;


let shutdown_http_thread() =
  let esys = get_http_esys() in
  let keep_alive_group = get_http_keep_alive_group() in
  Unixqueue.clear esys keep_alive_group;
  http_keep_alive_group := None;
  http_esys := None
;;


let caller_thread() =
  (* This is a thread that calls for an HTTP request *)
  let esys = get_http_esys() in
  let mutex = Mutex.create() in
  let cond = Condition.create () in
  let call = new get "https://www.google.com:80/" in
  let result = ref "" in
  let f_done call =
    (* This function is called from the scope of the HTTP thread!
     * Signal the calling thread that the call is done:
     *)
    Mutex.lock mutex;
    result := ( match call # status with
		  | `Successful ->
		      let body = call # response_body # value in
		      body
      | `Http_protocol_error e ->
          Printexc.to_string e
		  | _ ->
		      "some problem"
	      );
    Condition.signal cond;
    Mutex.unlock mutex
  in
  Unixqueue.add_event esys (Unixqueue.Extra (HTTP_Job(call, f_done)));
  (* Wait until we get a signal: *)
  Mutex.lock mutex;
  Condition.wait cond mutex;
  print_endline !result;
  flush stdout;
  Mutex.unlock mutex
;;


let _ =
  (* Unixqueue.set_debug_mode true; *)

  (* Initialize first: *)
  http_init();

  (* Start the HTTP thread: *)
  let http_thr = Thread.create http_thread () in
  
  (* Start a lot of caller threads: *)
  let callers = ref [] in
  for n = 1 to 100 do
    let thr = Thread.create caller_thread () in
    callers := thr :: !callers
  done;

  (* Wait until the callers return: *)
  List.iter Thread.join !callers;

  (* Shut down the HTTP thread, and wait until it is done *)
  shutdown_http_thread();
  Thread.join http_thr
;;

  


--------------060502050602000508060606
Content-Type: text/x-ocaml;
 name="http_download.ml"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="http_download.ml"

(* This example downloads a URL into a file *)

open Http_client

let download url =
  let pipeline = new pipeline in
  let get_call = new get url in
  get_call # set_response_body_storage (`File (fun () -> "file"));
  Ssl.init();
  let ctx = Ssl.create_context Ssl.TLSv1 Ssl.Client_context in
  let tct = Https_client.https_transport_channel_type ctx in
  pipeline # configure_transport Http_client.https_cb_id tct;
  pipeline # add get_call;
  pipeline # add get_call;
  pipeline # run()
;;

let () =
  download "https://www.google.com:80";


--------------060502050602000508060606
Content-Type: text/plain; charset=UTF-8;
 name="_tags"
Content-Transfer-Encoding: base64
Content-Disposition: attachment;
 filename="_tags"

dHJ1ZTogcGFja2FnZShuZXRjbGllbnQpLCBwYWNrYWdlKGVxdWV1ZS1zc2wpLCBkZWJ1Zwo8
aHR0cF9tdC4qPjogdGhyZWFkCgo=
--------------060502050602000508060606
Content-Type: application/x-shellscript;
 name="build.sh"
Content-Transfer-Encoding: base64
Content-Disposition: attachment;
 filename="build.sh"

IyEvYmluL3NoCm9jYW1sYnVpbGQgLXVzZS1vY2FtbGZpbmQgLi9odHRwX2Rvd25sb2FkLm5h
dGl2ZSAuL2h0dHBfbXQubmF0aXZlCg==
--------------060502050602000508060606
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

------------------------------------------------------------------------------
Learn the latest--Visual Studio 2012, SharePoint 2013, SQL 2012, more!
Discover the easy way to master current and previous Microsoft technologies
and advance your career. Get an incredible 1,500+ hours of step-by-step
tutorial videos with LearnDevNow. Subscribe today and save!
http://pubads.g.doubleclick.net/gampad/clk?id=58040911&iu=/4140/ostg.clktrk
--------------060502050602000508060606
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Ocamlnet-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/ocamlnet-devel

--------------060502050602000508060606--