cpet/openbsd-ports
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

a few patches from the unison cvs repo to improve stability

Browse Source 
from maintainer Zvezdan Petkovic <zpetkovic at acm.org>
This commit is contained in:
sturm 2005-05-30 19:27:45 +00:00
parent 2905908a69
commit 353cc18337
23 changed files with 757 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
net/unison/Makefile.inc
View File

@ -1,6 +1,7 @@
# $OpenBSD: Makefile.inc,v 1.1.1.1 2005/05/22 17:44:40 sturm Exp $
# $OpenBSD: Makefile.inc,v 1.2 2005/05/30 19:27:45 sturm Exp $
DISTNAME= unison-${VERSION}
PKGNAME= ${DISTNAME}p0
CATEGORIES= net
HOMEPAGE= http://www.cis.upenn.edu/~bcpierce/unison/

43
net/unison/snapshot/patches/patch-files_ml
View File

@ -1,8 +1,43 @@
$OpenBSD: patch-files_ml,v 1.1.1.1 2005/05/22 17:44:41 sturm Exp $
Fix the problem with comparison of files using diff
when the files are on two different hosts.
$OpenBSD: patch-files_ml,v 1.2 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix substitution of CURRENT1 and CURRENT2 in diff command.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000091.html
o Fix the problem with comparison of files using diff
when the files are on two different hosts.
See http://groups.yahoo.com/group/unison-users/message/3877
--- files.ml.orig Sat Mar 12 11:17:59 2005
+++ files.ml Sun May 22 08:13:59 2005
+++ files.ml Fri May 27 17:38:20 2005
@@ -429,8 +429,8 @@ let diffCmd =
^ "utility used to generate displays of file differences. The default "
^ "is `\\verb|diff|'. If the value of this preference contains the substrings "
^ "CURRENT1 and CURRENT2, these will be replaced by the names of the files to be "
- ^ "diffed. If not, the two filenames will be appended to the command (enclosed "
- ^ "in double quotes).")
+ ^ "diffed. If not, the two filenames will be appended to the command. In both "
+ ^ "cases, the filenames are suitably quoted.")
let quotes s = "'" ^ Util.replacesubstring s "'" "'\''" ^ "'"
@@ -442,14 +442,14 @@ let rec diff root1 path1 ui1 root2 path2
(root2string root2) (Path.toString path2));
let displayDiff fspath1 fspath2 =
let cmd =
- if Util.findsubstring (Prefs.read diffCmd) "CURRENT1" = None then
+ if Util.findsubstring "CURRENT1" (Prefs.read diffCmd) = None then
(Prefs.read diffCmd)
^ " " ^ (quotes (Fspath.toString fspath1))
- ^ " " ^ (quotes (Fspath.toString fspath2))
- else
+ ^ " " ^ (quotes (Fspath.toString fspath2))
+ else
Util.replacesubstrings (Prefs.read diffCmd)
- ["CURRENT1", (Fspath.toString fspath1);
- "CURRENT2", (Fspath.toString fspath2)] in
+ ["CURRENT1", quotes (Fspath.toString fspath1);
+ "CURRENT2", quotes (Fspath.toString fspath2)] in
let c = Unix.open_process_in cmd in
showDiff cmd (readChannelTillEof c);
ignore(Unix.close_process_in c) in
@@ -476,7 +476,7 @@ let rec diff root1 path1 ui1 root2 path2
(Update.translatePath root2 path2 >>= (fun path2 ->
Copy.file root2 path2 root1 workingDir tmppath realPath

52
net/unison/snapshot/patches/patch-os_ml Normal file
View File

@ -0,0 +1,52 @@
$OpenBSD: patch-os_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch and port maintainer patch.
o Properly deal with empty directories under Windows
(workaround for a bug in Ocaml).
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Fix the failure of Windows client when a file is read-only.
Approved by developers.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000087.html
--- os.ml.orig Sat Mar 12 11:17:58 2005
+++ os.ml Fri May 27 17:28:31 2005
@@ -150,10 +150,23 @@ and childrenOf fspath path =
loop newChildren directory
in
let absolutePath = Fspath.concat fspath path in
- let directory = Fspath.opendir absolutePath in
- let result = loop [] directory in
- Unix.closedir directory;
- result)
+ let directory =
+ try
+ Some (Fspath.opendir absolutePath)
+ with Unix.Unix_error (Unix.ENOENT, _, _) ->
+ (* FIX (in Ocaml): under Windows, when a directory is empty
+ (not even "." and ".."), FindFirstFile fails with
+ ERROR_FILE_NOT_FOUND while ocaml expects the error
+ ERROR_NO_MORE_FILES *)
+ None
+ in
+ match directory with
+ Some directory ->
+ let result = loop [] directory in
+ Unix.closedir directory;
+ result
+ | None ->
+ [])
(*****************************************************************************)
(* ACTIONS ON FILESYSTEM *)
@@ -175,8 +188,11 @@ and delete fspath path =
(childrenOf fspath path);
Unix.rmdir absolutePath
| `FILE ->
- if Util.osType <> `Unix then
- Unix.chmod absolutePath 0o600;
+ if Util.osType <> `Unix then begin
+ try
+ Unix.chmod absolutePath 0o600;
+ with Unix.Unix_error _ -> ()
+ end;
Unix.unlink absolutePath;
if Prefs.read Osx.rsrc then begin
let pathDouble = Osx.appleDoubleFile fspath path in

20
net/unison/snapshot/patches/patch-osx_ml Normal file
View File

@ -0,0 +1,20 @@
$OpenBSD: patch-osx_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
Fix the Mac OS X client problem.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000076.html
--- osx.ml.orig Sat Mar 12 11:17:59 2005
+++ osx.ml Mon May 23 13:50:28 2005
@@ -386,9 +386,10 @@ let ressDummy = NoRess
let openRessIn fspath path =
Util.convertUnixErrorsToTransient "reading ressource fork" (fun () ->
try
- open_in_gen
- [Open_rdonly; Open_binary] 0o444
- (Fspath.concatToString fspath (ressPath path))
+ Unix.in_channel_of_descr
+ (Unix.openfile
+ (Fspath.concatToString fspath (ressPath path))
+ [Unix.O_RDONLY] 0o444)
with Unix.Unix_error (Unix.ENOTDIR, _, _) ->
let (doublePath, inch, entries) = openDouble fspath path in
try

26
net/unison/snapshot/patches/patch-props_ml Normal file
View File

@ -0,0 +1,26 @@
$OpenBSD: patch-props_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix in property setting. In particular, set properties in the right order.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000091.html
--- props.ml.orig Sat Mar 12 11:17:59 2005
+++ props.ml Fri May 27 17:31:10 2005
@@ -421,7 +421,7 @@ let syncedPartsToString t = match t with
let iCanWrite p =
try
- Unix.access p [Unix.R_OK];
+ Unix.access p [Unix.W_OK];
true
with
Unix.Unix_error _ -> false
@@ -625,8 +625,8 @@ let set fspath path kind p =
Uid.set fspath path kind p.uid;
Gid.set fspath path kind p.gid;
TypeCreator.set fspath path kind p.typeCreator;
- Perm.set fspath path kind p.perm;
- Time.set fspath path kind p.time
+ Time.set fspath path kind p.time;
+ Perm.set fspath path kind p.perm
let init someHostIsRunningWindows =
Perm.init someHostIsRunningWindows;

49
net/unison/snapshot/patches/patch-ubase_util_ml Normal file
View File

@ -0,0 +1,49 @@
$OpenBSD: patch-ubase_util_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Catch failure of localtime library call.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Fix the order of looking for home directory.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000088.html
--- ubase/util.ml.orig Sat Mar 12 11:17:58 2005
+++ ubase/util.ml Fri May 27 18:07:18 2005
@@ -244,14 +244,18 @@ let time () =
convertUnixErrorsToTransient "time" Unix.time
let time2string timef =
- let time = localtime timef in
- Printf.sprintf
- "%2d:%.2d on %2d %3s, %4d"
- time.Unix.tm_hour
- time.Unix.tm_min
- time.Unix.tm_mday
- (monthname time.Unix.tm_mon)
- (time.Unix.tm_year + 1900)
+ try
+ let time = localtime timef in
+ Printf.sprintf
+ "%2d:%.2d:%.2d on %2d %3s, %4d"
+ time.Unix.tm_hour
+ time.Unix.tm_min
+ time.Unix.tm_sec
+ time.Unix.tm_mday
+ (monthname time.Unix.tm_mon)
+ (time.Unix.tm_year + 1900)
+ with Transient _ ->
+ "(invalid date)"
let percentageOfTotal current total =
(int_of_float ((float current) *. 100.0 /. (float total)))
@@ -364,11 +368,11 @@ let fileInHomeDir n =
Filename.concat (safeGetenv "HOME") n
else if osType = `Win32 then
let dirString =
- try Unix.getenv "UNISON" (* Use UNISON dir if it is set *)
+ try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *)
with Not_found ->
try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *)
with Not_found ->
- try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *)
+ try Unix.getenv "UNISON" (* Use UNISON dir if it is set *)
with Not_found ->
"c:/" (* Default *) in
Filename.concat dirString n

