diff options
Diffstat (limited to 'net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01')
| -rw-r--r-- | net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01 | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01 b/net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01 new file mode 100644 index 000000000000..2fb4193f76fa --- /dev/null +++ b/net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01 @@ -0,0 +1,209 @@ +From accfb998cc9afc95c0b13dac20d9b49ef9af7e8d Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= <toivol@gmail.com> +Date: Fri, 14 Apr 2023 14:48:48 +0200 +Subject: [PATCH] Revert "Avoid problems with quoting arguments to copyprog" + +This reverts commit e737106fbbd541c5d9536606fb15b04cb165f5d2. +--- + src/copy.ml | 38 ++++++++++++++++++++++-------- + src/external.ml | 45 +++--------------------------------- + src/external.mli | 1 - + src/system/system_generic.ml | 2 -- + src/system/system_intf.ml | 3 --- + 6 files changed, 31 insertions(+), 58 deletions(-) + +diff --git a/src/copy.ml b/src/copy.ml +index 21e22743d..fa704f35c 100644 +--- copy.ml ++++ copy.ml +@@ -911,8 +911,17 @@ let copythreshold = + ^ "See \\sectionref{speeding}{Making Unison Faster on Large Files} " + ^ "for more information.") + +-(* Pref copyquoterem removed since 2.53.3 *) +-let () = Prefs.markRemoved "copyquoterem" ++let copyquoterem = ++ Prefs.createBoolWithDefault "copyquoterem" ++ ~category:(`Advanced `General) ++ "add quotes to remote file name for copyprog (true/false/default)" ++ ("When set to {\\tt true}, this flag causes Unison to add an extra layer " ++ ^ "of quotes to the remote path passed to the external copy program. " ++ ^ "This is needed by rsync, for example, which internally uses an ssh " ++ ^ "connection requiring an extra level of quoting for paths containing " ++ ^ "spaces. When this flag is set to {\\tt default}, extra quotes are " ++ ^ "added if the value of {\\tt copyprog} contains the string " ++ ^ "{\\tt rsync}.") + + let copymax = + Prefs.createInt "copymax" 1 +@@ -1022,25 +1031,34 @@ let transferFileUsingExternalCopyprog + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress id useExistingTarget = + Uutil.showProgress id Uutil.Filesize.zero "ext"; +- let progWithArgs = ++ let prog = + if useExistingTarget then + Prefs.read copyprogrest + else + Prefs.read copyprog + in ++ let extraquotes = Prefs.read copyquoterem = `True ++ || ( Prefs.read copyquoterem = `Default ++ && Util.findsubstring "rsync" prog <> None) in ++ let addquotes root s = ++ match root with ++ | Common.Local, _ -> s ++ | Common.Remote _, _ -> if extraquotes then Uutil.quotes s else s in + let fromSpec = + (formatConnectionInfo rootFrom) +- ^ (Fspath.toString (Fspath.concat (snd rootFrom) pathFrom)) in ++ ^ (addquotes rootFrom ++ (Fspath.toString (Fspath.concat (snd rootFrom) pathFrom))) in + let toSpec = + (formatConnectionInfo rootTo) +- ^ (Fspath.toString (Fspath.concat fspathTo pathTo)) in +- Trace.log (progWithArgs ^ " " ^ fromSpec ^ " " ^ toSpec ^ "\n"); ++ ^ (addquotes rootTo ++ (Fspath.toString (Fspath.concat fspathTo pathTo))) in ++ let cmd = prog ^ " " ++ ^ (Uutil.quotes fromSpec) ^ " " ++ ^ (Uutil.quotes toSpec) in ++ Trace.log (Printf.sprintf "%s\n" cmd); + Lwt_util.resize_region !copyprogReg (Prefs.read copymax); +- let args = Str.split (Str.regexp "[ \t]+") progWithArgs in +- let prog = match args with [] -> assert false | h :: _ -> h in + Lwt_util.run_in_region !copyprogReg 1 +- (fun () -> External.runExternalProgramArgs prog +- (Array.of_list (args @ [fromSpec; toSpec]))) >>= fun (_, log) -> ++ (fun () -> External.runExternalProgram cmd) >>= fun (_, log) -> + debug (fun() -> + let l = Util.trimWhitespace log in + Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s" +diff --git a/src/external.ml b/src/external.ml +index f13368231..cefb9ea98 100644 +--- external.ml ++++ external.ml +@@ -25,26 +25,6 @@ let debug = Util.debug "external" + let (>>=) = Lwt.bind + open Lwt + +-(* For backwards compatibility with OCaml < 4.12 *) +-let path = +- try +- Str.split (Str.regexp (if Util.osType = `Win32 then ";" else ":")) +- (Sys.getenv "PATH") +- with Not_found -> +- [] +- +-let search_in_path ?(path = path) name = +- if String.contains name '/' then name else +- Filename.concat +- (List.find (fun dir -> +- let p = Filename.concat dir name in +- let found = System.file_exists p in +- debug (fun () -> Util.msg "'%s' ...%s\n" p +- (match found with true -> "found" | false -> "not found")); +- found) +- path) +- name +- + (* Make sure external process resources are collected and zombie processes + reaped when the Lwt thread calling the external program is stopped + suddenly due to remote connection being closed. *) +@@ -66,17 +46,9 @@ let fullProcRes = + let openProcessIn cmd = inProcRes.register (System.open_process_in cmd) + let closeProcessIn = inProcRes.release + +-(* Remove call to search_in_path once we require OCaml >= 4.12. *) +-let openProcessArgsIn cmd args = inProcRes.register (System.open_process_args_in (search_in_path cmd) args) +-let closeProcessArgsIn = inProcRes.release +- + let openProcessFull cmd = fullProcRes.register (System.open_process_full cmd) + let closeProcessFull = fullProcRes.release + +-(* Remove call to search_in_path once we require OCaml >= 4.12. *) +-let openProcessArgsFull cmd args = fullProcRes.register (System.open_process_args_full (search_in_path cmd) args) +-let closeProcessArgsFull = fullProcRes.release +- + let readChannelTillEof c = + let lst = ref [] in + let rec loop () = +@@ -108,11 +80,10 @@ let readChannelsTillEof l = + >>= (fun res -> return (String.concat "\n" (Safelist.rev res)))) + l + +- +-let runExternalProgramAux ~winProc ~posixProc = ++let runExternalProgram cmd = + if Util.osType = `Win32 && not Util.isCygwin then begin + debug (fun()-> Util.msg "Executing external program windows-style\n"); +- let c = winProc () in ++ let c = openProcessIn ("\"" ^ cmd ^ "\"") in + let log = Util.trimWhitespace (readChannelTillEof c) in + let returnValue = closeProcessIn c in + let resultLog = +@@ -124,7 +95,7 @@ let runExternalProgramAux ~winProc ~posixProc = + "") in + Lwt.return (returnValue, resultLog) + end else +- let (out, ipt, err) as desc = posixProc () in ++ let (out, ipt, err) as desc = openProcessFull cmd in + let out = Lwt_unix.intern_in_channel out in + let err = Lwt_unix.intern_in_channel err in + readChannelsTillEof [out;err] +@@ -143,13 +114,3 @@ let runExternalProgramAux ~winProc ~posixProc = + else "\n\n" ^ Util.process_status_to_string returnValue))) + (* Stop typechechecker from complaining about non-exhaustive pattern above *) + | _ -> assert false) +- +-let runExternalProgram cmd = +- runExternalProgramAux +- ~winProc:(fun () -> openProcessIn ("\"" ^ cmd ^ "\"")) +- ~posixProc:(fun () -> openProcessFull cmd) +- +-let runExternalProgramArgs cmd args = +- runExternalProgramAux +- ~winProc:(fun () -> openProcessArgsIn cmd args) +- ~posixProc:(fun () -> openProcessArgsFull cmd args) +diff --git a/src/external.mli b/src/external.mli +index d2d0bae5b..30d2dbd05 100644 +--- external.mli ++++ external.mli +@@ -2,5 +2,4 @@ + (* Copyright 1999-2020, Benjamin C. Pierce (see COPYING for details) *) + + val runExternalProgram : string -> (Unix.process_status * string) Lwt.t +-val runExternalProgramArgs : string -> string array -> (Unix.process_status * string) Lwt.t + val readChannelTillEof : in_channel -> string +diff --git a/src/system/system_generic.ml b/src/system/system_generic.ml +index 15509abd5..3ef4fb09b 100644 +--- system/system_generic.ml ++++ system/system_generic.ml +@@ -272,10 +272,8 @@ let open_in_bin = open_in_bin + + let create_process = Unix.create_process + let open_process_in = Unix.open_process_in +-let open_process_args_in = Unix.open_process_args_in + let open_process_out = Unix.open_process_out + let open_process_full cmd = Unix.open_process_full cmd (Unix.environment ()) +-let open_process_args_full cmd args = Unix.open_process_args_full cmd args (Unix.environment ()) + let process_in_pid = Unix.process_in_pid + let process_out_pid = Unix.process_out_pid + let process_full_pid = Unix.process_full_pid +diff --git a/src/system/system_intf.ml b/src/system/system_intf.ml +index 873f4ca57..4dc60dd3b 100644 +--- system/system_intf.ml ++++ system/system_intf.ml +@@ -99,12 +99,9 @@ val create_process : + string -> string array -> + Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int + val open_process_in : string -> in_channel +-val open_process_args_in : string -> string array -> in_channel + val open_process_out : string -> out_channel + val open_process_full : + string -> in_channel * out_channel * in_channel +-val open_process_args_full : +- string -> string array -> in_channel * out_channel * in_channel + val process_in_pid : in_channel -> int + val process_out_pid : out_channel -> int + val process_full_pid : in_channel * out_channel * in_channel -> int |