You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by ro...@apache.org on 2012/10/20 22:59:41 UTC
svn commit: r1400514 - in /thrift/trunk/lib/delphi: src/Thrift.Server.pas
src/Thrift.Transport.Pipes.pas test/TestClient.pas test/TestServer.pas
Author: roger
Date: Sat Oct 20 20:59:41 2012
New Revision: 1400514
URL: http://svn.apache.org/viewvc?rev=1400514&view=rev
Log:
THRIFT-1713 Named and Anonymous Pipe transport (Delphi)
Patch: Jens Geyer
Modified:
thrift/trunk/lib/delphi/src/Thrift.Server.pas
thrift/trunk/lib/delphi/src/Thrift.Transport.Pipes.pas
thrift/trunk/lib/delphi/test/TestClient.pas
thrift/trunk/lib/delphi/test/TestServer.pas
Modified: thrift/trunk/lib/delphi/src/Thrift.Server.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/src/Thrift.Server.pas?rev=1400514&r1=1400513&r2=1400514&view=diff
==============================================================================
--- thrift/trunk/lib/delphi/src/Thrift.Server.pas (original)
+++ thrift/trunk/lib/delphi/src/Thrift.Server.pas Sat Oct 20 20:59:41 2012
@@ -287,14 +287,13 @@ begin
except
on E: TTransportException do
begin
- if FStop then
- begin
- FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName);
- end;
+ if FStop
+ then FLogDelegate('TSimpleServer was shutting down, caught ' + E.ToString)
+ else FLogDelegate( E.ToString);
end;
on E: Exception do
begin
- FLogDelegate( E.ToString );
+ FLogDelegate( E.ToString);
end;
end;
if InputTransport <> nil then
Modified: thrift/trunk/lib/delphi/src/Thrift.Transport.Pipes.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/src/Thrift.Transport.Pipes.pas?rev=1400514&r1=1400513&r2=1400514&view=diff
==============================================================================
--- thrift/trunk/lib/delphi/src/Thrift.Transport.Pipes.pas (original)
+++ thrift/trunk/lib/delphi/src/Thrift.Transport.Pipes.pas Sat Oct 20 20:59:41 2012
@@ -33,79 +33,110 @@ const
type
- IPipe = interface( IStreamTransport)
- ['{5E05CC85-434F-428F-BFB2-856A168B5558}']
- end;
+ //--- Pipe Streams ---
- TPipeStreamImpl = class( TThriftStreamImpl)
- private
- FPipe : THandle;
- FOwner : Boolean;
- FPipeName : string;
+ TPipeStreamBaseImpl = class( TThriftStreamImpl)
+ strict protected
+ FPipe : THandle;
FTimeout : DWORD;
- FShareMode: DWORD;
- FSecurityAttribs : PSecurityAttributes;
- protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
- procedure Open; override;
+ //procedure Open; override; - see derived classes
procedure Close; override;
procedure Flush; override;
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
public
- constructor Create( const aPipeHandle : THandle; aOwnsHandle : Boolean); overload;
+ constructor Create( const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT);
+ destructor Destroy; override;
+ end;
+
+
+ TNamedPipeStreamImpl = class sealed( TPipeStreamBaseImpl)
+ private
+ FPipeName : string;
+ FShareMode : DWORD;
+ FSecurityAttribs : PSecurityAttributes;
+
+ protected
+ procedure Open; override;
+
+ public
constructor Create( const aPipeName : string;
const aShareMode: DWORD = 0;
const aSecurityAttributes: PSecurityAttributes = nil;
const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT); overload;
+ end;
+
+
+ THandlePipeStreamImpl = class sealed( TPipeStreamBaseImpl)
+ private
+ FSrcHandle : THandle;
+
+ protected
+ procedure Open; override;
+
+ public
+ constructor Create( const aPipeHandle : THandle; aOwnsHandle : Boolean); overload;
destructor Destroy; override;
end;
- TNamedPipeImpl = class( TStreamTransportImpl, IPipe)
+ //--- Pipe Transports ---
+
+
+ IPipe = interface( IStreamTransport)
+ ['{5E05CC85-434F-428F-BFB2-856A168B5558}']
+ end;
+
+
+ TPipeTransportBaseImpl = class( TStreamTransportImpl, IPipe)
public
- FOwner : Boolean;
+ // ITransport
+ function GetIsOpen: Boolean; override;
+ procedure Open; override;
+ procedure Close; override;
+ end;
- // Constructs a new pipe object.
- constructor Create(); overload;
+
+ TNamedPipeImpl = class( TPipeTransportBaseImpl)
+ public
// Named pipe constructors
constructor Create( aPipe : THandle; aOwnsHandle : Boolean); overload;
constructor Create( const aPipeName : string;
const aShareMode: DWORD = 0;
const aSecurityAttributes: PSecurityAttributes = nil;
const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT); overload;
+ end;
+
+ TNamedPipeServerImpl = class( TNamedPipeImpl)
+ strict private
+ FHandle : THandle;
+ public
// ITransport
- function GetIsOpen: Boolean; override;
- procedure Open; override;
procedure Close; override;
+ constructor Create( aPipe : THandle; aOwnsHandle : Boolean); reintroduce;
end;
- TAnonymousPipeImpl = class( TStreamTransportImpl, IPipe)
+ TAnonymousPipeImpl = class( TPipeTransportBaseImpl)
public
- FOwner : Boolean;
-
- // Constructs a new pipe object.
- constructor Create(); overload;
// Anonymous pipe constructor
constructor Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean); overload;
-
- // ITransport
- function GetIsOpen: Boolean; override;
- procedure Open; override;
- procedure Close; override;
end;
- IPipeServer = interface( IServerTransport)
+ //--- Server Transports ---
+
+
+ IAnonymousServerPipe = interface( IServerTransport)
['{7AEE6793-47B9-4E49-981A-C39E9108E9AD}']
// Server side anonymous pipe ends
- function Handle : THandle;
+ function ReadHandle : THandle;
function WriteHandle : THandle;
// Client side anonymous pipe ends
function ClientAnonRead : THandle;
@@ -113,14 +144,24 @@ type
end;
- TServerPipeImpl = class( TServerTransportImpl, IPipeServer)
+ INamedServerPipe = interface( IServerTransport)
+ ['{9DF9EE48-D065-40AF-8F67-D33037D3D960}']
+ function Handle : THandle;
+ end;
+
+
+ TServerPipeBaseImpl = class( TServerTransportImpl)
+ public
+ procedure Listen; override;
+ end;
+
+
+ TAnonymousServerPipeImpl = class( TServerPipeBaseImpl, IAnonymousServerPipe)
private
- FPipeName : string;
- FMaxConns : DWORD;
FBufSize : DWORD;
- FAnonymous : Boolean;
- FHandle,
+ // Server side anonymous pipe handles
+ FReadHandle,
FWriteHandle : THandle;
//Client side anonymous pipe handles
@@ -130,68 +171,82 @@ type
protected
function AcceptImpl: ITransport; override;
- function CreateNamedPipe : Boolean;
function CreateAnonPipe : Boolean;
- // IPipeServer
- function Handle : THandle;
+ // IAnonymousServerPipe
+ function ReadHandle : THandle;
function WriteHandle : THandle;
function ClientAnonRead : THandle;
function ClientAnonWrite : THandle;
public
- // Constructors
- constructor Create(); overload;
- // Named Pipe
- constructor Create( aPipename : string); overload;
- constructor Create( aPipename : string; aBufsize : Cardinal); overload;
- constructor Create( aPipename : string; aBufsize, aMaxConns : Cardinal); overload;
- // Anonymous pipe
- constructor Create( aBufsize : Cardinal); overload;
+ constructor Create( aBufsize : Cardinal = 4096);
- procedure Listen; override;
procedure Close; override;
end;
-const
- TPIPE_SERVER_MAX_CONNS_DEFAULT = 10;
+ TNamedServerPipeImpl = class( TServerPipeBaseImpl, INamedServerPipe)
+ private
+ FPipeName : string;
+ FMaxConns : DWORD;
+ FBufSize : DWORD;
+ FHandle : THandle;
-implementation
+ protected
+ function AcceptImpl: ITransport; override;
+ function CreateNamedPipe : Boolean;
-{ TPipeStreamImpl }
+ // INamedServerPipe
+ function Handle : THandle;
+ public
+ constructor Create( aPipename : string; aBufsize : Cardinal = 4096;
+ aMaxConns : Cardinal = PIPE_UNLIMITED_INSTANCES);
-constructor TPipeStreamImpl.Create( const aPipeHandle : THandle; aOwnsHandle : Boolean);
+ procedure Close; override;
+ end;
+
+
+implementation
+
+
+procedure ClosePipeHandle( var hPipe : THandle);
begin
- FPipe := aPipeHandle;
- FOwner := aOwnsHandle;
- FPipeName := '';
- FTimeout := DEFAULT_THRIFT_PIPE_TIMEOUT;
- FShareMode := 0;
- FSecurityAttribs := nil;
+ if hPipe <> INVALID_HANDLE_VALUE
+ then try
+ CloseHandle( hPipe);
+ finally
+ hPipe := INVALID_HANDLE_VALUE;
+ end;
end;
-constructor TPipeStreamImpl.Create( const aPipeName : string; const aShareMode: DWORD;
- const aSecurityAttributes: PSecurityAttributes;
- const aTimeOut : DWORD);
+function DuplicatePipeHandle( const hSource : THandle) : THandle;
begin
- FPipe := INVALID_HANDLE_VALUE;
- FOwner := TRUE;
- FPipeName := aPipeName;
- FTimeout := aTimeOut;
- FShareMode := aShareMode;
- FSecurityAttribs := aSecurityAttributes;
+ if not DuplicateHandle( GetCurrentProcess, hSource,
+ GetCurrentProcess, @result,
+ 0, FALSE, DUPLICATE_SAME_ACCESS)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'DuplicateHandle: '+SysErrorMessage(GetLastError));
+end;
- if Copy(FPipeName,1,2) <> '\\'
- then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+
+
+{ TPipeStreamBaseImpl }
+
+
+constructor TPipeStreamBaseImpl.Create( const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT);
+begin
+ inherited Create;
+ FPipe := INVALID_HANDLE_VALUE;
+ FTimeout := aTimeOut;
end;
-destructor TPipeStreamImpl.Destroy;
+destructor TPipeStreamBaseImpl.Destroy;
begin
try
Close;
@@ -201,73 +256,25 @@ begin
end;
-procedure TPipeStreamImpl.Close;
+procedure TPipeStreamBaseImpl.Close;
begin
- if IsOpen then try
- if FOwner
- then CloseHandle( FPipe);
- finally
- FPipe := INVALID_HANDLE_VALUE;
- end;
+ ClosePipeHandle( FPipe);
end;
-procedure TPipeStreamImpl.Flush;
+procedure TPipeStreamBaseImpl.Flush;
begin
// nothing to do
end;
-function TPipeStreamImpl.IsOpen: Boolean;
+function TPipeStreamBaseImpl.IsOpen: Boolean;
begin
result := (FPipe <> INVALID_HANDLE_VALUE);
end;
-procedure TPipeStreamImpl.Open;
-var retries : Integer;
- hPipe : THandle;
- dwMode : DWORD;
-const INTERVAL = 500; // ms
-begin
- if IsOpen then Exit;
-
- // open that thingy
- retries := Max( 1, Round( 1.0 * FTimeout / INTERVAL));
- hPipe := INVALID_HANDLE_VALUE;
- while TRUE do begin
- hPipe := CreateFile( PChar( FPipeName),
- GENERIC_READ or GENERIC_WRITE,
- FShareMode, // sharing
- FSecurityAttribs, // security attributes
- OPEN_EXISTING, // opens existing pipe
- 0, // default attributes
- 0); // no template file
-
- if hPipe <> INVALID_HANDLE_VALUE
- then Break;
-
- Dec( retries);
- if (retries > 0) or (FTimeout = INFINITE)
- then Sleep( INTERVAL)
- else raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
- 'Unable to open pipe');
- end;
-
- // pipe connected; change to message-read mode.
- dwMode := PIPE_READMODE_MESSAGE;
- if not SetNamedPipeHandleState( hPipe, dwMode, nil, nil) then begin
- Close;
- raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
- 'SetNamedPipeHandleState failed');
- end;
-
- // everything fine
- FPipe := hPipe;
-end;
-
-
-procedure TPipeStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+procedure TPipeStreamBaseImpl.Write(const buffer: TBytes; offset, count: Integer);
var cbWritten : DWORD;
begin
if not IsOpen
@@ -280,8 +287,8 @@ begin
end;
-function TPipeStreamImpl.Read( var buffer: TBytes; offset, count: Integer): Integer;
-var cbRead : DWORD;
+function TPipeStreamBaseImpl.Read( var buffer: TBytes; offset, count: Integer): Integer;
+var cbRead, dwErr : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
const INTERVAL = 10; // ms
@@ -301,6 +308,14 @@ begin
and (bytes > 0)
then Break; // there are data
+ dwErr := GetLastError;
+ if (dwErr = ERROR_BROKEN_PIPE)
+ or (dwErr = ERROR_PIPE_NOT_CONNECTED)
+ then begin
+ result := 0; // other side closed the pipe
+ Exit;
+ end;
+
Dec( retries);
if retries > 0
then Sleep( INTERVAL)
@@ -317,7 +332,7 @@ begin
end;
-function TPipeStreamImpl.ToArray: TBytes;
+function TPipeStreamBaseImpl.ToArray: TBytes;
var bytes : LongInt;
begin
SetLength( result, 0);
@@ -333,156 +348,190 @@ begin
end;
-{ TNamedPipeImpl }
+{ TNamedPipeStreamImpl }
-constructor TNamedPipeImpl.Create();
-// Constructs a new pipe object / provides defaults
+constructor TNamedPipeStreamImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+ const aSecurityAttributes: PSecurityAttributes;
+ const aTimeOut : DWORD);
begin
- inherited Create( nil, nil);
- FOwner := FALSE;
-end;
+ inherited Create( aTimeout);
+ FPipeName := aPipeName;
+ FShareMode := aShareMode;
+ FSecurityAttribs := aSecurityAttributes;
-constructor TNamedPipeImpl.Create( const aPipeName : string; const aShareMode: DWORD;
- const aSecurityAttributes: PSecurityAttributes;
- const aTimeOut : DWORD);
-// Named pipe constructor
-begin
- Create();
- FInputStream := TPipeStreamImpl.Create( aPipeName, aShareMode, aSecurityAttributes, aTimeOut);
- FOutputStream := FInputStream; // true for named pipes
- FOwner := TRUE;
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
end;
-constructor TNamedPipeImpl.Create( aPipe : THandle; aOwnsHandle : Boolean);
-// Named pipe constructor
+procedure TNamedPipeStreamImpl.Open;
+var hPipe : THandle;
+ dwMode : DWORD;
begin
- Create();
- FInputStream := TPipeStreamImpl.Create( aPipe, aOwnsHandle);
- FOutputStream := FInputStream; // true for named pipes
- FOwner := aOwnsHandle;
+ if IsOpen then Exit;
+
+ // open that thingy
+
+ if not WaitNamedPipe( PChar(FPipeName), FTimeout)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Unable to open pipe, '+SysErrorMessage(GetLastError));
+
+ hPipe := CreateFile( PChar( FPipeName),
+ GENERIC_READ or GENERIC_WRITE,
+ FShareMode, // sharing
+ FSecurityAttribs, // security attributes
+ OPEN_EXISTING, // opens existing pipe
+ 0, // default attributes
+ 0); // no template file
+
+ if hPipe = INVALID_HANDLE_VALUE
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Unable to open pipe, '+SysErrorMessage(GetLastError));
+
+ // pipe connected; change to message-read mode.
+ dwMode := PIPE_READMODE_MESSAGE;
+ if not SetNamedPipeHandleState( hPipe, dwMode, nil, nil) then begin
+ Close;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'SetNamedPipeHandleState failed');
+ end;
+
+ // everything fine
+ FPipe := hPipe;
end;
-function TNamedPipeImpl.GetIsOpen: Boolean;
+{ THandlePipeStreamImpl }
+
+
+constructor THandlePipeStreamImpl.Create( const aPipeHandle : THandle; aOwnsHandle : Boolean);
begin
- result := (FInputStream <> nil);
+ inherited Create( DEFAULT_THRIFT_PIPE_TIMEOUT);
+
+ if aOwnsHandle
+ then FSrcHandle := aPipeHandle
+ else FSrcHandle := DuplicatePipeHandle( aPipeHandle);
+
+ Open;
end;
-procedure TNamedPipeImpl.Open;
+destructor THandlePipeStreamImpl.Destroy;
begin
- if FOwner then begin
- FInputStream.Open;
- if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
- then FOutputStream.Open;
+ try
+ ClosePipeHandle( FSrcHandle);
+ finally
+ inherited Destroy;
end;
end;
-procedure TNamedPipeImpl.Close;
+procedure THandlePipeStreamImpl.Open;
begin
- if FOwner then begin
- FInputStream.Close;
- if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
- then FOutputStream.Close;
- end;
+ if not IsOpen
+ then FPipe := DuplicatePipeHandle( FSrcHandle);
end;
-{ TAnonymousPipeImpl }
+{ TPipeTransportBaseImpl }
-constructor TAnonymousPipeImpl.Create();
-// Constructs a new pipe object / provides defaults
+function TPipeTransportBaseImpl.GetIsOpen: Boolean;
begin
- inherited Create( nil, nil);
- FOwner := FALSE;
+ result := (FInputStream <> nil);
end;
-constructor TAnonymousPipeImpl.Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean);
-// Anonymous pipe constructor
+procedure TPipeTransportBaseImpl.Open;
begin
- Create();
- FInputStream := TPipeStreamImpl.Create( aPipeRead, aOwnsHandles);
- FOutputStream := TPipeStreamImpl.Create( aPipeWrite, aOwnsHandles);
- FOwner := aOwnsHandles;
+ FInputStream.Open;
+ FOutputStream.Open;
end;
-function TAnonymousPipeImpl.GetIsOpen: Boolean;
+procedure TPipeTransportBaseImpl.Close;
begin
- result := (FInputStream <> nil) or (FOutputStream <> nil);
+ FInputStream.Close;
+ FOutputStream.Close;
end;
-procedure TAnonymousPipeImpl.Open;
+{ TNamedPipeImpl }
+
+
+constructor TNamedPipeImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+ const aSecurityAttributes: PSecurityAttributes;
+ const aTimeOut : DWORD);
+// Named pipe constructor
begin
- if FOwner then begin
- FInputStream.Open;
- if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
- then FOutputStream.Open;
- end;
+ inherited Create( nil, nil);
+ FInputStream := TNamedPipeStreamImpl.Create( aPipeName, aShareMode, aSecurityAttributes, aTimeOut);
+ FOutputStream := FInputStream; // true for named pipes
end;
-procedure TAnonymousPipeImpl.Close;
+constructor TNamedPipeImpl.Create( aPipe : THandle; aOwnsHandle : Boolean);
+// Named pipe constructor
begin
- if FOwner then begin
- FInputStream.Close;
- if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
- then FOutputStream.Close;
- end;
+ inherited Create( nil, nil);
+ FInputStream := THandlePipeStreamImpl.Create( aPipe, aOwnsHandle);
+ FOutputStream := FInputStream; // true for named pipes
end;
-{ TServerPipeImpl }
+{ TNamedPipeServerImpl }
-constructor TServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns : Cardinal);
-// Named Pipe CTOR
+constructor TNamedPipeServerImpl.Create( aPipe : THandle; aOwnsHandle : Boolean);
+// Named pipe constructor
begin
- inherited Create;
- FPipeName := aPipename;
- FBufsize := aBufSize;
- FMaxConns := Max( 1, Min( 255, aMaxConns)); // restrict to 1-255 connections
- FAnonymous := FALSE;
- FHandle := INVALID_HANDLE_VALUE;
- FWriteHandle := INVALID_HANDLE_VALUE;
- FClientAnonRead := INVALID_HANDLE_VALUE;
- FClientAnonWrite := INVALID_HANDLE_VALUE;
+ FHandle := DuplicatePipeHandle( aPipe);
+ inherited Create( aPipe, aOwnsHandle);
+end;
- if Copy(FPipeName,1,2) <> '\\'
- then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+
+procedure TNamedPipeServerImpl.Close;
+begin
+ FlushFileBuffers( FHandle);
+ DisconnectNamedPipe( FHandle); // force client off the pipe
+ ClosePipeHandle( FHandle);
+
+ inherited Close;
end;
-constructor TServerPipeImpl.Create( aPipename : string; aBufsize : Cardinal);
-// Named Pipe CTOR
+{ TAnonymousPipeImpl }
+
+
+constructor TAnonymousPipeImpl.Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean);
+// Anonymous pipe constructor
begin
- Create( aPipename, aBufSize, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+ inherited Create( nil, nil);
+ FInputStream := THandlePipeStreamImpl.Create( aPipeRead, aOwnsHandles);
+ FOutputStream := THandlePipeStreamImpl.Create( aPipeWrite, aOwnsHandles);
end;
-constructor TServerPipeImpl.Create( aPipename : string);
-// Named Pipe CTOR
+{ TServerPipeBaseImpl }
+
+
+procedure TServerPipeBaseImpl.Listen;
begin
- Create( aPipename, 1024, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+ // not much to do here
end;
-constructor TServerPipeImpl.Create( aBufsize : Cardinal);
+{ TAnonymousServerPipeImpl }
+
+
+constructor TAnonymousServerPipeImpl.Create( aBufsize : Cardinal);
// Anonymous pipe CTOR
begin
inherited Create;
- FPipeName := '';
FBufsize := aBufSize;
- FMaxConns := 1;
- FAnonymous := TRUE;
- FHandle := INVALID_HANDLE_VALUE;
+ FReadHandle := INVALID_HANDLE_VALUE;
FWriteHandle := INVALID_HANDLE_VALUE;
FClientAnonRead := INVALID_HANDLE_VALUE;
FClientAnonWrite := INVALID_HANDLE_VALUE;
@@ -496,119 +545,148 @@ begin
end;
-constructor TServerPipeImpl.Create();
-// Anonymous pipe CTOR
+function TAnonymousServerPipeImpl.AcceptImpl: ITransport;
+var buf : Byte;
+ br : DWORD;
begin
- Create( 1024);
+ // This 0-byte read serves merely as a blocking call.
+ if not ReadFile( FReadHandle, buf, 0, br, nil)
+ and (GetLastError() <> ERROR_MORE_DATA)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TServerPipe unable to initiate pipe communication');
+ result := TAnonymousPipeImpl.Create( FReadHandle, FWriteHandle, FALSE);
end;
-function TServerPipeImpl.AcceptImpl: ITransport;
-var buf : Byte;
- br : DWORD;
- connectRet : Boolean;
+procedure TAnonymousServerPipeImpl.Close;
begin
- if FAnonymous then begin //Anonymous Pipe
+ ClosePipeHandle( FReadHandle);
+ ClosePipeHandle( FWriteHandle);
+ ClosePipeHandle( FClientAnonRead);
+ ClosePipeHandle( FClientAnonWrite);
+end;
- // This 0-byte read serves merely as a blocking call.
- if not ReadFile( FHandle, buf, 0, br, nil)
- and (GetLastError() <> ERROR_MORE_DATA)
- then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
- 'TPipeServer unable to initiate pipe communication');
- result := TAnonymousPipeImpl.Create( FHandle, FWriteHandle, FALSE);
- end
- else begin //Named Pipe
+function TAnonymousServerPipeImpl.ReadHandle : THandle;
+begin
+ result := FReadHandle;
+end;
- while TRUE do begin
- if not CreateNamedPipe()
- then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
- 'TPipeServer CreateNamedPipe failed');
-
- // Wait for the client to connect; if it succeeds, the
- // function returns a nonzero value. If the function returns
- // zero, GetLastError should return ERROR_PIPE_CONNECTED.
- if ConnectNamedPipe( FHandle,nil)
- then connectRet := TRUE
- else connectRet := (GetLastError() = ERROR_PIPE_CONNECTED);
-
- if connectRet
- then Break;
-
- Close;
- raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
- 'TPipeServer: client connection failed');
- end;
- result := TNamedPipeImpl.Create( FHandle, TRUE);
- end;
+function TAnonymousServerPipeImpl.WriteHandle : THandle;
+begin
+ result := FWriteHandle;
end;
-procedure TServerPipeImpl.Listen;
+function TAnonymousServerPipeImpl.ClientAnonRead : THandle;
begin
- // not much to do here
+ result := FClientAnonRead;
end;
-procedure TServerPipeImpl.Close;
+function TAnonymousServerPipeImpl.ClientAnonWrite : THandle;
begin
- if not FAnonymous then begin
+ result := FClientAnonWrite;
+end;
- if FHandle <> INVALID_HANDLE_VALUE then begin
- DisconnectNamedPipe( FHandle);
- CloseHandle( FHandle);
- FHandle := INVALID_HANDLE_VALUE;
- end;
- end
- else begin
+function TAnonymousServerPipeImpl.CreateAnonPipe : Boolean;
+var sd : PSECURITY_DESCRIPTOR;
+ sa : SECURITY_ATTRIBUTES; //TSecurityAttributes;
+ hCAR, hPipeW, hCAW, hPipe : THandle;
+begin
+ result := FALSE;
- if FHandle <> INVALID_HANDLE_VALUE then begin
- CloseHandle( FHandle);
- FHandle := INVALID_HANDLE_VALUE;
- end;
- if FWriteHandle <> INVALID_HANDLE_VALUE then begin
- CloseHandle( FWriteHandle);
- FWriteHandle := INVALID_HANDLE_VALUE;
- end;
- if FClientAnonRead <> INVALID_HANDLE_VALUE then begin
- CloseHandle( FClientAnonRead);
- FClientAnonRead := INVALID_HANDLE_VALUE;
- end;
- if FClientAnonWrite <> INVALID_HANDLE_VALUE then begin
- CloseHandle( FClientAnonWrite);
- FClientAnonWrite := INVALID_HANDLE_VALUE;
- end;
+ sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+ Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+ Win32Check( SetSecurityDescriptorDacl( sd, TRUE, nil, FALSE));
+
+ sa.nLength := sizeof( sa);
+ sa.lpSecurityDescriptor := sd;
+ sa.bInheritHandle := TRUE; //allow passing handle to child
+
+ if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
+ Console.WriteLine( 'TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+ Exit;
+ end;
+
+ if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin //create stdout pipe
+ Console.WriteLine( 'TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+ CloseHandle( hCAR);
+ CloseHandle( hPipeW);
+ Exit;
end;
+
+ FClientAnonRead := hCAR;
+ FClientAnonWrite := hCAW;
+ FReadHandle := hPipe;
+ FWriteHandle := hPipeW;
+
+ result := TRUE;
end;
-function TServerPipeImpl.Handle : THandle;
+{ TNamedServerPipeImpl }
+
+
+constructor TNamedServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns : Cardinal);
+// Named Pipe CTOR
begin
- result := FHandle;
+ inherited Create;
+ FPipeName := aPipename;
+ FBufsize := aBufSize;
+ FMaxConns := Max( 1, Min( PIPE_UNLIMITED_INSTANCES, aMaxConns));
+ FHandle := INVALID_HANDLE_VALUE;
+
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
end;
-function TServerPipeImpl.WriteHandle : THandle;
+function TNamedServerPipeImpl.AcceptImpl: ITransport;
+var connectRet : Boolean;
begin
- result := FWriteHandle;
+ if not CreateNamedPipe()
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TServerPipe CreateNamedPipe failed');
+
+ // Wait for the client to connect; if it succeeds, the
+ // function returns a nonzero value. If the function returns
+ // zero, GetLastError should return ERROR_PIPE_CONNECTED.
+ if ConnectNamedPipe( FHandle,nil)
+ then connectRet := TRUE
+ else connectRet := (GetLastError() = ERROR_PIPE_CONNECTED);
+
+ if not connectRet then begin
+ Close;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TServerPipe: client connection failed');
+ end;
+
+ result := TNamedPipeServerImpl.Create( FHandle, TRUE);
end;
-function TServerPipeImpl.ClientAnonRead : THandle;
+procedure TNamedServerPipeImpl.Close;
begin
- result := FClientAnonRead;
+ if FHandle <> INVALID_HANDLE_VALUE
+ then try
+ FlushFileBuffers( FHandle);
+ DisconnectNamedPipe( FHandle);
+ finally
+ ClosePipeHandle( FHandle);
+ end;
end;
-function TServerPipeImpl.ClientAnonWrite : THandle;
+function TNamedServerPipeImpl.Handle : THandle;
begin
- result := FClientAnonWrite;
+ result := FHandle;
end;
-function TServerPipeImpl.CreateNamedPipe : Boolean;
+function TNamedServerPipeImpl.CreateNamedPipe : Boolean;
var SIDAuthWorld : SID_IDENTIFIER_AUTHORITY ;
everyone_sid : PSID;
ea : EXPLICIT_ACCESS;
@@ -667,42 +745,6 @@ begin
end;
-function TServerPipeImpl.CreateAnonPipe : Boolean;
-var sd : PSECURITY_DESCRIPTOR;
- sa : SECURITY_ATTRIBUTES; //TSecurityAttributes;
- hCAR, hPipeW, hCAW, hPipe : THandle;
-begin
- result := FALSE;
-
- sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
- Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
- Win32Check( SetSecurityDescriptorDacl( sd, TRUE, nil, FALSE));
-
- sa.nLength := sizeof( sa);
- sa.lpSecurityDescriptor := sd;
- sa.bInheritHandle := TRUE; //allow passing handle to child
-
- if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
- Console.WriteLine( 'TPipeServer CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
- Exit;
- end;
-
- if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin //create stdout pipe
- Console.WriteLine( 'TPipeServer CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
- CloseHandle( hCAR);
- CloseHandle( hPipeW);
- Exit;
- end;
-
- FClientAnonRead := hCAR;
- FClientAnonWrite := hCAW;
- FHandle := hPipe;
- FWriteHandle := hPipeW;
-
- result := TRUE;
-end;
-
-
end.
Modified: thrift/trunk/lib/delphi/test/TestClient.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/TestClient.pas?rev=1400514&r1=1400513&r2=1400514&view=diff
==============================================================================
--- thrift/trunk/lib/delphi/test/TestClient.pas (original)
+++ thrift/trunk/lib/delphi/test/TestClient.pas Sat Oct 20 20:59:41 2012
@@ -213,6 +213,13 @@ begin
end;
end;
+ // In the anonymous pipes mode the client is launched by the test server
+ // -> behave nicely and allow for attaching a debugger to this process
+ if bAnonPipe and not IsDebuggerPresent
+ then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
+ 'Thrift TestClient (Delphi)',
+ MB_OK or MB_ICONEXCLAMATION);
+
SetLength( threads, FNumThread);
dtStart := Now;
Modified: thrift/trunk/lib/delphi/test/TestServer.pas
URL: http://svn.apache.org/viewvc/thrift/trunk/lib/delphi/test/TestServer.pas?rev=1400514&r1=1400513&r2=1400514&view=diff
==============================================================================
--- thrift/trunk/lib/delphi/test/TestServer.pas (original)
+++ thrift/trunk/lib/delphi/test/TestServer.pas Sat Oct 20 20:59:41 2012
@@ -78,7 +78,7 @@ type
procedure SetServer( const AServer : IServer );
end;
- class procedure LaunchAnonPipeChild( const app : string; const transport : IPipeServer);
+ class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousServerPipe);
class procedure Execute( const args: array of string);
end;
@@ -405,7 +405,7 @@ end;
{ TTestServer }
-class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IPipeServer);
+class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousServerPipe);
//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,7 +457,8 @@ var
testProcessor : IProcessor;
ServerTrans : IServerTransport;
ServerEngine : IServer;
- pipeserver : IPipeServer;
+ anonymouspipe : IAnonymousServerPipe;
+ namedpipe : INamedServerPipe;
TransportFactory : ITransportFactory;
ProtocolFactory : IProtocolFactory;
i : Integer;
@@ -536,13 +537,13 @@ begin
if sPipeName <> '' then begin
Console.WriteLine('- named pipe ('+sPipeName+')');
- pipeserver := TServerPipeImpl.Create( sPipeName);
- servertrans := pipeserver;
+ namedpipe := TNamedServerPipeImpl.Create( sPipeName);
+ servertrans := namedpipe;
end
else if AnonPipe then begin
Console.WriteLine('- anonymous pipes');
- pipeserver := TServerPipeImpl.Create;
- servertrans := pipeserver;
+ anonymouspipe := TAnonymousServerPipeImpl.Create;
+ servertrans := anonymouspipe;
end
else begin
Console.WriteLine('- sockets (port '+IntToStr(port)+')');
@@ -572,7 +573,7 @@ begin
// start the client now when we have the anon handles, but before the server starts
if AnonPipe
- then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', pipeserver);
+ then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
Console.WriteLine('');