]> git.proxmox.com Git - ceph.git/blame - ceph/src/jaegertracing/thrift/lib/delphi/src/Thrift.Protocol.pas
buildsys: switch source download to quincy
[ceph.git] / ceph / src / jaegertracing / thrift / lib / delphi / src / Thrift.Protocol.pas
CommitLineData
f67539c2
TL
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
22unit Thrift.Protocol;
23
24interface
25
26uses
27 Classes,
28 SysUtils,
29 Contnrs,
30 Thrift.Exception,
31 Thrift.Stream,
32 Thrift.Utils,
33 Thrift.Collections,
34 Thrift.Transport;
35
36type
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
61const
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
70const
71 DEFAULT_RECURSION_LIMIT = 64;
72
73type
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
432type
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
469procedure Init( var rec : TThriftMessage; const AName: string = ''; const AMessageType: TMessageType = Low(TMessageType); const ASeqID: Integer = 0); overload; inline;
470procedure Init( var rec : TThriftStruct; const AName: string = ''); overload; inline;
471procedure Init( var rec : TThriftField; const AName: string = ''; const AType: TType = Low(TType); const AID: SmallInt = 0); overload; inline;
472procedure Init( var rec : TThriftMap; const AKeyType: TType = Low(TType); const AValueType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
473procedure Init( var rec : TThriftSet; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
474procedure Init( var rec : TThriftList; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
475
476
477implementation
478
479function ConvertInt64ToDouble( const n: Int64): Double;
480begin
481 ASSERT( SizeOf(n) = SizeOf(Result));
482 System.Move( n, Result, SizeOf(Result));
483end;
484
485function ConvertDoubleToInt64( const d: Double): Int64;
486begin
487 ASSERT( SizeOf(d) = SizeOf(Result));
488 System.Move( d, Result, SizeOf(Result));
489end;
490
491
492
493{ TProtocolRecursionTrackerImpl }
494
495constructor TProtocolRecursionTrackerImpl.Create( prot : IProtocol);
496begin
497 inherited Create;
498
499 // storing the pointer *after* the (successful) increment is important here
500 prot.IncrementRecursionDepth;
501 FProtocol := prot;
502end;
503
504destructor TProtocolRecursionTrackerImpl.Destroy;
505begin
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;
515end;
516
517{ TProtocolImpl }
518
519constructor TProtocolImpl.Create(trans: ITransport);
520begin
521 inherited Create;
522 FTrans := trans;
523 FRecursionLimit := DEFAULT_RECURSION_LIMIT;
524 FRecursionDepth := 0;
525end;
526
527procedure TProtocolImpl.SetRecursionLimit( value : Integer);
528begin
529 FRecursionLimit := value;
530end;
531
532function TProtocolImpl.GetRecursionLimit : Integer;
533begin
534 result := FRecursionLimit;
535end;
536
537function TProtocolImpl.NextRecursionLevel : IProtocolRecursionTracker;
538begin
539 result := TProtocolRecursionTrackerImpl.Create(Self);
540end;
541
542procedure TProtocolImpl.IncrementRecursionDepth;
543begin
544 if FRecursionDepth < FRecursionLimit
545 then Inc(FRecursionDepth)
546 else raise TProtocolExceptionDepthLimit.Create('Depth limit exceeded');
547end;
548
549procedure TProtocolImpl.DecrementRecursionDepth;
550begin
551 Dec(FRecursionDepth)
552end;
553
554function TProtocolImpl.GetTransport: ITransport;
555begin
556 Result := FTrans;
557end;
558
559function TProtocolImpl.ReadAnsiString: AnsiString;
560var
561 b : TBytes;
562 len : Integer;
563begin
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;
572end;
573
574function TProtocolImpl.ReadString: string;
575begin
576 Result := TEncoding.UTF8.GetString( ReadBinary );
577end;
578
579procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);
580var
581 b : TBytes;
582 len : Integer;
583begin
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 );
591end;
592
593procedure TProtocolImpl.WriteString(const s: string);
594var
595 b : TBytes;
596begin
597 b := TEncoding.UTF8.GetBytes(s);
598 WriteBinary( b );
599end;
600
601{ TProtocolUtil }
602
603class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
604var field : TThriftField;
605 map : TThriftMap;
606 set_ : TThriftSet;
607 list : TThriftList;
608 i : Integer;
609 tracker : IProtocolRecursionTracker;
610begin
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;
660end;
661
662
663{ TBinaryProtocolImpl }
664
665constructor TBinaryProtocolImpl.Create( const trans: ITransport);
666begin
667 //no inherited
668 Create( trans, False, True);
669end;
670
671constructor TBinaryProtocolImpl.Create( const trans: ITransport; strictRead,
672 strictWrite: Boolean);
673begin
674 inherited Create( trans );
675 FStrictRead := strictRead;
676 FStrictWrite := strictWrite;
677end;
678
679function TBinaryProtocolImpl.ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;
680begin
681 Result := FTrans.ReadAll( pBuf, buflen, off, len );
682end;
683
684function TBinaryProtocolImpl.ReadBinary: TBytes;
685var
686 size : Integer;
687 buf : TBytes;
688begin
689 size := ReadI32;
690 SetLength( buf, size );
691 FTrans.ReadAll( buf, 0, size);
692 Result := buf;
693end;
694
695function TBinaryProtocolImpl.ReadBool: Boolean;
696begin
697 Result := (ReadByte = 1);
698end;
699
700function TBinaryProtocolImpl.ReadByte: ShortInt;
701begin
702 ReadAll( @result, SizeOf(result), 0, 1);
703end;
704
705function TBinaryProtocolImpl.ReadDouble: Double;
706begin
707 Result := ConvertInt64ToDouble( ReadI64 )
708end;
709
710function TBinaryProtocolImpl.ReadFieldBegin: TThriftField;
711begin
712 Init( result, '', TType( ReadByte), 0);
713 if ( result.Type_ <> TType.Stop ) then begin
714 result.Id := ReadI16;
715 end;
716end;
717
718procedure TBinaryProtocolImpl.ReadFieldEnd;
719begin
720
721end;
722
723function TBinaryProtocolImpl.ReadI16: SmallInt;
724var i16in : packed array[0..1] of Byte;
725begin
726 ReadAll( @i16in, Sizeof(i16in), 0, 2);
727 Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
728end;
729
730function TBinaryProtocolImpl.ReadI32: Integer;
731var i32in : packed array[0..3] of Byte;
732begin
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
741end;
742
743function TBinaryProtocolImpl.ReadI64: Int64;
744var i64in : packed array[0..7] of Byte;
745begin
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));
756end;
757
758function TBinaryProtocolImpl.ReadListBegin: TThriftList;
759begin
760 result.ElementType := TType(ReadByte);
761 result.Count := ReadI32;
762end;
763
764procedure TBinaryProtocolImpl.ReadListEnd;
765begin
766
767end;
768
769function TBinaryProtocolImpl.ReadMapBegin: TThriftMap;
770begin
771 result.KeyType := TType(ReadByte);
772 result.ValueType := TType(ReadByte);
773 result.Count := ReadI32;
774end;
775
776procedure TBinaryProtocolImpl.ReadMapEnd;
777begin
778
779end;
780
781function TBinaryProtocolImpl.ReadMessageBegin: TThriftMessage;
782var
783 size : Integer;
784 version : Integer;
785begin
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;
805end;
806
807procedure TBinaryProtocolImpl.ReadMessageEnd;
808begin
809 inherited;
810
811end;
812
813function TBinaryProtocolImpl.ReadSetBegin: TThriftSet;
814begin
815 result.ElementType := TType(ReadByte);
816 result.Count := ReadI32;
817end;
818
819procedure TBinaryProtocolImpl.ReadSetEnd;
820begin
821
822end;
823
824function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;
825var
826 buf : TBytes;
827begin
828 SetLength( buf, size );
829 FTrans.ReadAll( buf, 0, size );
830 Result := TEncoding.UTF8.GetString( buf);
831end;
832
833function TBinaryProtocolImpl.ReadStructBegin: TThriftStruct;
834begin
835 Init( Result);
836end;
837
838procedure TBinaryProtocolImpl.ReadStructEnd;
839begin
840 inherited;
841
842end;
843
844procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);
845var iLen : Integer;
846begin
847 iLen := Length(b);
848 WriteI32( iLen);
849 if iLen > 0 then FTrans.Write(b, 0, iLen);
850end;
851
852procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
853begin
854 if b then begin
855 WriteByte( 1 );
856 end else begin
857 WriteByte( 0 );
858 end;
859end;
860
861procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);
862begin
863 FTrans.Write( @b, 0, 1);
864end;
865
866procedure TBinaryProtocolImpl.WriteDouble( const d: Double);
867begin
868 WriteI64(ConvertDoubleToInt64(d));
869end;
870
871procedure TBinaryProtocolImpl.WriteFieldBegin( const field: TThriftField);
872begin
873 WriteByte(ShortInt(field.Type_));
874 WriteI16(field.ID);
875end;
876
877procedure TBinaryProtocolImpl.WriteFieldEnd;
878begin
879
880end;
881
882procedure TBinaryProtocolImpl.WriteFieldStop;
883begin
884 WriteByte(ShortInt(TType.Stop));
885end;
886
887procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
888var i16out : packed array[0..1] of Byte;
889begin
890 i16out[0] := Byte($FF and (i16 shr 8));
891 i16out[1] := Byte($FF and i16);
892 FTrans.Write( @i16out, 0, 2);
893end;
894
895procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
896var i32out : packed array[0..3] of Byte;
897begin
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);
903end;
904
905procedure TBinaryProtocolImpl.WriteI64( const i64: Int64);
906var i64out : packed array[0..7] of Byte;
907begin
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);
917end;
918
919procedure TBinaryProtocolImpl.WriteListBegin( const list: TThriftList);
920begin
921 WriteByte(ShortInt(list.ElementType));
922 WriteI32(list.Count);
923end;
924
925procedure TBinaryProtocolImpl.WriteListEnd;
926begin
927
928end;
929
930procedure TBinaryProtocolImpl.WriteMapBegin( const map: TThriftMap);
931begin
932 WriteByte(ShortInt(map.KeyType));
933 WriteByte(ShortInt(map.ValueType));
934 WriteI32(map.Count);
935end;
936
937procedure TBinaryProtocolImpl.WriteMapEnd;
938begin
939
940end;
941
942procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
943var
944 version : Cardinal;
945begin
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;
958end;
959
960procedure TBinaryProtocolImpl.WriteMessageEnd;
961begin
962
963end;
964
965procedure TBinaryProtocolImpl.WriteSetBegin( const set_: TThriftSet);
966begin
967 WriteByte(ShortInt(set_.ElementType));
968 WriteI32(set_.Count);
969end;
970
971procedure TBinaryProtocolImpl.WriteSetEnd;
972begin
973
974end;
975
976procedure TBinaryProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
977begin
978
979end;
980
981procedure TBinaryProtocolImpl.WriteStructEnd;
982begin
983
984end;
985
986{ TProtocolException }
987
988constructor TProtocolException.HiddenCreate(const Msg: string);
989begin
990 inherited Create(Msg);
991end;
992
993class function TProtocolException.Create(const Msg: string): TProtocolException;
994begin
995 Result := TProtocolExceptionUnknown.Create(Msg);
996end;
997
998class function TProtocolException.Create: TProtocolException;
999begin
1000 Result := TProtocolExceptionUnknown.Create('');
1001end;
1002
1003class function TProtocolException.Create(type_: Integer): TProtocolException;
1004begin
1005{$WARN SYMBOL_DEPRECATED OFF}
1006 Result := Create(type_, '');
1007{$WARN SYMBOL_DEPRECATED DEFAULT}
1008end;
1009
1010class function TProtocolException.Create(type_: Integer; const msg: string): TProtocolException;
1011begin
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;
1022end;
1023
1024{ TProtocolExceptionSpecialized }
1025
1026constructor TProtocolExceptionSpecialized.Create(const Msg: string);
1027begin
1028 inherited HiddenCreate(Msg);
1029end;
1030
1031{ TBinaryProtocolImpl.TFactory }
1032
1033constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);
1034begin
1035 inherited Create;
1036 FStrictRead := AStrictRead;
1037 FStrictWrite := AStrictWrite;
1038end;
1039
1040constructor TBinaryProtocolImpl.TFactory.Create;
1041begin
1042 //no inherited;
1043 Create( False, True )
1044end;
1045
1046function TBinaryProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
1047begin
1048 Result := TBinaryProtocolImpl.Create( trans, FStrictRead, FStrictWrite);
1049end;
1050
1051
1052{ TProtocolDecorator }
1053
1054constructor TProtocolDecorator.Create( const aProtocol : IProtocol);
1055begin
1056 ASSERT( aProtocol <> nil);
1057 inherited Create( aProtocol.Transport);
1058 FWrappedProtocol := aProtocol;
1059end;
1060
1061
1062procedure TProtocolDecorator.WriteMessageBegin( const msg: TThriftMessage);
1063begin
1064 FWrappedProtocol.WriteMessageBegin( msg);
1065end;
1066
1067
1068procedure TProtocolDecorator.WriteMessageEnd;
1069begin
1070 FWrappedProtocol.WriteMessageEnd;
1071end;
1072
1073
1074procedure TProtocolDecorator.WriteStructBegin( const struc: TThriftStruct);
1075begin
1076 FWrappedProtocol.WriteStructBegin( struc);
1077end;
1078
1079
1080procedure TProtocolDecorator.WriteStructEnd;
1081begin
1082 FWrappedProtocol.WriteStructEnd;
1083end;
1084
1085
1086procedure TProtocolDecorator.WriteFieldBegin( const field: TThriftField);
1087begin
1088 FWrappedProtocol.WriteFieldBegin( field);
1089end;
1090
1091
1092procedure TProtocolDecorator.WriteFieldEnd;
1093begin
1094 FWrappedProtocol.WriteFieldEnd;
1095end;
1096
1097
1098procedure TProtocolDecorator.WriteFieldStop;
1099begin
1100 FWrappedProtocol.WriteFieldStop;
1101end;
1102
1103
1104procedure TProtocolDecorator.WriteMapBegin( const map: TThriftMap);
1105begin
1106 FWrappedProtocol.WriteMapBegin( map);
1107end;
1108
1109
1110procedure TProtocolDecorator.WriteMapEnd;
1111begin
1112 FWrappedProtocol.WriteMapEnd;
1113end;
1114
1115
1116procedure TProtocolDecorator.WriteListBegin( const list: TThriftList);
1117begin
1118 FWrappedProtocol.WriteListBegin( list);
1119end;
1120
1121
1122procedure TProtocolDecorator.WriteListEnd();
1123begin
1124 FWrappedProtocol.WriteListEnd();
1125end;
1126
1127
1128procedure TProtocolDecorator.WriteSetBegin( const set_: TThriftSet );
1129begin
1130 FWrappedProtocol.WriteSetBegin( set_);
1131end;
1132
1133
1134procedure TProtocolDecorator.WriteSetEnd();
1135begin
1136 FWrappedProtocol.WriteSetEnd();
1137end;
1138
1139
1140procedure TProtocolDecorator.WriteBool( b: Boolean);
1141begin
1142 FWrappedProtocol.WriteBool( b);
1143end;
1144
1145
1146procedure TProtocolDecorator.WriteByte( b: ShortInt);
1147begin
1148 FWrappedProtocol.WriteByte( b);
1149end;
1150
1151
1152procedure TProtocolDecorator.WriteI16( i16: SmallInt);
1153begin
1154 FWrappedProtocol.WriteI16( i16);
1155end;
1156
1157
1158procedure TProtocolDecorator.WriteI32( i32: Integer);
1159begin
1160 FWrappedProtocol.WriteI32( i32);
1161end;
1162
1163
1164procedure TProtocolDecorator.WriteI64( const i64: Int64);
1165begin
1166 FWrappedProtocol.WriteI64( i64);
1167end;
1168
1169
1170procedure TProtocolDecorator.WriteDouble( const d: Double);
1171begin
1172 FWrappedProtocol.WriteDouble( d);
1173end;
1174
1175
1176procedure TProtocolDecorator.WriteString( const s: string );
1177begin
1178 FWrappedProtocol.WriteString( s);
1179end;
1180
1181
1182procedure TProtocolDecorator.WriteAnsiString( const s: AnsiString);
1183begin
1184 FWrappedProtocol.WriteAnsiString( s);
1185end;
1186
1187
1188procedure TProtocolDecorator.WriteBinary( const b: TBytes);
1189begin
1190 FWrappedProtocol.WriteBinary( b);
1191end;
1192
1193
1194function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
1195begin
1196 result := FWrappedProtocol.ReadMessageBegin;
1197end;
1198
1199
1200procedure TProtocolDecorator.ReadMessageEnd();
1201begin
1202 FWrappedProtocol.ReadMessageEnd();
1203end;
1204
1205
1206function TProtocolDecorator.ReadStructBegin: TThriftStruct;
1207begin
1208 result := FWrappedProtocol.ReadStructBegin;
1209end;
1210
1211
1212procedure TProtocolDecorator.ReadStructEnd;
1213begin
1214 FWrappedProtocol.ReadStructEnd;
1215end;
1216
1217
1218function TProtocolDecorator.ReadFieldBegin: TThriftField;
1219begin
1220 result := FWrappedProtocol.ReadFieldBegin;
1221end;
1222
1223
1224procedure TProtocolDecorator.ReadFieldEnd();
1225begin
1226 FWrappedProtocol.ReadFieldEnd();
1227end;
1228
1229
1230function TProtocolDecorator.ReadMapBegin: TThriftMap;
1231begin
1232 result := FWrappedProtocol.ReadMapBegin;
1233end;
1234
1235
1236procedure TProtocolDecorator.ReadMapEnd();
1237begin
1238 FWrappedProtocol.ReadMapEnd();
1239end;
1240
1241
1242function TProtocolDecorator.ReadListBegin: TThriftList;
1243begin
1244 result := FWrappedProtocol.ReadListBegin;
1245end;
1246
1247
1248procedure TProtocolDecorator.ReadListEnd();
1249begin
1250 FWrappedProtocol.ReadListEnd();
1251end;
1252
1253
1254function TProtocolDecorator.ReadSetBegin: TThriftSet;
1255begin
1256 result := FWrappedProtocol.ReadSetBegin;
1257end;
1258
1259
1260procedure TProtocolDecorator.ReadSetEnd();
1261begin
1262 FWrappedProtocol.ReadSetEnd();
1263end;
1264
1265
1266function TProtocolDecorator.ReadBool: Boolean;
1267begin
1268 result := FWrappedProtocol.ReadBool;
1269end;
1270
1271
1272function TProtocolDecorator.ReadByte: ShortInt;
1273begin
1274 result := FWrappedProtocol.ReadByte;
1275end;
1276
1277
1278function TProtocolDecorator.ReadI16: SmallInt;
1279begin
1280 result := FWrappedProtocol.ReadI16;
1281end;
1282
1283
1284function TProtocolDecorator.ReadI32: Integer;
1285begin
1286 result := FWrappedProtocol.ReadI32;
1287end;
1288
1289
1290function TProtocolDecorator.ReadI64: Int64;
1291begin
1292 result := FWrappedProtocol.ReadI64;
1293end;
1294
1295
1296function TProtocolDecorator.ReadDouble:Double;
1297begin
1298 result := FWrappedProtocol.ReadDouble;
1299end;
1300
1301
1302function TProtocolDecorator.ReadBinary: TBytes;
1303begin
1304 result := FWrappedProtocol.ReadBinary;
1305end;
1306
1307
1308function TProtocolDecorator.ReadString: string;
1309begin
1310 result := FWrappedProtocol.ReadString;
1311end;
1312
1313
1314function TProtocolDecorator.ReadAnsiString: AnsiString;
1315begin
1316 result := FWrappedProtocol.ReadAnsiString;
1317end;
1318
1319
1320{ Init helper functions }
1321
1322procedure Init( var rec : TThriftMessage; const AName: string; const AMessageType: TMessageType; const ASeqID: Integer);
1323begin
1324 rec.Name := AName;
1325 rec.Type_ := AMessageType;
1326 rec.SeqID := ASeqID;
1327end;
1328
1329
1330procedure Init( var rec : TThriftStruct; const AName: string = '');
1331begin
1332 rec.Name := AName;
1333end;
1334
1335
1336procedure Init( var rec : TThriftField; const AName: string; const AType: TType; const AID: SmallInt);
1337begin
1338 rec.Name := AName;
1339 rec.Type_ := AType;
1340 rec.Id := AId;
1341end;
1342
1343
1344procedure Init( var rec : TThriftMap; const AKeyType, AValueType: TType; const ACount: Integer);
1345begin
1346 rec.ValueType := AValueType;
1347 rec.KeyType := AKeyType;
1348 rec.Count := ACount;
1349end;
1350
1351
1352procedure Init( var rec : TThriftSet; const AElementType: TType; const ACount: Integer);
1353begin
1354 rec.Count := ACount;
1355 rec.ElementType := AElementType;
1356end;
1357
1358
1359procedure Init( var rec : TThriftList; const AElementType: TType; const ACount: Integer);
1360begin
1361 rec.Count := ACount;
1362 rec.ElementType := AElementType;
1363end;
1364
1365
1366
1367
1368
1369end.
1370