Shells in OCaml

Built_in: Trap

A first pass implementation of the `trap` built-in. Also, some fixes for
handling the `exit` built-in in terms of what is and what is not a
subshell.

+257 -18
+3
src/bin/main.ml
··· 7 7 let interactive = Option.is_none file && Option.is_none command in 8 8 let pos_zero = match file with Some f -> f | None -> "msh" in 9 9 Eio.Switch.run @@ fun async_switch -> 10 + let signal_handler f = Eio_posix.run @@ fun _ -> f () in 10 11 let ctx = 11 12 C. 12 13 { ··· 30 31 functions = []; 31 32 hash = Merry.Hash.empty; 32 33 rdrs = []; 34 + signal_handler = { run = signal_handler; sigint_set = false }; 35 + exit_handler = None; 33 36 } 34 37 in 35 38 match (file, command) with
+61
src/lib/built_ins.ml
··· 59 59 60 60 type set = { update : Options.option list; print_options : bool } 61 61 type hash = Hash_remove | Hash_stats | Hash_add of string list 62 + type trap = Int of int | Action of string | Ignore | Default 62 63 63 64 type t = 64 65 (* Built-in Actions *) ··· 75 76 | Unalias 76 77 | Eval of string list 77 78 | Echo of string list 79 + | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list 78 80 79 81 (* Change Directory *) 80 82 module Cd = struct ··· 316 318 Cmd.v info term 317 319 end 318 320 321 + module Trap = struct 322 + open Cmdliner 323 + 324 + let action = 325 + let doc = 326 + "Either an integer number or an action to invoke on a particular set of \ 327 + signals." 328 + in 329 + let action_conv = 330 + let parser s = 331 + match int_of_string_opt s with 332 + | Some n -> Ok (Int n) 333 + | None -> ( 334 + match s with 335 + | "\"\"" -> Ok Ignore 336 + | "-" -> Ok Default 337 + | s -> Ok (Action s)) 338 + in 339 + let pp ppf v = 340 + match v with 341 + | Int i -> Fmt.pf ppf "%i" i 342 + | Action p -> Fmt.pf ppf "%s" p 343 + | Ignore -> Fmt.pf ppf "\"\"" 344 + | Default -> Fmt.pf ppf "-" 345 + in 346 + Arg.Conv.make ~docv:"ACTION" ~parser ~pp () 347 + in 348 + Arg.(required & pos 0 (some action_conv) None & info [] ~docv:"ACTION" ~doc) 349 + 350 + let conditions = 351 + let doc = "Conditions to run the action on." in 352 + let cond_conv = 353 + let parser s = 354 + let s = String.lowercase_ascii s in 355 + try 356 + match int_of_string_opt s with 357 + | Some n -> Ok (`Signal (Eunix.Signals.of_int n)) 358 + | None -> ( 359 + match s with 360 + | "exit" -> Ok `Exit 361 + | s -> Ok (`Signal (Eunix.Signals.of_string s))) 362 + with Invalid_argument m -> Error m 363 + in 364 + let pp _ppf _ = () in 365 + Arg.Conv.make ~docv:"CONDITION" ~parser ~pp () 366 + in 367 + Arg.(value & pos_right 0 cond_conv [] & info [] ~docv:"CONDITIONS" ~doc) 368 + 369 + let t = 370 + let make_trap action sigs = Trap (action, sigs) in 371 + let term = Term.(const make_trap $ action $ conditions) in 372 + let info = 373 + let doc = "Display a line of text." in 374 + Cmd.info "echo" ~doc 375 + in 376 + Cmd.v info term 377 + end 378 + 319 379 module Source = Make_dot (struct 320 380 let name = "source" 321 381 end) ··· 349 409 | "unalias" :: _ -> Some (Ok Unalias) 350 410 | "eval" :: _ as cmd -> exec_cmd cmd Eval.t 351 411 | "echo" :: _ as cmd -> exec_cmd cmd Echo.t 412 + | "trap" :: _ as cmd -> exec_cmd cmd Trap.t 352 413 | _ -> None
+2
src/lib/built_ins.mli
··· 28 28 29 29 type set = { update : Options.option list; print_options : bool } 30 30 type hash = Hash_remove | Hash_stats | Hash_add of string list 31 + type trap = Int of int | Action of string | Ignore | Default 31 32 32 33 type t = 33 34 | Cd of { path : string option } ··· 44 45 | Unalias 45 46 | Eval of string list 46 47 | Echo of string list 48 + | Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list 47 49 48 50 val of_args : string list -> (t, string) result option 49 51 (** Parses a command-line to the built-ins, errors are returned if parsing. *)
+49
src/lib/eunix.ml
··· 95 95 Fun.protect 96 96 ~finally:(fun () -> Unix.tcsetattr Unix.stdin TCSADRAIN saved_tio) 97 97 fn 98 + 99 + module Signals = struct 100 + type t = 101 + | Interrupt 102 + | Quit 103 + | Abort 104 + | Kill 105 + | Alarm 106 + | Terminate 107 + | Exit 108 + | Stop 109 + | Hup 110 + [@@deriving to_yojson] 111 + 112 + let of_int = function 113 + | i when Int.equal i Sys.sigint -> Interrupt 114 + | i when Int.equal i Sys.sigquit -> Quit 115 + | i when Int.equal i Sys.sigabrt -> Abort 116 + | i when Int.equal i Sys.sigkill -> Kill 117 + | i when Int.equal i Sys.sigalrm -> Alarm 118 + | i when Int.equal i Sys.sigterm -> Terminate 119 + | i when Int.equal i Sys.sigstop -> Stop 120 + | i when Int.equal i Sys.sighup -> Hup 121 + | m -> Fmt.invalid_arg "Signal %i not supported yet." m 122 + 123 + let to_int = function 124 + | Interrupt -> Sys.sigint 125 + | Quit -> Sys.sigquit 126 + | Abort -> Sys.sigabrt 127 + | Kill -> Sys.sigkill 128 + | Alarm -> Sys.sigalrm 129 + | Terminate | Exit -> Sys.sigterm 130 + | Stop -> Sys.sigstop 131 + | Hup -> Sys.sighup 132 + 133 + let of_string s = 134 + match String.uppercase_ascii s with 135 + | "SIGINT" | "INT" -> Interrupt 136 + | "SIGQUIT" | "QUIT" -> Quit 137 + | "SIGABRT" | "ABRT" -> Abort 138 + | "SIGKILL" | "KILL" -> Kill 139 + | "SIGALRM" | "ALRM" -> Alarm 140 + | "SIGTERM" | "TERM" -> Terminate 141 + | "SIGSTOP" | "STOP" -> Stop 142 + | "SIGHUP" | "HUP" -> Hup 143 + | m -> Fmt.invalid_arg "Signal %s not supported or recognised." m 144 + 145 + let raise v = Unix.kill (Unix.getpid ()) (to_int v) 146 + end
+95 -13
src/lib/eval.ml
··· 29 29 method list f t = List.map f t 30 30 end 31 31 32 + type signal_handler = { run : (unit -> unit) -> unit; sigint_set : bool } 33 + 32 34 type ctx = { 33 35 interactive : bool; 34 36 subshell : bool; ··· 47 49 functions : (string * Ast.compound_command) list; 48 50 hash : Hash.t; 49 51 rdrs : Types.redirect list; 52 + signal_handler : signal_handler; 53 + exit_handler : (unit -> unit) option; 50 54 } 51 55 52 56 let clear_local_state ctx = { ctx with local_state = [] } ··· 257 261 let s_len = String.length s in 258 262 if s.[0] = '"' && s.[s_len - 1] = '"' then String.sub s 1 (s_len - 2) else s 259 263 264 + let exit ctx code = 265 + Option.iter (fun f -> f ()) ctx.exit_handler; 266 + exit code 267 + 260 268 let rec handle_pipeline ~async initial_ctx p : ctx Exit.t = 261 269 let set_last_background ~async process ctx = 262 270 if async then ··· 274 282 | `Rdr p -> J.add_rdr p j 275 283 | `Built_in p -> J.add_built_in p j 276 284 | `Error p -> J.add_error p j 285 + | `Exit p -> J.add_exit p j 277 286 in 278 287 let close_stdout ~is_global some_write = 279 288 if not is_global then begin ··· 452 461 ctx >|= fun ctx -> clear_local_state ctx 453 462 in 454 463 close_stdout ~is_global some_write; 455 - let built_in = ctx >|= fun _ -> () in 456 464 let job = 457 - handle_job job (`Built_in built_in) 465 + match bi with 466 + | Built_ins.Exit _ -> 467 + let v_ctx = Exit.value ctx in 468 + if not v_ctx.subshell then 469 + exit v_ctx (Exit.code ctx) 470 + else 471 + handle_job job 472 + (`Exit (Exit.ignore ctx)) 473 + | _ -> 474 + handle_job job 475 + (`Built_in (Exit.ignore ctx)) 458 476 in 459 477 loop (Exit.value ctx) job some_read rest 460 478 | _ -> ( ··· 515 533 in 516 534 let ctx = ctx >|= fun ctx -> clear_local_state ctx in 517 535 close_stdout ~is_global some_write; 518 - let built_in = ctx >|= fun _ -> () in 519 - let job = handle_job job (`Built_in built_in) in 536 + let job = 537 + match bi with 538 + | Built_ins.Exit _ -> 539 + let v_ctx = Exit.value ctx in 540 + if not v_ctx.subshell then begin 541 + if (Exit.value ctx).interactive then 542 + Fmt.pr "exit\n%!"; 543 + exit v_ctx (Exit.code ctx) 544 + end 545 + else handle_job job (`Exit (Exit.ignore ctx)) 546 + | _ -> handle_job job (`Built_in (Exit.ignore ctx)) 547 + in 520 548 loop (Exit.value ctx) job some_read rest)))) 521 549 | CompoundCommand (c, rdrs) :: rest -> ( 522 550 match handle_redirections ~sw:pipeline_switch ctx rdrs with ··· 533 561 loop ctx job None rest 534 562 | [] -> (clear_local_state ctx, job) 535 563 in 536 - (* HACK: when running the pipeline, we need a process group to 537 - put everything in. Eio's model of execution is nice, but we cannot 538 - safely delay execution of a process. So instead we create a ghost 539 - process that last just until all of the processes are setup. *) 540 564 Eio.Switch.run @@ fun sw -> 541 565 let initial_job = J.make 0 [] in 542 - let ctx, job = loop sw initial_ctx initial_job None p in 566 + let saved_ctx = initial_ctx in 567 + let subshell = saved_ctx.subshell || List.length p > 1 in 568 + let ctx = { initial_ctx with subshell } in 569 + let ctx, job = loop sw ctx initial_job None p in 543 570 match job.processes with 544 571 | [] -> Exit.zero ctx 545 572 | _ :: _ -> 546 573 if not async then begin 547 - J.await_exit ~pipefail:false ~interactive:ctx.interactive job 548 - >|= fun () -> ctx 574 + J.await_exit ~pipefail:ctx.options.pipefail 575 + ~interactive:ctx.interactive job 576 + >|= fun () -> { ctx with subshell = saved_ctx.subshell } 549 577 end 550 578 else begin 551 - Exit.zero { ctx with background_jobs = job :: ctx.background_jobs } 579 + Exit.zero 580 + { 581 + ctx with 582 + background_jobs = job :: ctx.background_jobs; 583 + subshell = saved_ctx.subshell; 584 + } 552 585 end 553 586 554 587 and parameter_expansion' ctx ast = ··· 1146 1179 let str = String.concat " " args ^ "\n" in 1147 1180 Eio.Flow.copy_string str stdout; 1148 1181 Exit.zero ctx 1182 + | Trap (action, signals) -> 1183 + let saved_ctx = ctx in 1184 + let action = 1185 + match action with 1186 + | Action m -> 1187 + let ast = Ast.of_string m in 1188 + let f _ = 1189 + saved_ctx.signal_handler.run @@ fun () -> 1190 + let _, _ = run (Exit.zero saved_ctx) ast in 1191 + () 1192 + in 1193 + Sys.Signal_handle f 1194 + | Default -> Sys.Signal_default 1195 + | Ignore -> Sys.Signal_ignore 1196 + | Int _ -> assert false 1197 + in 1198 + Exit.zero 1199 + @@ List.fold_left 1200 + (fun ctx signal -> 1201 + match signal with 1202 + | `Exit -> 1203 + let action = 1204 + match action with 1205 + | Sys.Signal_default | Sys.Signal_ignore -> None 1206 + | Sys.Signal_handle f -> Some (fun () -> f 0) 1207 + in 1208 + { ctx with exit_handler = action } 1209 + | `Signal signal -> 1210 + let action = 1211 + (* Handle sigint separately for interactive mode *) 1212 + match (action, signal) with 1213 + | Sys.Signal_default, Eunix.Signals.Interrupt -> 1214 + if ctx.interactive then Sys.Signal_ignore else action 1215 + | _ -> action 1216 + in 1217 + let setting_sigint = 1218 + ctx.signal_handler.sigint_set = false 1219 + && 1220 + match action with 1221 + | Sys.Signal_handle _ -> true 1222 + | _ -> false 1223 + in 1224 + Sys.set_signal (Eunix.Signals.to_int signal) action; 1225 + { 1226 + ctx with 1227 + signal_handler = 1228 + { ctx.signal_handler with sigint_set = setting_sigint }; 1229 + }) 1230 + ctx signals 1149 1231 | Command _ -> 1150 1232 (* Handled separately *) 1151 1233 assert false ··· 1196 1278 "You are using asynchronous operators and [set -o async] has \ 1197 1279 not been called.\n\ 1198 1280 %!"; 1199 - exit 1 1281 + exit ctx 1 1200 1282 end; 1201 1283 let exit = 1202 1284 try execute ctx command
+2
src/lib/exit.ml
··· 39 39 let nonzero ?message ?(should_exit = default_should_exit) value exit_code = 40 40 Nonzero { value; exit_code; message; should_exit } 41 41 42 + let code = function Zero _ -> 0 | Nonzero { exit_code; _ } -> exit_code 43 + 42 44 let nonzero_msg ?(exit_code = 1) ?(should_exit = default_should_exit) value fmt 43 45 = 44 46 Fmt.kstr
+8 -1
src/lib/interactive.ml
··· 82 82 Sys.set_signal Sys.sigttou Sys.Signal_ignore; 83 83 Sys.set_signal Sys.sigttin Sys.Signal_ignore; 84 84 Sys.set_signal Sys.sigtstp Sys.Signal_ignore; 85 + Sys.set_signal Sys.sigint Sys.Signal_ignore; 85 86 let rec loop (ctx : Eval.ctx Exit.t) = 86 87 Option.iter (Fmt.epr "%s%!") 87 88 (S.lookup (Exit.value ctx).state ~param:"PS1" ··· 94 95 exit 0 95 96 | String (Some c) -> 96 97 let ast = Ast.of_string (String.trim c) in 98 + Fmt.pr "\n%!"; 97 99 let ctx', _ast = Eval.run ctx ast in 98 100 add_history c; 99 101 loop ctx' 100 102 | Ctrl_c -> 101 103 let c = Exit.value ctx in 102 - loop (Exit.nonzero c 130) 104 + Eunix.Signals.(raise Interrupt); 105 + if c.signal_handler.sigint_set then loop (Exit.zero c) 106 + else begin 107 + Fmt.pr "\n%!"; 108 + loop (Exit.nonzero c 130) 109 + end 103 110 in 104 111 loop initial_ctx 105 112 end
+3 -1
src/lib/job.ml
··· 7 7 processes : 8 8 [ `Process of E.process 9 9 | `Built_in of unit Exit.t 10 + | `Exit of unit Exit.t 10 11 | `Rdr of unit Exit.t 11 12 | `Error of int ] 12 13 list; ··· 26 27 27 28 let add_error b t = { t with processes = List.cons (`Error b) t.processes } 28 29 let add_rdr b t = { t with processes = List.cons (`Rdr b) t.processes } 30 + let add_exit b t = { t with processes = List.cons (`Exit b) t.processes } 29 31 30 32 (* Section 2.9.2 https://pubs.opengroup.org/onlinepubs/9799919799/ *) 31 33 let await_exit ~pipefail ~interactive t = ··· 36 38 if interactive then 37 39 Eunix.delegate_control ~pgid:t.id @@ fun () -> E.await p 38 40 else E.await p 39 - | `Built_in b | `Rdr b -> b 41 + | `Built_in b | `Exit b | `Rdr b -> b 40 42 | `Error n -> Exit.nonzero () n 41 43 in 42 44 match (pipefail, t.processes) with
+2
src/lib/merry_stubs.c
··· 4 4 #include <caml/fail.h> 5 5 6 6 #include <unistd.h> 7 + #include <signal.h> 7 8 8 9 9 10 value caml_merry_tcsetpgrp(value v_fd, value v_pid_t) { ··· 23 24 24 25 CAMLreturn(Val_int(res)); 25 26 } 27 +
+32 -2
test/built_ins.t
··· 12 12 2. Exit 13 13 14 14 $ msh -c "exit 123" 15 - exit 16 15 [123] 17 16 18 17 $ msh -c "exit" 19 - exit 20 18 21 19 2. Wait 22 20 ··· 239 237 test_x: readonly variable 240 238 readonly test_x="foo" 241 239 readonly test_y="bar" 240 + 241 + 10. Traps 242 + 243 + $ cat > test.sh << EOF 244 + > trap "echo 'exiting...'" EXIT 245 + > echo "Running program..." 246 + > exit 123 247 + > echo "Never..." 248 + > EOF 249 + 250 + $ sh test.sh 251 + Running program... 252 + exiting... 253 + [123] 254 + $ msh test.sh 255 + Running program... 256 + exiting... 257 + [123] 258 + 259 + $ cat > test.sh << EOF 260 + > trap "echo 'exiting...'" EXIT 261 + > echo "Running program..." 262 + > trap - EXIT 263 + > echo "Always..." 264 + > EOF 265 + 266 + $ sh test.sh 267 + Running program... 268 + Always... 269 + $ msh test.sh 270 + Running program... 271 + Always...
-1
test/functions.t
··· 50 50 goodbye 51 51 goodbye 52 52 eybdoog 53 - exit 54 53 [128]