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.1 by root, Fri Oct 25 23:09:45 2013 UTC vs.
Revision 1.61 by root, Sat Nov 26 02:10:19 2016 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines