X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_common.ml;h=d56cf6909dcb6867bd576c60bddea372f414aea4;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=b1f96d8bddc13b682b37ae88813a6b8e0131cce5;hpb=f0e7ce0a6e8c15f198fab4d567b884a8ef7f6b0b;p=helm.git

diff --git a/helm/ocaml/getter/http_getter_common.ml b/helm/ocaml/getter/http_getter_common.ml
index b1f96d8bd..d56cf6909 100644
--- a/helm/ocaml/getter/http_getter_common.ml
+++ b/helm/ocaml/getter/http_getter_common.ml
@@ -52,7 +52,7 @@ let rec uri_of_string = function
           in
           Rdf_uri (prefix, rest)
       | _ -> raise (Invalid_URI uri))
-  | uri when is_cic_uri uri -> Cic_uri (Cic (Pcre.replace ~pat:"^cic:" uri))
+  | uri when is_cic_obj_uri uri -> Cic_uri (Cic (Pcre.replace ~pat:"^cic:" uri))
   | uri when is_nuprl_uri uri -> Nuprl_uri (Pcre.replace ~pat:"^nuprl:" uri)
   | uri when is_theory_uri uri ->
       Cic_uri (Theory (Pcre.replace ~pat:"^theory:" uri))
@@ -72,101 +72,95 @@ let patch_xsl ?(via_http = true) () =
     in
     patch_include (patch_import line)
 
-let patch_entity ?(via_http = true) () =
-  if via_http then
-    fun line ->
-      List.fold_left
-        (fun url s ->
-          Pcre.replace
-            ~pat:(sprintf "ENTITY (.*) SYSTEM\\s+\"(%s/)?" url)
-            ~templ:(sprintf "ENTITY $1 SYSTEM \"%s/getdtd?uri="
-              (Lazy.force Http_getter_env.my_own_url))
-            s)
-        line
-        (Lazy.force Http_getter_env.dtd_base_urls)
-  else
-    fun line ->
-      List.fold_left
-        (fun url s ->
-          Pcre.replace
-            ~pat:(sprintf "ENTITY (.*) SYSTEM\\s+\"(%s/)?" url)
-            ~templ:(sprintf "ENTITY $1 SYSTEM \"file://%s/"
-              (Lazy.force Http_getter_env.dtd_dir))
-            s)
-        line
-        (Lazy.force Http_getter_env.dtd_base_urls)
+let patch_system kind ?(via_http = true) () =
+  let rex =
+    Pcre.regexp (sprintf "%s (.*) SYSTEM\\s+\"((%s)/)?" kind
+      (String.concat "|" (Lazy.force Http_getter_env.dtd_base_urls)))
+  in
+  let templ =
+    if via_http then
+      sprintf "%s $1 SYSTEM \"%s/getdtd?uri=" kind
+        (Lazy.force Http_getter_env.my_own_url)
+    else
+      sprintf "%s $1 SYSTEM \"file://%s/" kind
+        (Lazy.force Http_getter_env.dtd_dir)
+  in
+  fun line -> Pcre.replace ~rex ~templ line
 
-let patch_doctype ?(via_http = true) () =
-  if via_http then
-    fun line ->
-      List.fold_left
-        (fun url s ->
-          Pcre.replace
-            ~pat:(sprintf "DOCTYPE (.*) SYSTEM\\s+\"%s/" url)
-            ~templ:(sprintf "DOCTYPE $1 SYSTEM \"%s/getdtd?uri="
-              (Lazy.force Http_getter_env.my_own_url))
-            s)
-        line
-        (Lazy.force Http_getter_env.dtd_base_urls)
-  else
-    fun line ->
-      List.fold_left
-        (fun url s ->
-          Pcre.replace
-            ~pat:(sprintf "DOCTYPE (.*) SYSTEM\\s+\"%s/" url)
-            ~templ:(sprintf "DOCTYPE $1 SYSTEM \"file://%s/"
-              (Lazy.force Http_getter_env.my_own_url))
-            s)
-        line
-        (Lazy.force Http_getter_env.dtd_base_urls)
+let patch_entity = patch_system "ENTITY"
+let patch_doctype = patch_system "DOCTYPE"
 
