Merge pull request #4401 from OCamlPro/fix-pkgname

Fix handling of filename-encoded pkgname in opam files

Makefile

@@ -149,6 +149,12 @@ uninstalllib-%: opam-installer opam-%.install
 libinstall: $(DUNE_DEP) opam-admin.top $(OPAMLIBS:%=installlib-%)
 	@
 
+custom-libinstall: $(DUNE_DEP) opam-lib opam
+	for p in $(OPAMLIBS); do \
+	  ./opam$(EXE) custom-install --no-recompilations opam-$$p.$(version) -- \
+	    $(DUNE) install opam-$$p; \
+	done
+
 processed-%.install: %.install
 	sed -f process.sed $^ > $@
 

master_changes.md

@@ -47,6 +47,9 @@ New option/command/subcommand are prefixed with ◈.
 ## Lock
   *
 
+## Opamfile
+  * Fix handling of filename-encoded pkgname in opam files [#4401 @AltGr - fix ocaml-opam/opam-publish#107]
+
 ## External dependencies
   * Add support for NetBSD and DragonFlyBSD [#4396 @kit-ty-kate]
   * Fix OpenBSD, FreeBSD and Gentoo: Allow short names and full name paths for ports-based systems [#4396 @kit-ty-kate]
@@ -65,6 +68,7 @@ New option/command/subcommand are prefixed with ◈.
 
 ## Build
   * Update opam file to 2.0 [#4371 @AltGr]
+  * Makefile: Add rule `custom-libinstall` for `opam-custom-install` use [#4401 @AltGr]
 
 ## Infrastructure
   *

src/client/opamAdminCommand.ml

@@ -602,7 +602,7 @@ let lint_command cli =
     let ret =
       OpamPackage.Map.fold (fun nv prefix ret ->
           let opam_file = OpamRepositoryPath.opam repo_root prefix nv in
-          let w, _ = OpamFileTools.lint_file opam_file in
+          let w, _ = OpamFileTools.lint_file ~handle_dirname:true opam_file in
           if List.exists (fun (n,_,_) -> List.mem n ign) w then ret else
           let w =
             List.filter (fun (n,_,_) ->

src/client/opamClient.mli

@@ -151,3 +151,25 @@ module PIN: sig
   val post_pin_action: rw switch_state -> package_set -> name list -> rw switch_state
 
 end
+
+
+(** {2 Auxiliary functions}
+    These functions are exposed for advanced uses by external libraries
+*)
+
+(** Orphan packages are installed but no longer available packages; we add
+    special treatment so that opam doesn't force their removal for consistency
+    reasons on any action. Returns the "fixed" state, fully orphan packages (no
+    available version of the package remaining), and orphan package versions.
+
+    Find more technical explanations in the source. *)
+val orphans:
+  ?changes:package_set -> ?transitive:bool ->
+  'a switch_state ->
+  'a switch_state * package_set * package_set
+
+(** An extended version of [orphans] that checks for conflicts between a given
+    request and the orphan packages *)
+val check_conflicts:
+  'a switch_state -> atom list ->
+  'a switch_state * package_set * package_set

src/client/opamCommands.ml

@@ -3391,9 +3391,10 @@ let lint cli =
           try
             let warnings,opam =
               match opam_f with
-              | Some f -> OpamFileTools.lint_file ~check_upstream f
+              | Some f ->
+                OpamFileTools.lint_file ~check_upstream ~handle_dirname:true f
               | None ->
-                OpamFileTools.lint_channel ~check_upstream
+                OpamFileTools.lint_channel ~check_upstream ~handle_dirname:false
                   (OpamFile.make (OpamFilename.of_string "-")) stdin
             in
             let enabled =

src/format/opamFile.ml

@@ -2450,24 +2450,6 @@ module OPAMSyntax = struct
       Some (pkg_flag_of_string (OpamStd.String.remove_prefix ~prefix tag))
     else None
 
-  let cleanup_name _opam_version ~pos:(file,_,_ as pos) name =
-    match OpamPackage.of_filename (OpamFilename.of_string file) with
-    | Some nv when nv.OpamPackage.name <> name ->
-      Pp.warn ~pos "This file is for package '%s' but its 'name:' field \
-                    advertises '%s'."
-        (OpamPackage.name_to_string nv) (OpamPackage.Name.to_string name);
-      nv.OpamPackage.name
-    | _ -> name
-
-  let cleanup_version _opam_version ~pos:(file,_,_ as pos) version =
-    match OpamPackage.of_filename (OpamFilename.of_string file) with
-    | Some nv when nv.OpamPackage.version <> version ->
-      Pp.warn ~pos "This file is for version '%s' but its 'version:' field \
-                    advertises '%s'."
-        (OpamPackage.version_to_string nv) (OpamPackage.Version.to_string version);
-      nv.OpamPackage.version
-    | _ -> version
-
   let cleanup_depopts opam_version ~pos depopts =
     if OpamFormatConfig.(!r.skip_version_checks) ||
        OpamVersion.compare opam_version (OpamVersion.of_string "1.2") < 0
@@ -2555,10 +2537,9 @@ module OPAMSyntax = struct
     [
       "opam-version", no_cleanup Pp.ppacc with_opam_version opam_version
         (Pp.V.string -| Pp.of_module "opam-version" (module OpamVersion));
-      "name", with_cleanup cleanup_name Pp.ppacc_opt with_name name_opt
+      "name", no_cleanup Pp.ppacc_opt with_name name_opt
         Pp.V.pkgname;
-      "version", with_cleanup cleanup_version
-        Pp.ppacc_opt with_version version_opt
+      "version", no_cleanup Pp.ppacc_opt with_version version_opt
         (Pp.V.string_tr -| Pp.of_module "version" (module OpamPackage.Version));
 
       "synopsis", no_cleanup Pp.ppacc_opt with_synopsis synopsis
@@ -2880,7 +2861,20 @@ module OPAMSyntax = struct
          in
          let t = { t with metadata_dir } in
          match OpamPackage.of_filename filename with
-         | Some nv -> with_nv nv t
+         | Some nv ->
+           if t.name <> None && t.name <> Some nv.name ||
+              t.version <> None && t.version <> Some nv.version
+           then
+             Pp.warn
+               "This file is for package '%s' but has mismatching fields%s%s."
+               (OpamPackage.to_string nv)
+               (OpamStd.Option.to_string
+                  (fun n -> " 'name:"^OpamPackage.Name.to_string n)
+                  t.name)
+               (OpamStd.Option.to_string
+                  (fun v -> " 'version:"^OpamPackage.Version.to_string v)
+                  t.version);
+           with_nv nv t
          | None -> t)
       (fun (filename, t) ->
          filename,

src/state/opamFileTools.ml

@@ -777,7 +777,8 @@ let extra_files_default filename =
        OpamHash.check_file (OpamFilename.to_string f))
     (OpamFilename.rec_files dir)
 
-let lint_gen ?check_extra_files ?check_upstream reader filename =
+let lint_gen ?check_extra_files ?check_upstream ?(handle_dirname=false)
+    reader filename =
   let warnings, t =
     let warn_of_bad_format (pos, msg) =
       2, `Error, Printf.sprintf "File format error%s: %s"
@@ -795,6 +796,7 @@ let lint_gen ?check_extra_files ?check_upstream reader filename =
           (OpamFormat.I.map_file OpamFile.OPAM.pp_raw_fields) f
       in
       let t, warnings =
+        if handle_dirname = false then t, [] else
         match OpamPackage.of_filename (OpamFile.filename filename) with
         | None -> t, []
         | Some nv ->
@@ -851,7 +853,7 @@ let lint_gen ?check_extra_files ?check_upstream reader filename =
   warnings @ (match t with Some t -> lint ~check_extra_files ?check_upstream t | None -> []),
   t
 
-let lint_file ?check_extra_files ?check_upstream filename =
+let lint_file ?check_extra_files ?check_upstream ?handle_dirname filename =
   let reader filename =
     try
       let ic = OpamFilename.open_in (OpamFile.filename filename) in
@@ -863,15 +865,17 @@ let lint_file ?check_extra_files ?check_upstream filename =
       OpamConsole.error_and_exit `Bad_arguments "File %s not found"
         (OpamFile.to_string filename)
   in
-  lint_gen ?check_extra_files ?check_upstream reader filename
+  lint_gen ?check_extra_files ?check_upstream ?handle_dirname reader filename
 
-let lint_channel ?check_extra_files ?check_upstream filename ic =
+let lint_channel ?check_extra_files ?check_upstream ?handle_dirname
+    filename ic =
   let reader filename = OpamFile.Syntax.of_channel filename ic in
-  lint_gen ?check_extra_files ?check_upstream reader filename
+  lint_gen ?check_extra_files ?check_upstream ?handle_dirname reader filename
 
-let lint_string ?check_extra_files ?check_upstream filename string =
+let lint_string ?check_extra_files ?check_upstream ?handle_dirname
+    filename string =
   let reader filename = OpamFile.Syntax.of_string filename string in
-  lint_gen ?check_extra_files ?check_upstream reader filename
+  lint_gen ?check_extra_files ?check_upstream ?handle_dirname reader filename
 
 let all_lint_warnings () =
   t_lint ~all:true OpamFile.OPAM.empty

src/state/opamFileTools.mli

@@ -19,20 +19,22 @@ val template: package -> OpamFile.OPAM.t
 (** Runs several sanity checks on the opam file; returns a list of warnings.
    [`Error] level should be considered unfit for publication, while [`Warning]
    are advisory but may be accepted. The int is an identifier for this specific
-   warning/error. If [check_extra_files] is unspecified, warning 53 won't be
-   checked. *)
+   warning/error. If [check_extra_files] is unspecified or false, warning 53
+   won't be checked. *)
 val lint:
   ?check_extra_files:(basename * (OpamHash.t -> bool)) list ->
-  ?check_upstream: bool ->
+  ?check_upstream:bool ->
   OpamFile.OPAM.t -> (int * [`Warning|`Error] * string) list
 
 (** Same as [lint], but operates on a file, which allows catching parse errors
-   too. You can specify an expected name and version. [check_extra_files]
-   defaults to a function that will look for a [files/] directory besides
-   [filename] *)
+   too. [check_extra_files] defaults to a function that will look for a [files/]
+   directory besides [filename]. [handle_dirname] is used for warning 4, and
+   should be set when reading packages from a repository, so that package name
+   and version are inferred from the filename. *)
 val lint_file:
   ?check_extra_files:(basename * (OpamHash.t -> bool)) list ->
-  ?check_upstream: bool ->
+  ?check_upstream:bool ->
+  ?handle_dirname:bool ->
   OpamFile.OPAM.t OpamFile.typed_file ->
   (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option
 
@@ -42,6 +44,7 @@ val lint_file:
 val lint_channel:
   ?check_extra_files:(basename * (OpamHash.t -> bool)) list ->
   ?check_upstream: bool ->
+  ?handle_dirname:bool ->
   OpamFile.OPAM.t OpamFile.typed_file -> in_channel ->
   (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option
 
@@ -51,6 +54,7 @@ val lint_channel:
 val lint_string:
   ?check_extra_files:(basename * (OpamHash.t -> bool)) list ->
   ?check_upstream: bool ->
+  ?handle_dirname:bool ->
   OpamFile.OPAM.t OpamFile.typed_file -> string ->
   (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option