THRIFT-1713 Named and Anonymous Pipe transport (Delphi)
Patch: Jens Geyer
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1394952 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
new file mode 100644
index 0000000..8f7ec59
--- /dev/null
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
@@ -0,0 +1,710 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+unit Thrift.Transport.Pipes;
+
+{$WARN SYMBOL_PLATFORM OFF}
+
+interface
+
+uses
+ Windows, SysUtils, Math, AccCtrl, AclAPI,
+ Thrift.Transport,
+ Thrift.Console,
+ Thrift.Stream;
+
+const
+ DEFAULT_THRIFT_PIPE_TIMEOUT = 5 * 1000; // ms
+
+
+type
+ IPipe = interface( IStreamTransport)
+ ['{5E05CC85-434F-428F-BFB2-856A168B5558}']
+ end;
+
+
+ TPipeStreamImpl = class( TThriftStreamImpl)
+ private
+ FPipe : THandle;
+ FOwner : Boolean;
+ FPipeName : string;
+ 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 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 aPipeName : string;
+ const aShareMode: DWORD = 0;
+ const aSecurityAttributes: PSecurityAttributes = nil;
+ const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT); overload;
+ destructor Destroy; override;
+ end;
+
+
+ TNamedPipeImpl = class( TStreamTransportImpl, IPipe)
+ public
+ FOwner : Boolean;
+
+ // Constructs a new pipe object.
+ constructor Create(); overload;
+ // 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;
+
+ // ITransport
+ function GetIsOpen: Boolean; override;
+ procedure Open; override;
+ procedure Close; override;
+ end;
+
+
+ TAnonymousPipeImpl = class( TStreamTransportImpl, IPipe)
+ 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)
+ ['{7AEE6793-47B9-4E49-981A-C39E9108E9AD}']
+ // Server side anonymous pipe ends
+ function Handle : THandle;
+ function WriteHandle : THandle;
+ // Client side anonymous pipe ends
+ function ClientAnonRead : THandle;
+ function ClientAnonWrite : THandle;
+ end;
+
+
+ TServerPipeImpl = class( TServerTransportImpl, IPipeServer)
+ private
+ FPipeName : string;
+ FMaxConns : DWORD;
+ FBufSize : DWORD;
+ FAnonymous : Boolean;
+
+ FHandle,
+ FWriteHandle : THandle;
+
+ //Client side anonymous pipe handles
+ FClientAnonRead,
+ FClientAnonWrite : THandle;
+
+ protected
+ function AcceptImpl: ITransport; override;
+
+ function CreateNamedPipe : Boolean;
+ function CreateAnonPipe : Boolean;
+
+ // IPipeServer
+ function Handle : 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;
+
+ procedure Listen; override;
+ procedure Close; override;
+ end;
+
+
+const
+ TPIPE_SERVER_MAX_CONNS_DEFAULT = 10;
+
+
+implementation
+
+
+{ TPipeStreamImpl }
+
+
+constructor TPipeStreamImpl.Create( const aPipeHandle : THandle; aOwnsHandle : Boolean);
+begin
+ FPipe := aPipeHandle;
+ FOwner := aOwnsHandle;
+ FPipeName := '';
+ FTimeout := DEFAULT_THRIFT_PIPE_TIMEOUT;
+ FShareMode := 0;
+ FSecurityAttribs := nil;
+end;
+
+
+constructor TPipeStreamImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+ const aSecurityAttributes: PSecurityAttributes;
+ const aTimeOut : DWORD);
+begin
+ FPipe := INVALID_HANDLE_VALUE;
+ FOwner := TRUE;
+ FPipeName := aPipeName;
+ FTimeout := aTimeOut;
+ FShareMode := aShareMode;
+ FSecurityAttribs := aSecurityAttributes;
+
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+end;
+
+
+destructor TPipeStreamImpl.Destroy;
+begin
+ try
+ Close;
+ finally
+ inherited Destroy;
+ end;
+end;
+
+
+procedure TPipeStreamImpl.Close;
+begin
+ if IsOpen then try
+ if FOwner
+ then CloseHandle( FPipe);
+ finally
+ FPipe := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+
+procedure TPipeStreamImpl.Flush;
+begin
+ // nothing to do
+end;
+
+
+function TPipeStreamImpl.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);
+var cbWritten : DWORD;
+begin
+ if not IsOpen
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Called write on non-open pipe');
+
+ if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Write to pipe failed');
+end;
+
+
+function TPipeStreamImpl.Read( var buffer: TBytes; offset, count: Integer): Integer;
+var cbRead : DWORD;
+ bytes, retries : LongInt;
+ bOk : Boolean;
+const INTERVAL = 10; // ms
+begin
+ if not IsOpen
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Called read on non-open pipe');
+
+ // MSDN: Handle can be a handle to a named pipe instance,
+ // or it can be a handle to the read end of an anonymous pipe,
+ // The handle must have GENERIC_READ access to the pipe.
+ if FTimeOut <> INFINITE then begin
+ retries := Max( 1, Round( 1.0 * FTimeOut / INTERVAL));
+ while TRUE do begin
+ if IsOpen
+ and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
+ and (bytes > 0)
+ then Break; // there are data
+
+ Dec( retries);
+ if retries > 0
+ then Sleep( INTERVAL)
+ else raise TTransportException.Create( TTransportException.TExceptionType.TimedOut,
+ 'Pipe read timed out');
+ end;
+ end;
+
+ // read the data (or block INFINITE-ly)
+ bOk := ReadFile( FPipe, buffer[offset], count, cbRead, nil);
+ if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
+ then result := 0 // No more data, possibly because client disconnected.
+ else result := cbRead;
+end;
+
+
+function TPipeStreamImpl.ToArray: TBytes;
+var bytes : LongInt;
+begin
+ SetLength( result, 0);
+ bytes := 0;
+
+ if IsOpen
+ and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
+ and (bytes > 0)
+ then begin
+ SetLength( result, bytes);
+ Read( result, 0, bytes);
+ end;
+end;
+
+
+{ TNamedPipeImpl }
+
+
+constructor TNamedPipeImpl.Create();
+// Constructs a new pipe object / provides defaults
+begin
+ inherited Create( nil, nil);
+ FOwner := FALSE;
+end;
+
+
+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;
+end;
+
+
+constructor TNamedPipeImpl.Create( aPipe : THandle; aOwnsHandle : Boolean);
+// Named pipe constructor
+begin
+ Create();
+ FInputStream := TPipeStreamImpl.Create( aPipe, aOwnsHandle);
+ FOutputStream := FInputStream; // true for named pipes
+ FOwner := aOwnsHandle;
+end;
+
+
+function TNamedPipeImpl.GetIsOpen: Boolean;
+begin
+ result := (FInputStream <> nil);
+end;
+
+
+procedure TNamedPipeImpl.Open;
+begin
+ if FOwner then begin
+ FInputStream.Open;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Open;
+ end;
+end;
+
+
+procedure TNamedPipeImpl.Close;
+begin
+ if FOwner then begin
+ FInputStream.Close;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Close;
+ end;
+end;
+
+
+{ TAnonymousPipeImpl }
+
+
+constructor TAnonymousPipeImpl.Create();
+// Constructs a new pipe object / provides defaults
+begin
+ inherited Create( nil, nil);
+ FOwner := FALSE;
+end;
+
+
+constructor TAnonymousPipeImpl.Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean);
+// Anonymous pipe constructor
+begin
+ Create();
+ FInputStream := TPipeStreamImpl.Create( aPipeRead, aOwnsHandles);
+ FOutputStream := TPipeStreamImpl.Create( aPipeWrite, aOwnsHandles);
+ FOwner := aOwnsHandles;
+end;
+
+
+function TAnonymousPipeImpl.GetIsOpen: Boolean;
+begin
+ result := (FInputStream <> nil) or (FOutputStream <> nil);
+end;
+
+
+procedure TAnonymousPipeImpl.Open;
+begin
+ if FOwner then begin
+ FInputStream.Open;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Open;
+ end;
+end;
+
+
+procedure TAnonymousPipeImpl.Close;
+begin
+ if FOwner then begin
+ FInputStream.Close;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Close;
+ end;
+end;
+
+
+{ TServerPipeImpl }
+
+
+constructor TServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns : Cardinal);
+// Named Pipe CTOR
+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;
+
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+end;
+
+
+constructor TServerPipeImpl.Create( aPipename : string; aBufsize : Cardinal);
+// Named Pipe CTOR
+begin
+ Create( aPipename, aBufSize, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+end;
+
+
+constructor TServerPipeImpl.Create( aPipename : string);
+// Named Pipe CTOR
+begin
+ Create( aPipename, 1024, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+end;
+
+
+constructor TServerPipeImpl.Create( aBufsize : Cardinal);
+// Anonymous pipe CTOR
+begin
+ inherited Create;
+ FPipeName := '';
+ FBufsize := aBufSize;
+ FMaxConns := 1;
+ FAnonymous := TRUE;
+ FHandle := INVALID_HANDLE_VALUE;
+ FWriteHandle := INVALID_HANDLE_VALUE;
+ FClientAnonRead := INVALID_HANDLE_VALUE;
+ FClientAnonWrite := INVALID_HANDLE_VALUE;
+
+ // The anonymous pipe needs to be created first so that the server can
+ // pass the handles on to the client before the serve (acceptImpl)
+ // blocking call.
+ if not CreateAnonPipe
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ ClassName+'.Create() failed');
+end;
+
+
+constructor TServerPipeImpl.Create();
+// Anonymous pipe CTOR
+begin
+ Create( 1024);
+end;
+
+
+function TServerPipeImpl.AcceptImpl: ITransport;
+var buf : Byte;
+ br : DWORD;
+ connectRet : Boolean;
+begin
+ if FAnonymous then begin //Anonymous Pipe
+
+ // 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
+
+ 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;
+end;
+
+
+procedure TServerPipeImpl.Listen;
+begin
+ // not much to do here
+end;
+
+
+procedure TServerPipeImpl.Close;
+begin
+ if not FAnonymous then begin
+
+ if FHandle <> INVALID_HANDLE_VALUE then begin
+ DisconnectNamedPipe( FHandle);
+ CloseHandle( FHandle);
+ FHandle := INVALID_HANDLE_VALUE;
+ end;
+
+ end
+ else begin
+
+ 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;
+ end;
+end;
+
+
+function TServerPipeImpl.Handle : THandle;
+begin
+ result := FHandle;
+end;
+
+
+function TServerPipeImpl.WriteHandle : THandle;
+begin
+ result := FWriteHandle;
+end;
+
+
+function TServerPipeImpl.ClientAnonRead : THandle;
+begin
+ result := FClientAnonRead;
+end;
+
+
+function TServerPipeImpl.ClientAnonWrite : THandle;
+begin
+ result := FClientAnonWrite;
+end;
+
+
+function TServerPipeImpl.CreateNamedPipe : Boolean;
+var SIDAuthWorld : SID_IDENTIFIER_AUTHORITY ;
+ everyone_sid : PSID;
+ ea : EXPLICIT_ACCESS;
+ acl : PACL;
+ sd : PSECURITY_DESCRIPTOR;
+ sa : SECURITY_ATTRIBUTES;
+ hPipe : THandle;
+const
+ SECURITY_WORLD_SID_AUTHORITY : TSIDIdentifierAuthority = (Value : (0,0,0,0,0,1));
+ SECURITY_WORLD_RID = $00000000;
+begin
+ // Windows - set security to allow non-elevated apps
+ // to access pipes created by elevated apps.
+ SIDAuthWorld := SECURITY_WORLD_SID_AUTHORITY;
+ everyone_sid := nil;
+ AllocateAndInitializeSid( SIDAuthWorld, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, everyone_sid);
+
+ ZeroMemory( @ea, SizeOf(ea));
+ ea.grfAccessPermissions := SPECIFIC_RIGHTS_ALL or STANDARD_RIGHTS_ALL;
+ ea.grfAccessMode := SET_ACCESS;
+ ea.grfInheritance := NO_INHERITANCE;
+ ea.Trustee.TrusteeForm := TRUSTEE_IS_SID;
+ ea.Trustee.TrusteeType := TRUSTEE_IS_WELL_KNOWN_GROUP;
+ ea.Trustee.ptstrName := PChar(everyone_sid);
+
+ acl := nil;
+ SetEntriesInAcl( 1, @ea, nil, acl);
+
+ sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+ Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+ Win32Check( SetSecurityDescriptorDacl( sd, TRUE, acl, FALSE));
+
+ sa.nLength := SizeOf(sa);
+ sa.lpSecurityDescriptor := sd;
+ sa.bInheritHandle := FALSE;
+
+ // Create an instance of the named pipe
+ hPipe := Windows.CreateNamedPipe( PChar( FPipeName), // pipe name
+ PIPE_ACCESS_DUPLEX, // read/write access
+ PIPE_TYPE_MESSAGE or // message type pipe
+ PIPE_READMODE_MESSAGE, // message-read mode
+ FMaxConns, // max. instances
+ FBufSize, // output buffer size
+ FBufSize, // input buffer size
+ 0, // client time-out
+ @sa); // default security attribute
+
+ if( hPipe = INVALID_HANDLE_VALUE) then begin
+ FHandle := INVALID_HANDLE_VALUE;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'CreateNamedPipe() failed ' + IntToStr(GetLastError));
+ end;
+
+ FHandle := hPipe;
+ result := TRUE;
+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.
+
+
+