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.JSON;
23
24 interface
25
26 uses
27 Character,
28 Classes,
29 SysUtils,
30 Math,
31 Generics.Collections,
32 Thrift.Configuration,
33 Thrift.Transport,
34 Thrift.Protocol,
35 Thrift.Utils;
36
37 type
38 IJSONProtocol = interface( IProtocol)
39 ['{F0DAFDBD-692A-4B71-9736-F5D485A2178F}']
40 // Read a byte that must match b; otherwise an exception is thrown.
41 procedure ReadJSONSyntaxChar( b : Byte);
42 end;
43
44 // JSON protocol implementation for thrift.
45 // This is a full-featured protocol supporting Write and Read.
46 // Please see the C++ class header for a detailed description of the protocol's wire format.
47 // Adapted from the C# version.
48 TJSONProtocolImpl = class( TProtocolImpl, IJSONProtocol)
49 public
50 type
51 TFactory = class( TInterfacedObject, IProtocolFactory)
52 public
53 function GetProtocol( const trans: ITransport): IProtocol;
54 end;
55
56 strict private
57 class function GetTypeNameForTypeID(typeID : TType) : string;
58 class function GetTypeIDForTypeName( const name : string) : TType;
59
60 strict protected
61 type
62 // Base class for tracking JSON contexts that may require
63 // inserting/Reading additional JSON syntax characters.
64 // This base context does nothing.
65 TJSONBaseContext = class
66 strict protected
67 FProto : Pointer; // weak IJSONProtocol;
68 public
69 constructor Create( const aProto : IJSONProtocol);
70 procedure Write; virtual;
71 procedure Read; virtual;
72 function EscapeNumbers : Boolean; virtual;
73 end;
74
75 // Context for JSON lists.
76 // Will insert/Read commas before each item except for the first one.
77 TJSONListContext = class( TJSONBaseContext)
78 strict private
79 FFirst : Boolean;
80 public
81 constructor Create( const aProto : IJSONProtocol);
82 procedure Write; override;
83 procedure Read; override;
84 end;
85
86 // Context for JSON records. Will insert/Read colons before the value portion of each record
87 // pair, and commas before each key except the first. In addition, will indicate that numbers
88 // in the key position need to be escaped in quotes (since JSON keys must be strings).
89 TJSONPairContext = class( TJSONBaseContext)
90 strict private
91 FFirst, FColon : Boolean;
92 public
93 constructor Create( const aProto : IJSONProtocol);
94 procedure Write; override;
95 procedure Read; override;
96 function EscapeNumbers : Boolean; override;
97 end;
98
99 // Holds up to one byte from the transport
100 TLookaheadReader = class
101 strict protected
102 FProto : Pointer; // weak IJSONProtocol;
103
104 protected
105 constructor Create( const aProto : IJSONProtocol);
106
107 strict private
108 FHasData : Boolean;
109 FData : Byte;
110
111 public
112 // Return and consume the next byte to be Read, either taking it from the
113 // data buffer if present or getting it from the transport otherwise.
114 function Read : Byte;
115
116 // Return the next byte to be Read without consuming, filling the data
117 // buffer if it has not been filled alReady.
118 function Peek : Byte;
119 end;
120
121 strict protected
122 // Stack of nested contexts that we may be in
123 FContextStack : TStack<TJSONBaseContext>;
124
125 // Current context that we are in
126 FContext : TJSONBaseContext;
127
128 // Reader that manages a 1-byte buffer
129 FReader : TLookaheadReader;
130
131 // Push/pop a new JSON context onto/from the stack.
132 procedure ResetContextStack;
133 procedure PushContext( const aCtx : TJSONBaseContext);
134 procedure PopContext;
135
136 strict protected
137 function GetMinSerializedSize( const aType : TType) : Integer; override;
138 procedure Reset; override;
139
140 public
141 // TJSONProtocolImpl Constructor
142 constructor Create( const aTrans : ITransport);
143 destructor Destroy; override;
144
145 strict protected
146 // IJSONProtocol
147 // Read a byte that must match b; otherwise an exception is thrown.
148 procedure ReadJSONSyntaxChar( b : Byte);
149
150 strict private
151 // Convert a byte containing a hex char ('0'-'9' or 'a'-'f') into its corresponding hex value
152 class function HexVal( ch : Byte) : Byte;
153
154 // Convert a byte containing a hex value to its corresponding hex character
155 class function HexChar( val : Byte) : Byte;
156
157 // Write the bytes in array buf as a JSON characters, escaping as needed
158 procedure WriteJSONString( const b : TBytes); overload;
159 procedure WriteJSONString( const str : string); overload;
160
161 // Write out number as a JSON value. If the context dictates so, it will be
162 // wrapped in quotes to output as a JSON string.
163 procedure WriteJSONInteger( const num : Int64);
164
165 // Write out a double as a JSON value. If it is NaN or infinity or if the
166 // context dictates escaping, Write out as JSON string.
167 procedure WriteJSONDouble( const num : Double);
168
169 // Write out contents of byte array b as a JSON string with base-64 encoded data
170 procedure WriteJSONBase64( const b : TBytes);
171
172 procedure WriteJSONObjectStart;
173 procedure WriteJSONObjectEnd;
174 procedure WriteJSONArrayStart;
175 procedure WriteJSONArrayEnd;
176
177 public
178 // IProtocol
179 procedure WriteMessageBegin( const aMsg : TThriftMessage); override;
180 procedure WriteMessageEnd; override;
181 procedure WriteStructBegin( const struc: TThriftStruct); override;
182 procedure WriteStructEnd; override;
183 procedure WriteFieldBegin( const field: TThriftField); override;
184 procedure WriteFieldEnd; override;
185 procedure WriteFieldStop; override;
186 procedure WriteMapBegin( const map: TThriftMap); override;
187 procedure WriteMapEnd; override;
188 procedure WriteListBegin( const list: TThriftList); override;
189 procedure WriteListEnd(); override;
190 procedure WriteSetBegin( const set_: TThriftSet ); override;
191 procedure WriteSetEnd(); override;
192 procedure WriteBool( b: Boolean); override;
193 procedure WriteByte( b: ShortInt); override;
194 procedure WriteI16( i16: SmallInt); override;
195 procedure WriteI32( i32: Integer); override;
196 procedure WriteI64( const i64: Int64); override;
197 procedure WriteDouble( const d: Double); override;
198 procedure WriteString( const s: string ); override;
199 procedure WriteBinary( const b: TBytes); override;
200 //
201 function ReadMessageBegin: TThriftMessage; override;
202 procedure ReadMessageEnd(); override;
203 function ReadStructBegin: TThriftStruct; override;
204 procedure ReadStructEnd; override;
205 function ReadFieldBegin: TThriftField; override;
206 procedure ReadFieldEnd(); override;
207 function ReadMapBegin: TThriftMap; override;
208 procedure ReadMapEnd(); override;
209 function ReadListBegin: TThriftList; override;
210 procedure ReadListEnd(); override;
211 function ReadSetBegin: TThriftSet; override;
212 procedure ReadSetEnd(); override;
213 function ReadBool: Boolean; override;
214 function ReadByte: ShortInt; override;
215 function ReadI16: SmallInt; override;
216 function ReadI32: Integer; override;
217 function ReadI64: Int64; override;
218 function ReadDouble:Double; override;
219 function ReadString : string; override;
220 function ReadBinary: TBytes; override;
221
222
223 strict private
224 // Reading methods.
225
226 // Read in a JSON string, unescaping as appropriate.
227 // Skip Reading from the context if skipContext is true.
228 function ReadJSONString( skipContext : Boolean) : TBytes;
229
230 // Return true if the given byte could be a valid part of a JSON number.
231 function IsJSONNumeric( b : Byte) : Boolean;
232
233 // Read in a sequence of characters that are all valid in JSON numbers. Does
234 // not do a complete regex check to validate that this is actually a number.
235 function ReadJSONNumericChars : String;
236
237 // Read in a JSON number. If the context dictates, Read in enclosing quotes.
238 function ReadJSONInteger : Int64;
239
240 // Read in a JSON double value. Throw if the value is not wrapped in quotes
241 // when expected or if wrapped in quotes when not expected.
242 function ReadJSONDouble : Double;
243
244 // Read in a JSON string containing base-64 encoded data and decode it.
245 function ReadJSONBase64 : TBytes;
246
247 procedure ReadJSONObjectStart;
248 procedure ReadJSONObjectEnd;
249 procedure ReadJSONArrayStart;
250 procedure ReadJSONArrayEnd;
251 end;
252
253
254 implementation
255
256 var
257 COMMA : TBytes;
258 COLON : TBytes;
259 LBRACE : TBytes;
260 RBRACE : TBytes;
261 LBRACKET : TBytes;
262 RBRACKET : TBytes;
263 QUOTE : TBytes;
264 BACKSLASH : TBytes;
265 ESCSEQ : TBytes;
266
267 const
268 VERSION = 1;
269 JSON_CHAR_TABLE : array[0..$2F] of Byte
270 = (0,0,0,0, 0,0,0,0, Byte('b'),Byte('t'),Byte('n'),0, Byte('f'),Byte('r'),0,0,
271 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,
272 1,1,Byte('"'),1, 1,1,1,1, 1,1,1,1, 1,1,1,1);
273
274 ESCAPE_CHARS = '"\/btnfr';
275 ESCAPE_CHAR_VALS = '"\/'#8#9#10#12#13;
276
277 DEF_STRING_SIZE = 16;
278
279 NAME_BOOL = 'tf';
280 NAME_BYTE = 'i8';
281 NAME_I16 = 'i16';
282 NAME_I32 = 'i32';
283 NAME_I64 = 'i64';
284 NAME_DOUBLE = 'dbl';
285 NAME_STRUCT = 'rec';
286 NAME_STRING = 'str';
287 NAME_MAP = 'map';
288 NAME_LIST = 'lst';
289 NAME_SET = 'set';
290
291 INVARIANT_CULTURE : TFormatSettings
292 = ( ThousandSeparator: ',';
293 DecimalSeparator: '.');
294
295
296
297 //--- TJSONProtocolImpl ----------------------
298
299
TFactorynull300 function TJSONProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
301 begin
302 result := TJSONProtocolImpl.Create( trans);
303 end;
304
305 class function TJSONProtocolImpl.GetTypeNameForTypeID(typeID : TType) : string;
306 begin
307 case typeID of
308 TType.Bool_: result := NAME_BOOL;
309 TType.Byte_: result := NAME_BYTE;
310 TType.I16: result := NAME_I16;
311 TType.I32: result := NAME_I32;
312 TType.I64: result := NAME_I64;
313 TType.Double_: result := NAME_DOUBLE;
314 TType.String_: result := NAME_STRING;
315 TType.Struct: result := NAME_STRUCT;
316 TType.Map: result := NAME_MAP;
317 TType.Set_: result := NAME_SET;
318 TType.List: result := NAME_LIST;
319 else
320 raise TProtocolExceptionNotImplemented.Create('Unrecognized type ('+IntToStr(Ord(typeID))+')');
321 end;
322 end;
323
324
325 class function TJSONProtocolImpl.GetTypeIDForTypeName( const name : string) : TType;
326 begin
327 if name = NAME_BOOL then result := TType.Bool_
328 else if name = NAME_BYTE then result := TType.Byte_
329 else if name = NAME_I16 then result := TType.I16
330 else if name = NAME_I32 then result := TType.I32
331 else if name = NAME_I64 then result := TType.I64
332 else if name = NAME_DOUBLE then result := TType.Double_
333 else if name = NAME_STRUCT then result := TType.Struct
334 else if name = NAME_STRING then result := TType.String_
335 else if name = NAME_MAP then result := TType.Map
336 else if name = NAME_LIST then result := TType.List
337 else if name = NAME_SET then result := TType.Set_
338 else raise TProtocolExceptionNotImplemented.Create('Unrecognized type ('+name+')');
339 end;
340
341
342 constructor TJSONProtocolImpl.TJSONBaseContext.Create( const aProto : IJSONProtocol);
343 begin
344 inherited Create;
345 FProto := Pointer(aProto);
346 end;
347
348
349 procedure TJSONProtocolImpl.TJSONBaseContext.Write;
350 begin
351 // nothing
352 end;
353
354
355 procedure TJSONProtocolImpl.TJSONBaseContext.Read;
356 begin
357 // nothing
358 end;
359
360
TJSONBaseContextnull361 function TJSONProtocolImpl.TJSONBaseContext.EscapeNumbers : Boolean;
362 begin
363 result := FALSE;
364 end;
365
366
367 constructor TJSONProtocolImpl.TJSONListContext.Create( const aProto : IJSONProtocol);
368 begin
369 inherited Create( aProto);
370 FFirst := TRUE;
371 end;
372
373
374 procedure TJSONProtocolImpl.TJSONListContext.Write;
375 begin
376 if FFirst
377 then FFirst := FALSE
378 else IJSONProtocol(FProto).Transport.Write( COMMA);
379 end;
380
381
382 procedure TJSONProtocolImpl.TJSONListContext.Read;
383 begin
384 if FFirst
385 then FFirst := FALSE
386 else IJSONProtocol(FProto).ReadJSONSyntaxChar( COMMA[0]);
387 end;
388
389
390 constructor TJSONProtocolImpl.TJSONPairContext.Create( const aProto : IJSONProtocol);
391 begin
392 inherited Create( aProto);
393 FFirst := TRUE;
394 FColon := TRUE;
395 end;
396
397
398 procedure TJSONProtocolImpl.TJSONPairContext.Write;
399 begin
400 if FFirst then begin
401 FFirst := FALSE;
402 FColon := TRUE;
403 end
404 else begin
405 if FColon
406 then IJSONProtocol(FProto).Transport.Write( COLON)
407 else IJSONProtocol(FProto).Transport.Write( COMMA);
408 FColon := not FColon;
409 end;
410 end;
411
412
413 procedure TJSONProtocolImpl.TJSONPairContext.Read;
414 begin
415 if FFirst then begin
416 FFirst := FALSE;
417 FColon := TRUE;
418 end
419 else begin
420 if FColon
421 then IJSONProtocol(FProto).ReadJSONSyntaxChar( COLON[0])
422 else IJSONProtocol(FProto).ReadJSONSyntaxChar( COMMA[0]);
423 FColon := not FColon;
424 end;
425 end;
426
427
TJSONPairContextnull428 function TJSONProtocolImpl.TJSONPairContext.EscapeNumbers : Boolean;
429 begin
430 result := FColon;
431 end;
432
433
434 constructor TJSONProtocolImpl.TLookaheadReader.Create( const aProto : IJSONProtocol);
435 begin
436 inherited Create;
437 FProto := Pointer(aProto);
438 FHasData := FALSE;
439 end;
440
441
TLookaheadReadernull442 function TJSONProtocolImpl.TLookaheadReader.Read : Byte;
443 begin
444 if FHasData
445 then FHasData := FALSE
446 else begin
447 IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
448 end;
449 result := FData;
450 end;
451
452
TLookaheadReadernull453 function TJSONProtocolImpl.TLookaheadReader.Peek : Byte;
454 begin
455 if not FHasData then begin
456 IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
457 FHasData := TRUE;
458 end;
459 result := FData;
460 end;
461
462
463 constructor TJSONProtocolImpl.Create( const aTrans : ITransport);
464 begin
465 inherited Create( aTrans);
466
467 // Stack of nested contexts that we may be in
468 FContextStack := TStack<TJSONBaseContext>.Create;
469
470 FContext := TJSONBaseContext.Create( Self);
471 FReader := TLookaheadReader.Create( Self);
472 end;
473
474
475 destructor TJSONProtocolImpl.Destroy;
476 begin
477 try
478 ResetContextStack; // free any contents
479 FreeAndNil( FReader);
480 FreeAndNil( FContext);
481 FreeAndNil( FContextStack);
482 finally
483 inherited Destroy;
484 end;
485 end;
486
487
488 procedure TJSONProtocolImpl.Reset;
489 begin
490 inherited Reset;
491 ResetContextStack;
492 end;
493
494
495 procedure TJSONProtocolImpl.ResetContextStack;
496 begin
497 while FContextStack.Count > 0
498 do PopContext;
499 end;
500
501
502 procedure TJSONProtocolImpl.PushContext( const aCtx : TJSONBaseContext);
503 begin
504 FContextStack.Push( FContext);
505 FContext := aCtx;
506 end;
507
508
509 procedure TJSONProtocolImpl.PopContext;
510 begin
511 FreeAndNil(FContext);
512 FContext := FContextStack.Pop;
513 end;
514
515
516 procedure TJSONProtocolImpl.ReadJSONSyntaxChar( b : Byte);
517 var ch : Byte;
518 begin
519 ch := FReader.Read;
520 if (ch <> b)
521 then raise TProtocolExceptionInvalidData.Create('Unexpected character ('+Char(ch)+')');
522 end;
523
524
525 class function TJSONProtocolImpl.HexVal( ch : Byte) : Byte;
526 var i : Integer;
527 begin
528 i := StrToIntDef( '$0'+Char(ch), -1);
529 if (0 <= i) and (i < $10)
530 then result := i
531 else raise TProtocolExceptionInvalidData.Create('Expected hex character ('+Char(ch)+')');
532 end;
533
534
535 class function TJSONProtocolImpl.HexChar( val : Byte) : Byte;
536 const HEXCHARS = '0123456789ABCDEF';
537 begin
538 result := Byte( PChar(HEXCHARS)[val and $0F]);
539 ASSERT( Pos( Char(result), HEXCHARS) > 0);
540 end;
541
542
543 procedure TJSONProtocolImpl.WriteJSONString( const str : string);
544 begin
545 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( str));
546 end;
547
548
549 procedure TJSONProtocolImpl.WriteJSONString( const b : TBytes);
550 var i : Integer;
551 tmp : TBytes;
552 begin
553 FContext.Write;
554 Transport.Write( QUOTE);
555 for i := 0 to Length(b)-1 do begin
556
557 if (b[i] and $00FF) >= $30 then begin
558
559 if (b[i] = BACKSLASH[0]) then begin
560 Transport.Write( BACKSLASH);
561 Transport.Write( BACKSLASH);
562 end
563 else begin
564 Transport.Write( b, i, 1);
565 end;
566
567 end
568 else begin
569 SetLength( tmp, 2);
570 tmp[0] := JSON_CHAR_TABLE[b[i]];
571 if (tmp[0] = 1) then begin
572 Transport.Write( b, i, 1)
573 end
574 else if (tmp[0] > 1) then begin
575 Transport.Write( BACKSLASH);
576 Transport.Write( tmp, 0, 1);
577 end
578 else begin
579 Transport.Write( ESCSEQ);
580 tmp[0] := HexChar( b[i] div $10);
581 tmp[1] := HexChar( b[i]);
582 Transport.Write( tmp, 0, 2);
583 end;
584 end;
585 end;
586 Transport.Write( QUOTE);
587 end;
588
589
590 procedure TJSONProtocolImpl.WriteJSONInteger( const num : Int64);
591 var str : String;
592 escapeNum : Boolean;
593 begin
594 FContext.Write;
595 str := IntToStr(num);
596
597 escapeNum := FContext.EscapeNumbers;
598 if escapeNum
599 then Transport.Write( QUOTE);
600
601 Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str));
602
603 if escapeNum
604 then Transport.Write( QUOTE);
605 end;
606
607
608 procedure TJSONProtocolImpl.WriteJSONDouble( const num : Double);
609 var str : string;
610 special : Boolean;
611 escapeNum : Boolean;
612 begin
613 FContext.Write;
614
615 str := FloatToStr( num, INVARIANT_CULTURE);
616 special := FALSE;
617
618 case UpCase(str[1]) of
619 'N' : special := TRUE; // NaN
620 'I' : special := TRUE; // Infinity
621 '-' : special := (UpCase(str[2]) = 'I'); // -Infinity
622 end;
623
624 escapeNum := special or FContext.EscapeNumbers;
625
626
627 if escapeNum
628 then Transport.Write( QUOTE);
629
630 Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str));
631
632 if escapeNum
633 then Transport.Write( QUOTE);
634 end;
635
636
637 procedure TJSONProtocolImpl.WriteJSONBase64( const b : TBytes);
638 var len, off, cnt : Integer;
639 tmpBuf : TBytes;
640 begin
641 FContext.Write;
642 Transport.Write( QUOTE);
643
644 len := Length(b);
645 off := 0;
646 SetLength( tmpBuf, 4);
647
648 while len >= 3 do begin
649 // Encode 3 bytes at a time
650 Base64Utils.Encode( b, off, 3, tmpBuf, 0);
651 Transport.Write( tmpBuf, 0, 4);
652 Inc( off, 3);
653 Dec( len, 3);
654 end;
655
656 // Encode remainder, if any
657 if len > 0 then begin
658 cnt := Base64Utils.Encode( b, off, len, tmpBuf, 0);
659 Transport.Write( tmpBuf, 0, cnt);
660 end;
661
662 Transport.Write( QUOTE);
663 end;
664
665
666 procedure TJSONProtocolImpl.WriteJSONObjectStart;
667 begin
668 FContext.Write;
669 Transport.Write( LBRACE);
670 PushContext( TJSONPairContext.Create( Self));
671 end;
672
673
674 procedure TJSONProtocolImpl.WriteJSONObjectEnd;
675 begin
676 PopContext;
677 Transport.Write( RBRACE);
678 end;
679
680
681 procedure TJSONProtocolImpl.WriteJSONArrayStart;
682 begin
683 FContext.Write;
684 Transport.Write( LBRACKET);
685 PushContext( TJSONListContext.Create( Self));
686 end;
687
688
689 procedure TJSONProtocolImpl.WriteJSONArrayEnd;
690 begin
691 PopContext;
692 Transport.Write( RBRACKET);
693 end;
694
695
696 procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : TThriftMessage);
697 begin
698 Reset;
699 ResetContextStack; // THRIFT-1473
700
701 WriteJSONArrayStart;
702 WriteJSONInteger(VERSION);
703
704 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( aMsg.Name));
705
706 WriteJSONInteger( LongInt( aMsg.Type_));
707 WriteJSONInteger( aMsg.SeqID);
708 end;
709
710 procedure TJSONProtocolImpl.WriteMessageEnd;
711 begin
712 WriteJSONArrayEnd;
713 end;
714
715
716 procedure TJSONProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
717 begin
718 WriteJSONObjectStart;
719 end;
720
721
722 procedure TJSONProtocolImpl.WriteStructEnd;
723 begin
724 WriteJSONObjectEnd;
725 end;
726
727
728 procedure TJSONProtocolImpl.WriteFieldBegin( const field : TThriftField);
729 begin
730 WriteJSONInteger(field.ID);
731 WriteJSONObjectStart;
732 WriteJSONString( GetTypeNameForTypeID(field.Type_));
733 end;
734
735
736 procedure TJSONProtocolImpl.WriteFieldEnd;
737 begin
738 WriteJSONObjectEnd;
739 end;
740
741
742 procedure TJSONProtocolImpl.WriteFieldStop;
743 begin
744 // nothing to do
745 end;
746
747 procedure TJSONProtocolImpl.WriteMapBegin( const map: TThriftMap);
748 begin
749 WriteJSONArrayStart;
750 WriteJSONString( GetTypeNameForTypeID( map.KeyType));
751 WriteJSONString( GetTypeNameForTypeID( map.ValueType));
752 WriteJSONInteger( map.Count);
753 WriteJSONObjectStart;
754 end;
755
756
757 procedure TJSONProtocolImpl.WriteMapEnd;
758 begin
759 WriteJSONObjectEnd;
760 WriteJSONArrayEnd;
761 end;
762
763
764 procedure TJSONProtocolImpl.WriteListBegin( const list: TThriftList);
765 begin
766 WriteJSONArrayStart;
767 WriteJSONString( GetTypeNameForTypeID( list.ElementType));
768 WriteJSONInteger(list.Count);
769 end;
770
771
772 procedure TJSONProtocolImpl.WriteListEnd;
773 begin
774 WriteJSONArrayEnd;
775 end;
776
777
778 procedure TJSONProtocolImpl.WriteSetBegin( const set_: TThriftSet);
779 begin
780 WriteJSONArrayStart;
781 WriteJSONString( GetTypeNameForTypeID( set_.ElementType));
782 WriteJSONInteger( set_.Count);
783 end;
784
785
786 procedure TJSONProtocolImpl.WriteSetEnd;
787 begin
788 WriteJSONArrayEnd;
789 end;
790
791 procedure TJSONProtocolImpl.WriteBool( b: Boolean);
792 begin
793 if b
794 then WriteJSONInteger( 1)
795 else WriteJSONInteger( 0);
796 end;
797
798 procedure TJSONProtocolImpl.WriteByte( b: ShortInt);
799 begin
800 WriteJSONInteger( b);
801 end;
802
803 procedure TJSONProtocolImpl.WriteI16( i16: SmallInt);
804 begin
805 WriteJSONInteger( i16);
806 end;
807
808 procedure TJSONProtocolImpl.WriteI32( i32: Integer);
809 begin
810 WriteJSONInteger( i32);
811 end;
812
813 procedure TJSONProtocolImpl.WriteI64( const i64: Int64);
814 begin
815 WriteJSONInteger(i64);
816 end;
817
818 procedure TJSONProtocolImpl.WriteDouble( const d: Double);
819 begin
820 WriteJSONDouble( d);
821 end;
822
823 procedure TJSONProtocolImpl.WriteString( const s: string );
824 begin
825 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( s));
826 end;
827
828 procedure TJSONProtocolImpl.WriteBinary( const b: TBytes);
829 begin
830 WriteJSONBase64( b);
831 end;
832
833
ReadJSONStringnull834 function TJSONProtocolImpl.ReadJSONString( skipContext : Boolean) : TBytes;
835 var buffer : TMemoryStream;
836 ch : Byte;
837 wch : Word;
838 highSurogate: Char;
839 surrogatePairs: Array[0..1] of Char;
840 off : Integer;
841 tmp : TBytes;
842 begin
843 highSurogate := #0;
844 buffer := TMemoryStream.Create;
845 try
846 if not skipContext
847 then FContext.Read;
848
849 ReadJSONSyntaxChar( QUOTE[0]);
850
851 while TRUE do begin
852 ch := FReader.Read;
853
854 if (ch = QUOTE[0])
855 then Break;
856
857 // check for escapes
858 if (ch <> ESCSEQ[0]) then begin
859 buffer.Write( ch, 1);
860 Continue;
861 end;
862
863 // distuinguish between \uNNNN and \?
864 ch := FReader.Read;
865 if (ch <> ESCSEQ[1])
866 then begin
867 off := Pos( Char(ch), ESCAPE_CHARS);
868 if off < 1
869 then raise TProtocolExceptionInvalidData.Create('Expected control char');
870 ch := Byte( ESCAPE_CHAR_VALS[off]);
871 buffer.Write( ch, 1);
872 Continue;
873 end;
874
875 // it is \uXXXX
876 SetLength( tmp, 4);
877 Transport.ReadAll( tmp, 0, 4);
878 wch := (HexVal(tmp[0]) shl 12)
879 + (HexVal(tmp[1]) shl 8)
880 + (HexVal(tmp[2]) shl 4)
881 + HexVal(tmp[3]);
882
883 // we need to make UTF8 bytes from it, to be decoded later
884 if CharUtils.IsHighSurrogate(char(wch)) then begin
885 if highSurogate <> #0
886 then raise TProtocolExceptionInvalidData.Create('Expected low surrogate char');
887 highSurogate := char(wch);
888 end
889 else if CharUtils.IsLowSurrogate(char(wch)) then begin
890 if highSurogate = #0
891 then TProtocolExceptionInvalidData.Create('Expected high surrogate char');
892 surrogatePairs[0] := highSurogate;
893 surrogatePairs[1] := char(wch);
894 tmp := TEncoding.UTF8.GetBytes(surrogatePairs);
895 buffer.Write( tmp[0], Length(tmp));
896 highSurogate := #0;
897 end
898 else begin
899 tmp := SysUtils.TEncoding.UTF8.GetBytes(Char(wch));
900 buffer.Write( tmp[0], Length(tmp));
901 end;
902 end;
903
904 if highSurogate <> #0
905 then raise TProtocolExceptionInvalidData.Create('Expected low surrogate char');
906
907 SetLength( result, buffer.Size);
908 if buffer.Size > 0 then Move( buffer.Memory^, result[0], Length(result));
909
910 finally
911 buffer.Free;
912 end;
913 end;
914
915
IsJSONNumericnull916 function TJSONProtocolImpl.IsJSONNumeric( b : Byte) : Boolean;
917 const NUMCHARS = ['+','-','.','0','1','2','3','4','5','6','7','8','9','E','e'];
918 begin
919 result := CharInSet( Char(b), NUMCHARS);
920 end;
921
922
ReadJSONNumericCharsnull923 function TJSONProtocolImpl.ReadJSONNumericChars : string;
924 var strbld : TThriftStringBuilder;
925 ch : Byte;
926 begin
927 strbld := TThriftStringBuilder.Create;
928 try
929 while TRUE do begin
930 ch := FReader.Peek;
931 if IsJSONNumeric(ch)
932 then strbld.Append( Char(FReader.Read))
933 else Break;
934 end;
935 result := strbld.ToString;
936
937 finally
938 strbld.Free;
939 end;
940 end;
941
942
ReadJSONIntegernull943 function TJSONProtocolImpl.ReadJSONInteger : Int64;
944 var str : string;
945 begin
946 FContext.Read;
947 if FContext.EscapeNumbers
948 then ReadJSONSyntaxChar( QUOTE[0]);
949
950 str := ReadJSONNumericChars;
951
952 if FContext.EscapeNumbers
953 then ReadJSONSyntaxChar( QUOTE[0]);
954
955 try
956 result := StrToInt64(str);
957 except
958 on e:Exception do begin
959 raise TProtocolExceptionInvalidData.Create('Bad data encounted in numeric data ('+str+') ('+e.Message+')');
960 end;
961 end;
962 end;
963
964
ReadJSONDoublenull965 function TJSONProtocolImpl.ReadJSONDouble : Double;
966 var dub : Double;
967 str : string;
968 begin
969 FContext.Read;
970
971 if FReader.Peek = QUOTE[0]
972 then begin
973 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( TRUE));
974 dub := StrToFloat( str, INVARIANT_CULTURE);
975
976 if not FContext.EscapeNumbers()
977 and not Math.IsNaN(dub)
978 and not Math.IsInfinite(dub)
979 then begin
980 // Throw exception -- we should not be in a string in Self case
981 raise TProtocolExceptionInvalidData.Create('Numeric data unexpectedly quoted');
982 end;
983 result := dub;
984 Exit;
985 end;
986
987 // will throw - we should have had a quote if escapeNum == true
988 if FContext.EscapeNumbers
989 then ReadJSONSyntaxChar( QUOTE[0]);
990
991 try
992 str := ReadJSONNumericChars;
993 result := StrToFloat( str, INVARIANT_CULTURE);
994 except
995 on e:Exception
996 do raise TProtocolExceptionInvalidData.Create('Bad data encounted in numeric data ('+str+') ('+e.Message+')');
997 end;
998 end;
999
1000
ReadJSONBase64null1001 function TJSONProtocolImpl.ReadJSONBase64 : TBytes;
1002 var b : TBytes;
1003 len, off, size : Integer;
1004 begin
1005 b := ReadJSONString(false);
1006
1007 len := Length(b);
1008 off := 0;
1009 size := 0;
1010
1011 // reduce len to ignore fill bytes
1012 Dec(len);
1013 while (len >= 0) and (b[len] = Byte('=')) do Dec(len);
1014 Inc(len);
1015
1016 // read & decode full byte triplets = 4 source bytes
1017 while (len >= 4) do begin
1018 // Decode 4 bytes at a time
1019 Inc( size, Base64Utils.Decode( b, off, 4, b, size)); // decoded in place
1020 Inc( off, 4);
1021 Dec( len, 4);
1022 end;
1023
1024 // Don't decode if we hit the end or got a single leftover byte (invalid
1025 // base64 but legal for skip of regular string type)
1026 if len > 1 then begin
1027 // Decode remainder
1028 Inc( size, Base64Utils.Decode( b, off, len, b, size)); // decoded in place
1029 end;
1030
1031 // resize to final size and return the data
1032 SetLength( b, size);
1033 result := b;
1034 end;
1035
1036
1037 procedure TJSONProtocolImpl.ReadJSONObjectStart;
1038 begin
1039 FContext.Read;
1040 ReadJSONSyntaxChar( LBRACE[0]);
1041 PushContext( TJSONPairContext.Create( Self));
1042 end;
1043
1044
1045 procedure TJSONProtocolImpl.ReadJSONObjectEnd;
1046 begin
1047 ReadJSONSyntaxChar( RBRACE[0]);
1048 PopContext;
1049 end;
1050
1051
1052 procedure TJSONProtocolImpl.ReadJSONArrayStart;
1053 begin
1054 FContext.Read;
1055 ReadJSONSyntaxChar( LBRACKET[0]);
1056 PushContext( TJSONListContext.Create( Self));
1057 end;
1058
1059
1060 procedure TJSONProtocolImpl.ReadJSONArrayEnd;
1061 begin
1062 ReadJSONSyntaxChar( RBRACKET[0]);
1063 PopContext;
1064 end;
1065
1066
TJSONProtocolImpl.ReadMessageBeginnull1067 function TJSONProtocolImpl.ReadMessageBegin: TThriftMessage;
1068 begin
1069 Reset;
1070 ResetContextStack; // THRIFT-1473
1071
1072 Init( result);
1073 ReadJSONArrayStart;
1074
1075 if ReadJSONInteger <> VERSION
1076 then raise TProtocolExceptionBadVersion.Create('Message contained bad version.');
1077
1078 result.Name := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1079 result.Type_ := TMessageType( ReadJSONInteger);
1080 result.SeqID := ReadJSONInteger;
1081 end;
1082
1083
1084 procedure TJSONProtocolImpl.ReadMessageEnd;
1085 begin
1086 ReadJSONArrayEnd;
1087 end;
1088
1089
ReadStructBeginnull1090 function TJSONProtocolImpl.ReadStructBegin : TThriftStruct ;
1091 begin
1092 ReadJSONObjectStart;
1093 Init( result);
1094 end;
1095
1096
1097 procedure TJSONProtocolImpl.ReadStructEnd;
1098 begin
1099 ReadJSONObjectEnd;
1100 end;
1101
1102
ReadFieldBeginnull1103 function TJSONProtocolImpl.ReadFieldBegin : TThriftField;
1104 var ch : Byte;
1105 str : string;
1106 begin
1107 Init( result);
1108 ch := FReader.Peek;
1109 if ch = RBRACE[0]
1110 then result.Type_ := TType.Stop
1111 else begin
1112 result.ID := ReadJSONInteger;
1113 ReadJSONObjectStart;
1114
1115 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1116 result.Type_ := GetTypeIDForTypeName( str);
1117 end;
1118 end;
1119
1120
1121 procedure TJSONProtocolImpl.ReadFieldEnd;
1122 begin
1123 ReadJSONObjectEnd;
1124 end;
1125
1126
ReadMapBeginnull1127 function TJSONProtocolImpl.ReadMapBegin : TThriftMap;
1128 var str : string;
1129 begin
1130 Init( result);
1131 ReadJSONArrayStart;
1132
1133 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1134 result.KeyType := GetTypeIDForTypeName( str);
1135
1136 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1137 result.ValueType := GetTypeIDForTypeName( str);
1138
1139 result.Count := ReadJSONInteger;
1140 CheckReadBytesAvailable(result);
1141
1142 ReadJSONObjectStart;
1143 end;
1144
1145
1146 procedure TJSONProtocolImpl.ReadMapEnd;
1147 begin
1148 ReadJSONObjectEnd;
1149 ReadJSONArrayEnd;
1150 end;
1151
1152
ReadListBeginnull1153 function TJSONProtocolImpl.ReadListBegin : TThriftList;
1154 var str : string;
1155 begin
1156 Init( result);
1157 ReadJSONArrayStart;
1158
1159 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1160 result.ElementType := GetTypeIDForTypeName( str);
1161 result.Count := ReadJSONInteger;
1162 CheckReadBytesAvailable(result);
1163 end;
1164
1165
1166 procedure TJSONProtocolImpl.ReadListEnd;
1167 begin
1168 ReadJSONArrayEnd;
1169 end;
1170
1171
ReadSetBeginnull1172 function TJSONProtocolImpl.ReadSetBegin : TThriftSet;
1173 var str : string;
1174 begin
1175 Init( result);
1176 ReadJSONArrayStart;
1177
1178 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1179 result.ElementType := GetTypeIDForTypeName( str);
1180 result.Count := ReadJSONInteger;
1181 CheckReadBytesAvailable(result);
1182 end;
1183
1184
1185 procedure TJSONProtocolImpl.ReadSetEnd;
1186 begin
1187 ReadJSONArrayEnd;
1188 end;
1189
1190
ReadBoolnull1191 function TJSONProtocolImpl.ReadBool : Boolean;
1192 begin
1193 result := (ReadJSONInteger <> 0);
1194 end;
1195
1196
ReadBytenull1197 function TJSONProtocolImpl.ReadByte : ShortInt;
1198 begin
1199 result := ReadJSONInteger;
1200 end;
1201
1202
ReadI16null1203 function TJSONProtocolImpl.ReadI16 : SmallInt;
1204 begin
1205 result := ReadJSONInteger;
1206 end;
1207
1208
TJSONProtocolImpl.ReadI32null1209 function TJSONProtocolImpl.ReadI32 : LongInt;
1210 begin
1211 result := ReadJSONInteger;
1212 end;
1213
1214
TJSONProtocolImpl.ReadI64null1215 function TJSONProtocolImpl.ReadI64 : Int64;
1216 begin
1217 result := ReadJSONInteger;
1218 end;
1219
1220
ReadDoublenull1221 function TJSONProtocolImpl.ReadDouble : Double;
1222 begin
1223 result := ReadJSONDouble;
1224 end;
1225
1226
ReadStringnull1227 function TJSONProtocolImpl.ReadString : string;
1228 begin
1229 result := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1230 end;
1231
1232
ReadBinarynull1233 function TJSONProtocolImpl.ReadBinary : TBytes;
1234 begin
1235 result := ReadJSONBase64;
1236 end;
1237
1238
TJSONProtocolImpl.GetMinSerializedSizenull1239 function TJSONProtocolImpl.GetMinSerializedSize( const aType : TType) : Integer;
1240 // Return the minimum number of bytes a type will consume on the wire
1241 begin
1242 case aType of
1243 TType.Stop: result := 0;
1244 TType.Void: result := 0;
1245 TType.Bool_: result := 1;
1246 TType.Byte_: result := 1;
1247 TType.Double_: result := 1;
1248 TType.I16: result := 1;
1249 TType.I32: result := 1;
1250 TType.I64: result := 1;
1251 TType.String_: result := 2; // empty string
1252 TType.Struct: result := 2; // empty struct
1253 TType.Map: result := 2; // empty map
1254 TType.Set_: result := 2; // empty set
1255 TType.List: result := 2; // empty list
1256 else
1257 raise TTransportExceptionBadArgs.Create('Unhandled type code');
1258 end;
1259 end;
1260
1261
1262
1263 //--- init code ---
1264
1265 procedure InitBytes( var b : TBytes; aData : array of Byte);
1266 begin
1267 SetLength( b, Length(aData));
1268 Move( aData, b[0], Length(b));
1269 end;
1270
1271 initialization
1272 InitBytes( COMMA, [Byte(',')]);
1273 InitBytes( COLON, [Byte(':')]);
1274 InitBytes( LBRACE, [Byte('{')]);
1275 InitBytes( RBRACE, [Byte('}')]);
1276 InitBytes( LBRACKET, [Byte('[')]);
1277 InitBytes( RBRACKET, [Byte(']')]);
1278 InitBytes( QUOTE, [Byte('"')]);
1279 InitBytes( BACKSLASH, [Byte('\')]);
1280 InitBytes( ESCSEQ, [Byte('\'),Byte('u'),Byte('0'),Byte('0')]);
1281 end.
1282