From 0f648f1387990e4bfa2bc3348a6e56199771df0d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 7 May 2018 21:27:53 +0700 Subject: [PATCH 1/5] Make sure Alias0.dir is always in the build_dir --- src/build_system.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/build_system.ml b/src/build_system.ml index 0594ecb9..2ca8095e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -233,6 +233,11 @@ module Alias0 = struct let make name ~dir = assert (not (String.contains name '/')); + if not (Path.is_in_build_dir dir) then + Exn.code_error "Alias0.make: Invalid alias" + [ "name", Sexp.To_sexp.string name + ; "dir", Path.sexp_of_t dir + ]; { dir; name } let stamp_file t = From 84831308f0cb73da6b12e3b309c86c73c71dc11c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 7 May 2018 21:36:07 +0700 Subject: [PATCH 2/5] Make sure that Alias0.dir always goes through dir check the directory must always be inside the build dir, so we make sure that any way to create the record validates this invariant --- src/build_system.ml | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 2ca8095e..890ddf67 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -212,7 +212,27 @@ module File_spec = struct end module Alias0 = struct - type t = { dir : Path.t; name : string } + module T : sig + type t = private + { dir : Path.t + ; name : string + } + val make : string -> dir:Path.t -> t + end = struct + type t = + { dir : Path.t + ; name : string + } + + let make name ~dir = + if not (Path.is_in_build_dir dir) || String.contains name '/' then + Exn.code_error "Alias0.make: Invalid alias" + [ "name", Sexp.To_sexp.string name + ; "dir", Path.sexp_of_t dir + ]; + { dir; name } + end + include T let pp fmt t = Path.pp fmt (Path.relative t.dir t.name) @@ -222,24 +242,13 @@ module Alias0 = struct if not (Path.is_in_build_dir path) then die "Invalid alias!\nTried to reference alias %S" (Path.to_string_maybe_quoted path); - { dir = Path.parent path - ; name = Path.basename path - } + make ~dir:(Path.parent path) (Path.basename path) let name t = t.name let dir t = t.dir let fully_qualified_name t = Path.relative t.dir t.name - let make name ~dir = - assert (not (String.contains name '/')); - if not (Path.is_in_build_dir dir) then - Exn.code_error "Alias0.make: Invalid alias" - [ "name", Sexp.To_sexp.string name - ; "dir", Path.sexp_of_t dir - ]; - { dir; name } - let stamp_file t = Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix) From 76c1a32da4642190059b2c459d4b5dd018854880 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 8 May 2018 19:27:02 +0700 Subject: [PATCH 3/5] Add tests for invalid alias paths --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/bad-alias-error/absolute-path/jbuild | 3 +++ .../bad-alias-error/outside-workspace/jbuild | 4 ++++ test/blackbox-tests/test-cases/bad-alias-error/run.t | 5 +++++ 4 files changed, 22 insertions(+) create mode 100644 test/blackbox-tests/test-cases/bad-alias-error/absolute-path/jbuild create mode 100644 test/blackbox-tests/test-cases/bad-alias-error/outside-workspace/jbuild create mode 100644 test/blackbox-tests/test-cases/bad-alias-error/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index f8dbff41..052e0b58 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -6,6 +6,14 @@ test-cases/aliases (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) +(alias + ((name bad-alias-error) + (deps ((package dune) (files_recursively_in test-cases/bad-alias-error))) + (action + (chdir + test-cases/bad-alias-error + (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) + (alias ((name byte-code-only) (deps ((package dune) (files_recursively_in test-cases/byte-code-only))) @@ -446,6 +454,7 @@ ((name runtest) (deps ((alias aliases) + (alias bad-alias-error) (alias byte-code-only) (alias c-stubs) (alias configurator) @@ -499,6 +508,7 @@ ((name runtest-no-deps) (deps ((alias aliases) + (alias bad-alias-error) (alias byte-code-only) (alias c-stubs) (alias configurator) diff --git a/test/blackbox-tests/test-cases/bad-alias-error/absolute-path/jbuild b/test/blackbox-tests/test-cases/bad-alias-error/absolute-path/jbuild new file mode 100644 index 00000000..789e60e0 --- /dev/null +++ b/test/blackbox-tests/test-cases/bad-alias-error/absolute-path/jbuild @@ -0,0 +1,3 @@ +(alias + ((name runtest) + (deps ((alias /foo/bar))))) diff --git a/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace/jbuild b/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace/jbuild new file mode 100644 index 00000000..d5050b8d --- /dev/null +++ b/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace/jbuild @@ -0,0 +1,4 @@ + +(alias + ((name runtest) + (deps ((alias ${ROOT}/../../../foobar))))) diff --git a/test/blackbox-tests/test-cases/bad-alias-error/run.t b/test/blackbox-tests/test-cases/bad-alias-error/run.t new file mode 100644 index 00000000..864f6496 --- /dev/null +++ b/test/blackbox-tests/test-cases/bad-alias-error/run.t @@ -0,0 +1,5 @@ + $ dune runtest --root absolute-path 2>&1 | grep -v Entering + Invalid alias! + Tried to reference alias "/foo/bar" + $ dune runtest --root outside-workspace 2>&1 | grep -v Entering + Path outside the workspace: ./../../../foobar from _build/default From 8eba040b92886e0dee81fffbb673d6953d485177 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 8 May 2018 20:01:00 +0700 Subject: [PATCH 4/5] Rename Alias.of_path to Alias.of_user_written_path And add a loc argument for correct error messages --- src/build_system.ml | 5 +++-- src/build_system.mli | 2 +- src/super_context.ml | 4 +++- test/blackbox-tests/test-cases/bad-alias-error/run.t | 8 +++++--- 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 890ddf67..eec4990e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -238,9 +238,10 @@ module Alias0 = struct let suffix = "-" ^ String.make 32 '0' - let of_path path = + let of_user_written_path ~loc path = if not (Path.is_in_build_dir path) then - die "Invalid alias!\nTried to reference alias %S" + Loc.fail loc "Invalid alias!\n\ + Tried to reference path outside build dir: %S" (Path.to_string_maybe_quoted path); make ~dir:(Path.parent path) (Path.basename path) diff --git a/src/build_system.mli b/src/build_system.mli index d55c6a8f..4abbcd2b 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -99,7 +99,7 @@ module Alias : sig val make : string -> dir:Path.t -> t - val of_path : Path.t -> t + val of_user_written_path : loc:Loc.t -> Path.t -> t (** The following always holds: diff --git a/src/super_context.ml b/src/super_context.ml index 3787dc3f..29e8aaeb 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -457,7 +457,9 @@ module Deps = struct open Dep_conf let make_alias t ~scope ~dir s = - Alias.of_path (Path.relative dir (expand_vars t ~scope ~dir s)) + let loc = String_with_vars.loc s in + Alias.of_user_written_path ~loc + (Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s)) let dep t ~scope ~dir = function | File s -> diff --git a/test/blackbox-tests/test-cases/bad-alias-error/run.t b/test/blackbox-tests/test-cases/bad-alias-error/run.t index 864f6496..67f63b48 100644 --- a/test/blackbox-tests/test-cases/bad-alias-error/run.t +++ b/test/blackbox-tests/test-cases/bad-alias-error/run.t @@ -1,5 +1,7 @@ $ dune runtest --root absolute-path 2>&1 | grep -v Entering - Invalid alias! - Tried to reference alias "/foo/bar" + File "jbuild", line 3, characters 16-24: + Error: Invalid alias! + Tried to reference path outside build dir: "/foo/bar" $ dune runtest --root outside-workspace 2>&1 | grep -v Entering - Path outside the workspace: ./../../../foobar from _build/default + File "jbuild", line 4, characters 16-39: + Error: path outside the workspace: ./../../../foobar from _build/default From 78612e0649fb60a5494064a9d96f32ba0a489fb8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 9 May 2018 08:09:32 +0700 Subject: [PATCH 5/5] Move of_user_written_path to Alias0.T This is done to avoid double check of the path being in build dir --- src/build_system.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index eec4990e..f595b419 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -218,6 +218,7 @@ module Alias0 = struct ; name : string } val make : string -> dir:Path.t -> t + val of_user_written_path : loc:Loc.t -> Path.t -> t end = struct type t = { dir : Path.t @@ -231,6 +232,15 @@ module Alias0 = struct ; "dir", Path.sexp_of_t dir ]; { dir; name } + + let of_user_written_path ~loc path = + if not (Path.is_in_build_dir path) then + Loc.fail loc "Invalid alias!\n\ + Tried to reference path outside build dir: %S" + (Path.to_string_maybe_quoted path); + { dir = Path.parent path + ; name = Path.basename path + } end include T @@ -238,13 +248,6 @@ module Alias0 = struct let suffix = "-" ^ String.make 32 '0' - let of_user_written_path ~loc path = - if not (Path.is_in_build_dir path) then - Loc.fail loc "Invalid alias!\n\ - Tried to reference path outside build dir: %S" - (Path.to_string_maybe_quoted path); - make ~dir:(Path.parent path) (Path.basename path) - let name t = t.name let dir t = t.dir