ceph/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas

   1 (*
   2  * Licensed to the Apache Software Foundation (ASF) under one
   3  * or more contributor license agreements. See the NOTICE file
   4  * distributed with this work for additional information
   5  * regarding copyright ownership. The ASF licenses this file
   6  * to you under the Apache License, Version 2.0 (the
   7  * "License"); you may not use this file except in compliance
   8  * with the License. You may obtain a copy of the License at
   9  *
  10  *   http://www.apache.org/licenses/LICENSE-2.0
  11  *
  12  * Unless required by applicable law or agreed to in writing,
  13  * software distributed under the License is distributed on an
  14  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  15  * KIND, either express or implied. See the License for the
  16  * specific language governing permissions and limitations
  17  * under the License.
  18  *)
  19
  20 {$SCOPEDENUMS ON}
  21
  22 unit Thrift.Protocol;
  23
  24 interface
  25
  26 uses
  27   Classes,
  28   SysUtils,
  29   Contnrs,
  30   Thrift.Exception,
  31   Thrift.Stream,
  32   Thrift.Utils,
  33   Thrift.Collections,
  34   Thrift.Transport;
  35
  36 type
  37
  38   TType = (
  39     Stop = 0,
  40     Void = 1,
  41     Bool_ = 2,
  42     Byte_ = 3,
  43     Double_ = 4,
  44     I16 = 6,
  45     I32 = 8,
  46     I64 = 10,
  47     String_ = 11,
  48     Struct = 12,
  49     Map = 13,
  50     Set_ = 14,
  51     List = 15
  52   );
  53
  54   TMessageType = (
  55     Call = 1,
  56     Reply = 2,
  57     Exception = 3,
  58     Oneway = 4
  59   );
  60
  61 const
  62   VALID_TTYPES = [
  63     TType.Stop, TType.Void,
  64     TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_,
  65     TType.Struct, TType.Map, TType.Set_, TType.List
  66   ];
  67
  68   VALID_MESSAGETYPES = [Low(TMessageType)..High(TMessageType)];
  69
  70 const
  71   DEFAULT_RECURSION_LIMIT = 64;
  72
  73 type
  74   IProtocol = interface;
  75
  76   TThriftMessage = record
  77     Name: string;
  78     Type_: TMessageType;
  79     SeqID: Integer;
  80   end;
  81
  82   TThriftStruct = record
  83     Name: string;
  84   end;
  85
  86   TThriftField = record
  87     Name: string;
  88     Type_: TType;
  89     Id: SmallInt;
  90   end;
  91
  92   TThriftList = record
  93     ElementType: TType;
  94     Count: Integer;
  95   end;
  96
  97   TThriftMap = record
  98     KeyType: TType;
  99     ValueType: TType;
 100     Count: Integer;
 101   end;
 102
 103   TThriftSet = record
 104     ElementType: TType;
 105     Count: Integer;
 106   end;
 107
 108
 109
 110   IProtocolFactory = interface
 111     ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']
 112     function GetProtocol( const trans: ITransport): IProtocol;
 113   end;
 114
 115   TProtocolException = class( TException)
 116   public
 117     const // TODO(jensg): change into enum
 118       UNKNOWN = 0;
 119       INVALID_DATA = 1;
 120       NEGATIVE_SIZE = 2;
 121       SIZE_LIMIT = 3;
 122       BAD_VERSION = 4;
 123       NOT_IMPLEMENTED = 5;
 124       DEPTH_LIMIT = 6;
 125   protected
 126     constructor HiddenCreate(const Msg: string);
 127   public
 128     // purposefully hide inherited constructor
 129     class function Create(const Msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
 130     class function Create: TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
 131     class function Create( type_: Integer): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
 132     class function Create( type_: Integer; const msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
 133   end;
 134
 135   // Needed to remove deprecation warning
 136   TProtocolExceptionSpecialized = class abstract (TProtocolException)
 137   public
 138     constructor Create(const Msg: string);
 139   end;
 140
 141   TProtocolExceptionUnknown = class (TProtocolExceptionSpecialized);
 142   TProtocolExceptionInvalidData = class (TProtocolExceptionSpecialized);
 143   TProtocolExceptionNegativeSize = class (TProtocolExceptionSpecialized);
 144   TProtocolExceptionSizeLimit = class (TProtocolExceptionSpecialized);
 145   TProtocolExceptionBadVersion = class (TProtocolExceptionSpecialized);
 146   TProtocolExceptionNotImplemented = class (TProtocolExceptionSpecialized);
 147   TProtocolExceptionDepthLimit = class (TProtocolExceptionSpecialized);
 148
 149
 150   TProtocolUtil = class
 151   public
 152     class procedure Skip( prot: IProtocol; type_: TType);
 153   end;
 154
 155   IProtocolRecursionTracker = interface
 156     ['{29CA033F-BB56-49B1-9EE3-31B1E82FC7A5}']
 157     // no members yet
 158   end;
 159
 160   TProtocolRecursionTrackerImpl = class abstract( TInterfacedObject, IProtocolRecursionTracker)
 161   protected
 162     FProtocol : IProtocol;
 163   public
 164     constructor Create( prot : IProtocol);
 165     destructor Destroy; override;
 166   end;
 167
 168   IProtocol = interface
 169     ['{602A7FFB-0D9E-4CD8-8D7F-E5076660588A}']
 170     function GetTransport: ITransport;
 171     procedure WriteMessageBegin( const msg: TThriftMessage);
 172     procedure WriteMessageEnd;
 173     procedure WriteStructBegin( const struc: TThriftStruct);
 174     procedure WriteStructEnd;
 175     procedure WriteFieldBegin( const field: TThriftField);
 176     procedure WriteFieldEnd;
 177     procedure WriteFieldStop;
 178     procedure WriteMapBegin( const map: TThriftMap);
 179     procedure WriteMapEnd;
 180     procedure WriteListBegin( const list: TThriftList);
 181     procedure WriteListEnd();
 182     procedure WriteSetBegin( const set_: TThriftSet );
 183     procedure WriteSetEnd();
 184     procedure WriteBool( b: Boolean);
 185     procedure WriteByte( b: ShortInt);
 186     procedure WriteI16( i16: SmallInt);
 187     procedure WriteI32( i32: Integer);
 188     procedure WriteI64( const i64: Int64);
 189     procedure WriteDouble( const d: Double);
 190     procedure WriteString( const s: string );
 191     procedure WriteAnsiString( const s: AnsiString);
 192     procedure WriteBinary( const b: TBytes);
 193
 194     function ReadMessageBegin: TThriftMessage;
 195     procedure ReadMessageEnd();
 196     function ReadStructBegin: TThriftStruct;
 197     procedure ReadStructEnd;
 198     function ReadFieldBegin: TThriftField;
 199     procedure ReadFieldEnd();
 200     function ReadMapBegin: TThriftMap;
 201     procedure ReadMapEnd();
 202     function ReadListBegin: TThriftList;
 203     procedure ReadListEnd();
 204     function ReadSetBegin: TThriftSet;
 205     procedure ReadSetEnd();
 206     function ReadBool: Boolean;
 207     function ReadByte: ShortInt;
 208     function ReadI16: SmallInt;
 209     function ReadI32: Integer;
 210     function ReadI64: Int64;
 211     function ReadDouble:Double;
 212     function ReadBinary: TBytes;
 213     function ReadString: string;
 214     function ReadAnsiString: AnsiString;
 215
 216     procedure SetRecursionLimit( value : Integer);
 217     function  GetRecursionLimit : Integer;
 218     function  NextRecursionLevel : IProtocolRecursionTracker;
 219     procedure IncrementRecursionDepth;
 220     procedure DecrementRecursionDepth;
 221
 222     property Transport: ITransport read GetTransport;
 223     property RecursionLimit : Integer read GetRecursionLimit write SetRecursionLimit;
 224   end;
 225
 226   TProtocolImpl = class abstract( TInterfacedObject, IProtocol)
 227   protected
 228     FTrans : ITransport;
 229     FRecursionLimit : Integer;
 230     FRecursionDepth : Integer;
 231
 232     procedure SetRecursionLimit( value : Integer);
 233     function  GetRecursionLimit : Integer;
 234     function  NextRecursionLevel : IProtocolRecursionTracker;
 235     procedure IncrementRecursionDepth;
 236     procedure DecrementRecursionDepth;
 237
 238     function GetTransport: ITransport;
 239   public
 240     procedure WriteMessageBegin( const msg: TThriftMessage); virtual; abstract;
 241     procedure WriteMessageEnd; virtual; abstract;
 242     procedure WriteStructBegin( const struc: TThriftStruct); virtual; abstract;
 243     procedure WriteStructEnd; virtual; abstract;
 244     procedure WriteFieldBegin( const field: TThriftField); virtual; abstract;
 245     procedure WriteFieldEnd; virtual; abstract;
 246     procedure WriteFieldStop; virtual; abstract;
 247     procedure WriteMapBegin( const map: TThriftMap); virtual; abstract;
 248     procedure WriteMapEnd; virtual; abstract;
 249     procedure WriteListBegin( const list: TThriftList); virtual; abstract;
 250     procedure WriteListEnd(); virtual; abstract;
 251     procedure WriteSetBegin( const set_: TThriftSet ); virtual; abstract;
 252     procedure WriteSetEnd(); virtual; abstract;
 253     procedure WriteBool( b: Boolean); virtual; abstract;
 254     procedure WriteByte( b: ShortInt); virtual; abstract;
 255     procedure WriteI16( i16: SmallInt); virtual; abstract;
 256     procedure WriteI32( i32: Integer); virtual; abstract;
 257     procedure WriteI64( const i64: Int64); virtual; abstract;
 258     procedure WriteDouble( const d: Double); virtual; abstract;
 259     procedure WriteString( const s: string ); virtual;
 260     procedure WriteAnsiString( const s: AnsiString); virtual;
 261     procedure WriteBinary( const b: TBytes); virtual; abstract;
 262
 263     function ReadMessageBegin: TThriftMessage; virtual; abstract;
 264     procedure ReadMessageEnd(); virtual; abstract;
 265     function ReadStructBegin: TThriftStruct; virtual; abstract;
 266     procedure ReadStructEnd; virtual; abstract;
 267     function ReadFieldBegin: TThriftField; virtual; abstract;
 268     procedure ReadFieldEnd(); virtual; abstract;
 269     function ReadMapBegin: TThriftMap; virtual; abstract;
 270     procedure ReadMapEnd(); virtual; abstract;
 271     function ReadListBegin: TThriftList; virtual; abstract;
 272     procedure ReadListEnd(); virtual; abstract;
 273     function ReadSetBegin: TThriftSet; virtual; abstract;
 274     procedure ReadSetEnd(); virtual; abstract;
 275     function ReadBool: Boolean; virtual; abstract;
 276     function ReadByte: ShortInt; virtual; abstract;
 277     function ReadI16: SmallInt; virtual; abstract;
 278     function ReadI32: Integer; virtual; abstract;
 279     function ReadI64: Int64; virtual; abstract;
 280     function ReadDouble:Double; virtual; abstract;
 281     function ReadBinary: TBytes; virtual; abstract;
 282     function ReadString: string; virtual;
 283     function ReadAnsiString: AnsiString; virtual;
 284
 285     property Transport: ITransport read GetTransport;
 286
 287     constructor Create( trans: ITransport );
 288   end;
 289
 290   IBase = interface( ISupportsToString)
 291     ['{AFF6CECA-5200-4540-950E-9B89E0C1C00C}']
 292     procedure Read( const iprot: IProtocol);
 293     procedure Write( const iprot: IProtocol);
 294   end;
 295
 296
 297   TBinaryProtocolImpl = class( TProtocolImpl )
 298   protected
 299     const
 300       VERSION_MASK : Cardinal = $ffff0000;
 301       VERSION_1 : Cardinal = $80010000;
 302   protected
 303     FStrictRead : Boolean;
 304     FStrictWrite : Boolean;
 305
 306   private
 307     function ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;  inline;
 308     function ReadStringBody( size: Integer): string;
 309
 310   public
 311
 312     type
 313       TFactory = class( TInterfacedObject, IProtocolFactory)
 314       protected
 315         FStrictRead : Boolean;
 316         FStrictWrite : Boolean;
 317       public
 318         function GetProtocol( const trans: ITransport): IProtocol;
 319         constructor Create( AStrictRead, AStrictWrite: Boolean ); overload;
 320         constructor Create; overload;
 321       end;
 322
 323     constructor Create( const trans: ITransport); overload;
 324     constructor Create( const trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;
 325
 326     procedure WriteMessageBegin( const msg: TThriftMessage); override;
 327     procedure WriteMessageEnd; override;
 328     procedure WriteStructBegin( const struc: TThriftStruct); override;
 329     procedure WriteStructEnd; override;
 330     procedure WriteFieldBegin( const field: TThriftField); override;
 331     procedure WriteFieldEnd; override;
 332     procedure WriteFieldStop; override;
 333     procedure WriteMapBegin( const map: TThriftMap); override;
 334     procedure WriteMapEnd; override;
 335     procedure WriteListBegin( const list: TThriftList); override;
 336     procedure WriteListEnd(); override;
 337     procedure WriteSetBegin( const set_: TThriftSet ); override;
 338     procedure WriteSetEnd(); override;
 339     procedure WriteBool( b: Boolean); override;
 340     procedure WriteByte( b: ShortInt); override;
 341     procedure WriteI16( i16: SmallInt); override;
 342     procedure WriteI32( i32: Integer); override;
 343     procedure WriteI64( const i64: Int64); override;
 344     procedure WriteDouble( const d: Double); override;
 345     procedure WriteBinary( const b: TBytes); override;
 346
 347     function ReadMessageBegin: TThriftMessage; override;
 348     procedure ReadMessageEnd(); override;
 349     function ReadStructBegin: TThriftStruct; override;
 350     procedure ReadStructEnd; override;
 351     function ReadFieldBegin: TThriftField; override;
 352     procedure ReadFieldEnd(); override;
 353     function ReadMapBegin: TThriftMap; override;
 354     procedure ReadMapEnd(); override;
 355     function ReadListBegin: TThriftList; override;
 356     procedure ReadListEnd(); override;
 357     function ReadSetBegin: TThriftSet; override;
 358     procedure ReadSetEnd(); override;
 359     function ReadBool: Boolean; override;
 360     function ReadByte: ShortInt; override;
 361     function ReadI16: SmallInt; override;
 362     function ReadI32: Integer; override;
 363     function ReadI64: Int64; override;
 364     function ReadDouble:Double; override;
 365     function ReadBinary: TBytes; override;
 366
 367   end;
 368
 369
 370   { TProtocolDecorator forwards all requests to an enclosed TProtocol instance,
 371     providing a way to author concise concrete decorator subclasses. The decorator
 372     does not (and should not) modify the behaviour of the enclosed TProtocol
 373
 374     See p.175 of Design Patterns (by Gamma et al.)
 375   }
 376   TProtocolDecorator = class( TProtocolImpl)
 377   private
 378     FWrappedProtocol : IProtocol;
 379
 380   public
 381     // Encloses the specified protocol.
 382     // All operations will be forward to the given protocol.  Must be non-null.
 383     constructor Create( const aProtocol : IProtocol);
 384
 385     procedure WriteMessageBegin( const msg: TThriftMessage); override;
 386     procedure WriteMessageEnd; override;
 387     procedure WriteStructBegin( const struc: TThriftStruct); override;
 388     procedure WriteStructEnd; override;
 389     procedure WriteFieldBegin( const field: TThriftField); override;
 390     procedure WriteFieldEnd; override;
 391     procedure WriteFieldStop; override;
 392     procedure WriteMapBegin( const map: TThriftMap); override;
 393     procedure WriteMapEnd; override;
 394     procedure WriteListBegin( const list: TThriftList); override;
 395     procedure WriteListEnd(); override;
 396     procedure WriteSetBegin( const set_: TThriftSet ); override;
 397     procedure WriteSetEnd(); override;
 398     procedure WriteBool( b: Boolean); override;
 399     procedure WriteByte( b: ShortInt); override;
 400     procedure WriteI16( i16: SmallInt); override;
 401     procedure WriteI32( i32: Integer); override;
 402     procedure WriteI64( const i64: Int64); override;
 403     procedure WriteDouble( const d: Double); override;
 404     procedure WriteString( const s: string ); override;
 405     procedure WriteAnsiString( const s: AnsiString); override;
 406     procedure WriteBinary( const b: TBytes); override;
 407
 408     function ReadMessageBegin: TThriftMessage; override;
 409     procedure ReadMessageEnd(); override;
 410     function ReadStructBegin: TThriftStruct; override;
 411     procedure ReadStructEnd; override;
 412     function ReadFieldBegin: TThriftField; override;
 413     procedure ReadFieldEnd(); override;
 414     function ReadMapBegin: TThriftMap; override;
 415     procedure ReadMapEnd(); override;
 416     function ReadListBegin: TThriftList; override;
 417     procedure ReadListEnd(); override;
 418     function ReadSetBegin: TThriftSet; override;
 419     procedure ReadSetEnd(); override;
 420     function ReadBool: Boolean; override;
 421     function ReadByte: ShortInt; override;
 422     function ReadI16: SmallInt; override;
 423     function ReadI32: Integer; override;
 424     function ReadI64: Int64; override;
 425     function ReadDouble:Double; override;
 426     function ReadBinary: TBytes; override;
 427     function ReadString: string; override;
 428     function ReadAnsiString: AnsiString; override;
 429   end;
 430
 431
 432 type
 433   IRequestEvents = interface
 434     ['{F926A26A-5B00-4560-86FA-2CAE3BA73DAF}']
 435     // Called before reading arguments.
 436     procedure PreRead;
 437     // Called between reading arguments and calling the handler.
 438     procedure PostRead;
 439     // Called between calling the handler and writing the response.
 440     procedure PreWrite;
 441     // Called after writing the response.
 442     procedure PostWrite;
 443     // Called when an oneway (async) function call completes successfully.
 444     procedure OnewayComplete;
 445     // Called if the handler throws an undeclared exception.
 446     procedure UnhandledError( const e : Exception);
 447     // Called when a client has finished request-handling to clean up
 448     procedure CleanupContext;
 449   end;
 450
 451
 452   IProcessorEvents = interface
 453     ['{A8661119-657C-447D-93C5-512E36162A45}']
 454     // Called when a client is about to call the processor.
 455     procedure Processing( const transport : ITransport);
 456     // Called on any service function invocation
 457     function  CreateRequestContext( const aFunctionName : string) : IRequestEvents;
 458     // Called when a client has finished request-handling to clean up
 459     procedure CleanupContext;
 460   end;
 461
 462
 463   IProcessor = interface
 464     ['{7BAE92A5-46DA-4F13-B6EA-0EABE233EE5F}']
 465     function Process( const iprot :IProtocol; const oprot: IProtocol; const events : IProcessorEvents = nil): Boolean;
 466   end;
 467
 468
 469 procedure Init( var rec : TThriftMessage; const AName: string = ''; const AMessageType: TMessageType = Low(TMessageType); const ASeqID: Integer = 0);  overload;  inline;
 470 procedure Init( var rec : TThriftStruct;  const AName: string = '');  overload;  inline;
 471 procedure Init( var rec : TThriftField;   const AName: string = ''; const AType: TType = Low(TType); const AID: SmallInt = 0);  overload;  inline;
 472 procedure Init( var rec : TThriftMap;     const AKeyType: TType = Low(TType); const AValueType: TType = Low(TType); const ACount: Integer = 0); overload;  inline;
 473 procedure Init( var rec : TThriftSet;     const AElementType: TType = Low(TType); const ACount: Integer = 0); overload;  inline;
 474 procedure Init( var rec : TThriftList;    const AElementType: TType = Low(TType); const ACount: Integer = 0); overload;  inline;
 475
 476
 477 implementation
 478
 479 function ConvertInt64ToDouble( const n: Int64): Double;
 480 begin
 481   ASSERT( SizeOf(n) = SizeOf(Result));
 482   System.Move( n, Result, SizeOf(Result));
 483 end;
 484
 485 function ConvertDoubleToInt64( const d: Double): Int64;
 486 begin
 487   ASSERT( SizeOf(d) = SizeOf(Result));
 488   System.Move( d, Result, SizeOf(Result));
 489 end;
 490
 491
 492
 493 { TProtocolRecursionTrackerImpl }
 494
 495 constructor TProtocolRecursionTrackerImpl.Create( prot : IProtocol);
 496 begin
 497   inherited Create;
 498
 499   // storing the pointer *after* the (successful) increment is important here
 500   prot.IncrementRecursionDepth;
 501   FProtocol := prot;
 502 end;
 503
 504 destructor TProtocolRecursionTrackerImpl.Destroy;
 505 begin
 506   try
 507     // we have to release the reference iff the pointer has been stored
 508     if FProtocol <> nil then begin
 509       FProtocol.DecrementRecursionDepth;
 510       FProtocol := nil;
 511     end;
 512   finally
 513     inherited Destroy;
 514   end;
 515 end;
 516
 517 { TProtocolImpl }
 518
 519 constructor TProtocolImpl.Create(trans: ITransport);
 520 begin
 521   inherited Create;
 522   FTrans := trans;
 523   FRecursionLimit := DEFAULT_RECURSION_LIMIT;
 524   FRecursionDepth := 0;
 525 end;
 526
 527 procedure TProtocolImpl.SetRecursionLimit( value : Integer);
 528 begin
 529   FRecursionLimit := value;
 530 end;
 531
 532 function TProtocolImpl.GetRecursionLimit : Integer;
 533 begin
 534   result := FRecursionLimit;
 535 end;
 536
 537 function TProtocolImpl.NextRecursionLevel : IProtocolRecursionTracker;
 538 begin
 539   result := TProtocolRecursionTrackerImpl.Create(Self);
 540 end;
 541
 542 procedure TProtocolImpl.IncrementRecursionDepth;
 543 begin
 544   if FRecursionDepth < FRecursionLimit
 545   then Inc(FRecursionDepth)
 546   else raise TProtocolExceptionDepthLimit.Create('Depth limit exceeded');
 547 end;
 548
 549 procedure TProtocolImpl.DecrementRecursionDepth;
 550 begin
 551   Dec(FRecursionDepth)
 552 end;
 553
 554 function TProtocolImpl.GetTransport: ITransport;
 555 begin
 556   Result := FTrans;
 557 end;
 558
 559 function TProtocolImpl.ReadAnsiString: AnsiString;
 560 var
 561   b : TBytes;
 562   len : Integer;
 563 begin
 564   Result := '';
 565   b := ReadBinary;
 566   len := Length( b );
 567   if len > 0 then
 568   begin
 569     SetLength( Result, len);
 570     System.Move( b[0], Pointer(Result)^, len );
 571   end;
 572 end;
 573
 574 function TProtocolImpl.ReadString: string;
 575 begin
 576   Result := TEncoding.UTF8.GetString( ReadBinary );
 577 end;
 578
 579 procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);
 580 var
 581   b : TBytes;
 582   len : Integer;
 583 begin
 584   len := Length(s);
 585   SetLength( b, len);
 586   if len > 0 then
 587   begin
 588     System.Move( Pointer(s)^, b[0], len );
 589   end;
 590   WriteBinary( b );
 591 end;
 592
 593 procedure TProtocolImpl.WriteString(const s: string);
 594 var
 595   b : TBytes;
 596 begin
 597   b := TEncoding.UTF8.GetBytes(s);
 598   WriteBinary( b );
 599 end;
 600
 601 { TProtocolUtil }
 602
 603 class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
 604 var field : TThriftField;
 605     map   : TThriftMap;
 606     set_  : TThriftSet;
 607     list  : TThriftList;
 608     i     : Integer;
 609     tracker : IProtocolRecursionTracker;
 610 begin
 611   tracker := prot.NextRecursionLevel;
 612   case type_ of
 613     // simple types
 614     TType.Bool_   :  prot.ReadBool();
 615     TType.Byte_   :  prot.ReadByte();
 616     TType.I16     :  prot.ReadI16();
 617     TType.I32     :  prot.ReadI32();
 618     TType.I64     :  prot.ReadI64();
 619     TType.Double_ :  prot.ReadDouble();
 620     TType.String_ :  prot.ReadBinary();// Don't try to decode the string, just skip it.
 621
 622     // structured types
 623     TType.Struct :  begin
 624       prot.ReadStructBegin();
 625       while TRUE do begin
 626         field := prot.ReadFieldBegin();
 627         if (field.Type_ = TType.Stop) then Break;
 628         Skip(prot, field.Type_);
 629         prot.ReadFieldEnd();
 630       end;
 631       prot.ReadStructEnd();
 632     end;
 633
 634     TType.Map :  begin
 635       map := prot.ReadMapBegin();
 636       for i := 0 to map.Count-1 do begin
 637         Skip(prot, map.KeyType);
 638         Skip(prot, map.ValueType);
 639       end;
 640       prot.ReadMapEnd();
 641     end;
 642
 643     TType.Set_ :  begin
 644       set_ := prot.ReadSetBegin();
 645       for i := 0 to set_.Count-1
 646       do Skip( prot, set_.ElementType);
 647       prot.ReadSetEnd();
 648     end;
 649
 650     TType.List :  begin
 651       list := prot.ReadListBegin();
 652       for i := 0 to list.Count-1
 653       do Skip( prot, list.ElementType);
 654       prot.ReadListEnd();
 655     end;
 656
 657   else
 658     raise TProtocolExceptionInvalidData.Create('Unexpected type '+IntToStr(Ord(type_)));
 659   end;
 660 end;
 661
 662
 663 { TBinaryProtocolImpl }
 664
 665 constructor TBinaryProtocolImpl.Create( const trans: ITransport);
 666 begin
 667   //no inherited
 668   Create( trans, False, True);
 669 end;
 670
 671 constructor TBinaryProtocolImpl.Create( const trans: ITransport; strictRead,
 672   strictWrite: Boolean);
 673 begin
 674   inherited Create( trans );
 675   FStrictRead := strictRead;
 676   FStrictWrite := strictWrite;
 677 end;
 678
 679 function TBinaryProtocolImpl.ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;
 680 begin
 681   Result := FTrans.ReadAll( pBuf, buflen, off, len );
 682 end;
 683
 684 function TBinaryProtocolImpl.ReadBinary: TBytes;
 685 var
 686   size : Integer;
 687   buf : TBytes;
 688 begin
 689   size := ReadI32;
 690   SetLength( buf, size );
 691   FTrans.ReadAll( buf, 0, size);
 692   Result := buf;
 693 end;
 694
 695 function TBinaryProtocolImpl.ReadBool: Boolean;
 696 begin
 697   Result := (ReadByte = 1);
 698 end;
 699
 700 function TBinaryProtocolImpl.ReadByte: ShortInt;
 701 begin
 702   ReadAll( @result, SizeOf(result), 0, 1);
 703 end;
 704
 705 function TBinaryProtocolImpl.ReadDouble: Double;
 706 begin
 707   Result := ConvertInt64ToDouble( ReadI64 )
 708 end;
 709
 710 function TBinaryProtocolImpl.ReadFieldBegin: TThriftField;
 711 begin
 712   Init( result, '', TType( ReadByte), 0);
 713   if ( result.Type_ <> TType.Stop ) then begin
 714     result.Id := ReadI16;
 715   end;
 716 end;
 717
 718 procedure TBinaryProtocolImpl.ReadFieldEnd;
 719 begin
 720
 721 end;
 722
 723 function TBinaryProtocolImpl.ReadI16: SmallInt;
 724 var i16in : packed array[0..1] of Byte;
 725 begin
 726   ReadAll( @i16in, Sizeof(i16in), 0, 2);
 727   Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
 728 end;
 729
 730 function TBinaryProtocolImpl.ReadI32: Integer;
 731 var i32in : packed array[0..3] of Byte;
 732 begin
 733   ReadAll( @i32in, SizeOf(i32in), 0, 4);
 734
 735   Result := Integer(
 736     ((i32in[0] and $FF) shl 24) or
 737     ((i32in[1] and $FF) shl 16) or
 738     ((i32in[2] and $FF) shl 8) or
 739      (i32in[3] and $FF));
 740
 741 end;
 742
 743 function TBinaryProtocolImpl.ReadI64: Int64;
 744 var i64in : packed array[0..7] of Byte;
 745 begin
 746   ReadAll( @i64in, SizeOf(i64in), 0, 8);
 747   Result :=
 748     (Int64( i64in[0] and $FF) shl 56) or
 749     (Int64( i64in[1] and $FF) shl 48) or
 750     (Int64( i64in[2] and $FF) shl 40) or
 751     (Int64( i64in[3] and $FF) shl 32) or
 752     (Int64( i64in[4] and $FF) shl 24) or
 753     (Int64( i64in[5] and $FF) shl 16) or
 754     (Int64( i64in[6] and $FF) shl 8) or
 755     (Int64( i64in[7] and $FF));
 756 end;
 757
 758 function TBinaryProtocolImpl.ReadListBegin: TThriftList;
 759 begin
 760   result.ElementType := TType(ReadByte);
 761   result.Count       := ReadI32;
 762 end;
 763
 764 procedure TBinaryProtocolImpl.ReadListEnd;
 765 begin
 766
 767 end;
 768
 769 function TBinaryProtocolImpl.ReadMapBegin: TThriftMap;
 770 begin
 771   result.KeyType   := TType(ReadByte);
 772   result.ValueType := TType(ReadByte);
 773   result.Count     := ReadI32;
 774 end;
 775
 776 procedure TBinaryProtocolImpl.ReadMapEnd;
 777 begin
 778
 779 end;
 780
 781 function TBinaryProtocolImpl.ReadMessageBegin: TThriftMessage;
 782 var
 783   size : Integer;
 784   version : Integer;
 785 begin
 786   Init( result);
 787   size := ReadI32;
 788   if (size < 0) then begin
 789     version := size and Integer( VERSION_MASK);
 790     if ( version <> Integer( VERSION_1)) then begin
 791       raise TProtocolExceptionBadVersion.Create('Bad version in ReadMessageBegin: ' + IntToStr(version) );
 792     end;
 793     result.Type_ := TMessageType( size and $000000ff);
 794     result.Name := ReadString;
 795     result.SeqID := ReadI32;
 796   end
 797   else begin
 798     if FStrictRead then begin
 799       raise TProtocolExceptionBadVersion.Create('Missing version in readMessageBegin, old client?' );
 800     end;
 801     result.Name := ReadStringBody( size );
 802     result.Type_ := TMessageType( ReadByte );
 803     result.SeqID := ReadI32;
 804   end;
 805 end;
 806
 807 procedure TBinaryProtocolImpl.ReadMessageEnd;
 808 begin
 809   inherited;
 810
 811 end;
 812
 813 function TBinaryProtocolImpl.ReadSetBegin: TThriftSet;
 814 begin
 815   result.ElementType := TType(ReadByte);
 816   result.Count       := ReadI32;
 817 end;
 818
 819 procedure TBinaryProtocolImpl.ReadSetEnd;
 820 begin
 821
 822 end;
 823
 824 function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;
 825 var
 826   buf : TBytes;
 827 begin
 828   SetLength( buf, size );
 829   FTrans.ReadAll( buf, 0, size );
 830   Result := TEncoding.UTF8.GetString( buf);
 831 end;
 832
 833 function TBinaryProtocolImpl.ReadStructBegin: TThriftStruct;
 834 begin
 835   Init( Result);
 836 end;
 837
 838 procedure TBinaryProtocolImpl.ReadStructEnd;
 839 begin
 840   inherited;
 841
 842 end;
 843
 844 procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);
 845 var iLen : Integer;
 846 begin
 847   iLen := Length(b);
 848   WriteI32( iLen);
 849   if iLen > 0 then FTrans.Write(b, 0, iLen);
 850 end;
 851
 852 procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
 853 begin
 854   if b then begin
 855     WriteByte( 1 );
 856   end else begin
 857     WriteByte( 0 );
 858   end;
 859 end;
 860
 861 procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);
 862 begin
 863   FTrans.Write( @b, 0, 1);
 864 end;
 865
 866 procedure TBinaryProtocolImpl.WriteDouble( const d: Double);
 867 begin
 868   WriteI64(ConvertDoubleToInt64(d));
 869 end;
 870
 871 procedure TBinaryProtocolImpl.WriteFieldBegin( const field: TThriftField);
 872 begin
 873   WriteByte(ShortInt(field.Type_));
 874   WriteI16(field.ID);
 875 end;
 876
 877 procedure TBinaryProtocolImpl.WriteFieldEnd;
 878 begin
 879
 880 end;
 881
 882 procedure TBinaryProtocolImpl.WriteFieldStop;
 883 begin
 884   WriteByte(ShortInt(TType.Stop));
 885 end;
 886
 887 procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
 888 var i16out : packed array[0..1] of Byte;
 889 begin
 890   i16out[0] := Byte($FF and (i16 shr 8));
 891   i16out[1] := Byte($FF and i16);
 892   FTrans.Write( @i16out, 0, 2);
 893 end;
 894
 895 procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
 896 var i32out : packed array[0..3] of Byte;
 897 begin
 898   i32out[0] := Byte($FF and (i32 shr 24));
 899   i32out[1] := Byte($FF and (i32 shr 16));
 900   i32out[2] := Byte($FF and (i32 shr 8));
 901   i32out[3] := Byte($FF and i32);
 902   FTrans.Write( @i32out, 0, 4);
 903 end;
 904
 905 procedure TBinaryProtocolImpl.WriteI64( const i64: Int64);
 906 var i64out : packed array[0..7] of Byte;
 907 begin
 908   i64out[0] := Byte($FF and (i64 shr 56));
 909   i64out[1] := Byte($FF and (i64 shr 48));
 910   i64out[2] := Byte($FF and (i64 shr 40));
 911   i64out[3] := Byte($FF and (i64 shr 32));
 912   i64out[4] := Byte($FF and (i64 shr 24));
 913   i64out[5] := Byte($FF and (i64 shr 16));
 914   i64out[6] := Byte($FF and (i64 shr 8));
 915   i64out[7] := Byte($FF and i64);
 916   FTrans.Write( @i64out, 0, 8);
 917 end;
 918
 919 procedure TBinaryProtocolImpl.WriteListBegin( const list: TThriftList);
 920 begin
 921   WriteByte(ShortInt(list.ElementType));
 922   WriteI32(list.Count);
 923 end;
 924
 925 procedure TBinaryProtocolImpl.WriteListEnd;
 926 begin
 927
 928 end;
 929
 930 procedure TBinaryProtocolImpl.WriteMapBegin( const map: TThriftMap);
 931 begin
 932   WriteByte(ShortInt(map.KeyType));
 933   WriteByte(ShortInt(map.ValueType));
 934   WriteI32(map.Count);
 935 end;
 936
 937 procedure TBinaryProtocolImpl.WriteMapEnd;
 938 begin
 939
 940 end;
 941
 942 procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
 943 var
 944   version : Cardinal;
 945 begin
 946   if FStrictWrite then
 947   begin
 948     version := VERSION_1 or Cardinal( msg.Type_);
 949     WriteI32( Integer( version) );
 950     WriteString( msg.Name);
 951     WriteI32( msg.SeqID);
 952   end else
 953   begin
 954     WriteString( msg.Name);
 955     WriteByte(ShortInt( msg.Type_));
 956     WriteI32( msg.SeqID);
 957   end;
 958 end;
 959
 960 procedure TBinaryProtocolImpl.WriteMessageEnd;
 961 begin
 962
 963 end;
 964
 965 procedure TBinaryProtocolImpl.WriteSetBegin( const set_: TThriftSet);
 966 begin
 967   WriteByte(ShortInt(set_.ElementType));
 968   WriteI32(set_.Count);
 969 end;
 970
 971 procedure TBinaryProtocolImpl.WriteSetEnd;
 972 begin
 973
 974 end;
 975
 976 procedure TBinaryProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
 977 begin
 978
 979 end;
 980
 981 procedure TBinaryProtocolImpl.WriteStructEnd;
 982 begin
 983
 984 end;
 985
 986 { TProtocolException }
 987
 988 constructor TProtocolException.HiddenCreate(const Msg: string);
 989 begin
 990   inherited Create(Msg);
 991 end;
 992
 993 class function TProtocolException.Create(const Msg: string): TProtocolException;
 994 begin
 995   Result := TProtocolExceptionUnknown.Create(Msg);
 996 end;
 997
 998 class function TProtocolException.Create: TProtocolException;
 999 begin
