Add some checks on .install root and rootexec fields

doc/pages/Manual.md

@@ -1399,6 +1399,11 @@ allowed.
   installs to `<prefix>/doc/<pkgname>/`
 - <a id="installfield-stublibs">`stublibs:`</a>
   installs to `<prefix>/lib/stublibs/`, with the `exec` bit set
+- <a id="installfield-root">`root:`</a>
+  installs to `<prefix>/` (since opam 2.6.0)
+- <a id="installfield-rootexec">`rootexec:`</a>
+  installs to `<prefix>/`, but the `exec` bit is set (since
+  opam 2.6.0)
 
 The following are treated slightly differently:
 

master_changes.md

@@ -30,6 +30,7 @@ users)
 
 ## Install
   * Remove the build directory as soon as possible when installing a package [#6906 @kit-ty-kate - fix #5884]
+  * Add `root` and `rootexec` sections to `.install` files to install files from prefix root [#6938 @WardBrian @rjbou - fix #6919]
 
 ## Build (package)
   * When fetching a git repository, the resulting git branch is now deterministically named `main` instead of taking the system's `init.defaultBranch` [#6992 @kit-ty-kate]
@@ -220,6 +221,7 @@ users)
   * Add a test showing the remote and branch names of a git repository extracted by `opam source` [#6992 @kit-ty-kate]
   * Add a test showing the order of install actions for each relevant commands [#6864 @kit-ty-kate]
   * Add a test showing some of the internal steps of `opam init` [#6957 @kit-ty-kate]
+  * Add tests for `.install` `root` and `rootexec` fields [#6938 @rjbou]
 
 ### Engine
   * Add `http-server` to launch a minimal http server [#6939 @rjbou]
@@ -349,6 +351,9 @@ users)
   * `OpamFile.*.read_from_string`: add optional `?loc` string argument to propagate location information when available (path on disk, archive, etc.), and add logging with level 3 that displays it [#6625 @rjbou]
   * `OpamFile.*`: add `safe_read_from_string` [#6625 @rjbou]
   * `OpamRepositoryPath.tar`: renamed to `repo_tarring`, deprecated, no longer used [#6625 @rjbou]
+  * `OpamPathName`: add `opam_switch_d` for `.opam-switch` [#6938 @WardBrian]
+  * `OpamFile.Dot_install`: add fields `root` and `rootexec` to type record `t` [#6938 @WardBrian]
+  * `OpamFile.Dot_install`: add `root`, `rootexec`, `with_root`, and `with_rootexec` functions [#6938 @WardBrian]
 
 ## opam-core
   * `OpamCmdliner` was added. It is accessible through a new `opam-core.cmdliner` sub-library [#6755 @kit-ty-kate]
@@ -393,3 +398,4 @@ users)
   * `OpamPatch.patch`: no longer patch a file on disk, but take as argument a filesystem abstraction `FS_ABSTR` that delivers the needed functions [#6625 @rjbou]
   * `OpamPatch.parse_patch`: no longer take `~dir` the directory to translate the patch in as argument, it now takes `~translate` argument that is a string option (directory option), if we want to perform a translation in that directory [#6625 @rjbou]
   * `OpamSystem.real_path`: fix a bug where paths after a non existent directory where not resolve [#7011 @kit-ty-kate - fix #7010]
+  * `OpamFilename`: add `split` function that returns the list of paths elements, not platform dependent [#6938 @WardBrian]

src/client/opamAction.ml

@@ -155,6 +155,10 @@ let preprocess_dot_install_t st nv build_dir =
     false, (instdir_gen P.lib_dir), I.lib_root;
     true, (instdir_gen P.lib_dir), I.libexec_root;
 
+    (* prefix files *)
+    false, (fun r s _ -> P.root r s), I.root;
+    true, (fun r s _ -> P.root r s), I.rootexec;
+
     (* toplevel *)
     false, (instdir_gen P.toplevel), I.toplevel;
 
@@ -827,6 +831,8 @@ let remove_package_aux
     remove_files OpamPath.Switch.share_dir OpamFile.Dot_install.share_root;
     remove_files_and_dir OpamPath.Switch.etc OpamFile.Dot_install.etc;
     remove_files (OpamPath.Switch.man_dir ?num:None) OpamFile.Dot_install.man;
+    remove_files ((fun r s _ -> OpamPath.Switch.root r s)) OpamFile.Dot_install.root;
+    remove_files ((fun r s _ -> OpamPath.Switch.root r s)) OpamFile.Dot_install.rootexec;
     remove_files_and_dir OpamPath.Switch.doc OpamFile.Dot_install.doc;
 
     (* Remove the misc files *)

src/core/opamFilename.ml

@@ -9,7 +9,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let might_escape ~sep path =
+let split ~sep path =
   let sep =
     let real_sep = function
       | `Unix -> Re.char '/'
@@ -20,8 +20,11 @@ let might_escape ~sep path =
     | `Unspecified -> real_sep `Unix
     | `Unix | `Windows as sep -> real_sep sep
   in
+  Re.(split (compile sep) path)
+
+let might_escape ~sep path =
   List.exists (String.equal Filename.parent_dir_name)
-    Re.(split (compile sep) path)
+    (split ~sep path)
 
 module Base = struct
   include OpamStd.AbstractString

src/core/opamFilename.mli

@@ -15,6 +15,9 @@
 (* Returns [true] if string contains '..' between directory separators *)
 val might_escape: sep:[`Unix | `Windows | `Unspecified ] -> string -> bool
 
+(* Returns a list of elements between directory separators *)
+val split: sep:[`Unix | `Windows | `Unspecified ] -> string -> string list
+
 (** Basenames *)
 module Base: sig
   include OpamStd.ABSTRACT

src/format/opamFile.ml

@@ -3751,6 +3751,8 @@ module Dot_installSyntax = struct
   let format_version = OpamVersion.of_string "2.0"
 
   type t =  {
+    root    : (basename optional * basename option) list;
+    rootexec  : (basename optional * basename option) list;
     bin     : (basename optional * basename option) list;
     sbin    : (basename optional * basename option) list;
     lib     : (basename optional * basename option) list;
@@ -3768,6 +3770,8 @@ module Dot_installSyntax = struct
   }
 
   let empty = {
+    root     = [];
+    rootexec = [];
     lib      = [];
     bin      = [];
     sbin     = [];
@@ -3784,6 +3788,8 @@ module Dot_installSyntax = struct
     doc      = [];
   }
 
+  let root t = t.root
+  let rootexec t = t.rootexec
   let bin t = t.bin
   let sbin t = t.sbin
   let lib t = t.lib
@@ -3799,6 +3805,8 @@ module Dot_installSyntax = struct
   let lib_root t = t.lib_root
   let libexec_root t = t.libexec_root
 
+  let with_root root t = { t with root }
+  let with_rootexec rootexec t = { t with rootexec }
   let with_bin bin t = { t with bin }
   let with_sbin sbin t = { t with sbin }
   let with_lib lib t = { t with lib }
@@ -3858,31 +3866,77 @@ module Dot_installSyntax = struct
          else OpamFilename.Base.to_string op.c)
 
   let fields =
+    let raise_with_file file ?pos message =
+      Pp.bad_format ?pos ("%s " ^^ message) file
+    in
+    let pp_check_parent_dir =
+      Pp.check ~name:"rel-filename"
+        ~raise:raise_with_file
+        ~errmsg:"references its parent directory."
+        (Fun.negate @@ OpamFilename.might_escape ~sep:`Unspecified)
+    in
+    let pp_check_not_absolute =
+      Pp.check ~name:"rel-filename"
+        ~raise:raise_with_file
+        ~errmsg:"is an absolute filename."
+        Filename.is_relative
+    in
+    let pp_warn_std_paths =
+      Pp.pp ~name:"std-paths"
+        (fun ~pos str ->
+           let paths = OpamTypesBase.all_std_paths in
+           let paths = List.filter (fun x -> x <> Prefix) paths in
+           let paths = List.map OpamTypesBase.string_of_std_path paths in
+           (match OpamFilename.split ~sep:`Unspecified str with
+            | root::_::_ ->
+              if OpamStd.List.mem String.equal root paths then
+                Pp.warn ~pos
+                  "Path '%s' begins with %s directory in 'root' field. \
+                   Use '%s' field instead."
+                  str root root
+            | _ -> ());
+           str)
+        Fun.id
+    in
     let pp_field =
       Pp.V.map_list ~depth:1 @@ Pp.V.map_option
         (Pp.V.string -| pp_optional)
         (Pp.opt @@
-         Pp.singleton -| Pp.V.string -| Pp.pp ~name:"rel-filename"
-           (fun ~pos s ->
-              if OpamFilename.might_escape ~sep:`Unspecified s then
-                Pp.bad_format ~pos "%s references its parent directory." s
-              else if Filename.is_relative s then
-                OpamFilename.Base.of_string s
-              else
-                Pp.bad_format ~pos "%s is an absolute filename." s)
-           OpamFilename.Base.to_string)
+         Pp.singleton -| Pp.V.string
+         -| pp_check_parent_dir
+         -| pp_check_not_absolute
+         -| Pp.of_module "file" (module OpamFilename.Base))
+    in
+    let pp_root =
+      Pp.V.map_list ~depth:1 @@ Pp.V.map_option
+        (Pp.V.string -| pp_optional)
+        (Pp.opt @@
+         Pp.singleton -| Pp.V.string
+         -| pp_check_parent_dir
+         -| pp_check_not_absolute
+         -| pp_warn_std_paths
+         -| Pp.check ~name:"rel-filename"
+           ~raise:raise_with_file
+           ~errmsg:"tries to overwrite opam internal files."
+           (fun s ->
+              match OpamFilename.split ~sep:`Unspecified s with
+              | root::_::_ -> (root : string) <> OpamPathName.opamswitch_d
+              | _ -> true)
+         -| Pp.of_module "file" (module OpamFilename.Base))
     in
     let pp_misc =
       Pp.V.map_list ~depth:1 @@ Pp.V.map_option
         (Pp.V.string -| pp_optional)
-        (Pp.singleton -| Pp.V.string -| Pp.pp ~name:"abs-filename"
-           (fun ~pos s ->
-              if not (Filename.is_relative s) then OpamFilename.of_string s
-              else Pp.bad_format ~pos
-                  "%s is not an absolute filename." s)
-           OpamFilename.to_string)
+        (Pp.singleton -| Pp.V.string
+         -| Pp.check ~name:"abs-filename"
+           ~raise:raise_with_file
+           ~errmsg:"is not an absolute filename."
+           (Fun.negate Filename.is_relative)
+         -| Pp.of_module "abs-filename" (module OpamFilename))
     in
     [
+      "root", Pp.ppacc with_root root pp_root;
+      "rootexec", Pp.ppacc with_rootexec rootexec pp_root;
       "lib", Pp.ppacc with_lib lib pp_field;
       "bin", Pp.ppacc with_bin bin pp_field;
       "sbin", Pp.ppacc with_sbin sbin pp_field;

src/format/opamFile.mli

@@ -936,6 +936,12 @@ module Dot_install: sig
 
   include IO_FILE
 
+  (** List of files to install directly under the switch root. *)
+  val root: t -> (basename optional * basename option) list
+
+  (** List of files to install directly under the switch root, with +x set. *)
+  val rootexec: t -> (basename optional * basename option) list
+
   (** List of files to install in $bin/ *)
   val bin:  t -> (basename optional * basename option) list
 
@@ -978,6 +984,12 @@ module Dot_install: sig
   (** List of other files to install *)
   val misc: t -> (basename optional * filename) list
 
+  (** List of files to install directly under the switch root. *)
+  val with_root: (basename optional * basename option) list -> t -> t
+
+  (** List of files to install directly under the switch root, with +x set. *)
+  val with_rootexec: (basename optional * basename option) list -> t -> t
+
   (** List of files to install in $bin/ *)
   val with_bin : (basename optional * basename option) list -> t -> t
 

src/format/opamPathName.ml

@@ -22,6 +22,7 @@ let reinstall_d = "reinstall"
 let remove_d = "remove"
 let sources_d = "sources"
 let opam_d = "opam"
+let opamswitch_d = ".opam-switch"
 
 let config_f = "config"
 let opam_f = OpamRepositoryPathName.opam_f

src/format/opamPathName.mli

@@ -25,6 +25,7 @@ val reinstall_d: string
 val remove_d: string
 val sources_d: string
 val opam_d: string
+val opamswitch_d: string
 
 (** {2 Files} *)
 val config_f: string

src/tools/opam_installer.ml

@@ -194,7 +194,9 @@ let iter_install f instfile o =
       dest_pkg                    D.share,    S.share instfile,      false;
       dest_global                 D.share_dir,S.share_root instfile, false;
       dest_pkg                    D.etc,      S.etc instfile,        false;
-      dest_pkg    ?fix:o.docdir   D.doc,      S.doc instfile,        false; ]
+      dest_pkg    ?fix:o.docdir   D.doc,      S.doc instfile,        false;
+      dest                        o.prefix,   S.root instfile,       false;
+      dest                        o.prefix,   S.rootexec instfile,   true;  ]
 
 let install options =
   let instfile = OpamFile.Dot_install.safe_read options.file in