[Unison-hackers] [unison-svn] r404 - in trunk/src: . uimacnew uimacnew09
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Tue Jan 19 04:18:16 EST 2010
Author: vouillon
Date: 2010-01-19 04:18:15 -0500 (Tue, 19 Jan 2010)
New Revision: 404
Modified:
trunk/src/RECENTNEWS
trunk/src/mkProjectInfo.ml
trunk/src/osx.ml
trunk/src/remote.ml
trunk/src/uicommon.ml
trunk/src/uigtk2.ml
trunk/src/uimacnew/Bridge.m
trunk/src/uimacnew/MyController.m
trunk/src/uimacnew09/Bridge.m
trunk/src/uimacnew09/MyController.m
trunk/src/uitext.ml
Log:
* Made a server waiting on a socket more resilient to unexpected
lost connections from the client.
* Fixed possible race condition in half-duplex communication mode.
* Minor other changes...
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/RECENTNEWS 2010-01-19 09:18:15 UTC (rev 404)
@@ -1,5 +1,13 @@
CHANGES FROM VERSION 2.39.6
+* Made a server waiting on a socket more resilient to unexpected
+ lost connections from the client.
+* Fixed possible race condition in half-duplex communication mode.
+* Minor other changes...
+
+-------------------------------
+CHANGES FROM VERSION 2.39.6
+
* Implemented 'partial' versions of 'noupdate', 'nodeletion' and 'nocreation'
* Check sooner (before connecting to another machine) that the roots
given as argument to all these preference are well-formed
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/mkProjectInfo.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -97,3 +97,4 @@
Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;;
Printf.printf "NAME=%s\n" projectName;;
+
Modified: trunk/src/osx.ml
===================================================================
--- trunk/src/osx.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/osx.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -15,6 +15,11 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
+(*
+See
+http://www.opensource.apple.com/source/copyfile/copyfile-42/copyfile.c
+*)
+
let debug = Trace.debug "osx"
(****)
Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/remote.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -33,6 +33,10 @@
Scanf.sscanf Sys.ocaml_version "%d.%d"
(fun maj min -> (maj = 3 && min >= 11) || maj > 3)
+let _ =
+ if Sys.os_type = "Unix" then
+ ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore)
+
(*
Flow-control mechanism (only active under Windows).
Only one side is allowed to send messages at any given time.
@@ -95,7 +99,10 @@
| Unix.Unix_error(Unix.EPIPE, _, _)
(* Windows may also return the following errors... *)
| Unix.Unix_error(Unix.EINVAL, _, _)
- | Unix.Unix_error(Unix.EUNKNOWNERR (-64), _, _) ->
+ | Unix.Unix_error(Unix.EUNKNOWNERR (-64), _, _)
+ (* ERROR_NETNAME_DELETED *)
+ | Unix.Unix_error(Unix.EUNKNOWNERR (-233), _, _) ->
+ (* ERROR_PIPE_NOT_CONNECTED *)
(* Client has closed its end of the connection *)
lostConnection ()
| _ ->
@@ -113,14 +120,16 @@
type ioBuffer =
{ channel : Lwt_unix.file_descr;
buffer : string;
- mutable length : int }
+ mutable length : int;
+ mutable opened : bool }
let bufferSize = 16384
(* No point in making this larger, as the Ocaml Unix library uses a
buffer of this size *)
let makeBuffer ch =
- { channel = ch; buffer = String.create bufferSize; length = 0 }
+ { channel = ch; buffer = String.create bufferSize;
+ length = 0; opened = true }
(****)
@@ -176,7 +185,11 @@
let rec sendOutput conn =
catchIoErrors
(fun () ->
- Lwt_unix.write conn.channel conn.buffer 0 conn.length >>= fun len ->
+ begin if conn.opened then
+ Lwt_unix.write conn.channel conn.buffer 0 conn.length
+ else
+ Lwt.return conn.length
+ end >>= fun len ->
debugV (fun() ->
Util.msg "dump: %s\n"
(String.escaped (String.sub conn.buffer 0 len)));
@@ -236,10 +249,6 @@
let rec performOutputRec q (kind, action, res) =
action () >>= fun () ->
- if kind = Last then begin
- assert (q.canWrite);
- if q.flowControl then q.canWrite <- false
- end;
Lwt.wakeup res ();
popOutputQueues q
@@ -321,6 +330,7 @@
(fun () ->
if q.flowControl then begin
debugE (fun() -> Util.msg "Sending write token\n");
+ q.canWrite <- false;
fillBuffer buf [encodeInt 0] >>= fun () ->
flushBuffer buf
end else
@@ -975,8 +985,6 @@
(****)
let initConnection in_ch out_ch =
- if not windowsHack then
- ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore);
let conn = setupIO false in_ch out_ch in
checkHeader
conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () ->
@@ -992,6 +1000,13 @@
None -> findFirst f r
| Some _ as v -> Lwt.return v
+let printAddr host addr =
+ match addr with
+ Unix.ADDR_UNIX s ->
+ assert false
+ | Unix.ADDR_INET (s, p) ->
+ Format.sprintf "%s[%s]:%d" host (Unix.string_of_inet_addr s) p
+
let buildSocket host port kind =
let attemptCreation ai =
Lwt.catch
@@ -1033,8 +1048,9 @@
let msg =
match kind with
`Connect ->
- Printf.sprintf "Can't connect to server (%s:%s): %s"
- host port (Unix.error_message error)
+ Printf.sprintf "Can't connect to server %s: %s\n"
+ (printAddr host ai.Unix.ai_addr)
+ (Unix.error_message error)
| `Bind ->
Printf.sprintf
"Can't bind socket to port %s at address [%s]: %s\n"
@@ -1066,7 +1082,7 @@
match kind with
`Connect ->
Printf.sprintf
- "Can't find the IP address of the server (%s:%s)" host port
+ "Failed to connect to the server on host %s:%s" host port
| `Bind ->
if host = "" then
Printf.sprintf "Can't bind socket to port %s" port
@@ -1401,7 +1417,17 @@
match e with
Util.Fatal "Lost connection with the server" ->
debug (fun () -> Util.msg "Connection closed by the client\n");
- Lwt.return ()
+ (* We prevents new writes and wait for any current write to
+ terminate. As we don't have a good way to wait for the
+ writer to terminate, we just yield a bit. *)
+ let rec wait n =
+ if n = 0 then Lwt.return () else begin
+ Lwt_unix.yield () >>= fun () ->
+ wait (n - 1)
+ end
+ in
+ conn.outputBuffer.opened <- false;
+ wait 10
| _ ->
Lwt.fail e)
@@ -1426,23 +1452,27 @@
let waitOnPort hostOpt port =
Util.convertUnixErrorsToFatal "waiting on port"
(fun () ->
- Lwt_unix.run
- (let host = match hostOpt with
- Some host -> host
- | None -> "" in
- buildSocket host port `Bind >>= fun listening ->
- Util.msg "server started\n";
- let rec handleClients () =
- (* Accept a connection *)
- Lwt_unix.accept listening >>= fun (connected,_) ->
- Lwt_unix.setsockopt connected Unix.SO_KEEPALIVE true;
- commandLoop connected connected >>= fun () ->
- (* The client has closed its end of the connection *)
- begin try Lwt_unix.close connected with Unix.Unix_error _ -> () end;
- if Prefs.read killServer then Lwt.return () else
- handleClients ()
- in
- handleClients ()))
+ let host =
+ match hostOpt with
+ Some host -> host
+ | None -> ""
+ in
+ let listening = Lwt_unix.run (buildSocket host port `Bind) in
+ Util.msg "server started\n";
+ let rec handleClients () =
+ let (connected, _) =
+ Lwt_unix.run (Lwt_unix.accept listening)
+ in
+ Lwt_unix.setsockopt connected Unix.SO_KEEPALIVE true;
+ begin try
+ (* Accept a connection *)
+ Lwt_unix.run (commandLoop connected connected)
+ with Util.Fatal "Lost connection with the server" -> () end;
+ (* The client has closed its end of the connection *)
+ begin try Lwt_unix.close connected with Unix.Unix_error _ -> () end;
+ if not (Prefs.read killServer) then handleClients ()
+ in
+ handleClients ())
let beAServer () =
begin try
Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uicommon.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -350,13 +350,13 @@
if dangerousPaths = [Path.empty] then
"The root of one of the replicas has been completely emptied.\n\
Unison may delete everything in the other replica. (Set the \n\
- 'confirmbigdel' preference to false to disable this check.)"
+ 'confirmbigdel' preference to false to disable this check.)\n"
else
Printf.sprintf
"The following paths have been completely emptied in one replica:\n \
%s\n\
Unison may delete everything below these paths in the other replica.\n
- (Set the 'confirmbigdel' preference to false to disable this check.)"
+ (Set the 'confirmbigdel' preference to false to disable this check.)\n"
(String.concat "\n "
(Safelist.map (fun p -> "'" ^ (Path.toString p) ^ "'")
dangerousPaths))
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uigtk2.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -3672,6 +3672,8 @@
format skippedCount "skipped item" "" "s"
in
let message =
+ (if failureCount = 0 then "The synchronization was successful.\n\n"
+ else "") ^
"The replicas are not fully synchronized.\nThere was" ^
begin match infos with
[] -> assert false
Modified: trunk/src/uimacnew/Bridge.m
===================================================================
--- trunk/src/uimacnew/Bridge.m 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uimacnew/Bridge.m 2010-01-19 09:18:15 UTC (rev 404)
@@ -38,7 +38,7 @@
pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t init_cond = PTHREAD_COND_INITIALIZER;
-static BOOL doneInit = false;
+static BOOL doneInit = NO;
pthread_mutex_t global_call_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t global_call_cond = PTHREAD_COND_INITIALIZER;
Modified: trunk/src/uimacnew/MyController.m
===================================================================
--- trunk/src/uimacnew/MyController.m 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uimacnew/MyController.m 2010-01-19 09:18:15 UTC (rev 404)
@@ -74,7 +74,7 @@
[[tableView tableColumnWithIdentifier:@"path"] setDataCell:[[[ImageAndTextCell alloc] init] autorelease]];
// Custom progress cell
- ProgressCell *progressCell = [[ProgressCell alloc] init];
+ ProgressCell *progressCell = [[[ProgressCell alloc] init] autorelease];
[[tableView tableColumnWithIdentifier:@"percentTransferred"] setDataCell:progressCell];
/* Set up the version string in the about box. We use a custom
Modified: trunk/src/uimacnew09/Bridge.m
===================================================================
--- trunk/src/uimacnew09/Bridge.m 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uimacnew09/Bridge.m 2010-01-19 09:18:15 UTC (rev 404)
@@ -38,7 +38,7 @@
pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t init_cond = PTHREAD_COND_INITIALIZER;
-static BOOL doneInit = false;
+static BOOL doneInit = NO;
pthread_mutex_t global_call_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t global_call_cond = PTHREAD_COND_INITIALIZER;
Modified: trunk/src/uimacnew09/MyController.m
===================================================================
--- trunk/src/uimacnew09/MyController.m 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uimacnew09/MyController.m 2010-01-19 09:18:15 UTC (rev 404)
@@ -93,7 +93,7 @@
[[tableView tableColumnWithIdentifier:@"path"] setDataCell:[[[ImageAndTextCell alloc] init] autorelease]];
// Custom progress cell
- ProgressCell *progressCell = [[ProgressCell alloc] init];
+ ProgressCell *progressCell = [[[ProgressCell alloc] init] autorelease];
[[tableView tableColumnWithIdentifier:@"percentTransferred"] setDataCell:progressCell];
/* Set up the version string in the about box. We use a custom
Modified: trunk/src/uitext.ml
===================================================================
--- trunk/src/uitext.ml 2010-01-15 23:25:09 UTC (rev 403)
+++ trunk/src/uitext.ml 2010-01-19 09:18:15 UTC (rev 404)
@@ -814,7 +814,8 @@
Uicommon.uiInit
(fun s -> Util.msg "%s\n%s\n" Uicommon.shortUsageMsg s; exit 1)
(fun s -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1)
- (fun () -> if Prefs.read silent then Prefs.set Trace.terse true;
+ (fun () -> setWarnPrinter();
+ if Prefs.read silent then Prefs.set Trace.terse true;
if not (Prefs.read silent)
then Util.msg "%s\n" (Uicommon.contactingServerMsg()))
(fun () -> Some "default")
More information about the Unison-hackers
mailing list