diff --git a/lib_eio/unix/dune b/lib_eio/unix/dune index 258fa7377..ca9c3df77 100644 --- a/lib_eio/unix/dune +++ b/lib_eio/unix/dune @@ -4,5 +4,5 @@ (foreign_stubs (language c) (include_dirs include) - (names fork_action stubs)) + (names fork_action stubs pty)) (libraries eio unix threads mtime.clock.os)) diff --git a/lib_eio/unix/eio_unix.ml b/lib_eio/unix/eio_unix.ml index 017b92698..c56545b75 100644 --- a/lib_eio/unix/eio_unix.ml +++ b/lib_eio/unix/eio_unix.ml @@ -1,6 +1,7 @@ [@@@alert "-unstable"] module Fd = Fd +module Pty = Pty module Resource = Resource module Private = Private diff --git a/lib_eio/unix/eio_unix.mli b/lib_eio/unix/eio_unix.mli index 4f88ad0f3..e3068d166 100644 --- a/lib_eio/unix/eio_unix.mli +++ b/lib_eio/unix/eio_unix.mli @@ -96,6 +96,9 @@ val pipe : Switch.t -> source * sink module Process = Process (** Spawning child processes with extra control. *) +module Pty = Pty +(** Pseudoterminal handling functions. *) + (** The set of resources provided to a process on a Unix-compatible system. *) module Stdenv : sig type base = < diff --git a/lib_eio/unix/fork_action.c b/lib_eio/unix/fork_action.c index 7f6ef0c33..1fc60d4d0 100644 --- a/lib_eio/unix/fork_action.c +++ b/lib_eio/unix/fork_action.c @@ -3,6 +3,9 @@ #include #include #include +#include +#include +#include #include #include @@ -153,17 +156,17 @@ static void action_dups(int errors, value v_config) { if (dst == -1) { // Dup to a temporary FD if (tmp == -1) { - tmp = dup(src); - if (tmp < 0) { - eio_unix_fork_error(errors, "dup-tmp", strerror(errno)); - _exit(1); - } + tmp = dup(src); + if (tmp < 0) { + eio_unix_fork_error(errors, "dup-tmp", strerror(errno)); + _exit(1); + } } else { - int r = dup2(src, tmp); - if (r < 0) { - eio_unix_fork_error(errors, "dup2-tmp", strerror(errno)); - _exit(1); - } + int r = dup2(src, tmp); + if (r < 0) { + eio_unix_fork_error(errors, "dup2-tmp", strerror(errno)); + _exit(1); + } } set_cloexec(errors, tmp, 1); } else if (src == dst) { @@ -171,8 +174,8 @@ static void action_dups(int errors, value v_config) { } else { int r = dup2(src, dst); if (r < 0) { - eio_unix_fork_error(errors, "dup2", strerror(errno)); - _exit(1); + eio_unix_fork_error(errors, "dup2", strerror(errno)); + _exit(1); } } v_plan = Field(v_plan, 1); @@ -189,3 +192,14 @@ static void action_dups(int errors, value v_config) { CAMLprim value eio_unix_fork_dups(value v_unit) { return Val_fork_fn(action_dups); } + +static void action_login_tty(int errors, value v_config) { + value v_pty = Field(v_config, 1); + + if (login_tty(Int_val(v_pty)) == -1) + dprintf(errors, "action_login_tty Error logging in tty: %s", strerror(errno)); +} + +CAMLprim value eio_unix_login_tty(value v_unit) { + return Val_fork_fn(action_login_tty); +} diff --git a/lib_eio/unix/fork_action.ml b/lib_eio/unix/fork_action.ml index 820dbc232..bba096ff4 100644 --- a/lib_eio/unix/fork_action.ml +++ b/lib_eio/unix/fork_action.ml @@ -63,3 +63,10 @@ let inherit_fds m = with_fds m @@ fun m -> let plan : action list = Inherit_fds.plan m in { run = fun k -> k (Obj.repr (action_dups, plan, blocking)) } + +external action_login_tty : unit -> fork_fn = "eio_unix_login_tty" +let action_login_tty = action_login_tty () + +let login_tty pty = + Fd.use_exn "login_tty" pty @@ fun pty -> + { run = fun k -> k (Obj.repr (action_login_tty, pty)) } diff --git a/lib_eio/unix/fork_action.mli b/lib_eio/unix/fork_action.mli index fc9357d4a..c60d167fb 100644 --- a/lib_eio/unix/fork_action.mli +++ b/lib_eio/unix/fork_action.mli @@ -58,3 +58,6 @@ val inherit_fds : (int * Fd.t * [< blocking]) list -> t A mapping from an FD to itself simply clears the close-on-exec flag. After this, the new FDs may also be set as blocking or non-blocking, depending on [flags]. *) + +val login_tty : Fd.t -> t +(** [login_tty pty] prepares for a shell login on the [pty] file descriptor. *) diff --git a/lib_eio/unix/pty.c b/lib_eio/unix/pty.c new file mode 100644 index 000000000..2e879184c --- /dev/null +++ b/lib_eio/unix/pty.c @@ -0,0 +1,87 @@ +/* + * Copyright (c) 2004 Anil Madhavapeddy + * Copyright (c) 2020–2021 Craig Ferguson + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#include +#include +#include +#include +#include +#include +#include + +value eio_unix_open_pty(value v_unit) +{ + CAMLparam1 (v_unit); + char namebuf[4096]; /* Not PATH_MAX due to portability issues */ + int i, masterfd, slavefd; + CAMLlocal1(v_ret); + + i = openpty(&masterfd, &slavefd, namebuf, NULL, NULL); + if (i < 0) + caml_uerror("openpty", Nothing); + + v_ret = caml_alloc_small(3, 0); + Store_field(v_ret, 0, Val_int(masterfd)); + Store_field(v_ret, 1, Val_int(slavefd)); + Store_field(v_ret, 2, caml_copy_string(namebuf)); + CAMLreturn (v_ret); +} + +value eio_unix_window_size(value pty, value pty_window) +{ + CAMLparam2 (pty, pty_window); + int ptyfd; + struct winsize w; + w.ws_row = Int32_val(Field(pty_window, 0)); + w.ws_col = Int32_val(Field(pty_window, 1)); + w.ws_xpixel = Int32_val(Field(pty_window, 2)); + w.ws_ypixel = Int32_val(Field(pty_window, 3)); + ptyfd = Int_val(Field(pty, 0)); + ioctl(ptyfd, TIOCSWINSZ, &w); + CAMLreturn (Val_unit); +} + +value eio_unix_tty_window_size(value unit) +{ + CAMLparam1 (unit); + CAMLlocal1(pty_window); + + struct winsize w; + if (ioctl(STDOUT_FILENO, TIOCGWINSZ, &w) == -1) + memset(&w, 0, sizeof(w)); + pty_window = caml_alloc_small(4, 0); + Store_field(pty_window, 0, caml_copy_int32(w.ws_row)); + Store_field(pty_window, 1, caml_copy_int32(w.ws_col)); + Store_field(pty_window, 2, caml_copy_int32(w.ws_xpixel)); + Store_field(pty_window, 3, caml_copy_int32(w.ws_ypixel)); + CAMLreturn (pty_window); +} diff --git a/lib_eio/unix/pty.ml b/lib_eio/unix/pty.ml new file mode 100644 index 000000000..bf252bad4 --- /dev/null +++ b/lib_eio/unix/pty.ml @@ -0,0 +1,16 @@ +type pty = { + masterfd : Unix.file_descr; + slavefd : Unix.file_descr; + name : string; +} + +type pty_window = { + row : int32; + col : int32; + xpixel : int32; + ypixel : int32 +} + +external open_pty : unit -> pty = "eio_unix_open_pty" +external set_window_size : pty -> pty_window -> unit = "eio_unix_window_size" +external tty_window_size : unit -> pty_window = "eio_unix_tty_window_size"