FPipeName : string;
FMaxConns : DWORD;
FBufSize : DWORD;
+ FTimeout : DWORD;
FHandle : THandle;
public
constructor Create( aPipename : string; aBufsize : Cardinal = 4096;
- aMaxConns : Cardinal = PIPE_UNLIMITED_INSTANCES);
+ aMaxConns : Cardinal = PIPE_UNLIMITED_INSTANCES;
+ aTimeOut : Cardinal = 0);
procedure Close; override;
end;
function TPipeTransportBaseImpl.GetIsOpen: Boolean;
begin
- result := (FInputStream <> nil);
+ result := (FInputStream <> nil) and (FInputStream.IsOpen)
+ and (FOutputStream <> nil) and (FOutputStream.IsOpen);
end;
{ TNamedServerPipeImpl }
-constructor TNamedServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns : Cardinal);
+constructor TNamedServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns, aTimeOut : Cardinal);
// Named Pipe CTOR
begin
inherited Create;
FBufsize := aBufSize;
FMaxConns := Max( 1, Min( PIPE_UNLIMITED_INSTANCES, aMaxConns));
FHandle := INVALID_HANDLE_VALUE;
+ FTimeout := aTimeOut;
if Copy(FPipeName,1,2) <> '\\'
then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
FMaxConns, // max. instances
FBufSize, // output buffer size
FBufSize, // input buffer size
- 0, // client time-out
+ FTimeout, // time-out, see MSDN
@sa); // default security attribute
FHandle := hPipe;
streamtrans : IStreamTransport;
http : IHTTPClient;
protType, p : TKnownProtocol;
+const
+ // pipe timeouts to be used
+ DEBUG_TIMEOUT = 30 * 1000;
+ RELEASE_TIMEOUT = DEFAULT_THRIFT_PIPE_TIMEOUT;
+ TIMEOUT = RELEASE_TIMEOUT;
begin
bBuffered := False;;
bFramed := False;
begin
if sPipeName <> '' then begin
Console.WriteLine('Using named pipe ('+sPipeName+')');
- streamtrans := TNamedPipeImpl.Create( sPipeName);
+ streamtrans := TNamedPipeImpl.Create( sPipeName, 0, nil, TIMEOUT);
end
else if bAnonPipe then begin
Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
trans := streamtrans;
if bBuffered then begin
- trans := TBufferedTransportImpl.Create( streamtrans);
+ trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
Console.WriteLine('Using buffered transport');
end;
// create protocol instance, default to BinaryProtocol
case protType of
- prot_Binary: prot := TBinaryProtocolImpl.Create( trans);
+ prot_Binary: prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
prot_JSON : prot := TJSONProtocolImpl.Create( trans);
else
ASSERT( FALSE); // unhandled case!
- prot := TBinaryProtocolImpl.Create( trans); // use default
+ prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE); // use default
end;
thread := TClientThread.Create( trans, prot, FNumIteration);
KNOWN_PROTOCOLS : array[TKnownProtocol] of string
= ('binary', 'JSON');
+ // defaults are: read=false, write=true
+ BINARY_STRICT_READ = FALSE;
+ BINARY_STRICT_WRITE = FALSE;
+
implementation
// nothing
i : Integer;
s : string;
protType, p : TKnownProtocol;
+const
+ // pipe timeouts to be used
+ DEBUG_TIMEOUT = 30 * 1000;
+ RELEASE_TIMEOUT = 0; // server-side default
+ TIMEOUT = RELEASE_TIMEOUT;
begin
try
UseBufferedSockets := False;
// create protocol factory, default to BinaryProtocol
case protType of
- prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
else
ASSERT( FALSE); // unhandled case!
- ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
end;
ASSERT( ProtocolFactory <> nil);
Console.WriteLine('- '+KNOWN_PROTOCOLS[protType]+' protocol');
if sPipeName <> '' then begin
Console.WriteLine('- named pipe ('+sPipeName+')');
- namedpipe := TNamedServerPipeImpl.Create( sPipeName);
+ namedpipe := TNamedServerPipeImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, TIMEOUT);
servertrans := namedpipe;
end
else if AnonPipe then begin
uses
SysUtils,
TestServer in 'TestServer.pas',
- Thrift.Test in 'gen-delphi\Thrift.Test.pas',
+ Thrift.Test, // in gen-delphi folder
Thrift in '..\src\Thrift.pas',
Thrift.Transport in '..\src\Thrift.Transport.pas',
Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',