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