+57 -9

src/lib/built_ins.ml

··· 1 1 module Options = struct 2 2 - type t = { noclobber : bool; pipefail : bool; async : bool } 2 2 + type t = { 3 3 + noclobber : bool; 4 4 + pipefail : bool; 5 5 + no_path_expansion : bool; 6 6 + no_unset : bool; 7 7 + async : bool; 8 8 + } 3 9 4 4 - let default = { noclobber = false; pipefail = false; async = false } 10 10 + let default = 11 11 + { 12 12 + noclobber = false; 13 13 + pipefail = false; 14 14 + no_path_expansion = false; 15 15 + no_unset = false; 16 16 + async = false; 17 17 + } 5 18 6 6 - let with_options ?noclobber ?pipefail ?async t = 19 19 + let with_options ?noclobber ?pipefail ?async ?no_path_expansion ?no_unset t = 7 20 { 8 21 noclobber = Option.value ~default:t.noclobber noclobber; 9 22 pipefail = Option.value ~default:t.pipefail pipefail; 10 23 async = Option.value ~default:t.async async; 24 24 + no_path_expansion = 25 25 + Option.value ~default:t.no_path_expansion no_path_expansion; 26 26 + no_unset = Option.value ~default:t.no_unset no_unset; 11 27 } 12 28 13 13 - type posix = [ `Noclobber | `Pipefail ] 29 29 + type posix = [ `Noclobber | `Pipefail | `Noglob | `Nounset ] 14 30 type merry = [ `Async ] 15 31 type option = [ posix | merry ] 16 32 ··· 19 35 (fun d -> function 20 36 | `Pipefail -> with_options ~pipefail:true d 21 37 | `Noclobber -> with_options ~noclobber:true d 38 38 + | `Noglob -> with_options ~no_path_expansion:true d 39 39 + | `Nounset -> with_options ~no_unset:true d 22 40 | `Async -> with_options ~async:true d) 23 41 t options 24 42 ··· 27 45 Fmt.pf ppf "%-12s %s@." name (if value then "on" else "off") 28 46 in 29 47 let opts = 30 30 - let { noclobber; pipefail; async } = opt in 31 31 - [ ("pipefail", pipefail); ("noclobber", noclobber); ("async", async) ] 48 48 + let { noclobber; pipefail; async; no_path_expansion; no_unset } = opt in 49 49 + [ 50 50 + ("pipefail", pipefail); 51 51 + ("noclobber", noclobber); 52 52 + ("noglob", no_path_expansion); 53 53 + ("nounset", no_unset); 54 54 + ("async", async); 55 55 + ] 32 56 in 33 57 Fmt.pf ppf "@[<v>%a@]" Fmt.(list pp_option) opts 34 58 end ··· 106 130 open Cmdliner 107 131 108 132 let enum_map = 109 109 - [ ("pipefail", `Pipefail); ("noclobber", `Noclobber); ("async", `Async) ] 133 133 + [ 134 134 + ("pipefail", `Pipefail); 135 135 + ("noclobber", `Noclobber); 136 136 + ("noglob", `Noglob); 137 137 + ("nounset", `Nounset); 138 138 + ("async", `Async); 139 139 + ] 110 140 111 141 let option = 112 142 let doc = "Options." in 113 143 Arg.(value & opt_all (enum enum_map) [] & info [ "o" ] ~docv:"OPTION" ~doc) 114 144 145 145 + let noclobber = 146 146 + let doc = "No clobber, like -o noclobber." in 147 147 + Arg.(value & flag & info [ "C" ] ~docv:"NOCLOBBER" ~doc) 148 148 + 149 149 + let noglob = 150 150 + let doc = "No glob, like -o noglob." in 151 151 + Arg.(value & flag & info [ "f" ] ~docv:"NOGLOB" ~doc) 152 152 + 153 153 + let nounset = 154 154 + let doc = "No unset, like -o nounset." in 155 155 + Arg.(value & flag & info [ "u" ] ~docv:"NOUNSET" ~doc) 156 156 + 115 157 let t = 116 116 - let make_set update = Set { update; print_options = false } in 117 117 - let term = Term.(const make_set $ option) in 158 158 + let make_set update noglob noclobber nounset = 159 159 + let extra = if noglob then [ `Noglob ] else [] in 160 160 + let extra = if noclobber then `Noclobber :: extra else extra in 161 161 + let extra = if nounset then `Nounset :: extra else extra in 162 162 + let update = extra @ update in 163 163 + Set { update; print_options = false } 164 164 + in 165 165 + let term = Term.(const make_set $ option $ noglob $ noclobber $ nounset) in 118 166 let info = 119 167 let doc = "Set or unset options and positional parameters." in 120 168 Cmd.info "set" ~doc

+19 -3

src/lib/built_ins.mli

··· 1 1 module Options : sig 2 2 - type t = { noclobber : bool; pipefail : bool; async : bool } 3 3 - type posix = [ `Noclobber | `Pipefail ] 2 2 + type t = { 3 3 + noclobber : bool; 4 4 + pipefail : bool; 5 5 + no_path_expansion : bool; 6 6 + no_unset : bool; 7 7 + async : bool; 8 8 + } 9 9 + 10 10 + type posix = [ `Noclobber | `Pipefail | `Noglob | `Nounset ] 4 11 type merry = [ `Async ] 5 12 type option = [ posix | merry ] 6 13 7 14 val default : t 8 8 - val with_options : ?noclobber:bool -> ?pipefail:bool -> ?async:bool -> t -> t 15 15 + 16 16 + val with_options : 17 17 + ?noclobber:bool -> 18 18 + ?pipefail:bool -> 19 19 + ?async:bool -> 20 20 + ?no_path_expansion:bool -> 21 21 + ?no_unset:bool -> 22 22 + t -> 23 23 + t 24 24 + 9 25 val update : t -> option list -> t 10 26 val pp : t Fmt.t 11 27 end

