ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/CBOR-XS/XS.xs
Revision: 1.71
Committed: Fri Mar 19 17:30:27 2021 UTC (3 years, 1 month ago) by root
Branch: MAIN
Changes since 1.70: +3 -2 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include <assert.h>
6 #include <string.h>
7 #include <stdlib.h>
8 #include <stdio.h>
9 #include <limits.h>
10 #include <float.h>
11 #include <inttypes.h>
12
13 #define ECB_NO_THREADS 1
14 #include "ecb.h"
15
16 // compatibility with perl <5.18
17 #ifndef HvNAMELEN_get
18 # define HvNAMELEN_get(hv) strlen (HvNAME (hv))
19 #endif
20 #ifndef HvNAMELEN
21 # define HvNAMELEN(hv) HvNAMELEN_get (hv)
22 #endif
23 #ifndef HvNAMEUTF8
24 # define HvNAMEUTF8(hv) 0
25 #endif
26 #ifndef SvREFCNT_inc_NN
27 # define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
28 #endif
29 #ifndef SvREFCNT_dec_NN
30 # define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
31 #endif
32
33 // known major and minor types
34 enum cbor_type
35 {
36 MAJOR_SHIFT = 5,
37 MINOR_MASK = 0x1f,
38
39 MAJOR_POS_INT = 0 << MAJOR_SHIFT,
40 MAJOR_NEG_INT = 1 << MAJOR_SHIFT,
41 MAJOR_BYTES = 2 << MAJOR_SHIFT,
42 MAJOR_TEXT = 3 << MAJOR_SHIFT,
43 MAJOR_ARRAY = 4 << MAJOR_SHIFT,
44 MAJOR_MAP = 5 << MAJOR_SHIFT,
45 MAJOR_TAG = 6 << MAJOR_SHIFT,
46 MAJOR_MISC = 7 << MAJOR_SHIFT,
47
48 // INT/STRING/ARRAY/MAP subtypes
49 LENGTH_EXT1 = 24,
50 LENGTH_EXT2 = 25,
51 LENGTH_EXT4 = 26,
52 LENGTH_EXT8 = 27,
53
54 // SIMPLE types (effectively MISC subtypes)
55 SIMPLE_FALSE = 20,
56 SIMPLE_TRUE = 21,
57 SIMPLE_NULL = 22,
58 SIMPLE_UNDEF = 23,
59
60 // MISC subtype (unused)
61 MISC_EXT1 = 24,
62 MISC_FLOAT16 = 25,
63 MISC_FLOAT32 = 26,
64 MISC_FLOAT64 = 27,
65
66 // BYTES/TEXT/ARRAY/MAP
67 MINOR_INDEF = 31,
68 };
69
70 // known tags
71 enum cbor_tag
72 {
73 // extensions
74 CBOR_TAG_STRINGREF = 25, // http://cbor.schmorp.de/stringref
75 CBOR_TAG_PERL_OBJECT = 26, // http://cbor.schmorp.de/perl-object
76 CBOR_TAG_GENERIC_OBJECT = 27, // http://cbor.schmorp.de/generic-object
77 CBOR_TAG_VALUE_SHAREABLE = 28, // http://cbor.schmorp.de/value-sharing
78 CBOR_TAG_VALUE_SHAREDREF = 29, // http://cbor.schmorp.de/value-sharing
79 CBOR_TAG_STRINGREF_NAMESPACE = 256, // http://cbor.schmorp.de/stringref
80 CBOR_TAG_INDIRECTION = 22098, // http://cbor.schmorp.de/indirection
81
82 // rfc7049
83 CBOR_TAG_DATETIME = 0, // rfc4287, utf-8
84 CBOR_TAG_TIMESTAMP = 1, // unix timestamp, any
85 CBOR_TAG_POS_BIGNUM = 2, // byte string
86 CBOR_TAG_NEG_BIGNUM = 3, // byte string
87 CBOR_TAG_DECIMAL = 4, // decimal fraction, array
88 CBOR_TAG_BIGFLOAT = 5, // array
89
90 CBOR_TAG_CONV_B64U = 21, // base64url, any
91 CBOR_TAG_CONV_B64 = 22, // base64, any
92 CBOR_TAG_CONV_HEX = 23, // base16, any
93 CBOR_TAG_CBOR = 24, // embedded cbor, byte string
94
95 CBOR_TAG_URI = 32, // URI rfc3986, utf-8
96 CBOR_TAG_B64U = 33, // base64url rfc4648, utf-8
97 CBOR_TAG_B64 = 34, // base6 rfc46484, utf-8
98 CBOR_TAG_REGEX = 35, // regex pcre/ecma262, utf-8
99 CBOR_TAG_MIME = 36, // mime message rfc2045, utf-8
100
101 CBOR_TAG_MAGIC = 55799, // self-describe cbor
102 };
103
104 // known forced types, also hardcoded in CBOR.pm
105 enum
106 {
107 AS_CBOR = 0,
108 AS_INT = 1,
109 AS_BYTES = 2,
110 AS_TEXT = 3,
111 AS_FLOAT16 = 4,
112 AS_FLOAT32 = 5,
113 AS_FLOAT64 = 6,
114 AS_MAP = 7,
115 // possibly future enhancements: (generic) float, (generic) string
116 };
117
118 #define F_SHRINK 0x00000001UL
119 #define F_ALLOW_UNKNOWN 0x00000002UL
120 #define F_ALLOW_SHARING 0x00000004UL
121 #define F_ALLOW_CYCLES 0x00000008UL
122 #define F_FORBID_OBJECTS 0x00000010UL
123 #define F_PACK_STRINGS 0x00000020UL
124 #define F_TEXT_KEYS 0x00000040UL
125 #define F_TEXT_STRINGS 0x00000080UL
126 #define F_VALIDATE_UTF8 0x00000100UL
127
128 #define INIT_SIZE 32 // initial scalar size to be allocated
129
130 #define SB do {
131 #define SE } while (0)
132
133 #define IN_RANGE_INC(type,val,beg,end) \
134 ((unsigned type)((unsigned type)(val) - (unsigned type)(beg)) \
135 <= (unsigned type)((unsigned type)(end) - (unsigned type)(beg)))
136
137 #define ERR_NESTING_EXCEEDED "cbor text or perl structure exceeds maximum nesting level (max_depth set too low?)"
138
139 #ifdef USE_ITHREADS
140 # define CBOR_SLOW 1
141 # define CBOR_STASH (cbor_stash ? cbor_stash : gv_stashpv ("CBOR::XS", 1))
142 #else
143 # define CBOR_SLOW 0
144 # define CBOR_STASH cbor_stash
145 #endif
146
147 static HV *cbor_stash, *types_boolean_stash, *types_error_stash, *cbor_tagged_stash; // CBOR::XS::
148 static SV *types_true, *types_false, *types_error, *sv_cbor, *default_filter;
149
150 typedef struct {
151 U32 flags;
152 U32 max_depth;
153 STRLEN max_size;
154 SV *filter;
155
156 // for the incremental parser
157 STRLEN incr_pos; // the current offset into the text
158 STRLEN incr_need; // minimum bytes needed to decode
159 AV *incr_count; // for every nesting level, the number of outstanding values, or -1 for indef.
160 } CBOR;
161
162 ecb_inline void
163 cbor_init (CBOR *cbor)
164 {
165 Zero (cbor, 1, CBOR);
166 cbor->max_depth = 512;
167 }
168
169 ecb_inline void
170 cbor_free (CBOR *cbor)
171 {
172 SvREFCNT_dec (cbor->filter);
173 SvREFCNT_dec (cbor->incr_count);
174 }
175
176 /////////////////////////////////////////////////////////////////////////////
177 // utility functions
178
179 ecb_inline SV *
180 get_bool (const char *name)
181 {
182 SV *sv = get_sv (name, 1);
183
184 SvREADONLY_on (sv);
185 SvREADONLY_on (SvRV (sv));
186
187 return sv;
188 }
189
190 ecb_inline void
191 shrink (SV *sv)
192 {
193 sv_utf8_downgrade (sv, 1);
194
195 if (SvLEN (sv) > SvCUR (sv) + 1)
196 {
197 #ifdef SvPV_shrink_to_cur
198 SvPV_shrink_to_cur (sv);
199 #elif defined (SvPV_renew)
200 SvPV_renew (sv, SvCUR (sv) + 1);
201 #endif
202 }
203 }
204
205 // minimum length of a string to be registered for stringref
206 ecb_inline STRLEN
207 minimum_string_length (UV idx)
208 {
209 return idx <= 23 ? 3
210 : idx <= 0xffU ? 4
211 : idx <= 0xffffU ? 5
212 : idx <= 0xffffffffU ? 7
213 : 11;
214 }
215
216 /////////////////////////////////////////////////////////////////////////////
217 // encoder
218
219 // structure used for encoding CBOR
220 typedef struct
221 {
222 char *cur; // SvPVX (sv) + current output position
223 char *end; // SvEND (sv)
224 SV *sv; // result scalar
225 CBOR cbor;
226 U32 depth; // recursion level
227 HV *stringref[2]; // string => index, or 0 ([0] = bytes, [1] = utf-8)
228 UV stringref_idx;
229 HV *shareable; // ptr => index, or 0
230 UV shareable_idx;
231 } enc_t;
232
233 ecb_inline void
234 need (enc_t *enc, STRLEN len)
235 {
236 if (ecb_expect_false ((uintptr_t)(enc->end - enc->cur) < len))
237 {
238 STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
239 SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
240 enc->cur = SvPVX (enc->sv) + cur;
241 enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
242 }
243 }
244
245 static void encode_sv (enc_t *enc, SV *sv);
246
247 ecb_inline void
248 encode_ch (enc_t *enc, char ch)
249 {
250 need (enc, 1);
251 *enc->cur++ = ch;
252 }
253
254 // used for tags, intregers, element counts and so on
255 static void
256 encode_uint (enc_t *enc, int major, UV len)
257 {
258 need (enc, 9);
259
260 if (ecb_expect_true (len < LENGTH_EXT1))
261 *enc->cur++ = major | len;
262 else if (ecb_expect_true (len <= 0xffU))
263 {
264 *enc->cur++ = major | LENGTH_EXT1;
265 *enc->cur++ = len;
266 }
267 else if (len <= 0xffffU)
268 {
269 *enc->cur++ = major | LENGTH_EXT2;
270 *enc->cur++ = len >> 8;
271 *enc->cur++ = len;
272 }
273 else if (len <= 0xffffffffU)
274 {
275 *enc->cur++ = major | LENGTH_EXT4;
276 *enc->cur++ = len >> 24;
277 *enc->cur++ = len >> 16;
278 *enc->cur++ = len >> 8;
279 *enc->cur++ = len;
280 }
281 else
282 {
283 *enc->cur++ = major | LENGTH_EXT8;
284 *enc->cur++ = len >> 56;
285 *enc->cur++ = len >> 48;
286 *enc->cur++ = len >> 40;
287 *enc->cur++ = len >> 32;
288 *enc->cur++ = len >> 24;
289 *enc->cur++ = len >> 16;
290 *enc->cur++ = len >> 8;
291 *enc->cur++ = len;
292 }
293 }
294
295 // encodes a perl value into a CBOR integer
296 ecb_inline void
297 encode_int (enc_t *enc, SV *sv)
298 {
299 if (SvIsUV (sv))
300 encode_uint (enc, MAJOR_POS_INT, SvUVX (sv));
301 else if (SvIVX (sv) >= 0)
302 encode_uint (enc, MAJOR_POS_INT, SvIVX (sv));
303 else
304 encode_uint (enc, MAJOR_NEG_INT, -(SvIVX (sv) + 1));
305 }
306
307 ecb_inline void
308 encode_tag (enc_t *enc, UV tag)
309 {
310 encode_uint (enc, MAJOR_TAG, tag);
311 }
312
313 // exceptional (hopefully) slow path for byte strings that need to be utf8-encoded
314 ecb_noinline static void
315 encode_str_utf8 (enc_t *enc, int utf8, char *str, STRLEN len)
316 {
317 STRLEN ulen = len;
318 U8 *p, *pend = (U8 *)str + len;
319
320 for (p = (U8 *)str; p < pend; ++p)
321 ulen += *p >> 7; // count set high bits
322
323 encode_uint (enc, MAJOR_TEXT, ulen);
324
325 need (enc, ulen);
326 for (p = (U8 *)str; p < pend; ++p)
327 if (*p < 0x80)
328 *enc->cur++ = *p;
329 else
330 {
331 *enc->cur++ = 0xc0 + (*p >> 6);
332 *enc->cur++ = 0x80 + (*p & 63);
333 }
334 }
335
336 ecb_inline void
337 encode_str (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
338 {
339 if (ecb_expect_false (upgrade_utf8))
340 if (!utf8)
341 {
342 encode_str_utf8 (enc, utf8, str, len);
343 return;
344 }
345
346 encode_uint (enc, utf8 ? MAJOR_TEXT : MAJOR_BYTES, len);
347 need (enc, len);
348 memcpy (enc->cur, str, len);
349 enc->cur += len;
350 }
351
352 ecb_inline void
353 encode_strref (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
354 {
355 if (ecb_expect_false (enc->cbor.flags & F_PACK_STRINGS))
356 {
357 SV **svp = hv_fetch (enc->stringref[!!utf8], str, len, 1);
358
359 if (SvOK (*svp))
360 {
361 // already registered, use stringref
362 encode_tag (enc, CBOR_TAG_STRINGREF);
363 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
364 return;
365 }
366 else if (len >= minimum_string_length (enc->stringref_idx))
367 {
368 // register only
369 sv_setuv (*svp, enc->stringref_idx);
370 ++enc->stringref_idx;
371 }
372 }
373
374 encode_str (enc, upgrade_utf8, utf8, str, len);
375 }
376
377 ecb_inline void
378 encode_float16 (enc_t *enc, NV nv)
379 {
380 need (enc, 1+2);
381
382 *enc->cur++ = MAJOR_MISC | MISC_FLOAT16;
383
384 uint16_t fp = ecb_float_to_binary16 (nv);
385
386 if (!ecb_big_endian ())
387 fp = ecb_bswap16 (fp);
388
389 memcpy (enc->cur, &fp, 2);
390 enc->cur += 2;
391 }
392
393 ecb_inline void
394 encode_float32 (enc_t *enc, NV nv)
395 {
396 need (enc, 1+4);
397
398 *enc->cur++ = MAJOR_MISC | MISC_FLOAT32;
399
400 uint32_t fp = ecb_float_to_binary32 (nv);
401
402 if (!ecb_big_endian ())
403 fp = ecb_bswap32 (fp);
404
405 memcpy (enc->cur, &fp, 4);
406 enc->cur += 4;
407 }
408
409 ecb_inline void
410 encode_float64 (enc_t *enc, NV nv)
411 {
412 need (enc, 1+8);
413
414 *enc->cur++ = MAJOR_MISC | MISC_FLOAT64;
415
416 uint64_t fp = ecb_double_to_binary64 (nv);
417
418 if (!ecb_big_endian ())
419 fp = ecb_bswap64 (fp);
420
421 memcpy (enc->cur, &fp, 8);
422 enc->cur += 8;
423 }
424
425 ecb_inline void
426 encode_bool (enc_t *enc, int istrue)
427 {
428 encode_ch (enc, istrue ? MAJOR_MISC | SIMPLE_TRUE : MAJOR_MISC | SIMPLE_FALSE);
429 }
430
431 // encodes an arrayref containing key-value pairs as CBOR map
432 ecb_inline void
433 encode_array_as_map (enc_t *enc, SV *sv)
434 {
435 if (enc->depth >= enc->cbor.max_depth)
436 croak (ERR_NESTING_EXCEEDED);
437
438 ++enc->depth;
439
440 // as_map does error checking for us, but we re-check in case
441 // things have changed.
442
443 if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
444 croak ("CBOR::XS::as_map requires an array reference (did you change the array after calling as_map?)");
445
446 AV *av = (AV *)SvRV (sv);
447 int i, len = av_len (av);
448
449 if (!(len & 1))
450 croak ("CBOR::XS::as_map requires an even number of elements (did you change the array after calling as_map?)");
451
452 encode_uint (enc, MAJOR_MAP, (len + 1) >> 1);
453
454 for (i = 0; i <= len; ++i)
455 {
456 SV **svp = av_fetch (av, i, 0);
457 encode_sv (enc, svp ? *svp : &PL_sv_undef);
458 }
459
460 --enc->depth;
461 }
462
463 ecb_inline void
464 encode_forced (enc_t *enc, UV type, SV *sv)
465 {
466 switch (type)
467 {
468 case AS_CBOR:
469 {
470 STRLEN len;
471 char *str = SvPVbyte (sv, len);
472
473 need (enc, len);
474 memcpy (enc->cur, str, len);
475 enc->cur += len;
476 }
477 break;
478
479 case AS_BYTES:
480 {
481 STRLEN len;
482 char *str = SvPVbyte (sv, len);
483 encode_strref (enc, 0, 0, str, len);
484 }
485 break;
486
487 case AS_TEXT:
488 {
489 STRLEN len;
490 char *str = SvPVutf8 (sv, len);
491 encode_strref (enc, 1, 1, str, len);
492 }
493 break;
494
495 case AS_INT: encode_int (enc, sv); break;
496
497 case AS_FLOAT16: encode_float16 (enc, SvNV (sv)); break;
498 case AS_FLOAT32: encode_float32 (enc, SvNV (sv)); break;
499 case AS_FLOAT64: encode_float64 (enc, SvNV (sv)); break;
500
501 case AS_MAP: encode_array_as_map (enc, sv); break;
502
503 default:
504 croak ("encountered malformed CBOR::XS::Tagged object");
505 }
506 }
507
508 static void
509 encode_av (enc_t *enc, AV *av)
510 {
511 int i, len = av_len (av);
512
513 if (enc->depth >= enc->cbor.max_depth)
514 croak (ERR_NESTING_EXCEEDED);
515
516 ++enc->depth;
517
518 encode_uint (enc, MAJOR_ARRAY, len + 1);
519
520 if (ecb_expect_false (SvMAGICAL (av)))
521 for (i = 0; i <= len; ++i)
522 {
523 SV **svp = av_fetch (av, i, 0);
524 encode_sv (enc, svp ? *svp : &PL_sv_undef);
525 }
526 else
527 for (i = 0; i <= len; ++i)
528 {
529 SV *sv = AvARRAY (av)[i];
530 encode_sv (enc, sv ? sv : &PL_sv_undef);
531 }
532
533 --enc->depth;
534 }
535
536 static void
537 encode_hv (enc_t *enc, HV *hv)
538 {
539 HE *he;
540
541 if (enc->depth >= enc->cbor.max_depth)
542 croak (ERR_NESTING_EXCEEDED);
543
544 ++enc->depth;
545
546 int pairs = hv_iterinit (hv);
547 int mg = SvMAGICAL (hv);
548
549 if (ecb_expect_false (mg))
550 encode_ch (enc, MAJOR_MAP | MINOR_INDEF);
551 else
552 encode_uint (enc, MAJOR_MAP, pairs);
553
554 while ((he = hv_iternext (hv)))
555 {
556 if (HeKLEN (he) == HEf_SVKEY)
557 encode_sv (enc, HeSVKEY (he));
558 else
559 encode_strref (enc, enc->cbor.flags & (F_TEXT_KEYS | F_TEXT_STRINGS), HeKUTF8 (he), HeKEY (he), HeKLEN (he));
560
561 encode_sv (enc, ecb_expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he));
562 }
563
564 if (ecb_expect_false (mg))
565 encode_ch (enc, MAJOR_MISC | MINOR_INDEF);
566
567 --enc->depth;
568 }
569
570 // encode objects, arrays and special \0=false and \1=true values.
571 static void
572 encode_rv (enc_t *enc, SV *sv)
573 {
574 SvGETMAGIC (sv);
575
576 svtype svt = SvTYPE (sv);
577
578 if (ecb_expect_false (SvOBJECT (sv)))
579 {
580 HV *boolean_stash = !CBOR_SLOW || types_boolean_stash
581 ? types_boolean_stash
582 : gv_stashpv ("Types::Serialiser::Boolean", 1);
583 HV *error_stash = !CBOR_SLOW || types_error_stash
584 ? types_error_stash
585 : gv_stashpv ("Types::Serialiser::Error", 1);
586 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
587 ? cbor_tagged_stash
588 : gv_stashpv ("CBOR::XS::Tagged" , 1);
589
590 HV *stash = SvSTASH (sv);
591
592 if (stash == boolean_stash)
593 {
594 encode_bool (enc, SvIV (sv));
595 return;
596 }
597 else if (stash == error_stash)
598 {
599 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
600 return;
601 }
602 else if (stash == tagged_stash)
603 {
604 if (svt != SVt_PVAV)
605 croak ("encountered CBOR::XS::Tagged object that isn't an array");
606
607 switch (av_len ((AV *)sv))
608 {
609 case 2-1:
610 // actually a tagged value
611 encode_uint (enc, MAJOR_TAG, SvUV (*av_fetch ((AV *)sv, 0, 1)));
612 encode_sv (enc, *av_fetch ((AV *)sv, 1, 1));
613 break;
614
615 case 3-1:
616 // a forced type [value, type, undef]
617 encode_forced (enc, SvUV (*av_fetch ((AV *)sv, 1, 1)), *av_fetch ((AV *)sv, 0, 1));
618 break;
619
620 default:
621 croak ("encountered malformed CBOR::XS::Tagged object");
622 }
623
624 return;
625 }
626 }
627
628 if (ecb_expect_false (SvREFCNT (sv) > 1)
629 && ecb_expect_false (enc->cbor.flags & F_ALLOW_SHARING))
630 {
631 if (ecb_expect_false (!enc->shareable))
632 enc->shareable = (HV *)sv_2mortal ((SV *)newHV ());
633
634 SV **svp = hv_fetch (enc->shareable, (char *)&sv, sizeof (sv), 1);
635
636 if (SvOK (*svp))
637 {
638 encode_tag (enc, CBOR_TAG_VALUE_SHAREDREF);
639 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
640 return;
641 }
642 else
643 {
644 sv_setuv (*svp, enc->shareable_idx);
645 ++enc->shareable_idx;
646 encode_tag (enc, CBOR_TAG_VALUE_SHAREABLE);
647 }
648 }
649
650 if (ecb_expect_false (SvOBJECT (sv)))
651 {
652 HV *stash = SvSTASH (sv);
653 GV *method;
654
655 if (enc->cbor.flags & F_FORBID_OBJECTS)
656 croak ("encountered object '%s', but forbid_objects is enabled",
657 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
658 else if ((method = gv_fetchmethod_autoload (stash, "TO_CBOR", 0)))
659 {
660 dSP;
661
662 ENTER; SAVETMPS;
663 PUSHMARK (SP);
664 // we re-bless the reference to get overload and other niceties right
665 XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
666
667 PUTBACK;
668 // G_SCALAR ensures that return value is 1
669 call_sv ((SV *)GvCV (method), G_SCALAR);
670 SPAGAIN;
671
672 // catch this surprisingly common error
673 if (SvROK (TOPs) && SvRV (TOPs) == sv)
674 croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (stash));
675
676 encode_sv (enc, POPs);
677
678 PUTBACK;
679
680 FREETMPS; LEAVE;
681 }
682 else if ((method = gv_fetchmethod_autoload (stash, "FREEZE", 0)) != 0)
683 {
684 dSP;
685
686 ENTER; SAVETMPS;
687 PUSHMARK (SP);
688 EXTEND (SP, 2);
689 // we re-bless the reference to get overload and other niceties right
690 PUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
691 PUSHs (sv_cbor);
692
693 PUTBACK;
694 int count = call_sv ((SV *)GvCV (method), G_ARRAY);
695 SPAGAIN;
696
697 // catch this surprisingly common error
698 if (count == 1 && SvROK (TOPs) && SvRV (TOPs) == sv)
699 croak ("%s::FREEZE(CBOR) method returned same object as was passed instead of a new one", HvNAME (stash));
700
701 encode_tag (enc, CBOR_TAG_PERL_OBJECT);
702 encode_uint (enc, MAJOR_ARRAY, count + 1);
703 encode_strref (enc, 0, HvNAMEUTF8 (stash), HvNAME (stash), HvNAMELEN (stash));
704
705 {
706 int i;
707
708 for (i = 0; i < count; ++i)
709 encode_sv (enc, SP[i + 1 - count]);
710
711 SP -= count;
712 }
713
714 PUTBACK;
715
716 FREETMPS; LEAVE;
717 }
718 else
719 croak ("encountered object '%s', but no TO_CBOR or FREEZE methods available on it",
720 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
721 }
722 else if (svt == SVt_PVHV)
723 encode_hv (enc, (HV *)sv);
724 else if (svt == SVt_PVAV)
725 encode_av (enc, (AV *)sv);
726 else
727 {
728 encode_tag (enc, CBOR_TAG_INDIRECTION);
729 encode_sv (enc, sv);
730 }
731 }
732
733 static void
734 encode_nv (enc_t *enc, SV *sv)
735 {
736 double nv = SvNVX (sv);
737
738 need (enc, 9);
739
740 if (ecb_expect_false (nv == (NV)(U32)nv))
741 encode_uint (enc, MAJOR_POS_INT, (U32)nv);
742 //TODO: maybe I32?
743 else if (ecb_expect_false (nv == (float)nv))
744 encode_float32 (enc, nv);
745 else
746 encode_float64 (enc, nv);
747 }
748
749 static void
750 encode_sv (enc_t *enc, SV *sv)
751 {
752 SvGETMAGIC (sv);
753
754 if (SvPOKp (sv))
755 {
756 STRLEN len;
757 char *str = SvPV (sv, len);
758 encode_strref (enc, enc->cbor.flags & F_TEXT_STRINGS, SvUTF8 (sv), str, len);
759 }
760 else if (SvNOKp (sv))
761 encode_nv (enc, sv);
762 else if (SvIOKp (sv))
763 encode_int (enc, sv);
764 else if (SvROK (sv))
765 encode_rv (enc, SvRV (sv));
766 else if (!SvOK (sv))
767 encode_ch (enc, MAJOR_MISC | SIMPLE_NULL);
768 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
769 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
770 else
771 croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data",
772 SvPV_nolen (sv), (unsigned int)SvFLAGS (sv));
773 }
774
775 static SV *
776 encode_cbor (SV *scalar, CBOR *cbor)
777 {
778 enc_t enc = { 0 };
779
780 enc.cbor = *cbor;
781 enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
782 enc.cur = SvPVX (enc.sv);
783 enc.end = SvEND (enc.sv);
784
785 SvPOK_only (enc.sv);
786
787 if (cbor->flags & F_PACK_STRINGS)
788 {
789 encode_tag (&enc, CBOR_TAG_STRINGREF_NAMESPACE);
790 enc.stringref[0]= (HV *)sv_2mortal ((SV *)newHV ());
791 enc.stringref[1]= (HV *)sv_2mortal ((SV *)newHV ());
792 }
793
794 encode_sv (&enc, scalar);
795
796 SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
797 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
798
799 if (enc.cbor.flags & F_SHRINK)
800 shrink (enc.sv);
801
802 return enc.sv;
803 }
804
805 /////////////////////////////////////////////////////////////////////////////
806 // decoder
807
808 // structure used for decoding CBOR
809 typedef struct
810 {
811 U8 *cur; // current parser pointer
812 U8 *end; // end of input string
813 const char *err; // parse error, if != 0
814 CBOR cbor;
815 U32 depth; // recursion depth
816 U32 maxdepth; // recursion depth limit
817 AV *shareable;
818 AV *stringref;
819 SV *decode_tagged;
820 SV *err_sv; // optional sv for error, needs to be freed
821 } dec_t;
822
823 // set dec->err to ERRSV
824 ecb_cold static void
825 err_errsv (dec_t *dec)
826 {
827 if (!dec->err)
828 {
829 dec->err_sv = newSVsv (ERRSV);
830
831 // chop off the trailing \n
832 SvCUR_set (dec->err_sv, SvCUR (dec->err_sv) - 1);
833 *SvEND (dec->err_sv) = 0;
834
835 dec->err = SvPVutf8_nolen (dec->err_sv);
836 }
837 }
838
839 // the following functions are used to reduce code size and help the compiler to optimise
840 ecb_cold static void
841 err_set (dec_t *dec, const char *reason)
842 {
843 if (!dec->err)
844 dec->err = reason;
845 }
846
847 ecb_cold static void
848 err_unexpected_end (dec_t *dec)
849 {
850 err_set (dec, "unexpected end of CBOR data");
851 }
852
853 #define ERR_DO(do) SB do; goto fail; SE
854 #define ERR(reason) ERR_DO (err_set (dec, reason))
855 #define ERR_ERRSV ERR_DO (err_errsv (dec))
856
857 #define WANT(len) if (ecb_expect_false ((uintptr_t)(dec->end - dec->cur) < (STRLEN)len)) ERR_DO (err_unexpected_end (dec))
858
859 #define DEC_INC_DEPTH if (ecb_expect_false (++dec->depth > dec->cbor.max_depth)) ERR (ERR_NESTING_EXCEEDED)
860 #define DEC_DEC_DEPTH --dec->depth
861
862 static UV
863 decode_uint (dec_t *dec)
864 {
865 U8 m = *dec->cur & MINOR_MASK;
866 ++dec->cur;
867
868 if (ecb_expect_true (m < LENGTH_EXT1))
869 return m;
870 else if (ecb_expect_true (m == LENGTH_EXT1))
871 {
872 WANT (1);
873 dec->cur += 1;
874 return dec->cur[-1];
875 }
876 else if (ecb_expect_true (m == LENGTH_EXT2))
877 {
878 WANT (2);
879 dec->cur += 2;
880 return (((UV)dec->cur[-2]) << 8)
881 | ((UV)dec->cur[-1]);
882 }
883 else if (ecb_expect_true (m == LENGTH_EXT4))
884 {
885 WANT (4);
886 dec->cur += 4;
887 return (((UV)dec->cur[-4]) << 24)
888 | (((UV)dec->cur[-3]) << 16)
889 | (((UV)dec->cur[-2]) << 8)
890 | ((UV)dec->cur[-1]);
891 }
892 else if (ecb_expect_true (m == LENGTH_EXT8))
893 {
894 WANT (8);
895 dec->cur += 8;
896
897 return
898 #if UVSIZE < 8
899 0
900 #else
901 (((UV)dec->cur[-8]) << 56)
902 | (((UV)dec->cur[-7]) << 48)
903 | (((UV)dec->cur[-6]) << 40)
904 | (((UV)dec->cur[-5]) << 32)
905 #endif
906 | (((UV)dec->cur[-4]) << 24)
907 | (((UV)dec->cur[-3]) << 16)
908 | (((UV)dec->cur[-2]) << 8)
909 | ((UV)dec->cur[-1]);
910 }
911 else
912 ERR ("corrupted CBOR data (unsupported integer minor encoding)");
913
914 fail:
915 return 0;
916 }
917
918 static SV *decode_sv (dec_t *dec);
919
920 static SV *
921 decode_av (dec_t *dec)
922 {
923 AV *av = newAV ();
924
925 DEC_INC_DEPTH;
926
927 if (*dec->cur == (MAJOR_ARRAY | MINOR_INDEF))
928 {
929 ++dec->cur;
930
931 for (;;)
932 {
933 WANT (1);
934
935 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF) || dec->err)
936 {
937 ++dec->cur;
938 break;
939 }
940
941 av_push (av, decode_sv (dec));
942 }
943 }
944 else
945 {
946 UV i, len = decode_uint (dec);
947
948 WANT (len); // complexity check for av_fill - need at least one byte per value, do not allow supersize arrays
949 av_fill (av, len - 1);
950
951 for (i = 0; i < len; ++i)
952 AvARRAY (av)[i] = decode_sv (dec);
953 }
954
955 DEC_DEC_DEPTH;
956 return newRV_noinc ((SV *)av);
957
958 fail:
959 SvREFCNT_dec_NN (av);
960 DEC_DEC_DEPTH;
961 return &PL_sv_undef;
962 }
963
964 static void
965 decode_he (dec_t *dec, HV *hv)
966 {
967 // for speed reasons, we specialcase single-string
968 // byte or utf-8 strings as keys, but only when !stringref
969
970 if (ecb_expect_true (!dec->stringref))
971 if (ecb_expect_true ((U8)(*dec->cur - MAJOR_BYTES) <= LENGTH_EXT8))
972 {
973 STRLEN len = decode_uint (dec);
974 char *key = (char *)dec->cur;
975
976 WANT (len);
977 dec->cur += len;
978
979 hv_store (hv, key, len, decode_sv (dec), 0);
980
981 return;
982 }
983 else if (ecb_expect_true ((U8)(*dec->cur - MAJOR_TEXT) <= LENGTH_EXT8))
984 {
985 STRLEN len = decode_uint (dec);
986 char *key = (char *)dec->cur;
987
988 WANT (len);
989 dec->cur += len;
990
991 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
992 if (!is_utf8_string ((U8 *)key, len))
993 ERR ("corrupted CBOR data (invalid UTF-8 in map key)");
994
995 hv_store (hv, key, -len, decode_sv (dec), 0);
996
997 return;
998 }
999
1000 SV *k = decode_sv (dec);
1001 SV *v = decode_sv (dec);
1002
1003 // we leak memory if uncaught exceptions are thrown by random magical
1004 // methods, and this is hopefully the only place where it can happen,
1005 // so if there is a chance of an exception, take the very slow path.
1006 // since catching exceptions is "undocumented/internal/forbidden" by
1007 // the new p5p powers, we need to call out to a perl function :/
1008 if (ecb_expect_false (SvAMAGIC (k)))
1009 {
1010 dSP;
1011
1012 ENTER; SAVETMPS;
1013 PUSHMARK (SP);
1014 EXTEND (SP, 3);
1015 PUSHs (sv_2mortal (newRV_inc ((SV *)hv)));
1016 PUSHs (sv_2mortal (k));
1017 PUSHs (sv_2mortal (v));
1018
1019 PUTBACK;
1020 call_pv ("CBOR::XS::_hv_store", G_VOID | G_DISCARD | G_EVAL);
1021 SPAGAIN;
1022
1023 FREETMPS; LEAVE;
1024
1025 if (SvTRUE (ERRSV))
1026 ERR_ERRSV;
1027
1028 return;
1029 }
1030
1031 hv_store_ent (hv, k, v, 0);
1032 SvREFCNT_dec_NN (k);
1033
1034 fail:
1035 ;
1036 }
1037
1038 static SV *
1039 decode_hv (dec_t *dec)
1040 {
1041 HV *hv = newHV ();
1042
1043 DEC_INC_DEPTH;
1044
1045 if (*dec->cur == (MAJOR_MAP | MINOR_INDEF))
1046 {
1047 ++dec->cur;
1048
1049 for (;;)
1050 {
1051 WANT (1);
1052
1053 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF) || dec->err)
1054 {
1055 ++dec->cur;
1056 break;
1057 }
1058
1059 decode_he (dec, hv);
1060 }
1061 }
1062 else
1063 {
1064 UV pairs = decode_uint (dec);
1065
1066 WANT (pairs); // complexity check - need at least one byte per value, do not allow supersize hashes
1067
1068 while (pairs--)
1069 decode_he (dec, hv);
1070 }
1071
1072 DEC_DEC_DEPTH;
1073 return newRV_noinc ((SV *)hv);
1074
1075 fail:
1076 SvREFCNT_dec_NN (hv);
1077 DEC_DEC_DEPTH;
1078 return &PL_sv_undef;
1079 }
1080
1081 static SV *
1082 decode_str (dec_t *dec, int utf8)
1083 {
1084 SV *sv = 0;
1085
1086 if (ecb_expect_false ((*dec->cur & MINOR_MASK) == MINOR_INDEF))
1087 {
1088 // indefinite length strings
1089 ++dec->cur;
1090
1091 U8 major = *dec->cur & MAJOR_MISC;
1092
1093 sv = newSVpvn ("", 0);
1094
1095 for (;;)
1096 {
1097 WANT (1);
1098
1099 if ((*dec->cur - major) > LENGTH_EXT8)
1100 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
1101 {
1102 ++dec->cur;
1103 break;
1104 }
1105 else
1106 ERR ("corrupted CBOR data (invalid chunks in indefinite length string)");
1107
1108 STRLEN len = decode_uint (dec);
1109
1110 WANT (len);
1111 sv_catpvn (sv, dec->cur, len);
1112 dec->cur += len;
1113 }
1114 }
1115 else
1116 {
1117 STRLEN len = decode_uint (dec);
1118
1119 WANT (len);
1120 sv = newSVpvn (dec->cur, len);
1121 dec->cur += len;
1122
1123 if (ecb_expect_false (dec->stringref)
1124 && SvCUR (sv) >= minimum_string_length (AvFILLp (dec->stringref) + 1))
1125 av_push (dec->stringref, SvREFCNT_inc_NN (sv));
1126 }
1127
1128 if (utf8)
1129 {
1130 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
1131 if (!is_utf8_string (SvPVX (sv), SvCUR (sv)))
1132 ERR ("corrupted CBOR data (invalid UTF-8 in text string)");
1133
1134 SvUTF8_on (sv);
1135 }
1136
1137 return sv;
1138
1139 fail:
1140 SvREFCNT_dec (sv);
1141 return &PL_sv_undef;
1142 }
1143
1144 static SV *
1145 decode_tagged (dec_t *dec)
1146 {
1147 SV *sv = 0;
1148 UV tag = decode_uint (dec);
1149
1150 WANT (1);
1151
1152 switch (tag)
1153 {
1154 case CBOR_TAG_MAGIC:
1155 sv = decode_sv (dec);
1156 break;
1157
1158 case CBOR_TAG_INDIRECTION:
1159 sv = newRV_noinc (decode_sv (dec));
1160 break;
1161
1162 case CBOR_TAG_STRINGREF_NAMESPACE:
1163 {
1164 // do not use SAVETMPS/FREETMPS, as these will
1165 // erase mortalised caches, e.g. "shareable"
1166 ENTER;
1167
1168 SAVESPTR (dec->stringref);
1169 dec->stringref = (AV *)sv_2mortal ((SV *)newAV ());
1170
1171 sv = decode_sv (dec);
1172
1173 LEAVE;
1174 }
1175 break;
1176
1177 case CBOR_TAG_STRINGREF:
1178 {
1179 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
1180 ERR ("corrupted CBOR data (stringref index not an unsigned integer)");
1181
1182 UV idx = decode_uint (dec);
1183
1184 if (!dec->stringref || idx >= (UV)(1 + AvFILLp (dec->stringref)))
1185 ERR ("corrupted CBOR data (stringref index out of bounds or outside namespace)");
1186
1187 sv = newSVsv (AvARRAY (dec->stringref)[idx]);
1188 }
1189 break;
1190
1191 case CBOR_TAG_VALUE_SHAREABLE:
1192 {
1193 if (ecb_expect_false (!dec->shareable))
1194 dec->shareable = (AV *)sv_2mortal ((SV *)newAV ());
1195
1196 if (dec->cbor.flags & F_ALLOW_CYCLES)
1197 {
1198 sv = newSV (0);
1199 av_push (dec->shareable, SvREFCNT_inc_NN (sv));
1200
1201 SV *osv = decode_sv (dec);
1202 sv_setsv (sv, osv);
1203 SvREFCNT_dec_NN (osv);
1204 }
1205 else
1206 {
1207 av_push (dec->shareable, &PL_sv_undef);
1208 int idx = AvFILLp (dec->shareable);
1209 sv = decode_sv (dec);
1210 av_store (dec->shareable, idx, SvREFCNT_inc_NN (sv));
1211 }
1212 }
1213 break;
1214
1215 case CBOR_TAG_VALUE_SHAREDREF:
1216 {
1217 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
1218 ERR ("corrupted CBOR data (sharedref index not an unsigned integer)");
1219
1220 UV idx = decode_uint (dec);
1221
1222 if (!dec->shareable || idx >= (UV)(1 + AvFILLp (dec->shareable)))
1223 ERR ("corrupted CBOR data (sharedref index out of bounds)");
1224
1225 sv = SvREFCNT_inc_NN (AvARRAY (dec->shareable)[idx]);
1226
1227 if (sv == &PL_sv_undef)
1228 ERR ("cyclic CBOR data structure found, but allow_cycles is not enabled");
1229 }
1230 break;
1231
1232 case CBOR_TAG_PERL_OBJECT:
1233 {
1234 if (dec->cbor.flags & F_FORBID_OBJECTS)
1235 goto filter;
1236
1237 sv = decode_sv (dec);
1238
1239 if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
1240 ERR ("corrupted CBOR data (non-array perl object)");
1241
1242 AV *av = (AV *)SvRV (sv);
1243 int len = av_len (av) + 1;
1244 HV *stash = gv_stashsv (*av_fetch (av, 0, 1), 0);
1245
1246 if (!stash)
1247 ERR ("cannot decode perl-object (package does not exist)");
1248
1249 GV *method = gv_fetchmethod_autoload (stash, "THAW", 0);
1250
1251 if (!method)
1252 ERR ("cannot decode perl-object (package does not have a THAW method)");
1253
1254 dSP;
1255
1256 ENTER; SAVETMPS;
1257 PUSHMARK (SP);
1258 EXTEND (SP, len + 1);
1259 // we re-bless the reference to get overload and other niceties right
1260 PUSHs (*av_fetch (av, 0, 1));
1261 PUSHs (sv_cbor);
1262
1263 int i;
1264
1265 for (i = 1; i < len; ++i)
1266 PUSHs (*av_fetch (av, i, 1));
1267
1268 PUTBACK;
1269 call_sv ((SV *)GvCV (method), G_SCALAR | G_EVAL);
1270 SPAGAIN;
1271
1272 if (SvTRUE (ERRSV))
1273 {
1274 FREETMPS; LEAVE;
1275 ERR_ERRSV;
1276 }
1277
1278 SvREFCNT_dec_NN (sv);
1279 sv = SvREFCNT_inc (POPs);
1280
1281 PUTBACK;
1282
1283 FREETMPS; LEAVE;
1284 }
1285 break;
1286
1287 default:
1288 filter:
1289 {
1290 SV *tag_sv = newSVuv (tag);
1291
1292 sv = decode_sv (dec);
1293
1294 dSP;
1295 ENTER; SAVETMPS;
1296 PUSHMARK (SP);
1297 EXTEND (SP, 2);
1298 PUSHs (tag_sv);
1299 PUSHs (sv);
1300
1301 PUTBACK;
1302 int count = call_sv (dec->cbor.filter ? dec->cbor.filter : default_filter, G_ARRAY | G_EVAL);
1303 SPAGAIN;
1304
1305 if (SvTRUE (ERRSV))
1306 {
1307 SvREFCNT_dec_NN (tag_sv);
1308 FREETMPS; LEAVE;
1309 ERR_ERRSV;
1310 }
1311
1312 if (count)
1313 {
1314 SvREFCNT_dec_NN (tag_sv);
1315 SvREFCNT_dec_NN (sv);
1316 sv = SvREFCNT_inc_NN (TOPs);
1317 SP -= count;
1318 }
1319 else
1320 {
1321 AV *av = newAV ();
1322 av_push (av, tag_sv);
1323 av_push (av, sv);
1324
1325 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
1326 ? cbor_tagged_stash
1327 : gv_stashpv ("CBOR::XS::Tagged" , 1);
1328 sv = sv_bless (newRV_noinc ((SV *)av), tagged_stash);
1329 }
1330
1331 PUTBACK;
1332
1333 FREETMPS; LEAVE;
1334 }
1335 break;
1336 }
1337
1338 return sv;
1339
1340 fail:
1341 SvREFCNT_dec (sv);
1342 return &PL_sv_undef;
1343 }
1344
1345 static SV *
1346 decode_sv (dec_t *dec)
1347 {
1348 WANT (1);
1349
1350 switch (*dec->cur >> MAJOR_SHIFT)
1351 {
1352 case MAJOR_POS_INT >> MAJOR_SHIFT: return newSVuv (decode_uint (dec));
1353 case MAJOR_NEG_INT >> MAJOR_SHIFT: return newSViv (-1 - (IV)decode_uint (dec));
1354 case MAJOR_BYTES >> MAJOR_SHIFT: return decode_str (dec, 0);
1355 case MAJOR_TEXT >> MAJOR_SHIFT: return decode_str (dec, 1);
1356 case MAJOR_ARRAY >> MAJOR_SHIFT: return decode_av (dec);
1357 case MAJOR_MAP >> MAJOR_SHIFT: return decode_hv (dec);
1358 case MAJOR_TAG >> MAJOR_SHIFT: return decode_tagged (dec);
1359
1360 case MAJOR_MISC >> MAJOR_SHIFT:
1361 switch (*dec->cur++ & MINOR_MASK)
1362 {
1363 case SIMPLE_FALSE:
1364 #if CBOR_SLOW
1365 types_false = get_bool ("Types::Serialiser::false");
1366 #endif
1367 return newSVsv (types_false);
1368 case SIMPLE_TRUE:
1369 #if CBOR_SLOW
1370 types_true = get_bool ("Types::Serialiser::true");
1371 #endif
1372 return newSVsv (types_true);
1373 case SIMPLE_NULL:
1374 return newSVsv (&PL_sv_undef);
1375 case SIMPLE_UNDEF:
1376 #if CBOR_SLOW
1377 types_error = get_bool ("Types::Serialiser::error");
1378 #endif
1379 return newSVsv (types_error);
1380
1381 case MISC_FLOAT16:
1382 {
1383 WANT (2);
1384
1385 uint16_t fp = (dec->cur[0] << 8) | dec->cur[1];
1386 dec->cur += 2;
1387
1388 return newSVnv (ecb_binary16_to_float (fp));
1389 }
1390
1391 case MISC_FLOAT32:
1392 {
1393 uint32_t fp;
1394 WANT (4);
1395 memcpy (&fp, dec->cur, 4);
1396 dec->cur += 4;
1397
1398 if (!ecb_big_endian ())
1399 fp = ecb_bswap32 (fp);
1400
1401 return newSVnv (ecb_binary32_to_float (fp));
1402 }
1403
1404 case MISC_FLOAT64:
1405 {
1406 uint64_t fp;
1407 WANT (8);
1408 memcpy (&fp, dec->cur, 8);
1409 dec->cur += 8;
1410
1411 if (!ecb_big_endian ())
1412 fp = ecb_bswap64 (fp);
1413
1414 return newSVnv (ecb_binary64_to_double (fp));
1415 }
1416
1417 // 0..19 unassigned simple
1418 // 24 reserved + unassigned simple (reserved values are not encodable)
1419 // 28-30 unassigned misc
1420 // 31 break code
1421 default:
1422 ERR ("corrupted CBOR data (reserved/unassigned/unexpected major 7 value)");
1423 }
1424
1425 break;
1426 }
1427
1428 fail:
1429 return &PL_sv_undef;
1430 }
1431
1432 static SV *
1433 decode_cbor (SV *string, CBOR *cbor, char **offset_return)
1434 {
1435 dec_t dec = { 0 };
1436 SV *sv;
1437 STRLEN len;
1438 char *data = SvPVbyte (string, len);
1439
1440 if (len > cbor->max_size && cbor->max_size)
1441 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
1442 (unsigned long)len, (unsigned long)cbor->max_size);
1443
1444 dec.cbor = *cbor;
1445 dec.cur = (U8 *)data;
1446 dec.end = (U8 *)data + len;
1447
1448 sv = decode_sv (&dec);
1449
1450 if (offset_return)
1451 *offset_return = dec.cur;
1452
1453 if (!(offset_return || !sv))
1454 if (dec.cur != dec.end && !dec.err)
1455 dec.err = "garbage after CBOR object";
1456
1457 if (dec.err)
1458 {
1459 if (dec.shareable)
1460 {
1461 // need to break cyclic links, which would all be in shareable
1462 int i;
1463 SV **svp;
1464
1465 for (i = av_len (dec.shareable) + 1; i--; )
1466 if ((svp = av_fetch (dec.shareable, i, 0)))
1467 sv_setsv (*svp, &PL_sv_undef);
1468 }
1469
1470 SvREFCNT_dec_NN (sv);
1471
1472 if (dec.err_sv)
1473 sv_2mortal (dec.err_sv);
1474
1475 croak ("%s, at offset %d (octet 0x%02x)", dec.err, dec.cur - (U8 *)data, (int)(uint8_t)*dec.cur);
1476 }
1477
1478 sv = sv_2mortal (sv);
1479
1480 return sv;
1481 }
1482
1483 /////////////////////////////////////////////////////////////////////////////
1484 // incremental parser
1485
1486 #define INCR_DONE(cbor) (AvFILLp (cbor->incr_count) < 0)
1487
1488 // returns 0 for notyet, 1 for success or error
1489 static int
1490 incr_parse (CBOR *self, SV *cborstr)
1491 {
1492 STRLEN cur;
1493 SvPV (cborstr, cur);
1494
1495 while (ecb_expect_true (self->incr_need <= cur))
1496 {
1497 // table of integer count bytes
1498 static I8 incr_len[MINOR_MASK + 1] = {
1499 0, 0, 0, 0, 0, 0, 0, 0,
1500 0, 0, 0, 0, 0, 0, 0, 0,
1501 0, 0, 0, 0, 0, 0, 0, 0,
1502 1, 2, 4, 8,-1,-1,-1,-2
1503 };
1504
1505 const U8 *p = SvPVX (cborstr) + self->incr_pos;
1506 U8 m = *p & MINOR_MASK;
1507 IV count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1508 I8 ilen = incr_len[m];
1509
1510 self->incr_need = self->incr_pos + 1;
1511
1512 if (ecb_expect_false (ilen < 0))
1513 {
1514 if (m != MINOR_INDEF)
1515 return 1; // error
1516
1517 if (*p == (MAJOR_MISC | MINOR_INDEF))
1518 {
1519 if (count >= 0)
1520 return 1; // error
1521
1522 count = 1;
1523 }
1524 else
1525 {
1526 av_push (self->incr_count, newSViv (-1)); //TODO: nest
1527 count = -1;
1528 }
1529 }
1530 else
1531 {
1532 self->incr_need += ilen;
1533 if (ecb_expect_false (self->incr_need > cur))
1534 return 0;
1535
1536 int major = *p >> MAJOR_SHIFT;
1537
1538 switch (major)
1539 {
1540 case MAJOR_TAG >> MAJOR_SHIFT:
1541 ++count; // tags merely prefix another value
1542 break;
1543
1544 case MAJOR_BYTES >> MAJOR_SHIFT:
1545 case MAJOR_TEXT >> MAJOR_SHIFT:
1546 case MAJOR_ARRAY >> MAJOR_SHIFT:
1547 case MAJOR_MAP >> MAJOR_SHIFT:
1548 {
1549 UV len;
1550
1551 if (ecb_expect_false (ilen))
1552 {
1553 len = 0;
1554
1555 do {
1556 len = (len << 8) | *++p;
1557 } while (--ilen);
1558 }
1559 else
1560 len = m;
1561
1562 switch (major)
1563 {
1564 case MAJOR_BYTES >> MAJOR_SHIFT:
1565 case MAJOR_TEXT >> MAJOR_SHIFT:
1566 self->incr_need += len;
1567 if (ecb_expect_false (self->incr_need > cur))
1568 return 0;
1569
1570 break;
1571
1572 case MAJOR_MAP >> MAJOR_SHIFT:
1573 len <<= 1;
1574 /* FALLTHROUGH */
1575 case MAJOR_ARRAY >> MAJOR_SHIFT:
1576 if (len)
1577 {
1578 av_push (self->incr_count, newSViv (len + 1)); //TODO: nest
1579 count = len + 1;
1580 }
1581 break;
1582 }
1583 }
1584 }
1585 }
1586
1587 self->incr_pos = self->incr_need;
1588
1589 if (count > 0)
1590 {
1591 while (!--count)
1592 {
1593 if (!AvFILLp (self->incr_count))
1594 return 1; // done
1595
1596 SvREFCNT_dec_NN (av_pop (self->incr_count));
1597 count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1598 }
1599
1600 SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]) = count;
1601 }
1602 }
1603
1604 return 0;
1605 }
1606
1607
1608 /////////////////////////////////////////////////////////////////////////////
1609 // XS interface functions
1610
1611 MODULE = CBOR::XS PACKAGE = CBOR::XS
1612
1613 BOOT:
1614 {
1615 cbor_stash = gv_stashpv ("CBOR::XS" , 1);
1616 cbor_tagged_stash = gv_stashpv ("CBOR::XS::Tagged" , 1);
1617
1618 types_boolean_stash = gv_stashpv ("Types::Serialiser::Boolean", 1);
1619 types_error_stash = gv_stashpv ("Types::Serialiser::Error" , 1);
1620
1621 types_true = get_bool ("Types::Serialiser::true" );
1622 types_false = get_bool ("Types::Serialiser::false");
1623 types_error = get_bool ("Types::Serialiser::error");
1624
1625 default_filter = newSVpv ("CBOR::XS::default_filter", 0);
1626
1627 sv_cbor = newSVpv ("CBOR", 0);
1628 SvREADONLY_on (sv_cbor);
1629
1630 assert (("STRLEN must be an unsigned type", 0 <= (STRLEN)-1));
1631 }
1632
1633 PROTOTYPES: DISABLE
1634
1635 void CLONE (...)
1636 CODE:
1637 cbor_stash = 0;
1638 cbor_tagged_stash = 0;
1639 types_error_stash = 0;
1640 types_boolean_stash = 0;
1641
1642 void new (char *klass)
1643 PPCODE:
1644 {
1645 SV *pv = NEWSV (0, sizeof (CBOR));
1646 SvPOK_only (pv);
1647 cbor_init ((CBOR *)SvPVX (pv));
1648 XPUSHs (sv_2mortal (sv_bless (
1649 newRV_noinc (pv),
1650 strEQ (klass, "CBOR::XS") ? CBOR_STASH : gv_stashpv (klass, 1)
1651 )));
1652 }
1653
1654 void shrink (CBOR *self, int enable = 1)
1655 ALIAS:
1656 shrink = F_SHRINK
1657 allow_unknown = F_ALLOW_UNKNOWN
1658 allow_sharing = F_ALLOW_SHARING
1659 allow_cycles = F_ALLOW_CYCLES
1660 forbid_objects = F_FORBID_OBJECTS
1661 pack_strings = F_PACK_STRINGS
1662 text_keys = F_TEXT_KEYS
1663 text_strings = F_TEXT_STRINGS
1664 validate_utf8 = F_VALIDATE_UTF8
1665 PPCODE:
1666 {
1667 if (enable)
1668 self->flags |= ix;
1669 else
1670 self->flags &= ~ix;
1671
1672 XPUSHs (ST (0));
1673 }
1674
1675 void get_shrink (CBOR *self)
1676 ALIAS:
1677 get_shrink = F_SHRINK
1678 get_allow_unknown = F_ALLOW_UNKNOWN
1679 get_allow_sharing = F_ALLOW_SHARING
1680 get_allow_cycles = F_ALLOW_CYCLES
1681 get_forbid_objects = F_FORBID_OBJECTS
1682 get_pack_strings = F_PACK_STRINGS
1683 get_text_keys = F_TEXT_KEYS
1684 get_text_strings = F_TEXT_STRINGS
1685 get_validate_utf8 = F_VALIDATE_UTF8
1686 PPCODE:
1687 XPUSHs (boolSV (self->flags & ix));
1688
1689 void max_depth (CBOR *self, U32 max_depth = 0x80000000UL)
1690 PPCODE:
1691 self->max_depth = max_depth;
1692 XPUSHs (ST (0));
1693
1694 U32 get_max_depth (CBOR *self)
1695 CODE:
1696 RETVAL = self->max_depth;
1697 OUTPUT:
1698 RETVAL
1699
1700 void max_size (CBOR *self, U32 max_size = 0)
1701 PPCODE:
1702 self->max_size = max_size;
1703 XPUSHs (ST (0));
1704
1705 int get_max_size (CBOR *self)
1706 CODE:
1707 RETVAL = self->max_size;
1708 OUTPUT:
1709 RETVAL
1710
1711 void filter (CBOR *self, SV *filter = 0)
1712 PPCODE:
1713 SvREFCNT_dec (self->filter);
1714 self->filter = filter ? newSVsv (filter) : filter;
1715 XPUSHs (ST (0));
1716
1717 SV *get_filter (CBOR *self)
1718 CODE:
1719 RETVAL = self->filter ? self->filter : NEWSV (0, 0);
1720 OUTPUT:
1721 RETVAL
1722
1723 void encode (CBOR *self, SV *scalar)
1724 PPCODE:
1725 PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN;
1726 XPUSHs (scalar);
1727
1728 void decode (CBOR *self, SV *cborstr)
1729 PPCODE:
1730 PUTBACK; cborstr = decode_cbor (cborstr, self, 0); SPAGAIN;
1731 XPUSHs (cborstr);
1732
1733 void decode_prefix (CBOR *self, SV *cborstr)
1734 PPCODE:
1735 {
1736 SV *sv;
1737 char *offset;
1738 PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
1739 EXTEND (SP, 2);
1740 PUSHs (sv);
1741 PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr))));
1742 }
1743
1744 void incr_parse (CBOR *self, SV *cborstr)
1745 ALIAS:
1746 incr_parse_multiple = 1
1747 PPCODE:
1748 {
1749 if (SvUTF8 (cborstr))
1750 sv_utf8_downgrade (cborstr, 0);
1751
1752 if (!self->incr_count)
1753 {
1754 self->incr_count = newAV ();
1755 self->incr_pos = 0;
1756 self->incr_need = 1;
1757
1758 av_push (self->incr_count, newSViv (1));
1759 }
1760
1761 do
1762 {
1763 if (!incr_parse (self, cborstr))
1764 {
1765 if (self->incr_need > self->max_size && self->max_size)
1766 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
1767 (unsigned long)self->incr_need, (unsigned long)self->max_size);
1768
1769 break;
1770 }
1771
1772 SV *sv;
1773 char *offset;
1774
1775 PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
1776 XPUSHs (sv);
1777
1778 sv_chop (cborstr, offset);
1779
1780 av_clear (self->incr_count);
1781 av_push (self->incr_count, newSViv (1));
1782
1783 self->incr_pos = 0;
1784 self->incr_need = self->incr_pos + 1;
1785 }
1786 while (ix);
1787 }
1788
1789 void incr_reset (CBOR *self)
1790 CODE:
1791 {
1792 SvREFCNT_dec (self->incr_count);
1793 self->incr_count = 0;
1794 }
1795
1796 void DESTROY (CBOR *self)
1797 PPCODE:
1798 cbor_free (self);
1799
1800 PROTOTYPES: ENABLE
1801
1802 void encode_cbor (SV *scalar)
1803 ALIAS:
1804 encode_cbor = 0
1805 encode_cbor_sharing = F_ALLOW_SHARING
1806 PPCODE:
1807 {
1808 CBOR cbor;
1809 cbor_init (&cbor);
1810 cbor.flags |= ix;
1811 PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN;
1812 XPUSHs (scalar);
1813 }
1814
1815 void decode_cbor (SV *cborstr)
1816 PPCODE:
1817 {
1818 CBOR cbor;
1819 cbor_init (&cbor);
1820 PUTBACK; cborstr = decode_cbor (cborstr, &cbor, 0); SPAGAIN;
1821 XPUSHs (cborstr);
1822 }
1823
1824 #ifdef __AFL_COMPILER
1825
1826 void
1827 afl_init ()
1828 CODE:
1829 __AFL_INIT ();
1830
1831 int
1832 afl_loop (unsigned int count = 10000)
1833 CODE:
1834 RETVAL = __AFL_LOOP (count);
1835 OUTPUT:
1836 RETVAL
1837
1838 #endif
1839