ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/CBOR-XS/XS.xs
(Generate patch)

Comparing CBOR-XS/XS.xs (file contents):
Revision 1.2 by root, Sat Oct 26 10:41:12 2013 UTC vs.
Revision 1.60 by root, Sat Nov 26 00:47:02 2016 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines