mirror of
https://git.FreeBSD.org/ports.git
synced 2024-11-19 00:13:33 +00:00
net/unison: Update to 2.53.3
Add patches to allow building with ocaml 4.07.1 [1]. Many thanks to Tõivo Leedjärv from upstream for providing them. Obtained from:ad79ecf3c4accfb998ccf9191b19df
This commit is contained in:
Guido Falsi
parent
da1285bbea
commit
ec146756a8
@ -1,5 +1,5 @@
|
||||
PORTNAME= unison
|
||||
PORTVERSION= 2.53.2
|
||||
PORTVERSION= 2.53.3
|
||||
DISTVERSIONPREFIX= v
|
||||
CATEGORIES= net
|
||||
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
TIMESTAMP = 1679421059
|
||||
SHA256 (bcpierce00-unison-v2.53.2_GH0.tar.gz) = fb337c221722e496916b385e50e99a49604b8aed3f5fafcc45029c1d2aa1232b
|
||||
SIZE (bcpierce00-unison-v2.53.2_GH0.tar.gz) = 1410117
|
||||
TIMESTAMP = 1682664394
|
||||
SHA256 (bcpierce00-unison-v2.53.3_GH0.tar.gz) = aaea04fc5bc76dcfe8627683c9659ee4c194d4f992cc8aaa15bbb2820fc8de46
|
||||
SIZE (bcpierce00-unison-v2.53.3_GH0.tar.gz) = 1415490
|
||||
|
||||
@ -1,18 +1,6 @@
|
||||
--- Makefile.OCaml.orig 2023-03-19 12:38:58 UTC
|
||||
--- Makefile.OCaml.orig 2023-04-24 16:49:02 UTC
|
||||
+++ Makefile.OCaml
|
||||
@@ -34,7 +34,11 @@ ifeq ($(shell uname),NetBSD)
|
||||
else
|
||||
ifeq ($(shell uname),NetBSD)
|
||||
OSARCH=NetBSD
|
||||
+else
|
||||
+ifeq ($(shell uname),FreeBSD)
|
||||
+ OSARCH=FreeBSD
|
||||
endif
|
||||
+endif
|
||||
ifeq ($(shell uname),Linux)
|
||||
OSARCH=Linux
|
||||
endif
|
||||
@@ -271,7 +275,7 @@ OCAMLOBJS+=main.cmo
|
||||
@@ -248,7 +248,7 @@ OCAMLOBJS+=main.cmo
|
||||
|
||||
# OCaml libraries for the bytecode version
|
||||
# File extensions will be substituted for the native code version
|
||||
@ -21,7 +9,7 @@
|
||||
INCLFLAGS+=-I +unix -I +str
|
||||
|
||||
COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) hash_compat$(OBJ_EXT) props_xattr$(OBJ_EXT) props_acl$(OBJ_EXT)
|
||||
@@ -332,6 +336,11 @@ ifeq ($(OSARCH),Linux)
|
||||
@@ -309,6 +309,11 @@ ifeq ($(OSARCH),Linux)
|
||||
### Filesystem monitoring
|
||||
|
||||
ifeq ($(OSARCH),Linux)
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
--- fsmonitor/linux/Makefile.orig 2017-03-23 16:47:46 UTC
|
||||
--- fsmonitor/linux/Makefile.orig 2023-04-24 16:49:02 UTC
|
||||
+++ fsmonitor/linux/Makefile
|
||||
@@ -18,6 +18,10 @@ else
|
||||
@@ -18,6 +18,10 @@ endif
|
||||
FSMCAMLLIBS=$(FSMOCAMLLIBS)
|
||||
endif
|
||||
|
||||
@ -11,10 +11,3 @@
|
||||
buildexecutable:: $(FSMONITOR)$(EXEC_EXT)
|
||||
|
||||
$(FSMONITOR)$(EXEC_EXT): $(FSMCAMLOBJS) $(FSMCOBJS)
|
||||
@@ -26,4 +30,4 @@ $(FSMONITOR)$(EXEC_EXT): $(FSMCAMLOBJS) $(FSMCOBJS)
|
||||
|
||||
clean::
|
||||
rm -f $(DIR)/*.cm[iox] $(DIR)/*.o $(DIR)/*~
|
||||
- rm -f $(FSMONITOR)$(EXEC_EXT)
|
||||
\ No newline at end of file
|
||||
+ rm -f $(FSMONITOR)$(EXEC_EXT)
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
From b787de04da85da2f911c8248e07342e58b4e8625 Mon Sep 17 00:00:00 2001
|
||||
From: Tõivo Leedjärv <toivol@gmail.com>
|
||||
Date: Fre, 24 Mar 2023 17:22:09 +0100
|
||||
From ad79ecf3c42e0f10b05c7cb8eb5671c66b8a09e9 Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= <toivol@gmail.com>
|
||||
Date: Thu, 17 Nov 2022 11:53:35 +0100
|
||||
Subject: [PATCH] Restore compatibility with OCaml 4.06 and 4.07 (temporary
|
||||
patch)
|
||||
|
||||
@ -13,13 +13,16 @@ Makefile.OCaml).
|
||||
src/fswatchold.ml | 25 +++--
|
||||
src/remote.ml | 3 +-
|
||||
src/system/system_generic.ml | 204 +++++++++++++++++++++++++++++++++++
|
||||
src/uitext.ml | 1 -
|
||||
6 files changed, 326 insertions(+), 14 deletions(-)
|
||||
src/ubase/umarshal.ml | 105 ++++++++++++++++++
|
||||
src/uicommon.ml | 12 +--
|
||||
src/uitext.ml | 3 +-
|
||||
6 files changed, 332 insertions(+), 20 deletions(-)
|
||||
|
||||
index 17f22dcb..13cab93b 100644
|
||||
diff --git a/src/fswatchold.ml b/src/fswatchold.ml
|
||||
index 84912071a..5b266f519 100644
|
||||
--- fswatchold.ml
|
||||
+++ fswatchold.ml
|
||||
@@ -116,19 +116,22 @@ let readChanges wi =
|
||||
@@ -113,19 +113,22 @@ let readChanges wi =
|
||||
let watcherRunning archHash =
|
||||
RootMap.mem archHash !watchers &&
|
||||
let wi = RootMap.find archHash !watchers in
|
||||
@ -54,7 +57,7 @@ index 17f22dcb..13cab93b 100644
|
||||
let getChanges archHash =
|
||||
if StringSet.mem archHash !newWatchers then
|
||||
diff --git a/src/remote.ml b/src/remote.ml
|
||||
index d320470a..0ed393ae 100644
|
||||
index d101c3903..bedf2e3ba 100644
|
||||
--- remote.ml
|
||||
+++ remote.ml
|
||||
@@ -1887,11 +1887,12 @@ let buildShellConnection shell host userOpt portOpt rootName termInteract =
|
||||
@ -72,7 +75,7 @@ index d320470a..0ed393ae 100644
|
||||
let () = at_exit end_ssh in
|
||||
(None, pid)
|
||||
diff --git a/src/system/system_generic.ml b/src/system/system_generic.ml
|
||||
index 2147d44d..3ef4fb09 100644
|
||||
index 6f6c6895a..15509abd5 100644
|
||||
--- system/system_generic.ml
|
||||
+++ system/system_generic.ml
|
||||
@@ -15,6 +15,210 @@
|
||||
@ -286,11 +289,183 @@ index 2147d44d..3ef4fb09 100644
|
||||
type fspath = string
|
||||
|
||||
let mfspath = Umarshal.string
|
||||
diff --git a/src/ubase/umarshal.ml b/src/ubase/umarshal.ml
|
||||
index 5c5f061ad..d65e1a7c5 100644
|
||||
--- ubase/umarshal.ml
|
||||
+++ ubase/umarshal.ml
|
||||
@@ -15,6 +15,111 @@
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*)
|
||||
|
||||
+(* OCaml 4.07 compatibility ONLY *)
|
||||
+module Bytes = struct
|
||||
+
|
||||
+include Bytes
|
||||
+
|
||||
+(* The following code is taken from OCaml sources.
|
||||
+ Authors of the code snippet: Alain Frisch and Daniel Bünzli *)
|
||||
+
|
||||
+(**************************************************************************)
|
||||
+(* *)
|
||||
+(* OCaml *)
|
||||
+(* *)
|
||||
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
||||
+(* *)
|
||||
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
||||
+(* en Automatique. *)
|
||||
+(* *)
|
||||
+(* All rights reserved. This file is distributed under the terms of *)
|
||||
+(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
+(* special exception on linking described in the file LICENSE. *)
|
||||
+(* *)
|
||||
+(**************************************************************************)
|
||||
+
|
||||
+(** {6 Binary encoding/decoding of integers} *)
|
||||
+
|
||||
+external get_uint8 : bytes -> int -> int = "%string_safe_get"
|
||||
+external get_uint16_ne : bytes -> int -> int = "%caml_string_get16"
|
||||
+external get_int32_ne : bytes -> int -> int32 = "%caml_string_get32"
|
||||
+external get_int64_ne : bytes -> int -> int64 = "%caml_string_get64"
|
||||
+external set_int8 : bytes -> int -> int -> unit = "%string_safe_set"
|
||||
+external set_int16_ne : bytes -> int -> int -> unit = "%caml_string_set16"
|
||||
+external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_string_set32"
|
||||
+external set_int64_ne : bytes -> int -> int64 -> unit = "%caml_string_set64"
|
||||
+external swap16 : int -> int = "%bswap16"
|
||||
+external swap32 : int32 -> int32 = "%bswap_int32"
|
||||
+external swap64 : int64 -> int64 = "%bswap_int64"
|
||||
+
|
||||
+let get_int8 b i =
|
||||
+ ((get_uint8 b i) lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
|
||||
+
|
||||
+let get_uint16_le b i =
|
||||
+ if Sys.big_endian then swap16 (get_uint16_ne b i)
|
||||
+ else get_uint16_ne b i
|
||||
+
|
||||
+let get_uint16_be b i =
|
||||
+ if not Sys.big_endian then swap16 (get_uint16_ne b i)
|
||||
+ else get_uint16_ne b i
|
||||
+
|
||||
+let get_int16_ne b i =
|
||||
+ ((get_uint16_ne b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int16_le b i =
|
||||
+ ((get_uint16_le b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int16_be b i =
|
||||
+ ((get_uint16_be b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int32_le b i =
|
||||
+ if Sys.big_endian then swap32 (get_int32_ne b i)
|
||||
+ else get_int32_ne b i
|
||||
+
|
||||
+let get_int32_be b i =
|
||||
+ if not Sys.big_endian then swap32 (get_int32_ne b i)
|
||||
+ else get_int32_ne b i
|
||||
+
|
||||
+let get_int64_le b i =
|
||||
+ if Sys.big_endian then swap64 (get_int64_ne b i)
|
||||
+ else get_int64_ne b i
|
||||
+
|
||||
+let get_int64_be b i =
|
||||
+ if not Sys.big_endian then swap64 (get_int64_ne b i)
|
||||
+ else get_int64_ne b i
|
||||
+
|
||||
+let set_int16_le b i x =
|
||||
+ if Sys.big_endian then set_int16_ne b i (swap16 x)
|
||||
+ else set_int16_ne b i x
|
||||
+
|
||||
+let set_int16_be b i x =
|
||||
+ if not Sys.big_endian then set_int16_ne b i (swap16 x)
|
||||
+ else set_int16_ne b i x
|
||||
+
|
||||
+let set_int32_le b i x =
|
||||
+ if Sys.big_endian then set_int32_ne b i (swap32 x)
|
||||
+ else set_int32_ne b i x
|
||||
+
|
||||
+let set_int32_be b i x =
|
||||
+ if not Sys.big_endian then set_int32_ne b i (swap32 x)
|
||||
+ else set_int32_ne b i x
|
||||
+
|
||||
+let set_int64_le b i x =
|
||||
+ if Sys.big_endian then set_int64_ne b i (swap64 x)
|
||||
+ else set_int64_ne b i x
|
||||
+
|
||||
+let set_int64_be b i x =
|
||||
+ if not Sys.big_endian then set_int64_ne b i (swap64 x)
|
||||
+ else set_int64_ne b i x
|
||||
+
|
||||
+let set_uint8 = set_int8
|
||||
+let set_uint16_ne = set_int16_ne
|
||||
+let set_uint16_be = set_int16_be
|
||||
+let set_uint16_le = set_int16_le
|
||||
+
|
||||
+end
|
||||
+(* / *)
|
||||
+
|
||||
exception Error of string
|
||||
|
||||
type 'a t = {
|
||||
diff --git a/src/uicommon.ml b/src/uicommon.ml
|
||||
index 94fbc66ef..8a16270c3 100644
|
||||
--- uicommon.ml
|
||||
+++ uicommon.ml
|
||||
@@ -484,7 +484,7 @@ let addIgnorePattern theRegExp =
|
||||
module Stats = struct
|
||||
|
||||
let calcETA rem rate =
|
||||
- if Float.is_nan rate || Float.is_nan rem || rem < 0. then "" else
|
||||
+ if rate <> rate || rem <> rem || rem < 0. then "" else
|
||||
let t = truncate (rem /. rate +. 0.5) in
|
||||
(* Estimating the remaining time is not accurate. Reduce the display
|
||||
precision (and reduce more when longer time remaining). *)
|
||||
@@ -501,8 +501,8 @@ let calcETA rem rate =
|
||||
Printf.sprintf "%02d:%02d:%02d" h m sec
|
||||
|
||||
let movAvg curr prev ?(c = 1.) deltaTime avgPeriod =
|
||||
- if Float.is_nan prev then curr else
|
||||
- let a = c *. Float.min (1. -. exp (-. deltaTime /. avgPeriod)) 1. in
|
||||
+ if prev <> prev then curr else
|
||||
+ let a = c *. min (1. -. exp (-. deltaTime /. avgPeriod)) 1. in
|
||||
(* Simplified from a *. curr +. (1. -. a) *. prev *)
|
||||
prev +. a *. (curr -. prev)
|
||||
|
||||
@@ -525,7 +525,7 @@ let init totalToTransfer =
|
||||
let t0 = 0. in
|
||||
{ t0; t = t0; totalToComplete = Uutil.Filesize.toInt64 totalToTransfer;
|
||||
completed = 0L;
|
||||
- curRate = Float.nan; avgRateS = Float.nan; avgRateDoubleSGauss = Float.nan;
|
||||
+ curRate = nan; avgRateS = nan; avgRateDoubleSGauss = nan;
|
||||
}
|
||||
|
||||
let calcAvgRate' sta totTime deltaCompleted deltaTime =
|
||||
@@ -534,11 +534,11 @@ let calcAvgRate' sta totTime deltaCompleted deltaTime =
|
||||
changes (like switching from cache to disk or from disk to network
|
||||
of from receiving to sending or with wildly variable network speed). *)
|
||||
let avgRateS = movAvg curRate sta.avgRateS deltaTime
|
||||
- (Float.min_num totTime avgPeriodS) in
|
||||
+ (min totTime avgPeriodS) in
|
||||
let cpr = (avgRateS -. sta.avgRateDoubleSGauss) /. sta.avgRateDoubleSGauss in
|
||||
let c = 1. -. exp (-.(cpr ** 2.) /. gaussC) in
|
||||
let avgRateDoubleSGauss = movAvg avgRateS sta.avgRateDoubleSGauss ~c deltaTime
|
||||
- (Float.min_num totTime avgPeriodD) in
|
||||
+ (min totTime avgPeriodD) in
|
||||
sta.curRate <- curRate;
|
||||
sta.avgRateS <- avgRateS;
|
||||
sta.avgRateDoubleSGauss <- avgRateDoubleSGauss
|
||||
diff --git a/src/uitext.ml b/src/uitext.ml
|
||||
index 1c2e509d..fbb4f7f1 100644
|
||||
index 5d1513a03..fc1f8c716 100644
|
||||
--- uitext.ml
|
||||
+++ uitext.ml
|
||||
@@ -1621,7 +1621,6 @@ and breakRepeat = function
|
||||
@@ -833,7 +833,7 @@ let doTransport reconItemList numskip isSkip =
|
||||
else if v >= 100. then "00:00:00"
|
||||
else
|
||||
let rate = Uicommon.Stats.avgRate1 sta in
|
||||
- if Float.is_nan rate then "--:--"
|
||||
+ if rate <> rate then "--:--"
|
||||
else
|
||||
Format.sprintf "%8s/s %s"
|
||||
(Util.bytes2string (Int64.of_float rate))
|
||||
@@ -1692,7 +1692,6 @@ and breakRepeat = function
|
||||
| Assert_failure _
|
||||
| Match_failure _
|
||||
| Invalid_argument _
|
||||
@ -298,6 +473,3 @@ index 1c2e509d..fbb4f7f1 100644
|
||||
(* Async exceptions *)
|
||||
| Out_of_memory
|
||||
| Stack_overflow
|
||||
--
|
||||
2.39.2
|
||||
|
||||
|
||||
209
net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01
Normal file
209
net/unison/files/patch-ocaml_4.07-compat-copyquoterem-01
Normal file
@ -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
|
||||
54
net/unison/files/patch-ocaml_4.07-compat-copyquoterem-02
Normal file
54
net/unison/files/patch-ocaml_4.07-compat-copyquoterem-02
Normal file
@ -0,0 +1,54 @@
|
||||
From f9191b19dfaba01f5903ce36eb0258edef09964e Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= <toivol@gmail.com>
|
||||
Date: Tue, 25 Apr 2023 09:35:14 +0200
|
||||
Subject: [PATCH] Revert "Regen strings.ml"
|
||||
|
||||
This reverts commit 63963d80157346c2f3c9073f741bbd58e5c32545.
|
||||
---
|
||||
src/strings.ml | 19 +++++++++++++++++++
|
||||
1 file changed, 19 insertions(+)
|
||||
|
||||
diff --git a/src/strings.ml b/src/strings.ml
|
||||
index 6e853eb07..eb00eac5f 100644
|
||||
--- strings.ml
|
||||
+++ strings.ml
|
||||
@@ -1286,6 +1286,8 @@ let docs =
|
||||
\032 -copymax n maximum number of simultaneous copyprog transfers\n\
|
||||
\032 -copyprog xxx external program for copying large files\n\
|
||||
\032 -copyprogrest xxx variant of copyprog for resuming partial transfers\n\
|
||||
+ \032 -copyquoterem xxx add quotes to remote file name for copyprog\n\
|
||||
+ \032 (true/false/default)\n\
|
||||
\032 -copythreshold n use copyprog on files bigger than this (if >=0, in Kb)\n\
|
||||
\032 -diff xxx set command for showing differences between files\n\
|
||||
\032 -ignorelocks ignore locks left over from previous run (dangerous!)\n\
|
||||
@@ -1502,6 +1504,15 @@ let docs =
|
||||
\032 rsync). The default setting invokes rsync with appropriate\n\
|
||||
\032 options\226\128\148most users should not need to change it.\n\
|
||||
\n\
|
||||
+ \032 copyquoterem xxx\n\
|
||||
+ \032 When set to true, this flag causes Unison to add an extra layer\n\
|
||||
+ \032 of quotes to the remote path passed to the external copy\n\
|
||||
+ \032 program. This is needed by rsync, for example, which internally\n\
|
||||
+ \032 uses an ssh connection requiring an extra level of quoting for\n\
|
||||
+ \032 paths containing spaces. When this flag is set to default, extra\n\
|
||||
+ \032 quotes are added if the value of copyprog contains the string\n\
|
||||
+ \032 rsync.\n\
|
||||
+ \n\
|
||||
\032 copythreshold n\n\
|
||||
\032 A number indicating above what filesize (in kilobytes) Unison\n\
|
||||
\032 should use the external copying utility specified by copyprog.\n\
|
||||
@@ -3113,6 +3124,14 @@ let docs =
|
||||
\032 copyprog = rsync --inplace --compress\n\
|
||||
\032 copyprogrest = rsync --partial --inplace --compress\n\
|
||||
\n\
|
||||
+ \032 You may also need to set the copyquoterem preference. When it is set to\n\
|
||||
+ \032 true, this causes Unison to add an extra layer of quotes to the remote\n\
|
||||
+ \032 path passed to the external copy program. This is is needed by rsync,\n\
|
||||
+ \032 for example, which internally uses an ssh connection, requiring an\n\
|
||||
+ \032 extra level of quoting for paths containing spaces. When this flag is\n\
|
||||
+ \032 set to default, extra quotes are added if the value of copyprog\n\
|
||||
+ \032 contains the string rsync. The default value is default, naturally.\n\
|
||||
+ \n\
|
||||
\032 If a directory transfer is interrupted, the next run of Unison will\n\
|
||||
\032 automatically skip any files that were completely transferred before\n\
|
||||
\032 the interruption. (This behavior is always on: it does not depend on\n\
|
||||
@ -1,114 +0,0 @@
|
||||
--- ubase/umarshal.ml.orig 2022-10-30 19:42:39 UTC
|
||||
+++ ubase/umarshal.ml
|
||||
@@ -15,6 +15,111 @@
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*)
|
||||
|
||||
+(* OCaml 4.07 compatibility ONLY *)
|
||||
+module Bytes = struct
|
||||
+
|
||||
+include Bytes
|
||||
+
|
||||
+(* The following code is taken from OCaml sources.
|
||||
+ Authors of the code snippet: Alain Frisch and Daniel Bünzli *)
|
||||
+
|
||||
+(**************************************************************************)
|
||||
+(* *)
|
||||
+(* OCaml *)
|
||||
+(* *)
|
||||
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
||||
+(* *)
|
||||
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
||||
+(* en Automatique. *)
|
||||
+(* *)
|
||||
+(* All rights reserved. This file is distributed under the terms of *)
|
||||
+(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
+(* special exception on linking described in the file LICENSE. *)
|
||||
+(* *)
|
||||
+(**************************************************************************)
|
||||
+
|
||||
+(** {6 Binary encoding/decoding of integers} *)
|
||||
+
|
||||
+external get_uint8 : bytes -> int -> int = "%string_safe_get"
|
||||
+external get_uint16_ne : bytes -> int -> int = "%caml_string_get16"
|
||||
+external get_int32_ne : bytes -> int -> int32 = "%caml_string_get32"
|
||||
+external get_int64_ne : bytes -> int -> int64 = "%caml_string_get64"
|
||||
+external set_int8 : bytes -> int -> int -> unit = "%string_safe_set"
|
||||
+external set_int16_ne : bytes -> int -> int -> unit = "%caml_string_set16"
|
||||
+external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_string_set32"
|
||||
+external set_int64_ne : bytes -> int -> int64 -> unit = "%caml_string_set64"
|
||||
+external swap16 : int -> int = "%bswap16"
|
||||
+external swap32 : int32 -> int32 = "%bswap_int32"
|
||||
+external swap64 : int64 -> int64 = "%bswap_int64"
|
||||
+
|
||||
+let get_int8 b i =
|
||||
+ ((get_uint8 b i) lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
|
||||
+
|
||||
+let get_uint16_le b i =
|
||||
+ if Sys.big_endian then swap16 (get_uint16_ne b i)
|
||||
+ else get_uint16_ne b i
|
||||
+
|
||||
+let get_uint16_be b i =
|
||||
+ if not Sys.big_endian then swap16 (get_uint16_ne b i)
|
||||
+ else get_uint16_ne b i
|
||||
+
|
||||
+let get_int16_ne b i =
|
||||
+ ((get_uint16_ne b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int16_le b i =
|
||||
+ ((get_uint16_le b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int16_be b i =
|
||||
+ ((get_uint16_be b i) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
|
||||
+
|
||||
+let get_int32_le b i =
|
||||
+ if Sys.big_endian then swap32 (get_int32_ne b i)
|
||||
+ else get_int32_ne b i
|
||||
+
|
||||
+let get_int32_be b i =
|
||||
+ if not Sys.big_endian then swap32 (get_int32_ne b i)
|
||||
+ else get_int32_ne b i
|
||||
+
|
||||
+let get_int64_le b i =
|
||||
+ if Sys.big_endian then swap64 (get_int64_ne b i)
|
||||
+ else get_int64_ne b i
|
||||
+
|
||||
+let get_int64_be b i =
|
||||
+ if not Sys.big_endian then swap64 (get_int64_ne b i)
|
||||
+ else get_int64_ne b i
|
||||
+
|
||||
+let set_int16_le b i x =
|
||||
+ if Sys.big_endian then set_int16_ne b i (swap16 x)
|
||||
+ else set_int16_ne b i x
|
||||
+
|
||||
+let set_int16_be b i x =
|
||||
+ if not Sys.big_endian then set_int16_ne b i (swap16 x)
|
||||
+ else set_int16_ne b i x
|
||||
+
|
||||
+let set_int32_le b i x =
|
||||
+ if Sys.big_endian then set_int32_ne b i (swap32 x)
|
||||
+ else set_int32_ne b i x
|
||||
+
|
||||
+let set_int32_be b i x =
|
||||
+ if not Sys.big_endian then set_int32_ne b i (swap32 x)
|
||||
+ else set_int32_ne b i x
|
||||
+
|
||||
+let set_int64_le b i x =
|
||||
+ if Sys.big_endian then set_int64_ne b i (swap64 x)
|
||||
+ else set_int64_ne b i x
|
||||
+
|
||||
+let set_int64_be b i x =
|
||||
+ if not Sys.big_endian then set_int64_ne b i (swap64 x)
|
||||
+ else set_int64_ne b i x
|
||||
+
|
||||
+let set_uint8 = set_int8
|
||||
+let set_uint16_ne = set_int16_ne
|
||||
+let set_uint16_be = set_int16_be
|
||||
+let set_uint16_le = set_int16_le
|
||||
+
|
||||
+end
|
||||
+(* / *)
|
||||
+
|
||||
exception Error of string
|
||||
|
||||
type 'a t = {
|
||||
Loading…
Reference in New Issue
Block a user