Shells in OCaml
Duplicating redirection inputs
This logic also comes with a vendoring of the inherit_fds logic too.
See the corresponding issue on Eio's page: https://github.com/ocaml-multicore/eio/issues/826
+120
-20
+23
-5
src/lib/eval.ml
+23
-5
src/lib/eval.ml
···
21
21
Fmt.failwith "Conversion of %a" Yojson.Safe.pp
22
22
(Ast.word_component_to_yojson v)
23
23
24
+
let word_components_to_string ws =
25
+
String.concat "" (List.map word_component_to_string ws)
26
+
24
27
class default_map =
25
28
object (_)
26
29
inherit Ast.map
···
116
119
let r, w = Eio_unix.pipe sw in
117
120
(Some r, Some (w :> Eio_unix.sink_ty Eio.Flow.sink))
118
121
122
+
let fd_of_int ?(close_unix = true) ~sw n =
123
+
Eio_unix.Fd.of_unix ~close_unix ~sw (Obj.magic n : Unix.file_descr)
124
+
119
125
let handle_one_redirection ~sw ctx = function
120
126
| Ast.IoRedirect_IoFile (n, (op, file)) -> (
121
127
match op with
122
128
| Io_op_less ->
129
+
(* Simple redirection for input *)
123
130
let r =
124
-
Eio.Path.open_in ~sw
125
-
(ctx.fs
126
-
/ (String.concat "" @@ List.map word_component_to_string file))
131
+
Eio.Path.open_in ~sw (ctx.fs / word_components_to_string file)
127
132
in
128
133
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
129
-
(n, fd, `Nonblocking)
134
+
Some (Types.Redirect (n, fd, `Blocking))
135
+
| Io_op_lessand -> (
136
+
match file with
137
+
| [ WordLiteral "-" ] ->
138
+
if n = 0 then Some (Types.Close Eio_unix.Fd.stdin)
139
+
else
140
+
let fd = fd_of_int ~sw n in
141
+
Some (Types.Close fd)
142
+
| [ WordLiteral m ] when Option.is_some (int_of_string_opt m) ->
143
+
let m = int_of_string m in
144
+
Some
145
+
(Types.Redirect
146
+
(n, fd_of_int ~close_unix:false ~sw m, `Blocking))
147
+
| _ -> None)
130
148
| _ -> Fmt.failwith "Redirections ...")
131
149
| Ast.IoRedirect_IoHere _ ->
132
150
Fmt.failwith "HERE documents not yet implemented!"
···
169
187
| Ast.Suffix_redirect rdr ->
170
188
handle_one_redirection ~sw:local_switch ctx rdr :: acc)
171
189
[] suffix
172
-
|> List.rev
190
+
|> List.rev |> List.filter_map Fun.id
173
191
in
174
192
let some_read, some_write =
175
193
stdout_for_pipeline ~sw:local_switch rest
+76
-14
src/lib/posix/exec.ml
+76
-14
src/lib/posix/exec.ml
···
63
63
64
64
let get_env = function Some e -> e | None -> Unix.environment ()
65
65
66
+
external action_dups : unit -> Eio_unix.Private.Fork_action.fork_fn
67
+
= "eio_unix_fork_dups"
68
+
69
+
let action_dups = action_dups ()
70
+
71
+
let rec with_fds mapping k =
72
+
match mapping with
73
+
| [] -> k []
74
+
| (dst, src, _) :: xs ->
75
+
Eio_unix.Fd.use_exn "inherit_fds" src @@ fun src ->
76
+
with_fds xs @@ fun xs -> k ((dst, (Obj.magic src : int)) :: xs)
77
+
78
+
let inherit_fds m =
79
+
let blocking =
80
+
m
81
+
|> List.filter_map (fun (dst, _, flags) ->
82
+
match flags with
83
+
| `Blocking -> Some (dst, true)
84
+
| `Nonblocking -> Some (dst, false)
85
+
| `Preserve_blocking -> None)
86
+
in
87
+
with_fds m @@ fun m ->
88
+
(* TODO: investigate -- the plan from Eio seems to also invert the list of redirections.
89
+
This is problematic for redirections, so we have copied the entire action here. *)
90
+
let plan = Eio_unix__.Inherit_fds.plan m |> List.rev in
91
+
Eio_unix.Private.Fork_action.
92
+
{ run = (fun k -> k (Obj.repr (action_dups, plan, blocking))) }
93
+
66
94
let spawn_unix () ~sw ?cwd ?pgid ?uid ?gid ~env ~fds ~executable args =
67
95
let open Eio_posix in
68
96
let actions =
69
-
Low_level.Process.Fork_action.
70
-
[ inherit_fds fds; execve executable ~argv:(Array.of_list args) ~env ]
97
+
[
98
+
inherit_fds fds;
99
+
Low_level.Process.Fork_action.execve executable ~argv:(Array.of_list args)
100
+
~env;
101
+
]
71
102
in
72
103
let actions =
73
104
match pgid with
···
104
135
with_actions cwd @@ fun actions ->
105
136
Eio_posix__.Process.process (Low_level.Process.spawn ~sw actions)
106
137
138
+
let fd_equal_int fd i =
139
+
Eio_unix.Fd.use_exn "fd_equal_int" fd @@ fun ufd ->
140
+
let ufd_int = (Obj.magic ufd : int) in
141
+
Int.equal i ufd_int
142
+
143
+
let pp_redirections ppf (i, fd, _) = Fmt.pf ppf "(%i,%a)" i Eio_unix.Fd.pp fd
144
+
107
145
let run ~sw _ ?stdin ?stdout ?stderr ?(fds = []) ?cwd ?env ?executable args =
108
146
with_close_list @@ fun to_close ->
109
-
let stdin_fd = read_of_fd ~sw stdin ~default:Eio_unix.Fd.stdin ~to_close in
110
-
let stdout_fd =
111
-
write_of_fd ~sw stdout ~default:Eio_unix.Fd.stdout ~to_close
147
+
let check_fd n = function
148
+
| Merry.Types.Redirect (m, _, _) -> Int.equal n m
149
+
| Merry.Types.Close fd -> fd_equal_int fd n
112
150
in
113
-
let stderr_fd =
114
-
write_of_fd ~sw stderr ~default:Eio_unix.Fd.stderr ~to_close
151
+
let fd_exists n = List.exists (check_fd n) fds in
152
+
let std_fds =
153
+
(if fd_exists 0 then []
154
+
else
155
+
[
156
+
( 0,
157
+
read_of_fd ~sw stdin ~default:Eio_unix.Fd.stdin ~to_close,
158
+
`Blocking );
159
+
])
160
+
@ (if fd_exists 1 then []
161
+
else
162
+
[
163
+
( 1,
164
+
write_of_fd ~sw stdout ~default:Eio_unix.Fd.stdout ~to_close,
165
+
`Blocking );
166
+
])
167
+
@
168
+
if fd_exists 2 then []
169
+
else
170
+
[
171
+
( 2,
172
+
write_of_fd ~sw stderr ~default:Eio_unix.Fd.stderr ~to_close,
173
+
`Blocking );
174
+
]
115
175
in
116
-
let check_fd n (m, _, _) = Int.equal n m in
117
-
let fd_exists n = List.exists (check_fd n) fds in
118
-
let fds =
119
-
(if fd_exists 0 then [] else [ (0, stdin_fd, `Blocking) ])
120
-
@ (if fd_exists 1 then [] else [ (1, stdout_fd, `Blocking) ])
121
-
@ (if fd_exists 2 then [] else [ (2, stderr_fd, `Blocking) ])
122
-
@ fds
176
+
let need_close, fds =
177
+
List.fold_left
178
+
(fun (cs, fs) -> function
179
+
| Merry.Types.Redirect (a, b, c) -> (cs, (a, b, c) :: fs)
180
+
| Close fd -> (fd :: cs, fs))
181
+
([], []) fds
182
+
|> fun (cs, fs) -> (List.rev cs, List.rev fs)
123
183
in
184
+
List.iter Eio_unix.Fd.close need_close;
185
+
let fds = std_fds @ fds in
124
186
let executable = get_executable executable ~args in
125
187
let env = get_env env in
126
188
spawn_unix ~sw ?cwd ~fds ~env ~executable () args
+5
-1
src/lib/types.ml
+5
-1
src/lib/types.ml
···
21
21
(** Update the state with a new parameter mapping *)
22
22
end
23
23
24
+
type redirect =
25
+
| Redirect of int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking
26
+
| Close of Eio_unix.Fd.t
27
+
24
28
module type Exec = sig
25
29
type t
26
30
(** An executor for commands *)
···
31
35
32
36
val exec :
33
37
?fork_actions:fork_action list ->
34
-
?fds:(int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking) list ->
38
+
?fds:redirect list ->
35
39
?stdin:_ Eio_unix.source ->
36
40
?stdout:_ Eio_unix.sink ->
37
41
?stderr:_ Eio_unix.sink ->
+16
test/simple.t
+16
test/simple.t
···
50
50
hello
51
51
52
52
2.5 Input redirection
53
+
54
+
Simple example of redirecing stdin to an open file.
55
+
53
56
$ cat >hello.md <<EOF
54
57
> # Hello, World!
55
58
> ---------------
···
58
61
$ osh -c "cat < hello.md"
59
62
# Hello, World!
60
63
---------------
64
+
65
+
Using `<&-` to close stdin
66
+
67
+
$ osh -c "cat <&-"
68
+
cat: -: Bad file descriptor
69
+
cat: closing standard input: Bad file descriptor
70
+
[1]
71
+
72
+
Using `<&` to copy a file descriptor
73
+
74
+
$ osh -c "cat 3<hello.md <&3"
75
+
# Hello, World!
76
+
---------------