debian: rebuilt against ocaml 3.08.2

[helm.git] / helm / http_getter / main.ml
diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml

index ed831c054b22c3db90c3f0e889f1159ca19648dd..640584e63a9729e2d03941162c5633039ac2c7a5 100644 (file)
--- a/helm/http_getter/main.ml
+++ b/helm/http_getter/main.ml
@@ -90,13 +90,16 @@ let parse_rdf_class (req: Http_types.request) =
    | "backward" -> `Backward
    | c -> raise (Bad_request ("Invalid RDF class: " ^ c))
  
+let xml_escape = Netencoding.Html.encode ~in_enc:`Enc_utf8 ()
+
  let html_tag ?exn () =
    let xml_decl = "<?xml version=\"1.0\"?>\n" in
    match exn with
-  | Some (exn, value) ->
+  | Some (exn, arg) ->
+      let (exn, arg) = (xml_escape exn, xml_escape arg) in
        sprintf
          "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\"\nhelm:exception=\"%s\"\nhelm:exception_arg=\"%s\">\n"
-        xml_decl xhtml_ns helm_ns exn value
+        xml_decl xhtml_ns helm_ns exn arg
    | None ->
        sprintf "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\">\n"
          xml_decl xhtml_ns helm_ns
@@ -268,7 +271,7 @@ let callback (req: Http_types.request) outchan =
      | "/getdtd" ->
          Http_getter_cache.respond_dtd ~patch:(parse_patch req)
            ~url:(sprintf "%s/%s"
-            (Helm_registry.get "getter.dtd_dir") (req#param "uri"))
+            (Lazy.force Http_getter_env.dtd_dir) (req#param "uri"))
            outchan
      | "/resolve" -> return_resolve (req#param "uri") outchan
      | "/register" ->
@@ -348,11 +351,7 @@ let callback (req: Http_types.request) outchan =
  
  let main () =
    Helm_registry.load_from configuration_file;
-  Http_getter_logger.set_log_level
-    (Helm_registry.get_opt_default Helm_registry.get_int 1 "getter.log_level");
-  Http_getter_logger.set_log_file
-    (Helm_registry.get_opt Helm_registry.get_string "getter.log_file");
-  Http_getter_env.reload ();
+  Http_getter.init ();
    print_string (Http_getter_env.env_to_string ());
    flush stdout;
    let batch_update =
@@ -365,7 +364,7 @@ let main () =
      Sys.catch_break true;
      try
        Http_daemon.start' ~mode:`Thread
-        ~timeout:(Some 600) ~port:(Helm_registry.get_int "getter.port")
+        ~timeout:(Some 600) ~port:(Lazy.force Http_getter_env.port)
          callback
      with Sys.Break -> ()  (* 'close_maps' already registered with 'at_exit' *)
    end