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