debian version 0.6.3-2

[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 bbed79722d421c58a9f2c57f57cd45486b893c7b..4366417de179da32c02ea2a3c3c4e8794328b29f 100644 (file)
--- a/helm/ocaml/getter/http_getter_common.ml
+++ b/helm/ocaml/getter/http_getter_common.ml
@@ -72,46 +72,44 @@ let patch_xsl ?(via_http = true) () =
     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_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 ->
-      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_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
@@ -125,7 +123,7 @@ let return_file
     | (None, None) -> []
   in
   if via_http then begin
-    Http_daemon.send_basic_headers ~code:200 outchan;
+    Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
     Http_daemon.send_headers headers outchan;
     Http_daemon.send_CRLF outchan
   end;