Something went wrong. Try again.
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107open Eio_posixopen Eio.Std
type (_, _, _) Eio.Resource.pi += | Posix_dir : ('t, 't -> Low_level.dir_fd, [> `Posix_dir ]) Eio.Resource.pi
let as_posix_dir (Eio.Resource.T (t, ops)) = match Eio.Resource.get_opt ops Posix_dir with | None -> None | Some fn -> Some (fn t)
module Process_impl = struct type t = Low_level.Process.t type tag = [ `Generic | `Unix ]
let pid = Low_level.Process.pid
let await t = match Eio.Promise.await @@ Low_level.Process.exit_status t with | Unix.WEXITED i -> `Exited i | Unix.WSIGNALED i -> `Signaled i | Unix.WSTOPPED _ -> assert false
let signal = Low_level.Process.signalend
let process = let handler = Eio.Process.Pi.process (module Process_impl) in fun proc -> Eio.Resource.T (proc, handler)
module T = struct type t = unit
external action_setcgroup : unit -> Eio_unix.Private.Fork_action.fork_fn = "eio_unix_fork_setcgroup"
let action_setcgroup = action_setcgroup ()
let setcgroup group = Eio_unix.Private.Fork_action. { run = (fun k -> k (Obj.repr (action_setcgroup, group))) }
let spawn_unix () ~group ~sw ?cwd ?pgid ?uid ?gid ?login_tty ~env ~fds ~executable args = let login_tty_action, fds = match login_tty with | None -> ([], fds) | Some tty -> let fds = [ (0, tty, `Blocking); (1, tty, `Blocking); (2, tty, `Blocking) ] @ fds in ([ Eio_unix.Private.Fork_action.login_tty tty ], fds) in let actions = Low_level.Process.Fork_action.( login_tty_action @ [ Eio_unix.Private.Fork_action.inherit_fds fds; execve executable ~argv:(Array.of_list args) ~env; ]) in let actions = match pgid with | None -> actions | Some pgid -> Eio_unix.Private.Fork_action.setpgid pgid :: actions in let actions = match uid with | None -> actions | Some uid -> Eio_unix.Private.Fork_action.setuid uid :: actions in let actions = match gid with | None -> actions | Some gid -> Eio_unix.Private.Fork_action.setgid gid :: actions in let actions = match group with None -> actions | Some g -> setcgroup g :: actions in let with_actions cwd fn = match cwd with | None -> fn actions | Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) -> ( match as_posix_dir dir with | None -> Fmt.invalid_arg "cwd is not an OS directory!" | Some dirfd -> Switch.run ~name:"spawn_unix" @@ fun launch_sw -> let cwd = Low_level.openat ~sw:launch_sw ~mode:0 dirfd path Low_level.Open_flags.(rdonly + directory) in fn (Low_level.Process.Fork_action.fchdir cwd :: actions)) in with_actions cwd @@ fun actions -> process (Low_level.Process.spawn ~sw actions)end
let make_process group = let module T = struct type t = unit
let spawn_unix = T.spawn_unix ~group end in let h = Eio_unix.Process.Pi.mgr_unix (module Eio_unix.Process.Make_mgr (T)) in Eio.Resource.T ((), h)