blob: 9ec3871e1ab6fda19e93a8e56aca05f6d1a93826 [file] [log] [blame]
Jake Farrell27274222011-11-10 20:32:44 +00001(*
2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20{$SCOPEDENUMS ON}
21
22unit Thrift.Protocol.JSON;
23
24interface
25
26uses
27 Classes,
28 SysUtils,
29 Math,
Jake Farrell27274222011-11-10 20:32:44 +000030 Generics.Collections,
31 Thrift.Transport,
Jens Geyerd8bddbc2014-12-14 00:41:33 +010032 Thrift.Protocol,
33 Thrift.Utils;
Jake Farrell27274222011-11-10 20:32:44 +000034
35type
36 IJSONProtocol = interface( IProtocol)
37 ['{F0DAFDBD-692A-4B71-9736-F5D485A2178F}']
38 // Read a byte that must match b; otherwise an exception is thrown.
39 procedure ReadJSONSyntaxChar( b : Byte);
40 end;
41
42 // JSON protocol implementation for thrift.
43 // This is a full-featured protocol supporting Write and Read.
44 // Please see the C++ class header for a detailed description of the protocol's wire format.
45 // Adapted from the C# version.
46 TJSONProtocolImpl = class( TProtocolImpl, IJSONProtocol)
47 public
48 type
49 TFactory = class( TInterfacedObject, IProtocolFactory)
50 public
Roger Meier333bbf32012-01-08 21:51:08 +000051 function GetProtocol( const trans: ITransport): IProtocol;
Jake Farrell27274222011-11-10 20:32:44 +000052 end;
53
54 private
55 class function GetTypeNameForTypeID(typeID : TType) : string;
56 class function GetTypeIDForTypeName( const name : string) : TType;
57
58 protected
59 type
60 // Base class for tracking JSON contexts that may require
61 // inserting/Reading additional JSON syntax characters.
62 // This base context does nothing.
63 TJSONBaseContext = class
64 protected
Roger Meierfebe8452012-06-06 10:32:24 +000065 FProto : Pointer; // weak IJSONProtocol;
Jake Farrell27274222011-11-10 20:32:44 +000066 public
67 constructor Create( const aProto : IJSONProtocol);
68 procedure Write; virtual;
69 procedure Read; virtual;
70 function EscapeNumbers : Boolean; virtual;
71 end;
72
73 // Context for JSON lists.
74 // Will insert/Read commas before each item except for the first one.
75 TJSONListContext = class( TJSONBaseContext)
76 private
77 FFirst : Boolean;
78 public
79 constructor Create( const aProto : IJSONProtocol);
80 procedure Write; override;
81 procedure Read; override;
82 end;
83
84 // Context for JSON records. Will insert/Read colons before the value portion of each record
85 // pair, and commas before each key except the first. In addition, will indicate that numbers
86 // in the key position need to be escaped in quotes (since JSON keys must be strings).
87 TJSONPairContext = class( TJSONBaseContext)
88 private
89 FFirst, FColon : Boolean;
90 public
91 constructor Create( const aProto : IJSONProtocol);
92 procedure Write; override;
93 procedure Read; override;
94 function EscapeNumbers : Boolean; override;
95 end;
96
97 // Holds up to one byte from the transport
98 TLookaheadReader = class
99 protected
Roger Meierfebe8452012-06-06 10:32:24 +0000100 FProto : Pointer; // weak IJSONProtocol;
Jake Farrell27274222011-11-10 20:32:44 +0000101 constructor Create( const aProto : IJSONProtocol);
102
103 private
104 FHasData : Boolean;
105 FData : TBytes;
106
107 public
108 // Return and consume the next byte to be Read, either taking it from the
109 // data buffer if present or getting it from the transport otherwise.
110 function Read : Byte;
111
112 // Return the next byte to be Read without consuming, filling the data
113 // buffer if it has not been filled alReady.
114 function Peek : Byte;
115 end;
116
117 protected
118 // Stack of nested contexts that we may be in
119 FContextStack : TStack<TJSONBaseContext>;
120
121 // Current context that we are in
122 FContext : TJSONBaseContext;
123
124 // Reader that manages a 1-byte buffer
125 FReader : TLookaheadReader;
126
127 // Push/pop a new JSON context onto/from the stack.
Roger Meier45a37262012-01-08 21:44:44 +0000128 procedure ResetContextStack;
Roger Meier333bbf32012-01-08 21:51:08 +0000129 procedure PushContext( const aCtx : TJSONBaseContext);
Jake Farrell27274222011-11-10 20:32:44 +0000130 procedure PopContext;
131
132 public
133 // TJSONProtocolImpl Constructor
Roger Meier333bbf32012-01-08 21:51:08 +0000134 constructor Create( const aTrans : ITransport);
Jake Farrell27274222011-11-10 20:32:44 +0000135 destructor Destroy; override;
136
137 protected
138 // IJSONProtocol
139 // Read a byte that must match b; otherwise an exception is thrown.
140 procedure ReadJSONSyntaxChar( b : Byte);
141
142 private
143 // Convert a byte containing a hex char ('0'-'9' or 'a'-'f') into its corresponding hex value
144 class function HexVal( ch : Byte) : Byte;
145
146 // Convert a byte containing a hex value to its corresponding hex character
147 class function HexChar( val : Byte) : Byte;
148
149 // Write the bytes in array buf as a JSON characters, escaping as needed
150 procedure WriteJSONString( const b : TBytes); overload;
Roger Meier333bbf32012-01-08 21:51:08 +0000151 procedure WriteJSONString( const str : string); overload;
Jake Farrell27274222011-11-10 20:32:44 +0000152
153 // Write out number as a JSON value. If the context dictates so, it will be
154 // wrapped in quotes to output as a JSON string.
Roger Meier333bbf32012-01-08 21:51:08 +0000155 procedure WriteJSONInteger( const num : Int64);
Jake Farrell27274222011-11-10 20:32:44 +0000156
157 // Write out a double as a JSON value. If it is NaN or infinity or if the
158 // context dictates escaping, Write out as JSON string.
159 procedure WriteJSONDouble( const num : Double);
160
161 // Write out contents of byte array b as a JSON string with base-64 encoded data
162 procedure WriteJSONBase64( const b : TBytes);
163
164 procedure WriteJSONObjectStart;
165 procedure WriteJSONObjectEnd;
166 procedure WriteJSONArrayStart;
167 procedure WriteJSONArrayEnd;
168
169 public
170 // IProtocol
Roger Meier333bbf32012-01-08 21:51:08 +0000171 procedure WriteMessageBegin( const aMsg : IMessage); override;
Jake Farrell27274222011-11-10 20:32:44 +0000172 procedure WriteMessageEnd; override;
Roger Meier333bbf32012-01-08 21:51:08 +0000173 procedure WriteStructBegin( const struc: IStruct); override;
Jake Farrell27274222011-11-10 20:32:44 +0000174 procedure WriteStructEnd; override;
Roger Meier333bbf32012-01-08 21:51:08 +0000175 procedure WriteFieldBegin( const field: IField); override;
Jake Farrell27274222011-11-10 20:32:44 +0000176 procedure WriteFieldEnd; override;
177 procedure WriteFieldStop; override;
Roger Meier333bbf32012-01-08 21:51:08 +0000178 procedure WriteMapBegin( const map: IMap); override;
Jake Farrell27274222011-11-10 20:32:44 +0000179 procedure WriteMapEnd; override;
Roger Meier333bbf32012-01-08 21:51:08 +0000180 procedure WriteListBegin( const list: IList); override;
Jake Farrell27274222011-11-10 20:32:44 +0000181 procedure WriteListEnd(); override;
Roger Meier333bbf32012-01-08 21:51:08 +0000182 procedure WriteSetBegin( const set_: ISet ); override;
Jake Farrell27274222011-11-10 20:32:44 +0000183 procedure WriteSetEnd(); override;
184 procedure WriteBool( b: Boolean); override;
185 procedure WriteByte( b: ShortInt); override;
186 procedure WriteI16( i16: SmallInt); override;
187 procedure WriteI32( i32: Integer); override;
Roger Meier333bbf32012-01-08 21:51:08 +0000188 procedure WriteI64( const i64: Int64); override;
189 procedure WriteDouble( const d: Double); override;
Jake Farrell27274222011-11-10 20:32:44 +0000190 procedure WriteString( const s: string ); override;
191 procedure WriteBinary( const b: TBytes); override;
192 //
193 function ReadMessageBegin: IMessage; override;
194 procedure ReadMessageEnd(); override;
195 function ReadStructBegin: IStruct; override;
196 procedure ReadStructEnd; override;
197 function ReadFieldBegin: IField; override;
198 procedure ReadFieldEnd(); override;
199 function ReadMapBegin: IMap; override;
200 procedure ReadMapEnd(); override;
201 function ReadListBegin: IList; override;
202 procedure ReadListEnd(); override;
203 function ReadSetBegin: ISet; override;
204 procedure ReadSetEnd(); override;
205 function ReadBool: Boolean; override;
206 function ReadByte: ShortInt; override;
207 function ReadI16: SmallInt; override;
208 function ReadI32: Integer; override;
209 function ReadI64: Int64; override;
210 function ReadDouble:Double; override;
211 function ReadString : string; override;
212 function ReadBinary: TBytes; override;
213
214
215 private
216 // Reading methods.
217
218 // Read in a JSON string, unescaping as appropriate.
219 // Skip Reading from the context if skipContext is true.
220 function ReadJSONString( skipContext : Boolean) : TBytes;
221
222 // Return true if the given byte could be a valid part of a JSON number.
223 function IsJSONNumeric( b : Byte) : Boolean;
224
225 // Read in a sequence of characters that are all valid in JSON numbers. Does
226 // not do a complete regex check to validate that this is actually a number.
227 function ReadJSONNumericChars : String;
228
229 // Read in a JSON number. If the context dictates, Read in enclosing quotes.
230 function ReadJSONInteger : Int64;
231
232 // Read in a JSON double value. Throw if the value is not wrapped in quotes
233 // when expected or if wrapped in quotes when not expected.
234 function ReadJSONDouble : Double;
235
236 // Read in a JSON string containing base-64 encoded data and decode it.
237 function ReadJSONBase64 : TBytes;
238
239 procedure ReadJSONObjectStart;
240 procedure ReadJSONObjectEnd;
241 procedure ReadJSONArrayStart;
242 procedure ReadJSONArrayEnd;
243 end;
244
245
246implementation
247
248var
249 COMMA : TBytes;
250 COLON : TBytes;
251 LBRACE : TBytes;
252 RBRACE : TBytes;
253 LBRACKET : TBytes;
254 RBRACKET : TBytes;
255 QUOTE : TBytes;
256 BACKSLASH : TBytes;
Jake Farrell27274222011-11-10 20:32:44 +0000257 ESCSEQ : TBytes;
258
259const
260 VERSION = 1;
261 JSON_CHAR_TABLE : array[0..$2F] of Byte
262 = (0,0,0,0, 0,0,0,0, Byte('b'),Byte('t'),Byte('n'),0, Byte('f'),Byte('r'),0,0,
263 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,
264 1,1,Byte('"'),1, 1,1,1,1, 1,1,1,1, 1,1,1,1);
265
Jens Geyer21366942013-12-30 22:04:51 +0100266 ESCAPE_CHARS = '"\/btnfr';
267 ESCAPE_CHAR_VALS = '"\/'#8#9#10#12#13;
Jake Farrell27274222011-11-10 20:32:44 +0000268
269 DEF_STRING_SIZE = 16;
270
271 NAME_BOOL = 'tf';
272 NAME_BYTE = 'i8';
273 NAME_I16 = 'i16';
274 NAME_I32 = 'i32';
275 NAME_I64 = 'i64';
276 NAME_DOUBLE = 'dbl';
277 NAME_STRUCT = 'rec';
278 NAME_STRING = 'str';
279 NAME_MAP = 'map';
280 NAME_LIST = 'lst';
281 NAME_SET = 'set';
282
283 INVARIANT_CULTURE : TFormatSettings
284 = ( ThousandSeparator: ',';
285 DecimalSeparator: '.');
286
287
288
289//--- TJSONProtocolImpl ----------------------
290
291
Roger Meier333bbf32012-01-08 21:51:08 +0000292function TJSONProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
Jake Farrell27274222011-11-10 20:32:44 +0000293begin
294 result := TJSONProtocolImpl.Create(trans);
295end;
296
297class function TJSONProtocolImpl.GetTypeNameForTypeID(typeID : TType) : string;
298begin
299 case typeID of
300 TType.Bool_: result := NAME_BOOL;
301 TType.Byte_: result := NAME_BYTE;
302 TType.I16: result := NAME_I16;
303 TType.I32: result := NAME_I32;
304 TType.I64: result := NAME_I64;
305 TType.Double_: result := NAME_DOUBLE;
306 TType.String_: result := NAME_STRING;
307 TType.Struct: result := NAME_STRUCT;
308 TType.Map: result := NAME_MAP;
309 TType.Set_: result := NAME_SET;
310 TType.List: result := NAME_LIST;
311 else
312 raise TProtocolException.Create( TProtocolException.NOT_IMPLEMENTED, 'Unrecognized type ('+IntToStr(Ord(typeID))+')');
313 end;
314end;
315
316
317class function TJSONProtocolImpl.GetTypeIDForTypeName( const name : string) : TType;
318begin
319 if name = NAME_BOOL then result := TType.Bool_
320 else if name = NAME_BYTE then result := TType.Byte_
321 else if name = NAME_I16 then result := TType.I16
322 else if name = NAME_I32 then result := TType.I32
323 else if name = NAME_I64 then result := TType.I64
324 else if name = NAME_DOUBLE then result := TType.Double_
325 else if name = NAME_STRUCT then result := TType.Struct
326 else if name = NAME_STRING then result := TType.String_
327 else if name = NAME_MAP then result := TType.Map
328 else if name = NAME_LIST then result := TType.List
329 else if name = NAME_SET then result := TType.Set_
330 else raise TProtocolException.Create( TProtocolException.NOT_IMPLEMENTED, 'Unrecognized type ('+name+')');
331end;
332
333
334constructor TJSONProtocolImpl.TJSONBaseContext.Create( const aProto : IJSONProtocol);
335begin
336 inherited Create;
Roger Meierfebe8452012-06-06 10:32:24 +0000337 FProto := Pointer(aProto);
Jake Farrell27274222011-11-10 20:32:44 +0000338end;
339
340
341procedure TJSONProtocolImpl.TJSONBaseContext.Write;
342begin
343 // nothing
344end;
345
346
347procedure TJSONProtocolImpl.TJSONBaseContext.Read;
348begin
349 // nothing
350end;
351
352
353function TJSONProtocolImpl.TJSONBaseContext.EscapeNumbers : Boolean;
354begin
355 result := FALSE;
356end;
357
358
359constructor TJSONProtocolImpl.TJSONListContext.Create( const aProto : IJSONProtocol);
360begin
361 inherited Create( aProto);
362 FFirst := TRUE;
363end;
364
365
366procedure TJSONProtocolImpl.TJSONListContext.Write;
367begin
368 if FFirst
369 then FFirst := FALSE
Roger Meierfebe8452012-06-06 10:32:24 +0000370 else IJSONProtocol(FProto).Transport.Write( COMMA);
Jake Farrell27274222011-11-10 20:32:44 +0000371end;
372
373
374procedure TJSONProtocolImpl.TJSONListContext.Read;
375begin
376 if FFirst
377 then FFirst := FALSE
Roger Meierfebe8452012-06-06 10:32:24 +0000378 else IJSONProtocol(FProto).ReadJSONSyntaxChar( COMMA[0]);
Jake Farrell27274222011-11-10 20:32:44 +0000379end;
380
381
382constructor TJSONProtocolImpl.TJSONPairContext.Create( const aProto : IJSONProtocol);
383begin
384 inherited Create( aProto);
385 FFirst := TRUE;
386 FColon := TRUE;
387end;
388
389
390procedure TJSONProtocolImpl.TJSONPairContext.Write;
391begin
392 if FFirst then begin
393 FFirst := FALSE;
394 FColon := TRUE;
395 end
396 else begin
397 if FColon
Roger Meierfebe8452012-06-06 10:32:24 +0000398 then IJSONProtocol(FProto).Transport.Write( COLON)
399 else IJSONProtocol(FProto).Transport.Write( COMMA);
Jake Farrell27274222011-11-10 20:32:44 +0000400 FColon := not FColon;
401 end;
402end;
403
404
405procedure TJSONProtocolImpl.TJSONPairContext.Read;
406begin
407 if FFirst then begin
408 FFirst := FALSE;
409 FColon := TRUE;
410 end
411 else begin
412 if FColon
Roger Meierfebe8452012-06-06 10:32:24 +0000413 then IJSONProtocol(FProto).ReadJSONSyntaxChar( COLON[0])
414 else IJSONProtocol(FProto).ReadJSONSyntaxChar( COMMA[0]);
Jake Farrell27274222011-11-10 20:32:44 +0000415 FColon := not FColon;
416 end;
417end;
418
419
420function TJSONProtocolImpl.TJSONPairContext.EscapeNumbers : Boolean;
421begin
422 result := FColon;
423end;
424
425
426constructor TJSONProtocolImpl.TLookaheadReader.Create( const aProto : IJSONProtocol);
427begin
428 inherited Create;
Roger Meierfebe8452012-06-06 10:32:24 +0000429 FProto := Pointer(aProto);
Jake Farrell27274222011-11-10 20:32:44 +0000430 FHasData := FALSE;
431end;
432
433
434function TJSONProtocolImpl.TLookaheadReader.Read : Byte;
435begin
436 if FHasData
437 then FHasData := FALSE
438 else begin
439 SetLength( FData, 1);
Roger Meierfebe8452012-06-06 10:32:24 +0000440 IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
Jake Farrell27274222011-11-10 20:32:44 +0000441 end;
442 result := FData[0];
443end;
444
445
446function TJSONProtocolImpl.TLookaheadReader.Peek : Byte;
447begin
448 if not FHasData then begin
449 SetLength( FData, 1);
Roger Meierfebe8452012-06-06 10:32:24 +0000450 IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
Jake Farrell27274222011-11-10 20:32:44 +0000451 FHasData := TRUE;
452 end;
453 result := FData[0];
454end;
455
456
Roger Meier333bbf32012-01-08 21:51:08 +0000457constructor TJSONProtocolImpl.Create( const aTrans : ITransport);
Jake Farrell27274222011-11-10 20:32:44 +0000458begin
459 inherited Create( aTrans);
460
461 // Stack of nested contexts that we may be in
462 FContextStack := TStack<TJSONBaseContext>.Create;
463
464 FContext := TJSONBaseContext.Create( Self);
465 FReader := TLookaheadReader.Create( Self);
466end;
467
468
469destructor TJSONProtocolImpl.Destroy;
470begin
471 try
Roger Meier45a37262012-01-08 21:44:44 +0000472 ResetContextStack; // free any contents
Jake Farrell27274222011-11-10 20:32:44 +0000473 FreeAndNil( FReader);
474 FreeAndNil( FContext);
475 FreeAndNil( FContextStack);
476 finally
477 inherited Destroy;
478 end;
479end;
480
481
Roger Meier45a37262012-01-08 21:44:44 +0000482procedure TJSONProtocolImpl.ResetContextStack;
483begin
484 while FContextStack.Count > 0
485 do PopContext;
486end;
487
488
Roger Meier333bbf32012-01-08 21:51:08 +0000489procedure TJSONProtocolImpl.PushContext( const aCtx : TJSONBaseContext);
Roger Meier45a37262012-01-08 21:44:44 +0000490begin
491 FContextStack.Push( FContext);
492 FContext := aCtx;
493end;
494
495
496procedure TJSONProtocolImpl.PopContext;
497begin
498 FreeAndNil(FContext);
499 FContext := FContextStack.Pop;
500end;
501
502
Jake Farrell27274222011-11-10 20:32:44 +0000503procedure TJSONProtocolImpl.ReadJSONSyntaxChar( b : Byte);
504var ch : Byte;
505begin
506 ch := FReader.Read;
507 if (ch <> b)
508 then raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Unexpected character ('+Char(ch)+')');
509end;
510
511
512class function TJSONProtocolImpl.HexVal( ch : Byte) : Byte;
513var i : Integer;
514begin
515 i := StrToIntDef( '$0'+Char(ch), -1);
516 if (0 <= i) and (i < $10)
517 then result := i
518 else raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Expected hex character ('+Char(ch)+')');
519end;
520
521
522class function TJSONProtocolImpl.HexChar( val : Byte) : Byte;
523const HEXCHARS = '0123456789ABCDEF';
524begin
525 result := Byte( PChar(HEXCHARS)[val and $0F]);
526 ASSERT( Pos( Char(result), HEXCHARS) > 0);
527end;
528
529
Roger Meier333bbf32012-01-08 21:51:08 +0000530procedure TJSONProtocolImpl.WriteJSONString( const str : string);
Jake Farrell27274222011-11-10 20:32:44 +0000531begin
532 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( str));
533end;
534
535
536procedure TJSONProtocolImpl.WriteJSONString( const b : TBytes);
537var i : Integer;
538 tmp : TBytes;
539begin
540 FContext.Write;
541 Transport.Write( QUOTE);
542 for i := 0 to Length(b)-1 do begin
543
544 if (b[i] and $00FF) >= $30 then begin
545
546 if (b[i] = BACKSLASH[0]) then begin
547 Transport.Write( BACKSLASH);
548 Transport.Write( BACKSLASH);
549 end
550 else begin
551 Transport.Write( b, i, 1);
552 end;
553
554 end
555 else begin
556 SetLength( tmp, 2);
557 tmp[0] := JSON_CHAR_TABLE[b[i]];
558 if (tmp[0] = 1) then begin
559 Transport.Write( b, i, 1)
560 end
561 else if (tmp[0] > 1) then begin
562 Transport.Write( BACKSLASH);
563 Transport.Write( tmp, 0, 1);
564 end
565 else begin
566 Transport.Write( ESCSEQ);
567 tmp[0] := HexChar( b[i] div $10);
568 tmp[1] := HexChar( b[i]);
569 Transport.Write( tmp, 0, 2);
570 end;
571 end;
572 end;
573 Transport.Write( QUOTE);
574end;
575
576
Roger Meier333bbf32012-01-08 21:51:08 +0000577procedure TJSONProtocolImpl.WriteJSONInteger( const num : Int64);
Jake Farrell27274222011-11-10 20:32:44 +0000578var str : String;
579 escapeNum : Boolean;
580begin
581 FContext.Write;
582 str := IntToStr(num);
583
584 escapeNum := FContext.EscapeNumbers;
585 if escapeNum
586 then Transport.Write( QUOTE);
587
588 Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str));
589
590 if escapeNum
591 then Transport.Write( QUOTE);
592end;
593
594
595procedure TJSONProtocolImpl.WriteJSONDouble( const num : Double);
596var str : string;
597 special : Boolean;
598 escapeNum : Boolean;
599begin
600 FContext.Write;
601
602 str := FloatToStr( num, INVARIANT_CULTURE);
603 special := FALSE;
604
605 case UpCase(str[1]) of
606 'N' : special := TRUE; // NaN
607 'I' : special := TRUE; // Infinity
608 '-' : special := (UpCase(str[2]) = 'I'); // -Infinity
609 end;
610
611 escapeNum := special or FContext.EscapeNumbers;
612
613
614 if escapeNum
615 then Transport.Write( QUOTE);
616
617 Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str));
618
619 if escapeNum
620 then Transport.Write( QUOTE);
621end;
622
623
624procedure TJSONProtocolImpl.WriteJSONBase64( const b : TBytes);
Jens Geyerd8bddbc2014-12-14 00:41:33 +0100625var len, off, cnt : Integer;
626 tmpBuf : TBytes;
Jake Farrell27274222011-11-10 20:32:44 +0000627begin
628 FContext.Write;
629 Transport.Write( QUOTE);
630
Jens Geyerd8bddbc2014-12-14 00:41:33 +0100631 len := Length(b);
632 off := 0;
633 SetLength( tmpBuf, 4);
634
635 while len >= 3 do begin
636 // Encode 3 bytes at a time
637 Base64Utils.Encode( b, off, 3, tmpBuf, 0);
638 Transport.Write( tmpBuf, 0, 4);
639 Inc( off, 3);
640 Dec( len, 3);
Jake Farrell27274222011-11-10 20:32:44 +0000641 end;
Jens Geyerd8bddbc2014-12-14 00:41:33 +0100642
643 // Encode remainder, if any
644 if len > 0 then begin
645 cnt := Base64Utils.Encode( b, off, len, tmpBuf, 0);
646 Transport.Write( tmpBuf, 0, cnt);
647 end;
Jake Farrell27274222011-11-10 20:32:44 +0000648
649 Transport.Write( QUOTE);
650end;
651
652
653procedure TJSONProtocolImpl.WriteJSONObjectStart;
654begin
655 FContext.Write;
656 Transport.Write( LBRACE);
657 PushContext( TJSONPairContext.Create( Self));
658end;
659
660
661procedure TJSONProtocolImpl.WriteJSONObjectEnd;
662begin
663 PopContext;
664 Transport.Write( RBRACE);
665end;
666
667
668procedure TJSONProtocolImpl.WriteJSONArrayStart;
669begin
670 FContext.Write;
671 Transport.Write( LBRACKET);
672 PushContext( TJSONListContext.Create( Self));
673end;
674
675
676procedure TJSONProtocolImpl.WriteJSONArrayEnd;
677begin
678 PopContext;
679 Transport.Write( RBRACKET);
680end;
681
682
Roger Meier333bbf32012-01-08 21:51:08 +0000683procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : IMessage);
Jake Farrell27274222011-11-10 20:32:44 +0000684begin
Roger Meier45a37262012-01-08 21:44:44 +0000685 ResetContextStack; // THRIFT-1473
686
Jake Farrell27274222011-11-10 20:32:44 +0000687 WriteJSONArrayStart;
688 WriteJSONInteger(VERSION);
689
690 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( aMsg.Name));
691
692 WriteJSONInteger( LongInt( aMsg.Type_));
693 WriteJSONInteger( aMsg.SeqID);
694end;
695
696procedure TJSONProtocolImpl.WriteMessageEnd;
697begin
698 WriteJSONArrayEnd;
699end;
700
701
Roger Meier333bbf32012-01-08 21:51:08 +0000702procedure TJSONProtocolImpl.WriteStructBegin( const struc: IStruct);
Jake Farrell27274222011-11-10 20:32:44 +0000703begin
704 WriteJSONObjectStart;
705end;
706
707
708procedure TJSONProtocolImpl.WriteStructEnd;
709begin
710 WriteJSONObjectEnd;
711end;
712
713
Roger Meier333bbf32012-01-08 21:51:08 +0000714procedure TJSONProtocolImpl.WriteFieldBegin( const field : IField);
Jake Farrell27274222011-11-10 20:32:44 +0000715begin
716 WriteJSONInteger(field.ID);
717 WriteJSONObjectStart;
718 WriteJSONString( GetTypeNameForTypeID(field.Type_));
719end;
720
721
722procedure TJSONProtocolImpl.WriteFieldEnd;
723begin
724 WriteJSONObjectEnd;
725end;
726
727
728procedure TJSONProtocolImpl.WriteFieldStop;
729begin
730 // nothing to do
731end;
732
Roger Meier333bbf32012-01-08 21:51:08 +0000733procedure TJSONProtocolImpl.WriteMapBegin( const map: IMap);
Jake Farrell27274222011-11-10 20:32:44 +0000734begin
735 WriteJSONArrayStart;
736 WriteJSONString( GetTypeNameForTypeID( map.KeyType));
737 WriteJSONString( GetTypeNameForTypeID( map.ValueType));
738 WriteJSONInteger( map.Count);
739 WriteJSONObjectStart;
740end;
741
742
743procedure TJSONProtocolImpl.WriteMapEnd;
744begin
745 WriteJSONObjectEnd;
746 WriteJSONArrayEnd;
747end;
748
749
Roger Meier333bbf32012-01-08 21:51:08 +0000750procedure TJSONProtocolImpl.WriteListBegin( const list: IList);
Jake Farrell27274222011-11-10 20:32:44 +0000751begin
752 WriteJSONArrayStart;
753 WriteJSONString( GetTypeNameForTypeID( list.ElementType));
754 WriteJSONInteger(list.Count);
755end;
756
757
758procedure TJSONProtocolImpl.WriteListEnd;
759begin
760 WriteJSONArrayEnd;
761end;
762
763
Roger Meier333bbf32012-01-08 21:51:08 +0000764procedure TJSONProtocolImpl.WriteSetBegin( const set_: ISet);
Jake Farrell27274222011-11-10 20:32:44 +0000765begin
766 WriteJSONArrayStart;
767 WriteJSONString( GetTypeNameForTypeID( set_.ElementType));
768 WriteJSONInteger( set_.Count);
769end;
770
771
772procedure TJSONProtocolImpl.WriteSetEnd;
773begin
774 WriteJSONArrayEnd;
775end;
776
777procedure TJSONProtocolImpl.WriteBool( b: Boolean);
778begin
779 if b
780 then WriteJSONInteger( 1)
781 else WriteJSONInteger( 0);
782end;
783
784procedure TJSONProtocolImpl.WriteByte( b: ShortInt);
785begin
786 WriteJSONInteger( b);
787end;
788
789procedure TJSONProtocolImpl.WriteI16( i16: SmallInt);
790begin
791 WriteJSONInteger( i16);
792end;
793
794procedure TJSONProtocolImpl.WriteI32( i32: Integer);
795begin
796 WriteJSONInteger( i32);
797end;
798
Roger Meier333bbf32012-01-08 21:51:08 +0000799procedure TJSONProtocolImpl.WriteI64( const i64: Int64);
Jake Farrell27274222011-11-10 20:32:44 +0000800begin
801 WriteJSONInteger(i64);
802end;
803
Roger Meier333bbf32012-01-08 21:51:08 +0000804procedure TJSONProtocolImpl.WriteDouble( const d: Double);
Jake Farrell27274222011-11-10 20:32:44 +0000805begin
806 WriteJSONDouble( d);
807end;
808
809procedure TJSONProtocolImpl.WriteString( const s: string );
810begin
811 WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( s));
812end;
813
814procedure TJSONProtocolImpl.WriteBinary( const b: TBytes);
815begin
816 WriteJSONBase64( b);
817end;
818
819
820function TJSONProtocolImpl.ReadJSONString( skipContext : Boolean) : TBytes;
821var buffer : TMemoryStream;
Jens Geyer7bb44a32014-02-07 22:24:37 +0100822 ch : Byte;
823 wch : Word;
Jake Farrell27274222011-11-10 20:32:44 +0000824 off : Integer;
825 tmp : TBytes;
826begin
827 buffer := TMemoryStream.Create;
828 try
829 if not skipContext
830 then FContext.Read;
831
832 ReadJSONSyntaxChar( QUOTE[0]);
833
834 while TRUE do begin
835 ch := FReader.Read;
836
837 if (ch = QUOTE[0])
838 then Break;
839
Jens Geyer7bb44a32014-02-07 22:24:37 +0100840 // check for escapes
841 if (ch <> ESCSEQ[0]) then begin
842 buffer.Write( ch, 1);
843 Continue;
Jake Farrell27274222011-11-10 20:32:44 +0000844 end;
Jens Geyer7bb44a32014-02-07 22:24:37 +0100845
846 // distuinguish between \uNNNN and \?
847 ch := FReader.Read;
848 if (ch <> ESCSEQ[1])
849 then begin
850 off := Pos( Char(ch), ESCAPE_CHARS);
851 if off < 1
852 then raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Expected control char');
853 ch := Byte( ESCAPE_CHAR_VALS[off]);
854 buffer.Write( ch, 1);
855 Continue;
856 end;
857
858 // it is \uXXXX
859 SetLength( tmp, 4);
860 Transport.ReadAll( tmp, 0, 4);
861 wch := (HexVal(tmp[0]) shl 12)
862 + (HexVal(tmp[1]) shl 8)
863 + (HexVal(tmp[2]) shl 4)
864 + HexVal(tmp[3]);
865 // we need to make UTF8 bytes from it, to be decoded later
866 tmp := SysUtils.TEncoding.UTF8.GetBytes(Char(wch));
867 buffer.Write( tmp[0], length(tmp));
Jake Farrell27274222011-11-10 20:32:44 +0000868 end;
869
870 SetLength( result, buffer.Size);
Jake Farrella2a9ee92011-12-15 20:50:31 +0000871 if buffer.Size > 0 then Move( buffer.Memory^, result[0], Length(result));
Jake Farrell27274222011-11-10 20:32:44 +0000872
873 finally
874 buffer.Free;
875 end;
876end;
877
878
879function TJSONProtocolImpl.IsJSONNumeric( b : Byte) : Boolean;
880const NUMCHARS = ['+','-','.','0','1','2','3','4','5','6','7','8','9','E','e'];
881begin
882 result := CharInSet( Char(b), NUMCHARS);
883end;
884
885
886function TJSONProtocolImpl.ReadJSONNumericChars : string;
887var strbld : TThriftStringBuilder;
888 ch : Byte;
889begin
890 strbld := TThriftStringBuilder.Create;
891 try
892 while TRUE do begin
893 ch := FReader.Peek;
894 if IsJSONNumeric(ch)
895 then strbld.Append( Char(FReader.Read))
896 else Break;
897 end;
898 result := strbld.ToString;
899
900 finally
901 strbld.Free;
902 end;
903end;
904
905
906function TJSONProtocolImpl.ReadJSONInteger : Int64;
907var str : string;
908begin
909 FContext.Read;
910 if FContext.EscapeNumbers
911 then ReadJSONSyntaxChar( QUOTE[0]);
912
913 str := ReadJSONNumericChars;
914
915 if FContext.EscapeNumbers
916 then ReadJSONSyntaxChar( QUOTE[0]);
917
918 try
919 result := StrToInt64(str);
920 except
921 on e:Exception do begin
922 raise TProtocolException.Create( TProtocolException.INVALID_DATA,
923 'Bad data encounted in numeric data ('+str+') ('+e.Message+')');
924 end;
925 end;
926end;
927
928
929function TJSONProtocolImpl.ReadJSONDouble : Double;
930var dub : Double;
931 str : string;
932begin
933 FContext.Read;
934
935 if FReader.Peek = QUOTE[0]
936 then begin
937 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( TRUE));
938 dub := StrToFloat( str, INVARIANT_CULTURE);
939
940 if not FContext.EscapeNumbers()
941 and not Math.IsNaN(dub)
942 and not Math.IsInfinite(dub)
943 then begin
944 // Throw exception -- we should not be in a string in Self case
945 raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Numeric data unexpectedly quoted');
946 end;
947 result := dub;
948 Exit;
949 end;
950
951 // will throw - we should have had a quote if escapeNum == true
952 if FContext.EscapeNumbers
953 then ReadJSONSyntaxChar( QUOTE[0]);
954
955 try
956 str := ReadJSONNumericChars;
957 result := StrToFloat( str, INVARIANT_CULTURE);
958 except
959 on e:Exception
960 do raise TProtocolException.Create( TProtocolException.INVALID_DATA,
961 'Bad data encounted in numeric data ('+str+') ('+e.Message+')');
962 end;
963end;
964
965
966function TJSONProtocolImpl.ReadJSONBase64 : TBytes;
967var b : TBytes;
Jens Geyerd8bddbc2014-12-14 00:41:33 +0100968 len, off, size, cnt : Integer;
Jake Farrell27274222011-11-10 20:32:44 +0000969begin
970 b := ReadJSONString(false);
971
Jens Geyerd8bddbc2014-12-14 00:41:33 +0100972 len := Length(b);
973 off := 0;
974 size := 0;
975
976 // reduce len to ignore fill bytes
977 Dec(len);
978 while (len >= 0) and (b[len] = Byte('=')) do Dec(len);
979 Inc(len);
980
981 // read & decode full byte triplets = 4 source bytes
982 while (len >= 4) do begin
983 // Decode 4 bytes at a time
984 Inc( size, Base64Utils.Decode( b, off, 4, b, size)); // decoded in place
985 Inc( off, 4);
986 Dec( len, 4);
987 end;
988
989 // Don't decode if we hit the end or got a single leftover byte (invalid
990 // base64 but legal for skip of regular string type)
991 if len > 1 then begin
992 // Decode remainder
993 Inc( size, Base64Utils.Decode( b, off, len, b, size)); // decoded in place
994 end;
995
996 // resize to final size and return the data
997 SetLength( b, size);
998 result := b;
Jake Farrell27274222011-11-10 20:32:44 +0000999end;
1000
1001
1002procedure TJSONProtocolImpl.ReadJSONObjectStart;
1003begin
1004 FContext.Read;
1005 ReadJSONSyntaxChar( LBRACE[0]);
1006 PushContext( TJSONPairContext.Create( Self));
1007end;
1008
1009
1010procedure TJSONProtocolImpl.ReadJSONObjectEnd;
1011begin
1012 ReadJSONSyntaxChar( RBRACE[0]);
1013 PopContext;
1014end;
1015
1016
1017procedure TJSONProtocolImpl.ReadJSONArrayStart;
1018begin
1019 FContext.Read;
1020 ReadJSONSyntaxChar( LBRACKET[0]);
1021 PushContext( TJSONListContext.Create( Self));
1022end;
1023
1024
1025procedure TJSONProtocolImpl.ReadJSONArrayEnd;
1026begin
1027 ReadJSONSyntaxChar( RBRACKET[0]);
1028 PopContext;
1029end;
1030
1031
1032function TJSONProtocolImpl.ReadMessageBegin: IMessage;
1033begin
Roger Meier45a37262012-01-08 21:44:44 +00001034 ResetContextStack; // THRIFT-1473
1035
Jake Farrell27274222011-11-10 20:32:44 +00001036 result := TMessageImpl.Create;
1037 ReadJSONArrayStart;
1038
1039 if ReadJSONInteger <> VERSION
1040 then raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Message contained bad version.');
1041
1042 result.Name := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1043 result.Type_ := TMessageType( ReadJSONInteger);
1044 result.SeqID := ReadJSONInteger;
1045end;
1046
1047
1048procedure TJSONProtocolImpl.ReadMessageEnd;
1049begin
1050 ReadJSONArrayEnd;
1051end;
1052
1053
1054function TJSONProtocolImpl.ReadStructBegin : IStruct ;
1055begin
1056 ReadJSONObjectStart;
1057 result := TStructImpl.Create('');
1058end;
1059
1060
1061procedure TJSONProtocolImpl.ReadStructEnd;
1062begin
1063 ReadJSONObjectEnd;
1064end;
1065
1066
1067function TJSONProtocolImpl.ReadFieldBegin : IField;
1068var ch : Byte;
1069 str : string;
1070begin
1071 result := TFieldImpl.Create;
1072 ch := FReader.Peek;
1073 if ch = RBRACE[0]
1074 then result.Type_ := TType.Stop
1075 else begin
1076 result.ID := ReadJSONInteger;
1077 ReadJSONObjectStart;
1078
1079 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1080 result.Type_ := GetTypeIDForTypeName( str);
1081 end;
1082end;
1083
1084
1085procedure TJSONProtocolImpl.ReadFieldEnd;
1086begin
1087 ReadJSONObjectEnd;
1088end;
1089
1090
1091function TJSONProtocolImpl.ReadMapBegin : IMap;
1092var str : string;
1093begin
1094 result := TMapImpl.Create;
1095 ReadJSONArrayStart;
1096
1097 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1098 result.KeyType := GetTypeIDForTypeName( str);
1099
1100 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1101 result.ValueType := GetTypeIDForTypeName( str);
1102
1103 result.Count := ReadJSONInteger;
1104 ReadJSONObjectStart;
1105end;
1106
1107
1108procedure TJSONProtocolImpl.ReadMapEnd;
1109begin
1110 ReadJSONObjectEnd;
1111 ReadJSONArrayEnd;
1112end;
1113
1114
1115function TJSONProtocolImpl.ReadListBegin : IList;
1116var str : string;
1117begin
1118 result := TListImpl.Create;
1119 ReadJSONArrayStart;
1120
1121 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1122 result.ElementType := GetTypeIDForTypeName( str);
1123 result.Count := ReadJSONInteger;
1124end;
1125
1126
1127procedure TJSONProtocolImpl.ReadListEnd;
1128begin
1129 ReadJSONArrayEnd;
1130end;
1131
1132
1133function TJSONProtocolImpl.ReadSetBegin : ISet;
1134var str : string;
1135begin
1136 result := TSetImpl.Create;
1137 ReadJSONArrayStart;
1138
1139 str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
1140 result.ElementType := GetTypeIDForTypeName( str);
1141 result.Count := ReadJSONInteger;
1142end;
1143
1144
1145procedure TJSONProtocolImpl.ReadSetEnd;
1146begin
1147 ReadJSONArrayEnd;
1148end;
1149
1150
1151function TJSONProtocolImpl.ReadBool : Boolean;
1152begin
1153 result := (ReadJSONInteger <> 0);
1154end;
1155
1156
1157function TJSONProtocolImpl.ReadByte : ShortInt;
1158begin
1159 result := ReadJSONInteger;
1160end;
1161
1162
1163function TJSONProtocolImpl.ReadI16 : SmallInt;
1164begin
1165 result := ReadJSONInteger;
1166end;
1167
1168
1169function TJSONProtocolImpl.ReadI32 : LongInt;
1170begin
1171 result := ReadJSONInteger;
1172end;
1173
1174
1175function TJSONProtocolImpl.ReadI64 : Int64;
1176begin
1177 result := ReadJSONInteger;
1178end;
1179
1180
1181function TJSONProtocolImpl.ReadDouble : Double;
1182begin
1183 result := ReadJSONDouble;
1184end;
1185
1186
1187function TJSONProtocolImpl.ReadString : string;
1188begin
1189 result := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE));
1190end;
1191
1192
1193function TJSONProtocolImpl.ReadBinary : TBytes;
1194begin
1195 result := ReadJSONBase64;
1196end;
1197
1198
1199//--- init code ---
1200
1201procedure InitBytes( var b : TBytes; aData : array of Byte);
1202begin
1203 SetLength( b, Length(aData));
1204 Move( aData, b[0], Length(b));
1205end;
1206
1207initialization
1208 InitBytes( COMMA, [Byte(',')]);
1209 InitBytes( COLON, [Byte(':')]);
1210 InitBytes( LBRACE, [Byte('{')]);
1211 InitBytes( RBRACE, [Byte('}')]);
1212 InitBytes( LBRACKET, [Byte('[')]);
1213 InitBytes( RBRACKET, [Byte(']')]);
1214 InitBytes( QUOTE, [Byte('"')]);
1215 InitBytes( BACKSLASH, [Byte('\')]);
Jake Farrell27274222011-11-10 20:32:44 +00001216 InitBytes( ESCSEQ, [Byte('\'),Byte('u'),Byte('0'),Byte('0')]);
1217end.