Shells in OCaml
Change and print directory
We create the infrastructure necessary to support shell built-ins. The
built-ins `cd` and `pwd` are added and lightly tested.
+249
-108
+12
TODO.md
+12
TODO.md
···
18
18
- [ ] Globs
19
19
- [ ] Traps
20
20
- [ ] Background Tasks
21
+
- [ ] Interactive Mode
22
+
- [x] Initial prototype
23
+
- [ ] Signals (e.g. ctrl+D)
24
+
- [ ] Built-ins
25
+
- [x] Basic cmdliner infrastructure
26
+
- [ ] cd
27
+
- [x] Basic functionality
28
+
- [ ] Flags
29
+
- [ ] pwd
30
+
- [x] Basic functionality
31
+
- [ ] Flags
32
+
- [ ] which
21
33
22
34
## Conformance Testing
23
35
+5
-2
src/bin/main.ml
+5
-2
src/bin/main.ml
···
1
1
(* A shell... one day *)
2
-
2
+
open Merry.Import
3
3
module C = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec)
4
4
module I = Merry.Interactive.Make (Merry_posix.State) (Merry_posix.Exec)
5
5
···
8
8
let ctx =
9
9
C.
10
10
{
11
-
state = Merry_posix.State.make ~home:(Sys.getenv "HOME") ();
11
+
state =
12
+
Merry_posix.State.make
13
+
~home:(Sys.getenv "HOME" ^ "/")
14
+
(Fpath.v (Eunix.cwd ()));
12
15
executor;
13
16
fs = env#fs;
14
17
options = Merry.Eval.Options.default;
+14
src/lib/ast.ml
+14
src/lib/ast.ml
···
738
738
let of_file path =
739
739
let fname = Eio.Path.native_exn path in
740
740
Eio.Path.load path |> Morbig.parse_string fname |> of_program
741
+
742
+
let rec word_component_to_string : word_component -> string = function
743
+
| WordName s -> s
744
+
| WordLiteral s -> s
745
+
| WordDoubleQuoted s ->
746
+
String.concat " " (List.map word_component_to_string s)
747
+
| WordSingleQuoted s ->
748
+
String.concat " " (List.map word_component_to_string s)
749
+
| v ->
750
+
Fmt.failwith "Conversion of %a" Yojson.Safe.pp
751
+
(word_component_to_yojson v)
752
+
753
+
let word_components_to_string ws =
754
+
String.concat "" (List.map word_component_to_string ws)
+3
src/lib/ast.mli
+3
src/lib/ast.mli
+48
src/lib/built_ins.ml
+48
src/lib/built_ins.ml
···
1
+
(* Built-in Actions *)
2
+
type t = Cd of { path : string option } | Pwd
3
+
4
+
(* Change Directory *)
5
+
module Cd = struct
6
+
open Cmdliner
7
+
8
+
let path =
9
+
let doc = "Directory to change to." in
10
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"DIRECTORY" ~doc)
11
+
12
+
let t =
13
+
let make_cd path = Cd { path } in
14
+
let term = Term.(const make_cd $ path) in
15
+
let info =
16
+
let doc = "Change directory, see man cd for more information." in
17
+
Cmd.info "cd" ~doc
18
+
in
19
+
Cmd.v info term
20
+
end
21
+
22
+
(* Print working directory *)
23
+
module Pwd = struct
24
+
open Cmdliner
25
+
26
+
let t =
27
+
let make_pwd = Pwd in
28
+
let term = Term.(const make_pwd) in
29
+
let info =
30
+
let doc = "Print working directory" in
31
+
Cmd.info "pwd" ~doc
32
+
in
33
+
Cmd.v info term
34
+
end
35
+
36
+
let of_args (w : string list) =
37
+
let open Cmdliner in
38
+
let exec_cmd cmd v =
39
+
let t = Cmd.eval_value ~argv:(Array.of_list cmd) v in
40
+
match t with
41
+
| Ok (`Ok v) -> Some v
42
+
| Ok `Version | Ok `Help | Error _ -> None
43
+
in
44
+
45
+
match w with
46
+
| "cd" :: _ as cmd -> exec_cmd cmd Cd.t
47
+
| "pwd" :: _ as cmd -> exec_cmd cmd Pwd.t
48
+
| _ -> None
+7
src/lib/built_ins.mli
+7
src/lib/built_ins.mli
+1
-1
src/lib/dune
+1
-1
src/lib/dune
+103
-80
src/lib/eval.ml
+103
-80
src/lib/eval.ml
···
21
21
then redirection is setup, and finally functions/built-ins/commands are
22
22
executed. *)
23
23
24
-
let rec word_component_to_string : Ast.word_component -> string = function
25
-
| WordName s -> s
26
-
| WordLiteral s -> s
27
-
| WordDoubleQuoted s ->
28
-
String.concat " " (List.map word_component_to_string s)
29
-
| WordSingleQuoted s ->
30
-
String.concat " " (List.map word_component_to_string s)
31
-
| v ->
32
-
Fmt.failwith "Conversion of %a" Yojson.Safe.pp
33
-
(Ast.word_component_to_yojson v)
34
-
35
-
let word_components_to_string ws =
36
-
String.concat "" (List.map word_component_to_string ws)
37
-
38
24
class default_map =
39
25
object (_)
40
26
inherit Ast.map
···
144
130
| Io_op_less ->
145
131
(* Simple redirection for input *)
146
132
let r =
147
-
Eio.Path.open_in ~sw (ctx.fs / word_components_to_string file)
133
+
Eio.Path.open_in ~sw (ctx.fs / Ast.word_components_to_string file)
148
134
in
149
135
let fd = Eio_unix.Resource.fd_opt r |> Option.get in
150
136
Some (Types.Redirect (n, fd, `Blocking))
···
166
152
let append = v = Io_op_dgreat in
167
153
let w =
168
154
Eio.Path.open_out ~sw ~append ~create:(`If_missing 0o644)
169
-
(ctx.fs / word_components_to_string file)
155
+
(ctx.fs / Ast.word_components_to_string file)
170
156
in
171
157
let fd = Eio_unix.Resource.fd_opt w |> Option.get in
172
158
Some (Types.Redirect (n, fd, `Blocking))
···
188
174
| Ast.IoRedirect_IoHere _ ->
189
175
Fmt.failwith "HERE documents not yet implemented!"
190
176
191
-
let execute_commands ctx local_switch p =
192
-
let rec loop (status_of_previous, stdout_of_previous) = function
177
+
let handle_built_in (ctx : ctx) = function
178
+
| Built_ins.Cd { path } ->
179
+
let cwd = S.cwd ctx.state in
180
+
let new_cwd =
181
+
match path with
182
+
| Some p ->
183
+
let fp = Fpath.append cwd (Fpath.v p) in
184
+
Eunix.chdir p;
185
+
fp
186
+
| None -> Fpath.v ""
187
+
in
188
+
let state = S.set_cwd ctx.state new_cwd in
189
+
({ ctx with state }, Some 0)
190
+
| Pwd ->
191
+
Fmt.pr "%s\n%!" (Eunix.cwd ());
192
+
(ctx, Some 0)
193
+
194
+
let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs
195
+
196
+
let execute_commands initial_ctx local_switch p =
197
+
let rec loop ctx (status_of_previous, stdout_of_previous) :
198
+
Ast.command list -> ctx * int option = function
193
199
| Ast.SimpleCommand (Prefixed _) :: next ->
194
-
loop (status_of_previous, stdout_of_previous) next
200
+
loop ctx (status_of_previous, stdout_of_previous) next
195
201
| Ast.SimpleCommand (Named (executable, None)) :: rest -> (
196
-
let some_read, some_write =
197
-
stdout_for_pipeline ~sw:local_switch rest
198
-
in
199
-
match stdout_of_previous with
200
-
| None ->
201
-
E.exec ctx.executor ?stdout:some_write
202
-
(List.map word_component_to_string executable)
203
-
|> Option.some
204
-
| Some stdout ->
205
-
let res =
206
-
E.exec ctx.executor ~stdin:stdout ?stdout:some_write
207
-
(List.map word_component_to_string executable)
202
+
match
203
+
Built_ins.of_args [ Ast.word_components_to_string executable ]
204
+
with
205
+
| Some bi -> handle_built_in ctx bi
206
+
| None -> (
207
+
let some_read, some_write =
208
+
stdout_for_pipeline ~sw:local_switch rest
208
209
in
209
-
Option.iter Eio.Flow.close some_write;
210
-
loop (Some res, some_read) rest)
210
+
match stdout_of_previous with
211
+
| None ->
212
+
( ctx,
213
+
E.exec ctx.executor ?stdout:some_write ~cwd:(cwd_of_ctx ctx)
214
+
(List.map Ast.word_component_to_string executable)
215
+
|> Option.some )
216
+
| Some stdout ->
217
+
let res =
218
+
E.exec ctx.executor ~stdin:stdout ?stdout:some_write
219
+
~cwd:(cwd_of_ctx ctx)
220
+
(List.map Ast.word_component_to_string executable)
221
+
in
222
+
Option.iter Eio.Flow.close some_write;
223
+
loop ctx (Some res, some_read) rest))
211
224
| Ast.SimpleCommand (Named (executable, Some suffix)) :: rest -> (
212
225
let args =
213
226
List.filter_map
214
227
(function
215
228
| Ast.Suffix_word w ->
216
-
Some (List.map word_component_to_string w)
229
+
Some
230
+
(String.concat ""
231
+
@@ List.map Ast.word_component_to_string w)
217
232
| Ast.Suffix_redirect _ -> None)
218
233
suffix
219
234
in
220
-
let redirect =
221
-
List.fold_left
222
-
(fun acc -> function
223
-
| Ast.Suffix_word _ -> acc
224
-
| Ast.Suffix_redirect rdr ->
225
-
handle_one_redirection ~sw:local_switch ctx rdr :: acc)
226
-
[] suffix
227
-
|> List.rev |> List.filter_map Fun.id
228
-
in
229
-
let some_read, some_write =
230
-
stdout_for_pipeline ~sw:local_switch rest
231
-
in
232
-
match stdout_of_previous with
233
-
| None ->
234
-
let res =
235
-
E.exec ~fds:redirect ctx.executor ?stdout:some_write
236
-
(List.map word_component_to_string executable
237
-
@ List.concat args)
238
-
|> Option.some
235
+
match
236
+
Built_ins.of_args (Ast.word_components_to_string executable :: args)
237
+
with
238
+
| Some bi -> handle_built_in ctx bi
239
+
| None -> (
240
+
let redirect =
241
+
List.fold_left
242
+
(fun acc -> function
243
+
| Ast.Suffix_word _ -> acc
244
+
| Ast.Suffix_redirect rdr ->
245
+
handle_one_redirection ~sw:local_switch ctx rdr :: acc)
246
+
[] suffix
247
+
|> List.rev |> List.filter_map Fun.id
239
248
in
240
-
Option.iter Eio.Flow.close some_write;
241
-
loop (res, some_read) rest
242
-
| Some stdout ->
243
-
let res =
244
-
E.exec ~fds:redirect ctx.executor ~stdin:stdout
245
-
?stdout:some_write
246
-
(List.map word_component_to_string executable
247
-
@ List.concat args)
248
-
|> Option.some
249
+
let some_read, some_write =
250
+
stdout_for_pipeline ~sw:local_switch rest
249
251
in
250
-
Option.iter Eio.Flow.close some_write;
251
-
loop (res, some_read) rest)
252
+
match stdout_of_previous with
253
+
| None ->
254
+
let res =
255
+
E.exec ~fds:redirect ctx.executor ?stdout:some_write
256
+
~cwd:(cwd_of_ctx ctx)
257
+
(List.map Ast.word_component_to_string executable @ args)
258
+
|> Option.some
259
+
in
260
+
Option.iter Eio.Flow.close some_write;
261
+
loop ctx (res, some_read) rest
262
+
| Some stdout ->
263
+
let res =
264
+
E.exec ~fds:redirect ctx.executor ~stdin:stdout
265
+
~cwd:(cwd_of_ctx ctx) ?stdout:some_write
266
+
(List.map Ast.word_component_to_string executable @ args)
267
+
|> Option.some
268
+
in
269
+
Option.iter Eio.Flow.close some_write;
270
+
loop ctx (res, some_read) rest))
252
271
| v :: _ ->
253
272
Fmt.epr "TODO: %a" Yojson.Safe.pp (Ast.command_to_yojson v);
254
273
failwith "Err"
255
-
| [] -> status_of_previous
274
+
| [] -> (ctx, status_of_previous)
256
275
in
257
-
loop (None, None) p
276
+
loop initial_ctx (None, None) p
258
277
259
278
let handle_single_pipeline ~sw ctx c =
260
279
let pipeline = function
261
280
| Ast.Pipeline p -> (Fun.id, p)
262
281
| Ast.Pipeline_Bang p ->
263
-
(Option.map (fun i -> if Int.equal i 0 then -1 else 0), p)
282
+
( (fun (ctx, v) ->
283
+
(ctx, Option.map (fun i -> if Int.equal i 0 then -1 else 0) v)),
284
+
p )
264
285
in
265
286
266
287
let rec fold :
267
-
Ast.and_or * int option -> Ast.pipeline Ast.and_or_list -> int option =
268
-
fun (sep, exit_so_far) pipe ->
288
+
Ast.and_or * (ctx * int option) ->
289
+
Ast.pipeline Ast.and_or_list ->
290
+
ctx * int option =
291
+
fun (sep, (ctx, exit_so_far)) pipe ->
269
292
match (sep, pipe) with
270
293
| And, Nlist.Singleton (p, _) -> (
271
294
match exit_so_far with
272
295
| Some 0 ->
273
296
let f, p = pipeline p in
274
297
f @@ execute_commands ctx sw p
275
-
| v -> v)
298
+
| v -> (ctx, v))
276
299
| Or, Nlist.Singleton (p, _) -> (
277
300
match exit_so_far with
278
-
| Some 0 -> Some 0
301
+
| Some 0 -> (ctx, Some 0)
279
302
| _ ->
280
303
let f, p = pipeline p in
281
304
f @@ execute_commands ctx sw p)
···
290
313
| Some 0 ->
291
314
let f, p = pipeline p in
292
315
fold (next_sep, f (execute_commands ctx sw p)) rest
293
-
| (None | Some _) as v -> v)
316
+
| (None | Some _) as v -> (ctx, v))
294
317
| Or, Nlist.Cons ((p, next_sep), rest) -> (
295
318
match exit_so_far with
296
-
| Some 0 -> fold (next_sep, exit_so_far) rest
319
+
| Some 0 -> fold (next_sep, (ctx, exit_so_far)) rest
297
320
| None | Some _ ->
298
321
let f, p = pipeline p in
299
322
fold (next_sep, f (execute_commands ctx sw p)) rest)
300
323
in
301
-
fold (Noand_or, None) c
324
+
fold (Noand_or, (ctx, None)) c
302
325
303
-
let exec ctx (ast : Ast.complete_command) =
326
+
let exec initial_ctx (ast : Ast.complete_command) =
304
327
let command, _ = ast in
305
-
let rec loop : Eio.Switch.t -> Ast.clist -> int option =
306
-
fun sw -> function
328
+
let rec loop : Eio.Switch.t -> ctx -> Ast.clist -> ctx * int option =
329
+
fun sw ctx -> function
307
330
| Nlist.Singleton (c, _) -> handle_single_pipeline ~sw ctx c
308
331
| Nlist.Cons ((c, (Semicolon | Nosep)), cs) -> (
309
332
match handle_single_pipeline ~sw ctx c with
310
-
| Some 0 -> loop sw cs
333
+
| ctx, Some 0 -> loop sw ctx cs
311
334
| v -> v)
312
335
| _ -> Fmt.failwith "Background tasks not implemented yet!"
313
336
in
314
-
Eio.Switch.run @@ fun sw -> (loop sw command, ctx, ast)
337
+
Eio.Switch.run @@ fun sw -> (loop sw initial_ctx command, ast)
315
338
316
339
let apply_pair (a, b) f = f a b
317
340
let ( ||> ) = apply_pair
···
328
351
let ctx, cs =
329
352
List.fold_left
330
353
(fun (ctx, cs) command ->
331
-
let exit_code, ctx, ast =
354
+
let (ctx, exit_code), ast =
332
355
expand ctx command ||> redirect ||> execute
333
356
in
334
357
Option.iter (function 0 -> () | n -> exit n) exit_code;
+10
src/lib/import.ml
+10
src/lib/import.ml
···
50
50
let fold_left f acc (vs : ('a, 'b) t) =
51
51
Nlist.fold_left (fun acc (a, b) -> f acc a b) acc vs
52
52
end
53
+
54
+
let yojson_pp = Yojson.Safe.pretty_print ~std:true
55
+
56
+
module Eunix = struct
57
+
let cwd () =
58
+
Eio_unix.run_in_systhread ~label:"cwd" @@ fun () -> Unix.getcwd ()
59
+
60
+
let chdir p =
61
+
Eio_unix.run_in_systhread ~label:"chdir" @@ fun () -> Unix.chdir p
62
+
end
+2
-1
src/lib/interactive.ml
+2
-1
src/lib/interactive.ml
···
1
1
module Make (S : Types.State) (E : Types.Exec) = struct
2
2
module Eval = Eval.Make (S) (E)
3
3
4
-
let default_prompt _ = Fmt.str "%s >\t%!" (Unix.getcwd ())
4
+
let default_prompt s =
5
+
Fmt.str "%s > %!" (Fpath.normalize @@ S.cwd s |> Fpath.to_string)
5
6
6
7
let with_stdin_in_raw_mode fn =
7
8
let saved_tio = Unix.tcgetattr Unix.stdin in
+1
src/lib/merry.ml
+1
src/lib/merry.ml
+16
-18
src/lib/posix/exec.ml
+16
-18
src/lib/posix/exec.ml
···
91
91
Eio_unix.Private.Fork_action.
92
92
{ run = (fun k -> k (Obj.repr (action_dups, plan, blocking))) }
93
93
94
-
let spawn_unix () ~sw ?cwd ?pgid ?uid ?gid ~env ~fds ~executable args =
94
+
let spawn_unix () ~sw ?pgid ?uid ?gid ~env ~fds ~executable ~cwd args =
95
95
let open Eio_posix in
96
96
let actions =
97
97
[
···
116
116
| Some gid -> Eio_unix.Private.Fork_action.setgid gid :: actions
117
117
in
118
118
let with_actions cwd fn =
119
-
match cwd with
120
-
| None -> fn actions
121
-
| Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) -> (
122
-
match Eio_posix__.Fs.as_posix_dir dir with
123
-
| None -> Fmt.invalid_arg "cwd is not an OS directory!"
124
-
| Some dirfd ->
125
-
Switch.run ~name:"spawn_unix" @@ fun launch_sw ->
126
-
let cwd =
127
-
Eio_posix__.Err.run
128
-
(fun () ->
129
-
let flags = Low_level.Open_flags.(rdonly + directory) in
130
-
Low_level.openat ~sw:launch_sw ~mode:0 dirfd path flags)
131
-
()
132
-
in
133
-
fn (Low_level.Process.Fork_action.fchdir cwd :: actions))
119
+
let ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) = cwd in
120
+
match Eio_posix__.Fs.as_posix_dir dir with
121
+
| None -> Fmt.invalid_arg "cwd is not an OS directory!"
122
+
| Some dirfd ->
123
+
Switch.run ~name:"spawn_unix" @@ fun launch_sw ->
124
+
let cwd =
125
+
Eio_posix__.Err.run
126
+
(fun () ->
127
+
let flags = Low_level.Open_flags.(rdonly + directory) in
128
+
Low_level.openat ~sw:launch_sw ~mode:0 dirfd path flags)
129
+
()
130
+
in
131
+
fn (Low_level.Process.Fork_action.fchdir cwd :: actions)
134
132
in
135
133
with_actions cwd @@ fun actions ->
136
134
Eio_posix__.Process.process (Low_level.Process.spawn ~sw actions)
···
142
140
143
141
let pp_redirections ppf (i, fd, _) = Fmt.pf ppf "(%i,%a)" i Eio_unix.Fd.pp fd
144
142
145
-
let run ~sw _ ?stdin ?stdout ?stderr ?(fds = []) ?cwd ?env ?executable args =
143
+
let run ~sw _ ?stdin ?stdout ?stderr ?(fds = []) ~cwd ?env ?executable args =
146
144
with_close_list @@ fun to_close ->
147
145
let check_fd n = function
148
146
| Merry.Types.Redirect (m, _, _) -> Int.equal n m
···
185
183
let fds = std_fds @ fds in
186
184
let executable = get_executable executable ~args in
187
185
let env = get_env env in
188
-
spawn_unix ~sw ?cwd ~fds ~env ~executable () args
186
+
spawn_unix ~sw ~cwd ~fds ~env ~executable () args
+2
-2
src/lib/posix/merry_posix.ml
+2
-2
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:_ ?(fds = []) ?stdin ?stdout ?stderr t args =
9
+
let exec ?fork_actions:_ ?(fds = []) ?stdin ?stdout ?stderr ~cwd t args =
10
10
Eio.Switch.run @@ fun sw ->
11
-
Exec.run ~sw ~fds ?stdin ?stdout ?stderr t args |> Eio.Process.await
11
+
Exec.run ~sw ~fds ~cwd ?stdin ?stdout ?stderr t args |> Eio.Process.await
12
12
|> function
13
13
| `Exited n -> n
14
14
| `Signaled n -> n
+5
-4
src/lib/posix/state.ml
+5
-4
src/lib/posix/state.ml
···
1
1
module Variables = Map.Make (String)
2
2
3
3
type t = {
4
-
cwd : string;
4
+
cwd : Fpath.t;
5
5
functions : Merry.Function.t list;
6
6
root : int;
7
7
outermost : bool;
···
9
9
variables : Merry.Ast.word_cst Variables.t;
10
10
}
11
11
12
-
let make ?(cwd = ".") ?(functions = []) ?(root = 0) ?(outermost = true)
13
-
?(home = "/root") ?(variables = Variables.empty) () =
12
+
let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root")
13
+
?(variables = Variables.empty) cwd =
14
14
{ cwd; functions; root; outermost; home; variables }
15
15
16
-
let default = make ()
16
+
let cwd t = t.cwd
17
+
let set_cwd t cwd = { t with cwd }
17
18
let expand t = function `Tilde -> t.home
18
19
let lookup t ~param = Variables.find_opt param t.variables
19
20
+7
src/lib/types.ml
+7
src/lib/types.ml
···
11
11
(** State for the shell and operating system that is carried from one
12
12
evaluation step to the next. *)
13
13
14
+
val cwd : t -> Fpath.t
15
+
(** The current working directory *)
16
+
17
+
val set_cwd : t -> Fpath.t -> t
18
+
(** Update the cwd *)
19
+
14
20
val expand : t -> [ `Tilde ] -> string
15
21
(** Expansions *)
16
22
···
39
45
?stdin:_ Eio_unix.source ->
40
46
?stdout:_ Eio_unix.sink ->
41
47
?stderr:_ Eio_unix.sink ->
48
+
cwd:Eio.Fs.dir_ty Eio.Path.t ->
42
49
t ->
43
50
string list ->
44
51
int