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