type redirection = | In_from_file of string (* < file *) | Out_to_file of string (* > file *) | Err_to_file of string (* 2> file *) | Out_append_to_file of string (* >> file *) | Err_to_out (* 2>&1 *) | In_from_string of string (* <<END *) | Err_null (* >/dev/null *) | Out_null (* 2>/dev/null *) | Silent (* >/dev/null 2>&1 *) ;; (* Enlever un fichier s'il existe. *) let unlink_f file = try unlink file with Unix_error (ENOENT, _, _) -> () let execvp_redirect redirections cmd args = print_endline cmd; let perm = 0o640 in let temp_file = if List.exists (function In_from_string _ -> true | _ -> false) redirections then Some (Filename.temp_file "foo" ".in") else None in let rec make_redirect rd = match rd with In_from_file file -> let desc_file = openfile file [O_RDONLY] perm in try_finalize (dup2 desc_file) stdin close desc_file | Out_to_file file -> let desc_file = openfile file [O_WRONLY;O_CREAT;O_TRUNC] perm in try_finalize (dup2 desc_file) stdout close desc_file | Err_to_file file -> let desc_file = openfile file [O_WRONLY;O_CREAT;O_TRUNC] perm in try_finalize (dup2 desc_file) stderr close desc_file | Out_append_to_file file -> let desc_file = openfile file [O_WRONLY;O_APPEND;O_CREAT] perm in try_finalize (dup2 desc_file) stdout close desc_file | Err_to_out -> dup2 stdout stderr | In_from_string s -> begin match temp_file with Some tmp -> file_of_string tmp s; make_redirect (In_from_file tmp); | None -> assert false end | Out_null -> make_redirect (Out_to_file "/dev/null") | Err_null -> make_redirect (Err_to_file "/dev/null") | Silent -> make_redirect Out_null; make_redirect Err_to_out; in match fork () with 0 -> let exec () = List.iter make_redirect redirections; execvp cmd (Array.append [|cmd|] args); in handle_unix_error exec (); | pid -> let res = snd (waitpid [] pid) in begin match temp_file with Some tmp -> unlink_f tmp | _ -> () end; res ;; |