Core.Std.Unix

Reviewed By: cristianoc

Differential Revision: D4232433

fbshipit-source-id: 123c5c7
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent c094287428
commit 9d1b495f57

@ -140,8 +140,8 @@ struct
let fd =
Unix.openfile
(DB.filename_to_string full_fname)
[Unix.O_WRONLY; Unix.O_APPEND]
0o777 in
~mode:Unix.[O_WRONLY; O_APPEND]
~perm:0o777 in
let outc = Unix.out_channel_of_descr fd in
let fmt = F.formatter_of_out_channel outc in
(fd, fmt)

@ -14,11 +14,11 @@ open! Utils
module Html : sig
(** Close an Html file *)
val close : Unix.file_descr * Format.formatter -> unit
val close : Unix.File_descr.t * Format.formatter -> unit
(** Create a new html file *)
val create :
DB.Results_dir.path_kind -> DB.Results_dir.path -> Unix.file_descr * Format.formatter
DB.Results_dir.path_kind -> DB.Results_dir.path -> Unix.File_descr.t * Format.formatter
(** Return true if the html file was modified since the beginning of the analysis *)
val modified_during_analysis : SourceFile.t -> DB.Results_dir.path -> bool
@ -27,7 +27,7 @@ module Html : sig
val node_filename : Procname.t -> int -> string
(** Open an Html file to append data *)
val open_out : SourceFile.t -> DB.Results_dir.path -> Unix.file_descr * Format.formatter
val open_out : SourceFile.t -> DB.Results_dir.path -> Unix.File_descr.t * Format.formatter
(** Print an html link to the given line number of the current source file *)
val pp_line_link :

@ -146,7 +146,7 @@ let register_report_at_exit file =
try
let json_stats = to_json (stats ()) in
try
create_path (Filename.dirname file);
Unix.mkdir_p (Filename.dirname file);
let stats_oc = open_out file in
Yojson.Basic.pretty_to_channel stats_oc json_stats ;
close_out stats_oc

