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}']
GetProtocolnull112 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)';
Createnull130 class function Create: TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
Createnull131 class function Create( type_: Integer): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
Createnull132 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}']
GetTransportnull170 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
ReadMessageBeginnull194 function ReadMessageBegin: TThriftMessage;
195 procedure ReadMessageEnd();
ReadStructBeginnull196 function ReadStructBegin: TThriftStruct;
197 procedure ReadStructEnd;
ReadFieldBeginnull198 function ReadFieldBegin: TThriftField;
199 procedure ReadFieldEnd();
ReadMapBeginnull200 function ReadMapBegin: TThriftMap;
201 procedure ReadMapEnd();
ReadListBeginnull202 function ReadListBegin: TThriftList;
203 procedure ReadListEnd();
ReadSetBeginnull204 function ReadSetBegin: TThriftSet;
205 procedure ReadSetEnd();
ReadBoolnull206 function ReadBool: Boolean;
ReadBytenull207 function ReadByte: ShortInt;
ReadI16null208 function ReadI16: SmallInt;
ReadI32null209 function ReadI32: Integer;
ReadI64null210 function ReadI64: Int64;
ReadDoublenull211 function ReadDouble:Double;
ReadBinarynull212 function ReadBinary: TBytes;
ReadStringnull213 function ReadString: string;
ReadAnsiStringnull214 function ReadAnsiString: AnsiString;
215
216 procedure SetRecursionLimit( value : Integer);
GetRecursionLimitnull217 function GetRecursionLimit : Integer;
NextRecursionLevelnull218 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);
GetRecursionLimitnull233 function GetRecursionLimit : Integer;
NextRecursionLevelnull234 function NextRecursionLevel : IProtocolRecursionTracker;
235 procedure IncrementRecursionDepth;
236 procedure DecrementRecursionDepth;
237
GetTransportnull238 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
ReadMessageBeginnull263 function ReadMessageBegin: TThriftMessage; virtual; abstract;
264 procedure ReadMessageEnd(); virtual; abstract;
ReadStructBeginnull265 function ReadStructBegin: TThriftStruct; virtual; abstract;
266 procedure ReadStructEnd; virtual; abstract;
ReadFieldBeginnull267 function ReadFieldBegin: TThriftField; virtual; abstract;
268 procedure ReadFieldEnd(); virtual; abstract;
ReadMapBeginnull269 function ReadMapBegin: TThriftMap; virtual; abstract;
270 procedure ReadMapEnd(); virtual; abstract;
ReadListBeginnull271 function ReadListBegin: TThriftList; virtual; abstract;
272 procedure ReadListEnd(); virtual; abstract;
ReadSetBeginnull273 function ReadSetBegin: TThriftSet; virtual; abstract;
274 procedure ReadSetEnd(); virtual; abstract;
ReadBoolnull275 function ReadBool: Boolean; virtual; abstract;
ReadBytenull276 function ReadByte: ShortInt; virtual; abstract;
ReadI16null277 function ReadI16: SmallInt; virtual; abstract;
ReadI32null278 function ReadI32: Integer; virtual; abstract;
ReadI64null279 function ReadI64: Int64; virtual; abstract;
ReadDoublenull280 function ReadDouble:Double; virtual; abstract;
ReadBinarynull281 function ReadBinary: TBytes; virtual; abstract;
ReadStringnull282 function ReadString: string; virtual;
ReadAnsiStringnull283 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
ReadAllnull307 function ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer; inline;
ReadStringBodynull308 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
GetProtocolnull318 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
ReadMessageBeginnull347 function ReadMessageBegin: TThriftMessage; override;
348 procedure ReadMessageEnd(); override;
ReadStructBeginnull349 function ReadStructBegin: TThriftStruct; override;
350 procedure ReadStructEnd; override;
ReadFieldBeginnull351 function ReadFieldBegin: TThriftField; override;
352 procedure ReadFieldEnd(); override;
ReadMapBeginnull353 function ReadMapBegin: TThriftMap; override;
354 procedure ReadMapEnd(); override;
ReadListBeginnull355 function ReadListBegin: TThriftList; override;
356 procedure ReadListEnd(); override;
ReadSetBeginnull357 function ReadSetBegin: TThriftSet; override;
358 procedure ReadSetEnd(); override;
ReadBoolnull359 function ReadBool: Boolean; override;
ReadBytenull360 function ReadByte: ShortInt; override;
ReadI16null361 function ReadI16: SmallInt; override;
ReadI32null362 function ReadI32: Integer; override;
ReadI64null363 function ReadI64: Int64; override;
ReadDoublenull364 function ReadDouble:Double; override;
ReadBinarynull365 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
ReadMessageBeginnull408 function ReadMessageBegin: TThriftMessage; override;
409 procedure ReadMessageEnd(); override;
ReadStructBeginnull410 function ReadStructBegin: TThriftStruct; override;
411 procedure ReadStructEnd; override;
ReadFieldBeginnull412 function ReadFieldBegin: TThriftField; override;
413 procedure ReadFieldEnd(); override;
ReadMapBeginnull414 function ReadMapBegin: TThriftMap; override;
415 procedure ReadMapEnd(); override;
ReadListBeginnull416 function ReadListBegin: TThriftList; override;
417 procedure ReadListEnd(); override;
ReadSetBeginnull418 function ReadSetBegin: TThriftSet; override;
419 procedure ReadSetEnd(); override;
ReadBoolnull420 function ReadBool: Boolean; override;
ReadBytenull421 function ReadByte: ShortInt; override;
ReadI16null422 function ReadI16: SmallInt; override;
ReadI32null423 function ReadI32: Integer; override;
ReadI64null424 function ReadI64: Int64; override;
ReadDoublenull425 function ReadDouble:Double; override;
ReadBinarynull426 function ReadBinary: TBytes; override;
ReadStringnull427 function ReadString: string; override;
ReadAnsiStringnull428 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;
callnull443 // 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);
invocationnull456 // 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}']
Processnull465 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
ConvertInt64ToDoublenull479 function ConvertInt64ToDouble( const n: Int64): Double;
480 begin
481 ASSERT( SizeOf(n) = SizeOf(Result));
482 System.Move( n, Result, SizeOf(Result));
483 end;
484
ConvertDoubleToInt64null485 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
TProtocolImpl.GetRecursionLimitnull532 function TProtocolImpl.GetRecursionLimit : Integer;
533 begin
534 result := FRecursionLimit;
535 end;
536
TProtocolImpl.NextRecursionLevelnull537 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
GetTransportnull554 function TProtocolImpl.GetTransport: ITransport;
555 begin
556 Result := FTrans;
557 end;
558
ReadAnsiStringnull559 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
ReadStringnull574 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
ReadAllnull679 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
ReadBinarynull684 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
ReadBoolnull695 function TBinaryProtocolImpl.ReadBool: Boolean;
696 begin
697 Result := (ReadByte = 1);
698 end;
699
ReadBytenull700 function TBinaryProtocolImpl.ReadByte: ShortInt;
701 begin
702 ReadAll( @result, SizeOf(result), 0, 1);
703 end;
704
ReadDoublenull705 function TBinaryProtocolImpl.ReadDouble: Double;
706 begin
707 Result := ConvertInt64ToDouble( ReadI64 )
708 end;
709
ReadFieldBeginnull710 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
ReadI16null723 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
ReadI32null730 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
ReadI64null743 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
ReadListBeginnull758 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
ReadMapBeginnull769 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
ReadMessageBeginnull781 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
ReadSetBeginnull813 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
ReadStringBodynull824 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
ReadStructBeginnull833 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
TFactorynull1046 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
ReadMessageBeginnull1194 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
ReadStructBeginnull1206 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
ReadFieldBeginnull1218 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
ReadMapBeginnull1230 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
ReadListBeginnull1242 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
ReadSetBeginnull1254 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
ReadBoolnull1266 function TProtocolDecorator.ReadBool: Boolean;
1267 begin
1268 result := FWrappedProtocol.ReadBool;
1269 end;
1270
1271
ReadBytenull1272 function TProtocolDecorator.ReadByte: ShortInt;
1273 begin
1274 result := FWrappedProtocol.ReadByte;
1275 end;
1276
1277
ReadI16null1278 function TProtocolDecorator.ReadI16: SmallInt;
1279 begin
1280 result := FWrappedProtocol.ReadI16;
1281 end;
1282
1283
ReadI32null1284 function TProtocolDecorator.ReadI32: Integer;
1285 begin
1286 result := FWrappedProtocol.ReadI32;
1287 end;
1288
1289
ReadI64null1290 function TProtocolDecorator.ReadI64: Int64;
1291 begin
1292 result := FWrappedProtocol.ReadI64;
1293 end;
1294
1295
ReadDoublenull1296 function TProtocolDecorator.ReadDouble:Double;
1297 begin
1298 result := FWrappedProtocol.ReadDouble;
1299 end;
1300
1301
ReadBinarynull1302 function TProtocolDecorator.ReadBinary: TBytes;
1303 begin
1304 result := FWrappedProtocol.ReadBinary;
1305 end;
1306
1307
ReadStringnull1308 function TProtocolDecorator.ReadString: string;
1309 begin
1310 result := FWrappedProtocol.ReadString;
1311 end;
1312
1313
ReadAnsiStringnull1314 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
1371