support for creating ptys and a login_tty fork_action

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))

lib_eio/unix/eio_unix.ml

@@ -1,6 +1,7 @@
 [@@@alert "-unstable"]
 
 module Fd = Fd
+module Pty = Pty
 module Resource = Resource
 module Private = Private
 

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 = <

lib_eio/unix/fork_action.c

@@ -3,6 +3,9 @@
 #include <fcntl.h>
 #include <string.h>
 #include <errno.h>
+#include <sys/ioctl.h>
+#include <paths.h>
+#include <utmp.h>
 
 #include <caml/mlvalues.h>
 #include <caml/unixsupport.h>
@@ -153,26 +156,26 @@ 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) {
       set_cloexec(errors, dst, 0);
     } 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);
+}

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)) }

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. *)

lib_eio/unix/pty.c

@@ -0,0 +1,87 @@
+/*
+ * Copyright (c) 2004 Anil Madhavapeddy <[email protected]>
+ * Copyright (c) 2020–2021 Craig Ferguson <[email protected]>
+ *
+ * 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 <stdio.h>
+#include <errno.h>
+#include <paths.h>
+#include <fcntl.h>
+#include <string.h>
+#include <termios.h>
+#include <unistd.h>
+#include <sys/ioctl.h>
+#include <signal.h>
+#include <limits.h>
+
+#include <pty.h>
+#include <utmp.h>
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#include <caml/signals.h>
+#include <caml/unixsupport.h>
+
+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);
+}

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"