43
net/unison/snapshot/patches/patch-uicommon_ml Normal file
View File

@ -0,0 +1,43 @@
$OpenBSD: patch-uicommon_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Correct quoting of ignored patterns generated by the UI.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
--- uicommon.ml.orig Sat Mar 12 11:17:58 2005
+++ uicommon.ml Fri May 27 17:29:02 2005
@@ -275,26 +275,28 @@ let quote s =
| c ->
buf.[!pos] <- c; pos := !pos + 1
done;
- String.sub buf 0 !pos
+ "{" ^ String.sub buf 0 !pos ^ "}"
-let ignorePath path = "Path " ^ (quote (Path.toString path))
+let ignorePath path = "Path " ^ quote (Path.toString path)
let ignoreName path =
match Path.finalName path with
- Some name -> "Name " ^ (quote (Name.toString name))
+ Some name -> "Name " ^ quote (Name.toString name)
| None -> assert false
let ignoreExt path =
match Path.finalName path with
Some name ->
let str = Name.toString name in
- (try
- let pos = String.rindex str '.' + 1 in
+ begin try
+ let pos = String.rindex str '.' in
let ext = String.sub str pos (String.length str - pos) in
- "Name *." ^ (quote ext)
+ "Name {,.}*" ^ quote ext
with Not_found -> (* str does not contain '.' *)
- "Name "^(quote str))
- | None -> assert false
+ "Name " ^ quote str
+ end
+ | None ->
+ assert false
let addIgnorePattern theRegExp =
if theRegExp = "Path " then

