From 8e696e01df440771ad630fa2007fda9439b77656 Mon Sep 17 00:00:00 2001
From: Andre Maroneze <andre.maroneze@cea.fr>
Date: Fri, 18 Jun 2021 10:45:48 +0200
Subject: [PATCH] [Kernel] avoid issues when PWD is not in the environment
---
src/kernel_services/ast_queries/file.ml | 5 +++--
src/libraries/utils/filepath.ml | 6 ++++--
src/plugins/markdown-report/sarif_gen.ml | 6 ++++--
src/plugins/wp/wp_parameters.ml | 6 ++++--
4 files changed, 15 insertions(+), 8 deletions(-)
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index 8378c48b20a..b1222fd06eb 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -535,8 +535,9 @@ let build_cpp_cmd = function
for a given path. 'getcwd' always resolves them, but if the user
supplies a path with symbolic links, this may cause issues.
Instead of forcing the user to always provide resolved paths, we
- currently choose to never resolve them. *)
- let cwd = Unix.getenv "PWD" in
+ currently choose to never resolve them.
+ We only resort to getcwd() to avoid issues when PWD does not exist. *)
+ let cwd = try Unix.getenv "PWD" with Not_found -> Sys.getcwd () in
if cwd <> dir then
"cd " ^ dir ^ " && " ^ cpp_command
else cpp_command
diff --git a/src/libraries/utils/filepath.ml b/src/libraries/utils/filepath.ml
index 6f1a5cb5e27..288780367b1 100644
--- a/src/libraries/utils/filepath.ml
+++ b/src/libraries/utils/filepath.ml
@@ -130,8 +130,10 @@ let insert base path_name =
for a given path. 'getcwd' always resolves them, but if the user
supplies a path with symbolic links, this may cause issues.
Instead of forcing the user to always provide resolved paths, we
- currently choose to never resolve them. *)
-let cwd = insert dummy (Sys.getenv "PWD")
+ currently choose to never resolve them.
+ Note that, in rare situations (e.g. some Docker images), PWD does not
+ exist in the environment, so in that case, we fallback to Sys.getcwd. *)
+let cwd = insert dummy (try Sys.getenv "PWD" with Not_found -> Sys.getcwd ())
type existence =
| Must_exist
diff --git a/src/plugins/markdown-report/sarif_gen.ml b/src/plugins/markdown-report/sarif_gen.ml
index 52d493fe3f9..98be05d0f77 100644
--- a/src/plugins/markdown-report/sarif_gen.ml
+++ b/src/plugins/markdown-report/sarif_gen.ml
@@ -261,8 +261,10 @@ let gen_run remarks =
'getcwd' always resolves them, but if the user supplies a path with
symbolic links, this may cause issues.
Instead of forcing the user to always provide resolved paths, we
- currently choose to never resolve them. *)
- let uriBases = ("PWD", Sys.getenv "PWD") :: symbolicDirs in
+ currently choose to never resolve them.
+ We only resort to getcwd() to avoid issues when PWD does not exist. *)
+ let pwd = try Sys.getenv "PWD" with Not_found -> Sys.getcwd () in
+ let uriBases = ("PWD", pwd) :: symbolicDirs in
let uriBasesJson =
List.fold_left (fun acc (name, dir) ->
let baseUri =
diff --git a/src/plugins/wp/wp_parameters.ml b/src/plugins/wp/wp_parameters.ml
index 8ec961641c4..042f73ad148 100644
--- a/src/plugins/wp/wp_parameters.ml
+++ b/src/plugins/wp/wp_parameters.ml
@@ -1242,8 +1242,10 @@ let get_output_dir d =
for a given path. 'getcwd' always resolves them, but if the user
supplies a path with symbolic links, this may cause issues.
Instead of forcing the user to always provide resolved paths, we
- currently choose to never resolve them. *)
-let default = Sys.getenv "PWD" ^ "/.frama-c"
+ currently choose to never resolve them.
+ We only resort to getcwd() to avoid issues when PWD does not exist. *)
+let default =
+ (try Sys.getenv "PWD" with Not_found -> Sys.getcwd ()) ^ "/.frama-c"
let has_session () =
Session.is_set () ||
--
GitLab