File Coverage

XS.xs
Criterion Covered Total %
statement 586 771 76.0
branch 314 752 41.7
condition n/a
subroutine n/a
pod n/a
total 900 1523 59.0


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