16
net/unison/snapshot/patches/patch-uigtk2_ml Normal file
View File

@ -0,0 +1,16 @@
$OpenBSD: patch-uigtk2_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Disable password prompting code (broken in 2.12.0).
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000091.html
--- uigtk2.ml.orig Sat Mar 12 11:17:59 2005
+++ uigtk2.ml Fri May 27 17:30:45 2005
@@ -745,8 +745,7 @@ let termInteract() =
match Uicommon.sshParse s with
Uicommon.Password account -> getPassword account
| _ -> "" in
- if Osx.isMacOSX or Osx.isLinux then Some handleSSH
- else None
+ None
(* ------ *)

15
net/unison/snapshot/patches/patch-uitext_ml Normal file
View File

@ -0,0 +1,15 @@
$OpenBSD: patch-uitext_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Missing call to restoreTerminal.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
--- uitext.ml.orig Sat Mar 12 11:17:59 2005
+++ uitext.ml Fri May 27 17:29:54 2005
@@ -426,6 +426,8 @@ let setWarnPrinter() =
(["n";"q";"x"],
("Exit"),
fun()->
+ alwaysDisplay "\n";
+ restoreTerminal ();
Lwt_unix.run (Update.unlockArchives ());
exit 1)]
(fun()-> display "Press return to continue.")

38
net/unison/snapshot/patches/patch-update_ml Normal file
View File

