summaryrefslogtreecommitdiffstats
path: root/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas
diff options
context:
space:
mode:
Diffstat (limited to 'src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas')
-rw-r--r--src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas1370
1 files changed, 1370 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas b/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas
new file mode 100644
index 000000000..609dfc605
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas
@@ -0,0 +1,1370 @@
+(*
+ * 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.
+ *)
+
+{$SCOPEDENUMS ON}
+
+unit Thrift.Protocol;
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Contnrs,
+ Thrift.Exception,
+ Thrift.Stream,
+ Thrift.Utils,
+ Thrift.Collections,
+ Thrift.Transport;
+
+type
+
+ TType = (
+ Stop = 0,
+ Void = 1,
+ Bool_ = 2,
+ Byte_ = 3,
+ Double_ = 4,
+ I16 = 6,
+ I32 = 8,
+ I64 = 10,
+ String_ = 11,
+ Struct = 12,
+ Map = 13,
+ Set_ = 14,
+ List = 15
+ );
+
+ TMessageType = (
+ Call = 1,
+ Reply = 2,
+ Exception = 3,
+ Oneway = 4
+ );
+
+const
+ VALID_TTYPES = [
+ TType.Stop, TType.Void,
+ TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_,
+ TType.Struct, TType.Map, TType.Set_, TType.List
+ ];
+
+ VALID_MESSAGETYPES = [Low(TMessageType)..High(TMessageType)];
+
+const
+ DEFAULT_RECURSION_LIMIT = 64;
+
+type
+ IProtocol = interface;
+
+ TThriftMessage = record
+ Name: string;
+ Type_: TMessageType;
+ SeqID: Integer;
+ end;
+
+ TThriftStruct = record
+ Name: string;
+ end;
+
+ TThriftField = record
+ Name: string;
+ Type_: TType;
+ Id: SmallInt;
+ end;
+
+ TThriftList = record
+ ElementType: TType;
+ Count: Integer;
+ end;
+
+ TThriftMap = record
+ KeyType: TType;
+ ValueType: TType;
+ Count: Integer;
+ end;
+
+ TThriftSet = record
+ ElementType: TType;
+ Count: Integer;
+ end;
+
+
+
+ IProtocolFactory = interface
+ ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']
+ function GetProtocol( const trans: ITransport): IProtocol;
+ end;
+
+ TProtocolException = class( TException)
+ public
+ const // TODO(jensg): change into enum
+ UNKNOWN = 0;
+ INVALID_DATA = 1;
+ NEGATIVE_SIZE = 2;
+ SIZE_LIMIT = 3;
+ BAD_VERSION = 4;
+ NOT_IMPLEMENTED = 5;
+ DEPTH_LIMIT = 6;
+ protected
+ constructor HiddenCreate(const Msg: string);
+ public
+ // purposefully hide inherited constructor
+ class function Create(const Msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
+ class function Create: TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
+ class function Create( type_: Integer): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
+ class function Create( type_: Integer; const msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
+ end;
+
+ // Needed to remove deprecation warning
+ TProtocolExceptionSpecialized = class abstract (TProtocolException)
+ public
+ constructor Create(const Msg: string);
+ end;
+
+ TProtocolExceptionUnknown = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionInvalidData = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionNegativeSize = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionSizeLimit = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionBadVersion = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionNotImplemented = class (TProtocolExceptionSpecialized);
+ TProtocolExceptionDepthLimit = class (TProtocolExceptionSpecialized);
+
+
+ TProtocolUtil = class
+ public
+ class procedure Skip( prot: IProtocol; type_: TType);
+ end;
+
+ IProtocolRecursionTracker = interface
+ ['{29CA033F-BB56-49B1-9EE3-31B1E82FC7A5}']
+ // no members yet
+ end;
+
+ TProtocolRecursionTrackerImpl = class abstract( TInterfacedObject, IProtocolRecursionTracker)
+ protected
+ FProtocol : IProtocol;
+ public
+ constructor Create( prot : IProtocol);
+ destructor Destroy; override;
+ end;
+
+ IProtocol = interface
+ ['{602A7FFB-0D9E-4CD8-8D7F-E5076660588A}']
+ function GetTransport: ITransport;
+ procedure WriteMessageBegin( const msg: TThriftMessage);
+ procedure WriteMessageEnd;
+ procedure WriteStructBegin( const struc: TThriftStruct);
+ procedure WriteStructEnd;
+ procedure WriteFieldBegin( const field: TThriftField);
+ procedure WriteFieldEnd;
+ procedure WriteFieldStop;
+ procedure WriteMapBegin( const map: TThriftMap);
+ procedure WriteMapEnd;
+ procedure WriteListBegin( const list: TThriftList);
+ procedure WriteListEnd();
+ procedure WriteSetBegin( const set_: TThriftSet );
+ procedure WriteSetEnd();
+ procedure WriteBool( b: Boolean);
+ procedure WriteByte( b: ShortInt);
+ procedure WriteI16( i16: SmallInt);
+ procedure WriteI32( i32: Integer);
+ procedure WriteI64( const i64: Int64);
+ procedure WriteDouble( const d: Double);
+ procedure WriteString( const s: string );
+ procedure WriteAnsiString( const s: AnsiString);
+ procedure WriteBinary( const b: TBytes);
+
+ function ReadMessageBegin: TThriftMessage;
+ procedure ReadMessageEnd();
+ function ReadStructBegin: TThriftStruct;
+ procedure ReadStructEnd;
+ function ReadFieldBegin: TThriftField;
+ procedure ReadFieldEnd();
+ function ReadMapBegin: TThriftMap;
+ procedure ReadMapEnd();
+ function ReadListBegin: TThriftList;
+ procedure ReadListEnd();
+ function ReadSetBegin: TThriftSet;
+ procedure ReadSetEnd();
+ function ReadBool: Boolean;
+ function ReadByte: ShortInt;
+ function ReadI16: SmallInt;
+ function ReadI32: Integer;
+ function ReadI64: Int64;
+ function ReadDouble:Double;
+ function ReadBinary: TBytes;
+ function ReadString: string;
+ function ReadAnsiString: AnsiString;
+
+ procedure SetRecursionLimit( value : Integer);
+ function GetRecursionLimit : Integer;
+ function NextRecursionLevel : IProtocolRecursionTracker;
+ procedure IncrementRecursionDepth;
+ procedure DecrementRecursionDepth;
+
+ property Transport: ITransport read GetTransport;
+ property RecursionLimit : Integer read GetRecursionLimit write SetRecursionLimit;
+ end;
+
+ TProtocolImpl = class abstract( TInterfacedObject, IProtocol)
+ protected
+ FTrans : ITransport;
+ FRecursionLimit : Integer;
+ FRecursionDepth : Integer;
+
+ procedure SetRecursionLimit( value : Integer);
+ function GetRecursionLimit : Integer;
+ function NextRecursionLevel : IProtocolRecursionTracker;
+ procedure IncrementRecursionDepth;
+ procedure DecrementRecursionDepth;
+
+ function GetTransport: ITransport;
+ public
+ procedure WriteMessageBegin( const msg: TThriftMessage); virtual; abstract;
+ procedure WriteMessageEnd; virtual; abstract;
+ procedure WriteStructBegin( const struc: TThriftStruct); virtual; abstract;
+ procedure WriteStructEnd; virtual; abstract;
+ procedure WriteFieldBegin( const field: TThriftField); virtual; abstract;
+ procedure WriteFieldEnd; virtual; abstract;
+ procedure WriteFieldStop; virtual; abstract;
+ procedure WriteMapBegin( const map: TThriftMap); virtual; abstract;
+ procedure WriteMapEnd; virtual; abstract;
+ procedure WriteListBegin( const list: TThriftList); virtual; abstract;
+ procedure WriteListEnd(); virtual; abstract;
+ procedure WriteSetBegin( const set_: TThriftSet ); virtual; abstract;
+ procedure WriteSetEnd(); virtual; abstract;
+ procedure WriteBool( b: Boolean); virtual; abstract;
+ procedure WriteByte( b: ShortInt); virtual; abstract;
+ procedure WriteI16( i16: SmallInt); virtual; abstract;
+ procedure WriteI32( i32: Integer); virtual; abstract;
+ procedure WriteI64( const i64: Int64); virtual; abstract;
+ procedure WriteDouble( const d: Double); virtual; abstract;
+ procedure WriteString( const s: string ); virtual;
+ procedure WriteAnsiString( const s: AnsiString); virtual;
+ procedure WriteBinary( const b: TBytes); virtual; abstract;
+
+ function ReadMessageBegin: TThriftMessage; virtual; abstract;
+ procedure ReadMessageEnd(); virtual; abstract;
+ function ReadStructBegin: TThriftStruct; virtual; abstract;
+ procedure ReadStructEnd; virtual; abstract;
+ function ReadFieldBegin: TThriftField; virtual; abstract;
+ procedure ReadFieldEnd(); virtual; abstract;
+ function ReadMapBegin: TThriftMap; virtual; abstract;
+ procedure ReadMapEnd(); virtual; abstract;
+ function ReadListBegin: TThriftList; virtual; abstract;
+ procedure ReadListEnd(); virtual; abstract;
+ function ReadSetBegin: TThriftSet; virtual; abstract;
+ procedure ReadSetEnd(); virtual; abstract;
+ function ReadBool: Boolean; virtual; abstract;
+ function ReadByte: ShortInt; virtual; abstract;
+ function ReadI16: SmallInt; virtual; abstract;
+ function ReadI32: Integer; virtual; abstract;
+ function ReadI64: Int64; virtual; abstract;
+ function ReadDouble:Double; virtual; abstract;
+ function ReadBinary: TBytes; virtual; abstract;
+ function ReadString: string; virtual;
+ function ReadAnsiString: AnsiString; virtual;
+
+ property Transport: ITransport read GetTransport;
+
+ constructor Create( trans: ITransport );
+ end;
+
+ IBase = interface( ISupportsToString)
+ ['{AFF6CECA-5200-4540-950E-9B89E0C1C00C}']
+ procedure Read( const iprot: IProtocol);
+ procedure Write( const iprot: IProtocol);
+ end;
+
+
+ TBinaryProtocolImpl = class( TProtocolImpl )
+ protected
+ const
+ VERSION_MASK : Cardinal = $ffff0000;
+ VERSION_1 : Cardinal = $80010000;
+ protected
+ FStrictRead : Boolean;
+ FStrictWrite : Boolean;
+
+ private
+ function ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer; inline;
+ function ReadStringBody( size: Integer): string;
+
+ public
+
+ type
+ TFactory = class( TInterfacedObject, IProtocolFactory)
+ protected
+ FStrictRead : Boolean;
+ FStrictWrite : Boolean;
+ public
+ function GetProtocol( const trans: ITransport): IProtocol;
+ constructor Create( AStrictRead, AStrictWrite: Boolean ); overload;
+ constructor Create; overload;
+ end;
+
+ constructor Create( const trans: ITransport); overload;
+ constructor Create( const trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;
+
+ procedure WriteMessageBegin( const msg: TThriftMessage); override;
+ procedure WriteMessageEnd; override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
+ procedure WriteStructEnd; override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
+ procedure WriteFieldEnd; override;
+ procedure WriteFieldStop; override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
+ procedure WriteMapEnd; override;
+ procedure WriteListBegin( const list: TThriftList); override;
+ procedure WriteListEnd(); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
+ procedure WriteSetEnd(); override;
+ procedure WriteBool( b: Boolean); override;
+ procedure WriteByte( b: ShortInt); override;
+ procedure WriteI16( i16: SmallInt); override;
+ procedure WriteI32( i32: Integer); override;
+ procedure WriteI64( const i64: Int64); override;
+ procedure WriteDouble( const d: Double); override;
+ procedure WriteBinary( const b: TBytes); override;
+
+ function ReadMessageBegin: TThriftMessage; override;
+ procedure ReadMessageEnd(); override;
+ function ReadStructBegin: TThriftStruct; override;
+ procedure ReadStructEnd; override;
+ function ReadFieldBegin: TThriftField; override;
+ procedure ReadFieldEnd(); override;
+ function ReadMapBegin: TThriftMap; override;
+ procedure ReadMapEnd(); override;
+ function ReadListBegin: TThriftList; override;
+ procedure ReadListEnd(); override;
+ function ReadSetBegin: TThriftSet; override;
+ procedure ReadSetEnd(); override;
+ function ReadBool: Boolean; override;
+ function ReadByte: ShortInt; override;
+ function ReadI16: SmallInt; override;
+ function ReadI32: Integer; override;
+ function ReadI64: Int64; override;
+ function ReadDouble:Double; override;
+ function ReadBinary: TBytes; override;
+
+ end;
+
+
+ { TProtocolDecorator forwards all requests to an enclosed TProtocol instance,
+ providing a way to author concise concrete decorator subclasses. The decorator
+ does not (and should not) modify the behaviour of the enclosed TProtocol
+
+ See p.175 of Design Patterns (by Gamma et al.)
+ }
+ TProtocolDecorator = class( TProtocolImpl)
+ private
+ FWrappedProtocol : IProtocol;
+
+ public
+ // Encloses the specified protocol.
+ // All operations will be forward to the given protocol. Must be non-null.
+ constructor Create( const aProtocol : IProtocol);
+
+ procedure WriteMessageBegin( const msg: TThriftMessage); override;
+ procedure WriteMessageEnd; override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
+ procedure WriteStructEnd; override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
+ procedure WriteFieldEnd; override;
+ procedure WriteFieldStop; override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
+ procedure WriteMapEnd; override;
+ procedure WriteListBegin( const list: TThriftList); override;
+ procedure WriteListEnd(); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
+ procedure WriteSetEnd(); override;
+ procedure WriteBool( b: Boolean); override;
+ procedure WriteByte( b: ShortInt); override;
+ procedure WriteI16( i16: SmallInt); override;
+ procedure WriteI32( i32: Integer); override;
+ procedure WriteI64( const i64: Int64); override;
+ procedure WriteDouble( const d: Double); override;
+ procedure WriteString( const s: string ); override;
+ procedure WriteAnsiString( const s: AnsiString); override;
+ procedure WriteBinary( const b: TBytes); override;
+
+ function ReadMessageBegin: TThriftMessage; override;
+ procedure ReadMessageEnd(); override;
+ function ReadStructBegin: TThriftStruct; override;
+ procedure ReadStructEnd; override;
+ function ReadFieldBegin: TThriftField; override;
+ procedure ReadFieldEnd(); override;
+ function ReadMapBegin: TThriftMap; override;
+ procedure ReadMapEnd(); override;
+ function ReadListBegin: TThriftList; override;
+ procedure ReadListEnd(); override;
+ function ReadSetBegin: TThriftSet; override;
+ procedure ReadSetEnd(); override;
+ function ReadBool: Boolean; override;
+ function ReadByte: ShortInt; override;
+ function ReadI16: SmallInt; override;
+ function ReadI32: Integer; override;
+ function ReadI64: Int64; override;
+ function ReadDouble:Double; override;
+ function ReadBinary: TBytes; override;
+ function ReadString: string; override;
+ function ReadAnsiString: AnsiString; override;
+ end;
+
+
+type
+ IRequestEvents = interface
+ ['{F926A26A-5B00-4560-86FA-2CAE3BA73DAF}']
+ // Called before reading arguments.
+ procedure PreRead;
+ // Called between reading arguments and calling the handler.
+ procedure PostRead;
+ // Called between calling the handler and writing the response.
+ procedure PreWrite;
+ // Called after writing the response.
+ procedure PostWrite;
+ // Called when an oneway (async) function call completes successfully.
+ procedure OnewayComplete;
+ // Called if the handler throws an undeclared exception.
+ procedure UnhandledError( const e : Exception);
+ // Called when a client has finished request-handling to clean up
+ procedure CleanupContext;
+ end;
+
+
+ IProcessorEvents = interface
+ ['{A8661119-657C-447D-93C5-512E36162A45}']
+ // Called when a client is about to call the processor.
+ procedure Processing( const transport : ITransport);
+ // Called on any service function invocation
+ function CreateRequestContext( const aFunctionName : string) : IRequestEvents;
+ // Called when a client has finished request-handling to clean up
+ procedure CleanupContext;
+ end;
+
+
+ IProcessor = interface
+ ['{7BAE92A5-46DA-4F13-B6EA-0EABE233EE5F}']
+ function Process( const iprot :IProtocol; const oprot: IProtocol; const events : IProcessorEvents = nil): Boolean;
+ end;
+
+
+procedure Init( var rec : TThriftMessage; const AName: string = ''; const AMessageType: TMessageType = Low(TMessageType); const ASeqID: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftStruct; const AName: string = ''); overload; inline;
+procedure Init( var rec : TThriftField; const AName: string = ''; const AType: TType = Low(TType); const AID: SmallInt = 0); overload; inline;
+procedure Init( var rec : TThriftMap; const AKeyType: TType = Low(TType); const AValueType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftSet; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftList; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+
+
+implementation
+
+function ConvertInt64ToDouble( const n: Int64): Double;
+begin
+ ASSERT( SizeOf(n) = SizeOf(Result));
+ System.Move( n, Result, SizeOf(Result));
+end;
+
+function ConvertDoubleToInt64( const d: Double): Int64;
+begin
+ ASSERT( SizeOf(d) = SizeOf(Result));
+ System.Move( d, Result, SizeOf(Result));
+end;
+
+
+
+{ TProtocolRecursionTrackerImpl }
+
+constructor TProtocolRecursionTrackerImpl.Create( prot : IProtocol);
+begin
+ inherited Create;
+
+ // storing the pointer *after* the (successful) increment is important here
+ prot.IncrementRecursionDepth;
+ FProtocol := prot;
+end;
+
+destructor TProtocolRecursionTrackerImpl.Destroy;
+begin
+ try
+ // we have to release the reference iff the pointer has been stored
+ if FProtocol <> nil then begin
+ FProtocol.DecrementRecursionDepth;
+ FProtocol := nil;
+ end;
+ finally
+ inherited Destroy;
+ end;
+end;
+
+{ TProtocolImpl }
+
+constructor TProtocolImpl.Create(trans: ITransport);
+begin
+ inherited Create;
+ FTrans := trans;
+ FRecursionLimit := DEFAULT_RECURSION_LIMIT;
+ FRecursionDepth := 0;
+end;
+
+procedure TProtocolImpl.SetRecursionLimit( value : Integer);
+begin
+ FRecursionLimit := value;
+end;
+
+function TProtocolImpl.GetRecursionLimit : Integer;
+begin
+ result := FRecursionLimit;
+end;
+
+function TProtocolImpl.NextRecursionLevel : IProtocolRecursionTracker;
+begin
+ result := TProtocolRecursionTrackerImpl.Create(Self);
+end;
+
+procedure TProtocolImpl.IncrementRecursionDepth;
+begin
+ if FRecursionDepth < FRecursionLimit
+ then Inc(FRecursionDepth)
+ else raise TProtocolExceptionDepthLimit.Create('Depth limit exceeded');
+end;
+
+procedure TProtocolImpl.DecrementRecursionDepth;
+begin
+ Dec(FRecursionDepth)
+end;
+
+function TProtocolImpl.GetTransport: ITransport;
+begin
+ Result := FTrans;
+end;
+
+function TProtocolImpl.ReadAnsiString: AnsiString;
+var
+ b : TBytes;
+ len : Integer;
+begin
+ Result := '';
+ b := ReadBinary;
+ len := Length( b );
+ if len > 0 then
+ begin
+ SetLength( Result, len);
+ System.Move( b[0], Pointer(Result)^, len );
+ end;
+end;
+
+function TProtocolImpl.ReadString: string;
+begin
+ Result := TEncoding.UTF8.GetString( ReadBinary );
+end;
+
+procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);
+var
+ b : TBytes;
+ len : Integer;
+begin
+ len := Length(s);
+ SetLength( b, len);
+ if len > 0 then
+ begin
+ System.Move( Pointer(s)^, b[0], len );
+ end;
+ WriteBinary( b );
+end;
+
+procedure TProtocolImpl.WriteString(const s: string);
+var
+ b : TBytes;
+begin
+ b := TEncoding.UTF8.GetBytes(s);
+ WriteBinary( b );
+end;
+
+{ TProtocolUtil }
+
+class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
+var field : TThriftField;
+ map : TThriftMap;
+ set_ : TThriftSet;
+ list : TThriftList;
+ i : Integer;
+ tracker : IProtocolRecursionTracker;
+begin
+ tracker := prot.NextRecursionLevel;
+ case type_ of
+ // simple types
+ TType.Bool_ : prot.ReadBool();
+ TType.Byte_ : prot.ReadByte();
+ TType.I16 : prot.ReadI16();
+ TType.I32 : prot.ReadI32();
+ TType.I64 : prot.ReadI64();
+ TType.Double_ : prot.ReadDouble();
+ TType.String_ : prot.ReadBinary();// Don't try to decode the string, just skip it.
+
+ // structured types
+ TType.Struct : begin
+ prot.ReadStructBegin();
+ while TRUE do begin
+ field := prot.ReadFieldBegin();
+ if (field.Type_ = TType.Stop) then Break;
+ Skip(prot, field.Type_);
+ prot.ReadFieldEnd();
+ end;
+ prot.ReadStructEnd();
+ end;
+
+ TType.Map : begin
+ map := prot.ReadMapBegin();
+ for i := 0 to map.Count-1 do begin
+ Skip(prot, map.KeyType);
+ Skip(prot, map.ValueType);
+ end;
+ prot.ReadMapEnd();
+ end;
+
+ TType.Set_ : begin
+ set_ := prot.ReadSetBegin();
+ for i := 0 to set_.Count-1
+ do Skip( prot, set_.ElementType);
+ prot.ReadSetEnd();
+ end;
+
+ TType.List : begin
+ list := prot.ReadListBegin();
+ for i := 0 to list.Count-1
+ do Skip( prot, list.ElementType);
+ prot.ReadListEnd();
+ end;
+
+ else
+ raise TProtocolExceptionInvalidData.Create('Unexpected type '+IntToStr(Ord(type_)));
+ end;
+end;
+
+
+{ TBinaryProtocolImpl }
+
+constructor TBinaryProtocolImpl.Create( const trans: ITransport);
+begin
+ //no inherited
+ Create( trans, False, True);
+end;
+
+constructor TBinaryProtocolImpl.Create( const trans: ITransport; strictRead,
+ strictWrite: Boolean);
+begin
+ inherited Create( trans );
+ FStrictRead := strictRead;
+ FStrictWrite := strictWrite;
+end;
+
+function TBinaryProtocolImpl.ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;
+begin
+ Result := FTrans.ReadAll( pBuf, buflen, off, len );
+end;
+
+function TBinaryProtocolImpl.ReadBinary: TBytes;
+var
+ size : Integer;
+ buf : TBytes;
+begin
+ size := ReadI32;
+ SetLength( buf, size );
+ FTrans.ReadAll( buf, 0, size);
+ Result := buf;
+end;
+
+function TBinaryProtocolImpl.ReadBool: Boolean;
+begin
+ Result := (ReadByte = 1);
+end;
+
+function TBinaryProtocolImpl.ReadByte: ShortInt;
+begin
+ ReadAll( @result, SizeOf(result), 0, 1);
+end;
+
+function TBinaryProtocolImpl.ReadDouble: Double;
+begin
+ Result := ConvertInt64ToDouble( ReadI64 )
+end;
+
+function TBinaryProtocolImpl.ReadFieldBegin: TThriftField;
+begin
+ Init( result, '', TType( ReadByte), 0);
+ if ( result.Type_ <> TType.Stop ) then begin
+ result.Id := ReadI16;
+ end;
+end;
+
+procedure TBinaryProtocolImpl.ReadFieldEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadI16: SmallInt;
+var i16in : packed array[0..1] of Byte;
+begin
+ ReadAll( @i16in, Sizeof(i16in), 0, 2);
+ Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
+end;
+
+function TBinaryProtocolImpl.ReadI32: Integer;
+var i32in : packed array[0..3] of Byte;
+begin
+ ReadAll( @i32in, SizeOf(i32in), 0, 4);
+
+ Result := Integer(
+ ((i32in[0] and $FF) shl 24) or
+ ((i32in[1] and $FF) shl 16) or
+ ((i32in[2] and $FF) shl 8) or
+ (i32in[3] and $FF));
+
+end;
+
+function TBinaryProtocolImpl.ReadI64: Int64;
+var i64in : packed array[0..7] of Byte;
+begin
+ ReadAll( @i64in, SizeOf(i64in), 0, 8);
+ Result :=
+ (Int64( i64in[0] and $FF) shl 56) or
+ (Int64( i64in[1] and $FF) shl 48) or
+ (Int64( i64in[2] and $FF) shl 40) or
+ (Int64( i64in[3] and $FF) shl 32) or
+ (Int64( i64in[4] and $FF) shl 24) or
+ (Int64( i64in[5] and $FF) shl 16) or
+ (Int64( i64in[6] and $FF) shl 8) or
+ (Int64( i64in[7] and $FF));
+end;
+
+function TBinaryProtocolImpl.ReadListBegin: TThriftList;
+begin
+ result.ElementType := TType(ReadByte);
+ result.Count := ReadI32;
+end;
+
+procedure TBinaryProtocolImpl.ReadListEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadMapBegin: TThriftMap;
+begin
+ result.KeyType := TType(ReadByte);
+ result.ValueType := TType(ReadByte);
+ result.Count := ReadI32;
+end;
+
+procedure TBinaryProtocolImpl.ReadMapEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadMessageBegin: TThriftMessage;
+var
+ size : Integer;
+ version : Integer;
+begin
+ Init( result);
+ size := ReadI32;
+ if (size < 0) then begin
+ version := size and Integer( VERSION_MASK);
+ if ( version <> Integer( VERSION_1)) then begin
+ raise TProtocolExceptionBadVersion.Create('Bad version in ReadMessageBegin: ' + IntToStr(version) );
+ end;
+ result.Type_ := TMessageType( size and $000000ff);
+ result.Name := ReadString;
+ result.SeqID := ReadI32;
+ end
+ else begin
+ if FStrictRead then begin
+ raise TProtocolExceptionBadVersion.Create('Missing version in readMessageBegin, old client?' );
+ end;
+ result.Name := ReadStringBody( size );
+ result.Type_ := TMessageType( ReadByte );
+ result.SeqID := ReadI32;
+ end;
+end;
+
+procedure TBinaryProtocolImpl.ReadMessageEnd;
+begin
+ inherited;
+
+end;
+
+function TBinaryProtocolImpl.ReadSetBegin: TThriftSet;
+begin
+ result.ElementType := TType(ReadByte);
+ result.Count := ReadI32;
+end;
+
+procedure TBinaryProtocolImpl.ReadSetEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;
+var
+ buf : TBytes;
+begin
+ SetLength( buf, size );
+ FTrans.ReadAll( buf, 0, size );
+ Result := TEncoding.UTF8.GetString( buf);
+end;
+
+function TBinaryProtocolImpl.ReadStructBegin: TThriftStruct;
+begin
+ Init( Result);
+end;
+
+procedure TBinaryProtocolImpl.ReadStructEnd;
+begin
+ inherited;
+
+end;
+
+procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);
+var iLen : Integer;
+begin
+ iLen := Length(b);
+ WriteI32( iLen);
+ if iLen > 0 then FTrans.Write(b, 0, iLen);
+end;
+
+procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
+begin
+ if b then begin
+ WriteByte( 1 );
+ end else begin
+ WriteByte( 0 );
+ end;
+end;
+
+procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);
+begin
+ FTrans.Write( @b, 0, 1);
+end;
+
+procedure TBinaryProtocolImpl.WriteDouble( const d: Double);
+begin
+ WriteI64(ConvertDoubleToInt64(d));
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldBegin( const field: TThriftField);
+begin
+ WriteByte(ShortInt(field.Type_));
+ WriteI16(field.ID);
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldStop;
+begin
+ WriteByte(ShortInt(TType.Stop));
+end;
+
+procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
+var i16out : packed array[0..1] of Byte;
+begin
+ i16out[0] := Byte($FF and (i16 shr 8));
+ i16out[1] := Byte($FF and i16);
+ FTrans.Write( @i16out, 0, 2);
+end;
+
+procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
+var i32out : packed array[0..3] of Byte;
+begin
+ i32out[0] := Byte($FF and (i32 shr 24));
+ i32out[1] := Byte($FF and (i32 shr 16));
+ i32out[2] := Byte($FF and (i32 shr 8));
+ i32out[3] := Byte($FF and i32);
+ FTrans.Write( @i32out, 0, 4);
+end;
+
+procedure TBinaryProtocolImpl.WriteI64( const i64: Int64);
+var i64out : packed array[0..7] of Byte;
+begin
+ i64out[0] := Byte($FF and (i64 shr 56));
+ i64out[1] := Byte($FF and (i64 shr 48));
+ i64out[2] := Byte($FF and (i64 shr 40));
+ i64out[3] := Byte($FF and (i64 shr 32));
+ i64out[4] := Byte($FF and (i64 shr 24));
+ i64out[5] := Byte($FF and (i64 shr 16));
+ i64out[6] := Byte($FF and (i64 shr 8));
+ i64out[7] := Byte($FF and i64);
+ FTrans.Write( @i64out, 0, 8);
+end;
+
+procedure TBinaryProtocolImpl.WriteListBegin( const list: TThriftList);
+begin
+ WriteByte(ShortInt(list.ElementType));
+ WriteI32(list.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteListEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteMapBegin( const map: TThriftMap);
+begin
+ WriteByte(ShortInt(map.KeyType));
+ WriteByte(ShortInt(map.ValueType));
+ WriteI32(map.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteMapEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
+var
+ version : Cardinal;
+begin
+ if FStrictWrite then
+ begin
+ version := VERSION_1 or Cardinal( msg.Type_);
+ WriteI32( Integer( version) );
+ WriteString( msg.Name);
+ WriteI32( msg.SeqID);
+ end else
+ begin
+ WriteString( msg.Name);
+ WriteByte(ShortInt( msg.Type_));
+ WriteI32( msg.SeqID);
+ end;
+end;
+
+procedure TBinaryProtocolImpl.WriteMessageEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteSetBegin( const set_: TThriftSet);
+begin
+ WriteByte(ShortInt(set_.ElementType));
+ WriteI32(set_.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteSetEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteStructEnd;
+begin
+
+end;
+
+{ TProtocolException }
+
+constructor TProtocolException.HiddenCreate(const Msg: string);
+begin
+ inherited Create(Msg);
+end;
+
+class function TProtocolException.Create(const Msg: string): TProtocolException;
+begin
+ Result := TProtocolExceptionUnknown.Create(Msg);
+end;
+
+class function TProtocolException.Create: TProtocolException;
+begin
+ Result := TProtocolExceptionUnknown.Create('');
+end;
+
+class function TProtocolException.Create(type_: Integer): TProtocolException;
+begin
+{$WARN SYMBOL_DEPRECATED OFF}
+ Result := Create(type_, '');
+{$WARN SYMBOL_DEPRECATED DEFAULT}
+end;
+
+class function TProtocolException.Create(type_: Integer; const msg: string): TProtocolException;
+begin
+ case type_ of
+ INVALID_DATA: Result := TProtocolExceptionInvalidData.Create(msg);
+ NEGATIVE_SIZE: Result := TProtocolExceptionNegativeSize.Create(msg);
+ SIZE_LIMIT: Result := TProtocolExceptionSizeLimit.Create(msg);
+ BAD_VERSION: Result := TProtocolExceptionBadVersion.Create(msg);
+ NOT_IMPLEMENTED: Result := TProtocolExceptionNotImplemented.Create(msg);
+ DEPTH_LIMIT: Result := TProtocolExceptionDepthLimit.Create(msg);
+ else
+ Result := TProtocolExceptionUnknown.Create(msg);
+ end;
+end;
+
+{ TProtocolExceptionSpecialized }
+
+constructor TProtocolExceptionSpecialized.Create(const Msg: string);
+begin
+ inherited HiddenCreate(Msg);
+end;
+
+{ TBinaryProtocolImpl.TFactory }
+
+constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);
+begin
+ inherited Create;
+ FStrictRead := AStrictRead;
+ FStrictWrite := AStrictWrite;
+end;
+
+constructor TBinaryProtocolImpl.TFactory.Create;
+begin
+ //no inherited;
+ Create( False, True )
+end;
+
+function TBinaryProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
+begin
+ Result := TBinaryProtocolImpl.Create( trans, FStrictRead, FStrictWrite);
+end;
+
+
+{ TProtocolDecorator }
+
+constructor TProtocolDecorator.Create( const aProtocol : IProtocol);
+begin
+ ASSERT( aProtocol <> nil);
+ inherited Create( aProtocol.Transport);
+ FWrappedProtocol := aProtocol;
+end;
+
+
+procedure TProtocolDecorator.WriteMessageBegin( const msg: TThriftMessage);
+begin
+ FWrappedProtocol.WriteMessageBegin( msg);
+end;
+
+
+procedure TProtocolDecorator.WriteMessageEnd;
+begin
+ FWrappedProtocol.WriteMessageEnd;
+end;
+
+
+procedure TProtocolDecorator.WriteStructBegin( const struc: TThriftStruct);
+begin
+ FWrappedProtocol.WriteStructBegin( struc);
+end;
+
+
+procedure TProtocolDecorator.WriteStructEnd;
+begin
+ FWrappedProtocol.WriteStructEnd;
+end;
+
+
+procedure TProtocolDecorator.WriteFieldBegin( const field: TThriftField);
+begin
+ FWrappedProtocol.WriteFieldBegin( field);
+end;
+
+
+procedure TProtocolDecorator.WriteFieldEnd;
+begin
+ FWrappedProtocol.WriteFieldEnd;
+end;
+
+
+procedure TProtocolDecorator.WriteFieldStop;
+begin
+ FWrappedProtocol.WriteFieldStop;
+end;
+
+
+procedure TProtocolDecorator.WriteMapBegin( const map: TThriftMap);
+begin
+ FWrappedProtocol.WriteMapBegin( map);
+end;
+
+
+procedure TProtocolDecorator.WriteMapEnd;
+begin
+ FWrappedProtocol.WriteMapEnd;
+end;
+
+
+procedure TProtocolDecorator.WriteListBegin( const list: TThriftList);
+begin
+ FWrappedProtocol.WriteListBegin( list);
+end;
+
+
+procedure TProtocolDecorator.WriteListEnd();
+begin
+ FWrappedProtocol.WriteListEnd();
+end;
+
+
+procedure TProtocolDecorator.WriteSetBegin( const set_: TThriftSet );
+begin
+ FWrappedProtocol.WriteSetBegin( set_);
+end;
+
+
+procedure TProtocolDecorator.WriteSetEnd();
+begin
+ FWrappedProtocol.WriteSetEnd();
+end;
+
+
+procedure TProtocolDecorator.WriteBool( b: Boolean);
+begin
+ FWrappedProtocol.WriteBool( b);
+end;
+
+
+procedure TProtocolDecorator.WriteByte( b: ShortInt);
+begin
+ FWrappedProtocol.WriteByte( b);
+end;
+
+
+procedure TProtocolDecorator.WriteI16( i16: SmallInt);
+begin
+ FWrappedProtocol.WriteI16( i16);
+end;
+
+
+procedure TProtocolDecorator.WriteI32( i32: Integer);
+begin
+ FWrappedProtocol.WriteI32( i32);
+end;
+
+
+procedure TProtocolDecorator.WriteI64( const i64: Int64);
+begin
+ FWrappedProtocol.WriteI64( i64);
+end;
+
+
+procedure TProtocolDecorator.WriteDouble( const d: Double);
+begin
+ FWrappedProtocol.WriteDouble( d);
+end;
+
+
+procedure TProtocolDecorator.WriteString( const s: string );
+begin
+ FWrappedProtocol.WriteString( s);
+end;
+
+
+procedure TProtocolDecorator.WriteAnsiString( const s: AnsiString);
+begin
+ FWrappedProtocol.WriteAnsiString( s);
+end;
+
+
+procedure TProtocolDecorator.WriteBinary( const b: TBytes);
+begin
+ FWrappedProtocol.WriteBinary( b);
+end;
+
+
+function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
+begin
+ result := FWrappedProtocol.ReadMessageBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadMessageEnd();
+begin
+ FWrappedProtocol.ReadMessageEnd();
+end;
+
+
+function TProtocolDecorator.ReadStructBegin: TThriftStruct;
+begin
+ result := FWrappedProtocol.ReadStructBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadStructEnd;
+begin
+ FWrappedProtocol.ReadStructEnd;
+end;
+
+
+function TProtocolDecorator.ReadFieldBegin: TThriftField;
+begin
+ result := FWrappedProtocol.ReadFieldBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadFieldEnd();
+begin
+ FWrappedProtocol.ReadFieldEnd();
+end;
+
+
+function TProtocolDecorator.ReadMapBegin: TThriftMap;
+begin
+ result := FWrappedProtocol.ReadMapBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadMapEnd();
+begin
+ FWrappedProtocol.ReadMapEnd();
+end;
+
+
+function TProtocolDecorator.ReadListBegin: TThriftList;
+begin
+ result := FWrappedProtocol.ReadListBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadListEnd();
+begin
+ FWrappedProtocol.ReadListEnd();
+end;
+
+
+function TProtocolDecorator.ReadSetBegin: TThriftSet;
+begin
+ result := FWrappedProtocol.ReadSetBegin;
+end;
+
+
+procedure TProtocolDecorator.ReadSetEnd();
+begin
+ FWrappedProtocol.ReadSetEnd();
+end;
+
+
+function TProtocolDecorator.ReadBool: Boolean;
+begin
+ result := FWrappedProtocol.ReadBool;
+end;
+
+
+function TProtocolDecorator.ReadByte: ShortInt;
+begin
+ result := FWrappedProtocol.ReadByte;
+end;
+
+
+function TProtocolDecorator.ReadI16: SmallInt;
+begin
+ result := FWrappedProtocol.ReadI16;
+end;
+
+
+function TProtocolDecorator.ReadI32: Integer;
+begin
+ result := FWrappedProtocol.ReadI32;
+end;
+
+
+function TProtocolDecorator.ReadI64: Int64;
+begin
+ result := FWrappedProtocol.ReadI64;
+end;
+
+
+function TProtocolDecorator.ReadDouble:Double;
+begin
+ result := FWrappedProtocol.ReadDouble;
+end;
+
+
+function TProtocolDecorator.ReadBinary: TBytes;
+begin
+ result := FWrappedProtocol.ReadBinary;
+end;
+
+
+function TProtocolDecorator.ReadString: string;
+begin
+ result := FWrappedProtocol.ReadString;
+end;
+
+
+function TProtocolDecorator.ReadAnsiString: AnsiString;
+begin
+ result := FWrappedProtocol.ReadAnsiString;
+end;
+
+
+{ Init helper functions }
+
+procedure Init( var rec : TThriftMessage; const AName: string; const AMessageType: TMessageType; const ASeqID: Integer);
+begin
+ rec.Name := AName;
+ rec.Type_ := AMessageType;
+ rec.SeqID := ASeqID;
+end;
+
+
+procedure Init( var rec : TThriftStruct; const AName: string = '');
+begin
+ rec.Name := AName;
+end;
+
+
+procedure Init( var rec : TThriftField; const AName: string; const AType: TType; const AID: SmallInt);
+begin
+ rec.Name := AName;
+ rec.Type_ := AType;
+ rec.Id := AId;
+end;
+
+
+procedure Init( var rec : TThriftMap; const AKeyType, AValueType: TType; const ACount: Integer);
+begin
+ rec.ValueType := AValueType;
+ rec.KeyType := AKeyType;
+ rec.Count := ACount;
+end;
+
+
+procedure Init( var rec : TThriftSet; const AElementType: TType; const ACount: Integer);
+begin
+ rec.Count := ACount;
+ rec.ElementType := AElementType;
+end;
+
+
+procedure Init( var rec : TThriftList; const AElementType: TType; const ACount: Integer);
+begin
+ rec.Count := ACount;
+ rec.ElementType := AElementType;
+end;
+
+
+
+
+
+end.
+