THRIFT-1880 Make named pipes server work asynchronously (overlapped) to allow for clean server stops
Patch: Jens Geyer
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index 791468b..7b74e58 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -21,6 +21,8 @@
{$WARN SYMBOL_PLATFORM OFF}
+{.$DEFINE RunEndless} // activate to interactively stress-test the server stop routines via Ctrl+C
+
interface
uses
@@ -46,6 +48,7 @@
ITestHandler = interface( TThriftTest.Iface )
procedure SetServer( const AServer : IServer );
+ procedure TestStop;
end;
TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
@@ -73,17 +76,45 @@
function testMultiException(const arg0: string; const arg1: string): IXtruct;
procedure testOneway(secondsToSleep: Integer);
- procedure testStop;
-
+ procedure TestStop;
procedure SetServer( const AServer : IServer );
end;
- class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousServerPipe);
+ class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
class procedure Execute( const args: array of string);
end;
implementation
+
+var g_Handler : TTestServer.ITestHandler = nil;
+
+
+function MyConsoleEventHandler( dwCtrlType : DWORD) : BOOL; stdcall;
+// Note that this Handler procedure is called from another thread
+var handler : TTestServer.ITestHandler;
+begin
+ result := TRUE;
+ try
+ case dwCtrlType of
+ CTRL_C_EVENT : Console.WriteLine( 'Ctrl+C pressed');
+ CTRL_BREAK_EVENT : Console.WriteLine( 'Ctrl+Break pressed');
+ CTRL_CLOSE_EVENT : Console.WriteLine( 'Received CloseTask signal');
+ CTRL_LOGOFF_EVENT : Console.WriteLine( 'Received LogOff signal');
+ CTRL_SHUTDOWN_EVENT : Console.WriteLine( 'Received Shutdown signal');
+ else
+ Console.WriteLine( 'Received console event #'+IntToStr(Integer(dwCtrlType)));
+ end;
+
+ handler := g_Handler;
+ if handler <> nil then handler.TestStop;
+
+ except
+ // catch all
+ end;
+end;
+
+
{ TTestServer.TTestHandlerImpl }
procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer);
@@ -405,7 +436,7 @@
{ TTestServer }
-class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousServerPipe);
+class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
//Launch child process and pass R/W anonymous pipe handles on cmd line.
//This is a simple example and does not include elevation or other
//advanced features.
@@ -457,8 +488,8 @@
testProcessor : IProcessor;
ServerTrans : IServerTransport;
ServerEngine : IServer;
- anonymouspipe : IAnonymousServerPipe;
- namedpipe : INamedServerPipe;
+ anonymouspipe : IAnonymousPipeServerTransport;
+ namedpipe : INamedPipeServerTransport;
TransportFactory : ITransportFactory;
ProtocolFactory : IProtocolFactory;
i : Integer;
@@ -542,12 +573,12 @@
if sPipeName <> '' then begin
Console.WriteLine('- named pipe ('+sPipeName+')');
- namedpipe := TNamedServerPipeImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, TIMEOUT);
+ namedpipe := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, TIMEOUT);
servertrans := namedpipe;
end
else if AnonPipe then begin
Console.WriteLine('- anonymous pipes');
- anonymouspipe := TAnonymousServerPipeImpl.Create;
+ anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
servertrans := anonymouspipe;
end
else begin
@@ -580,11 +611,18 @@
if AnonPipe
then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
+ // install Ctrl+C handler before the server starts
+ g_Handler := testHandler;
+ SetConsoleCtrlHandler( @MyConsoleEventHandler, TRUE);
Console.WriteLine('');
- Console.WriteLine('Starting the server ...');
- serverEngine.Serve;
+ repeat
+ Console.WriteLine('Starting the server ...');
+ serverEngine.Serve;
+ until {$IFDEF RunEndless} FALSE {$ELSE} TRUE {$ENDIF};
+
testHandler.SetServer( nil);
+ g_Handler := nil;
except
on E: Exception do
@@ -595,4 +633,5 @@
Console.WriteLine( 'done.');
end;
+
end.