@ -76,8 +76,8 @@ let remove_results_dir () =
rmtree Config.results_dir
let create_results_dir () =
create_path (Config.results_dir // Config.captured_dir_name) ;
create_path (Config.results_dir // Config.specs_dir_name)
Unix.mkdir_p (Config.results_dir // Config.captured_dir_name) ;
Unix.mkdir_p (Config.results_dir // Config.specs_dir_name)
let clean_results_dir () =
let dirs = ["classnames"; "filelists"; "multicore"; "sources"] in
@ -111,17 +111,16 @@ let register_perf_stats_report () =
let stats_dir = Filename.concat Config.results_dir Config.backend_stats_dir_name in
let stats_base = Config.perf_stats_prefix ^ ".json" in
let stats_file = Filename.concat stats_dir stats_base in
create_path stats_dir;
Unix.mkdir_p stats_dir;
PerfStats.register_report_at_exit stats_file
let touch_start_file () =
let start = Config.results_dir // Config.start_filename in
let file_perm = 0o0666 in
let flags =
Unix.O_CREAT :: Unix.O_WRONLY :: (if Config.continue_capture then [Unix.O_EXCL] else []) in
(* create new file, or open existing file for writing to update modified timestamp *)
try Unix.close (Unix.openfile start flags file_perm)
try Unix.close (Unix.openfile ~perm:0o0666 ~mode:flags start)
with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
@ -138,7 +137,6 @@ let run_command ~prog ~args after_wait =
let check_xcpretty () =
let open! Core.Std in
match Unix.system "xcpretty --version" with
| Ok () -> ()
| Error _ ->
@ -232,7 +230,7 @@ let capture build_cmd = function
let run_parallel_analysis () =
let multicore_dir = Config.results_dir // Config.multicore_dir_name in
rmtree multicore_dir ;
create_path multicore_dir ;
Unix.mkdir_p multicore_dir ;
InferAnalyze.print_stdout_legend ();
InferAnalyze.main (multicore_dir // "Makefile") ;
let cwd = Unix.getcwd () in

@ -83,13 +83,13 @@ let add_multilink_attr ~stats src dst =
let create_link ~stats src dst =
if link_exists dst then Unix.unlink dst;
Unix.symlink src dst;
Unix.symlink ~src ~dst;
(* Set the accessed and modified time of the original file slightly in the past. Due to
the coarse precision of the timestamps, it is possible for the source and destination of a
link to have the same modification time. When this happens, the files will be considered to
need re-analysis every time, indefinitely. *)
let near_past = Unix.gettimeofday () -. 1. in
Unix.utimes src near_past near_past;
Unix.utimes src ~access:near_past ~modif:near_past;
stats.files_linked <- stats.files_linked + 1
let create_multilinks () =
@ -110,7 +110,7 @@ let rec slink ~stats ~skiplevels src dst =
then
begin
if not (Sys.file_exists dst)
then Unix.mkdir dst 0o700;
then Unix.mkdir dst ~perm:0o700;
let items = Sys.readdir src in
Array.iter
(fun item ->

@ -596,11 +596,11 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
;
full_speclist := add_or_suppress_help (normalize !full_desc_list)
;
let env_args = decode_env_to_argv (try Unix.getenv args_env_var with Not_found -> "") in
let env_args = decode_env_to_argv (try Sys.getenv args_env_var with Not_found -> "") in
(* begin transitional support for INFERCLANG_ARGS *)
let c_args =
Str.split (Str.regexp_string (String.make 1 ':'))
(try Unix.getenv "INFERCLANG_ARGS" with Not_found -> "") in
(try Sys.getenv "INFERCLANG_ARGS" with Not_found -> "") in
let env_args = c_args @ env_args in
(* end transitional support for INFERCLANG_ARGS *)
let exe_name = Sys.executable_name in
@ -636,6 +636,7 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
in
parse_loop ();
if not incomplete then
Unix.putenv args_env_var
(encode_argv_to_env (prefix_before_rest (IList.tl (Array.to_list !args_to_parse)))) ;
Unix.putenv
~key:args_env_var
~data:(encode_argv_to_env (prefix_before_rest (IList.tl (Array.to_list !args_to_parse)))) ;
curr_usage

@ -400,7 +400,7 @@ let init_work_dir, is_originator =
(* Approach is borrowed from llvm implementation of *)
(* llvm::sys::fs::current_path (implemented in Path.inc file) *)
try
let pwd = Unix.getenv "PWD" in
let pwd = Sys.getenv "PWD" in
let pwd_stat = Unix.stat pwd in
let dot_stat = Unix.stat "." in
if pwd_stat.st_dev = dot_stat.st_dev && pwd_stat.st_ino = dot_stat.st_ino then
@ -410,7 +410,7 @@ let init_work_dir, is_originator =
with _ ->
Sys.getcwd () in
let real_cwd = realpath cwd in
Unix.putenv "INFER_CWD" real_cwd;
Unix.putenv ~key:"INFER_CWD" ~data:real_cwd;
(real_cwd, true)
(** Resolve relative paths passed as command line options, i.e., with respect to the working
@ -1648,7 +1648,7 @@ let specs_library =
let key_dir = cache_dir // key in
let extract_specs dest_dir filename =
if Filename.check_suffix filename ".jar" then
match (Unix.mkdir dest_dir 0o700) with
match (Unix.mkdir dest_dir ~perm:0o700) with
| exception Unix.Unix_error _ ->
()
| () ->

@ -14,8 +14,6 @@ open! Utils
module F = Format
module L = Logging
module Unix = Core.Std.Unix
module In_channel = Core.Std.In_channel
(** {2 Source Dirs} *)

@ -66,7 +66,7 @@ module Results_dir : sig
val clean_specs_dir : unit -> unit
(** create a file at the given path, creating any missing directories *)
val create_file : path_kind -> path -> Unix.file_descr
val create_file : path_kind -> path -> Unix.File_descr.t
end
(** origin of a analysis artifact: current results dir, a spec library, or models *)

@ -46,13 +46,13 @@ let set_log_file_identifier (current_exe : CLOpt.exe) string_opt =
(match string_opt with
| Some name -> name ^ "_"
| None -> ""
) ^ string_of_int (Unix.getpid ()) ^ "_" in
) ^ Pid.to_string (Unix.getpid ()) ^ "_" in
let exe_log_dir =
let log_dir = Config.results_dir // Config.log_dir_name in
log_dir // (log_dir_of_current_exe current_exe) in
let fmt_chan_file name suffix = lazy (
try
create_path exe_log_dir ;
Unix.mkdir_p exe_log_dir ;
let file =
(* the command-line option takes precedence if specified *)
if name <> "" then name

@ -8,9 +8,6 @@
*)
open! Utils
module Pid = Core.Std.Pid
module L = Logging
module F = Format
@ -43,7 +40,6 @@ let create_process_and_wait ~prog ~args =
represents, prints a message explaining the command and its status, if in debug or stats mode.
It also prints a dot to show progress of jobs being finished. *)
let print_status f pid status =
let open Core.Std in
L.err "%a%s@."
(fun fmt pid -> F.pp_print_string fmt (f pid)) pid
(Unix.Exit_or_signal.to_string_hum status) ;
@ -59,7 +55,6 @@ module PidMap = Map.Make (Pid)
and all the other children and update the current jobs count.
Use f to print the job status *)
let rec wait_for_child f current_jobs_count jobs_map =
let open! Core.Std in
let pid, status = Unix.wait `Any in
Pervasives.decr current_jobs_count;
Pervasives.incr waited_for_jobs;
@ -103,7 +98,7 @@ let run_jobs_in_parallel jobs_stack gen_prog prog_to_string =
L.out "Waited for %d jobs" !waited_for_jobs
let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args =
let open Core.Std in
let open! Core.Std in
let pipe_in, pipe_out = Unix.pipe () in
match Unix.fork () with
| `In_the_child ->

@ -25,11 +25,11 @@ val print_error_and_exit :
env)] where [dir_opt] is an optional directory to chdir to before executing [command] with
[args] in [env]. [prog_to_string] is used for printing information about the job's status. *)
val run_jobs_in_parallel :
'a Stack.t -> ('a -> (string option * string * string list * Core.Std.Unix.env)) -> ('a -> string)
'a Stack.t -> ('a -> (string option * string * string list * Unix.env)) -> ('a -> string)
-> unit
(** Pipeline producer program into consumer program *)
val pipeline :
producer_prog:string -> producer_args:string list ->
consumer_prog:string -> consumer_args:string list ->
Core.Std.Unix.Exit_or_signal.t * Core.Std.Unix.Exit_or_signal.t
Unix.Exit_or_signal.t * Unix.Exit_or_signal.t

@ -90,7 +90,7 @@ let create_serializer (key : key) : 'a serializer =
let outc = open_out_bin fname_tmp in
Marshal.to_channel outc (key, version, value) [];
close_out outc;
Unix.rename fname_tmp fname_str in
Unix.rename ~src:fname_tmp ~dst:fname_str in
(from_string, from_file, to_file)

@ -12,8 +12,11 @@
module Bool = Core.Std.Bool
module Filename = Core.Std.Filename
module In_channel = Core.Std.In_channel
module Int = Core.Std.Int
module Pid = Core.Std.Pid
module String = Core.Std.String
module Unix = Core.Std.Unix
module F = Format
@ -483,7 +486,7 @@ let remove_directory_tree path =
|> Stream.iter (fun ent ->
match Fts.FTSENT.info ent with
| FTS_D | FTS_DOT -> ()
| _ -> Core.Std.Unix.remove (Fts.FTSENT.name ent)
| _ -> Unix.remove (Fts.FTSENT.name ent)
)
@ -549,7 +552,7 @@ let create_dir dir =
if (Unix.stat dir).Unix.st_kind != Unix.S_DIR then
failwithf "@.ERROR: file %s exists and is not a directory@." dir
with Unix.Unix_error _ ->
try Unix.mkdir dir 0o700 with
try Unix.mkdir dir ~perm:0o700 with
Unix.Unix_error _ ->
let created_concurrently = (* check if another process created it meanwhile *)
try (Unix.stat dir).Unix.st_kind = Unix.S_DIR
@ -557,17 +560,6 @@ let create_dir dir =
if not created_concurrently then
failwithf "@.ERROR: cannot create directory %s@." dir
(** [create_path path] will create a directory at [path], creating all the parent directories if
non-existing *)
let rec create_path path =
try
Unix.mkdir path 0o700
with
| Unix.Unix_error (Unix.EEXIST, _, _) -> ()
| Unix.Unix_error (Unix.ENOENT, _, _) ->
create_path (Filename.dirname path);
create_dir path
let realpath_cache = Hashtbl.create 1023
let realpath path =

@ -12,8 +12,11 @@
module Bool = Core.Std.Bool
module Filename = Core.Std.Filename
module In_channel = Core.Std.In_channel
module Int = Core.Std.Int
module Pid = Core.Std.Pid
module String = Core.Std.String
module Unix = Core.Std.Unix
(** {2 Generic Utility Functions} *)
@ -227,7 +230,7 @@ val write_json_to_file : string -> Yojson.Basic.json -> unit
val consume_in : in_channel -> unit
val with_process_in: string -> (in_channel -> 'a) -> ('a * Unix.process_status)
val with_process_in: string -> (in_channel -> 'a) -> ('a * Unix.Exit_or_signal.t)
val failwithf : ('a, Format.formatter, unit, 'b) format4 -> 'a
@ -236,10 +239,6 @@ val invalid_argf : ('a, Format.formatter, unit, 'b) format4 -> 'a
(** create a directory if it does not exist already *)
val create_dir : string -> unit
(** [create_path path] will create a directory at [path], creating all the parent directories if
non-existing *)
val create_path : string -> unit
(** [realpath path] returns path with all symbolic links resolved. It caches results of previous
calls to avoid expensive system calls *)
val realpath : string -> string

@ -30,7 +30,7 @@ let load_from_cache serializer zip_path cache_dir zip_library =
let extract to_path =
if not (Sys.file_exists to_path) then
begin
create_path (Filename.dirname to_path);
Unix.mkdir_p (Filename.dirname to_path);
let lazy zip_channel = zip_library.zip_channel in
let entry = Zip.find_entry zip_channel zip_path in
Zip.copy_entry_to_file zip_channel entry to_path

@ -120,8 +120,8 @@ let run_clang clang_command read => {
};
/* NOTE: exceptions will propagate through without exiting here */
switch (with_process_in clang_command read) {
| (res, Unix.WEXITED 0) => res
| (_, Unix.WEXITED n) =>
| (res, Ok ()) => res
| (_, Error (`Exit_non_zero n)) =>
/* exit with the same error code as clang in case of compilation failure */
exit_with_error n
| _ => exit_with_error 1
@ -143,11 +143,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
String.concat
sep::"^"
(
(
try [Unix.getenv CLOpt.args_env_var] {
| Not_found => []
}
) @ [
Core.Std.Option.to_list (Core.Std.Sys.getenv CLOpt.args_env_var) @ [
"--clang-biniou-file",
biniou_fname
]

@ -112,7 +112,7 @@ let cache_classname cn =
let rec mkdir l p =
let () =
if not (Sys.file_exists p) then
Unix.mkdir p 493 in
Unix.mkdir p ~perm:493 in
match l with
| [] -> ()
| d:: tl -> mkdir tl (Filename.concat p d) in

Loading…
Cancel
Save