Shells in OCaml
Input redirection
Initial redirection for inputs (just <)
+171
-10
+1
src/bin/main.ml
+1
src/bin/main.ml
+28
-3
src/lib/eval.ml
+28
-3
src/lib/eval.ml
···
33
33
method list f t = List.map f t
34
34
end
35
35
36
-
type ctx = { state : S.t; executor : E.t }
36
+
type ctx = { state : S.t; executor : E.t; fs : Eio.Fs.dir_ty Eio.Path.t }
37
37
38
38
class default_ctx_fold =
39
39
object (_)
···
116
116
let r, w = Eio_unix.pipe sw in
117
117
(Some r, Some (w :> Eio_unix.sink_ty Eio.Flow.sink))
118
118
119
+
let handle_one_redirection ~sw ctx = function
120
+
| Ast.IoRedirect_IoFile (n, (op, file)) -> (
121
+
match op with
122
+
| Io_op_less ->
123
+
let r =
124
+
Eio.Path.open_in ~sw
125
+
(ctx.fs
126
+
/ (String.concat "" @@ List.map word_component_to_string file))
127
+
in
128
+
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
129
+
(n, fd, `Nonblocking)
130
+
| _ -> Fmt.failwith "Redirections ...")
131
+
| Ast.IoRedirect_IoHere _ ->
132
+
Fmt.failwith "HERE documents not yet implemented!"
133
+
119
134
let exec ctx (ast : Ast.complete_command) =
120
135
let command, _ = ast in
121
136
let execute_commands local_switch p =
···
147
162
| Ast.Suffix_redirect _ -> None)
148
163
suffix
149
164
in
165
+
let redirect =
166
+
List.fold_left
167
+
(fun acc -> function
168
+
| Ast.Suffix_word _ -> acc
169
+
| Ast.Suffix_redirect rdr ->
170
+
handle_one_redirection ~sw:local_switch ctx rdr :: acc)
171
+
[] suffix
172
+
|> List.rev
173
+
in
150
174
let some_read, some_write =
151
175
stdout_for_pipeline ~sw:local_switch rest
152
176
in
153
177
match stdout_of_previous with
154
178
| None ->
155
179
let res =
156
-
E.exec ctx.executor ?stdout:some_write
180
+
E.exec ~fds:redirect ctx.executor ?stdout:some_write
157
181
(List.map word_component_to_string executable
158
182
@ List.concat args)
159
183
|> Option.some
···
162
186
loop (res, some_read) rest
163
187
| Some stdout ->
164
188
let res =
165
-
E.exec ctx.executor ~stdin:stdout ?stdout:some_write
189
+
E.exec ~fds:redirect ctx.executor ~stdin:stdout
190
+
?stdout:some_write
166
191
(List.map word_component_to_string executable
167
192
@ List.concat args)
168
193
|> Option.some
+2
src/lib/import.ml
+2
src/lib/import.ml
+1
-1
src/lib/posix/dune
+1
-1
src/lib/posix/dune
+126
src/lib/posix/exec.ml
+126
src/lib/posix/exec.ml
···
1
+
open Eio.Std
2
+
3
+
let resolve_program name =
4
+
if not (String.contains name '/') then
5
+
Sys.getenv_opt "PATH"
6
+
|> Option.value ~default:"/bin:/usr/bin"
7
+
|> String.split_on_char ':'
8
+
|> List.find_map (fun dir ->
9
+
let p = Filename.concat dir name in
10
+
if Sys.file_exists p then Some p else None)
11
+
else if Sys.file_exists name then Some name
12
+
else None
13
+
14
+
let read_of_fd ~sw ~default ~to_close = function
15
+
| None -> default
16
+
| Some f -> (
17
+
match Eio_unix.Resource.fd_opt f with
18
+
| Some fd -> fd
19
+
| None ->
20
+
let r, w = Eio_unix.pipe sw in
21
+
Fiber.fork ~sw (fun () ->
22
+
Eio.Flow.copy f w;
23
+
Eio.Flow.close w);
24
+
let r = Eio_unix.Resource.fd r in
25
+
to_close := r :: !to_close;
26
+
r)
27
+
28
+
let write_of_fd ~sw ~default ~to_close = function
29
+
| None -> default
30
+
| Some f -> (
31
+
match Eio_unix.Resource.fd_opt f with
32
+
| Some fd -> fd
33
+
| None ->
34
+
let r, w = Eio_unix.pipe sw in
35
+
Fiber.fork ~sw (fun () ->
36
+
Eio.Flow.copy r f;
37
+
Eio.Flow.close r);
38
+
let w = Eio_unix.Resource.fd w in
39
+
to_close := w :: !to_close;
40
+
w)
41
+
42
+
let with_close_list fn =
43
+
let to_close = ref [] in
44
+
let close () = List.iter Eio_unix.Fd.close !to_close in
45
+
match fn to_close with
46
+
| x ->
47
+
close ();
48
+
x
49
+
| exception ex ->
50
+
let bt = Printexc.get_raw_backtrace () in
51
+
close ();
52
+
Printexc.raise_with_backtrace ex bt
53
+
54
+
let get_executable ~args = function
55
+
| Some exe -> exe
56
+
| None -> (
57
+
match args with
58
+
| [] -> invalid_arg "Arguments list is empty and no executable given!"
59
+
| x :: _ -> (
60
+
match resolve_program x with
61
+
| Some x -> x
62
+
| None -> raise (Eio.Process.err (Executable_not_found x))))
63
+
64
+
let get_env = function Some e -> e | None -> Unix.environment ()
65
+
66
+
let spawn_unix () ~sw ?cwd ?pgid ?uid ?gid ~env ~fds ~executable args =
67
+
let open Eio_posix in
68
+
let actions =
69
+
Low_level.Process.Fork_action.
70
+
[ inherit_fds fds; execve executable ~argv:(Array.of_list args) ~env ]
71
+
in
72
+
let actions =
73
+
match pgid with
74
+
| None -> actions
75
+
| Some pgid -> Low_level.Process.Fork_action.setpgid pgid :: actions
76
+
in
77
+
let actions =
78
+
match uid with
79
+
| None -> actions
80
+
| Some uid -> Eio_unix.Private.Fork_action.setuid uid :: actions
81
+
in
82
+
let actions =
83
+
match gid with
84
+
| None -> actions
85
+
| Some gid -> Eio_unix.Private.Fork_action.setgid gid :: actions
86
+
in
87
+
let with_actions cwd fn =
88
+
match cwd with
89
+
| None -> fn actions
90
+
| Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) -> (
91
+
match Eio_posix__.Fs.as_posix_dir dir with
92
+
| None -> Fmt.invalid_arg "cwd is not an OS directory!"
93
+
| Some dirfd ->
94
+
Switch.run ~name:"spawn_unix" @@ fun launch_sw ->
95
+
let cwd =
96
+
Eio_posix__.Err.run
97
+
(fun () ->
98
+
let flags = Low_level.Open_flags.(rdonly + directory) in
99
+
Low_level.openat ~sw:launch_sw ~mode:0 dirfd path flags)
100
+
()
101
+
in
102
+
fn (Low_level.Process.Fork_action.fchdir cwd :: actions))
103
+
in
104
+
with_actions cwd @@ fun actions ->
105
+
Eio_posix__.Process.process (Low_level.Process.spawn ~sw actions)
106
+
107
+
let run ~sw _ ?stdin ?stdout ?stderr ?(fds = []) ?cwd ?env ?executable args =
108
+
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
112
+
in
113
+
let stderr_fd =
114
+
write_of_fd ~sw stderr ~default:Eio_unix.Fd.stderr ~to_close
115
+
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
123
+
in
124
+
let executable = get_executable executable ~args in
125
+
let env = get_env env in
126
+
spawn_unix ~sw ?cwd ~fds ~env ~executable () args
+2
-3
src/lib/posix/merry_posix.ml
+2
-3
src/lib/posix/merry_posix.ml
···
6
6
type t = { mgr : Eio_unix.Process.mgr_ty Eio_unix.Process.mgr }
7
7
type fork_action = unit
8
8
9
-
let exec ?fork_actions:_ ?stdin ?stdout ?stderr t s =
10
-
(* let fds = List.map (fun (i, fd) -> (i, fd, `Nonblocking)) fds in *)
9
+
let exec ?fork_actions:_ ?(fds = []) ?stdin ?stdout ?stderr t args =
11
10
Eio.Switch.run @@ fun sw ->
12
-
Eio.Process.spawn ~sw ?stdin ?stdout ?stderr t.mgr s |> Eio.Process.await
11
+
Exec.run ~sw ~fds ?stdin ?stdout ?stderr t args |> Eio.Process.await
13
12
|> function
14
13
| `Exited n -> n
15
14
| `Signaled n -> n
+3
-2
src/lib/types.ml
+3
-2
src/lib/types.ml
···
31
31
32
32
val exec :
33
33
?fork_actions:fork_action list ->
34
-
?stdin:[> Eio__Flow.source_ty ] Eio_unix.source ->
34
+
?fds:(int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking) list ->
35
+
?stdin:_ Eio_unix.source ->
35
36
?stdout:_ Eio_unix.sink ->
36
-
?stderr:[> Eio__Flow.sink_ty ] Eio_unix.source ->
37
+
?stderr:_ Eio_unix.sink ->
37
38
t ->
38
39
string list ->
39
40
int