Fix downloading of archive for rsync repositories. Regression introdu…

…ced by 641c07f

src/client/opamState.ml

@@ -27,7 +27,8 @@ let () =
 
 let check f =
   let root = OpamPath.default () in
-  let with_switch_lock a f = OpamFilename.with_flock (OpamPath.Switch.lock root a) f in
+  let with_switch_lock a f =
+    OpamFilename.with_flock (OpamPath.Switch.lock root a) f in
   if OpamFilename.exists_dir root then
     match f with
 
@@ -36,7 +37,12 @@ let check f =
       OpamFilename.with_flock (OpamPath.lock root) (fun () ->
         (* Take all the switch locks *)
         let aliases = OpamFile.Aliases.safe_read (OpamPath.aliases root) in
-        let f = OpamSwitch.Map.fold (fun a _ f -> with_switch_lock a (fun () -> f ())) aliases f in
+        let f =
+          OpamSwitch.Map.fold (fun a _ f ->
+            if OpamFilename.exists_dir (OpamPath.Switch.root root a)
+            then with_switch_lock a (fun () -> f ())
+            else f
+          ) aliases f in
         f ()
       ) ()
 
@@ -639,11 +645,11 @@ let install_compiler t ~quiet switch compiler =
       else if Sys.file_exists comp_src_raw then
         OpamFilename.extract comp_src build_dir
       else OpamFilename.with_tmp_dir (fun download_dir ->
-        let file = OpamFilename.download comp_src download_dir in
+        let file = OpamFilename.download ~overwrite:true comp_src download_dir in
         OpamFilename.extract file build_dir;
       );
       let patches = OpamFile.Comp.patches comp in
-      let patches = List.map (fun f -> OpamFilename.download f build_dir) patches in
+      let patches = List.map (fun f -> OpamFilename.download ~overwrite:true f build_dir) patches in
       List.iter (fun f -> OpamFilename.patch f build_dir) patches;
       if OpamFile.Comp.configure comp @ OpamFile.Comp.make comp <> [] then begin
         OpamFilename.exec build_dir

src/core/opamFilename.ml

@@ -219,17 +219,17 @@ let remove_prefix ~prefix filename =
   let dirname = to_string filename in
   OpamMisc.remove_prefix ~prefix dirname
 
-let download filename dirname =
+let download ~overwrite filename dirname =
   mkdir dirname;
-  let file = OpamSystem.download ~filename:(to_string filename) ~dirname:(Dir.to_string dirname) in
+  let file = OpamSystem.download ~overwrite ~filename:(to_string filename) ~dirname:(Dir.to_string dirname) in
   of_string file
 
-let download_iter filenames dirname =
+let download_iter ~overwrite filenames dirname =
   let rec aux = function
     | []   ->
       OpamSystem.internal_error "Cannot download %s" (String.concat ", " (List.map to_string filenames))
     | h::t ->
-      try download h dirname
+      try download ~overwrite h dirname
       with _ -> aux t in
   aux filenames
 

src/core/opamFilename.mli

@@ -140,10 +140,10 @@ val remove_prefix: prefix:Dir.t -> t -> string
 
 (** download a remote file in a given directory. Return the location
     of the downloaded file if the download is successful.  *)
-val download: t -> Dir.t -> t
+val download: overwrite:bool -> t -> Dir.t -> t
 
 (** iterate downloads until one is sucessful *)
-val download_iter: t list -> Dir.t -> t
+val download_iter: overwrite:bool -> t list -> Dir.t -> t
 
 (** Apply a patch to a directory *)
 val patch: t -> Dir.t -> unit

src/core/opamSystem.ml

@@ -438,7 +438,7 @@ let download_command = lazy (
       internal_error "Cannot find curl nor wget"
 )
 
-let really_download ~src ~dst =
+let really_download ~overwrite ~src ~dst =
   let cmd = (Lazy.force download_command) src in
   let aux () =
     command cmd;
@@ -447,9 +447,12 @@ let really_download ~src ~dst =
         internal_error "there should be exactly one file in download directory"
     | [filename] ->
         let dst_file = dst / Filename.basename filename in
