struct
type filename = string;;
type foldername = string;;
type content = string;;
let current_umask =
let old = Unix.umask 0 in
let _ = Unix.umask old in
old
;;
let touch ?(perm=0o640) (fname:filename) : unit =
let fd = (Unix.openfile fname [Unix.O_CREAT] perm) in (Unix.close fd)
;;
module Copylib = struct
open Unix;;
let buffer_size = 8192;;
let buffer = String.create buffer_size;;
let file_copy ?(perm=0o666) ?(flag=O_TRUNC) input_name output_name =
let fd_in = openfile input_name [O_RDONLY] 0 in
let fd_out = openfile output_name [O_WRONLY; O_CREAT; flag] perm in
let rec copy_loop () =
match read fd_in buffer 0 buffer_size with
0 -> ()
| r -> ignore (write fd_out buffer 0 r); copy_loop () in
copy_loop ();
close fd_in;
close fd_out;;
end;;
let file_copy ?(perm=0o640) (x:filename) (y:filename) = Unix.handle_unix_error (Copylib.file_copy ~perm x) y ;;
let file_append ?(perm=0o640) (x:filename) (y:filename) = Unix.handle_unix_error (Copylib.file_copy ~perm ~flag:Unix.O_APPEND x) y ;;
let put ?(perm=0o640) (fname:filename) (x:content) : unit =
let fd = (Unix.openfile fname [Unix.O_CREAT; Unix.O_WRONLY; Unix.O_TRUNC] perm) in
let n = String.length x in
ignore (Unix.write fd x 0 n);
(Unix.close fd)
;;
let rewrite = put;;
let append ?(perm=0o640) (fname:filename) (x:content) =
let fd = (Unix.openfile fname [Unix.O_CREAT; Unix.O_WRONLY; Unix.O_APPEND] perm) in
let n = String.length x in
ignore (Unix.write fd x 0 n);
(Unix.close fd)
;;
let rec cat (fname:filename) =
let fd = (Unix.openfile fname [Unix.O_RDONLY] 0o640) in
let len = 16*1024 in
let buff = String.create len in
let rec boucle () =
begin
let n = (Unix.read fd buff 0 len) in
let s = String.sub buff 0 n in
if (n<len) then s
else s^(boucle ())
end in
boucle ()
;;
module Templib = struct
let rec temp_name ~(dir:bool) ~(perm:Unix.file_perm) ~(parent:string) ~(prefix:string) ~(suffix:string) () =
begin
let rnd = Random.int (1024*1024*1023) in
let candidate = (Filename.concat parent (prefix^(string_of_int rnd)^suffix)) in
if (Sys.file_exists candidate) then (temp_name ~dir ~perm ~parent ~prefix ~suffix ())
else
begin
if dir then (Unix.mkdir candidate perm)
else (touch candidate ~perm) ;
candidate
end
end
;;
end;;
let rec temp_dir ?(perm=0o755) ?(parent="/tmp") ?(prefix="") ?(suffix="") () =
Templib.temp_name ~dir:true ~parent ~perm ~prefix ~suffix ()
;;
let rec temp_file ?(perm=0o644) ?(parent="/tmp") ?(prefix="") ?(suffix="") ?(content:string="") () =
let fname = (Templib.temp_name ~dir:false ~perm ~parent ~prefix ~suffix ()) in
(if content<>"" then (rewrite fname content));
fname
;;
let file_kind_of_char = function
| 'f' -> Some Unix.S_REG
| 'd' -> Some Unix.S_DIR
| 'c' -> Some Unix.S_CHR
| 'b' -> Some Unix.S_BLK
| 'h' | 'L' -> Some Unix.S_LNK
| 'p' -> Some Unix.S_FIFO
| 'S' -> Some Unix.S_SOCK
| _ -> None
;;
let iter_dir f dirname =
let d = Unix.opendir dirname in
try while true do f (Unix.readdir d) done
with End_of_file -> Unix.closedir d
;;
module Findlib = struct
exception Hidden of exn
let hide_exn f x = try f x with exn -> raise (Hidden exn);;
let reveal_exn f x = try f x with Hidden exn -> raise exn;;
open Unix;;
let find on_error on_path follow depth roots =
let rec find_rec depth visiting filename =
try
let infos = (if follow then stat else lstat) filename in
let continue = hide_exn (on_path filename) infos in
let id = infos.st_dev, infos.st_ino in
if infos.st_kind = S_DIR && depth > 0 && continue &&
(not follow || not (List.mem id visiting))
then
let process_child child =
if (child <> Filename.current_dir_name &&
child <> Filename.parent_dir_name) then
let child_name = Filename.concat filename child in
let visiting =
if follow then id :: visiting else visiting in
find_rec (depth-1) visiting child_name in
iter_dir process_child filename
with Unix_error (e, b, c) -> hide_exn on_error (e, b, c) in
reveal_exn (List.iter (find_rec depth [])) roots
;;
end;;
let find ?(follow=false) ?(maxdepth=1024) ?(kind='_') ?(name="") (root:string) : string list =
let result = ref [] in
let action = match (file_kind_of_char kind, name) with
| (None , "" ) -> fun p infos -> result := (p::!result)
| ((Some k), "" ) -> fun p infos -> if (infos.Unix.st_kind = k) then result := (p::!result);
| (None , n ) -> fun p infos -> if ((Filename.basename p) = n) then result := (p::!result)
| ((Some k), n ) -> fun p infos -> if (infos.Unix.st_kind = k) && ((Filename.basename p) = n)
then result := (p::!result); in
let action p infos = (action p infos; true) in
let on_error (e, b, c) = prerr_endline (c ^ ": " ^ Unix.error_message e) in
Unix.handle_unix_error (Findlib.find on_error action follow maxdepth) [root];
List.rev (!result)
;;
module Passwdlib = struct
open Unix;;
let read_passwd message =
match
try
let default = tcgetattr stdin in
let silent =
{ default with
c_echo = false;
c_echoe = false;
c_echok = false;
c_echonl = false;
} in
Some (default, silent)
with _ -> None
with
| None -> input_line Pervasives.stdin
| Some (default, silent) ->
print_string message;
flush Pervasives.stdout;
tcsetattr stdin TCSANOW silent;
try
let s = input_line Pervasives.stdin in
tcsetattr stdin TCSANOW default; s
with x ->
tcsetattr stdin TCSANOW default; raise x;;
end;;
let read_passwd prompt = Passwdlib.read_passwd prompt;;
type command = string;;
let run ?(trace:bool=false) ?(input:content="") (cmd:command) : string * Unix.process_status =
let script = temp_file ~perm:0o755 ~prefix:"script-" ~suffix:".sh" ~content:cmd () in
let output = temp_file ~perm:0o644 ~prefix:"script-" ~suffix:".output" () in
let (input_option,input_file) = if (input="")
then ("","")
else
let name=(temp_file ~perm:0o644 ~prefix:"script-" ~suffix:".input" ()) in
begin
put name input;
((" <"^name),name)
end
in
let code = Unix.system("bash -c " ^script^" >"^output^input_option) in
let str = (cat output) in
begin
if trace then begin
prerr_endline ("\n======> INPUT FILE: <<EOF\n"^input^"EOF");
prerr_endline ("\n======> SCRIPT CONTENT: <<EOF\n"^cmd^"EOF");
prerr_endline ("\n======> OUTPUT: <<EOF\n"^str^"EOF");
()
end;
Unix.unlink script;
Unix.unlink output;
if (not (input="")) then (Unix.unlink input_file);
(str,code)
end
;;
let shell ?(trace:bool=false) ?(input:string="") cmd = fst(run ~trace ~input cmd)
;;
end