X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter_misc.ml;h=0790d9415f8b4f8b68131f29afee75e967a7de12;hb=bbb280d199ff7b34f7ec00f632bfada722fd1037;hp=1bd5522134448245e3865297b20f45bbb117354d;hpb=d599c257fed6a37da72494676ed24315a6d8b2fb;p=helm.git diff --git a/helm/http_getter/http_getter_misc.ml b/helm/http_getter/http_getter_misc.ml index 1bd552213..0790d9415 100644 --- a/helm/http_getter/http_getter_misc.ml +++ b/helm/http_getter/http_getter_misc.ml @@ -1,5 +1,7 @@ (* - * Copyright (C) 2000, HELM Team. + * Copyright (C) 2003: + * Stefano Zacchiroli + * for the HELM Team http://helm.cs.unibo.it/ * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -21,9 +23,10 @@ * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, - * http://cs.unibo.it/helm/. + * http://helm.cs.unibo.it/ *) +open Http_getter_debugger;; open Printf;; let fold_file f init fname = @@ -45,37 +48,64 @@ let hashtbl_sorted_fold f tbl init = in List.fold_left (fun acc k -> f k (Hashtbl.find tbl k) acc) init sorted_keys -let wget ?output url = - let flags = - (match output with Some file -> ["-O"; file] | None -> []) @ [url] - in +let cp src dst = Shell.call ~stdout:Shell.to_dev_null ~stderr:Shell.to_dev_null - [Shell.cmd "wget" flags] + [Shell.cmd "cp" [src; dst]] - (* TODO gzip and gunzip create executables file, but umask seems to be - correctly inherited from the shell .... boh *) +let file_scheme_RE = Pcre.regexp "^file://" +let wget ?output url = + let use_wget () = + let flags = + (match output with Some file -> ["-O"; file] | None -> []) @ [url] + in + debug_print ("wget " ^ String.concat " " flags); + Shell.call + ~stdout:Shell.to_dev_null ~stderr:Shell.to_dev_null + [Shell.cmd "wget" flags] + in + if Pcre.pmatch ~rex:file_scheme_RE url then begin (* file:// URL *) + let src_fname = Pcre.replace ~rex:file_scheme_RE url in + match output with + | Some dst_fname -> cp src_fname dst_fname + | None -> + let dst_fname = Filename.basename src_fname in + if src_fname <> dst_fname then + cp src_fname dst_fname + else (* src and dst are the same: do nothing *) + () + end else (* other URL, pass it to wget *) + use_wget () - (* stderr shown as usual *) +let bufsiz = 16384 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]] + let (ic, oc) = (open_in fname, Gzip.open_out (fname ^ ".gz")) in + let buf = String.create bufsiz in + (try + while true do + let bytes = input ic buf 0 bufsiz in + if bytes = 0 then raise End_of_file else Gzip.output oc buf 0 bytes + done + with End_of_file -> ()); + close_in ic; + Gzip.close_out oc; + if not keep then Sys.remove fname - (* stderr shown as usual *) +let trailing_dot_gz_RE = Pcre.regexp "\\.gz$" 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 basename = Pcre.replace ~rex:trailing_dot_gz_RE fname in + assert (basename <> fname); + let (ic, oc) = (Gzip.open_in fname, open_out basename) in + let buf = String.create bufsiz in + (try + while true do + let bytes = Gzip.input ic buf 0 bufsiz in + if bytes = 0 then raise End_of_file else output oc buf 0 bytes + done + with End_of_file -> ()); + Gzip.close_in ic; + close_out oc; + if not keep then Sys.remove fname let tempfile () = let buf = Buffer.create 28 in (* strlen("/tmp/fileSzb3Mw_http_getter") *) @@ -84,8 +114,32 @@ let tempfile () = [Shell.cmd "tempfile" ["--suffix=_http_getter"]]; Pcre.replace ~pat:"\n" (Buffer.contents buf) +let mkdir ?(parents = false) dirname = + if not (Sys.file_exists dirname) then begin + let flags = if parents then ["-p"; dirname] else [dirname] in + debug_print ("mkdir " ^ String.concat " " flags); + Shell.call [Shell.cmd "mkdir" flags] + end + let string_of_proc_status = function | Unix.WEXITED code -> sprintf "[Exited: %d]" code | Unix.WSIGNALED sg -> sprintf "[Killed: %d]" sg | Unix.WSTOPPED sg -> sprintf "[Stopped: %d]" sg +let http_get url = + if Pcre.pmatch ~rex:file_scheme_RE url then begin + (* file:// URL. Read data from file system *) + let fname = Pcre.replace ~rex:file_scheme_RE url in + try + let size = (Unix.stat fname).Unix.st_size in + let buf = String.create size in + let ic = open_in fname in + really_input ic buf 0 size; + close_in ic; + Some buf + with Unix.Unix_error (Unix.ENOENT, "stat", _) -> None + end else (* other URL, pass it to netclient *) + try + Some (Http_client.Convenience.http_get url) + with Http_client.Http_error (code, _) -> None +