X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter_common.ml;h=fc3867128203363ee110e1c14ff0f67db6bd3ca4;hb=d599c257fed6a37da72494676ed24315a6d8b2fb;hp=67d72f4f16148c19681caf99e85dfa76f427a8b0;hpb=86e80bc65186bf4c2824dc94f5f4dd5966843f14;p=helm.git diff --git a/helm/http_getter/http_getter_common.ml b/helm/http_getter/http_getter_common.ml index 67d72f4f1..fc3867128 100644 --- a/helm/http_getter/http_getter_common.ml +++ b/helm/http_getter/http_getter_common.ml @@ -65,7 +65,7 @@ let patch_xsl = Pcre.replace ~pat:(sprintf "%s\\s+href=\"" tag) ~templ:( - sprintf "%s href=\"%s/getxslt?uri=" Http_getter_env.my_own_url tag) + sprintf "%s href=\"%s/getxslt?uri=" tag Http_getter_env.my_own_url) line in let (patch_import, patch_include) = @@ -79,28 +79,21 @@ let patch_dtd line = sprintf "ENTITY $1 SYSTEM \"%s/getdtd?uri=" Http_getter_env.my_own_url) line -let pp_error = - sprintf "

Http Getter error: %s

" -let pp_internal_error = - sprintf "

Http Getter Internal error: %s

" -let pp_msg = sprintf "

%s

" +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 null_pp s = s let mk_return_fun pp_fun contype msg outchan = Http_daemon.respond - ~body:(pp_fun msg) - ~headers:["Content-Type", contype] - outchan + ~body:(pp_fun msg) ~headers:["Content-Type", contype] outchan 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_xml_msg = mk_return_fun pp_msg "text/xml" - (** - @param fname name of the file to be sent - @param contype Content-Type header value - @param contenc Content-Enconding header value - @param patch_fun function used to patch file contents - @param outchan output channel over which sent file fname *) +let return_xml_msg = mk_return_fun null_pp "text/xml" let return_file ~fname ?contype ?contenc ?(patch_fun = fun x -> x) outchan = let headers = match (contype, contenc) with @@ -109,50 +102,11 @@ let return_file ~fname ?contype ?contenc ?(patch_fun = fun x -> x) outchan = | (None, Some e) -> [ "Content-Enconding", e ] | (None, None) -> [] in - Http_daemon.send_basic_headers outchan; + Http_daemon.send_basic_headers ~code:200 outchan; Http_daemon.send_headers headers outchan; Http_daemon.send_CRLF outchan; Http_getter_misc.iter_file (fun line -> output_string outchan (patch_fun line ^ "\n")) fname - (* return a bad request http response *) let return_400 body outchan = Http_daemon.respond_error ~code:400 ~body outchan -let wget ?output url = - let flags = - (match output with Some file -> ["-O " ^ file] | None -> []) @ [url] - in - Shell.call - ~stdout:Shell.to_dev_null ~stderr:Shell.to_dev_null [Shell.cmd "wget" flags] - - (* TODO gzip and gunzip create executables file, but umask seems to be - correctly inherited from the shell .... boh *) - - (* stderr shown as usual *) -let gzip ?(keep = false) fname = - if keep then (* keep original file *) - Shell.call - ~stdout:(Shell.to_file (fname ^ ".gz")) - [Shell.cmd "gzip" ["-f"; "-c"; fname]] - else (* don't keep original file *) - Shell.call [Shell.cmd "gzip" ["-f"; fname]] - - (* stderr shown as usual *) -let gunzip ?(keep = false) fname = - if not (Pcre.pmatch ~pat:"\\.gz$" fname) then - failwith "gunzip: source file doesn't end with '.gz'"; - let basename = Pcre.replace ~pat:"\\.gz$" fname in - if keep then (* keep original file *) - Shell.call - ~stdout:(Shell.to_file basename) - [Shell.cmd "gunzip" ["-f"; "-c"; fname]] - else (* don't keep original file *) - Shell.call [Shell.cmd "gunzip" ["-f"; fname]] - -let tempfile () = - let buf = Buffer.create 28 in (* strlen("/tmp/fileSzb3Mw_http_getter") *) - Shell.call - ~stdout:(Shell.to_buffer buf) - [Shell.cmd "tempfile" ["--suffix=_http_getter"]]; - Pcre.replace ~pat:"\n" (Buffer.contents buf) -