- the mathql interpreter is not helm-dependent any more

[helm.git] / helm / hbugs / common / hbugs_misc.ml

diff --git a/helm/hbugs/common/hbugs_misc.ml b/helm/hbugs/common/hbugs_misc.ml
index 85f926fc7dbe8dfc29fe9345ab0d0de2b4deebc4..b826318e0a05f924eb35f7c61b8570708f1b5d40 100644 (file)
--- a/helm/hbugs/common/hbugs_misc.ml
+++ b/helm/hbugs/common/hbugs_misc.ml
@@ -28,24 +28,38 @@
 
 open Printf;;
 
+let rec hashtbl_remove_all tbl key =
+  if Hashtbl.mem tbl key then begin
+    Hashtbl.remove tbl key;
+    hashtbl_remove_all tbl key
+  end else
+    ()
+
+  (** follows cut and paste from zack's Http_client_smart module *)
+
+exception Malformed_URL of string;;
+exception Malformed_HTTP_response of string;;
+
+let bufsiz = 16384;;
+let tcp_bufsiz = 4096;;
+
 let body_sep_RE = Pcre.regexp "\r\n\r\n";;
-let url_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "http://";;
+let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://";;
 let url_RE = Pcre.regexp "^([\\w.]+)(:(\\d+))?(/.*)?$";;
 let parse_url url =
   try
-    let subs = Pcre.extract ~rex:url_RE (Pcre.replace ~rex:url_scheme_RE url) in
+    let subs =
+      Pcre.extract ~rex:url_RE (Pcre.replace ~rex:http_scheme_RE url)
+    in
     (subs.(1),
     (if subs.(2) = "" then 80 else int_of_string subs.(3)),
     (if subs.(4) = "" then "/" else subs.(4)))
-  with exc ->
-    failwith
-      (sprintf "Can't parse url: %s (exception: %s)"
-        url (Printexc.to_string exc))
+  with exc -> raise (Malformed_URL url)
 ;;
 let get_body answer =
   match Pcre.split ~rex:body_sep_RE answer with
   | [_; body] -> body
-  | _ -> failwith "Invalid response received: can't parse response's body"
+  | _ -> raise (Malformed_HTTP_response answer)
 ;;
 
 let init_socket addr port =
@@ -62,15 +76,31 @@ let rec retrieve inchan buf =
   retrieve inchan buf
 ;;
 
-let http_get url =
+let http_get_iter_buf ~callback url =
   let (address, port, path) = parse_url url in
+  let buf = String.create tcp_bufsiz in
   let (inchan, outchan) = init_socket address port in
-  output_string outchan (sprintf "GET %s HTTP/1.0\r\n\r\n" path);
+  output_string outchan (sprintf "GET %s\r\n" path);
   flush outchan;
-  let buf = Buffer.create 1023 in
-  try
-    retrieve inchan buf
-  with End_of_file -> get_body (Buffer.contents buf)
+  (try
+    while true do
+      match input inchan buf 0 tcp_bufsiz with
+      | 0 -> raise End_of_file
+      | bytes when bytes = tcp_bufsiz ->  (* buffer full, no need to slice it *)
+          callback buf
+      | bytes when bytes < tcp_bufsiz ->  (* buffer not full, slice it *)
+          callback (String.sub buf 0 bytes)
+      | _ -> (* ( bytes < 0 ) || ( bytes > tcp_bufsiz ) *)
+          assert false
+    done
+  with End_of_file -> ());
+  close_in inchan (* close also outchan, same fd *)
+;;
+
+let http_get url =
+  let buf = Buffer.create (tcp_bufsiz * 10) in
+  http_get_iter_buf (fun data -> Buffer.add_string buf data) url;
+  get_body (Buffer.contents buf)
 ;;
 
 let http_post ?(body = "") url =
@@ -81,17 +111,10 @@ let http_post ?(body = "") url =
   output_string outchan "\r\n";
   output_string outchan body;
   flush outchan;
-  let buf = Buffer.create 1023 in
-  try
+  let buf = Buffer.create bufsiz in
+  (try
     retrieve inchan buf
-  with End_of_file -> get_body (Buffer.contents buf)
-;;
-
-let rec hashtbl_remove_all tbl key =
-  if Hashtbl.mem tbl key then begin
-    Hashtbl.remove tbl key;
-    hashtbl_remove_all tbl key
-  end else
-    ()
+  with End_of_file -> close_in inchan); (* close also outchan, same fd *)
+  get_body (Buffer.contents buf)
 ;;