-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
30 additions
and
107 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,26 +1 @@ | ||
| (lang dune 3.6) | ||
|
|
||
| (name ocaml_exec_shell) | ||
|
|
||
| (generate_opam_files true) | ||
|
|
||
| (source | ||
| (github username/reponame)) | ||
|
|
||
| (authors "Author Name") | ||
|
|
||
| (maintainers "Maintainer Name") | ||
|
|
||
| (license LICENSE) | ||
|
|
||
| (documentation https://url/to/documentation) | ||
|
|
||
| (package | ||
| (name ocaml_exec_shell) | ||
| (synopsis "A short synopsis") | ||
| (description "A longer description") | ||
| (depends (ocaml (>= 5.0.0)) dune eio_main) | ||
| (tags | ||
| (topics "to describe" your project))) | ||
|
|
||
| ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,5 +1,5 @@ | ||
| (executable | ||
| (public_name ocaml_exec_shell) | ||
| (name main) | ||
| (libraries unix eio_main) | ||
| (libraries unix eio_main eio_linux) | ||
| (foreign_stubs (language c) (names pty))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,85 +1,25 @@ | ||
|
|
||
| let client ~stdout ~stdin pty = | ||
| let savedTio = Unix.tcgetattr Unix.stdin in | ||
|
|
||
| (* set raw mode *) | ||
| let tio = { | ||
| savedTio with | ||
| (* input modes *) | ||
| c_ignpar = true; | ||
| c_istrip = false; | ||
| c_inlcr = false; | ||
| c_igncr = false; | ||
| c_ixon = false; | ||
| (* c_ixany = false; *) | ||
| (* c_iuclc = false; *) | ||
| c_ixoff = false; | ||
|
|
||
| (* output modes *) | ||
| c_opost = false; | ||
|
|
||
| (* control modes *) | ||
| c_isig = false; | ||
| c_icanon = false; | ||
| c_echo = false; | ||
| c_echoe = false; | ||
| c_echok = false; | ||
| c_echonl = false; | ||
| (* c_iexten = false; *) | ||
|
|
||
| (* special characters *) | ||
| c_vmin = 1; | ||
| c_vtime = 0; | ||
| }; | ||
| in Unix.tcsetattr Unix.stdin TCSADRAIN tio; | ||
|
|
||
| let exception Sigchld in | ||
| let sigchld = Eio.Condition.create () in | ||
| let handle_sigchld (_signum : int) = Eio.Condition.broadcast sigchld in | ||
| ignore (Sys.signal Sys.sigchld (Signal_handle handle_sigchld)); | ||
|
|
||
| try | ||
| (* don't close PTY file descriptors *) | ||
| let close_unix = false in | ||
| Eio.Fiber.all [ | ||
| (fun () -> Eio.Switch.run @@ fun sw -> | ||
| let sink = Eio_unix.FD.as_socket ~sw ~close_unix pty.Pty.masterfd in | ||
| Eio.Flow.copy stdin sink); | ||
| (fun () -> Eio.Switch.run @@ fun sw -> | ||
| let source = Eio_unix.FD.as_socket ~sw ~close_unix pty.Pty.masterfd in | ||
| Eio.Flow.copy source stdout | ||
| ); | ||
| (fun () -> Eio.Condition.await_no_mutex sigchld; raise Sigchld); | ||
| ] | ||
| with | ||
| | Sigchld -> (); | ||
| (* restore tio *) | ||
| Unix.tcsetattr Unix.stdin TCSADRAIN savedTio | ||
|
|
||
| let server pty = | ||
| Unix.close pty.Pty.masterfd; | ||
| Pty.switch_controlling_pty pty; | ||
| (* TODO Pty.window_size pty pty_window; *) | ||
| Unix.dup2 pty.Pty.slavefd Unix.stdin; | ||
| Unix.dup2 pty.Pty.slavefd Unix.stdout; | ||
| Unix.dup2 pty.Pty.slavefd Unix.stderr; | ||
| Unix.close pty.Pty.slavefd; | ||
| (* TODO get default shell from /etc/passwd *) | ||
| try Unix.execve "/run/current-system/sw/bin/bash" | ||
| (* login shell *) | ||
| [| "-bash"; |] | ||
| (Unix.unsafe_environment ()) | ||
| (* [| "PATH=" ^ Unix.getenv "PATH" |];; *) | ||
| with Unix.Unix_error (x,_s,y) -> | ||
| print_endline (Printf.sprintf "%s: %s" y (Unix.error_message x)); | ||
| Pty.close_pty pty | ||
| let client ~stdout ~stdin ~write ~read = | ||
| Eio.Fiber.both | ||
| (fun () -> Eio.Flow.copy stdin write) | ||
| (fun () -> Eio.Flow.copy read stdout) | ||
|
|
||
| let () = | ||
| Eio_main.run @@ fun env -> | ||
| let pty = Pty.open_pty () in | ||
| let pid = Unix.fork () in | ||
| (* if child *) | ||
| if pid == 0 then | ||
| server pty | ||
| else | ||
| client ~stdout:(Eio.Stdenv.stdout env) ~stdin:(Eio.Stdenv.stdin env) pty | ||
| Eio.Switch.run @@ fun sw -> | ||
| (* Could use Eio_unix.pipe with higher level Eio process lib | ||
| but need Eio_linux.FD for Eio_linux.Low_level.Process.spawn *) | ||
| let child = | ||
| let action = Eio_posix.Low_level.Process.Fork_action.execve | ||
| "/run/current-system/sw/bin/bash" | ||
| ~argv:[| "-bash" |] | ||
| ~env:[||] in | ||
| Eio_linux.Low_level.Process.spawn ~sw [ action ] in | ||
| let readInpipe, _writeInpipe = Eio_unix.pipe sw in | ||
| let _readOutpipe, writeOutpipe = Eio_unix.pipe sw in | ||
| client | ||
| ~stdout:(Eio.Stdenv.stdout env) | ||
| ~stdin:(Eio.Stdenv.stdin env) | ||
| ~write:writeOutpipe | ||
| ~read:readInpipe; | ||
| ignore @@ Eio.Promise.await (Eio_linux.Low_level.Process.exit_status child);; |