X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fhttp_getter%2Fmain.ml;h=5f7e8cd93582e94a90dd9bf27619266031451ab8;hb=31afc64440b7da53bb79e6f1524d47bf0fb56aaf;hp=44c69610e1d4e0ffffcef79d3c332988e127ed8f;hpb=cb196689329c36dd651513a2859a2f9a714ea07b;p=helm.git diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml index 44c69610e..5f7e8cd93 100644 --- a/helm/http_getter/main.ml +++ b/helm/http_getter/main.ml @@ -29,6 +29,7 @@ open Printf open Http_getter_common +open Http_getter_const open Http_getter_misc open Http_getter_types @@ -89,22 +90,41 @@ 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 = "\n" in + match exn with + | Some (exn, arg) -> + let (exn, arg) = (xml_escape exn, xml_escape arg) in + sprintf + "%s\n" + xml_decl xhtml_ns helm_ns exn arg + | None -> + sprintf "%s\n" + xml_decl xhtml_ns helm_ns + let mk_return_fun pp_fun contype msg outchan = Http_daemon.respond ~body:(pp_fun msg) ~headers:["Content-Type", contype] outchan -let pp_error s = - sprintf "
Http Getter error: %s" s -let pp_internal_error s = - sprintf "Http Getter Internal error: %s" s -let pp_msg s = sprintf "%s" s +let pp_msg s = sprintf "%s%s" (html_tag ()) s let null_pp s = s -let return_html_error = mk_return_fun pp_error "text/html" -let return_html_internal_error = mk_return_fun pp_internal_error "text/html" -let return_html_msg = mk_return_fun pp_msg "text/html" -let return_html_raw = mk_return_fun null_pp "text/html" +let return_html_error exn = + let pp_error s = + sprintf "%s\nHttp Getter error: %s" + (html_tag ~exn ()) s + in + mk_return_fun pp_error "text/xml" +let return_html_internal_error exn = + let pp_internal_error s = + sprintf "%s\nHttp Getter Internal error: %s