-
Notifications
You must be signed in to change notification settings - Fork 1
/
simple.ml
49 lines (41 loc) · 1.18 KB
/
simple.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
open Core.Std
let setup_child_fds slave_name =
let open Unix in
let fd = openfile (~mode:[O_RDWR]) slave_name in
Termios.make_term_raw fd;
(* Replace all three *)
dup2 ~src:fd ~dst:stdin;
dup2 ~src:fd ~dst:stdout;
dup2 ~src:fd ~dst:stderr
let rec echo_serv () =
let open Unix in
let str = String.create 100 in
let read_chars = read stdin ~buf:str in
let out_line = sprintf "Got input: '%s'" (String.prefix str read_chars) in
let _ = single_write stdout ~buf:out_line in
echo_serv ()
let rec echo_read mfd =
fprintf stderr "Input: ";
Out_channel.flush stderr;
match In_channel.input_line stdin with
| None -> ()
| Some line ->
let _ = Unix.single_write mfd ~buf:line in
let str = String.create 100 in
let read_chars = Unix.read mfd ~buf:str in
printf "%s\n" (String.prefix str read_chars);
Out_channel.flush stdout;
echo_read mfd
let dispatch () =
(* Setup the pty *)
let (master_fd, slave_name) = Pty.prepare_pt () in
let open Unix in
match fork () with
| `In_the_child ->
close master_fd;
setup_child_fds slave_name;
echo_serv ()
| `In_the_parent _ ->
echo_read master_fd
let () =
dispatch ()