open Sys;; open Unix;; let unwind_protect f x g y = try let v = f x in g y; v with z -> g y; raise z let mon_system arg = let old_mask = sigprocmask SIG_BLOCK [ sigchld ] in let old_int = signal sigint Signal_ignore in let old_quit = signal sigquit Signal_ignore in let reset() = ignore (signal sigint old_int); ignore (signal sigquit old_quit); ignore (sigprocmask SIG_SETMASK old_mask) in let system_call () = match fork() with | 0 -> reset(); handle_unix_error (execv "/bin/sh") [| "/bin/sh"; "-c"; arg |]; assert false | k -> let rec wait() = try snd (waitpid [] k) with Unix_error (EINTR, _, _) -> wait() in wait() in unwind_protect system_call() reset() |