From 79655fbe0b9bf0ca310ce35bafcfb47f76642e6d Mon Sep 17 00:00:00 2001 From: Roger Meier Date: Sat, 20 Oct 2012 20:59:41 +0000 Subject: [PATCH] THRIFT-1713 Named and Anonymous Pipe transport (Delphi) Patch: Jens Geyer git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1400514 13f79535-47bb-0310-9956-ffa450edef68 --- lib/delphi/src/Thrift.Server.pas | 9 +- lib/delphi/src/Thrift.Transport.Pipes.pas | 682 ++++++++++++---------- lib/delphi/test/TestClient.pas | 7 + lib/delphi/test/TestServer.pas | 17 +- 4 files changed, 382 insertions(+), 333 deletions(-) diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas index d4375276..8af399e2 100644 --- a/lib/delphi/src/Thrift.Server.pas +++ b/lib/delphi/src/Thrift.Server.pas @@ -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 diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas index 8f7ec59e..76ed93bc 100644 --- a/lib/delphi/src/Thrift.Transport.Pipes.pas +++ b/lib/delphi/src/Thrift.Transport.Pipes.pas @@ -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. diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas index d3a4895b..baeaaa8b 100644 --- a/lib/delphi/test/TestClient.pas +++ b/lib/delphi/test/TestClient.pas @@ -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; diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas index 5d003dac..7048a208 100644 --- a/lib/delphi/test/TestServer.pas +++ b/lib/delphi/test/TestServer.pas @@ -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(''); -- 2.17.1