Shells in OCaml
Set built-in and pipeline fixes
We add some of the `set -o` capabilities (though unimplemented).
Pipelines need fixing w.r.t built-ins.
+98
-31
+1
-1
src/bin/main.ml
+1
-1
src/bin/main.ml
+58
-3
src/lib/built_ins.ml
+58
-3
src/lib/built_ins.ml
···
1
+
module Options = struct
2
+
type t = { noclobber : bool; pipefail : bool }
3
+
4
+
let default = { noclobber = false; pipefail = false }
5
+
6
+
let with_options ?noclobber ?pipefail t =
7
+
{
8
+
noclobber = Option.value ~default:t.noclobber noclobber;
9
+
pipefail = Option.value ~default:t.pipefail pipefail;
10
+
}
11
+
12
+
type option = Noclobber | Pipefail
13
+
14
+
let update t options =
15
+
List.fold_left
16
+
(fun d -> function
17
+
| Pipefail -> with_options ~pipefail:true d
18
+
| Noclobber -> with_options ~noclobber:true d)
19
+
t options
20
+
21
+
let pp ppf opt =
22
+
let pp_option ppf (name, value) =
23
+
Fmt.pf ppf "%-12s %s@." name (if value then "on" else "off")
24
+
in
25
+
let opts =
26
+
let { noclobber; pipefail } = opt in
27
+
[ ("pipefail", pipefail); ("noclobber", noclobber) ]
28
+
in
29
+
Fmt.pf ppf "@[<v>%a@]" Fmt.(list pp_option) opts
30
+
end
31
+
32
+
type set = { update : Options.option list; print_options : bool }
33
+
1
34
(* Built-in Actions *)
2
-
type t = Cd of { path : string option } | Pwd | Exit of int
35
+
type t = Cd of { path : string option } | Pwd | Exit of int | Set of set
3
36
4
37
(* Change Directory *)
5
38
module Cd = struct
···
51
84
Cmd.v info term
52
85
end
53
86
87
+
module Set = struct
88
+
open Cmdliner
89
+
open Options
90
+
91
+
let enum_map = [ ("pipefail", Pipefail); ("noclobber", Noclobber) ]
92
+
93
+
let option =
94
+
let doc = "Options." in
95
+
Arg.(value & opt_all (enum enum_map) [] & info [ "o" ] ~docv:"OPTION" ~doc)
96
+
97
+
let t =
98
+
let make_set update = Set { update; print_options = false } in
99
+
let term = Term.(const make_set $ option) in
100
+
let info =
101
+
let doc = "Set or unset options and positional parameters." in
102
+
Cmd.info "set" ~doc
103
+
in
104
+
Cmd.v info term
105
+
end
106
+
54
107
let of_args (w : string list) =
55
108
let open Cmdliner in
56
109
let exec_cmd cmd v =
57
110
let t = Cmd.eval_value ~argv:(Array.of_list cmd) v in
58
111
match t with
59
-
| Ok (`Ok v) -> Some v
60
-
| Ok `Version | Ok `Help | Error _ -> None
112
+
| Ok (`Ok v) -> Some (Ok v)
113
+
| Ok `Version | Ok `Help | Error `Parse -> Some (Error "parsing")
114
+
| Error _ -> None
61
115
in
62
116
63
117
match w with
64
118
| "cd" :: _ as cmd -> exec_cmd cmd Cd.t
65
119
| "pwd" :: _ as cmd -> exec_cmd cmd Pwd.t
66
120
| "exit" :: _ as cmd -> exec_cmd cmd Exit.t
121
+
| "set" :: _ as cmd -> exec_cmd cmd Set.t
67
122
| _ -> None
+15
-2
src/lib/built_ins.mli
+15
-2
src/lib/built_ins.mli
···
1
+
module Options : sig
2
+
type t = { noclobber : bool; pipefail : bool }
3
+
type option = Noclobber | Pipefail
4
+
5
+
val default : t
6
+
val with_options : ?noclobber:bool -> ?pipefail:bool -> t -> t
7
+
val update : t -> option list -> t
8
+
val pp : t Fmt.t
9
+
end
10
+
11
+
type set = { update : Options.option list; print_options : bool }
12
+
1
13
type t =
2
14
| Cd of { path : string option }
3
15
(** Change directory to a path (if [None] then it should be [HOME]) *)
4
16
| Pwd
5
17
| Exit of int
18
+
| Set of set
6
19
7
-
val of_args : string list -> t option
8
-
(** Parses a command-line to the built-ins *)
20
+
val of_args : string list -> (t, string) result option
21
+
(** Parses a command-line to the built-ins, errors are returned if parsing. *)
+18
-17
src/lib/eval.ml
+18
-17
src/lib/eval.ml
···
5
5
open Import
6
6
open Exit.Syntax
7
7
8
-
module Options = struct
9
-
type t = { noclobber : bool; pipefail : bool }
10
-
11
-
let default = { noclobber = false; pipefail = false }
12
-
13
-
let with_options ?noclobber ?pipefail t =
14
-
{
15
-
noclobber = Option.value ~default:t.noclobber noclobber;
16
-
pipefail = Option.value ~default:t.pipefail pipefail;
17
-
}
18
-
end
19
-
20
8
(** An evaluator over the AST *)
21
9
module Make (S : Types.State) (E : Types.Exec) = struct
22
10
(* What follows uses the POSIX definition of what a shell does ($ 2.1).
···
45
33
local_state : (string * string) list;
46
34
executor : E.t;
47
35
fs : Eio.Fs.dir_ty Eio.Path.t;
48
-
options : Options.t;
36
+
options : Built_ins.Options.t;
49
37
stdout : Eio_unix.sink_ty Eio.Flow.sink option;
50
38
}
51
39
···
192
180
{ Exit.default_should_exit with interactive = `Yes }
193
181
in
194
182
Exit.nonzero_msg ~should_exit ctx ~exit_code:n "exit"
183
+
| Set { update; print_options } ->
184
+
let v =
185
+
Exit.zero
186
+
{ ctx with options = Built_ins.Options.update ctx.options update }
187
+
in
188
+
if print_options then Fmt.pr "%a%!" Built_ins.Options.pp ctx.options;
189
+
v
195
190
196
191
let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs
197
192
···
236
231
Built_ins.of_args
237
232
[ handle_word_components_to_string ctx executable ]
238
233
with
239
-
| Some bi ->
234
+
| Some (Ok bi) ->
240
235
let ctx = handle_built_in ctx bi in
241
236
let built_in = ctx >|= fun _ -> () in
242
-
(Exit.value ctx, handle_job ~pgid job (`Built_in built_in))
237
+
let job = handle_job ~pgid job (`Built_in built_in) in
238
+
loop (Exit.value ctx) job (pgid, stdout_of_previous) rest
239
+
| Some (Error _) ->
240
+
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
243
241
| None -> (
244
242
let some_read, some_write =
245
243
stdout_for_pipeline ctx ~sw:pipeline_switch rest
···
285
283
Built_ins.of_args
286
284
(handle_word_components_to_string ctx executable :: args)
287
285
with
288
-
| Some bi ->
286
+
| Some (Ok bi) ->
289
287
let ctx = handle_built_in ctx bi in
290
288
let built_in = ctx >|= fun _ -> () in
291
-
(Exit.value ctx, handle_job ~pgid job (`Built_in built_in))
289
+
let job = handle_job ~pgid job (`Built_in built_in) in
290
+
loop (Exit.value ctx) job (pgid, stdout_of_previous) rest
291
+
| Some (Error _) ->
292
+
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
292
293
| None -> (
293
294
let redirect =
294
295
List.fold_left
+1
src/lib/merry.ml
+1
src/lib/merry.ml
+1
src/lib/merry.mli
+1
src/lib/merry.mli
+4
-8
test/pipelines.t
+4
-8
test/pipelines.t
···
7
7
ls: invalid option -- 'j'
8
8
Try 'ls --help' for more information.
9
9
[2]
10
-
$ sh -c "ls -j | ls"
10
+
$ sh -c "ls -j | sleep 0.1; ls"
11
11
ls: invalid option -- 'j'
12
12
Try 'ls --help' for more information.
13
13
hello
···
15
15
ls: invalid option -- 'j'
16
16
Try 'ls --help' for more information.
17
17
[2]
18
-
$ osh -c "ls -j | ls"
18
+
$ osh -c "ls -j | sleep 0.1; ls"
19
19
ls: invalid option -- 'j'
20
20
Try 'ls --help' for more information.
21
21
hello
22
22
23
23
And an exclaimation point should invert that.
24
24
25
-
$ sh -c "! ls -j | ls"
26
-
ls: invalid option -- 'j'
27
-
Try 'ls --help' for more information.
25
+
$ sh -c "! exit 1 | ls"
28
26
hello
29
27
[1]
30
-
$ osh -c "! ls -j | ls"
31
-
ls: invalid option -- 'j'
32
-
Try 'ls --help' for more information.
28
+
$ osh -c "! exit 1 | ls"
33
29
hello
34
30
[1]