+307 -241

src/lib/eval.ml

··· 320 320 match c with 321 321 | Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest -> 322 322 let ctx = collect_assignments ctx prefix in 323 323 - let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 323 323 + let job = handle_job job (`Built_in (Exit.ignore ctx)) in 324 324 loop (Exit.value ctx) job stdout_of_previous rest 325 325 | Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest 326 326 -> 327 327 let ctx = collect_assignments ~update:false ctx prefix in 328 328 - let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 328 328 + let job = handle_job job (`Built_in (Exit.ignore ctx)) in 329 329 loop (Exit.value ctx) job stdout_of_previous 330 330 (Ast.SimpleCommand (Named (executable, suffix)) :: rest) 331 331 | Ast.SimpleCommand (Named (executable, suffix)) :: rest -> ( 332 332 let ctx, executable = expand_cst ctx executable in 333 333 - let executable = handle_word_cst_subshell ctx executable in 334 334 - let executable, extra_args = 335 335 - (* This is a side-effect of the alias command with something like 333 333 + match ctx with 334 334 + | Exit.Nonzero _ as ctx -> 335 335 + let job = handle_job job (`Built_in (Exit.ignore ctx)) in 336 336 + loop (Exit.value ctx) job stdout_of_previous rest 337 337 + | Exit.Zero ctx -> ( 338 338 + let executable = handle_word_cst_subshell ctx executable in 339 339 + let executable, extra_args = 340 340 + (* This is a side-effect of the alias command with something like 336 341 alias ls="ls -la" *) 337 337 - match executable with 338 338 - | [ Ast.WordLiteral s ] as v -> ( 339 339 - match String.split_on_char ' ' (remove_quotes s) with 340 340 - | exec :: args -> 341 341 - ( [ Ast.WordName exec ], 342 342 - List.map 343 343 - (fun w -> Ast.Suffix_word [ Ast.WordName w ]) 344 344 - args ) 345 345 - | _ -> (v, [])) 346 346 - | v -> (v, []) 347 347 - in 348 348 - let executable = Ast.word_components_to_string executable in 349 349 - let ctx, suffix = 350 350 - match suffix with 351 351 - | None -> (ctx, []) 352 352 - | Some suffix -> expand_redirects (ctx, []) suffix 353 353 - in 354 354 - let ctx, args = args ctx (extra_args @ suffix) in 355 355 - let args_as_strings = List.map Ast.word_components_to_string args in 356 356 - let some_read, some_write = 357 357 - stdout_for_pipeline ~sw:pipeline_switch ctx rest 358 358 - in 359 359 - let is_global, some_write = 360 360 - match some_write with 361 361 - | `Global p -> (true, p) 362 362 - | `Local p -> (false, p) 363 363 - in 364 364 - let rdrs = 365 365 - List.fold_left 366 366 - (fun acc -> function 367 367 - | Ast.Suffix_word _ -> acc 368 368 - | Ast.Suffix_redirect rdr -> rdr :: acc) 369 369 - [] suffix 370 370 - |> List.rev 371 371 - in 372 372 - match handle_redirections ~sw:pipeline_switch ctx rdrs with 373 373 - | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) 374 374 - | Ok rdrs -> ( 375 375 - match Built_ins.of_args (executable :: args_as_strings) with 376 376 - | Some (Error _) -> 377 377 - (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) 378 378 - | (None | Some (Ok (Command _))) as v -> ( 379 379 - let is_command, command_args, print_command = 380 380 - match v with 381 381 - | Some (Ok (Command { print_command; args })) -> 382 382 - (true, args, print_command) 383 383 - | _ -> (false, [], false) 342 342 + match executable with 343 343 + | [ Ast.WordLiteral s ] as v -> ( 344 344 + match String.split_on_char ' ' (remove_quotes s) with 345 345 + | exec :: args -> 346 346 + ( [ Ast.WordName exec ], 347 347 + List.map 348 348 + (fun w -> Ast.Suffix_word [ Ast.WordName w ]) 349 349 + args ) 350 350 + | _ -> (v, [])) 351 351 + | v -> (v, []) 352 352 + in 353 353 + let executable = Ast.word_components_to_string executable in 354 354 + let ctx, suffix = 355 355 + match suffix with 356 356 + | None -> (ctx, []) 357 357 + | Some suffix -> expand_redirects (ctx, []) suffix 358 358 + in 359 359 + let ctx, args = args ctx (extra_args @ suffix) in 360 360 + match ctx with 361 361 + | Exit.Nonzero _ as ctx -> 362 362 + let job = handle_job job (`Built_in (Exit.ignore ctx)) in 363 363 + loop (Exit.value ctx) job stdout_of_previous rest 364 364 + | Exit.Zero ctx -> ( 365 365 + let args_as_strings = 366 366 + List.map Ast.word_components_to_string args 367 367 + in 368 368 + let some_read, some_write = 369 369 + stdout_for_pipeline ~sw:pipeline_switch ctx rest 370 370 + in 371 371 + let is_global, some_write = 372 372 + match some_write with 373 373 + | `Global p -> (true, p) 374 374 + | `Local p -> (false, p) 375 375 + in 376 376 + let rdrs = 377 377 + List.fold_left 378 378 + (fun acc -> function 379 379 + | Ast.Suffix_word _ -> acc 380 380 + | Ast.Suffix_redirect rdr -> rdr :: acc) 381 381 + [] suffix 382 382 + |> List.rev 384 383 in 385 385 - (* We handle the [export] built_in explicitly as we need access to the 386 386 - raw CST *) 387 387 - match executable with 388 388 - | "export" -> 389 389 - let updated = 390 390 - handle_export_or_readonly `Export ctx args 391 391 - in 392 392 - let job = 393 393 - handle_job job (`Built_in (updated >|= fun _ -> ())) 394 394 - in 395 395 - loop (Exit.value updated) job stdout_of_previous rest 396 396 - | "readonly" -> 397 397 - let updated = 398 398 - handle_export_or_readonly `Readonly ctx args 399 399 - in 400 400 - let job = 401 401 - handle_job job (`Built_in (updated >|= fun _ -> ())) 402 402 - in 403 403 - loop (Exit.value updated) job stdout_of_previous rest 404 404 - | _ -> ( 405 405 - let saved_ctx = ctx in 406 406 - let func_app = 407 407 - if is_command then None 408 408 - else 409 409 - let ctx = { ctx with stdout = some_write } in 410 410 - handle_function_application ctx ~name:executable 411 411 - (ctx.program :: args_as_strings) 412 412 - in 413 413 - match func_app with 414 414 - | Some ctx -> 415 415 - close_stdout ~is_global some_write; 416 416 - (* TODO: Proper job stuff and redirects etc. *) 417 417 - let job = 418 418 - handle_job job (`Built_in (ctx >|= fun _ -> ())) 384 384 + match handle_redirections ~sw:pipeline_switch ctx rdrs with 385 385 + | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) 386 386 + | Ok rdrs -> ( 387 387 + match 388 388 + Built_ins.of_args (executable :: args_as_strings) 389 389 + with 390 390 + | Some (Error _) -> 391 391 + (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) 392 392 + | (None | Some (Ok (Command _))) as v -> ( 393 393 + let is_command, command_args, print_command = 394 394 + match v with 395 395 + | Some (Ok (Command { print_command; args })) -> 396 396 + (true, args, print_command) 397 397 + | _ -> (false, [], false) 419 398 in 420 420 - loop saved_ctx job some_read rest 421 421 - | None -> ( 422 422 - match Built_ins.of_args command_args with 423 423 - | Some (Error _) -> 424 424 - ( ctx, 425 425 - handle_job job (`Built_in (Exit.nonzero () 1)) 426 426 - ) 427 427 - | Some (Ok bi) -> 428 428 - let ctx = 429 429 - handle_built_in ~rdrs ~stdout:some_write ctx bi 399 399 + (* We handle the [export] built_in explicitly as we need access to the 400 400 + raw CST *) 401 401 + match executable with 402 402 + | "export" -> 403 403 + let updated = 404 404 + handle_export_or_readonly `Export ctx args 405 405 + in 406 406 + let job = 407 407 + handle_job job 408 408 + (`Built_in (updated >|= fun _ -> ())) 409 409 + in 410 410 + loop (Exit.value updated) job stdout_of_previous 411 411 + rest 412 412 + | "readonly" -> 413 413 + let updated = 414 414 + handle_export_or_readonly `Readonly ctx args 430 415 in 431 431 - let ctx = 432 432 - ctx >|= fun ctx -> clear_local_state ctx 416 416 + let job = 417 417 + handle_job job 418 418 + (`Built_in (updated >|= fun _ -> ())) 433 419 in 434 434 - close_stdout ~is_global some_write; 435 435 - let built_in = ctx >|= fun _ -> () in 436 436 - let job = handle_job job (`Built_in built_in) in 437 437 - loop (Exit.value ctx) job some_read rest 420 420 + loop (Exit.value updated) job stdout_of_previous 421 421 + rest 438 422 | _ -> ( 439 439 - let exec_and_args = 440 440 - if is_command then begin 441 441 - match command_args with 442 442 - | [] -> assert false 443 443 - | x :: xs -> ( 444 444 - Eunix.with_redirections rdrs @@ fun () -> 445 445 - match 446 446 - resolve_program ~update:false ctx x 447 447 - with 448 448 - | _, None -> Exit.nonzero ("", []) 1 449 449 - | _, Some prog -> 450 450 - if print_command then 451 451 - Exit.zero ("echo", [ prog ]) 452 452 - else Exit.zero (x, xs)) 453 453 - end 454 454 - else Exit.zero (executable, args_as_strings) 423 423 + let saved_ctx = ctx in 424 424 + let func_app = 425 425 + if is_command then None 426 426 + else 427 427 + let ctx = { ctx with stdout = some_write } in 428 428 + handle_function_application ctx 429 429 + ~name:executable 430 430 + (ctx.program :: args_as_strings) 455 431 in 456 456 - match exec_and_args with 457 457 - | Exit.Nonzero _ as v -> 432 432 + match func_app with 433 433 + | Some ctx -> 434 434 + close_stdout ~is_global some_write; 435 435 + (* TODO: Proper job stuff and redirects etc. *) 458 436 let job = 459 459 - handle_job job 460 460 - (`Built_in (v >|= fun _ -> ())) 437 437 + handle_job job (`Built_in (Exit.ignore ctx)) 461 438 in 462 462 - loop ctx job some_read rest 463 463 - | Exit.Zero (executable, args) -> ( 464 464 - match stdout_of_previous with 465 465 - | None -> 466 466 - let ctx, job = 467 467 - exec_process ~sw:pipeline_switch ctx job 468 468 - ~fds:rdrs ~stdout:some_write 469 469 - ~pgid:(job_pgid job) executable args 439 439 + loop saved_ctx job some_read rest 440 440 + | None -> ( 441 441 + match Built_ins.of_args command_args with 442 442 + | Some (Error _) -> 443 443 + ( ctx, 444 444 + handle_job job 445 445 + (`Built_in (Exit.nonzero () 1)) ) 446 446 + | Some (Ok bi) -> 447 447 + let ctx = 448 448 + handle_built_in ~rdrs ~stdout:some_write 449 449 + ctx bi 470 450 in 471 471 - close_stdout ~is_global some_write; 472 472 - loop ctx job some_read rest 473 473 - | Some stdout -> 474 474 - let ctx, job = 475 475 - exec_process ~sw:pipeline_switch ctx job 476 476 - ~fds:rdrs ~stdin:stdout 477 477 - ~stdout:some_write 478 478 - ~pgid:(job_pgid job) executable 479 479 - args_as_strings 451 451 + let ctx = 452 452 + ctx >|= fun ctx -> clear_local_state ctx 480 453 in 481 454 close_stdout ~is_global some_write; 482 482 - loop ctx job some_read rest))))) 483 483 - | Some (Ok bi) -> 484 484 - let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in 485 485 - let ctx = ctx >|= fun ctx -> clear_local_state ctx in 486 486 - close_stdout ~is_global some_write; 487 487 - let built_in = ctx >|= fun _ -> () in 488 488 - let job = handle_job job (`Built_in built_in) in 489 489 - loop (Exit.value ctx) job some_read rest)) 455 455 + let built_in = ctx >|= fun _ -> () in 456 456 + let job = 457 457 + handle_job job (`Built_in built_in) 458 458 + in 459 459 + loop (Exit.value ctx) job some_read rest 460 460 + | _ -> ( 461 461 + let exec_and_args = 462 462 + if is_command then begin 463 463 + match command_args with 464 464 + | [] -> assert false 465 465 + | x :: xs -> ( 466 466 + Eunix.with_redirections rdrs 467 467 + @@ fun () -> 468 468 + match 469 469 + resolve_program ~update:false 470 470 + ctx x 471 471 + with 472 472 + | _, None -> 473 473 + Exit.nonzero ("", []) 1 474 474 + | _, Some prog -> 475 475 + if print_command then 476 476 + Exit.zero ("echo", [ prog ]) 477 477 + else Exit.zero (x, xs)) 478 478 + end 479 479 + else 480 480 + Exit.zero (executable, args_as_strings) 481 481 + in 482 482 + match exec_and_args with 483 483 + | Exit.Nonzero _ as v -> 484 484 + let job = 485 485 + handle_job job 486 486 + (`Built_in (Exit.ignore v)) 487 487 + in 488 488 + loop ctx job some_read rest 489 489 + | Exit.Zero (executable, args) -> ( 490 490 + match stdout_of_previous with 491 491 + | None -> 492 492 + let ctx, job = 493 493 + exec_process ~sw:pipeline_switch 494 494 + ctx job ~fds:rdrs 495 495 + ~stdout:some_write 496 496 + ~pgid:(job_pgid job) 497 497 + executable args 498 498 + in 499 499 + close_stdout ~is_global some_write; 500 500 + loop ctx job some_read rest 501 501 + | Some stdout -> 502 502 + let ctx, job = 503 503 + exec_process ~sw:pipeline_switch 504 504 + ctx job ~fds:rdrs 505 505 + ~stdin:stdout 506 506 + ~stdout:some_write 507 507 + ~pgid:(job_pgid job) 508 508 + executable args_as_strings 509 509 + in 510 510 + close_stdout ~is_global some_write; 511 511 + loop ctx job some_read rest))))) 512 512 + | Some (Ok bi) -> 513 513 + let ctx = 514 514 + handle_built_in ~rdrs ~stdout:some_write ctx bi 515 515 + in 516 516 + let ctx = ctx >|= fun ctx -> clear_local_state ctx in 517 517 + close_stdout ~is_global some_write; 518 518 + let built_in = ctx >|= fun _ -> () in 519 519 + let job = handle_job job (`Built_in built_in) in 520 520 + loop (Exit.value ctx) job some_read rest)))) 490 521 | CompoundCommand (c, rdrs) :: rest -> ( 491 522 match handle_redirections ~sw:pipeline_switch ctx rdrs with 492 523 | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) ··· 569 600 expand ([ Ast.WordName "" ] :: acc) ctx rest) 570 601 | Ast.VariableAtom (s, NoAttribute) -> ( 571 602 match S.lookup ctx.state ~param:s with 572 572 - | None -> expand ([ Ast.WordName "" ] :: acc) ctx rest 603 603 + | None -> 604 604 + if ctx.options.no_unset then begin 605 605 + ( Exit.nonzero_msg ctx ~exit_code:1 "%s: unbound variable" s, 606 606 + List.rev acc |> List.concat ) 607 607 + end 608 608 + else expand ([ Ast.WordName "" ] :: acc) ctx rest 573 609 | Some cst -> expand (cst :: acc) ctx rest) 574 610 | Ast.VariableAtom (s, ParameterLength) -> ( 575 611 match S.lookup ctx.state ~param:s with ··· 592 628 (( RemoveSmallestPrefixPattern cst 593 629 | RemoveLargestPrefixPattern cst ) as v) ) -> ( 594 630 let ctx, spp = expand_cst ctx cst in 595 595 - let pattern = Ast.word_components_to_string spp in 596 596 - match S.lookup ctx.state ~param:s with 597 597 - | None -> expand (cst :: acc) ctx rest 598 598 - | Some cst -> ( 599 599 - let kind = 600 600 - match v with 601 601 - | RemoveSmallestPrefixPattern _ -> `Smallest 602 602 - | RemoveLargestPrefixPattern _ -> `Largest 603 603 - | _ -> assert false 604 604 - in 605 605 - let param = Ast.word_components_to_string cst in 606 606 - let prefix = get_prefix ~pattern ~kind param in 607 607 - match prefix with 608 608 - | None -> expand ([ Ast.WordName param ] :: acc) ctx rest 609 609 - | Some s -> ( 610 610 - match String.cut_prefix ~prefix:s param with 611 611 - | Some s -> expand ([ Ast.WordName s ] :: acc) ctx rest 612 612 - | None -> expand ([ Ast.WordName param ] :: acc) ctx rest) 613 613 - )) 631 631 + match ctx with 632 632 + | Exit.Nonzero _ as ctx -> (ctx, List.rev acc |> List.concat) 633 633 + | Exit.Zero ctx -> ( 634 634 + let pattern = Ast.word_components_to_string spp in 635 635 + match S.lookup ctx.state ~param:s with 636 636 + | None -> expand (cst :: acc) ctx rest 637 637 + | Some cst -> ( 638 638 + let kind = 639 639 + match v with 640 640 + | RemoveSmallestPrefixPattern _ -> `Smallest 641 641 + | RemoveLargestPrefixPattern _ -> `Largest 642 642 + | _ -> assert false 643 643 + in 644 644 + let param = Ast.word_components_to_string cst in 645 645 + let prefix = get_prefix ~pattern ~kind param in 646 646 + match prefix with 647 647 + | None -> expand ([ Ast.WordName param ] :: acc) ctx rest 648 648 + | Some s -> ( 649 649 + match String.cut_prefix ~prefix:s param with 650 650 + | Some s -> 651 651 + expand ([ Ast.WordName s ] :: acc) ctx rest 652 652 + | None -> 653 653 + expand ([ Ast.WordName param ] :: acc) ctx rest))) 654 654 + ) 614 655 | Ast.VariableAtom 615 656 ( s, 616 657 (( RemoveSmallestSuffixPattern cst 617 658 | RemoveLargestSuffixPattern cst ) as v) ) -> ( 618 659 let ctx, spp = expand_cst ctx cst in 619 660 let pattern = Ast.word_components_to_string spp in 620 620 - match S.lookup ctx.state ~param:s with 621 621 - | None -> expand (cst :: acc) ctx rest 622 622 - | Some cst -> ( 623 623 - let kind = 624 624 - match v with 625 625 - | RemoveSmallestSuffixPattern _ -> `Smallest 626 626 - | RemoveLargestSuffixPattern _ -> `Largest 627 627 - | _ -> assert false 628 628 - in 629 629 - let param = Ast.word_components_to_string cst in 630 630 - let suffix = get_suffix ~pattern ~kind param in 631 631 - match suffix with 632 632 - | None -> expand ([ Ast.WordName param ] :: acc) ctx rest 633 633 - | Some s -> ( 634 634 - match String.cut_suffix ~suffix:s param with 635 635 - | Some s -> expand ([ Ast.WordName s ] :: acc) ctx rest 636 636 - | None -> expand ([ Ast.WordName param ] :: acc) ctx rest) 637 637 - )) 661 661 + match ctx with 662 662 + | Exit.Nonzero _ as ctx -> (ctx, List.rev acc |> List.concat) 663 663 + | Exit.Zero ctx -> ( 664 664 + match S.lookup ctx.state ~param:s with 665 665 + | None -> expand (cst :: acc) ctx rest 666 666 + | Some cst -> ( 667 667 + let kind = 668 668 + match v with 669 669 + | RemoveSmallestSuffixPattern _ -> `Smallest 670 670 + | RemoveLargestSuffixPattern _ -> `Largest 671 671 + | _ -> assert false 672 672 + in 673 673 + let param = Ast.word_components_to_string cst in 674 674 + let suffix = get_suffix ~pattern ~kind param in 675 675 + match suffix with 676 676 + | None -> expand ([ Ast.WordName param ] :: acc) ctx rest 677 677 + | Some s -> ( 678 678 + match String.cut_suffix ~suffix:s param with 679 679 + | Some s -> 680 680 + expand ([ Ast.WordName s ] :: acc) ctx rest 681 681 + | None -> 682 682 + expand ([ Ast.WordName param ] :: acc) ctx rest))) 683 683 + ) 638 684 | Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> ( 639 685 match S.lookup ctx.state ~param:s with 640 686 | Some _ -> expand (alt :: acc) ctx rest ··· 718 764 end; 719 765 Exit.zero ctx 720 766 721 721 - and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst = 767 767 + and expand_cst (ctx : ctx) cst : ctx Exit.t * Ast.word_cst = 722 768 let cst = tilde_expansion ctx cst in 723 769 let ctx, cst = parameter_expansion' ctx cst in 724 770 match ctx with 725 725 - | Exit.Nonzero { value = ctx; _ } -> (ctx, cst) 771 771 + | Exit.Nonzero _ as ctx -> (ctx, cst) 726 772 | Exit.Zero ctx -> 727 773 (* TODO: Propagate errors *) 728 774 let ctx, ast = arithmetic_expansion ctx cst in 729 729 - (ctx, ast) 775 775 + (Exit.zero ctx, ast) 730 776 731 777 and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list) 732 778 (c : Ast.cmd_suffix_item list) = 733 779 match c with 734 780 | [] -> (ctx, List.rev acc) 735 735 - | Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, file))) :: rest -> 781 781 + | Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, file))) :: rest -> ( 736 782 let ctx, cst = expand_cst ctx file in 737 737 - let cst = handle_subshell ctx cst in 738 738 - let v = Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, cst))) in 739 739 - expand_redirects (ctx, v :: acc) rest 783 783 + match ctx with 784 784 + | Exit.Nonzero _ -> assert false 785 785 + | Exit.Zero ctx -> 786 786 + let cst = handle_subshell ctx cst in 787 787 + let v = Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, cst))) in 788 788 + expand_redirects (ctx, v :: acc) rest) 740 789 | (Ast.Suffix_redirect _ as v) :: rest -> 741 790 expand_redirects (ctx, v :: acc) rest 742 791 | s :: rest -> expand_redirects (ctx, s :: acc) rest ··· 824 873 | Ast.Case _ -> Exit.zero ctx 825 874 | Cases (word, case_list) -> ( 826 875 let ctx, word = expand_cst ctx word in 827 827 - let scrutinee = Ast.word_components_to_string word in 828 828 - let res = 829 829 - Nlist.fold_left 830 830 - (fun acc pat -> 831 831 - match acc with 832 832 - | Some _ as ctx -> ctx 833 833 - | None -> ( 834 834 - match pat with 835 835 - | Ast.Case_pattern (p, sub) -> 836 836 - Nlist.fold_left 837 837 - (fun inner_acc pattern -> 838 838 - match inner_acc with 839 839 - | Some _ as v -> v 840 840 - | None -> 841 841 - let ctx, pattern = expand_cst ctx pattern in 842 842 - let pattern = 843 843 - Ast.word_components_to_string pattern 844 844 - in 845 845 - if Glob.test ~pattern scrutinee then begin 846 846 - match sub with 847 847 - | Some sub -> Some (exec_subshell ctx sub) 848 848 - | None -> Some (Exit.zero ctx) 849 849 - end 850 850 - else inner_acc) 851 851 - None p)) 852 852 - None case_list 853 853 - in 854 854 - match res with Some ctx -> ctx | None -> Exit.zero ctx) 876 876 + match ctx with 877 877 + | Exit.Nonzero _ as ctx -> ctx 878 878 + | Exit.Zero ctx -> ( 879 879 + let scrutinee = Ast.word_components_to_string word in 880 880 + let res = 881 881 + Nlist.fold_left 882 882 + (fun acc pat -> 883 883 + match acc with 884 884 + | Some _ as ctx -> ctx 885 885 + | None -> ( 886 886 + match pat with 887 887 + | Ast.Case_pattern (p, sub) -> 888 888 + Nlist.fold_left 889 889 + (fun inner_acc pattern -> 890 890 + match inner_acc with 891 891 + | Some _ as v -> v 892 892 + | None -> ( 893 893 + let ctx, pattern = expand_cst ctx pattern in 894 894 + match ctx with 895 895 + | Exit.Nonzero _ as ctx -> Some ctx 896 896 + | Exit.Zero ctx -> 897 897 + let pattern = 898 898 + Ast.word_components_to_string pattern 899 899 + in 900 900 + if Glob.test ~pattern scrutinee then begin 901 901 + match sub with 902 902 + | Some sub -> 903 903 + Some (exec_subshell ctx sub) 904 904 + | None -> Some (Exit.zero ctx) 905 905 + end 906 906 + else inner_acc)) 907 907 + None p)) 908 908 + None case_list 909 909 + in 910 910 + match res with Some ctx -> ctx | None -> Exit.zero ctx)) 855 911 856 912 and exec_subshell ctx (term, sep) = 857 913 let saved_ctx = ctx in ··· 945 1001 946 1002 and glob_expand ctx wc = 947 1003 let wc = handle_word_cst_subshell ctx wc in 948 948 - if Ast.has_glob wc then 1004 1004 + if Ast.has_glob wc && not ctx.options.no_path_expansion then 949 1005 Ast.word_components_to_string wc |> fun pattern -> 950 1006 Glob.glob_dir ~pattern (cwd_of_ctx ctx) 951 1007 |> List.map (fun w -> [ Ast.WordName w ]) ··· 965 1021 | Ast.Prefix_assignment (Name param, v) -> ( 966 1022 (* Expand the values *) 967 1023 let ctx, v = expand_cst ctx v in 968 968 - let v = handle_subshell ctx v in 969 969 - let state = 970 970 - if update then S.update ctx.state ~param v else Ok ctx.state 971 971 - in 972 972 - match state with 973 973 - | Error message -> Exit.nonzero ~message ctx 1 974 974 - | Ok state -> 975 975 - Exit.zero 976 976 - { 977 977 - ctx with 978 978 - state; 979 979 - local_state = 980 980 - (param, Ast.word_components_to_string v) 981 981 - :: ctx.local_state; 982 982 - }) 1024 1024 + match ctx with 1025 1025 + | Exit.Nonzero _ as ctx -> ctx 1026 1026 + | Exit.Zero ctx -> ( 1027 1027 + let v = handle_subshell ctx v in 1028 1028 + let state = 1029 1029 + if update then S.update ctx.state ~param v 1030 1030 + else Ok ctx.state 1031 1031 + in 1032 1032 + match state with 1033 1033 + | Error message -> Exit.nonzero ~message ctx 1 1034 1034 + | Ok state -> 1035 1035 + Exit.zero 1036 1036 + { 1037 1037 + ctx with 1038 1038 + state; 1039 1039 + local_state = 1040 1040 + (param, Ast.word_components_to_string v) 1041 1041 + :: ctx.local_state; 1042 1042 + })) 983 1043 | _ -> Exit.zero ctx)) 984 1044 (Exit.zero ctx) vs 985 1045 986 986 - and args ctx swc : ctx * Ast.word_cst list = 1046 1046 + and args ctx swc : ctx Exit.t * Ast.word_cst list = 987 1047 List.fold_left 988 1048 (fun (ctx, acc) -> function 989 1049 | Ast.Suffix_redirect _ -> (ctx, acc) 990 990 - | Suffix_word wc -> 991 991 - let ctx, cst = expand_cst ctx wc in 992 992 - (ctx, acc @ word_glob_expand ctx cst)) 993 993 - (ctx, []) swc 1050 1050 + | Suffix_word wc -> ( 1051 1051 + match ctx with 1052 1052 + | Exit.Nonzero _ as ctx -> (ctx, acc) 1053 1053 + | Exit.Zero ctx -> ( 1054 1054 + let ctx, cst = expand_cst ctx wc in 1055 1055 + match ctx with 1056 1056 + | Exit.Nonzero _ as ctx -> (ctx, acc) 1057 1057 + | Exit.Zero c as ctx -> (ctx, acc @ word_glob_expand c cst)))) 1058 1058 + (Exit.zero ctx, []) 1059 1059 + swc 994 1060 995 1061 and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink) 996 1062 (ctx : ctx) v =

+4

src/lib/exit.ml

··· 17 17 should_exit : should_exit; 18 18 } 19 19 20 20 + let ignore = function 21 21 + | Zero _ -> Zero () 22 22 + | Nonzero v -> Nonzero { v with value = () } 23 23 + 20 24 let value = function Zero v -> v | Nonzero { value; _ } -> value 21 25 22 26 let not = function

+33

test/options.t

··· 1 1 + More fine-grained testing of the possible shell execution options. 2 2 + 3 3 + First, we test the noglob option. 4 4 + 5 5 + $ cat > test.sh << EOF 6 6 + > set -f 7 7 + > touch a.txt b.txt 8 8 + > ls *.txt 9 9 + > EOF 10 10 + 11 11 + $ sh test.sh 12 12 + ls: cannot access '*.txt': No such file or directory 13 13 + [2] 14 14 + $ msh test.sh 15 15 + ls: cannot access '*.txt': No such file or directory 16 16 + [2] 17 17 + 18 18 + No unset variable option. 19 19 + 20 20 + $ cat > test.sh << EOF 21 21 + > echo "The variable is: \$UNSETVAR" 22 22 + > set -u 23 23 + > echo \$UNSETVAR 24 24 + > EOF 25 25 + 26 26 + $ sh test.sh 27 27 + The variable is: 28 28 + test.sh: line 3: UNSETVAR: unbound variable 29 29 + [1] 30 30 + $ msh test.sh 31 31 + The variable is: 32 32 + UNSETVAR: unbound variable 33 33 + [1]