+1

src/bin/main.ml

··· 29 29 program = pos_zero; 30 30 functions = []; 31 31 hash = Merry.Hash.empty; 32 32 + rdrs = []; 32 33 } 33 34 in 34 35 match (file, command) with

+3 -2

src/lib/ast.ml

··· 94 94 | Command_CompoundCommand a -> 95 95 let a = compound_command a.value in 96 96 CompoundCommand (a, []) 97 97 - | Command_CompoundCommand_RedirectList (a, _) -> 97 97 + | Command_CompoundCommand_RedirectList (a, rdrs) -> 98 98 let a = compound_command a.value in 99 99 - CompoundCommand (a, []) 99 99 + let b = redirect_list rdrs.value in 100 100 + CompoundCommand (a, b) 100 101 | Command_FunctionDefinition a -> 101 102 let a = function_definition a.value in 102 103 FunctionDefinition a

+132 -113

src/lib/eval.ml

··· 46 46 argv : string array; 47 47 functions : (string * Ast.compound_command) list; 48 48 hash : Hash.t; 49 49 + rdrs : Types.redirect list; 49 50 } 50 51 51 52 let clear_local_state ctx = { ctx with local_state = [] } ··· 151 152 | (Io_op_great | Io_op_dgreat) as v -> 152 153 (* Simple file creation *) 153 154 let append = v = Io_op_dgreat in 155 155 + let create = 156 156 + if append then `Never 157 157 + else if ctx.options.noclobber then `Exclusive 0o644 158 158 + else `Or_truncate 0o644 159 159 + in 154 160 let w = 155 155 - Eio.Path.open_out ~sw ~append ~create:(`If_missing 0o644) 161 161 + Eio.Path.open_out ~sw ~append ~create 156 162 (ctx.fs / Ast.word_components_to_string file) 157 163 in 158 164 let fd = Eio_unix.Resource.fd_opt w |> Option.get in ··· 183 189 Types.Redirect (1, fd, `Blocking); 184 190 Types.Redirect (2, fd, `Blocking); 185 191 ] 186 186 - | Io_op_clobber -> Fmt.failwith ">| not supported yet." 192 192 + | Io_op_clobber -> 193 193 + let w = 194 194 + Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644) 195 195 + (ctx.fs / Ast.word_components_to_string file) 196 196 + in 197 197 + let fd = Eio_unix.Resource.fd_opt w |> Option.get in 198 198 + [ Types.Redirect (n, fd, `Blocking) ] 187 199 | Io_op_lessgreat -> Fmt.failwith "<> not support yet.") 188 200 | Ast.IoRedirect_IoHere _ -> 189 201 Fmt.failwith "HERE documents not yet implemented!" 190 202 203 203 + let handle_redirections ~sw ctx rdrs = 204 204 + try Ok (List.concat_map (handle_one_redirection ~sw ctx) rdrs) 205 205 + with Eio.Io (Eio.Fs.E (Already_exists _), _) -> 206 206 + Fmt.epr "msh: cannot overwrite existing file\n%!"; 207 207 + Error ctx 208 208 + 191 209 let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs 192 210 193 211 let needs_glob_expansion : Ast.word_component -> bool = function ··· 199 217 200 218 let resolve_program ?(update = true) ctx name = 201 219 let v = 202 202 - (* Fmt.epr "Resolving %s\n%!" name; *) 203 220 if not (String.contains name '/') then begin 204 204 - (* Fmt.epr "not %a\n%!" Fmt.(option string) (S.lookup ctx.state ~param:"PATH" |> Option.map Ast.word_components_to_string); *) 205 221 S.lookup ctx.state ~param:"PATH" 206 222 |> Option.map Ast.word_components_to_string 207 223 |> Option.value ~default:"/bin:/usr/bin" 208 224 |> String.split_on_char ':' 209 225 |> List.find_map (fun dir -> 210 226 let p = Filename.concat dir name in 211 211 - (* Fmt.epr "Does it exist %s %b\n%!" p (Sys.file_exists p); *) 212 227 if Sys.file_exists p then Some p else None) 213 228 end 214 229 else if Sys.file_exists name then Some name ··· 247 262 | None -> ctx 248 263 | Some process -> set_last_background ~async process ctx 249 264 in 250 250 - let handle_job j p = 251 251 - match p with 252 252 - (* | None, _ -> *) 253 253 - (* let pgid = match pgid with Some p -> p | None -> Unix.getpid () in *) 254 254 - (* Option.some *) 255 255 - (* @@ J.make ~state:`Running ~reap:(Option.get reap) pgid *) 256 256 - (* (Nlist.Singleton p) *) 265 265 + let handle_job j = function 257 266 | `Process p -> J.add_process p j 267 267 + | `Rdr p -> J.add_rdr p j 258 268 | `Built_in p -> J.add_built_in p j 259 269 | `Error p -> J.add_error p j 260 270 in ··· 267 277 let pgid = match pgid with None -> 0 | Some p -> p in 268 278 let reap = J.get_reaper job in 269 279 let mode = if async then Types.Async else Types.Switched sw in 280 280 + let fds = ctx.rdrs @ Option.value ~default:[] fds in 270 281 let ctx, process = 271 282 match (executable, resolve_program ctx executable) with 272 283 | _, (ctx, None) | "", (ctx, _) -> 273 273 - Eunix.with_redirections 274 274 - (match fds with None -> [] | Some ls -> ls) 275 275 - (fun () -> 284 284 + Eunix.with_redirections fds (fun () -> 276 285 Eio.Flow.copy_string 277 286 (Fmt.str "msh: command not found: %s\n" executable) 278 287 stdout); 279 288 (ctx, Error (127, `Not_found)) 280 289 | _, (ctx, Some full_path) -> 281 290 ( ctx, 282 282 - E.exec ctx.executor ~delay_reap:(fst reap) ?fds ?stdin ~stdout 291 291 + E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout 283 292 ~pgid ~mode ~cwd:(cwd_of_ctx ctx) 284 293 ~env:(get_env ~extra:ctx.local_state ctx) 285 294 ~executable:full_path (executable :: args) ) ··· 347 356 List.fold_left 348 357 (fun acc -> function 349 358 | Ast.Suffix_word _ -> acc 350 350 - | Ast.Suffix_redirect rdr -> 351 351 - handle_one_redirection ~sw:pipeline_switch ctx rdr @ acc) 359 359 + | Ast.Suffix_redirect rdr -> rdr :: acc) 352 360 [] suffix 353 361 |> List.rev 354 362 in 355 355 - match Built_ins.of_args (executable :: args_as_strings) with 356 356 - | Some (Error _) -> 357 357 - (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) 358 358 - | (None | Some (Ok (Command _))) as v -> ( 359 359 - let is_command, command_args, print_command = 360 360 - match v with 361 361 - | Some (Ok (Command { print_command; args })) -> 362 362 - (true, args, print_command) 363 363 - | _ -> (false, [], false) 364 364 - in 365 365 - (* We handle the [export] built_in explicitly as we need access to the 363 363 + match handle_redirections ~sw:pipeline_switch ctx rdrs with 364 364 + | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) 365 365 + | Ok rdrs -> ( 366 366 + match Built_ins.of_args (executable :: args_as_strings) with 367 367 + | Some (Error _) -> 368 368 + (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) 369 369 + | (None | Some (Ok (Command _))) as v -> ( 370 370 + let is_command, command_args, print_command = 371 371 + match v with 372 372 + | Some (Ok (Command { print_command; args })) -> 373 373 + (true, args, print_command) 374 374 + | _ -> (false, [], false) 375 375 + in 376 376 + (* We handle the [export] built_in explicitly as we need access to the 366 377 raw CST *) 367 367 - match executable with 368 368 - | "export" -> 369 369 - let updated = handle_export ctx args in 370 370 - let job = 371 371 - handle_job job (`Built_in (updated >|= fun _ -> ())) 372 372 - in 373 373 - loop (Exit.value updated) job stdout_of_previous rest 374 374 - | _ -> ( 375 375 - let saved_ctx = ctx in 376 376 - let func_app = 377 377 - if is_command then None 378 378 - else 379 379 - let ctx = { ctx with stdout = some_write } in 380 380 - handle_function_application ctx ~name:executable 381 381 - (ctx.program :: args_as_strings) 382 382 - in 383 383 - match func_app with 384 384 - | Some ctx -> 385 385 - close_stdout ~is_global some_write; 386 386 - (* TODO: Proper job stuff and redirects etc. *) 378 378 + match executable with 379 379 + | "export" -> 380 380 + let updated = handle_export ctx args in 387 381 let job = 388 388 - handle_job job (`Built_in (ctx >|= fun _ -> ())) 382 382 + handle_job job (`Built_in (updated >|= fun _ -> ())) 389 383 in 390 390 - loop saved_ctx job some_read rest 391 391 - | None -> ( 392 392 - match Built_ins.of_args command_args with 393 393 - | Some (Error _) -> 394 394 - (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) 395 395 - | Some (Ok bi) -> 396 396 - let ctx = 397 397 - handle_built_in ~rdrs ~stdout:some_write ctx bi 398 398 - in 384 384 + loop (Exit.value updated) job stdout_of_previous rest 385 385 + | _ -> ( 386 386 + let saved_ctx = ctx in 387 387 + let func_app = 388 388 + if is_command then None 389 389 + else 390 390 + let ctx = { ctx with stdout = some_write } in 391 391 + handle_function_application ctx ~name:executable 392 392 + (ctx.program :: args_as_strings) 393 393 + in 394 394 + match func_app with 395 395 + | Some ctx -> 399 396 close_stdout ~is_global some_write; 400 400 - let built_in = ctx >|= fun _ -> () in 401 401 - let job = handle_job job (`Built_in built_in) in 402 402 - loop (Exit.value ctx) job some_read rest 403 403 - | _ -> ( 404 404 - let exec_and_args = 405 405 - if is_command then begin 406 406 - match command_args with 407 407 - | [] -> assert false 408 408 - | x :: xs -> ( 409 409 - Eunix.with_redirections rdrs @@ fun () -> 410 410 - match resolve_program ~update:false ctx x with 411 411 - | _, None -> Exit.nonzero ("", []) 1 412 412 - | _, Some prog -> 413 413 - if print_command then 414 414 - Exit.zero ("echo", [ prog ]) 415 415 - else Exit.zero (x, xs)) 416 416 - end 417 417 - else Exit.zero (executable, args_as_strings) 397 397 + (* TODO: Proper job stuff and redirects etc. *) 398 398 + let job = 399 399 + handle_job job (`Built_in (ctx >|= fun _ -> ())) 418 400 in 419 419 - match exec_and_args with 420 420 - | Exit.Nonzero _ as v -> 421 421 - let job = 422 422 - handle_job job (`Built_in (v >|= fun _ -> ())) 401 401 + loop saved_ctx job some_read rest 402 402 + | None -> ( 403 403 + match Built_ins.of_args command_args with 404 404 + | Some (Error _) -> 405 405 + ( ctx, 406 406 + handle_job job (`Built_in (Exit.nonzero () 1)) 407 407 + ) 408 408 + | Some (Ok bi) -> 409 409 + let ctx = 410 410 + handle_built_in ~rdrs ~stdout:some_write ctx bi 411 411 + in 412 412 + close_stdout ~is_global some_write; 413 413 + let built_in = ctx >|= fun _ -> () in 414 414 + let job = handle_job job (`Built_in built_in) in 415 415 + loop (Exit.value ctx) job some_read rest 416 416 + | _ -> ( 417 417 + let exec_and_args = 418 418 + if is_command then begin 419 419 + match command_args with 420 420 + | [] -> assert false 421 421 + | x :: xs -> ( 422 422 + Eunix.with_redirections rdrs @@ fun () -> 423 423 + match 424 424 + resolve_program ~update:false ctx x 425 425 + with 426 426 + | _, None -> Exit.nonzero ("", []) 1 427 427 + | _, Some prog -> 428 428 + if print_command then 429 429 + Exit.zero ("echo", [ prog ]) 430 430 + else Exit.zero (x, xs)) 431 431 + end 432 432 + else Exit.zero (executable, args_as_strings) 423 433 in 424 424 - loop ctx job some_read rest 425 425 - | Exit.Zero (executable, args) -> ( 426 426 - match stdout_of_previous with 427 427 - | None -> 428 428 - let ctx, job = 429 429 - exec_process ~sw:pipeline_switch ctx job 430 430 - ~fds:rdrs ~stdout:some_write 431 431 - ~pgid:(job_pgid job) executable args 434 434 + match exec_and_args with 435 435 + | Exit.Nonzero _ as v -> 436 436 + let job = 437 437 + handle_job job 438 438 + (`Built_in (v >|= fun _ -> ())) 432 439 in 433 433 - close_stdout ~is_global some_write; 434 440 loop ctx job some_read rest 435 435 - | Some stdout -> 436 436 - let ctx, job = 437 437 - exec_process ~sw:pipeline_switch ctx job 438 438 - ~fds:rdrs ~stdin:stdout ~stdout:some_write 439 439 - ~pgid:(job_pgid job) executable 440 440 - args_as_strings 441 441 - in 442 442 - close_stdout ~is_global some_write; 443 443 - loop ctx job some_read rest))))) 444 444 - | Some (Ok bi) -> 445 445 - let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in 446 446 - close_stdout ~is_global some_write; 447 447 - let built_in = ctx >|= fun _ -> () in 448 448 - let job = handle_job job (`Built_in built_in) in 449 449 - loop (Exit.value ctx) job some_read rest) 450 450 - | CompoundCommand (c, rdrs) :: rest -> 451 451 - let _rdrs = 452 452 - List.map (handle_one_redirection ~sw:pipeline_switch ctx) rdrs 453 453 - in 454 454 - (* TODO: No way this is right *) 455 455 - let ctx = handle_compound_command ctx c in 456 456 - let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 457 457 - loop (Exit.value ctx) job None rest 441 441 + | Exit.Zero (executable, args) -> ( 442 442 + match stdout_of_previous with 443 443 + | None -> 444 444 + let ctx, job = 445 445 + exec_process ~sw:pipeline_switch ctx job 446 446 + ~fds:rdrs ~stdout:some_write 447 447 + ~pgid:(job_pgid job) executable args 448 448 + in 449 449 + close_stdout ~is_global some_write; 450 450 + loop ctx job some_read rest 451 451 + | Some stdout -> 452 452 + let ctx, job = 453 453 + exec_process ~sw:pipeline_switch ctx job 454 454 + ~fds:rdrs ~stdin:stdout 455 455 + ~stdout:some_write 456 456 + ~pgid:(job_pgid job) executable 457 457 + args_as_strings 458 458 + in 459 459 + close_stdout ~is_global some_write; 460 460 + loop ctx job some_read rest))))) 461 461 + | Some (Ok bi) -> 462 462 + let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in 463 463 + close_stdout ~is_global some_write; 464 464 + let built_in = ctx >|= fun _ -> () in 465 465 + let job = handle_job job (`Built_in built_in) in 466 466 + loop (Exit.value ctx) job some_read rest)) 467 467 + | CompoundCommand (c, rdrs) :: rest -> ( 468 468 + match handle_redirections ~sw:pipeline_switch ctx rdrs with 469 469 + | Error ctx -> (ctx, handle_job job (`Rdr (Exit.nonzero () 1))) 470 470 + | Ok rdrs -> 471 471 + (* TODO: No way this is right *) 472 472 + let ctx = { ctx with rdrs } in 473 473 + let ctx = handle_compound_command ctx c in 474 474 + let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 475 475 + let actual_ctx = Exit.value ctx in 476 476 + loop { actual_ctx with rdrs = [] } job None rest) 458 477 | FunctionDefinition (name, (body, _rdrs)) :: rest -> 459 478 let ctx = { ctx with functions = (name, body) :: ctx.functions } in 460 479 loop ctx job None rest

+7 -2

src/lib/job.ml

··· 5 5 id : int; 6 6 (* Process list is in reverse order *) 7 7 processes : 8 8 - [ `Process of E.process | `Built_in of unit Exit.t | `Error of int ] list; 8 8 + [ `Process of E.process 9 9 + | `Built_in of unit Exit.t 10 10 + | `Rdr of unit Exit.t 11 11 + | `Error of int ] 12 12 + list; 9 13 } 10 14 11 15 let get_reaper t = t.reap ··· 21 25 { t with processes = List.cons (`Built_in b) t.processes } 22 26 23 27 let add_error b t = { t with processes = List.cons (`Error b) t.processes } 28 28 + let add_rdr b t = { t with processes = List.cons (`Rdr b) t.processes } 24 29 25 30 (* Section 2.9.2 https://pubs.opengroup.org/onlinepubs/9799919799/ *) 26 31 let await_exit ~pipefail ~interactive t = ··· 31 36 if interactive then 32 37 Eunix.delegate_control ~pgid:t.id @@ fun () -> E.await p 33 38 else E.await p 34 34 - | `Built_in b -> b 39 39 + | `Built_in b | `Rdr b -> b 35 40 | `Error n -> Exit.nonzero () n 36 41 in 37 42 match (pipefail, t.processes) with

+19

test/forloops.t

··· 61 61 olleh 62 62 dlrow 63 63 64 64 + 1.6 Redirects 65 65 + 66 66 + $ cat > test.sh << EOF 67 67 + > for i in a b; do 68 68 + > echo \$i 69 69 + > done > hello.txt 70 70 + > echo "The file contains:" 71 71 + > cat hello.txt 72 72 + > EOF 73 73 + 74 74 + $ sh test.sh 75 75 + The file contains: 76 76 + a 77 77 + b 78 78 + $ msh test.sh 79 79 + The file contains: 80 80 + a 81 81 + b 82 82 +

+17

test/simple.t

··· 188 188 $ msh -c "ls -j &> /dev/null" 189 189 [2] 190 190 191 191 + Clobbering files and stuff. 192 192 + 193 193 + $ cat > test.sh << EOF 194 194 + > echo hello > file.txt 195 195 + > set -o noclobber 196 196 + > echo world > file.txt 197 197 + > echo world >| file.txt 198 198 + > cat file.txt 199 199 + > EOF 200 200 + 201 201 + $ sh test.sh 202 202 + test.sh: line 3: file.txt: cannot overwrite existing file 203 203 + world 204 204 + $ msh test.sh 205 205 + msh: cannot overwrite existing file 206 206 + world 207 207 + 191 208 2.7 Sequences 192 209 193 210 A simple, semicolon sequence.