@ -0,0 +1,38 @@
$OpenBSD: patch-update_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Better error message for non-existing paths.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Update archive timestamps to avoid defeating fastcheck on Windows.
See http://groups.yahoo.com/group/unison-users/message/3821
--- update.ml.orig Sat Mar 12 11:17:58 2005
+++ update.ml Fri May 27 17:27:12 2005
@@ -1587,7 +1587,6 @@ and buildUpdateRec archive currfspath pa
let rec buildUpdate archive fspath fullpath here path =
match Path.deconstruct path with
None ->
- Os.checkThatParentPathIsADir fspath here;
showStatus path;
let (arch, ui) =
buildUpdateRec archive fspath here (useFastChecking()) in
@@ -1597,6 +1596,12 @@ let rec buildUpdate archive fspath fullp
end,
ui)
| Some(name, path') ->
+ if not (isDir fspath here) then
+ (archive,
+ Error (Printf.sprintf
+ "path %s is not valid because %s is not a directory"
+ (Path.toString fullpath) (Path.toString here)))
+ else
let children = getChildren fspath here in
let (name', status) =
try
@@ -1634,7 +1639,7 @@ let rec buildUpdate archive fspath fullp
Note that we may also put NoArchive deep inside an
archive...
*)
- (ArchiveDir (desc, NameMap.add name' child otherChildren),
+ (ArchiveDir (desc, NameMap.add name' arch otherChildren),
updates)
(* for the given path, find the archive and compute the list of update

87
net/unison/stable/patches/patch-copy_ml Normal file
View File

@ -0,0 +1,87 @@
$OpenBSD: patch-copy_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the file open in text mode instead of binary.
See http://groups.yahoo.com/group/unison-users/message/3184
and http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000089.html
o Fix the Windows client hang problem.
See http://groups.yahoo.com/group/unison-users/message/2885
--- copy.ml.orig Mon Sep 6 15:15:47 2004
+++ copy.ml Mon May 23 16:26:18 2005
@@ -10,14 +10,16 @@ let debug = Trace.debug "copy"
let openFileIn fspath path kind =
match kind with
- `DATA -> Unix.openfile (Fspath.concatToString fspath path)
- [Unix.O_RDONLY] 0o444
+ `DATA -> Unix.descr_of_in_channel
+ (open_in_gen [Open_rdonly; Open_binary] 0o444
+ (Fspath.concatToString fspath path))
| `RESS _ -> Osx.openRessIn fspath path
let openFileOut fspath path kind =
match kind with
- `DATA -> Unix.openfile (Fspath.concatToString fspath path)
- [Unix.O_WRONLY;Unix.O_CREAT;Unix.O_EXCL] 0o600
+ `DATA -> Unix.descr_of_out_channel
+ (open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary]
+ 0o600 (Fspath.concatToString fspath path))
| `RESS len -> Osx.openRessOut fspath path len
let protect f g =
@@ -260,10 +262,9 @@ let reallyTransmitFile
fspathTo pathTo realPathTo `DATA update srcFileSize id file_id
>>= (fun (outfd, infd, bi) ->
Lwt.catch (fun () ->
- Lwt_util.run_in_region transmitFileReg (bufferSize srcFileSize) (fun () ->
- Uutil.showProgress id Uutil.Filesize.zero "f";
- compressRemotely connFrom
- (bi, fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id))
+ Uutil.showProgress id Uutil.Filesize.zero "f";
+ compressRemotely connFrom
+ (bi, fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id)
>>= (fun () ->
decompressor :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
@@ -281,16 +282,15 @@ let reallyTransmitFile
(`RESS ressLength) update ressLength id file_id
>>= (fun (outfd, infd, bi) ->
Lwt.catch (fun () ->
- Lwt_util.run_in_region transmitFileReg (bufferSize ressLength) (fun () ->
- Uutil.showProgress id Uutil.Filesize.zero "f";
- compressRemotely connFrom
- (bi, fspathFrom, pathFrom,
- `RESS ressLength, ressLength, id, file_id))
- >>= (fun () ->
- decompressor :=
- Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
- close_all infd outfd;
- Lwt.return ()))
+ Uutil.showProgress id Uutil.Filesize.zero "f";
+ compressRemotely connFrom
+ (bi, fspathFrom, pathFrom,
+ `RESS ressLength, ressLength, id, file_id)
+ >>= (fun () ->
+ decompressor :=
+ Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
+ close_all infd outfd;
+ Lwt.return ()))
(fun e ->
decompressor :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
@@ -367,9 +367,13 @@ let transmitFileOnRoot =
let transmitFile
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id =
- transmitFileOnRoot rootTo rootFrom
- (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
- update, desc, fp, ress, id)
+ let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in
+ (* This must be on the client: any lock on the server side may result
+ in a deadlock under windows *)
+ Lwt_util.run_in_region transmitFileReg bufSz (fun () ->
+ transmitFileOnRoot rootTo rootFrom
+ (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
+ update, desc, fp, ress, id))
(****)

22
net/unison/stable/patches/patch-files_ml
View File

@ -1,22 +1,28 @@
$OpenBSD: patch-files_ml,v 1.1.1.1 2005/05/22 17:44:41 sturm Exp $
Fix the problem with comparison of files using diff
when the files are on two different hosts.
$OpenBSD: patch-files_ml,v 1.2 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the problem with comparison of files using diff
when the files are on two different hosts.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000067.html
--- files.ml.orig Mon Sep 6 15:15:46 2004
+++ files.ml Sun May 22 07:58:42 2005
@@ -470,7 +470,7 @@ let rec diff root1 path1 ui1 root2 path2
+++ files.ml Sun May 22 16:13:36 2005
@@ -469,8 +469,8 @@ let rec diff root1 path1 ui1 root2 path2
Lwt_unix.run
(Update.translatePath root2 path2 >>= (fun path2 ->
Copy.file root2 path2 root1 workingDir tmppath realPath
`Copy (Props.setLength Props.fileSafe (Props.length desc1))
- `Copy (Props.setLength Props.fileSafe (Props.length desc1))
- fp1 ress1 id));
+ `Copy (Props.setLength Props.fileSafe (Props.length desc2))
+ fp2 ress2 id));
displayDiff
(Fspath.concat workingDir realPath)
(Fspath.concat workingDir tmppath);
@@ -488,7 +488,7 @@ let rec diff root1 path1 ui1 root2 path2
@@ -487,8 +487,8 @@ let rec diff root1 path1 ui1 root2 path2
(Update.translatePath root1 path1 >>= (fun path1 ->
(* Note that we don't need the ressource fork *)
Copy.file root1 path1 root2 workingDir tmppath realPath
`Copy (Props.setLength Props.fileSafe (Props.length desc2))
- `Copy (Props.setLength Props.fileSafe (Props.length desc2))
- fp2 ress2 id));
+ `Copy (Props.setLength Props.fileSafe (Props.length desc1))
+ fp1 ress1 id));
displayDiff
(Fspath.concat workingDir tmppath)

16
net/unison/stable/patches/patch-fingerprint_ml Normal file
View File

@ -0,0 +1,16 @@
$OpenBSD: patch-fingerprint_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the file open in text mode instead of binary.
See http://groups.yahoo.com/group/unison-users/message/3184
and http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000089.html
--- fingerprint.ml.orig Mon Sep 6 15:15:47 2004
+++ fingerprint.ml Mon May 23 16:30:14 2005
@@ -22,7 +22,7 @@ let subfile path offset len =
Util.convertUnixErrorsToTransient
"digesting subfile"
(fun () ->
- let inch = open_in path in
+ let inch = open_in_bin path in
LargeFile.seek_in inch offset;
begin try
let res = Digest.channel inch (Uutil.Filesize.toInt len) in

60
net/unison/stable/patches/patch-os_ml Normal file
View File

@ -0,0 +1,60 @@
$OpenBSD: patch-os_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Properly deal with empty directories under Windows
(workaround for a bug in Ocaml).
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Fix the failure of Windows client when directory or file are read-only.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000075.html
--- os.ml.orig Mon Sep 6 15:15:46 2004
+++ os.ml Fri May 27 16:37:03 2005
@@ -150,10 +150,23 @@ and childrenOf fspath path =
loop newChildren directory
in
let absolutePath = Fspath.concat fspath path in
- let directory = Fspath.opendir absolutePath in
- let result = loop [] directory in
- Unix.closedir directory;
- result)
+ let directory =
+ try
+ Some (Fspath.opendir absolutePath)
+ with Unix.Unix_error (Unix.ENOENT, _, _) ->
+ (* FIX (in Ocaml): under Windows, when a directory is empty
+ (not even "." and ".."), FindFirstFile fails with
+ ERROR_FILE_NOT_FOUND while ocaml expects the error
+ ERROR_NO_MORE_FILES *)
+ None
+ in
+ match directory with
+ Some directory ->
+ let result = loop [] directory in
+ Unix.closedir directory;
+ result
+ | None ->
+ [])
(*****************************************************************************)
(* ACTIONS ON FILESYSTEM *)
@@ -167,14 +180,19 @@ and delete fspath path =
let absolutePath = Fspath.concatToString fspath path in
match (Fileinfo.get false fspath path).Fileinfo.typ with
`DIRECTORY ->
- Unix.chmod absolutePath 0o700;
+ begin try
+ Unix.chmod absolutePath 0o700
+ with Unix.Unix_error _ -> () end;
Safelist.iter
(fun child -> delete fspath (Path.child path child))
(childrenOf fspath path);
Unix.rmdir absolutePath
| `FILE ->
- if Util.osType <> `Unix then
- Unix.chmod absolutePath 0o600;
+ if Util.osType <> `Unix then begin
+ try
+ Unix.chmod absolutePath 0o600;
+ with Unix.Unix_error _ -> ()
+ end;
Unix.unlink absolutePath;
if Prefs.read Osx.rsrc then begin
let pathDouble = Osx.appleDoubleFile fspath path in

27
net/unison/stable/patches/patch-props_ml Normal file
View File

@ -0,0 +1,27 @@
$OpenBSD: patch-props_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix in property setting. In particular, set properties in the right order.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000090.html
--- props.ml.orig Mon Sep 6 15:15:46 2004
+++ props.ml Fri May 27 16:28:48 2005
@@ -421,7 +421,7 @@ let syncedPartsToString t = match t with
let iCanWrite p =
try
- Unix.access p [Unix.R_OK];
+ Unix.access p [Unix.W_OK];
true
with
Unix.Unix_error _ -> false
@@ -615,9 +615,9 @@ let get stats infos =
let set fspath path kind p =
Uid.set fspath path kind p.uid;
Gid.set fspath path kind p.gid;
- Perm.set fspath path kind p.perm;
+ TypeCreator.set fspath path kind p.typeCreator;
Time.set fspath path kind p.time;
- TypeCreator.set fspath path kind p.typeCreator
+ Perm.set fspath path kind p.perm
let init someHostIsRunningWindows =
Perm.init someHostIsRunningWindows;

16
net/unison/stable/patches/patch-transport_ml Normal file
View File

@ -0,0 +1,16 @@
$OpenBSD: patch-transport_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the assert failure on all platforms.
See http://groups.yahoo.com/group/unison-users/message/3200
--- transport.ml.orig Mon Sep 6 15:15:46 2004
+++ transport.ml Sun May 22 16:14:32 2005
@@ -15,7 +15,8 @@ let fileSize uiFrom uiTo =
match uiFrom, uiTo with
_, Updates (File (props, ContentsUpdated (_, _, ress)), _) ->
(Props.length props, Osx.ressLength ress)
- | Updates (File _, Previous (_, props, _, ress)), NoUpdates ->
+ | Updates (_, Previous (`FILE, props, _, ress)),
+ (NoUpdates | Updates (File (_, ContentsSame), _)) ->
(Props.length props, Osx.ressLength ress)
| _ ->
assert false

69
net/unison/stable/patches/patch-ubase_util_ml Normal file
View File

@ -0,0 +1,69 @@
$OpenBSD: patch-ubase_util_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Catch failure of localtime library call.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Fix the order of looking for home directory.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000088.html
--- ubase/util.ml.orig Mon Sep 6 15:15:47 2004
+++ ubase/util.ml Fri May 27 16:59:57 2005
@@ -244,14 +244,18 @@ let time () =
convertUnixErrorsToTransient "time" Unix.time
let time2string timef =
- let time = localtime timef in
- Printf.sprintf
- "%2d:%.2d on %2d %3s, %4d"
- time.Unix.tm_hour
- time.Unix.tm_min
- time.Unix.tm_mday
- (monthname time.Unix.tm_mon)
- (time.Unix.tm_year + 1900)
+ try
+ let time = localtime timef in
+ Printf.sprintf
+ "%2d:%.2d:%.2d on %2d %3s, %4d"
+ time.Unix.tm_hour
+ time.Unix.tm_min
+ time.Unix.tm_sec
+ time.Unix.tm_mday
+ (monthname time.Unix.tm_mon)
+ (time.Unix.tm_year + 1900)
+ with Transient _ ->
+ "(invalid date)"
let percentageOfTotal current total =
(int_of_float ((float current) *. 100.0 /. (float total)))
@@ -355,19 +359,20 @@ let padto n s = s ^ (String.make (max 0
(*****************************************************************************)
let fileInHomeDir n =
- match osType with
- `Win32 ->
- let dirString =
- try Unix.getenv "USERPROFILE" (* Windows NT/2K *)
- with Not_found ->
- try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *)
- with Not_found ->
- try Unix.getenv "UNISON" (* Use UNISON dir if none of
- the above are set *)
- with Not_found -> "c:/" (* Default *) in
- Filename.concat dirString n
- | `Unix ->
- Filename.concat (safeGetenv "HOME") n
+ if osType = `Unix || isCygwin then
+ Filename.concat (safeGetenv "HOME") n
+ else if osType = `Win32 then
+ let dirString =
+ try Unix.getenv "USERPROFILE" (* Windows NT/2K *)
+ with Not_found ->
+ try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *)
+ with Not_found ->
+ try Unix.getenv "UNISON" (* Use UNISON dir if none of
+ the above are set *)
+ with Not_found -> "c:/" (* Default *) in
+ Filename.concat dirString n
+ else
+ assert false (* osType can't be anything else *)
(*****************************************************************************)
(* "Upcall" for building pathnames in the .unison dir *)

43
net/unison/stable/patches/patch-uicommon_ml Normal file
View File

@ -0,0 +1,43 @@
$OpenBSD: patch-uicommon_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Correct quoting of ignored patterns generated by the UI.
http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
--- uicommon.ml.orig Mon Sep 6 15:15:46 2004
+++ uicommon.ml Fri May 27 16:37:26 2005
@@ -268,26 +268,28 @@ let quote s =
| c ->
buf.[!pos] <- c; pos := !pos + 1
done;
- String.sub buf 0 !pos
+ "{" ^ String.sub buf 0 !pos ^ "}"
-let ignorePath path = "Path " ^ (quote (Path.toString path))
+let ignorePath path = "Path " ^ quote (Path.toString path)
let ignoreName path =
match Path.finalName path with
- Some name -> "Name " ^ (quote (Name.toString name))
+ Some name -> "Name " ^ quote (Name.toString name)
| None -> assert false
let ignoreExt path =
match Path.finalName path with
Some name ->
let str = Name.toString name in
- (try
- let pos = String.rindex str '.' + 1 in
+ begin try
+ let pos = String.rindex str '.' in
let ext = String.sub str pos (String.length str - pos) in
- "Name *." ^ (quote ext)
+ "Name {,.}*" ^ quote ext
with Not_found -> (* str does not contain '.' *)
- "Name "^(quote str))
- | None -> assert false
+ "Name " ^ quote str
+ end
+ | None ->
+ assert false
let addIgnorePattern theRegExp =
if theRegExp = "Path " then

16
net/unison/stable/patches/patch-uigtk2_ml Normal file
View File

@ -0,0 +1,16 @@
$OpenBSD: patch-uigtk2_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Disable password prompting code (broken in 2.10.2)
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000090.html
--- uigtk2.ml.orig Mon Sep 6 15:15:46 2004
+++ uigtk2.ml Fri May 27 16:26:01 2005
@@ -745,8 +745,7 @@ let termInteract() =
match Uicommon.sshParse s with
Uicommon.Password account -> getPassword account
| _ -> "" in
- if Osx.isMacOSX or Osx.isLinux then Some handleSSH
- else None
+ None
(* ------ *)

8
net/unison/stable/patches/patch-uigtk_ml
View File

@ -1,5 +1,9 @@
$OpenBSD: patch-uigtk_ml,v 1.1.1.1 2005/05/22 17:44:41 sturm Exp $
Fix compilation with GTK 1.
$OpenBSD: patch-uigtk_ml,v 1.2 2005/05/30 19:27:45 sturm Exp $
Post release port maintainer fix.
o Fix compilation with GTK 1.
Applied the same approach used in beta version by developers.
Approved by developers.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000074.html
--- uigtk.ml.orig Mon Sep 6 15:15:46 2004
+++ uigtk.ml Tue May 17 02:21:59 2005
@@ -1606,7 +1606,7 @@ in

15
net/unison/stable/patches/patch-uitext_ml Normal file
View File

@ -0,0 +1,15 @@
$OpenBSD: patch-uitext_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Missing call to restoreTerminal.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
--- uitext.ml.orig Mon Sep 6 15:15:46 2004
+++ uitext.ml Fri May 27 17:01:29 2005
@@ -423,6 +423,8 @@ let setWarnPrinter() =
(["n";"q";"x"],
("Exit"),
fun()->
+ alwaysDisplay "\n";
+ restoreTerminal ();
Lwt_unix.run (Update.unlockArchives ());
exit 1)]
(fun()-> display "Press return to continue.")

73
net/unison/stable/patches/patch-update_ml Normal file
View File

@ -0,0 +1,73 @@
$OpenBSD: patch-update_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the file open in text mode instead of binary.
See http://groups.yahoo.com/group/unison-users/message/3184
and http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000089.html
o Better error message for non-existing paths.
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000092.html
o Update archive timestamps to avoid defeating fastcheck on Windows.
See http://groups.yahoo.com/group/unison-users/message/3821
--- update.ml.orig Mon Sep 6 15:15:46 2004
+++ update.ml Fri May 27 16:33:58 2005
@@ -347,13 +347,25 @@ let postCommitArchiveLocal (fspath,())
let fto = Fspath.toString (Os.fileInUnisonDir toname) in
debug (fun() -> Util.msg "Copying archive %s to %s\n" ffrom fto);
Util.convertUnixErrorsToFatal "copying archive" (fun () ->
- let outFd = Unix.openfile fto
- [Unix.O_RDWR;Unix.O_CREAT;Unix.O_TRUNC] 0o600 in
+ let outFd =
+ open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary]
+ 0o600 fto
+ in
Unix.chmod fto 0o600; (* In case the file already existed *)
- let inFd = Unix.openfile ffrom [Unix.O_RDONLY] 0o444 in
- Uutil.readWrite inFd outFd (fun _ -> ());
- Unix.close inFd;
- Unix.close outFd;
+ let inFd = open_in_bin ffrom in
+ let bufsize = 10000 in
+ let buf = String.create bufsize in
+
+ let rec read () =
+ let n = input inFd buf 0 bufsize in
+ if n>0 then begin
+ output outFd buf 0 n;
+ read()
+ end
+ in
+ read ();
+ close_in inFd;
+ close_out outFd;
let arcFspath = Os.fileInUnisonDir toname in
let info = Fileinfo.get false arcFspath Path.empty in
Hashtbl.replace archiveInfoCache thisRoot info))
@@ -1578,7 +1590,6 @@ and buildUpdateRec archive currfspath pa
let rec buildUpdate archive fspath fullpath here path =
match Path.deconstruct path with
None ->
- Os.checkThatParentPathIsADir fspath here;
showStatus path;
let (arch, ui) =
buildUpdateRec archive fspath here (useFastChecking()) in
@@ -1588,6 +1599,12 @@ let rec buildUpdate archive fspath fullp
end,
ui)
| Some(name, path') ->
+ if not (isDir fspath here) then
+ (archive,
+ Error (Printf.sprintf
+ "path %s is not valid because %s is not a directory"
+ (Path.toString fullpath) (Path.toString here)))
+ else
let children = getChildren fspath here in
let (name', status) =
try
@@ -1625,7 +1642,7 @@ let rec buildUpdate archive fspath fullp
Note that we may also put NoArchive deep inside an
archive...
*)
- (ArchiveDir (desc, NameMap.add name' child otherChildren),
+ (ArchiveDir (desc, NameMap.add name' arch otherChildren),
updates)
(* for the given path, find the archive and compute the list of update

15
net/unison/stable/patches/patch-uutil_ml Normal file
View File

@ -0,0 +1,15 @@
$OpenBSD: patch-uutil_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Use aligned writes for better performance (especially on USB devices).
See http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000090.html
--- uutil.ml.orig Mon Sep 6 15:15:47 2004
+++ uutil.ml Fri May 27 16:26:08 2005
@@ -83,7 +83,7 @@ let showProgress i bytes ch =
(* Copy bytes from one file_desc to another *)
(*****************************************************************************)
-let bufsize = 10000
+let bufsize = 16384
let bufsizeFS = Filesize.ofInt bufsize
let buf = String.create bufsize