- (* 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
- let res = int_of_string (req#param "position") in
- if res < 0 then
- raise (Failure "int_of_string");
- res
- with
- | Http_types.Param_not_found _ -> 0
- | Failure "int_of_string" ->
- raise (Bad_request
- (sprintf "position must be a non negative integer (%s given)"
- (req#param "position")))
-
-let parse_rdf_class (req: Http_types.request) =
- match req#param "class" with
- | "forward" -> `Forward
- | "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, arg) ->
+ let (exn, arg) = (xml_escape exn, xml_escape arg) in
+ sprintf
+ ("%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\"\n"
+ ^^ "helm:exception=\"%s\"\nhelm:exception_arg=\"%s\">\n")
+ xml_decl xhtml_ns helm_ns exn arg
+ | None ->
+ sprintf "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\">\n"
+ xml_decl xhtml_ns helm_ns