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