diff --git a/master_changes.md b/master_changes.md index 0e3dcc3763b..cf8808b1d64 100644 --- a/master_changes.md +++ b/master_changes.md @@ -337,6 +337,8 @@ users) * [BUG] Display correct exception backtrace on uncaught exception on Windows [#5216 @dra27] * Use grep -F instead of fgrep, as the latter is deprecated [#5309 @MisterDA] * Always open files with `O_SHARE_DELETE`, which eliminates unnecessary "access denied" errors in various situations on Windows. [#5435 @dra27] + * Use `Sys.rename` instead of `mv` [#5438 @dra27] + * Use `robocopy` instead of `cp` on Windows [#5438 @dra27] ## Internal: Windows * Support MSYS2: treat MSYS2 and Cygwin as equivalent [#4813 @jonahbeckford] diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 3612d17c73d..53938750c47 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -254,13 +254,15 @@ let in_dir dir fn = with e -> OpamStd.Exn.finalise e reset_cwd -let list kind dir = +let with_path dir files = List.map (Filename.concat dir) files + +let list ?(map = with_path) kind dir = try in_dir dir (fun () -> let d = Sys.readdir (Sys.getcwd ()) in let d = Array.to_list d in let l = List.filter kind d in - List.map (Filename.concat dir) (List.sort compare l) + map dir (List.sort compare l) ) with File_not_found _ -> [] @@ -575,11 +577,11 @@ let run_process | `Not_found -> command_not_found cmd | `Denied -> permission_denied cmd -let command ?verbose ?env ?name ?metadata ?allow_stdin cmd = +let command ?(success=raise_on_process_error) ?verbose ?env ?name ?metadata ?allow_stdin cmd = let name = log_file name in let r = run_process ?verbose ?env ~name ?metadata ?allow_stdin cmd in OpamProcess.cleanup r; - raise_on_process_error r + success r let commands ?verbose ?env ?name ?metadata ?(keep_going=false) commands = let name = log_file name in @@ -633,6 +635,12 @@ let copy_file src dst = log "copy %s -> %s" src dst; copy_file_aux ~src ~dst () +let robocopy_success r = + let open OpamProcess in + (* XXX Comment this! *) + if r.r_code <> 0 && r.r_code <> 1 then + raise (Process_error r) + let copy_dir src dst = (* MSYS2 requires special handling because its uses copying rather than symlinks for maximum portability on Windows. However copying a source @@ -680,18 +688,36 @@ let copy_dir src dst = ([ "rsync"; "-a"; "--ignore-existing"; trailingslash_cygsrc; cygdest ])) else if Sys.file_exists dst then if Sys.is_directory dst then - match ls src with + let files = + (* XXX This mechanism isn't necessary - robocopy prefers not to have wildcards anyway *) + if Sys.win32 then + list ~map:(fun _ x -> x) (fun _ -> true) src + else + list (fun _ -> true) src in + match files with | [] -> () | srcfiles -> - command ~verbose:(verbose_for_base_commands ()) - ([ "cp"; "-PRp" ] @ srcfiles @ [ dst ]) + if Sys.win32 then + (* XXX Apply the slightly strange quoting rules for robocopy here - trailing space, etc. *) + command ~success:robocopy_success ~verbose:(verbose_for_base_commands ()) + (* How recent are /DCOPY:DATE and /SJ + /SL + XXX /SJ and /DCOPY:E are't present in 1809 / Server 2019 *) + ([ "robocopy"; "/E"; "/COPY:DAT"; "/SL"; (*"/SJ";*) "/DCOPY:DAT"; src; dst ]) + else + command ~success:robocopy_success ~verbose:(verbose_for_base_commands ()) + ([ "cp"; "-PRp" ] @ srcfiles @ [ dst ]) else internal_error "Can not copy dir %s to %s, which is not a directory" src dst else (mkdir (Filename.dirname dst); - command ~verbose:(verbose_for_base_commands ()) - [ "cp"; "-PRp"; src; dst ]) + if Sys.win32 then + (* XXX Apply the slightly strange quoting rules for robocopy here - trailing space, etc. *) + command ~success:robocopy_success ~verbose:(verbose_for_base_commands ()) + [ "robocopy"; "/E"; "/COPY:DAT"; "/SL"; (*"/SJ";*) "/DCOPY:DAT"; src; dst ] + else + command ~verbose:(verbose_for_base_commands ()) + [ "cp"; "-PRp"; src; dst ]) let mv_aux f src dst = if file_or_symlink_exists dst then remove_file dst; diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index 62a016eeb85..306e997eb39 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -197,10 +197,10 @@ val get_cygpath_function: command:string -> (string -> string) lazy_t val get_cygpath_path_transform: (string -> string) lazy_t (** [command cmd] executes the command [cmd] in the correct OPAM - environment. *) -val command: ?verbose:bool -> ?env:string array -> ?name:string -> - ?metadata:(string * string) list -> ?allow_stdin:bool -> - command -> unit + environment. [~success] defaults to {!raise_on_process_error} *) +val command: ?success:(OpamProcess.result -> unit) -> ?verbose:bool -> + ?env:string array -> ?name:string -> ?metadata:(string * string) list -> + ?allow_stdin:bool -> command -> unit (** [commands cmds] executes the commands [cmds] in the correct OPAM environment. It stops whenever one command fails unless [keep_going] is set