- added via_http parameter so that when the getter is used locally (i.e.

[helm.git] / helm / ocaml / getter / http_getter_common.ml

diff --git a/helm/ocaml/getter/http_getter_common.ml b/helm/ocaml/getter/http_getter_common.ml
index 62a52c792f1713b9f152881421b889a1d76f46dd..bbed79722d421c58a9f2c57f57cd45486b893c7b 100644 (file)
--- a/helm/ocaml/getter/http_getter_common.ml
+++ b/helm/ocaml/getter/http_getter_common.ml
@@ -31,8 +31,8 @@ open Printf;;
 
 let string_of_ls_flag = function No -> "NO" | Yes -> "YES" | Ann -> "ANN"
 let string_of_encoding = function
-  | Enc_normal -> "Normal"
-  | Enc_gzipped -> "GZipped"
+  | `Normal -> "Normal"
+  | `Gzipped -> "GZipped"
 
 let is_cic_obj_uri uri = Pcre.pmatch ~pat:"^cic:" uri
 let is_theory_uri uri = Pcre.pmatch ~pat:"^theory:" uri
@@ -58,35 +58,64 @@ let rec uri_of_string = function
       Cic_uri (Theory (Pcre.replace ~pat:"^theory:" uri))
   | uri -> raise (Invalid_URI uri)
 
-let patch_xml line =
-  Pcre.replace
-    ~pat:(sprintf "DOCTYPE (.*) SYSTEM\\s+\"%s/"
-      (Lazy.force Http_getter_env.dtd_base_url))
-    ~templ:(sprintf "DOCTYPE $1 SYSTEM \"%s/getdtd?uri="
-      (Lazy.force Http_getter_env.my_own_url))
-    line
-let patch_xsl line =
-  let mk_patch_fun tag line =
-    Pcre.replace
-      ~pat:(sprintf "%s\\s+href=\"" tag)
-      ~templ:(sprintf "%s href=\"%s/getxslt?uri="
-        tag (Lazy.force Http_getter_env.my_own_url))
-      line
-  in
-  let (patch_import, patch_include) =
-    (mk_patch_fun "xsl:import", mk_patch_fun "xsl:include")
-  in
-  patch_include (patch_import line)
-let patch_dtd line =
-  Pcre.replace
-    ~pat:(sprintf "ENTITY (.*) SYSTEM\\s+\"(%s/)?"
-      (Lazy.force Http_getter_env.dtd_base_url))
-    ~templ:(sprintf "ENTITY $1 SYSTEM \"%s/getdtd?uri="
-      (Lazy.force Http_getter_env.my_own_url))
-    line
+let patch_xsl ?(via_http = true) () =
+  fun line ->
+    let mk_patch_fun tag line =
+      Pcre.replace
+        ~pat:(sprintf "%s\\s+href=\"" tag)
+        ~templ:(sprintf "%s href=\"%s/getxslt?uri="
+          tag (Lazy.force Http_getter_env.my_own_url))
+        line
+    in
+    let (patch_import, patch_include) =
+      (mk_patch_fun "xsl:import", mk_patch_fun "xsl:include")
+    in
+    patch_include (patch_import line)
+
+let patch_entity ?(via_http = true) () =
+  if via_http then
+    fun line ->
+      Pcre.replace
+        ~pat:(sprintf "ENTITY (.*) SYSTEM\\s+\"(%s/)?"
+          (Lazy.force Http_getter_env.dtd_base_url))
+        ~templ:(sprintf "ENTITY $1 SYSTEM \"%s/getdtd?uri="
+          (Lazy.force Http_getter_env.my_own_url))
+        line
+  else
+    fun line ->
+      Pcre.replace
+        ~pat:(sprintf "ENTITY (.*) SYSTEM\\s+\"(%s/)?"
+          (Lazy.force Http_getter_env.dtd_base_url))
+        ~templ:(sprintf "ENTITY $1 SYSTEM \"file://%s/"
+          (Lazy.force Http_getter_env.dtd_dir))
+        line
+
+let patch_doctype ?(via_http = true) () =
+  if via_http then
+    fun line ->
+      Pcre.replace
+        ~pat:(sprintf "DOCTYPE (.*) SYSTEM\\s+\"%s/"
+          (Lazy.force Http_getter_env.dtd_base_url))
+        ~templ:(sprintf "DOCTYPE $1 SYSTEM \"%s/getdtd?uri="
+          (Lazy.force Http_getter_env.my_own_url))
+        line
+  else
+    fun line ->
+      Pcre.replace
+        ~pat:(sprintf "DOCTYPE (.*) SYSTEM\\s+\"%s/"
+          (Lazy.force Http_getter_env.dtd_base_url))
+        ~templ:(sprintf "DOCTYPE $1 SYSTEM \"file://%s/"
+          (Lazy.force Http_getter_env.dtd_dir))
+        line
+
+let patch_dtd = patch_entity
+
+let patch_xml ?via_http () line =
+  patch_doctype ?via_http () (patch_entity ?via_http () line)
 
 let return_file
-  ~fname ?contype ?contenc ?(patch_fun = fun x -> x) ?(gunzip = false) outchan
+  ~fname ?contype ?contenc
+  ?(patch_fun = fun x -> x) ?(gunzip = false) ?(via_http = true) outchan
   =
   let headers =
     match (contype, contenc) with
@@ -95,9 +124,11 @@ let return_file
     | (None, Some e) -> ["Content-Encoding", e]
     | (None, None) -> []
   in
-  Http_daemon.send_basic_headers ~code:200 outchan;
-  Http_daemon.send_headers headers outchan;
-  Http_daemon.send_CRLF outchan;
+  if via_http then begin
+    Http_daemon.send_basic_headers ~code:200 outchan;
+    Http_daemon.send_headers headers outchan;
+    Http_daemon.send_CRLF outchan
+  end;
   if gunzip then begin  (* gunzip needed, uncompress file, apply patch_fun to
                         it, compress the result and sent it to client *)
     let (tmp1, tmp2) =
@@ -107,20 +138,23 @@ let return_file
       Http_getter_misc.gunzip ~keep:true ~output:tmp1 fname;(* gunzip to tmp1 *)
       let new_file = open_out tmp2 in
       Http_getter_misc.iter_file  (* tmp2 = patch(tmp1) *)
-        (fun line -> output_string new_file (patch_fun line ^ "\n"))
+        (fun line ->
+          output_string new_file (patch_fun line ^ "\n");
+          flush outchan)
         tmp1;
       close_out new_file;
       Http_getter_misc.gzip ~output:tmp1 tmp2;  (* tmp1 = gzip(tmp2); rm tmp2 *)
       Http_getter_misc.iter_file  (* send tmp1 to client as is*)
-        (fun line -> output_string outchan (line ^ "\n"))
+        (fun line -> output_string outchan (line ^ "\n"); flush outchan)
         tmp1;
       Sys.remove tmp1       (* rm tmp1 *)
     with e ->
       Sys.remove tmp1;
       raise e
-  end else  (* no need to gunzip, apply patch_fun directly to file *)
+  end else begin (* no need to gunzip, apply patch_fun directly to file *)
     Http_getter_misc.iter_file
-      (fun line -> output_string outchan (patch_fun line ^ "\n"))
-      fname
+      (fun line -> output_string outchan (patch_fun line ^ "\n"); flush outchan)
+      fname;
+  end
 ;;