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