1000   Result := TProtocolExceptionUnknown.Create('');
1001 end;
1002
1003 class function TProtocolException.Create(type_: Integer): TProtocolException;
1004 begin
1005 {$WARN SYMBOL_DEPRECATED OFF}
1006   Result := Create(type_, '');
1007 {$WARN SYMBOL_DEPRECATED DEFAULT}
1008 end;
1009
1010 class function TProtocolException.Create(type_: Integer; const msg: string): TProtocolException;
1011 begin
1012   case type_ of
1013     INVALID_DATA:    Result := TProtocolExceptionInvalidData.Create(msg);
1014     NEGATIVE_SIZE:   Result := TProtocolExceptionNegativeSize.Create(msg);
1015     SIZE_LIMIT:      Result := TProtocolExceptionSizeLimit.Create(msg);
1016     BAD_VERSION:     Result := TProtocolExceptionBadVersion.Create(msg);
1017     NOT_IMPLEMENTED: Result := TProtocolExceptionNotImplemented.Create(msg);
1018     DEPTH_LIMIT:     Result := TProtocolExceptionDepthLimit.Create(msg);
1019   else
1020     Result := TProtocolExceptionUnknown.Create(msg);
1021   end;
1022 end;
1023
1024 { TProtocolExceptionSpecialized }
1025
1026 constructor TProtocolExceptionSpecialized.Create(const Msg: string);
1027 begin
1028   inherited HiddenCreate(Msg);
1029 end;
1030
1031 { TBinaryProtocolImpl.TFactory }
1032
1033 constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);
1034 begin
1035   inherited Create;
1036   FStrictRead := AStrictRead;
1037   FStrictWrite := AStrictWrite;
1038 end;
1039
1040 constructor TBinaryProtocolImpl.TFactory.Create;
1041 begin
1042   //no inherited;
1043   Create( False, True )
1044 end;
1045
1046 function TBinaryProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
1047 begin
1048   Result := TBinaryProtocolImpl.Create( trans, FStrictRead, FStrictWrite);
1049 end;
1050
1051
1052 { TProtocolDecorator }
1053
1054 constructor TProtocolDecorator.Create( const aProtocol : IProtocol);
1055 begin
1056   ASSERT( aProtocol <> nil);
1057   inherited Create( aProtocol.Transport);
1058   FWrappedProtocol := aProtocol;
1059 end;
1060
1061
1062 procedure TProtocolDecorator.WriteMessageBegin( const msg: TThriftMessage);
1063 begin
1064   FWrappedProtocol.WriteMessageBegin( msg);
1065 end;
1066
1067
1068 procedure TProtocolDecorator.WriteMessageEnd;
1069 begin
1070   FWrappedProtocol.WriteMessageEnd;
1071 end;
1072
1073
1074 procedure TProtocolDecorator.WriteStructBegin( const struc: TThriftStruct);
1075 begin
1076   FWrappedProtocol.WriteStructBegin( struc);
1077 end;
1078
1079
1080 procedure TProtocolDecorator.WriteStructEnd;
1081 begin
1082   FWrappedProtocol.WriteStructEnd;
1083 end;
1084
1085
1086 procedure TProtocolDecorator.WriteFieldBegin( const field: TThriftField);
1087 begin
1088   FWrappedProtocol.WriteFieldBegin( field);
1089 end;
1090
1091
1092 procedure TProtocolDecorator.WriteFieldEnd;
1093 begin
1094   FWrappedProtocol.WriteFieldEnd;
1095 end;
1096
1097
1098 procedure TProtocolDecorator.WriteFieldStop;
1099 begin
1100   FWrappedProtocol.WriteFieldStop;
1101 end;
1102
1103
1104 procedure TProtocolDecorator.WriteMapBegin( const map: TThriftMap);
1105 begin
1106   FWrappedProtocol.WriteMapBegin( map);
1107 end;
1108
1109
1110 procedure TProtocolDecorator.WriteMapEnd;
1111 begin
1112   FWrappedProtocol.WriteMapEnd;
1113 end;
1114
1115
1116 procedure TProtocolDecorator.WriteListBegin( const list: TThriftList);
1117 begin
1118   FWrappedProtocol.WriteListBegin( list);
1119 end;
1120
1121
1122 procedure TProtocolDecorator.WriteListEnd();
1123 begin
1124   FWrappedProtocol.WriteListEnd();
1125 end;
1126
1127
1128 procedure TProtocolDecorator.WriteSetBegin( const set_: TThriftSet );
1129 begin
1130   FWrappedProtocol.WriteSetBegin( set_);
1131 end;
1132
1133
1134 procedure TProtocolDecorator.WriteSetEnd();
1135 begin
1136   FWrappedProtocol.WriteSetEnd();
1137 end;
1138
1139
1140 procedure TProtocolDecorator.WriteBool( b: Boolean);
1141 begin
1142   FWrappedProtocol.WriteBool( b);
1143 end;
1144
1145
1146 procedure TProtocolDecorator.WriteByte( b: ShortInt);
1147 begin
1148   FWrappedProtocol.WriteByte( b);
1149 end;
1150
1151
1152 procedure TProtocolDecorator.WriteI16( i16: SmallInt);
1153 begin
1154   FWrappedProtocol.WriteI16( i16);
1155 end;
1156
1157
1158 procedure TProtocolDecorator.WriteI32( i32: Integer);
1159 begin
1160   FWrappedProtocol.WriteI32( i32);
1161 end;
1162
1163
1164 procedure TProtocolDecorator.WriteI64( const i64: Int64);
1165 begin
1166   FWrappedProtocol.WriteI64( i64);
1167 end;
1168
1169
1170 procedure TProtocolDecorator.WriteDouble( const d: Double);
1171 begin
1172   FWrappedProtocol.WriteDouble( d);
1173 end;
1174
1175
1176 procedure TProtocolDecorator.WriteString( const s: string );
1177 begin
1178   FWrappedProtocol.WriteString( s);
1179 end;
1180
1181
1182 procedure TProtocolDecorator.WriteAnsiString( const s: AnsiString);
1183 begin
1184   FWrappedProtocol.WriteAnsiString( s);
1185 end;
1186
1187
1188 procedure TProtocolDecorator.WriteBinary( const b: TBytes);
1189 begin
1190   FWrappedProtocol.WriteBinary( b);
1191 end;
1192
1193
1194 function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
1195 begin
1196   result := FWrappedProtocol.ReadMessageBegin;
1197 end;
1198
1199
1200 procedure TProtocolDecorator.ReadMessageEnd();
1201 begin
1202   FWrappedProtocol.ReadMessageEnd();
1203 end;
1204
1205
1206 function TProtocolDecorator.ReadStructBegin: TThriftStruct;
1207 begin
1208   result := FWrappedProtocol.ReadStructBegin;
1209 end;
1210
1211
1212 procedure TProtocolDecorator.ReadStructEnd;
1213 begin
1214   FWrappedProtocol.ReadStructEnd;
1215 end;
1216
1217
1218 function TProtocolDecorator.ReadFieldBegin: TThriftField;
1219 begin
1220   result := FWrappedProtocol.ReadFieldBegin;
1221 end;
1222
1223
1224 procedure TProtocolDecorator.ReadFieldEnd();
1225 begin
1226   FWrappedProtocol.ReadFieldEnd();
1227 end;
1228
1229
1230 function TProtocolDecorator.ReadMapBegin: TThriftMap;
1231 begin
1232   result := FWrappedProtocol.ReadMapBegin;
1233 end;
1234
1235
1236 procedure TProtocolDecorator.ReadMapEnd();
1237 begin
1238   FWrappedProtocol.ReadMapEnd();
1239 end;
1240
1241
1242 function TProtocolDecorator.ReadListBegin: TThriftList;
1243 begin
1244   result := FWrappedProtocol.ReadListBegin;
1245 end;
1246
1247
1248 procedure TProtocolDecorator.ReadListEnd();
1249 begin
1250   FWrappedProtocol.ReadListEnd();
1251 end;
1252
1253
1254 function TProtocolDecorator.ReadSetBegin: TThriftSet;
1255 begin
1256   result := FWrappedProtocol.ReadSetBegin;
1257 end;
1258
1259
1260 procedure TProtocolDecorator.ReadSetEnd();
1261 begin
1262   FWrappedProtocol.ReadSetEnd();
1263 end;
1264
1265
1266 function TProtocolDecorator.ReadBool: Boolean;
1267 begin
1268   result := FWrappedProtocol.ReadBool;
1269 end;
1270
1271
1272 function TProtocolDecorator.ReadByte: ShortInt;
1273 begin
1274   result := FWrappedProtocol.ReadByte;
1275 end;
1276
1277
1278 function TProtocolDecorator.ReadI16: SmallInt;
1279 begin
1280   result := FWrappedProtocol.ReadI16;
1281 end;
1282
1283
1284 function TProtocolDecorator.ReadI32: Integer;
1285 begin
1286   result := FWrappedProtocol.ReadI32;
1287 end;
1288
1289
1290 function TProtocolDecorator.ReadI64: Int64;
1291 begin
1292   result := FWrappedProtocol.ReadI64;
1293 end;
1294
1295
1296 function TProtocolDecorator.ReadDouble:Double;
1297 begin
1298   result := FWrappedProtocol.ReadDouble;
1299 end;
1300
1301
1302 function TProtocolDecorator.ReadBinary: TBytes;
1303 begin
1304   result := FWrappedProtocol.ReadBinary;
1305 end;
1306
1307
1308 function TProtocolDecorator.ReadString: string;
1309 begin
1310   result := FWrappedProtocol.ReadString;
1311 end;
1312
1313
1314 function TProtocolDecorator.ReadAnsiString: AnsiString;
1315 begin
1316   result := FWrappedProtocol.ReadAnsiString;
1317 end;
1318
1319
1320 { Init helper functions }
1321
1322 procedure Init( var rec : TThriftMessage; const AName: string; const AMessageType: TMessageType; const ASeqID: Integer);
1323 begin
1324   rec.Name := AName;
1325   rec.Type_ := AMessageType;
1326   rec.SeqID := ASeqID;
1327 end;
1328
1329
1330 procedure Init( var rec : TThriftStruct; const AName: string = '');
1331 begin
1332   rec.Name := AName;
1333 end;
1334
1335
1336 procedure Init( var rec : TThriftField; const AName: string; const AType: TType; const AID: SmallInt);
1337 begin
1338   rec.Name := AName;
1339   rec.Type_ := AType;
1340   rec.Id := AId;
1341 end;
1342
1343
1344 procedure Init( var rec : TThriftMap; const AKeyType, AValueType: TType; const ACount: Integer);
1345 begin
1346   rec.ValueType := AValueType;
1347   rec.KeyType := AKeyType;
1348   rec.Count := ACount;
1349 end;
1350
1351
1352 procedure Init( var rec : TThriftSet; const AElementType: TType; const ACount: Integer);
1353 begin
1354   rec.Count := ACount;
1355   rec.ElementType := AElementType;
1356 end;
1357
1358
1359 procedure Init( var rec : TThriftList; const AElementType: TType; const ACount: Integer);
1360 begin
1361   rec.Count := ACount;
1362   rec.ElementType := AElementType;
1363 end;
1364
1365
1366
1367
1368
1369 end.
1370