-let patch_dtd = patch_entity
+let patch_xmlbase =
+  let rex = Pcre.regexp "^(\\s*<\\w[^ ]*)(\\s|>)" in
+  fun xmlbases baseurl baseuri s ->
+    let s' =
+      Pcre.replace ~rex
+        ~templ:(sprintf "$1 xml:base=\"%s\" helm:base=\"%s\"$2" baseurl baseuri)
+        s
+    in
+    if s <> s' then xmlbases := None;
+    s'
 
-let patch_xml ?via_http () line =
-  patch_doctype ?via_http () (patch_entity ?via_http () line)
+let patch_dtd = patch_entity
+let patch_xml ?via_http ?xmlbases () =
+  let xmlbases = ref xmlbases in
+  fun line ->
+    match !xmlbases with
+    | None -> patch_doctype ?via_http () (patch_entity ?via_http () line)
+    | Some (xmlbaseuri, xmlbaseurl) ->
+        patch_xmlbase xmlbases xmlbaseurl xmlbaseuri
+          (patch_doctype ?via_http () (patch_entity ?via_http () line))
 
 let return_file
-  ~fname ?contype ?contenc
-  ?(patch_fun = fun x -> x) ?(gunzip = false) ?(via_http = true) outchan
-  =
-  let headers =
-    match (contype, contenc) with
-    | (Some t, Some e) -> ["Content-Encoding", e; "Content-Type", t]
-    | (Some t, None) -> ["Content-Type" , t]
-    | (None, Some e) -> ["Content-Encoding", e]
-    | (None, None) -> []
-  in
+  ~fname ?contype ?contenc ?patch_fun ?(gunzip = false) ?(via_http = true)
+  ~enc outchan
+=
   if via_http then begin
-    Http_daemon.send_basic_headers ~code:200 outchan;
+    let headers =
+      match (contype, contenc) with
+      | (Some t, Some e) -> ["Content-Encoding", e; "Content-Type", t]
+      | (Some t, None) -> ["Content-Type" , t]
+      | (None, Some e) -> ["Content-Encoding", e]
+      | (None, None) -> []
+    in
+    Http_daemon.send_basic_headers ~code:(`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) =
-      (Http_getter_misc.tempfile (), Http_getter_misc.tempfile ())
-    in
-    try
-      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");
-          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"); flush outchan)
-        tmp1;
-      Sys.remove tmp1       (* rm tmp1 *)
-    with e ->
-      Sys.remove tmp1;
-      raise e
-  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"); flush outchan)
-      fname;
-  end
+  match gunzip, patch_fun with
+  | true, Some patch_fun ->
+      Http_getter_logger.log ~level:2
+        "Patch required, uncompress/compress cycle needed :-(";
+      (* gunzip needed, uncompress file, apply patch_fun to it, compress the
+       * result and sent it to client *)
+      let (tmp1, tmp2) =
+        (Http_getter_misc.tempfile (), Http_getter_misc.tempfile ())
+      in
+      (try
+        Http_getter_misc.gunzip ~keep:true ~output:tmp1 fname; (* gunzip 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");
+            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"); flush outchan)
+          tmp1;
+        Sys.remove tmp1       (* rm tmp1 *)
+      with e ->
+        Sys.remove tmp1;
+        raise e)
+  | false, Some patch_fun ->
+      (match enc with
+      | `Normal ->
+          Http_getter_misc.iter_file
+            (fun line -> output_string outchan (patch_fun (line ^ "\n")))
+            fname
+      | `Gzipped -> assert false)
+        (* dangerous case, if this happens it needs to be investigated *)
+  | _, None -> Http_getter_misc.iter_file_data (output_string outchan) fname
 ;;