From 5a37af852731e18ed7ad81c50f710b7b0049c338 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 4 Aug 2020 22:06:21 -0700 Subject: [PATCH 1/2] Launch process without stdin by default Introduce a `null` input/output for processes. This can be used for redirecting to /dev/null or running a process without stdin. Change the default for Process.run to not read anything from stdin. Previously, processes would inherit stdin from dune. That seems like a bad default. Signed-off-by: Rudi Grinberg --- src/dune/process.ml | 25 ++++++++++++++++++++++++- src/dune/process.mli | 2 ++ 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/dune/process.ml b/src/dune/process.ml index 048f81d9035..fc85dba0441 100644 --- a/src/dune/process.ml +++ b/src/dune/process.ml @@ -33,6 +33,7 @@ module Io = struct type kind = | File of Path.t + | Null | Terminal type status = @@ -85,6 +86,23 @@ module Io = struct let stdin = terminal (In_chan stdin) + let null_path = + lazy + ( if Sys.win32 then + "nul" + else + "/dev/null" ) + + let null (type a) (mode : a mode) : a t = + let flags = + match mode with + | Out -> [ Unix.O_WRONLY ] + | In -> [ O_RDONLY ] + in + let fd = lazy (Unix.openfile (Lazy.force null_path) flags 0o666) in + let channel = lazy (channel_of_descr (Lazy.force fd) mode) in + { kind = Null; mode; fd; channel; status = Close_after_exec } + let file : type a. _ -> a mode -> a t = fun fn mode -> let flags = @@ -138,6 +156,7 @@ let command_line_enclosers ~dir ~(stdout_to : Io.output Io.t) in let suffix = match stdin_from.kind with + | Null -> suffix | Terminal -> suffix | File fn -> suffix ^ " < " ^ quote fn in @@ -148,10 +167,14 @@ let command_line_enclosers ~dir ~(stdout_to : Io.output Io.t) let suffix = match stdout_to.kind with | Terminal -> suffix + | Null -> + suffix ^ " > " ^ String.quote_for_shell (Lazy.force Io.null_path) | File fn -> suffix ^ " > " ^ quote fn in match stderr_to.kind with | Terminal -> suffix + | Null -> + suffix ^ " 2> " ^ String.quote_for_shell (Lazy.force Io.null_path) | File fn -> suffix ^ " 2> " ^ quote fn ) in (prefix, suffix) @@ -425,7 +448,7 @@ module Exit_status = struct end let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) - ?(stdin_from = Io.stdin) ~env ~purpose fail_mode prog args = + ?(stdin_from = Io.null In) ~env ~purpose fail_mode prog args = Scheduler.with_job_slot (fun () -> let display = (Config.t ()).display in let dir = diff --git a/src/dune/process.mli b/src/dune/process.mli index d6c122091b5..73fd4d37729 100644 --- a/src/dune/process.mli +++ b/src/dune/process.mli @@ -28,6 +28,8 @@ module Io : sig val stdin : input t + val null : 'a mode -> 'a t + (** Return a buffered channel for this output. The channel is created lazily. *) val out_channel : output t -> out_channel From 44b774a53ecd1770c10321d595ef095d0cc555d5 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 6 Aug 2020 05:12:09 -0700 Subject: [PATCH 2/2] Do not connect dune's stdin to user written actions Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 ++ src/dune/action_exec.ml | 2 +- src/dune/process.ml | 38 ++++++++++++--------- test/blackbox-tests/test-cases/github3672.t | 6 ++++ 4 files changed, 32 insertions(+), 17 deletions(-) create mode 100644 test/blackbox-tests/test-cases/github3672.t diff --git a/CHANGES.md b/CHANGES.md index fd702b0e19f..90514223434 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -62,6 +62,9 @@ next - Add `"odoc" {with-doc}` to the dependencies in the generated `.opam` files. (#3667, @kit-ty-kate) +- Do not allow user actions to capture dune's stdin (#3677, fixes #3672, + @rgrinberg) + 2.6.1 (02/07/2020) ------------------ diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index e8ecb755209..8d27d934527 100644 --- a/src/dune/action_exec.ml +++ b/src/dune/action_exec.ml @@ -476,7 +476,7 @@ let exec ~targets ~context ~env ~rule_loc ~build_deps t = ; env ; stdout_to = Process.Io.stdout ; stderr_to = Process.Io.stderr - ; stdin_from = Process.Io.stdin + ; stdin_from = Process.Io.null In ; prepared_dependencies = DAP.Dependency.Set.empty ; exit_codes = Predicate_lang.Element 0 } diff --git a/src/dune/process.ml b/src/dune/process.ml index fc85dba0441..e62e1ccc895 100644 --- a/src/dune/process.ml +++ b/src/dune/process.ml @@ -146,6 +146,12 @@ type purpose = | Internal_job | Build_job of Path.Build.Set.t +let io_to_redirection_path (kind : Io.kind) = + match kind with + | Terminal -> None + | Null -> Some (Lazy.force Io.null_path) + | File fn -> Some (Path.to_string fn) + let command_line_enclosers ~dir ~(stdout_to : Io.output Io.t) ~(stderr_to : Io.output Io.t) ~(stdin_from : Io.input Io.t) = let quote fn = String.quote_for_shell (Path.to_string fn) in @@ -156,26 +162,26 @@ let command_line_enclosers ~dir ~(stdout_to : Io.output Io.t) in let suffix = match stdin_from.kind with - | Null -> suffix - | Terminal -> suffix + | Null + | Terminal -> + suffix | File fn -> suffix ^ " < " ^ quote fn in let suffix = - match (stdout_to.kind, stderr_to.kind) with - | File fn1, File fn2 when Path.equal fn1 fn2 -> " &> " ^ quote fn1 - | _ -> ( - let suffix = - match stdout_to.kind with - | Terminal -> suffix - | Null -> - suffix ^ " > " ^ String.quote_for_shell (Lazy.force Io.null_path) - | File fn -> suffix ^ " > " ^ quote fn + match + ( io_to_redirection_path stdout_to.kind + , io_to_redirection_path stderr_to.kind ) + with + | Some fn1, Some fn2 when String.equal fn1 fn2 -> + " &> " ^ String.quote_for_shell fn1 + | path_out, path_err -> + let add_to_suffix suffix path redirect = + match path with + | None -> suffix + | Some path -> suffix ^ redirect ^ String.quote_for_shell path in - match stderr_to.kind with - | Terminal -> suffix - | Null -> - suffix ^ " 2> " ^ String.quote_for_shell (Lazy.force Io.null_path) - | File fn -> suffix ^ " 2> " ^ quote fn ) + let suffix = add_to_suffix suffix path_out " > " in + add_to_suffix suffix path_err " 2> " in (prefix, suffix) diff --git a/test/blackbox-tests/test-cases/github3672.t b/test/blackbox-tests/test-cases/github3672.t new file mode 100644 index 00000000000..4b604afbe0e --- /dev/null +++ b/test/blackbox-tests/test-cases/github3672.t @@ -0,0 +1,6 @@ + $ echo "(lang dune 2.7)" > dune-project + $ cat >dune < (rule (with-stdout-to file.txt (run cat))) + > EOF + $ echo foo | dune build + $ cat _build/default/file.txt