-        if Sys.file_exists dst_file
-        then internal_error "download overwriting file %s" dst_file;
-        command [ "mv"; filename; dst_file ];
+        if not overwrite && Sys.file_exists dst_file then
+          internal_error "download overwriting file %s" dst_file;
+        commands [
+          [ "rm"; "-f"; dst_file ];
+          [ "mv"; filename; dst_file ];
+        ];
         dst_file
   in
   try with_tmp_dir (fun tmp_dir -> in_dir tmp_dir aux)
@@ -459,17 +462,20 @@ let really_download ~src ~dst =
     raise e
   | _ -> OpamGlobals.error_and_exit "Cannot download %s, please check your connection settings." src
 
-let download ~filename:src ~dirname:dst =
+let download ~overwrite ~filename:src ~dirname:dst =
   let dst_file = dst / Filename.basename src in
   if dst_file = src then
     dst_file
-  else if Sys.file_exists src then
-    ( commands [
-          [ "rm"; "-f"; dst_file ];
-          [ "cp"; src; dst ]
-        ];
-      dst_file )
-  else really_download ~src ~dst
+  else if Sys.file_exists src then (
+    if not overwrite && Sys.file_exists dst_file then
+      internal_error "download overwriting file %s" dst_file;
+    commands [
+      [ "rm"; "-f"; dst_file ];
+      [ "cp"; src; dst ]
+    ];
+    dst_file
+  ) else
+    really_download ~overwrite ~src ~dst
 
 let patch =
   let max_trying = 20 in

src/core/opamSystem.mli

@@ -141,7 +141,7 @@ val funlock: string -> unit
 (** {2 Misc} *)
 
 (** download compiler sources *)
-val download: filename:string -> dirname:string -> string
+val download: overwrite:bool -> filename:string -> dirname:string -> string
 
 (** Apply a patch file in the current directory. *)
 val patch: string -> unit

src/repositories/opamCurl.ml

@@ -51,7 +51,7 @@ let make_state ~download_index remote_dir =
         if OpamFilename.exists local_index_file then
           OpamFilename.move local_index_file local_index_file_save;
         try
-          let file = OpamFilename.download remote_index_file local_dir in
+          let file = OpamFilename.download ~overwrite:false remote_index_file local_dir in
           OpamFilename.remove local_index_file_save;
           file;
         with e ->
@@ -100,8 +100,7 @@ module B = struct
     let state = make_state ~download_index:true address in
     (* Download index.tar.gz *)
     try
-      OpamFilename.remove state.local_index_archive;
-      let file = OpamFilename.download state.remote_index_archive state.local_dir in
+      let file = OpamFilename.download ~overwrite:true state.remote_index_archive state.local_dir in
       OpamFilename.extract_in file state.local_dir
     with _ ->
       OpamGlobals.msg
@@ -112,7 +111,7 @@ module B = struct
     log "dowloading %s" (OpamFilename.to_string remote_file);
     let local_dir = OpamFilename.dirname local_file in
     OpamFilename.mkdir local_dir;
-    OpamFilename.download remote_file local_dir
+    OpamFilename.download ~overwrite:true remote_file local_dir
 
   let update ~address =
     OpamGlobals.msg "Synchronizing with %s ...\n" (OpamFilename.Dir.to_string address);
@@ -175,7 +174,7 @@ module B = struct
         let local_dir = OpamFilename.dirname local_file in
         OpamFilename.mkdir local_dir;
         OpamGlobals.msg "Downloading %s ...\n" (OpamFilename.to_string remote_file);
-        let local_file = OpamFilename.download remote_file local_dir in
+        let local_file = OpamFilename.download ~overwrite:true remote_file local_dir in
         if not (OpamFilename.exists local_file) then
           (* This may happen with empty files *)
           OpamFilename.touch local_file;
@@ -197,7 +196,7 @@ module B = struct
     let dest_dir = OpamPath.Repository.tmp_dir local_repo nv in
     OpamGlobals.msg "Downloading %s ...\n" (OpamFilename.to_string remote_file);
     try
-      let file = OpamFilename.download remote_file dest_dir in
+      let file = OpamFilename.download ~overwrite:true remote_file dest_dir in
       Result file
     with _ ->
       Not_available