Merge pull request #6036 from rjbou/swhid-test

Software Heritage fallback fixes

.gitignore

@@ -99,3 +99,4 @@ doc/*.build
 src/x_build_libs.ocp
 # dev setup
 /.ocamlinit
+/release/out

master_changes.md

@@ -65,6 +65,10 @@ users)
 
 ## Repository
   * Accurately tag `curl` download command when loaded from global config file [#6270 @rjbou]
+  * Remove wget support for Software Heritage fallback [#6036 @rjbou - fix #5721]
+  * [BUG] Fix SWH liveness check [#6036 @rjbou - fix #5721]
+  * Update SWH API request [#6036 @rjbou]
+  * Rework SWH fallback to have a more correct archive retrieval and more fine grained error handling [#6036 @rjbou - fix #5721]
 
 ## Lock
 
@@ -170,6 +174,9 @@ users)
   * `OpamArg.InvalidCLI`: export exception [#6150 @rjbou]
 
 ## opam-repository
+  * `OpamDownload.get_output`: fix `wget` option for `POST` requests [#6036 @rjbou]
+  * `OpamDownload.get_output`: use long form for `curl` `POST` request option [#6036 @rjbou]
+  * `OpamDownload.download`: more fine grained HTTP request error code detection for curl [#6036 @rjbou]
 
 ## opam-state
 
@@ -190,3 +197,4 @@ users)
   * `OpamSystem`: add `is_archive_from_string` that does the same than `is_archive` but without looking at the file, only analysing the string (extension) [#6219 @rjbou]
   * `OpamSystem.remove_dir`: do not fail with an exception when directory is a symbolic link [#6276 @btjorge @rjbou - fix #6275]
   * `OpamParallel.*.{map,reduce,iter}`: Run `Gc.compact` when the main process is waiting for the children processes for the first time [#5396 @kkeundotnet]
+  * `OpamSystem`, `OpamFilename`: add `with_tmp_file` and `with_tmp_file_job` function, that create a file name in temporary directory and removes it at the end of the call [#6036 @rjbou]

src/core/opamFilename.ml

@@ -266,6 +266,12 @@ let exists filename =
 let opt_file filename =
   if exists filename then Some filename else None
 
+let with_tmp_file fn =
+  OpamSystem.with_tmp_file (fun file -> fn (of_string file))
+
+let with_tmp_file_job fjob =
+  OpamSystem.with_tmp_file_job (fun file -> fjob (of_string file))
+
 let with_contents fn filename =
   fn (read filename)
 

src/core/opamFilename.mli

@@ -170,6 +170,13 @@ val exists: t -> bool
     a symlink to one *)
 val opt_file: t -> t option
 
+(** Execute a function with a file in a temp directory.
+    It is always cleaned up afterwards. *)
+val with_tmp_file: (t -> 'a) -> 'a
+
+(** Provide an automatically cleaned up file in temp directory to a job *)
+val with_tmp_file_job: (t -> 'a OpamProcess.job) -> 'a OpamProcess.job
+
 (** Check whether a file has a given suffix *)
 val check_suffix: t -> string -> bool
 

src/core/opamSystem.ml

@@ -81,10 +81,18 @@ let real_path p =
 let temp_basename prefix =
   Printf.sprintf "%s-%d-%06x" prefix (OpamStubs.getpid ()) (Random.int 0xFFFFFF)
 
-let rec mk_temp_dir ?(prefix="opam") () =
-  let s = Filename.get_temp_dir_name () / temp_basename prefix in
+let temp_name ?dir ?(prefix="opam") () =
+  let tmpdir =
+    match dir with
+    | Some d -> d
+    | None -> Filename.get_temp_dir_name ()
+  in
+  tmpdir / (temp_basename prefix)
+
+let rec mk_temp_dir ?prefix () =
+  let s = temp_name ?prefix () in
   if Sys.file_exists s then
-    mk_temp_dir ~prefix ()
+    mk_temp_dir ?prefix ()
   else
     real_path s
 
@@ -203,7 +211,7 @@ let rec temp_file ?(auto_clean=true) ?dir prefix =
     | None   -> OpamCoreConfig.(!r.log_dir)
     | Some d -> d in
   mkdir temp_dir;
-  let file = temp_dir / temp_basename prefix in
+  let file = temp_name ~dir:temp_dir ~prefix () in
   if Hashtbl.mem temp_files file then
     temp_file ~auto_clean ?dir prefix
   else (
@@ -404,6 +412,26 @@ let with_tmp_dir_job fjob =
   mkdir dir;
   OpamProcess.Job.finally (fun () -> remove_dir dir) (fun () -> fjob dir)
 
+let rec with_tmp_file fn =
+  let file = temp_name () in
+  if Sys.file_exists file then
+    with_tmp_file fn
+  else
+    try
+      let e = fn file in
+      remove_file file;
+      e
+    with e ->
+      OpamStd.Exn.finalise e @@ fun () ->
+      remove_file file
+
+let rec with_tmp_file_job fjob =
+  let file = temp_name () in
+  if Sys.file_exists file then
+    with_tmp_file_job fjob
+  else
+    OpamProcess.Job.finally (fun () -> remove_file file) (fun () -> fjob file)
+
 let remove file =
   if (try Sys2.is_directory file with Sys_error _ -> false) then
     remove_dir file

src/core/opamSystem.mli

@@ -33,7 +33,7 @@ exception Internal_error of string
 val internal_error: ('a, unit, string, 'b) format4 -> 'a
 
 (** [with_tmp_dir fn] executes [fn] creates a temporary directory and
-    passes its name to [fn]. The directory is alwasy removed on completion. *)
+    passes its name to [fn]. The directory is always removed on completion. *)
 val with_tmp_dir: (string -> 'a) -> 'a
 
 (** [in_tmp_dir fn] executes [fn] in a temporary directory. *)
@@ -42,6 +42,14 @@ val in_tmp_dir: (unit -> 'a) -> 'a
 (** Runs a job with a temp dir that is cleaned up afterwards *)
 val with_tmp_dir_job: (string -> 'a OpamProcess.job) -> 'a OpamProcess.job
 
+(** [with_tmp_file fn] creates a file name in temporary directory and
+    passes it to [fn]. The file is always removed on completion. *)
+val with_tmp_file: (string -> 'a) -> 'a
+
+(** Runs a job with a file in temporary directory that is cleaned up afterwards
+    *)
+val with_tmp_file_job: (string -> 'a OpamProcess.job) -> 'a OpamProcess.job
+
 (** Returns true if the default verbose level for base commands (cp, mv, etc.)
     is reached *)
 val verbose_for_base_commands: unit -> bool