Shells in OCaml
Add hash built-in
This also fixes the problem where the stdout of built-in functions was
just going to the parent stdout instead of respecting things like
pipelines etc.
+197
-56
+1
src/bin/main.ml
+1
src/bin/main.ml
+29
-2
src/lib/built_ins.ml
+29
-2
src/lib/built_ins.ml
···
34
34
end
35
35
36
36
type set = { update : Options.option list; print_options : bool }
37
+
type hash = Hash_remove | Hash_stats | Hash_add of string list
37
38
38
39
(* Built-in Actions *)
39
40
type t =
···
44
45
| Wait of int
45
46
| Dot of string (* a.k.a source *)
46
47
| Unset of [ `Variables of string list | `Functions of string list ]
48
+
| Hash of hash
47
49
48
50
(* Change Directory *)
49
51
module Cd = struct
···
159
161
in
160
162
let term = Term.(const make_unset $ kind $ names) in
161
163
let info =
162
-
let doc = "Wait for a particular PID (default is 0)" in
163
-
Cmd.info "wait" ~doc
164
+
let doc = "Unset names of variables or functions." in
165
+
Cmd.info "unset" ~doc
166
+
in
167
+
Cmd.v info term
168
+
end
169
+
170
+
module Hash = struct
171
+
open Cmdliner
172
+
173
+
let remove =
174
+
let doc = "Empty the location table." in
175
+
Arg.(value & flag & info [ "r" ] ~docv:"REMOVE" ~doc)
176
+
177
+
let utilities =
178
+
let doc = "Utilities to search for and add to the location table." in
179
+
Arg.(value & pos_all string [] & info [] ~docv:"UTILITIES" ~doc)
180
+
181
+
let t =
182
+
let make_hash remove pos_all =
183
+
if remove then Hash Hash_remove
184
+
else match pos_all with [] -> Hash Hash_stats | us -> Hash (Hash_add us)
185
+
in
186
+
let term = Term.(const make_hash $ remove $ utilities) in
187
+
let info =
188
+
let doc = "Remember or report utility locations." in
189
+
Cmd.info "hash" ~doc
164
190
in
165
191
Cmd.v info term
166
192
end
···
212
238
| "source" :: _ as cmd -> exec_cmd cmd Source.t
213
239
| "." :: _ as cmd -> exec_cmd cmd Dot.t
214
240
| "unset" :: _ as cmd -> exec_cmd cmd Unset.t
241
+
| "hash" :: _ as cmd -> exec_cmd cmd Hash.t
215
242
| _ -> None
+2
src/lib/built_ins.mli
+2
src/lib/built_ins.mli
···
11
11
end
12
12
13
13
type set = { update : Options.option list; print_options : bool }
14
+
type hash = Hash_remove | Hash_stats | Hash_add of string list
14
15
15
16
type t =
16
17
| Cd of { path : string option }
···
21
22
| Wait of int
22
23
| Dot of string
23
24
| Unset of [ `Variables of string list | `Functions of string list ]
25
+
| Hash of hash
24
26
25
27
val of_args : string list -> (t, string) result option
26
28
(** Parses a command-line to the built-ins, errors are returned if parsing. *)
+70
-37
src/lib/eval.ml
+70
-37
src/lib/eval.ml
···
43
43
program : string;
44
44
argv : string array;
45
45
functions : (string * Ast.compound_command) list;
46
+
hash : Hash.t;
46
47
}
47
48
48
49
let clear_local_state ctx = { ctx with local_state = [] }
···
157
158
let apply_pair (a, b) f = f a b
158
159
let ( ||> ) = apply_pair
159
160
161
+
let resolve_program ?(update = true) ctx name =
162
+
let v =
163
+
if not (String.contains name '/') then
164
+
Sys.getenv_opt "PATH"
165
+
|> Option.value ~default:"/bin:/usr/bin"
166
+
|> String.split_on_char ':'
167
+
|> List.find_map (fun dir ->
168
+
let p = Filename.concat dir name in
169
+
if Sys.file_exists p then Some p else None)
170
+
else if Sys.file_exists name then Some name
171
+
else None
172
+
in
173
+
match (update, v) with
174
+
| true, Some loc ->
175
+
let hash = Hash.add ~utility:name ~loc ctx.hash in
176
+
({ ctx with hash }, Some loc)
177
+
| false, Some loc -> (ctx, Some loc)
178
+
| _, None -> (ctx, None)
179
+
160
180
let get_env ?(extra = []) ctx =
161
181
let extra =
162
182
extra
···
193
213
Eio.Flow.close some_write
194
214
end
195
215
in
196
-
let exec_process ctx job ?fds ?stdin ~stdout ~pgid args =
197
-
let process =
198
-
E.exec ctx.executor ?fds ?stdin ~stdout ~pgid ~mode
199
-
~cwd:(cwd_of_ctx ctx)
200
-
~env:(get_env ~extra:ctx.local_state ctx)
201
-
args
216
+
let exec_process ctx job ?fds ?stdin ~stdout ~pgid executable args =
217
+
let ctx, process =
218
+
match resolve_program ctx executable with
219
+
| ctx, None ->
220
+
Fmt.epr "msh: command not found: %s\n%!" executable;
221
+
(ctx, Error (127, `Not_found))
222
+
| ctx, Some full_path ->
223
+
( ctx,
224
+
E.exec ctx.executor ?fds ?stdin ~stdout ~pgid ~mode
225
+
~cwd:(cwd_of_ctx ctx)
226
+
~env:(get_env ~extra:ctx.local_state ctx)
227
+
~executable:full_path (executable :: args) )
202
228
in
203
229
match process with
204
230
| Error (n, _) ->
···
243
269
in
244
270
match Built_ins.of_args (executable :: args_as_strings) with
245
271
| Some (Ok bi) ->
246
-
let ctx = handle_built_in ctx bi in
272
+
let ctx = handle_built_in ~stdout:some_write ctx bi in
273
+
close_stdout ~is_global some_write;
247
274
let built_in = ctx >|= fun _ -> () in
248
275
let job = handle_job ~pgid job (`Built_in built_in) in
249
-
loop (Exit.value ctx) job (pgid, stdout_of_previous) rest
276
+
loop (Exit.value ctx) job (pgid, some_read) rest
250
277
| Some (Error _) ->
251
278
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
252
279
| None -> (
···
289
316
| None ->
290
317
let ctx, job =
291
318
exec_process ctx job ~fds:redirect
292
-
~stdout:some_write ~pgid
293
-
(executable :: args_as_strings)
319
+
~stdout:some_write ~pgid executable
320
+
args_as_strings
294
321
in
295
322
close_stdout ~is_global some_write;
296
323
loop ctx job (pgid, some_read) rest
297
324
| Some stdout ->
298
325
let ctx, job =
299
326
exec_process ctx job ~fds:redirect ~stdin:stdout
300
-
~stdout:some_write ~pgid
301
-
(executable :: args_as_strings)
327
+
~stdout:some_write ~pgid executable
328
+
args_as_strings
302
329
in
303
330
close_stdout ~is_global some_write;
304
331
loop ctx job (pgid, some_read) rest))))
···
320
347
process that last just until all of the processes are setup. *)
321
348
let ctx, job =
322
349
let ghost_process =
323
-
E.exec ~mode:(Types.Switched pipeline_switch) ~pgid:0
324
-
~cwd:(cwd_of_ctx initial_ctx) initial_ctx.executor
325
-
[ "sleep"; "99999999" ]
326
-
|> function
327
-
| Ok p -> p
328
-
| Error (n, `Not_found) ->
329
-
Fmt.epr "Interal error ghost process: not found";
330
-
exit n
350
+
match resolve_program ~update:false initial_ctx "sleep" with
351
+
| _, None -> Fmt.failwith "Sleep not found\n%!"
352
+
| ctx, Some sleep -> (
353
+
E.exec ~mode:(Types.Switched pipeline_switch) ~pgid:0
354
+
~cwd:(cwd_of_ctx ctx) ctx.executor ~executable:sleep
355
+
[ "sleep"; "99999999" ]
356
+
|> function
357
+
| Ok p -> p
358
+
| Error (n, `Not_found) ->
359
+
Fmt.epr "Interal error ghost process: not found";
360
+
exit n)
331
361
in
332
362
loop initial_ctx None (E.pid ghost_process, None) p
333
363
in
···
672
702
| Ast.Prefix_assignment (Name param, v) ->
673
703
(* Expand the values *)
674
704
let ctx, v = expand_cst ctx v in
705
+
let v = handle_subshell ctx v in
675
706
let state =
676
707
if update then S.update ctx.state ~param v else ctx.state
677
708
in
···
693
724
(ctx, acc @ word_glob_expand ctx cst))
694
725
(ctx, []) swc
695
726
696
-
and handle_built_in (ctx : ctx) = function
727
+
and handle_built_in ~(stdout : Eio_unix.sink_ty Eio.Flow.sink) (ctx : ctx) =
728
+
function
697
729
| Built_ins.Cd { path } ->
698
730
let cwd = S.cwd ctx.state in
699
731
let+ state =
···
708
740
in
709
741
{ ctx with state }
710
742
| Pwd ->
711
-
Fmt.pr "%a\n%!" Fpath.pp (S.cwd ctx.state);
743
+
Eio.Flow.copy_string
744
+
(Fmt.str "%a\n%!" Fpath.pp (S.cwd ctx.state))
745
+
stdout;
712
746
Exit.zero ctx
713
747
| Exit n ->
714
748
let should_exit =
···
720
754
Exit.zero
721
755
{ ctx with options = Built_ins.Options.update ctx.options update }
722
756
in
723
-
if print_options then Fmt.pr "%a%!" Built_ins.Options.pp ctx.options;
757
+
if print_options then
758
+
Eio.Flow.copy_string
759
+
(Fmt.str "%a" Built_ins.Options.pp ctx.options)
760
+
stdout;
724
761
v
725
762
| Wait i -> (
726
763
match Unix.waitpid [] i with
727
764
| _, WEXITED 0 -> Exit.zero ctx
728
765
| _, (WEXITED n | WSIGNALED n | WSTOPPED n) -> Exit.nonzero ctx n)
729
766
| Dot file -> (
730
-
let resolve_program name =
731
-
if not (String.contains name '/') then
732
-
Sys.getenv_opt "PATH"
733
-
|> Option.value ~default:"/bin:/usr/bin"
734
-
|> String.split_on_char ':'
735
-
|> List.find_map (fun dir ->
736
-
let p = Filename.concat dir name in
737
-
if Sys.file_exists p then Some p else None)
738
-
else if Sys.file_exists name then Some name
739
-
else None
740
-
in
741
-
match resolve_program file with
742
-
| None -> Exit.nonzero ctx 127
743
-
| Some f ->
767
+
match resolve_program ctx file with
768
+
| ctx, None -> Exit.nonzero ctx 127
769
+
| ctx, Some f ->
744
770
let program = Ast.of_file (ctx.fs / f) in
745
771
let ctx, _ = run (Exit.zero ctx) program in
746
772
ctx)
···
760
786
ctx.functions names
761
787
in
762
788
Exit.zero { ctx with functions })
789
+
| Hash v -> (
790
+
match v with
791
+
| Built_ins.Hash_remove -> Exit.zero { ctx with hash = Hash.empty }
792
+
| Built_ins.Hash_stats ->
793
+
Eio.Flow.copy_string (Fmt.str "%a" Hash.pp ctx.hash) stdout;
794
+
Exit.zero ctx
795
+
| _ -> assert false)
763
796
764
797
and exec initial_ctx ((command, sep) : Ast.complete_command) =
765
798
let rec loop : Eio.Switch.t -> ctx -> Ast.clist -> ctx Exit.t =
+25
src/lib/hash.ml
+25
src/lib/hash.ml
···
1
+
(* The hash table for utility locations *)
2
+
3
+
module M = Map.Make (String)
4
+
5
+
type entry = { hits : int; loc : string }
6
+
type t = entry M.t
7
+
8
+
let empty = M.empty
9
+
10
+
let add ~utility ~loc t =
11
+
match M.find_opt utility t with
12
+
| Some { hits; loc = loc' } when String.equal loc loc' ->
13
+
M.add utility { hits = hits + 1; loc } t
14
+
| None | Some _ -> M.add utility { hits = 1; loc } t
15
+
16
+
let lookup ~utility t = M.find_opt utility t |> Option.map (fun v -> v.loc)
17
+
18
+
let pp ppf t =
19
+
let entries = M.to_list t in
20
+
match entries with
21
+
| [] -> ()
22
+
| _ ->
23
+
let pp_entry ppf (_, { hits; loc }) = Fmt.pf ppf "%-7i %s@." hits loc in
24
+
let pp_header ppf () = Fmt.pf ppf "%-7s %s@." "hits" "command" in
25
+
Fmt.pf ppf "@[<v>%a%a@]" pp_header () Fmt.(list pp_entry) entries
+14
src/lib/hash.mli
+14
src/lib/hash.mli
···
1
+
type t
2
+
(** A lookup table for utilities *)
3
+
4
+
val empty : t
5
+
(** The empty table *)
6
+
7
+
val add : utility:string -> loc:string -> t -> t
8
+
(** [add ~utility ~loc t] adds the [utility] with [loc] location. *)
9
+
10
+
val lookup : utility:string -> t -> string option
11
+
(** [lookup ~utility t] will try to find [utility] in [t]. *)
12
+
13
+
val pp : t Fmt.t
14
+
(** A pretty printer *)
+1
src/lib/merry.ml
+1
src/lib/merry.ml
+1
src/lib/merry.mli
+1
src/lib/merry.mli
+1
-15
src/lib/posix/exec.ml
+1
-15
src/lib/posix/exec.ml
···
128
128
let handler = Eio.Process.Pi.process (module Process_impl) in
129
129
fun proc -> Eio.Resource.T (proc, handler)
130
130
131
-
let resolve_program name =
132
-
if not (String.contains name '/') then
133
-
Sys.getenv_opt "PATH"
134
-
|> Option.value ~default:"/bin:/usr/bin"
135
-
|> String.split_on_char ':'
136
-
|> List.find_map (fun dir ->
137
-
let p = Filename.concat dir name in
138
-
if Sys.file_exists p then Some p else None)
139
-
else if Sys.file_exists name then Some name
140
-
else None
141
-
142
131
let read_of_fd ~mode ~default ~to_close v =
143
132
match (mode, v) with
144
133
| Merry.Types.Async, _ | _, None -> default
···
186
175
| None -> (
187
176
match args with
188
177
| [] -> invalid_arg "Arguments list is empty and no executable given!"
189
-
| x :: _ -> (
190
-
match resolve_program x with
191
-
| Some x -> x
192
-
| None -> raise (Eio.Process.err (Executable_not_found x))))
178
+
| x :: _ -> x)
193
179
194
180
let get_env = function Some e -> e | None -> Unix.environment ()
195
181
+2
-2
src/lib/posix/merry_posix.ml
+2
-2
src/lib/posix/merry_posix.ml
···
16
16
| `Signaled n -> Merry.Exit.nonzero () n
17
17
18
18
let exec ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr ?env ~mode
19
-
~pgid ~cwd t args =
19
+
~pgid ~cwd ~executable t args =
20
20
let env =
21
21
Option.map
22
22
(fun lst -> List.map (fun (a, b) -> a ^ "=" ^ b) lst |> Array.of_list)
···
25
25
try
26
26
Ok
27
27
(Exec.run ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin ?stdout ?stderr
28
-
?env t args)
28
+
?env t ~executable args)
29
29
with Eio.Io (Eio.Process.E (Eio.Process.Executable_not_found m), _ctx) ->
30
30
Fmt.epr "msh: command not found: %s\n%!" m;
31
31
Error (127, `Not_found)
+1
src/lib/types.ml
+1
src/lib/types.ml
+50
test/built_ins.t
+50
test/built_ins.t
···
93
93
HEY
94
94
msh: command not found: shout
95
95
[127]
96
+
97
+
5. Hash
98
+
99
+
$ cat > test.sh << EOF
100
+
> reproducible_hash () {
101
+
> hash | sed 's/|/ /' | awk '{print \$1, \$8}'
102
+
> }
103
+
> ls
104
+
> ls
105
+
> reproducible_hash
106
+
> hash -r
107
+
> reproducible_hash
108
+
> EOF
109
+
110
+
$ sh test.sh
111
+
hello.txt
112
+
run.sh
113
+
test.sh
114
+
test_bad.sh
115
+
test_good.sh
116
+
testing
117
+
hello.txt
118
+
run.sh
119
+
test.sh
120
+
test_bad.sh
121
+
test_good.sh
122
+
testing
123
+
hits
124
+
2
125
+
$ msh test.sh
126
+
hello.txt
127
+
run.sh
128
+
test.sh
129
+
test_bad.sh
130
+
test_good.sh
131
+
testing
132
+
hello.txt
133
+
run.sh
134
+
test.sh
135
+
test_bad.sh
136
+
test_good.sh
137
+
testing
138
+
hits
139
+
2
140
+
6. Built-in redirection and pipelining
141
+
142
+
$ sh -c "FOO=\$(pwd | rev | rev); echo \$(basename \$FOO)"
143
+
test
144
+
$ msh -c "FOO=\$(pwd | rev | rev); echo \$(basename \$FOO)"
145
+
test