X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_misc.ml;h=b7b52bbf64309da80028b1b5cfd47fff7c31c615;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=6db793369acfd10f747fe9728a5f02d3565821d4;hpb=4cc248707314a05902ce8d70ceea1ac0541f9976;p=helm.git diff --git a/helm/ocaml/getter/http_getter_misc.ml b/helm/ocaml/getter/http_getter_misc.ml index 6db793369..b7b52bbf6 100644 --- a/helm/ocaml/getter/http_getter_misc.ml +++ b/helm/ocaml/getter/http_getter_misc.ml @@ -28,15 +28,22 @@ open Printf -open Http_getter_debugger +let file_scheme_prefix = "file://" let trailing_dot_gz_RE = Pcre.regexp "\\.gz$" (* for g{,un}zip *) let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$" let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://" -let file_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^file://" +let file_scheme_RE = Pcre.regexp ~flags:[`CASELESS] ("^" ^ file_scheme_prefix) let dir_sep_RE = Pcre.regexp "/" let heading_slash_RE = Pcre.regexp "^/" +let local_url = + let rex = Pcre.regexp ("^(" ^ file_scheme_prefix ^ ")(.*)(.gz)$") in + fun s -> + try + Some ((Pcre.extract ~rex s).(2)) + with Not_found -> None + let bufsiz = 16384 (* for file system I/O *) let tcp_bufsiz = 4096 (* for TCP I/O *) @@ -54,6 +61,19 @@ let fold_file f init fname = let iter_file f = fold_file (fun line _ -> f line) () +let iter_buf_size = 10240 + +let iter_file_data f fname = + let ic = open_in fname in + let buf = String.create iter_buf_size in + try + while true do + let bytes = input ic buf 0 iter_buf_size in + if bytes = 0 then raise End_of_file; + f (String.sub buf 0 bytes) + done + with End_of_file -> close_in ic + let hashtbl_sorted_fold f tbl init = let sorted_keys = List.sort compare (Hashtbl.fold (fun key _ keys -> key::keys) tbl []) @@ -64,21 +84,40 @@ let hashtbl_sorted_iter f tbl = let sorted_keys = List.sort compare (Hashtbl.fold (fun key _ keys -> key::keys) tbl []) in - List.iter (fun k -> f k (Hashtbl.find tbl k)) sorted_keys + List.iter (fun k -> f k (Hashtbl.find tbl k)) sorted_keys let cp src dst = - let (ic, oc) = (open_in src, open_out dst) 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 output oc buf 0 bytes - done - with End_of_file -> ()); - close_in ic; close_out oc + try + let ic = open_in src in + try + let oc = open_out dst 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 output oc buf 0 bytes + done + with + End_of_file -> () + ); + close_in ic; close_out oc + with + Sys_error s -> + Http_getter_logger.log s; + close_in ic + | e -> + Http_getter_logger.log (Printexc.to_string e); + close_in ic; + raise e + with + Sys_error s -> + Http_getter_logger.log s + | e -> + Http_getter_logger.log (Printexc.to_string e); + raise e let wget ?output url = - debug_print + Http_getter_logger.log (sprintf "wgetting %s (output: %s)" url (match output with None -> "default" | Some f -> f)); match url with @@ -96,14 +135,15 @@ let wget ?output url = (let oc = open_out (match output with Some f -> f | None -> Filename.basename url) in - Http_client.http_get_iter (fun data -> output_string oc data) url; + Http_user_agent.get_iter (fun data -> output_string oc data) url; close_out oc) | scheme -> (* unsupported scheme *) failwith ("Http_getter_misc.wget: unsupported scheme: " ^ scheme) let gzip ?(keep = false) ?output fname = let output = match output with None -> fname ^ ".gz" | Some fname -> fname in - debug_print (sprintf "gzipping %s (keep: %b, output: %s)" fname keep output); + Http_getter_logger.log ~level:3 + (sprintf "gzipping %s (keep: %b, output: %s)" fname keep output); let (ic, oc) = (open_in fname, Gzip.open_out output) in let buf = String.create bufsiz in (try @@ -128,17 +168,27 @@ let gunzip ?(keep = false) ?output fname = "Http_getter_misc.gunzip: unable to determine output file name" | Some fname -> fname in - debug_print (sprintf "gunzipping %s (keep: %b, output: %s)" - fname keep output); - let (ic, oc) = (Gzip.open_in fname, open_out output) 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 Pervasives.output oc buf 0 bytes - done - with End_of_file -> ()); - Gzip.close_in ic; close_out oc; + Http_getter_logger.log ~level:3 + (sprintf "gunzipping %s (keep: %b, output: %s)" fname keep output); + (* Open the zipped file manually since Gzip.open_in may + * leak the descriptor if it raises an exception *) + let zic = open_in fname in + begin + try + let ic = Gzip.open_in_chan zic in + let oc = open_out output 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 Pervasives.output oc buf 0 bytes + done + with End_of_file -> ()); + close_out oc; + Gzip.close_in ic + with + e -> close_in zic ; raise e + end ; if not keep then Sys.remove fname ;; @@ -190,16 +240,16 @@ let http_get url = 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; + 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 Http_client *) + end else (* other URL, pass it to Http_user_agent *) try - Some (Http_client.http_get url) + Some (Http_user_agent.get url) with e -> - debug_print (sprintf - "Warning: Http_client failed on url %s with exception: %s" + Http_getter_logger.log (sprintf + "Warning: Http_user_agent failed on url %s with exception: %s" url (Printexc.to_string e)); None @@ -208,3 +258,56 @@ let is_blank_line = fun line -> Pcre.pmatch ~rex:blank_line_RE line +let normalize_dir s = (* append "/" if missing *) + let len = String.length s in + try + if s.[len - 1] = '/' then s + else s ^ "/" + with Invalid_argument _ -> (* string is empty *) "/" + +let strip_trailing_slash s = + try + let len = String.length s in + if s.[len - 1] = '/' then String.sub s 0 (len - 1) + else s + with Invalid_argument _ -> s + +let strip_suffix ~suffix s = + try + let s_len = String.length s in + let suffix_len = String.length suffix in + let suffix_sub = String.sub s (s_len - suffix_len) suffix_len in + if suffix_sub <> suffix then raise (Invalid_argument ""); + String.sub s 0 (s_len - suffix_len) + with Invalid_argument _ -> + raise (Invalid_argument "Http_getter_misc.strip_suffix") + +let rec list_uniq = function + | [] -> [] + | h::[] -> [h] + | h1::h2::tl when h1 = h2 -> list_uniq (h2 :: tl) + | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq tl + +let extension s = + try + let idx = String.rindex s '.' in + String.sub s idx (String.length s - idx) + with Not_found -> "" + +let temp_file_of_uri uri = + let flat_string s s' c = + let cs = String.copy s in + for i = 0 to (String.length s) - 1 do + if String.contains s' s.[i] then cs.[i] <- c + done; + cs + in + let user = try Unix.getlogin () with _ -> "" in + Filename.open_temp_file (user ^ flat_string uri ".-=:;!?/&" '_') "" + +let backtick cmd = + let ic = Unix.open_process_in cmd in + let res = input_line ic in + ignore (Unix.close_process_in ic); + res +