ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/CBOR-XS/XS.xs
(Generate patch)

Comparing CBOR-XS/XS.xs (file contents):
Revision 1.10 by root, Sun Oct 27 20:40:25 2013 UTC vs.
Revision 1.52 by root, Sun Apr 24 19:31:55 2016 UTC

7#include <stdlib.h> 7#include <stdlib.h>
8#include <stdio.h> 8#include <stdio.h>
9#include <limits.h> 9#include <limits.h>
10#include <float.h> 10#include <float.h>
11 11
12#define ECB_NO_THREADS 1
12#include "ecb.h" 13#include "ecb.h"
14
15// compatibility with perl <5.18
16#ifndef HvNAMELEN_get
17# define HvNAMELEN_get(hv) strlen (HvNAME (hv))
18#endif
19#ifndef HvNAMELEN
20# define HvNAMELEN(hv) HvNAMELEN_get (hv)
21#endif
22#ifndef HvNAMEUTF8
23# define HvNAMEUTF8(hv) 0
24#endif
25#ifndef SvREFCNT_dec_NN
26# define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
27#endif
28
29// known major and minor types
30enum cbor_type
31{
32 MAJOR_SHIFT = 5,
33 MINOR_MASK = 0x1f,
34
35 MAJOR_POS_INT = 0 << MAJOR_SHIFT,
36 MAJOR_NEG_INT = 1 << MAJOR_SHIFT,
37 MAJOR_BYTES = 2 << MAJOR_SHIFT,
38 MAJOR_TEXT = 3 << MAJOR_SHIFT,
39 MAJOR_ARRAY = 4 << MAJOR_SHIFT,
40 MAJOR_MAP = 5 << MAJOR_SHIFT,
41 MAJOR_TAG = 6 << MAJOR_SHIFT,
42 MAJOR_MISC = 7 << MAJOR_SHIFT,
43
44 // INT/STRING/ARRAY/MAP subtypes
45 LENGTH_EXT1 = 24,
46 LENGTH_EXT2 = 25,
47 LENGTH_EXT4 = 26,
48 LENGTH_EXT8 = 27,
49
50 // SIMPLE types (effectively MISC subtypes)
51 SIMPLE_FALSE = 20,
52 SIMPLE_TRUE = 21,
53 SIMPLE_NULL = 22,
54 SIMPLE_UNDEF = 23,
55
56 // MISC subtype (unused)
57 MISC_EXT1 = 24,
58 MISC_FLOAT16 = 25,
59 MISC_FLOAT32 = 26,
60 MISC_FLOAT64 = 27,
61
62 // BYTES/TEXT/ARRAY/MAP
63 MINOR_INDEF = 31,
64};
13 65
14// known tags 66// known tags
15enum cbor_tag 67enum cbor_tag
16{ 68{
17 // inofficial extensions (pending iana registration) 69 // extensions
18 CBOR_TAG_PERL_OBJECT = 256, 70 CBOR_TAG_STRINGREF = 25, // http://cbor.schmorp.de/stringref
19 CBOR_TAG_GENERIC_OBJECT = 257, 71 CBOR_TAG_PERL_OBJECT = 26, // http://cbor.schmorp.de/perl-object
72 CBOR_TAG_GENERIC_OBJECT = 27, // http://cbor.schmorp.de/generic-object
73 CBOR_TAG_VALUE_SHAREABLE = 28, // http://cbor.schmorp.de/value-sharing
74 CBOR_TAG_VALUE_SHAREDREF = 29, // http://cbor.schmorp.de/value-sharing
75 CBOR_TAG_STRINGREF_NAMESPACE = 256, // http://cbor.schmorp.de/stringref
76 CBOR_TAG_INDIRECTION = 22098, // http://cbor.schmorp.de/indirection
20 77
21 // rfc7049 78 // rfc7049
22 CBOR_TAG_DATETIME = 0, // rfc4287, utf-8 79 CBOR_TAG_DATETIME = 0, // rfc4287, utf-8
23 CBOR_TAG_TIMESTAMP = 1, // unix timestamp, any 80 CBOR_TAG_TIMESTAMP = 1, // unix timestamp, any
24 CBOR_TAG_POS_BIGNUM = 2, // byte string 81 CBOR_TAG_POS_BIGNUM = 2, // byte string
25 CBOR_TAG_NEG_BIGNUM = 3, // byte string 82 CBOR_TAG_NEG_BIGNUM = 3, // byte string
26 CBOR_TAG_DECIMAL = 4, // decimal fraction, array 83 CBOR_TAG_DECIMAL = 4, // decimal fraction, array
27 CBOR_TAG_BIGFLOAT = 5, // array 84 CBOR_TAG_BIGFLOAT = 5, // array
28 85
29 CBOR_TAG_CONV_B64U = 21, // base64url, any 86 CBOR_TAG_CONV_B64U = 21, // base64url, any
30 CBOR_TAG_CONV_B64 = 22, // base64, any 87 CBOR_TAG_CONV_B64 = 22, // base64, any
31 CBOR_TAG_CONV_HEX = 23, // base16, any 88 CBOR_TAG_CONV_HEX = 23, // base16, any
32 CBOR_TAG_CBOR = 24, // embedded cbor, byte string 89 CBOR_TAG_CBOR = 24, // embedded cbor, byte string
33 90
34 CBOR_TAG_URI = 32, // URI rfc3986, utf-8 91 CBOR_TAG_URI = 32, // URI rfc3986, utf-8
35 CBOR_TAG_B64U = 33, // base64url rfc4648, utf-8 92 CBOR_TAG_B64U = 33, // base64url rfc4648, utf-8
36 CBOR_TAG_B64 = 34, // base6 rfc46484, utf-8 93 CBOR_TAG_B64 = 34, // base6 rfc46484, utf-8
37 CBOR_TAG_REGEX = 35, // regex pcre/ecma262, utf-8 94 CBOR_TAG_REGEX = 35, // regex pcre/ecma262, utf-8
38 CBOR_TAG_MIME = 36, // mime message rfc2045, utf-8 95 CBOR_TAG_MIME = 36, // mime message rfc2045, utf-8
39 96
40 CBOR_TAG_MAGIC = 55799 // self-describe cbor 97 CBOR_TAG_MAGIC = 55799, // self-describe cbor
41}; 98};
42 99
43#define F_SHRINK 0x00000200UL 100#define F_SHRINK 0x00000001UL
44#define F_ALLOW_UNKNOWN 0x00002000UL 101#define F_ALLOW_UNKNOWN 0x00000002UL
102#define F_ALLOW_SHARING 0x00000004UL
103#define F_ALLOW_CYCLES 0x00000008UL
104#define F_PACK_STRINGS 0x00000010UL
105#define F_UTF8_STRINGS 0x00000020UL
106#define F_VALIDATE_UTF8 0x00000040UL
45 107
46#define INIT_SIZE 32 // initial scalar size to be allocated 108#define INIT_SIZE 32 // initial scalar size to be allocated
47 109
48#define SB do { 110#define SB do {
49#define SE } while (0) 111#define SE } while (0)
61# define CBOR_SLOW 0 123# define CBOR_SLOW 0
62# define CBOR_STASH cbor_stash 124# define CBOR_STASH cbor_stash
63#endif 125#endif
64 126
65static HV *cbor_stash, *types_boolean_stash, *types_error_stash, *cbor_tagged_stash; // CBOR::XS:: 127static HV *cbor_stash, *types_boolean_stash, *types_error_stash, *cbor_tagged_stash; // CBOR::XS::
66static SV *types_true, *types_false, *types_error; 128static SV *types_true, *types_false, *types_error, *sv_cbor, *default_filter;
67 129
68typedef struct { 130typedef struct {
69 U32 flags; 131 U32 flags;
70 U32 max_depth; 132 U32 max_depth;
71 STRLEN max_size; 133 STRLEN max_size;
134 SV *filter;
135
136 // for the incremental parser
137 STRLEN incr_pos; // the current offset into the text
138 STRLEN incr_need; // minimum bytes needed to decode
139 AV *incr_count; // for every nesting level, the number of outstanding values, or -1 for indef.
72} CBOR; 140} CBOR;
73 141
74ecb_inline void 142ecb_inline void
75cbor_init (CBOR *cbor) 143cbor_init (CBOR *cbor)
76{ 144{
77 Zero (cbor, 1, CBOR); 145 Zero (cbor, 1, CBOR);
78 cbor->max_depth = 512; 146 cbor->max_depth = 512;
147}
148
149ecb_inline void
150cbor_free (CBOR *cbor)
151{
152 SvREFCNT_dec (cbor->filter);
153 SvREFCNT_dec (cbor->incr_count);
79} 154}
80 155
81///////////////////////////////////////////////////////////////////////////// 156/////////////////////////////////////////////////////////////////////////////
82// utility functions 157// utility functions
83 158
105 SvPV_renew (sv, SvCUR (sv) + 1); 180 SvPV_renew (sv, SvCUR (sv) + 1);
106#endif 181#endif
107 } 182 }
108} 183}
109 184
110///////////////////////////////////////////////////////////////////////////// 185// minimum length of a string to be registered for stringref
111// fp hell 186ecb_inline int
112 187minimum_string_length (UV idx)
113//TODO 188{
189 return idx > 23
190 ? idx > 0xffU
191 ? idx > 0xffffU
192 ? idx > 0xffffffffU
193 ? 11
194 : 7
195 : 5
196 : 4
197 : 3;
198}
114 199
115///////////////////////////////////////////////////////////////////////////// 200/////////////////////////////////////////////////////////////////////////////
116// encoder 201// encoder
117 202
118// structure used for encoding CBOR 203// structure used for encoding CBOR
121 char *cur; // SvPVX (sv) + current output position 206 char *cur; // SvPVX (sv) + current output position
122 char *end; // SvEND (sv) 207 char *end; // SvEND (sv)
123 SV *sv; // result scalar 208 SV *sv; // result scalar
124 CBOR cbor; 209 CBOR cbor;
125 U32 depth; // recursion level 210 U32 depth; // recursion level
211 HV *stringref[2]; // string => index, or 0 ([0] = bytes, [1] = utf-8)
212 UV stringref_idx;
213 HV *shareable; // ptr => index, or 0
214 UV shareable_idx;
126} enc_t; 215} enc_t;
127 216
128ecb_inline void 217ecb_inline void
129need (enc_t *enc, STRLEN len) 218need (enc_t *enc, STRLEN len)
130{ 219{
147static void 236static void
148encode_uint (enc_t *enc, int major, UV len) 237encode_uint (enc_t *enc, int major, UV len)
149{ 238{
150 need (enc, 9); 239 need (enc, 9);
151 240
152 if (len < 24) 241 if (ecb_expect_true (len < LENGTH_EXT1))
153 *enc->cur++ = major | len; 242 *enc->cur++ = major | len;
154 else if (len <= 0xff) 243 else if (ecb_expect_true (len <= 0xffU))
155 { 244 {
156 *enc->cur++ = major | 24; 245 *enc->cur++ = major | LENGTH_EXT1;
157 *enc->cur++ = len; 246 *enc->cur++ = len;
158 } 247 }
159 else if (len <= 0xffff) 248 else if (len <= 0xffffU)
160 { 249 {
161 *enc->cur++ = major | 25; 250 *enc->cur++ = major | LENGTH_EXT2;
162 *enc->cur++ = len >> 8; 251 *enc->cur++ = len >> 8;
163 *enc->cur++ = len; 252 *enc->cur++ = len;
164 } 253 }
165 else if (len <= 0xffffffff) 254 else if (len <= 0xffffffffU)
166 { 255 {
167 *enc->cur++ = major | 26; 256 *enc->cur++ = major | LENGTH_EXT4;
168 *enc->cur++ = len >> 24; 257 *enc->cur++ = len >> 24;
169 *enc->cur++ = len >> 16; 258 *enc->cur++ = len >> 16;
170 *enc->cur++ = len >> 8; 259 *enc->cur++ = len >> 8;
171 *enc->cur++ = len; 260 *enc->cur++ = len;
172 } 261 }
173 else 262 else
174 { 263 {
175 *enc->cur++ = major | 27; 264 *enc->cur++ = major | LENGTH_EXT8;
176 *enc->cur++ = len >> 56; 265 *enc->cur++ = len >> 56;
177 *enc->cur++ = len >> 48; 266 *enc->cur++ = len >> 48;
178 *enc->cur++ = len >> 40; 267 *enc->cur++ = len >> 40;
179 *enc->cur++ = len >> 32; 268 *enc->cur++ = len >> 32;
180 *enc->cur++ = len >> 24; 269 *enc->cur++ = len >> 24;
182 *enc->cur++ = len >> 8; 271 *enc->cur++ = len >> 8;
183 *enc->cur++ = len; 272 *enc->cur++ = len;
184 } 273 }
185} 274}
186 275
187static void 276ecb_inline void
277encode_tag (enc_t *enc, UV tag)
278{
279 encode_uint (enc, MAJOR_TAG, tag);
280}
281
282ecb_inline void
188encode_str (enc_t *enc, int utf8, char *str, STRLEN len) 283encode_str (enc_t *enc, int utf8, char *str, STRLEN len)
189{ 284{
190 encode_uint (enc, utf8 ? 0x60 : 0x40, len); 285 if (ecb_expect_false (enc->cbor.flags & F_UTF8_STRINGS))
286 if (!utf8)
287 {
288 // exceptional path for bytze strings that need to be utf8-encoded
289 STRLEN ulen = len;
290 U8 *p, *pend = (U8 *)str + len;
291
292 for (p = (U8 *)str; p < pend; ++p)
293 ulen += *p >> 7; // count set high bits
294
295 encode_uint (enc, MAJOR_TEXT, ulen);
296
297 need (enc, ulen);
298 for (p = (U8 *)str; p < pend; ++p)
299 if (*p < 0x80)
300 *enc->cur++ = *p;
301 else
302 {
303 *enc->cur++ = 0xc0 + (*p >> 6);
304 *enc->cur++ = 0x80 + (*p & 63);
305 }
306
307 return;
308 }
309
310 encode_uint (enc, utf8 ? MAJOR_TEXT : MAJOR_BYTES, len);
191 need (enc, len); 311 need (enc, len);
192 memcpy (enc->cur, str, len); 312 memcpy (enc->cur, str, len);
193 enc->cur += len; 313 enc->cur += len;
194} 314}
195 315
316static void
317encode_strref (enc_t *enc, int utf8, char *str, STRLEN len)
318{
319 if (ecb_expect_false (enc->cbor.flags & F_PACK_STRINGS))
320 {
321 SV **svp = hv_fetch (enc->stringref[!!utf8], str, len, 1);
322
323 if (SvOK (*svp))
324 {
325 // already registered, use stringref
326 encode_tag (enc, CBOR_TAG_STRINGREF);
327 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
328 return;
329 }
330 else if (len >= minimum_string_length (enc->stringref_idx))
331 {
332 // register only
333 sv_setuv (*svp, enc->stringref_idx);
334 ++enc->stringref_idx;
335 }
336 }
337
338 encode_str (enc, utf8, str, len);
339}
340
196static void encode_sv (enc_t *enc, SV *sv); 341static void encode_sv (enc_t *enc, SV *sv);
197 342
198static void 343static void
199encode_av (enc_t *enc, AV *av) 344encode_av (enc_t *enc, AV *av)
200{ 345{
203 if (enc->depth >= enc->cbor.max_depth) 348 if (enc->depth >= enc->cbor.max_depth)
204 croak (ERR_NESTING_EXCEEDED); 349 croak (ERR_NESTING_EXCEEDED);
205 350
206 ++enc->depth; 351 ++enc->depth;
207 352
208 encode_uint (enc, 0x80, len + 1); 353 encode_uint (enc, MAJOR_ARRAY, len + 1);
209 354
355 if (SvMAGICAL (av))
210 for (i = 0; i <= len; ++i) 356 for (i = 0; i <= len; ++i)
211 { 357 {
212 SV **svp = av_fetch (av, i, 0); 358 SV **svp = av_fetch (av, i, 0);
213 encode_sv (enc, svp ? *svp : &PL_sv_undef); 359 encode_sv (enc, svp ? *svp : &PL_sv_undef);
214 } 360 }
361 else
362 for (i = 0; i <= len; ++i)
363 {
364 SV *sv = AvARRAY (av)[i];
365 encode_sv (enc, sv ? sv : &PL_sv_undef);
366 }
215 367
216 --enc->depth; 368 --enc->depth;
217} 369}
218 370
219static void 371static void
228 380
229 int pairs = hv_iterinit (hv); 381 int pairs = hv_iterinit (hv);
230 int mg = SvMAGICAL (hv); 382 int mg = SvMAGICAL (hv);
231 383
232 if (mg) 384 if (mg)
233 encode_ch (enc, 0xa0 | 31); 385 encode_ch (enc, MAJOR_MAP | MINOR_INDEF);
234 else 386 else
235 encode_uint (enc, 0xa0, pairs); 387 encode_uint (enc, MAJOR_MAP, pairs);
236 388
237 while ((he = hv_iternext (hv))) 389 while ((he = hv_iternext (hv)))
238 { 390 {
239 if (HeKLEN (he) == HEf_SVKEY) 391 if (HeKLEN (he) == HEf_SVKEY)
240 encode_sv (enc, HeSVKEY (he)); 392 encode_sv (enc, HeSVKEY (he));
241 else 393 else
242 encode_str (enc, HeKUTF8 (he), HeKEY (he), HeKLEN (he)); 394 encode_strref (enc, HeKUTF8 (he), HeKEY (he), HeKLEN (he));
243 395
244 encode_sv (enc, ecb_expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he)); 396 encode_sv (enc, ecb_expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he));
245 } 397 }
246 398
247 if (mg) 399 if (mg)
248 encode_ch (enc, 0xe0 | 31); 400 encode_ch (enc, MAJOR_MISC | MINOR_INDEF);
249 401
250 --enc->depth; 402 --enc->depth;
251} 403}
252 404
253// encode objects, arrays and special \0=false and \1=true values. 405// encode objects, arrays and special \0=false and \1=true values.
254static void 406static void
255encode_rv (enc_t *enc, SV *sv) 407encode_rv (enc_t *enc, SV *sv)
256{ 408{
257 svtype svt;
258
259 SvGETMAGIC (sv); 409 SvGETMAGIC (sv);
410
260 svt = SvTYPE (sv); 411 svtype svt = SvTYPE (sv);
261 412
262 if (ecb_expect_false (SvOBJECT (sv))) 413 if (ecb_expect_false (SvOBJECT (sv)))
263 { 414 {
264 HV *boolean_stash = !CBOR_SLOW || types_boolean_stash 415 HV *boolean_stash = !CBOR_SLOW || types_boolean_stash
265 ? types_boolean_stash 416 ? types_boolean_stash
269 : gv_stashpv ("Types::Serialiser::Error", 1); 420 : gv_stashpv ("Types::Serialiser::Error", 1);
270 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash 421 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
271 ? cbor_tagged_stash 422 ? cbor_tagged_stash
272 : gv_stashpv ("CBOR::XS::Tagged" , 1); 423 : gv_stashpv ("CBOR::XS::Tagged" , 1);
273 424
425 HV *stash = SvSTASH (sv);
426
274 if (SvSTASH (sv) == boolean_stash) 427 if (stash == boolean_stash)
275 encode_ch (enc, SvIV (sv) ? 0xe0 | 21 : 0xe0 | 20); 428 {
429 encode_ch (enc, SvIV (sv) ? MAJOR_MISC | SIMPLE_TRUE : MAJOR_MISC | SIMPLE_FALSE);
430 return;
431 }
276 else if (SvSTASH (sv) == error_stash) 432 else if (stash == error_stash)
277 encode_ch (enc, 0xe0 | 23); 433 {
434 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
435 return;
436 }
278 else if (SvSTASH (sv) == tagged_stash) 437 else if (stash == tagged_stash)
279 { 438 {
280 if (svt != SVt_PVAV) 439 if (svt != SVt_PVAV)
281 croak ("encountered CBOR::XS::Tagged object that isn't an array"); 440 croak ("encountered CBOR::XS::Tagged object that isn't an array");
282 441
283 encode_uint (enc, 0xc0, SvUV (*av_fetch ((AV *)sv, 0, 1))); 442 encode_uint (enc, MAJOR_TAG, SvUV (*av_fetch ((AV *)sv, 0, 1)));
284 encode_sv (enc, *av_fetch ((AV *)sv, 1, 1)); 443 encode_sv (enc, *av_fetch ((AV *)sv, 1, 1));
444
445 return;
446 }
447 }
448
449 if (ecb_expect_false (SvREFCNT (sv) > 1)
450 && ecb_expect_false (enc->cbor.flags & F_ALLOW_SHARING))
451 {
452 if (!enc->shareable)
453 enc->shareable = (HV *)sv_2mortal ((SV *)newHV ());
454
455 SV **svp = hv_fetch (enc->shareable, (char *)&sv, sizeof (sv), 1);
456
457 if (SvOK (*svp))
458 {
459 encode_tag (enc, CBOR_TAG_VALUE_SHAREDREF);
460 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
461 return;
285 } 462 }
286 else 463 else
287 { 464 {
465 sv_setuv (*svp, enc->shareable_idx);
466 ++enc->shareable_idx;
467 encode_tag (enc, CBOR_TAG_VALUE_SHAREABLE);
468 }
469 }
470
471 if (ecb_expect_false (SvOBJECT (sv)))
472 {
473 HV *stash = SvSTASH (sv);
474 GV *method;
475
476 if ((method = gv_fetchmethod_autoload (stash, "TO_CBOR", 0)))
477 {
478 dSP;
479
480 ENTER; SAVETMPS;
481 PUSHMARK (SP);
288 // we re-bless the reference to get overload and other niceties right 482 // we re-bless the reference to get overload and other niceties right
289 GV *to_cbor = gv_fetchmethod_autoload (SvSTASH (sv), "TO_CBOR", 0);
290
291 if (to_cbor)
292 {
293 dSP;
294
295 ENTER; SAVETMPS; PUSHMARK (SP);
296 XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), SvSTASH (sv))); 483 XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
297 484
298 // calling with G_SCALAR ensures that we always get a 1 return value
299 PUTBACK; 485 PUTBACK;
486 // G_SCALAR ensures that return value is 1
300 call_sv ((SV *)GvCV (to_cbor), G_SCALAR); 487 call_sv ((SV *)GvCV (method), G_SCALAR);
301 SPAGAIN; 488 SPAGAIN;
302 489
303 // catch this surprisingly common error 490 // catch this surprisingly common error
304 if (SvROK (TOPs) && SvRV (TOPs) == sv) 491 if (SvROK (TOPs) && SvRV (TOPs) == sv)
305 croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv))); 492 croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (stash));
306 493
307 sv = POPs; 494 encode_sv (enc, POPs);
495
308 PUTBACK; 496 PUTBACK;
309 497
310 encode_sv (enc, sv);
311
312 FREETMPS; LEAVE; 498 FREETMPS; LEAVE;
313 } 499 }
500 else if ((method = gv_fetchmethod_autoload (stash, "FREEZE", 0)) != 0)
501 {
502 dSP;
503
504 ENTER; SAVETMPS;
505 SAVESTACK_POS ();
506 PUSHMARK (SP);
507 EXTEND (SP, 2);
508 // we re-bless the reference to get overload and other niceties right
509 PUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
510 PUSHs (sv_cbor);
511
512 PUTBACK;
513 int count = call_sv ((SV *)GvCV (method), G_ARRAY);
514 SPAGAIN;
515
516 // catch this surprisingly common error
517 if (count == 1 && SvROK (TOPs) && SvRV (TOPs) == sv)
518 croak ("%s::FREEZE(CBOR) method returned same object as was passed instead of a new one", HvNAME (stash));
519
520 encode_tag (enc, CBOR_TAG_PERL_OBJECT);
521 encode_uint (enc, MAJOR_ARRAY, count + 1);
522 encode_strref (enc, HvNAMEUTF8 (stash), HvNAME (stash), HvNAMELEN (stash));
523
524 while (count)
525 encode_sv (enc, SP[1 - count--]);
526
527 PUTBACK;
528
529 FREETMPS; LEAVE;
530 }
314 else 531 else
315 croak ("encountered object '%s', but no TO_CBOR method available on it", 532 croak ("encountered object '%s', but no TO_CBOR or FREEZE methods available on it",
316 SvPV_nolen (sv_2mortal (newRV_inc (sv)))); 533 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
317 }
318 } 534 }
319 else if (svt == SVt_PVHV) 535 else if (svt == SVt_PVHV)
320 encode_hv (enc, (HV *)sv); 536 encode_hv (enc, (HV *)sv);
321 else if (svt == SVt_PVAV) 537 else if (svt == SVt_PVAV)
322 encode_av (enc, (AV *)sv); 538 encode_av (enc, (AV *)sv);
323 else if (svt < SVt_PVAV)
324 {
325 STRLEN len = 0;
326 char *pv = svt ? SvPV (sv, len) : 0;
327
328 if (len == 1 && *pv == '1')
329 encode_ch (enc, 0xe0 | 21);
330 else if (len == 1 && *pv == '0')
331 encode_ch (enc, 0xe0 | 20);
332 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
333 encode_ch (enc, 0xe0 | 23);
334 else
335 croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
336 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
337 }
338 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
339 encode_ch (enc, 0xe0 | 23);
340 else 539 else
341 croak ("encountered %s, but CBOR can only represent references to arrays or hashes", 540 {
342 SvPV_nolen (sv_2mortal (newRV_inc (sv)))); 541 encode_tag (enc, CBOR_TAG_INDIRECTION);
542 encode_sv (enc, sv);
543 }
343} 544}
344 545
345static void 546static void
346encode_nv (enc_t *enc, SV *sv) 547encode_nv (enc_t *enc, SV *sv)
347{ 548{
348 double nv = SvNVX (sv); 549 double nv = SvNVX (sv);
349 550
350 need (enc, 9); 551 need (enc, 9);
351 552
352 if (ecb_expect_false (nv == (U32)nv)) 553 if (ecb_expect_false (nv == (NV)(U32)nv))
353 encode_uint (enc, 0x00, (U32)nv); 554 encode_uint (enc, MAJOR_POS_INT, (U32)nv);
354 //TODO: maybe I32? 555 //TODO: maybe I32?
355 else if (ecb_expect_false (nv == (float)nv)) 556 else if (ecb_expect_false (nv == (float)nv))
356 { 557 {
357 uint32_t fp = ecb_float_to_binary32 (nv); 558 uint32_t fp = ecb_float_to_binary32 (nv);
358 559
359 *enc->cur++ = 0xe0 | 26; 560 *enc->cur++ = MAJOR_MISC | MISC_FLOAT32;
360 561
361 if (!ecb_big_endian ()) 562 if (!ecb_big_endian ())
362 fp = ecb_bswap32 (fp); 563 fp = ecb_bswap32 (fp);
363 564
364 memcpy (enc->cur, &fp, 4); 565 memcpy (enc->cur, &fp, 4);
366 } 567 }
367 else 568 else
368 { 569 {
369 uint64_t fp = ecb_double_to_binary64 (nv); 570 uint64_t fp = ecb_double_to_binary64 (nv);
370 571
371 *enc->cur++ = 0xe0 | 27; 572 *enc->cur++ = MAJOR_MISC | MISC_FLOAT64;
372 573
373 if (!ecb_big_endian ()) 574 if (!ecb_big_endian ())
374 fp = ecb_bswap64 (fp); 575 fp = ecb_bswap64 (fp);
375 576
376 memcpy (enc->cur, &fp, 8); 577 memcpy (enc->cur, &fp, 8);
385 586
386 if (SvPOKp (sv)) 587 if (SvPOKp (sv))
387 { 588 {
388 STRLEN len; 589 STRLEN len;
389 char *str = SvPV (sv, len); 590 char *str = SvPV (sv, len);
390 encode_str (enc, SvUTF8 (sv), str, len); 591 encode_strref (enc, SvUTF8 (sv), str, len);
391 } 592 }
392 else if (SvNOKp (sv)) 593 else if (SvNOKp (sv))
393 encode_nv (enc, sv); 594 encode_nv (enc, sv);
394 else if (SvIOKp (sv)) 595 else if (SvIOKp (sv))
395 { 596 {
396 if (SvIsUV (sv)) 597 if (SvIsUV (sv))
397 encode_uint (enc, 0x00, SvUVX (sv)); 598 encode_uint (enc, MAJOR_POS_INT, SvUVX (sv));
398 else if (SvIVX (sv) >= 0) 599 else if (SvIVX (sv) >= 0)
399 encode_uint (enc, 0x00, SvIVX (sv)); 600 encode_uint (enc, MAJOR_POS_INT, SvIVX (sv));
400 else 601 else
401 encode_uint (enc, 0x20, -(SvIVX (sv) + 1)); 602 encode_uint (enc, MAJOR_NEG_INT, -(SvIVX (sv) + 1));
402 } 603 }
403 else if (SvROK (sv)) 604 else if (SvROK (sv))
404 encode_rv (enc, SvRV (sv)); 605 encode_rv (enc, SvRV (sv));
405 else if (!SvOK (sv)) 606 else if (!SvOK (sv))
406 encode_ch (enc, 0xe0 | 22); 607 encode_ch (enc, MAJOR_MISC | SIMPLE_NULL);
407 else if (enc->cbor.flags & F_ALLOW_UNKNOWN) 608 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
408 encode_ch (enc, 0xe0 | 23); 609 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
409 else 610 else
410 croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data", 611 croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data",
411 SvPV_nolen (sv), (unsigned int)SvFLAGS (sv)); 612 SvPV_nolen (sv), (unsigned int)SvFLAGS (sv));
412} 613}
413 614
414static SV * 615static SV *
415encode_cbor (SV *scalar, CBOR *cbor) 616encode_cbor (SV *scalar, CBOR *cbor)
416{ 617{
417 enc_t enc; 618 enc_t enc = { 0 };
418 619
419 enc.cbor = *cbor; 620 enc.cbor = *cbor;
420 enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE)); 621 enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
421 enc.cur = SvPVX (enc.sv); 622 enc.cur = SvPVX (enc.sv);
422 enc.end = SvEND (enc.sv); 623 enc.end = SvEND (enc.sv);
423 enc.depth = 0;
424 624
425 SvPOK_only (enc.sv); 625 SvPOK_only (enc.sv);
626
627 if (cbor->flags & F_PACK_STRINGS)
628 {
629 encode_tag (&enc, CBOR_TAG_STRINGREF_NAMESPACE);
630 enc.stringref[0]= (HV *)sv_2mortal ((SV *)newHV ());
631 enc.stringref[1]= (HV *)sv_2mortal ((SV *)newHV ());
632 }
633
426 encode_sv (&enc, scalar); 634 encode_sv (&enc, scalar);
427 635
428 SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv)); 636 SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
429 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings 637 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
430 638
444 U8 *end; // end of input string 652 U8 *end; // end of input string
445 const char *err; // parse error, if != 0 653 const char *err; // parse error, if != 0
446 CBOR cbor; 654 CBOR cbor;
447 U32 depth; // recursion depth 655 U32 depth; // recursion depth
448 U32 maxdepth; // recursion depth limit 656 U32 maxdepth; // recursion depth limit
657 AV *shareable;
658 AV *stringref;
659 SV *decode_tagged;
449} dec_t; 660} dec_t;
450 661
451#define ERR(reason) SB if (!dec->err) dec->err = reason; goto fail; SE 662#define ERR(reason) SB if (!dec->err) dec->err = reason; goto fail; SE
452 663
453#define WANT(len) if (ecb_expect_false (dec->cur + len > dec->end)) ERR ("unexpected end of CBOR data") 664#define WANT(len) if (ecb_expect_false (dec->cur + len > dec->end)) ERR ("unexpected end of CBOR data")
456#define DEC_DEC_DEPTH --dec->depth 667#define DEC_DEC_DEPTH --dec->depth
457 668
458static UV 669static UV
459decode_uint (dec_t *dec) 670decode_uint (dec_t *dec)
460{ 671{
461 switch (*dec->cur & 31) 672 U8 m = *dec->cur & MINOR_MASK;
462 { 673 ++dec->cur;
463 case 0: case 1: case 2: case 3: case 4: case 5: case 6: case 7:
464 case 8: case 9: case 10: case 11: case 12: case 13: case 14: case 15:
465 case 16: case 17: case 18: case 19: case 20: case 21: case 22: case 23:
466 return *dec->cur++ & 31;
467 674
468 case 24: 675 if (ecb_expect_true (m < LENGTH_EXT1))
676 return m;
677 else if (ecb_expect_true (m == LENGTH_EXT1))
678 {
469 WANT (2); 679 WANT (1);
470 dec->cur += 2; 680 dec->cur += 1;
471 return dec->cur[-1]; 681 return dec->cur[-1];
472 682 }
473 case 25: 683 else if (ecb_expect_true (m == LENGTH_EXT2))
684 {
474 WANT (3); 685 WANT (2);
475 dec->cur += 3; 686 dec->cur += 2;
476 return (((UV)dec->cur[-2]) << 8) 687 return (((UV)dec->cur[-2]) << 8)
477 | ((UV)dec->cur[-1]); 688 | ((UV)dec->cur[-1]);
478 689 }
479 case 26: 690 else if (ecb_expect_true (m == LENGTH_EXT4))
691 {
480 WANT (5); 692 WANT (4);
481 dec->cur += 5; 693 dec->cur += 4;
482 return (((UV)dec->cur[-4]) << 24) 694 return (((UV)dec->cur[-4]) << 24)
483 | (((UV)dec->cur[-3]) << 16) 695 | (((UV)dec->cur[-3]) << 16)
484 | (((UV)dec->cur[-2]) << 8) 696 | (((UV)dec->cur[-2]) << 8)
485 | ((UV)dec->cur[-1]); 697 | ((UV)dec->cur[-1]);
486 698 }
487 case 27: 699 else if (ecb_expect_true (m == LENGTH_EXT8))
700 {
488 WANT (9); 701 WANT (8);
489 dec->cur += 9; 702 dec->cur += 8;
703
704 return
705#if UVSIZE < 8
706 0
707#else
490 return (((UV)dec->cur[-8]) << 56) 708 (((UV)dec->cur[-8]) << 56)
491 | (((UV)dec->cur[-7]) << 48) 709 | (((UV)dec->cur[-7]) << 48)
492 | (((UV)dec->cur[-6]) << 40) 710 | (((UV)dec->cur[-6]) << 40)
493 | (((UV)dec->cur[-5]) << 32) 711 | (((UV)dec->cur[-5]) << 32)
712#endif
494 | (((UV)dec->cur[-4]) << 24) 713 | (((UV)dec->cur[-4]) << 24)
495 | (((UV)dec->cur[-3]) << 16) 714 | (((UV)dec->cur[-3]) << 16)
496 | (((UV)dec->cur[-2]) << 8) 715 | (((UV)dec->cur[-2]) << 8)
497 | ((UV)dec->cur[-1]); 716 | ((UV)dec->cur[-1]);
498 717 }
499 default: 718 else
500 ERR ("corrupted CBOR data (unsupported integer minor encoding)"); 719 ERR ("corrupted CBOR data (unsupported integer minor encoding)");
501 }
502 720
503fail: 721fail:
504 return 0; 722 return 0;
505} 723}
506 724
511{ 729{
512 AV *av = newAV (); 730 AV *av = newAV ();
513 731
514 DEC_INC_DEPTH; 732 DEC_INC_DEPTH;
515 733
516 if ((*dec->cur & 31) == 31) 734 if (*dec->cur == (MAJOR_ARRAY | MINOR_INDEF))
517 { 735 {
518 ++dec->cur; 736 ++dec->cur;
519 737
520 for (;;) 738 for (;;)
521 { 739 {
522 WANT (1); 740 WANT (1);
523 741
524 if (*dec->cur == (0xe0 | 31)) 742 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
525 { 743 {
526 ++dec->cur; 744 ++dec->cur;
527 break; 745 break;
528 } 746 }
529 747
532 } 750 }
533 else 751 else
534 { 752 {
535 int i, len = decode_uint (dec); 753 int i, len = decode_uint (dec);
536 754
755 WANT (len); // complexity check for av_fill - need at least one byte per value, do not allow supersize arrays
537 av_fill (av, len - 1); 756 av_fill (av, len - 1);
538 757
539 for (i = 0; i < len; ++i) 758 for (i = 0; i < len; ++i)
540 AvARRAY (av)[i] = decode_sv (dec); 759 AvARRAY (av)[i] = decode_sv (dec);
541 } 760 }
547 SvREFCNT_dec (av); 766 SvREFCNT_dec (av);
548 DEC_DEC_DEPTH; 767 DEC_DEC_DEPTH;
549 return &PL_sv_undef; 768 return &PL_sv_undef;
550} 769}
551 770
771static void
772decode_he (dec_t *dec, HV *hv)
773{
774 // for speed reasons, we specialcase single-string
775 // byte or utf-8 strings as keys, but only when !stringref
776
777 if (ecb_expect_true (!dec->stringref))
778 if (ecb_expect_true ((U8)(*dec->cur - MAJOR_BYTES) <= LENGTH_EXT8))
779 {
780 I32 len = decode_uint (dec);
781 char *key = (char *)dec->cur;
782
783 WANT (len);
784 dec->cur += len;
785
786 hv_store (hv, key, len, decode_sv (dec), 0);
787
788 return;
789 }
790 else if (ecb_expect_true ((U8)(*dec->cur - MAJOR_TEXT) <= LENGTH_EXT8))
791 {
792 I32 len = decode_uint (dec);
793 char *key = (char *)dec->cur;
794
795 WANT (len);
796 dec->cur += len;
797
798 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
799 if (!is_utf8_string (key, len))
800 ERR ("corrupted CBOR data (invalid UTF-8 in map key)");
801
802 hv_store (hv, key, -len, decode_sv (dec), 0);
803
804 return;
805 }
806
807 SV *k = decode_sv (dec);
808 SV *v = decode_sv (dec);
809
810 hv_store_ent (hv, k, v, 0);
811 SvREFCNT_dec (k);
812
813fail:
814 ;
815}
816
552static SV * 817static SV *
553decode_hv (dec_t *dec) 818decode_hv (dec_t *dec)
554{ 819{
555 HV *hv = newHV (); 820 HV *hv = newHV ();
556 821
557 DEC_INC_DEPTH; 822 DEC_INC_DEPTH;
558 823
559 if ((*dec->cur & 31) == 31) 824 if (*dec->cur == (MAJOR_MAP | MINOR_INDEF))
560 { 825 {
561 ++dec->cur; 826 ++dec->cur;
562 827
563 for (;;) 828 for (;;)
564 { 829 {
565 WANT (1); 830 WANT (1);
566 831
567 if (*dec->cur == (0xe0 | 31)) 832 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
568 { 833 {
569 ++dec->cur; 834 ++dec->cur;
570 break; 835 break;
571 } 836 }
572 837
573 SV *k = decode_sv (dec); 838 decode_he (dec, hv);
574 SV *v = decode_sv (dec);
575
576 hv_store_ent (hv, k, v, 0);
577 } 839 }
578 } 840 }
579 else 841 else
580 { 842 {
581 int len = decode_uint (dec); 843 int pairs = decode_uint (dec);
582 844
583 while (len--) 845 while (pairs--)
584 { 846 decode_he (dec, hv);
585 SV *k = decode_sv (dec);
586 SV *v = decode_sv (dec);
587
588 hv_store_ent (hv, k, v, 0);
589 }
590 } 847 }
591 848
592 DEC_DEC_DEPTH; 849 DEC_DEC_DEPTH;
593 return newRV_noinc ((SV *)hv); 850 return newRV_noinc ((SV *)hv);
594 851
601static SV * 858static SV *
602decode_str (dec_t *dec, int utf8) 859decode_str (dec_t *dec, int utf8)
603{ 860{
604 SV *sv = 0; 861 SV *sv = 0;
605 862
606 if ((*dec->cur & 31) == 31) 863 if ((*dec->cur & MINOR_MASK) == MINOR_INDEF)
607 { 864 {
865 // indefinite length strings
608 ++dec->cur; 866 ++dec->cur;
609 867
868 U8 major = *dec->cur & MAJOR_MISC;
869
610 sv = newSVpvn ("", 0); 870 sv = newSVpvn ("", 0);
611 871
612 // not very fast, and certainly not robust against illegal input
613 for (;;) 872 for (;;)
614 { 873 {
615 WANT (1); 874 WANT (1);
616 875
617 if (*dec->cur == (0xe0 | 31)) 876 if ((*dec->cur - major) > LENGTH_EXT8)
877 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
618 { 878 {
619 ++dec->cur; 879 ++dec->cur;
620 break; 880 break;
621 } 881 }
882 else
883 ERR ("corrupted CBOR data (invalid chunks in indefinite length string)");
622 884
623 sv_catsv (sv, decode_sv (dec)); 885 STRLEN len = decode_uint (dec);
886
887 WANT (len);
888 sv_catpvn (sv, dec->cur, len);
889 dec->cur += len;
624 } 890 }
625 } 891 }
626 else 892 else
627 { 893 {
628 STRLEN len = decode_uint (dec); 894 STRLEN len = decode_uint (dec);
629 895
630 WANT (len); 896 WANT (len);
631 sv = newSVpvn (dec->cur, len); 897 sv = newSVpvn (dec->cur, len);
632 dec->cur += len; 898 dec->cur += len;
899
900 if (ecb_expect_false (dec->stringref)
901 && SvCUR (sv) >= minimum_string_length (AvFILLp (dec->stringref) + 1))
902 av_push (dec->stringref, SvREFCNT_inc_NN (sv));
633 } 903 }
634 904
635 if (utf8) 905 if (utf8)
906 {
907 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
908 if (!is_utf8_string (SvPVX (sv), SvCUR (sv)))
909 ERR ("corrupted CBOR data (invalid UTF-8 in text string)");
910
636 SvUTF8_on (sv); 911 SvUTF8_on (sv);
912 }
637 913
638 return sv; 914 return sv;
639 915
640fail: 916fail:
641 SvREFCNT_dec (sv); 917 SvREFCNT_dec (sv);
643} 919}
644 920
645static SV * 921static SV *
646decode_tagged (dec_t *dec) 922decode_tagged (dec_t *dec)
647{ 923{
924 SV *sv = 0;
648 UV tag = decode_uint (dec); 925 UV tag = decode_uint (dec);
926
927 WANT (1);
928
929 switch (tag)
930 {
931 case CBOR_TAG_MAGIC:
649 SV *sv = decode_sv (dec); 932 sv = decode_sv (dec);
933 break;
650 934
651 if (tag == CBOR_TAG_MAGIC) 935 case CBOR_TAG_INDIRECTION:
652 return sv; 936 sv = newRV_noinc (decode_sv (dec));
937 break;
653 938
654 if (tag == CBOR_TAG_PERL_OBJECT) 939 case CBOR_TAG_STRINGREF_NAMESPACE:
655 { 940 {
941 ENTER; SAVETMPS;
942
943 SAVESPTR (dec->stringref);
944 dec->stringref = (AV *)sv_2mortal ((SV *)newAV ());
945
946 sv = decode_sv (dec);
947
948 FREETMPS; LEAVE;
949 }
950 break;
951
952 case CBOR_TAG_STRINGREF:
953 {
954 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
955 ERR ("corrupted CBOR data (stringref index not an unsigned integer)");
956
957 UV idx = decode_uint (dec);
958
959 if (!dec->stringref || (int)idx > AvFILLp (dec->stringref))
960 ERR ("corrupted CBOR data (stringref index out of bounds or outside namespace)");
961
962 sv = newSVsv (AvARRAY (dec->stringref)[idx]);
963 }
964 break;
965
966 case CBOR_TAG_VALUE_SHAREABLE:
967 {
968 if (ecb_expect_false (!dec->shareable))
969 dec->shareable = (AV *)sv_2mortal ((SV *)newAV ());
970
971 if (dec->cbor.flags & F_ALLOW_CYCLES)
972 {
973 sv = newSV (0);
974 av_push (dec->shareable, SvREFCNT_inc_NN (sv));
975
976 SV *osv = decode_sv (dec);
977 sv_setsv (sv, osv);
978 SvREFCNT_dec_NN (osv);
979 }
980 else
981 {
982 av_push (dec->shareable, &PL_sv_undef);
983 int idx = AvFILLp (dec->shareable);
984 sv = decode_sv (dec);
985 av_store (dec->shareable, idx, SvREFCNT_inc_NN (sv));
986 }
987 }
988 break;
989
990 case CBOR_TAG_VALUE_SHAREDREF:
991 {
992 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
993 ERR ("corrupted CBOR data (sharedref index not an unsigned integer)");
994
995 UV idx = decode_uint (dec);
996
997 if (!dec->shareable || (int)idx > AvFILLp (dec->shareable))
998 ERR ("corrupted CBOR data (sharedref index out of bounds)");
999
1000 sv = SvREFCNT_inc_NN (AvARRAY (dec->shareable)[idx]);
1001
1002 if (sv == &PL_sv_undef)
1003 ERR ("cyclic CBOR data structure found, but allow_cycles is not enabled");
1004 }
1005 break;
1006
1007 case CBOR_TAG_PERL_OBJECT:
1008 {
1009 sv = decode_sv (dec);
1010
656 if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV) 1011 if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
657 ERR ("corrupted CBOR data (non-array perl object)"); 1012 ERR ("corrupted CBOR data (non-array perl object)");
1013
1014 AV *av = (AV *)SvRV (sv);
1015 int len = av_len (av) + 1;
1016 HV *stash = gv_stashsv (*av_fetch (av, 0, 1), 0);
1017
1018 if (!stash)
1019 ERR ("cannot decode perl-object (package does not exist)");
1020
1021 GV *method = gv_fetchmethod_autoload (stash, "THAW", 0);
1022
1023 if (!method)
1024 ERR ("cannot decode perl-object (package does not have a THAW method)");
1025
1026 dSP;
1027
1028 ENTER; SAVETMPS;
1029 PUSHMARK (SP);
1030 EXTEND (SP, len + 1);
1031 // we re-bless the reference to get overload and other niceties right
1032 PUSHs (*av_fetch (av, 0, 1));
1033 PUSHs (sv_cbor);
1034
1035 int i;
1036
1037 for (i = 1; i < len; ++i)
1038 PUSHs (*av_fetch (av, i, 1));
1039
1040 PUTBACK;
1041 call_sv ((SV *)GvCV (method), G_SCALAR | G_EVAL);
1042 SPAGAIN;
1043
1044 if (SvTRUE (ERRSV))
1045 {
1046 FREETMPS; LEAVE;
1047 ERR (SvPVutf8_nolen (sv_2mortal (SvREFCNT_inc (ERRSV))));
1048 }
1049
1050 SvREFCNT_dec (sv);
1051 sv = SvREFCNT_inc (POPs);
1052
1053 PUTBACK;
1054
1055 FREETMPS; LEAVE;
658 1056 }
659 // TODO 1057 break;
660 }
661 1058
1059 default:
1060 {
1061 sv = decode_sv (dec);
1062
1063 dSP;
1064 ENTER; SAVETMPS;
1065 SAVESTACK_POS ();
1066 PUSHMARK (SP);
1067 EXTEND (SP, 2);
1068 PUSHs (newSVuv (tag));
1069 PUSHs (sv);
1070
1071 PUTBACK;
1072 int count = call_sv (dec->cbor.filter ? dec->cbor.filter : default_filter, G_ARRAY | G_EVAL);
1073 SPAGAIN;
1074
1075 if (SvTRUE (ERRSV))
1076 {
1077 FREETMPS; LEAVE;
1078 ERR (SvPVutf8_nolen (sv_2mortal (SvREFCNT_inc (ERRSV))));
1079 }
1080
1081 if (count)
1082 {
1083 SvREFCNT_dec (sv);
1084 sv = SvREFCNT_inc (POPs);
1085 }
1086 else
1087 {
662 AV *av = newAV (); 1088 AV *av = newAV ();
663 av_push (av, newSVuv (tag)); 1089 av_push (av, newSVuv (tag));
664 av_push (av, sv); 1090 av_push (av, sv);
665 1091
666 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash 1092 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
667 ? cbor_tagged_stash 1093 ? cbor_tagged_stash
668 : gv_stashpv ("CBOR::XS::Tagged" , 1); 1094 : gv_stashpv ("CBOR::XS::Tagged" , 1);
669
670 return sv_bless (newRV_noinc ((SV *)av), tagged_stash); 1095 sv = sv_bless (newRV_noinc ((SV *)av), tagged_stash);
1096 }
1097
1098 PUTBACK;
1099
1100 FREETMPS; LEAVE;
1101 }
1102 break;
1103 }
1104
1105 return sv;
671 1106
672fail: 1107fail:
673 SvREFCNT_dec (sv); 1108 SvREFCNT_dec (sv);
674 return &PL_sv_undef; 1109 return &PL_sv_undef;
675} 1110}
677static SV * 1112static SV *
678decode_sv (dec_t *dec) 1113decode_sv (dec_t *dec)
679{ 1114{
680 WANT (1); 1115 WANT (1);
681 1116
682 switch (*dec->cur >> 5) 1117 switch (*dec->cur >> MAJOR_SHIFT)
683 { 1118 {
684 case 0: // unsigned int 1119 case MAJOR_POS_INT >> MAJOR_SHIFT: return newSVuv (decode_uint (dec));
685 return newSVuv (decode_uint (dec)); 1120 case MAJOR_NEG_INT >> MAJOR_SHIFT: return newSViv (-1 - (IV)decode_uint (dec));
686 case 1: // negative int 1121 case MAJOR_BYTES >> MAJOR_SHIFT: return decode_str (dec, 0);
687 return newSViv (-1 - (IV)decode_uint (dec)); 1122 case MAJOR_TEXT >> MAJOR_SHIFT: return decode_str (dec, 1);
688 case 2: // octet string 1123 case MAJOR_ARRAY >> MAJOR_SHIFT: return decode_av (dec);
689 return decode_str (dec, 0); 1124 case MAJOR_MAP >> MAJOR_SHIFT: return decode_hv (dec);
690 case 3: // utf-8 string 1125 case MAJOR_TAG >> MAJOR_SHIFT: return decode_tagged (dec);
691 return decode_str (dec, 1); 1126
692 case 4: // array 1127 case MAJOR_MISC >> MAJOR_SHIFT:
693 return decode_av (dec);
694 case 5: // map
695 return decode_hv (dec);
696 case 6: // tag
697 return decode_tagged (dec);
698 case 7: // misc
699 switch (*dec->cur++ & 31) 1128 switch (*dec->cur++ & MINOR_MASK)
700 { 1129 {
701 case 20: 1130 case SIMPLE_FALSE:
702#if CBOR_SLOW 1131#if CBOR_SLOW
703 types_false = get_bool ("Types::Serialiser::false"); 1132 types_false = get_bool ("Types::Serialiser::false");
704#endif 1133#endif
705 return newSVsv (types_false); 1134 return newSVsv (types_false);
706 case 21: 1135 case SIMPLE_TRUE:
707#if CBOR_SLOW 1136#if CBOR_SLOW
708 types_true = get_bool ("Types::Serialiser::true"); 1137 types_true = get_bool ("Types::Serialiser::true");
709#endif 1138#endif
710 return newSVsv (types_true); 1139 return newSVsv (types_true);
711 case 22: 1140 case SIMPLE_NULL:
712 return newSVsv (&PL_sv_undef); 1141 return newSVsv (&PL_sv_undef);
713 case 23: 1142 case SIMPLE_UNDEF:
714#if CBOR_SLOW 1143#if CBOR_SLOW
715 types_error = get_bool ("Types::Serialiser::error"); 1144 types_error = get_bool ("Types::Serialiser::error");
716#endif 1145#endif
717 return newSVsv (types_error); 1146 return newSVsv (types_error);
718 1147
719 case 25: 1148 case MISC_FLOAT16:
720 { 1149 {
721 WANT (2); 1150 WANT (2);
722 1151
723 uint16_t fp = (dec->cur[0] << 8) | dec->cur[1]; 1152 uint16_t fp = (dec->cur[0] << 8) | dec->cur[1];
724 dec->cur += 2; 1153 dec->cur += 2;
725 1154
726 return newSVnv (ecb_binary16_to_float (fp)); 1155 return newSVnv (ecb_binary16_to_float (fp));
727 } 1156 }
728 1157
729 case 26: 1158 case MISC_FLOAT32:
730 { 1159 {
731 uint32_t fp; 1160 uint32_t fp;
732 WANT (4); 1161 WANT (4);
733 memcpy (&fp, dec->cur, 4); 1162 memcpy (&fp, dec->cur, 4);
734 dec->cur += 4; 1163 dec->cur += 4;
737 fp = ecb_bswap32 (fp); 1166 fp = ecb_bswap32 (fp);
738 1167
739 return newSVnv (ecb_binary32_to_float (fp)); 1168 return newSVnv (ecb_binary32_to_float (fp));
740 } 1169 }
741 1170
742 case 27: 1171 case MISC_FLOAT64:
743 { 1172 {
744 uint64_t fp; 1173 uint64_t fp;
745 WANT (8); 1174 WANT (8);
746 memcpy (&fp, dec->cur, 8); 1175 memcpy (&fp, dec->cur, 8);
747 dec->cur += 8; 1176 dec->cur += 8;
750 fp = ecb_bswap64 (fp); 1179 fp = ecb_bswap64 (fp);
751 1180
752 return newSVnv (ecb_binary64_to_double (fp)); 1181 return newSVnv (ecb_binary64_to_double (fp));
753 } 1182 }
754 1183
755 // 0..19 unassigned 1184 // 0..19 unassigned simple
756 // 24 reserved + unassigned (reserved values are not encodable) 1185 // 24 reserved + unassigned simple (reserved values are not encodable)
1186 // 28-30 unassigned misc
1187 // 31 break code
757 default: 1188 default:
758 ERR ("corrupted CBOR data (reserved/unassigned major 7 value)"); 1189 ERR ("corrupted CBOR data (reserved/unassigned/unexpected major 7 value)");
759 } 1190 }
760 1191
761 break; 1192 break;
762 } 1193 }
763 1194
766} 1197}
767 1198
768static SV * 1199static SV *
769decode_cbor (SV *string, CBOR *cbor, char **offset_return) 1200decode_cbor (SV *string, CBOR *cbor, char **offset_return)
770{ 1201{
771 dec_t dec; 1202 dec_t dec = { 0 };
772 SV *sv; 1203 SV *sv;
1204 STRLEN len;
1205 char *data = SvPVbyte (string, len);
773 1206
774 /* work around bugs in 5.10 where manipulating magic values
775 * makes perl ignore the magic in subsequent accesses.
776 * also make a copy of non-PV values, to get them into a clean
777 * state (SvPV should do that, but it's buggy, see below).
778 */
779 /*SvGETMAGIC (string);*/
780 if (SvMAGICAL (string) || !SvPOK (string))
781 string = sv_2mortal (newSVsv (string));
782
783 SvUPGRADE (string, SVt_PV);
784
785 /* work around a bug in perl 5.10, which causes SvCUR to fail an
786 * assertion with -DDEBUGGING, although SvCUR is documented to
787 * return the xpv_cur field which certainly exists after upgrading.
788 * according to nicholas clark, calling SvPOK fixes this.
789 * But it doesn't fix it, so try another workaround, call SvPV_nolen
790 * and hope for the best.
791 * Damnit, SvPV_nolen still trips over yet another assertion. This
792 * assertion business is seriously broken, try yet another workaround
793 * for the broken -DDEBUGGING.
794 */
795 {
796#ifdef DEBUGGING
797 STRLEN offset = SvOK (string) ? sv_len (string) : 0;
798#else
799 STRLEN offset = SvCUR (string);
800#endif
801
802 if (offset > cbor->max_size && cbor->max_size) 1207 if (len > cbor->max_size && cbor->max_size)
803 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu", 1208 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
804 (unsigned long)SvCUR (string), (unsigned long)cbor->max_size); 1209 (unsigned long)len, (unsigned long)cbor->max_size);
805 }
806
807 sv_utf8_downgrade (string, 0);
808 1210
809 dec.cbor = *cbor; 1211 dec.cbor = *cbor;
810 dec.cur = (U8 *)SvPVX (string); 1212 dec.cur = (U8 *)data;
811 dec.end = (U8 *)SvEND (string); 1213 dec.end = (U8 *)data + len;
812 dec.err = 0;
813 dec.depth = 0;
814 1214
815 sv = decode_sv (&dec); 1215 sv = decode_sv (&dec);
816 1216
817 if (offset_return) 1217 if (offset_return)
818 *offset_return = dec.cur; 1218 *offset_return = dec.cur;
821 if (dec.cur != dec.end && !dec.err) 1221 if (dec.cur != dec.end && !dec.err)
822 dec.err = "garbage after CBOR object"; 1222 dec.err = "garbage after CBOR object";
823 1223
824 if (dec.err) 1224 if (dec.err)
825 { 1225 {
1226 if (dec.shareable)
1227 {
1228 // need to break cyclic links, which whould all be in shareable
1229 int i;
1230 SV **svp;
1231
1232 for (i = av_len (dec.shareable) + 1; i--; )
1233 if ((svp = av_fetch (dec.shareable, i, 0)))
1234 sv_setsv (*svp, &PL_sv_undef);
1235 }
1236
826 SvREFCNT_dec (sv); 1237 SvREFCNT_dec (sv);
827 croak ("%s, at offset %d (octet 0x%02x)", dec.err, dec.cur - (U8 *)SvPVX (string), (int)(uint8_t)*dec.cur); 1238 croak ("%s, at offset %d (octet 0x%02x)", dec.err, dec.cur - (U8 *)data, (int)(uint8_t)*dec.cur);
828 } 1239 }
829 1240
830 sv = sv_2mortal (sv); 1241 sv = sv_2mortal (sv);
831 1242
832 return sv; 1243 return sv;
833} 1244}
834 1245
1246/////////////////////////////////////////////////////////////////////////////
1247// incremental parser
1248
1249#define INCR_DONE(cbor) (AvFILLp (cbor->incr_count) < 0)
1250
1251// returns 0 for notyet, 1 for success or error
1252static int
1253incr_parse (CBOR *self, SV *cborstr)
1254{
1255 STRLEN cur;
1256 SvPV (cborstr, cur);
1257
1258 while (ecb_expect_true (self->incr_need <= cur))
1259 {
1260 // table of integer count bytes
1261 static I8 incr_len[MINOR_MASK + 1] = {
1262 0, 0, 0, 0, 0, 0, 0, 0,
1263 0, 0, 0, 0, 0, 0, 0, 0,
1264 0, 0, 0, 0, 0, 0, 0, 0,
1265 1, 2, 4, 8,-1,-1,-1,-2
1266 };
1267
1268 const U8 *p = SvPVX (cborstr) + self->incr_pos;
1269 U8 m = *p & MINOR_MASK;
1270 IV count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1271 I8 ilen = incr_len[m];
1272
1273 self->incr_need = self->incr_pos + 1;
1274
1275 if (ecb_expect_false (ilen < 0))
1276 {
1277 if (m != MINOR_INDEF)
1278 return 1; // error
1279
1280 if (*p == (MAJOR_MISC | MINOR_INDEF))
1281 {
1282 if (count >= 0)
1283 return 1; // error
1284
1285 count = 1;
1286 }
1287 else
1288 {
1289 av_push (self->incr_count, newSViv (-1)); //TODO: nest
1290 count = -1;
1291 }
1292 }
1293 else
1294 {
1295 self->incr_need += ilen;
1296 if (ecb_expect_false (self->incr_need > cur))
1297 return 0;
1298
1299 int major = *p >> MAJOR_SHIFT;
1300
1301 switch (major)
1302 {
1303 case MAJOR_TAG >> MAJOR_SHIFT:
1304 ++count; // tags merely prefix another value
1305 break;
1306
1307 case MAJOR_BYTES >> MAJOR_SHIFT:
1308 case MAJOR_TEXT >> MAJOR_SHIFT:
1309 case MAJOR_ARRAY >> MAJOR_SHIFT:
1310 case MAJOR_MAP >> MAJOR_SHIFT:
1311 {
1312 UV len;
1313
1314 if (ecb_expect_false (ilen))
1315 {
1316 len = 0;
1317
1318 do {
1319 len = (len << 8) | *++p;
1320 } while (--ilen);
1321 }
1322 else
1323 len = m;
1324
1325 switch (major)
1326 {
1327 case MAJOR_BYTES >> MAJOR_SHIFT:
1328 case MAJOR_TEXT >> MAJOR_SHIFT:
1329 self->incr_need += len;
1330 if (ecb_expect_false (self->incr_need > cur))
1331 return 0;
1332
1333 break;
1334
1335 case MAJOR_MAP >> MAJOR_SHIFT:
1336 len <<= 1;
1337 case MAJOR_ARRAY >> MAJOR_SHIFT:
1338 if (len)
1339 {
1340 av_push (self->incr_count, newSViv (len + 1)); //TODO: nest
1341 count = len + 1;
1342 }
1343 break;
1344 }
1345 }
1346 }
1347 }
1348
1349 self->incr_pos = self->incr_need;
1350
1351 if (count > 0)
1352 {
1353 while (!--count)
1354 {
1355 if (!AvFILLp (self->incr_count))
1356 return 1; // done
1357
1358 SvREFCNT_dec_NN (av_pop (self->incr_count));
1359 count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1360 }
1361
1362 SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]) = count;
1363 }
1364 }
1365
1366 return 0;
1367}
1368
1369
835///////////////////////////////////////////////////////////////////////////// 1370/////////////////////////////////////////////////////////////////////////////
836// XS interface functions 1371// XS interface functions
837 1372
838MODULE = CBOR::XS PACKAGE = CBOR::XS 1373MODULE = CBOR::XS PACKAGE = CBOR::XS
839 1374
846 types_error_stash = gv_stashpv ("Types::Serialiser::Error" , 1); 1381 types_error_stash = gv_stashpv ("Types::Serialiser::Error" , 1);
847 1382
848 types_true = get_bool ("Types::Serialiser::true" ); 1383 types_true = get_bool ("Types::Serialiser::true" );
849 types_false = get_bool ("Types::Serialiser::false"); 1384 types_false = get_bool ("Types::Serialiser::false");
850 types_error = get_bool ("Types::Serialiser::error"); 1385 types_error = get_bool ("Types::Serialiser::error");
1386
1387 default_filter = newSVpv ("CBOR::XS::default_filter", 0);
1388
1389 sv_cbor = newSVpv ("CBOR", 0);
1390 SvREADONLY_on (sv_cbor);
851} 1391}
852 1392
853PROTOTYPES: DISABLE 1393PROTOTYPES: DISABLE
854 1394
855void CLONE (...) 1395void CLONE (...)
873 1413
874void shrink (CBOR *self, int enable = 1) 1414void shrink (CBOR *self, int enable = 1)
875 ALIAS: 1415 ALIAS:
876 shrink = F_SHRINK 1416 shrink = F_SHRINK
877 allow_unknown = F_ALLOW_UNKNOWN 1417 allow_unknown = F_ALLOW_UNKNOWN
1418 allow_sharing = F_ALLOW_SHARING
1419 allow_cycles = F_ALLOW_CYCLES
1420 pack_strings = F_PACK_STRINGS
1421 utf8_strings = F_UTF8_STRINGS
1422 validate_utf8 = F_VALIDATE_UTF8
878 PPCODE: 1423 PPCODE:
879{ 1424{
880 if (enable) 1425 if (enable)
881 self->flags |= ix; 1426 self->flags |= ix;
882 else 1427 else
887 1432
888void get_shrink (CBOR *self) 1433void get_shrink (CBOR *self)
889 ALIAS: 1434 ALIAS:
890 get_shrink = F_SHRINK 1435 get_shrink = F_SHRINK
891 get_allow_unknown = F_ALLOW_UNKNOWN 1436 get_allow_unknown = F_ALLOW_UNKNOWN
1437 get_allow_sharing = F_ALLOW_SHARING
1438 get_allow_cycles = F_ALLOW_CYCLES
1439 get_pack_strings = F_PACK_STRINGS
1440 get_validate_utf8 = F_VALIDATE_UTF8
892 PPCODE: 1441 PPCODE:
893 XPUSHs (boolSV (self->flags & ix)); 1442 XPUSHs (boolSV (self->flags & ix));
894 1443
895void max_depth (CBOR *self, U32 max_depth = 0x80000000UL) 1444void max_depth (CBOR *self, U32 max_depth = 0x80000000UL)
896 PPCODE: 1445 PPCODE:
912 CODE: 1461 CODE:
913 RETVAL = self->max_size; 1462 RETVAL = self->max_size;
914 OUTPUT: 1463 OUTPUT:
915 RETVAL 1464 RETVAL
916 1465
917#if 0 //TODO 1466void filter (CBOR *self, SV *filter = 0)
918
919void filter_cbor_object (CBOR *self, SV *cb = &PL_sv_undef)
920 PPCODE: 1467 PPCODE:
921{
922 SvREFCNT_dec (self->cb_object); 1468 SvREFCNT_dec (self->filter);
923 self->cb_object = SvOK (cb) ? newSVsv (cb) : 0; 1469 self->filter = filter ? newSVsv (filter) : filter;
924
925 XPUSHs (ST (0)); 1470 XPUSHs (ST (0));
926}
927 1471
928void filter_cbor_single_key_object (CBOR *self, SV *key, SV *cb = &PL_sv_undef) 1472SV *get_filter (CBOR *self)
929 PPCODE: 1473 CODE:
930{ 1474 RETVAL = self->filter ? self->filter : NEWSV (0, 0);
931 if (!self->cb_sk_object) 1475 OUTPUT:
932 self->cb_sk_object = newHV (); 1476 RETVAL
933
934 if (SvOK (cb))
935 hv_store_ent (self->cb_sk_object, key, newSVsv (cb), 0);
936 else
937 {
938 hv_delete_ent (self->cb_sk_object, key, G_DISCARD, 0);
939
940 if (!HvKEYS (self->cb_sk_object))
941 {
942 SvREFCNT_dec (self->cb_sk_object);
943 self->cb_sk_object = 0;
944 }
945 }
946
947 XPUSHs (ST (0));
948}
949
950#endif
951 1477
952void encode (CBOR *self, SV *scalar) 1478void encode (CBOR *self, SV *scalar)
953 PPCODE: 1479 PPCODE:
954 PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN; 1480 PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN;
955 XPUSHs (scalar); 1481 XPUSHs (scalar);
968 EXTEND (SP, 2); 1494 EXTEND (SP, 2);
969 PUSHs (sv); 1495 PUSHs (sv);
970 PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr)))); 1496 PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr))));
971} 1497}
972 1498
973#if 0 1499void incr_parse (CBOR *self, SV *cborstr)
1500 ALIAS:
1501 incr_parse_multiple = 1
1502 PPCODE:
1503{
1504 if (SvUTF8 (cborstr))
1505 sv_utf8_downgrade (cborstr, 0);
1506
1507 if (!self->incr_count)
1508 {
1509 self->incr_count = newAV ();
1510 self->incr_pos = 0;
1511 self->incr_need = 1;
1512
1513 av_push (self->incr_count, newSViv (1));
1514 }
1515
1516 do
1517 {
1518 if (!incr_parse (self, cborstr))
1519 {
1520 if (self->incr_need > self->max_size && self->max_size)
1521 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
1522 (unsigned long)self->incr_need, (unsigned long)self->max_size);
1523
1524 break;
1525 }
1526
1527 SV *sv;
1528 char *offset;
1529
1530 PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
1531 XPUSHs (sv);
1532
1533 sv_chop (cborstr, offset);
1534
1535 av_clear (self->incr_count);
1536 av_push (self->incr_count, newSViv (1));
1537
1538 self->incr_pos = 0;
1539 self->incr_need = self->incr_pos + 1;
1540 }
1541 while (ix);
1542}
1543
1544void incr_reset (CBOR *self)
1545 CODE:
1546{
1547 SvREFCNT_dec (self->incr_count);
1548 self->incr_count = 0;
1549}
974 1550
975void DESTROY (CBOR *self) 1551void DESTROY (CBOR *self)
976 CODE: 1552 PPCODE:
977 SvREFCNT_dec (self->cb_sk_object); 1553 cbor_free (self);
978 SvREFCNT_dec (self->cb_object);
979
980#endif
981 1554
982PROTOTYPES: ENABLE 1555PROTOTYPES: ENABLE
983 1556
984void encode_cbor (SV *scalar) 1557void encode_cbor (SV *scalar)
1558 ALIAS:
1559 encode_cbor = 0
1560 encode_cbor_sharing = F_ALLOW_SHARING
985 PPCODE: 1561 PPCODE:
986{ 1562{
987 CBOR cbor; 1563 CBOR cbor;
988 cbor_init (&cbor); 1564 cbor_init (&cbor);
1565 cbor.flags |= ix;
989 PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN; 1566 PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN;
990 XPUSHs (scalar); 1567 XPUSHs (scalar);
991} 1568}
992 1569
993void decode_cbor (SV *cborstr) 1570void decode_cbor (SV *cborstr)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines