From f3e1171531b38516118246a6e2ade650db5109a1 Mon Sep 17 00:00:00 2001
From: Andre Maroneze <andre.maroneze@cea.fr>
Date: Tue, 19 Apr 2022 13:57:44 +0200
Subject: [PATCH] [Filepath] add 'pwd' function
---
src/kernel_services/ast_queries/file.ml | 14 ++------------
src/libraries/utils/filepath.ml | 2 ++
src/libraries/utils/filepath.mli | 15 +++++++++++++++
src/plugins/markdown-report/sarif_gen.ml | 10 +---------
src/plugins/wp/wp_parameters.ml | 10 +---------
5 files changed, 21 insertions(+), 30 deletions(-)
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index d384a53a645..7bb60f13bd7 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -447,19 +447,9 @@ let concat_strs ?(pre="") ?(sep=" ") l =
if l = [] then ""
else pre ^ (String.concat sep l)
-let cwd () =
- (* TODO: we currently use PWD instead of Sys.getcwd () because OCaml has
- no function in its stdlib to resolve symbolic links (e.g. realpath)
- 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.
- We only resort to getcwd() to avoid issues when PWD does not exist. *)
- try Unix.getenv "PWD" with Not_found -> Sys.getcwd ()
-
let adjust_pwd fp cpp_command =
if Kernel.JsonCompilationDatabase.is_set () then
- let cwd = cwd () in
+ let cwd = Filepath.pwd () in
let dir =
match Json_compilation_database.get_dir fp with
| None -> cwd
@@ -583,7 +573,7 @@ let abort_with_detailed_pp_message f cpp_command =
"failed to run: %s\n(PWD: %s)@\n\
%sSee chapter \"Preparing the Sources\" in the Frama-C user manual \
for more details."
- cpp_command (cwd ()) possible_cause
+ cpp_command (Filepath.pwd ()) possible_cause
let parse_cabs cpp_command = function
| NoCPP f ->
diff --git a/src/libraries/utils/filepath.ml b/src/libraries/utils/filepath.ml
index a9741beeed6..c0070248e9f 100644
--- a/src/libraries/utils/filepath.ml
+++ b/src/libraries/utils/filepath.ml
@@ -323,6 +323,8 @@ type position =
let pp_pos fmt pos =
Format.fprintf fmt "%a:%d" Normalized.pretty pos.pos_path pos.pos_lnum
+let pwd () = try Unix.getenv "PWD" with Not_found -> Sys.getcwd ()
+
(*
Local Variables:
compile-command: "make -C ../../.."
diff --git a/src/libraries/utils/filepath.mli b/src/libraries/utils/filepath.mli
index 4c5a6eee3c4..1f3de6c2705 100644
--- a/src/libraries/utils/filepath.mli
+++ b/src/libraries/utils/filepath.mli
@@ -207,6 +207,21 @@ type position =
*)
val pp_pos : Format.formatter -> position -> unit
+(** Return the current working directory.
+ Currently uses the environment's PWD instead of Sys.getcwd () because OCaml
+ has no function in its stdlib to resolve symbolic links (e.g. realpath)
+ 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.
+ We only resort to getcwd() to avoid issues when PWD does not exist.
+ Note that this function does not validate that PWD has not been tampered
+ with.
+
+ @since Frama-C+dev
+*)
+val pwd : unit -> string
+
(*
Local Variables:
compile-command: "make -C ../../.."
diff --git a/src/plugins/markdown-report/sarif_gen.ml b/src/plugins/markdown-report/sarif_gen.ml
index f452170bbf5..7378f6b6b85 100644
--- a/src/plugins/markdown-report/sarif_gen.ml
+++ b/src/plugins/markdown-report/sarif_gen.ml
@@ -255,15 +255,7 @@ let gen_run remarks =
(key, (dir :> string))
) (Filepath.all_symbolic_dirs ())
in
- (* TODO: we currently use Sys.getenv "PWD" instead of Sys.getcwd ()
- because OCaml has no function in its stdlib to resolve symbolic links
- (e.g. realpath) 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.
- 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 pwd = Filepath.pwd () in
let uriBases = ("PWD", pwd) :: symbolicDirs in
let uriBasesJson =
List.fold_left (fun acc (name, dir) ->
diff --git a/src/plugins/wp/wp_parameters.ml b/src/plugins/wp/wp_parameters.ml
index 780f7d2ff64..c84cfe647e4 100644
--- a/src/plugins/wp/wp_parameters.ml
+++ b/src/plugins/wp/wp_parameters.ml
@@ -1129,15 +1129,7 @@ let get_output_dir d =
(* --- Session dir --- *)
(* -------------------------------------------------------------------------- *)
-(* TODO: we currently use PWD instead of Sys.getcwd () because OCaml has
- no function in its stdlib to resolve symbolic links (e.g. realpath)
- 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.
- 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 default = Fc_Filepath.pwd () ^ "/.frama-c"
let has_session () =
Session.is_set () ||
--
GitLab