(* * 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.Stream, 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 ); IProtocol = interface; IStruct = interface; IProtocolFactory = interface ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}'] function GetProtocol( const trans: ITransport): IProtocol; end; TThriftStringBuilder = class( TStringBuilder) public function Append(const Value: TBytes): TStringBuilder; overload; function Append(const Value: IThriftContainer): TStringBuilder; overload; end; TProtocolException = class( Exception ) public const UNKNOWN : Integer = 0; INVALID_DATA : Integer = 1; NEGATIVE_SIZE : Integer = 2; SIZE_LIMIT : Integer = 3; BAD_VERSION : Integer = 4; NOT_IMPLEMENTED : Integer = 5; protected FType : Integer; public constructor Create; overload; constructor Create( type_: Integer ); overload; constructor Create( type_: Integer; const msg: string); overload; end; IMap = interface ['{30531D97-7E06-4233-B800-C3F53CCD23E7}'] function GetKeyType: TType; procedure SetKeyType( Value: TType); function GetValueType: TType; procedure SetValueType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); property KeyType: TType read GetKeyType write SetKeyType; property ValueType: TType read GetValueType write SetValueType; property Count: Integer read GetCount write SetCount; end; TMapImpl = class( TInterfacedObject, IMap) private FValueType: TType; FKeyType: TType; FCount: Integer; protected function GetKeyType: TType; procedure SetKeyType( Value: TType); function GetValueType: TType; procedure SetValueType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); public constructor Create( AValueType: TType; AKeyType: TType; ACount: Integer); overload; constructor Create; overload; end; IList = interface ['{6763E1EA-A934-4472-904F-0083980B9B87}'] function GetElementType: TType; procedure SetElementType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); property ElementType: TType read GetElementType write SetElementType; property Count: Integer read GetCount write SetCount; end; TListImpl = class( TInterfacedObject, IList) private FElementType: TType; FCount : Integer; protected function GetElementType: TType; procedure SetElementType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); public constructor Create( AElementType: TType; ACount: Integer); overload; constructor Create; overload; end; ISet = interface ['{A8671700-7514-4C1E-8A05-62786872005F}'] function GetElementType: TType; procedure SetElementType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); property ElementType: TType read GetElementType write SetElementType; property Count: Integer read GetCount write SetCount; end; TSetImpl = class( TInterfacedObject, ISet) private FCount: Integer; FElementType: TType; protected function GetElementType: TType; procedure SetElementType( Value: TType); function GetCount: Integer; procedure SetCount( Value: Integer); public constructor Create( AElementType: TType; ACount: Integer); overload; constructor Create; overload; end; IMessage = interface ['{9E368B4A-B1FA-43E7-8CF5-56C66D256CA7}'] function GetName: string; procedure SetName( const Value: string); function GetType: TMessageType; procedure SetType( Value: TMessageType); function GetSeqID: Integer; procedure SetSeqID( Value: Integer); property Name: string read GetName write SetName; property Type_: TMessageType read GetType write SetType; property SeqID: Integer read GetSeqID write SetSeqID; end; TMessageImpl = class( TInterfacedObject, IMessage ) private FName: string; FMessageType: TMessageType; FSeqID: Integer; protected function GetName: string; procedure SetName( const Value: string); function GetType: TMessageType; procedure SetType( Value: TMessageType); function GetSeqID: Integer; procedure SetSeqID( Value: Integer); public property Name: string read FName write FName; property Type_: TMessageType read FMessageType write FMessageType; property SeqID: Integer read FSeqID write FSeqID; constructor Create( AName: string; AMessageType: TMessageType; ASeqID: Integer); overload; constructor Create; overload; end; IField = interface ['{F0D43BE5-7883-442E-83FF-0580CC632B72}'] function GetName: string; procedure SetName( const Value: string); function GetType: TType; procedure SetType( Value: TType); function GetId: SmallInt; procedure SetId( Value: SmallInt); property Name: string read GetName write SetName; property Type_: TType read GetType write SetType; property Id: SmallInt read GetId write SetId; end; TFieldImpl = class( TInterfacedObject, IField) private FName : string; FType : TType; FId : SmallInt; protected function GetName: string; procedure SetName( const Value: string); function GetType: TType; procedure SetType( Value: TType); function GetId: SmallInt; procedure SetId( Value: SmallInt); public constructor Create( const AName: string; const AType: TType; AId: SmallInt); overload; constructor Create; overload; end; TProtocolUtil = class public class procedure Skip( prot: IProtocol; type_: TType); end; IProtocol = interface ['{FD95C151-1527-4C96-8134-B902BFC4B4FC}'] function GetTransport: ITransport; procedure WriteMessageBegin( const msg: IMessage); procedure WriteMessageEnd; procedure WriteStructBegin( const struc: IStruct); procedure WriteStructEnd; procedure WriteFieldBegin( const field: IField); procedure WriteFieldEnd; procedure WriteFieldStop; procedure WriteMapBegin( const map: IMap); procedure WriteMapEnd; procedure WriteListBegin( const list: IList); procedure WriteListEnd(); procedure WriteSetBegin( const set_: ISet ); 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: IMessage; procedure ReadMessageEnd(); function ReadStructBegin: IStruct; procedure ReadStructEnd; function ReadFieldBegin: IField; procedure ReadFieldEnd(); function ReadMapBegin: IMap; procedure ReadMapEnd(); function ReadListBegin: IList; procedure ReadListEnd(); function ReadSetBegin: ISet; 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; property Transport: ITransport read GetTransport; end; TProtocolImpl = class abstract( TInterfacedObject, IProtocol) protected FTrans : ITransport; function GetTransport: ITransport; public procedure WriteMessageBegin( const msg: IMessage); virtual; abstract; procedure WriteMessageEnd; virtual; abstract; procedure WriteStructBegin( const struc: IStruct); virtual; abstract; procedure WriteStructEnd; virtual; abstract; procedure WriteFieldBegin( const field: IField); virtual; abstract; procedure WriteFieldEnd; virtual; abstract; procedure WriteFieldStop; virtual; abstract; procedure WriteMapBegin( const map: IMap); virtual; abstract; procedure WriteMapEnd; virtual; abstract; procedure WriteListBegin( const list: IList); virtual; abstract; procedure WriteListEnd(); virtual; abstract; procedure WriteSetBegin( const set_: ISet ); 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: IMessage; virtual; abstract; procedure ReadMessageEnd(); virtual; abstract; function ReadStructBegin: IStruct; virtual; abstract; procedure ReadStructEnd; virtual; abstract; function ReadFieldBegin: IField; virtual; abstract; procedure ReadFieldEnd(); virtual; abstract; function ReadMapBegin: IMap; virtual; abstract; procedure ReadMapEnd(); virtual; abstract; function ReadListBegin: IList; virtual; abstract; procedure ReadListEnd(); virtual; abstract; function ReadSetBegin: ISet; 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 ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}'] function ToString: string; procedure Read( const iprot: IProtocol); procedure Write( const iprot: IProtocol); end; IStruct = interface ['{5DCE39AA-C916-4BC7-A79B-96A0C36B2220}'] procedure SetName(const Value: string); function GetName: string; property Name: string read GetName write SetName; end; TStructImpl = class( TInterfacedObject, IStruct ) private FName: string; protected function GetName: string; procedure SetName(const Value: string); public constructor Create( const AName: string); end; TBinaryProtocolImpl = class( TProtocolImpl ) protected const VERSION_MASK : Cardinal = $ffff0000; VERSION_1 : Cardinal = $80010000; protected FStrictRead : Boolean; FStrictWrite : Boolean; private function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer; 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: IMessage); override; procedure WriteMessageEnd; override; procedure WriteStructBegin( const struc: IStruct); override; procedure WriteStructEnd; override; procedure WriteFieldBegin( const field: IField); override; procedure WriteFieldEnd; override; procedure WriteFieldStop; override; procedure WriteMapBegin( const map: IMap); override; procedure WriteMapEnd; override; procedure WriteListBegin( const list: IList); override; procedure WriteListEnd(); override; procedure WriteSetBegin( const set_: ISet ); 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: IMessage; override; procedure ReadMessageEnd(); override; function ReadStructBegin: IStruct; override; procedure ReadStructEnd; override; function ReadFieldBegin: IField; override; procedure ReadFieldEnd(); override; function ReadMapBegin: IMap; override; procedure ReadMapEnd(); override; function ReadListBegin: IList; override; procedure ReadListEnd(); override; function ReadSetBegin: ISet; 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: IMessage); override; procedure WriteMessageEnd; override; procedure WriteStructBegin( const struc: IStruct); override; procedure WriteStructEnd; override; procedure WriteFieldBegin( const field: IField); override; procedure WriteFieldEnd; override; procedure WriteFieldStop; override; procedure WriteMapBegin( const map: IMap); override; procedure WriteMapEnd; override; procedure WriteListBegin( const list: IList); override; procedure WriteListEnd(); override; procedure WriteSetBegin( const set_: ISet ); 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: IMessage; override; procedure ReadMessageEnd(); override; function ReadStructBegin: IStruct; override; procedure ReadStructEnd; override; function ReadFieldBegin: IField; override; procedure ReadFieldEnd(); override; function ReadMapBegin: IMap; override; procedure ReadMapEnd(); override; function ReadListBegin: IList; override; procedure ReadListEnd(); override; function ReadSetBegin: ISet; 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; 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; { TFieldImpl } constructor TFieldImpl.Create(const AName: string; const AType: TType; AId: SmallInt); begin FName := AName; FType := AType; FId := AId; end; constructor TFieldImpl.Create; begin FName := ''; FType := Low(TType); FId := 0; end; function TFieldImpl.GetId: SmallInt; begin Result := FId; end; function TFieldImpl.GetName: string; begin Result := FName; end; function TFieldImpl.GetType: TType; begin Result := FType; end; procedure TFieldImpl.SetId(Value: SmallInt); begin FId := Value; end; procedure TFieldImpl.SetName(const Value: string); begin FName := Value; end; procedure TFieldImpl.SetType(Value: TType); begin FType := Value; end; { TProtocolImpl } constructor TProtocolImpl.Create(trans: ITransport); begin inherited Create; FTrans := trans; 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 : IField; map : IMap; set_ : ISet; list : IList; i : Integer; begin 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 ASSERT( FALSE); // any new types? end; end; { TStructImpl } constructor TStructImpl.Create(const AName: string); begin inherited Create; FName := AName; end; function TStructImpl.GetName: string; begin Result := FName; end; procedure TStructImpl.SetName(const Value: string); begin FName := Value; end; { TMapImpl } constructor TMapImpl.Create(AValueType, AKeyType: TType; ACount: Integer); begin inherited Create; FValueType := AValueType; FKeyType := AKeyType; FCount := ACount; end; constructor TMapImpl.Create; begin end; function TMapImpl.GetCount: Integer; begin Result := FCount; end; function TMapImpl.GetKeyType: TType; begin Result := FKeyType; end; function TMapImpl.GetValueType: TType; begin Result := FValueType; end; procedure TMapImpl.SetCount(Value: Integer); begin FCount := Value; end; procedure TMapImpl.SetKeyType(Value: TType); begin FKeyType := Value; end; procedure TMapImpl.SetValueType(Value: TType); begin FValueType := Value; end; { IMessage } constructor TMessageImpl.Create(AName: string; AMessageType: TMessageType; ASeqID: Integer); begin inherited Create; FName := AName; FMessageType := AMessageType; FSeqID := ASeqID; end; constructor TMessageImpl.Create; begin inherited; end; function TMessageImpl.GetName: string; begin Result := FName; end; function TMessageImpl.GetSeqID: Integer; begin Result := FSeqID; end; function TMessageImpl.GetType: TMessageType; begin Result := FMessageType; end; procedure TMessageImpl.SetName(const Value: string); begin FName := Value; end; procedure TMessageImpl.SetSeqID(Value: Integer); begin FSeqID := Value; end; procedure TMessageImpl.SetType(Value: TMessageType); begin FMessageType := Value; end; { ISet } constructor TSetImpl.Create( AElementType: TType; ACount: Integer); begin inherited Create; FCount := ACount; FElementType := AElementType; end; constructor TSetImpl.Create; begin end; function TSetImpl.GetCount: Integer; begin Result := FCount; end; function TSetImpl.GetElementType: TType; begin Result := FElementType; end; procedure TSetImpl.SetCount(Value: Integer); begin FCount := Value; end; procedure TSetImpl.SetElementType(Value: TType); begin FElementType := Value; end; { IList } constructor TListImpl.Create( AElementType: TType; ACount: Integer); begin inherited Create; FCount := ACount; FElementType := AElementType; end; constructor TListImpl.Create; begin end; function TListImpl.GetCount: Integer; begin Result := FCount; end; function TListImpl.GetElementType: TType; begin Result := FElementType; end; procedure TListImpl.SetCount(Value: Integer); begin FCount := Value; end; procedure TListImpl.SetElementType(Value: TType); begin FElementType := Value; end; { TBinaryProtocolImpl } constructor TBinaryProtocolImpl.Create( const trans: ITransport); begin 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( var buf: TBytes; off, len: Integer): Integer; begin Result := FTrans.ReadAll( buf, 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; var bin : TBytes; begin SetLength( bin, 1); ReadAll( bin, 0, 1 ); Result := ShortInt( bin[0]); end; function TBinaryProtocolImpl.ReadDouble: Double; begin Result := ConvertInt64ToDouble( ReadI64 ) end; function TBinaryProtocolImpl.ReadFieldBegin: IField; var field : IField; begin field := TFieldImpl.Create; field.Type_ := TType( ReadByte); if ( field.Type_ <> TType.Stop ) then begin field.Id := ReadI16; end; Result := field; end; procedure TBinaryProtocolImpl.ReadFieldEnd; begin end; function TBinaryProtocolImpl.ReadI16: SmallInt; var i16in : TBytes; begin SetLength( i16in, 2 ); ReadAll( i16in, 0, 2); Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF)); end; function TBinaryProtocolImpl.ReadI32: Integer; var i32in : TBytes; begin SetLength( i32in, 4 ); ReadAll( 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 : TBytes; begin SetLength( i64in, 8); ReadAll( 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: IList; var list : IList; begin list := TListImpl.Create; list.ElementType := TType( ReadByte ); list.Count := ReadI32; Result := list; end; procedure TBinaryProtocolImpl.ReadListEnd; begin end; function TBinaryProtocolImpl.ReadMapBegin: IMap; var map : IMap; begin map := TMapImpl.Create; map.KeyType := TType( ReadByte ); map.ValueType := TType( ReadByte ); map.Count := ReadI32; Result := map; end; procedure TBinaryProtocolImpl.ReadMapEnd; begin end; function TBinaryProtocolImpl.ReadMessageBegin: IMessage; var size : Integer; version : Integer; message : IMessage; begin message := TMessageImpl.Create; size := ReadI32; if (size < 0) then begin version := size and Integer( VERSION_MASK); if ( version <> Integer( VERSION_1)) then begin raise TProtocolException.Create(TProtocolException.BAD_VERSION, 'Bad version in ReadMessageBegin: ' + IntToStr(version) ); end; message.Type_ := TMessageType( size and $000000ff); message.Name := ReadString; message.SeqID := ReadI32; end else begin if FStrictRead then begin raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Missing version in readMessageBegin, old client?' ); end; message.Name := ReadStringBody( size ); message.Type_ := TMessageType( ReadByte ); message.SeqID := ReadI32; end; Result := message; end; procedure TBinaryProtocolImpl.ReadMessageEnd; begin inherited; end; function TBinaryProtocolImpl.ReadSetBegin: ISet; var set_ : ISet; begin set_ := TSetImpl.Create; set_.ElementType := TType( ReadByte ); set_.Count := ReadI32; Result := set_; 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: IStruct; begin Result := TStructImpl.Create(''); 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); var a : TBytes; begin SetLength( a, 1); a[0] := Byte( b ); FTrans.Write( a, 0, 1 ); end; procedure TBinaryProtocolImpl.WriteDouble( const d: Double); begin WriteI64(ConvertDoubleToInt64(d)); end; procedure TBinaryProtocolImpl.WriteFieldBegin( const field: IField); 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 : TBytes; begin SetLength( i16out, 2); i16out[0] := Byte($FF and (i16 shr 8)); i16out[1] := Byte($FF and i16); FTrans.Write( i16out ); end; procedure TBinaryProtocolImpl.WriteI32(i32: Integer); var i32out : TBytes; begin SetLength( i32out, 4); 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 : TBytes; begin SetLength( i64out, 8); 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: IList); begin WriteByte(ShortInt(list.ElementType)); WriteI32(list.Count); end; procedure TBinaryProtocolImpl.WriteListEnd; begin end; procedure TBinaryProtocolImpl.WriteMapBegin( const map: IMap); begin WriteByte(ShortInt(map.KeyType)); WriteByte(ShortInt(map.ValueType)); WriteI32(map.Count); end; procedure TBinaryProtocolImpl.WriteMapEnd; begin end; procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: IMessage); 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_: ISet); begin WriteByte(ShortInt(set_.ElementType)); WriteI32(set_.Count); end; procedure TBinaryProtocolImpl.WriteSetEnd; begin end; procedure TBinaryProtocolImpl.WriteStructBegin( const struc: IStruct); begin end; procedure TBinaryProtocolImpl.WriteStructEnd; begin end; { TProtocolException } constructor TProtocolException.Create; begin inherited Create(''); FType := UNKNOWN; end; constructor TProtocolException.Create(type_: Integer); begin inherited Create(''); FType := type_; end; constructor TProtocolException.Create(type_: Integer; const msg: string); begin inherited Create( msg ); FType := type_; end; { TThriftStringBuilder } function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder; begin Result := Append( string( RawByteString(Value)) ); end; function TThriftStringBuilder.Append( const Value: IThriftContainer): TStringBuilder; begin Result := Append( Value.ToString ); end; { TBinaryProtocolImpl.TFactory } constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean); begin FStrictRead := AStrictRead; FStrictWrite := AStrictWrite; end; constructor TBinaryProtocolImpl.TFactory.Create; begin 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: IMessage); begin FWrappedProtocol.WriteMessageBegin( msg); end; procedure TProtocolDecorator.WriteMessageEnd; begin FWrappedProtocol.WriteMessageEnd; end; procedure TProtocolDecorator.WriteStructBegin( const struc: IStruct); begin FWrappedProtocol.WriteStructBegin( struc); end; procedure TProtocolDecorator.WriteStructEnd; begin FWrappedProtocol.WriteStructEnd; end; procedure TProtocolDecorator.WriteFieldBegin( const field: IField); begin FWrappedProtocol.WriteFieldBegin( field); end; procedure TProtocolDecorator.WriteFieldEnd; begin FWrappedProtocol.WriteFieldEnd; end; procedure TProtocolDecorator.WriteFieldStop; begin FWrappedProtocol.WriteFieldStop; end; procedure TProtocolDecorator.WriteMapBegin( const map: IMap); begin FWrappedProtocol.WriteMapBegin( map); end; procedure TProtocolDecorator.WriteMapEnd; begin FWrappedProtocol.WriteMapEnd; end; procedure TProtocolDecorator.WriteListBegin( const list: IList); begin FWrappedProtocol.WriteListBegin( list); end; procedure TProtocolDecorator.WriteListEnd(); begin FWrappedProtocol.WriteListEnd(); end; procedure TProtocolDecorator.WriteSetBegin( const set_: ISet ); 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: IMessage; begin result := FWrappedProtocol.ReadMessageBegin; end; procedure TProtocolDecorator.ReadMessageEnd(); begin FWrappedProtocol.ReadMessageEnd(); end; function TProtocolDecorator.ReadStructBegin: IStruct; begin result := FWrappedProtocol.ReadStructBegin; end; procedure TProtocolDecorator.ReadStructEnd; begin FWrappedProtocol.ReadStructEnd; end; function TProtocolDecorator.ReadFieldBegin: IField; begin result := FWrappedProtocol.ReadFieldBegin; end; procedure TProtocolDecorator.ReadFieldEnd(); begin FWrappedProtocol.ReadFieldEnd(); end; function TProtocolDecorator.ReadMapBegin: IMap; begin result := FWrappedProtocol.ReadMapBegin; end; procedure TProtocolDecorator.ReadMapEnd(); begin FWrappedProtocol.ReadMapEnd(); end; function TProtocolDecorator.ReadListBegin: IList; begin result := FWrappedProtocol.ReadListBegin; end; procedure TProtocolDecorator.ReadListEnd(); begin FWrappedProtocol.ReadListEnd(); end; function TProtocolDecorator.ReadSetBegin: ISet; 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; end.