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