- with Unresolvable_URI uri ->
- return_xml_raw "<unresolved />\n" outchan
-
-let return_list_servers outchan =
- return_html_raw
- (sprintf "<html><body><table>\n%s\n</table></body></html>"
- (String.concat "\n"
- (List.map
- (fun (pos, server) ->
- sprintf "<tr><td>%d</td><td>%s</td></tr>" pos server)
- (Http_getter.list_servers ()))))
- outchan
+ with
+ | Unresolvable_URI _ -> return_xml_raw "<unresolvable />\n" outchan
+ | Key_not_found _ -> return_xml_raw "<not_found />\n" outchan
+
+let log_failure msg = Http_getter_logger.log ("Request not fulfilled: " ^ msg)
+
+let convert_file ~from_enc ~to_enc fname =
+ let remove f = fun () -> if Sys.file_exists f then Sys.remove f in
+ match from_enc, to_enc with
+ | `Normal, `Normal
+ | `Gzipped, `Gzipped -> fname, (fun () -> ())
+ | `Normal, `Gzipped ->
+ let tmp = Http_getter_misc.tempfile () in
+ Http_getter_misc.gzip ~keep:true ~output:tmp fname;
+ tmp, remove tmp
+ | `Gzipped, `Normal ->
+ let tmp = Http_getter_misc.tempfile () in
+ Http_getter_misc.gunzip ~keep:true ~output:tmp fname;
+ tmp, remove tmp
+
+let is_gzip fname = Http_getter_misc.extension fname = ".gz"
+
+let patch_fun_for uri url =
+ let xmlbases =
+ if Http_getter_common.is_theory_uri uri then
+ Some (Filename.dirname uri, Filename.dirname url)
+ else
+ None
+ in
+ Http_getter_common.patch_xml ?xmlbases ~via_http:true ()
+
+let respond_dtd patch_dtd fname outchan =
+ let via_http = false in
+ let patch_fun =
+ if patch_dtd then Some (Http_getter_common.patch_dtd ~via_http ())
+ else None
+ in
+ Http_getter_common.return_file ~via_http:true ~fname ~contype:"text/plain"
+ ~gunzip:false ?patch_fun ~enc:`Normal outchan
+
+(* let respond_xsl
+ ?(via_http = true) ?(enc = `Normal) ?(patch = true) ~url outchan
+ =
+ let patch_fun =
+ if patch then Http_getter_common.patch_xsl ~via_http () else (fun x -> x)
+ in
+ let fname = tempfile () in
+ finally (fun () -> Sys.remove fname) (lazy (
+ wget ~output:fname url;
+ return_file ~via_http ~fname ~contype:"text/xml" ~patch_fun ~enc outchan
+ )) *)
+(* | "/getxslt" ->
+ Http_getter_cache.respond_xsl
+ ~url:(Http_getter.resolve (req#param "uri"))
+ ~patch:(parse_patch req) outchan *)
+
+let respond_xslt patch_xslt xslt_name outchan =
+ let fname = Http_getter.getxslt xslt_name in
+ let patch_fun =
+ if patch_xslt then Some (Http_getter_common.patch_xsl ~via_http:true ())
+ else None
+ in
+ Http_getter_common.return_file ~fname ~contype:"text/xml" ?patch_fun
+ ~gunzip:false ~via_http:true ~enc:`Normal outchan