X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fhttp_getter%2Fmain.ml;h=f65e991b7c263fbd7a714e3efbd755684080a3c4;hb=e01753bf730b3c4e50df0655f7940f8720b16524;hp=699c685bb6c56cc840306cc2d84bbe96a02950b6;hpb=750e15351055085126b3719e140f96f5f9d41d95;p=helm.git diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml index 699c685bb..f65e991b7 100644 --- a/helm/http_getter/main.ml +++ b/helm/http_getter/main.ml @@ -29,14 +29,13 @@ open Printf open Http_getter_common +open Http_getter_const open Http_getter_misc open Http_getter_types -open Http_getter_debugger (* constants *) -(* let configuration_file = "/projects/helm/etc/http_getter.conf.xml" *) -let configuration_file = "http_getter.conf.xml" +let configuration_file = BuildTimeOpts.conffile let common_headers = [ "Cache-Control", "no-cache"; @@ -71,26 +70,6 @@ let parse_output_format meth (req: Http_types.request) = | s when String.lowercase s = "xml" -> `Xml | s -> raise (Bad_request ("Invalid /" ^ meth ^ " format: " ^ s)) - (* parse "baseuri" format for /ls method, no default value *) -let parse_ls_uri = - let parse_ls_RE = Pcre.regexp "^(\\w+):(.*)$" in - let trailing_slash_RE = Pcre.regexp "/+$" in - let wrong_uri uri = - raise (Bad_request ("Invalid /ls baseuri: " ^ uri)) - in - fun (req: Http_types.request) -> - let baseuri = req#param "baseuri" in - try - let subs = - Pcre.extract ~rex:parse_ls_RE - (Pcre.replace ~rex:trailing_slash_RE baseuri) - in - (match (subs.(1), subs.(2)) with - | "cic", uri -> Cic uri - | "theory", uri -> Theory uri - | _ -> wrong_uri baseuri) - with Not_found -> wrong_uri baseuri - (* parse "position" argument, default is 0 *) let parse_position (req: Http_types.request) = try @@ -111,24 +90,41 @@ let parse_rdf_class (req: Http_types.request) = | "backward" -> `Backward | c -> raise (Bad_request ("Invalid RDF class: " ^ c)) +let html_tag ?exn () = + let xml_decl = "\n" in + match exn with + | Some exn -> + sprintf + "%s\n" + xml_decl xhtml_ns helm_ns exn + | 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