package hack_parallel
Parallel and shared memory library
Install
Dune Dependency
Authors
Maintainers
Sources
1.0.1.tar.gz
md5=ba7c72bc207e326b72e294fc76f6ad2c
sha512=5020d47f97bea2f88e2a40411894d03232a7f2282606926c93c7d4c96d72e94a966be852897a9b16f7e0893ba376512045abb9d93020a7c03c3def4f3d918f8e
doc/src/hack_parallel.utils/sys_utils.ml.html
Source file sys_utils.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
(** * Copyright (c) 2015, Facebook, Inc. * All rights reserved. * * This source code is licensed under the BSD-style license found in the * LICENSE file in the "hack" directory of this source tree. An additional grant * of patent rights can be found in the PATENTS file in the same directory. * *) open Hack_core exception NotADirectory of string external realpath: string -> string option = "hh_realpath" external is_nfs: string -> bool = "hh_is_nfs" (** Hack_option type intead of exception throwing. *) let get_env name = try Some (Sys.getenv name) with | Not_found -> None let getenv_user () = let user_var = if Sys.win32 then "USERNAME" else "USER" in let logname_var = "LOGNAME" in let user = get_env user_var in let logname = get_env logname_var in Hack_option.first_some user logname let getenv_home () = let home_var = if Sys.win32 then "APPDATA" else "HOME" in get_env home_var let getenv_term () = let term_var = "TERM" in (* This variable does not exist on windows. *) get_env term_var let path_sep = if Sys.win32 then ";" else ":" let null_path = if Sys.win32 then "nul" else "/dev/null" let temp_dir_name = if Sys.win32 then Filename.get_temp_dir_name () else "/tmp" let getenv_path () = let path_var = "PATH" in (* Same variable on windows *) get_env path_var let open_in_no_fail fn = try open_in fn with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not open_in: '%s' (%s)\n" fn e; exit 3 let open_in_bin_no_fail fn = try open_in_bin fn with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not open_in_bin: '%s' (%s)\n" fn e; exit 3 let close_in_no_fail fn ic = try close_in ic with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not close: '%s' (%s)\n" fn e; exit 3 let open_out_no_fail fn = try open_out fn with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not open_out: '%s' (%s)\n" fn e; exit 3 let open_out_bin_no_fail fn = try open_out_bin fn with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not open_out_bin: '%s' (%s)\n" fn e; exit 3 let close_out_no_fail fn oc = try close_out oc with e -> let e = Printexc.to_string e in Printf.fprintf stderr "Could not close: '%s' (%s)\n" fn e; exit 3 let cat = Disk.cat let cat_no_fail filename = let ic = open_in_bin_no_fail filename in let len = in_channel_length ic in let buf = Buffer.create len in Buffer.add_channel buf ic len; let content = Buffer.contents buf in close_in_no_fail filename ic; content let nl_regexp = Str.regexp "[\r\n]" let split_lines = Str.split nl_regexp (** Returns true if substring occurs somewhere inside str. *) let string_contains str substring = (* regexp_string matches only this string and nothing else. *) let re = Str.regexp_string substring in try (Str.search_forward re str 0) >= 0 with Not_found -> false let exec_read cmd = let ic = Unix.open_process_in cmd in let result = input_line ic in assert (Unix.close_process_in ic = Unix.WEXITED 0); result let exec_read_lines ?(reverse=false) cmd = let ic = Unix.open_process_in cmd in let result = ref [] in (try while true do result := input_line ic :: !result done; with End_of_file -> ()); assert (Unix.close_process_in ic = Unix.WEXITED 0); if not reverse then List.rev !result else !result (** Deletes the file given by "path". If it is a directory, recursively * deletes all its contents then removes the directory itself. *) let rec rm_dir_tree path = try begin let stats = Unix.lstat path in match stats.Unix.st_kind with | Unix.S_DIR -> let contents = Sys.readdir path in List.iter (Array.to_list contents) ~f:(fun name -> let name = Filename.concat path name in rm_dir_tree name); Unix.rmdir path | Unix.S_LNK | Unix.S_REG | Unix.S_CHR | Unix.S_BLK | Unix.S_FIFO | Unix.S_SOCK -> Unix.unlink path end with (* Path has been deleted out from under us - can ignore it. *) | Sys_error(s) when s = Printf.sprintf "%s: No such file or directory" path -> () | Unix.Unix_error(Unix.ENOENT, _, _) -> () let restart () = let cmd = Sys.argv.(0) in let argv = Sys.argv in Unix.execv cmd argv let logname_impl () = match getenv_user () with | Some user -> user | None -> (* If this function is generally useful, it can be lifted to toplevel in this file, but this is the only place we need it for now. *) let exec_try_read cmd = let ic = Unix.open_process_in cmd in let out = try Some (input_line ic) with End_of_file -> None in let status = Unix.close_process_in ic in match out, status with | Some _, Unix.WEXITED 0 -> out | _ -> None in try Utils.unsafe_opt (exec_try_read "logname") with Invalid_argument _ -> try Utils.unsafe_opt (exec_try_read "id -un") with Invalid_argument _ -> "[unknown]" let logname_ref = ref None let logname () = if !logname_ref = None then logname_ref := Some (logname_impl ()); Utils.unsafe_opt !logname_ref let with_umask umask f = let old_umask = ref 0 in Utils.with_context ~enter:(fun () -> old_umask := Unix.umask umask) ~exit:(fun () -> ignore (Unix.umask !old_umask)) ~do_:f let with_umask umask f = if Sys.win32 then f () else with_umask umask f let read_stdin_to_string () = let buf = Buffer.create 4096 in try while true do Buffer.add_string buf (input_line stdin); Buffer.add_char buf '\n' done; assert false with End_of_file -> Buffer.contents buf let read_all ?(buf_size=4096) ic = let buf = Buffer.create buf_size in (try while true do let data = Bytes.create buf_size in let bytes_read = input ic data 0 buf_size in if bytes_read = 0 then raise Exit; Buffer.add_subbytes buf data 0 bytes_read; done with Exit -> ()); Buffer.contents buf (** * Like Python's os.path.expanduser, though probably doesn't cover some cases. * Roughly follow's bash's tilde expansion: * http://www.gnu.org/software/bash/manual/html_node/Tilde-Expansion.html * * ~/foo -> /home/bob/foo if $HOME = "/home/bob" * ~joe/foo -> /home/joe/foo if joe's home is /home/joe *) let expanduser path = Str.substitute_first (Str.regexp "^~\\([^/]*\\)") begin fun s -> match Str.matched_group 1 s with | "" -> begin match getenv_home () with | None -> (Unix.getpwuid (Unix.getuid())).Unix.pw_dir | Some home -> home end | unixname -> try (Unix.getpwnam unixname).Unix.pw_dir with Not_found -> Str.matched_string s end path (* Turns out it's surprisingly complex to figure out the path to the current executable, which we need in order to extract its embedded libraries. If argv[0] is a path, then we can use that; sometimes it's just the exe name, so we have to search $PATH for it the same way shells do. for example: https://www.gnu.org/software/bash/manual/html_node/Command-Search-and-Execution.html There are other options which might be more reliable when they exist, like using the `_` env var set by bash, or /proc/self/exe on Linux, but they are not portable. *) let executable_path : unit -> string = let executable_path_ = ref None in let dir_sep = Filename.dir_sep.[0] in let search_path path = let paths = match getenv_path () with | None -> failwith "Unable to determine executable path" | Some paths -> Str.split (Str.regexp_string path_sep) paths in let path = List.fold_left paths ~f:begin fun acc p -> match acc with | Some _ -> acc | None -> realpath (expanduser (Filename.concat p path)) end ~init:None in match path with | Some path -> path | None -> failwith "Unable to determine executable path" in fun () -> match !executable_path_ with | Some path -> path | None -> let path = Sys.executable_name in let path = if String.contains path dir_sep then match realpath path with | Some path -> path | None -> failwith "Unable to determine executable path" else search_path path in executable_path_ := Some path; path let lines_of_in_channel ic = let rec loop accum = match try Some(input_line ic) with _e -> None with | None -> List.rev accum | Some(line) -> loop (line::accum) in loop [] let lines_of_file filename = let ic = open_in filename in try let result = lines_of_in_channel ic in let _ = close_in ic in result with _ -> close_in ic; [] let read_file file = let ic = open_in_bin file in let size = in_channel_length ic in let buf = String.create size in really_input ic buf 0 size; close_in ic; buf let write_file ~file s = let chan = open_out file in (output_string chan s; close_out chan) let append_file ~file s = let chan = open_out_gen [Open_wronly; Open_append; Open_creat] 0o666 file in (output_string chan s; close_out chan) (* could be in control section too *) let filemtime file = (Unix.stat file).Unix.st_mtime external lutimes : string -> unit = "hh_lutimes" let try_touch ~follow_symlinks file = try if follow_symlinks then Unix.utimes file 0.0 0.0 else lutimes file with _ -> () let rec mkdir_p = function | "" -> failwith "Unexpected empty directory, should never happen" | d when not (Sys.file_exists d) -> mkdir_p (Filename.dirname d); Unix.mkdir d 0o770; | d when Sys.is_directory d -> () | d -> raise (NotADirectory d) (* Emulate "mkdir -p", i.e., no error if already exists. *) let mkdir_no_fail dir = with_umask 0 begin fun () -> (* Don't set sticky bit since the socket opening code wants to remove any * old sockets it finds, which may be owned by a different user. *) try Unix.mkdir dir 0o777 with Unix.Unix_error (Unix.EEXIST, _, _) -> () end let unlink_no_fail fn = try Unix.unlink fn with Unix.Unix_error (Unix.ENOENT, _, _) -> () let readlink_no_fail fn = if Sys.win32 && Sys.file_exists fn then cat fn else try Unix.readlink fn with _ -> fn let splitext filename = let root = Filename.chop_extension filename in let root_length = String.length root in (* -1 because the extension includes the period, e.g. ".foo" *) let ext_length = String.length filename - root_length - 1 in let ext = String.sub filename (root_length + 1) ext_length in root, ext let is_test_mode () = try ignore @@ Sys.getenv "HH_TEST_MODE"; true with _ -> false let symlink = (* Dummy implementation of `symlink` on Windows: we create a text file containing the targeted-file's path. Symlink are available on Windows since Vista, but until Seven (included), one should have administratrive rights in order to create symlink. *) let win32_symlink source dest = write_file ~file:dest source in if Sys.win32 then win32_symlink else (* 4.03 adds an optional argument to Unix.symlink that we want to ignore *) fun source dest -> Unix.symlink source dest (* Creates a symlink at <dir>/<linkname.ext> to * <dir>/<pluralized ext>/<linkname>-<timestamp>.<ext> *) let make_link_of_timestamped linkname = let open Unix in let dir = Filename.dirname linkname in mkdir_no_fail dir; let base = Filename.basename linkname in let base, ext = splitext base in let dir = Filename.concat dir (Printf.sprintf "%ss" ext) in mkdir_no_fail dir; let tm = localtime (time ()) in let year = tm.tm_year + 1900 in let time_str = Printf.sprintf "%d-%02d-%02d-%02d-%02d-%02d" year (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec in let filename = Filename.concat dir (Printf.sprintf "%s-%s.%s" base time_str ext) in unlink_no_fail linkname; symlink filename linkname; filename let setsid = (* Not implemented on Windows. Let's just return the pid *) if Sys.win32 then Unix.getpid else Unix.setsid let set_signal = if not Sys.win32 then Sys.set_signal else (fun _ _ -> ()) let signal = if not Sys.win32 then (fun a b -> ignore (Sys.signal a b)) else (fun _ _ -> ()) external get_total_ram : unit -> int = "hh_sysinfo_totalram" external uptime : unit -> int = "hh_sysinfo_uptime" external nproc: unit -> int = "nproc" let total_ram = get_total_ram () let nbr_procs = nproc () external set_priorities : cpu_priority:int -> io_priority:int -> unit = "hh_set_priorities" external pid_of_handle: int -> int = "pid_of_handle" external handle_of_pid_for_termination: int -> int = "handle_of_pid_for_termination" let terminate_process pid = Unix.kill pid Sys.sigkill let lstat path = (* WTF, on Windows `lstat` fails if a directory path ends with an '/' (or a '\', whatever) *) Unix.lstat @@ if Sys.win32 && String_utils.string_ends_with path Filename.dir_sep then String.sub path 0 (String.length path - 1) else path let normalize_filename_dir_sep = let dir_sep_char = String.get Filename.dir_sep 0 in String.map (fun c -> if c = dir_sep_char then '/' else c) let name_of_signal = function | s when s = Sys.sigabrt -> "SIGABRT (Abnormal termination)" | s when s = Sys.sigalrm -> "SIGALRM (Timeout)" | s when s = Sys.sigfpe -> "SIGFPE (Arithmetic exception)" | s when s = Sys.sighup -> "SIGHUP (Hangup on controlling terminal)" | s when s = Sys.sigill -> "SIGILL (Invalid hardware instruction)" | s when s = Sys.sigint -> "SIGINT (Interactive interrupt (ctrl-C))" | s when s = Sys.sigkill -> "SIGKILL (Termination)" | s when s = Sys.sigpipe -> "SIGPIPE (Broken pipe)" | s when s = Sys.sigquit -> "SIGQUIT (Interactive termination)" | s when s = Sys.sigsegv -> "SIGSEGV (Invalid memory reference)" | s when s = Sys.sigterm -> "SIGTERM (Termination)" | s when s = Sys.sigusr1 -> "SIGUSR1 (Application-defined signal 1)" | s when s = Sys.sigusr2 -> "SIGUSR2 (Application-defined signal 2)" | s when s = Sys.sigchld -> "SIGCHLD (Child process terminated)" | s when s = Sys.sigcont -> "SIGCONT (Continue)" | s when s = Sys.sigstop -> "SIGSTOP (Stop)" | s when s = Sys.sigtstp -> "SIGTSTP (Interactive stop)" | s when s = Sys.sigttin -> "SIGTTIN (Terminal read from background process)" | s when s = Sys.sigttou -> "SIGTTOU (Terminal write from background process)" | s when s = Sys.sigvtalrm -> "SIGVTALRM (Timeout in virtual time)" | s when s = Sys.sigprof -> "SIGPROF (Profiling interrupt)" | s when s = Sys.sigbus -> "SIGBUS (Bus error)" | s when s = Sys.sigpoll -> "SIGPOLL (Pollable event)" | s when s = Sys.sigsys -> "SIGSYS (Bad argument to routine)" | s when s = Sys.sigtrap -> "SIGTRAP (Trace/breakpoint trap)" | s when s = Sys.sigurg -> "SIGURG (Urgent condition on socket)" | s when s = Sys.sigxcpu -> "SIGXCPU (Timeout in cpu time)" | s when s = Sys.sigxfsz -> "SIGXFSZ (File size limit exceeded)" | other -> string_of_int other
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>