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

Comparing CBOR-XS/XS.pm (file contents):
Revision 1.53 by root, Mon Apr 25 18:20:22 2016 UTC vs.
Revision 1.69 by root, Sat Nov 9 07:23:31 2019 UTC

38with the added ability of supporting serialisation of Perl objects. (JSON 38with the added ability of supporting serialisation of Perl objects. (JSON
39often compresses better than CBOR though, so if you plan to compress the 39often compresses better than CBOR though, so if you plan to compress the
40data later and speed is less important you might want to compare both 40data later and speed is less important you might want to compare both
41formats first). 41formats first).
42 42
43The primary goal of this module is to be I<correct> and the secondary goal
44is to be I<fast>. To reach the latter goal it was written in C.
45
43To give you a general idea about speed, with texts in the megabyte range, 46To give you a general idea about speed, with texts in the megabyte range,
44C<CBOR::XS> usually encodes roughly twice as fast as L<Storable> or 47C<CBOR::XS> usually encodes roughly twice as fast as L<Storable> or
45L<JSON::XS> and decodes about 15%-30% faster than those. The shorter the 48L<JSON::XS> and decodes about 15%-30% faster than those. The shorter the
46data, the worse L<Storable> performs in comparison. 49data, the worse L<Storable> performs in comparison.
47 50
52In addition to the core CBOR data format, this module implements a 55In addition to the core CBOR data format, this module implements a
53number of extensions, to support cyclic and shared data structures 56number of extensions, to support cyclic and shared data structures
54(see C<allow_sharing> and C<allow_cycles>), string deduplication (see 57(see C<allow_sharing> and C<allow_cycles>), string deduplication (see
55C<pack_strings>) and scalar references (always enabled). 58C<pack_strings>) and scalar references (always enabled).
56 59
57The primary goal of this module is to be I<correct> and the secondary goal
58is to be I<fast>. To reach the latter goal it was written in C.
59
60See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and 60See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and
61vice versa. 61vice versa.
62 62
63=cut 63=cut
64 64
65package CBOR::XS; 65package CBOR::XS;
66 66
67use common::sense; 67use common::sense;
68 68
69our $VERSION = 1.41; 69our $VERSION = 1.71;
70our @ISA = qw(Exporter); 70our @ISA = qw(Exporter);
71 71
72our @EXPORT = qw(encode_cbor decode_cbor); 72our @EXPORT = qw(encode_cbor decode_cbor);
73 73
74use Exporter; 74use Exporter;
112 112
113The mutators for flags all return the CBOR object again and thus calls can 113The mutators for flags all return the CBOR object again and thus calls can
114be chained: 114be chained:
115 115
116 my $cbor = CBOR::XS->new->encode ({a => [1,2]}); 116 my $cbor = CBOR::XS->new->encode ({a => [1,2]});
117
118=item $cbor = new_safe CBOR::XS
119
120Create a new, safe/secure CBOR::XS object. This is similar to C<new>,
121but configures the coder object to be safe to use with untrusted
122data. Currently, this is equivalent to:
123
124 my $cbor = CBOR::XS
125 ->new
126 ->forbid_objects
127 ->filter (\&CBOR::XS::safe_filter)
128 ->max_size (1e8);
129
130But is more future proof (it is better to crash because of a change than
131to be exploited in other ways).
132
133=cut
134
135sub new_safe {
136 CBOR::XS
137 ->new
138 ->forbid_objects
139 ->filter (\&CBOR::XS::safe_filter)
140 ->max_size (1e8)
141}
117 142
118=item $cbor = $cbor->max_depth ([$maximum_nesting_depth]) 143=item $cbor = $cbor->max_depth ([$maximum_nesting_depth])
119 144
120=item $max_depth = $cbor->get_max_depth 145=item $max_depth = $cbor->get_max_depth
121 146
137 162
138Note that nesting is implemented by recursion in C. The default value has 163Note that nesting is implemented by recursion in C. The default value has
139been chosen to be as large as typical operating systems allow without 164been chosen to be as large as typical operating systems allow without
140crashing. 165crashing.
141 166
142See SECURITY CONSIDERATIONS, below, for more info on why this is useful. 167See L<SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
143 168
144=item $cbor = $cbor->max_size ([$maximum_string_size]) 169=item $cbor = $cbor->max_size ([$maximum_string_size])
145 170
146=item $max_size = $cbor->get_max_size 171=item $max_size = $cbor->get_max_size
147 172
152effect on C<encode> (yet). 177effect on C<encode> (yet).
153 178
154If no argument is given, the limit check will be deactivated (same as when 179If no argument is given, the limit check will be deactivated (same as when
155C<0> is specified). 180C<0> is specified).
156 181
157See SECURITY CONSIDERATIONS, below, for more info on why this is useful. 182See L<SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
158 183
159=item $cbor = $cbor->allow_unknown ([$enable]) 184=item $cbor = $cbor->allow_unknown ([$enable])
160 185
161=item $enabled = $cbor->get_allow_unknown 186=item $enabled = $cbor->get_allow_unknown
162 187
180reference to the earlier value. 205reference to the earlier value.
181 206
182This means that such values will only be encoded once, and will not result 207This means that such values will only be encoded once, and will not result
183in a deep cloning of the value on decode, in decoders supporting the value 208in a deep cloning of the value on decode, in decoders supporting the value
184sharing extension. This also makes it possible to encode cyclic data 209sharing extension. This also makes it possible to encode cyclic data
185structures (which need C<allow_cycles> to ne enabled to be decoded by this 210structures (which need C<allow_cycles> to be enabled to be decoded by this
186module). 211module).
187 212
188It is recommended to leave it off unless you know your 213It is recommended to leave it off unless you know your
189communication partner supports the value sharing extensions to CBOR 214communication partner supports the value sharing extensions to CBOR
190(L<http://cbor.schmorp.de/value-sharing>), as without decoder support, the 215(L<http://cbor.schmorp.de/value-sharing>), as without decoder support, the
191resulting data structure might be unusable. 216resulting data structure might be unusable.
192 217
193Detecting shared values incurs a runtime overhead when values are encoded 218Detecting shared values incurs a runtime overhead when values are encoded
194that have a reference counter large than one, and might unnecessarily 219that have a reference counter large than one, and might unnecessarily
195increase the encoded size, as potentially shared values are encode as 220increase the encoded size, as potentially shared values are encoded as
196shareable whether or not they are actually shared. 221shareable whether or not they are actually shared.
197 222
198At the moment, only targets of references can be shared (e.g. scalars, 223At the moment, only targets of references can be shared (e.g. scalars,
199arrays or hashes pointed to by a reference). Weirder constructs, such as 224arrays or hashes pointed to by a reference). Weirder constructs, such as
200an array with multiple "copies" of the I<same> string, which are hard but 225an array with multiple "copies" of the I<same> string, which are hard but
226throwing an error. 251throwing an error.
227 252
228This option does not affect C<encode> in any way - shared values and 253This option does not affect C<encode> in any way - shared values and
229references will always be encoded properly if present. 254references will always be encoded properly if present.
230 255
256=item $cbor = $cbor->forbid_objects ([$enable])
257
258=item $enabled = $cbor->get_forbid_objects
259
260Disables the use of the object serialiser protocol.
261
262If C<$enable> is true (or missing), then C<encode> will will throw an
263exception when it encounters perl objects that would be encoded using the
264perl-object tag (26). When C<decode> encounters such tags, it will fall
265back to the general filter/tagged logic as if this were an unknown tag (by
266default resulting in a C<CBOR::XC::Tagged> object).
267
268If C<$enable> is false (the default), then C<encode> will use the
269L<Types::Serialiser> object serialisation protocol to serialise objects
270into perl-object tags, and C<decode> will do the same to decode such tags.
271
272See L<SECURITY CONSIDERATIONS>, below, for more info on why forbidding this
273protocol can be useful.
274
231=item $cbor = $cbor->pack_strings ([$enable]) 275=item $cbor = $cbor->pack_strings ([$enable])
232 276
233=item $enabled = $cbor->get_pack_strings 277=item $enabled = $cbor->get_pack_strings
234 278
235If C<$enable> is true (or missing), then C<encode> will try not to encode 279If C<$enable> is true (or missing), then C<encode> will try not to encode
337replace the tagged value in the decoded data structure, or no values, 381replace the tagged value in the decoded data structure, or no values,
338which will result in default handling, which currently means the decoder 382which will result in default handling, which currently means the decoder
339creates a C<CBOR::XS::Tagged> object to hold the tag and the value. 383creates a C<CBOR::XS::Tagged> object to hold the tag and the value.
340 384
341When the filter is cleared (the default state), the default filter 385When the filter is cleared (the default state), the default filter
342function, C<CBOR::XS::default_filter>, is used. This function simply looks 386function, C<CBOR::XS::default_filter>, is used. This function simply
343up the tag in the C<%CBOR::XS::FILTER> hash. If an entry exists it must be 387looks up the tag in the C<%CBOR::XS::FILTER> hash. If an entry exists
344a code reference that is called with tag and value, and is responsible for 388it must be a code reference that is called with tag and value, and is
345decoding the value. If no entry exists, it returns no values. 389responsible for decoding the value. If no entry exists, it returns no
390values. C<CBOR::XS> provides a number of default filter functions already,
391the the C<%CBOR::XS::FILTER> hash can be freely extended with more.
392
393C<CBOR::XS> additionally provides an alternative filter function that is
394supposed to be safe to use with untrusted data (which the default filter
395might not), called C<CBOR::XS::safe_filter>, which works the same as
396the C<default_filter> but uses the C<%CBOR::XS::SAFE_FILTER> variable
397instead. It is prepopulated with the tag decoding functions that are
398deemed safe (basically the same as C<%CBOR::XS::FILTER> without all
399the bignum tags), and can be extended by user code as wlel, although,
400obviously, one should be very careful about adding decoding functions
401here, since the expectation is that they are safe to use on untrusted
402data, after all.
346 403
347Example: decode all tags not handled internally into C<CBOR::XS::Tagged> 404Example: decode all tags not handled internally into C<CBOR::XS::Tagged>
348objects, with no other special handling (useful when working with 405objects, with no other special handling (useful when working with
349potentially "unsafe" CBOR data). 406potentially "unsafe" CBOR data).
350 407
356 $CBOR::XS::FILTER{1347375694} = sub { 413 $CBOR::XS::FILTER{1347375694} = sub {
357 my ($tag, $value); 414 my ($tag, $value);
358 415
359 "tag 1347375694 value $value" 416 "tag 1347375694 value $value"
360 }; 417 };
418
419Example: provide your own filter function that looks up tags in your own
420hash:
421
422 my %my_filter = (
423 998347484 => sub {
424 my ($tag, $value);
425
426 "tag 998347484 value $value"
427 };
428 );
429
430 my $coder = CBOR::XS->new->filter (sub {
431 &{ $my_filter{$_[0]} or return }
432 });
433
434
435Example: use the safe filter function (see L<SECURITY CONSIDERATIONS> for
436more considerations on security).
437
438 CBOR::XS->new->filter (\&CBOR::XS::safe_filter)->decode ($cbor_data);
361 439
362=item $cbor_data = $cbor->encode ($perl_scalar) 440=item $cbor_data = $cbor->encode ($perl_scalar)
363 441
364Converts the given Perl data structure (a scalar value) to its CBOR 442Converts the given Perl data structure (a scalar value) to its CBOR
365representation. 443representation.
440 518
441Resets the incremental decoder. This throws away any saved state, so that 519Resets the incremental decoder. This throws away any saved state, so that
442subsequent calls to C<incr_parse> or C<incr_parse_multiple> start to parse 520subsequent calls to C<incr_parse> or C<incr_parse_multiple> start to parse
443a new CBOR value from the beginning of the C<$buffer> again. 521a new CBOR value from the beginning of the C<$buffer> again.
444 522
445This method can be caled at any time, but it I<must> be called if you want 523This method can be called at any time, but it I<must> be called if you want
446to change your C<$buffer> or there was a decoding error and you want to 524to change your C<$buffer> or there was a decoding error and you want to
447reuse the C<$cbor> object for future incremental parsings. 525reuse the C<$cbor> object for future incremental parsings.
448 526
449=back 527=back
450 528
927 1005
928These tags are decoded into L<Math::BigInt> objects. The corresponding 1006These tags are decoded into L<Math::BigInt> objects. The corresponding
929C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR 1007C<Math::BigInt::TO_CBOR> method encodes "small" bigints into normal CBOR
930integers, and others into positive/negative CBOR bignums. 1008integers, and others into positive/negative CBOR bignums.
931 1009
932=item 4, 5 (decimal fraction/bigfloat) 1010=item 4, 5, 264, 265 (decimal fraction/bigfloat)
933 1011
934Both decimal fractions and bigfloats are decoded into L<Math::BigFloat> 1012Both decimal fractions and bigfloats are decoded into L<Math::BigFloat>
935objects. The corresponding C<Math::BigFloat::TO_CBOR> method I<always> 1013objects. The corresponding C<Math::BigFloat::TO_CBOR> method I<always>
936encodes into a decimal fraction. 1014encodes into a decimal fraction (either tag 4 or 264).
937 1015
938CBOR cannot represent bigfloats with I<very> large exponents - conversion 1016NaN and infinities are not encoded properly, as they cannot be represented
939of such big float objects is undefined. 1017in CBOR.
940 1018
941Also, NaN and infinities are not encoded properly. 1019See L<BIGNUM SECURITY CONSIDERATIONS> for more info.
1020
1021=item 30 (rational numbers)
1022
1023These tags are decoded into L<Math::BigRat> objects. The corresponding
1024C<Math::BigRat::TO_CBOR> method encodes rational numbers with denominator
1025C<1> via their numerator only, i.e., they become normal integers or
1026C<bignums>.
1027
1028See L<BIGNUM SECURITY CONSIDERATIONS> for more info.
942 1029
943=item 21, 22, 23 (expected later JSON conversion) 1030=item 21, 22, 23 (expected later JSON conversion)
944 1031
945CBOR::XS is not a CBOR-to-JSON converter, and will simply ignore these 1032CBOR::XS is not a CBOR-to-JSON converter, and will simply ignore these
946tags. 1033tags.
969CBOR intact. 1056CBOR intact.
970 1057
971 1058
972=head1 SECURITY CONSIDERATIONS 1059=head1 SECURITY CONSIDERATIONS
973 1060
974When you are using CBOR in a protocol, talking to untrusted potentially 1061Tl;dr... if you want to decode or encode CBOR from untrusted sources, you
975hostile creatures requires relatively few measures. 1062should start with a coder object created via C<new_safe> (which implements
1063the mitigations explained below):
976 1064
1065 my $coder = CBOR::XS->new_safe;
1066
1067 my $data = $coder->decode ($cbor_text);
1068 my $cbor = $coder->encode ($data);
1069
1070Longer version: When you are using CBOR in a protocol, talking to
1071untrusted potentially hostile creatures requires some thought:
1072
1073=over 4
1074
1075=item Security of the CBOR decoder itself
1076
977First of all, your CBOR decoder should be secure, that is, should not have 1077First and foremost, your CBOR decoder should be secure, that is, should
1078not have any buffer overflows or similar bugs that could potentially be
978any buffer overflows. Obviously, this module should ensure that and I am 1079exploited. Obviously, this module should ensure that and I am trying hard
979trying hard on making that true, but you never know. 1080on making that true, but you never know.
980 1081
1082=item CBOR::XS can invoke almost arbitrary callbacks during decoding
1083
1084CBOR::XS supports object serialisation - decoding CBOR can cause calls
1085to I<any> C<THAW> method in I<any> package that exists in your process
1086(that is, CBOR::XS will not try to load modules, but any existing C<THAW>
1087method or function can be called, so they all have to be secure).
1088
1089Less obviously, it will also invoke C<TO_CBOR> and C<FREEZE> methods -
1090even if all your C<THAW> methods are secure, encoding data structures from
1091untrusted sources can invoke those and trigger bugs in those.
1092
1093So, if you are not sure about the security of all the modules you
1094have loaded (you shouldn't), you should disable this part using
1095C<forbid_objects> or using C<new_safe>.
1096
1097=item CBOR can be extended with tags that call library code
1098
1099CBOR can be extended with tags, and C<CBOR::XS> has a registry of
1100conversion functions for many existing tags that can be extended via
1101third-party modules (see the C<filter> method).
1102
1103If you don't trust these, you should configure the "safe" filter function,
1104C<CBOR::XS::safe_filter> (C<new_safe> does this), which by default only
1105includes conversion functions that are considered "safe" by the author
1106(but again, they can be extended by third party modules).
1107
1108Depending on your level of paranoia, you can use the "safe" filter:
1109
1110 $cbor->filter (\&CBOR::XS::safe_filter);
1111
1112... your own filter...
1113
1114 $cbor->filter (sub { ... do your stuffs here ... });
1115
1116... or even no filter at all, disabling all tag decoding:
1117
1118 $cbor->filter (sub { });
1119
1120This is never a problem for encoding, as the tag mechanism only exists in
1121CBOR texts.
1122
1123=item Resource-starving attacks: object memory usage
1124
981Second, you need to avoid resource-starving attacks. That means you should 1125You need to avoid resource-starving attacks. That means you should limit
982limit the size of CBOR data you accept, or make sure then when your 1126the size of CBOR data you accept, or make sure then when your resources
983resources run out, that's just fine (e.g. by using a separate process that 1127run out, that's just fine (e.g. by using a separate process that can
984can crash safely). The size of a CBOR string in octets is usually a good 1128crash safely). The size of a CBOR string in octets is usually a good
985indication of the size of the resources required to decode it into a Perl 1129indication of the size of the resources required to decode it into a Perl
986structure. While CBOR::XS can check the size of the CBOR text, it might be 1130structure. While CBOR::XS can check the size of the CBOR text (using
987too late when you already have it in memory, so you might want to check 1131C<max_size> - done by C<new_safe>), it might be too late when you already
988the size before you accept the string. 1132have it in memory, so you might want to check the size before you accept
1133the string.
989 1134
1135As for encoding, it is possible to construct data structures that are
1136relatively small but result in large CBOR texts (for example by having an
1137array full of references to the same big data structure, which will all be
1138deep-cloned during encoding by default). This is rarely an actual issue
1139(and the worst case is still just running out of memory), but you can
1140reduce this risk by using C<allow_sharing>.
1141
1142=item Resource-starving attacks: stack overflows
1143
990Third, CBOR::XS recurses using the C stack when decoding objects and 1144CBOR::XS recurses using the C stack when decoding objects and arrays. The
991arrays. The C stack is a limited resource: for instance, on my amd64 1145C stack is a limited resource: for instance, on my amd64 machine with 8MB
992machine with 8MB of stack size I can decode around 180k nested arrays but 1146of stack size I can decode around 180k nested arrays but only 14k nested
993only 14k nested CBOR objects (due to perl itself recursing deeply on croak 1147CBOR objects (due to perl itself recursing deeply on croak to free the
994to free the temporary). If that is exceeded, the program crashes. To be 1148temporary). If that is exceeded, the program crashes. To be conservative,
995conservative, the default nesting limit is set to 512. If your process 1149the default nesting limit is set to 512. If your process has a smaller
996has a smaller stack, you should adjust this setting accordingly with the 1150stack, you should adjust this setting accordingly with the C<max_depth>
997C<max_depth> method. 1151method.
1152
1153=item Resource-starving attacks: CPU en-/decoding complexity
1154
1155CBOR::XS will use the L<Math::BigInt>, L<Math::BigFloat> and
1156L<Math::BigRat> libraries to represent encode/decode bignums. These can be
1157very slow (as in, centuries of CPU time) and can even crash your program
1158(and are generally not very trustworthy). See the next section on bignum
1159security for details.
1160
1161=item Data breaches: leaking information in error messages
1162
1163CBOR::XS might leak contents of your Perl data structures in its error
1164messages, so when you serialise sensitive information you might want to
1165make sure that exceptions thrown by CBOR::XS will not end up in front of
1166untrusted eyes.
1167
1168=item Something else...
998 1169
999Something else could bomb you, too, that I forgot to think of. In that 1170Something else could bomb you, too, that I forgot to think of. In that
1000case, you get to keep the pieces. I am always open for hints, though... 1171case, you get to keep the pieces. I am always open for hints, though...
1001 1172
1002Also keep in mind that CBOR::XS might leak contents of your Perl data 1173=back
1003structures in its error messages, so when you serialise sensitive 1174
1004information you might want to make sure that exceptions thrown by CBOR::XS 1175
1005will not end up in front of untrusted eyes. 1176=head1 BIGNUM SECURITY CONSIDERATIONS
1177
1178CBOR::XS provides a C<TO_CBOR> method for both L<Math::BigInt> and
1179L<Math::BigFloat> that tries to encode the number in the simplest possible
1180way, that is, either a CBOR integer, a CBOR bigint/decimal fraction (tag
11814) or an arbitrary-exponent decimal fraction (tag 264). Rational numbers
1182(L<Math::BigRat>, tag 30) can also contain bignums as members.
1183
1184CBOR::XS will also understand base-2 bigfloat or arbitrary-exponent
1185bigfloats (tags 5 and 265), but it will never generate these on its own.
1186
1187Using the built-in L<Math::BigInt::Calc> support, encoding and decoding
1188decimal fractions is generally fast. Decoding bigints can be slow for very
1189big numbers (tens of thousands of digits, something that could potentially
1190be caught by limiting the size of CBOR texts), and decoding bigfloats or
1191arbitrary-exponent bigfloats can be I<extremely> slow (minutes, decades)
1192for large exponents (roughly 40 bit and longer).
1193
1194Additionally, L<Math::BigInt> can take advantage of other bignum
1195libraries, such as L<Math::GMP>, which cannot handle big floats with large
1196exponents, and might simply abort or crash your program, due to their code
1197quality.
1198
1199This can be a concern if you want to parse untrusted CBOR. If it is, you
1200might want to disable decoding of tag 2 (bigint) and 3 (negative bigint)
1201types. You should also disable types 5 and 265, as these can be slow even
1202without bigints.
1203
1204Disabling bigints will also partially or fully disable types that rely on
1205them, e.g. rational numbers that use bignums.
1206
1006 1207
1007=head1 CBOR IMPLEMENTATION NOTES 1208=head1 CBOR IMPLEMENTATION NOTES
1008 1209
1009This section contains some random implementation notes. They do not 1210This section contains some random implementation notes. They do not
1010describe guaranteed behaviour, but merely behaviour as-is implemented 1211describe guaranteed behaviour, but merely behaviour as-is implemented
1051 1252
1052Please refrain from using rt.cpan.org or any other bug reporting 1253Please refrain from using rt.cpan.org or any other bug reporting
1053service. I put the contact address into my modules for a reason. 1254service. I put the contact address into my modules for a reason.
1054 1255
1055=cut 1256=cut
1257
1258# clumsy and slow hv_store-in-hash helper function
1259sub _hv_store {
1260 $_[0]{$_[1]} = $_[2];
1261}
1056 1262
1057our %FILTER = ( 1263our %FILTER = (
1058 0 => sub { # rfc4287 datetime, utf-8 1264 0 => sub { # rfc4287 datetime, utf-8
1059 require Time::Piece; 1265 require Time::Piece;
1060 # Time::Piece::Strptime uses the "incredibly flexible date parsing routine" 1266 # Time::Piece::Strptime uses the "incredibly flexible date parsing routine"
1096 4 => sub { # decimal fraction, array 1302 4 => sub { # decimal fraction, array
1097 require Math::BigFloat; 1303 require Math::BigFloat;
1098 Math::BigFloat->new ($_[1][1] . "E" . $_[1][0]) 1304 Math::BigFloat->new ($_[1][1] . "E" . $_[1][0])
1099 }, 1305 },
1100 1306
1307 264 => sub { # decimal fraction with arbitrary exponent
1308 require Math::BigFloat;
1309 Math::BigFloat->new ($_[1][1] . "E" . $_[1][0])
1310 },
1311
1101 5 => sub { # bigfloat, array 1312 5 => sub { # bigfloat, array
1102 require Math::BigFloat; 1313 require Math::BigFloat;
1103 scalar Math::BigFloat->new ($_[1][1]) * Math::BigFloat->new (2)->bpow ($_[1][0]) 1314 scalar Math::BigFloat->new ($_[1][1]) * Math::BigFloat->new (2)->bpow ($_[1][0])
1315 },
1316
1317 265 => sub { # bigfloat with arbitrary exponent
1318 require Math::BigFloat;
1319 scalar Math::BigFloat->new ($_[1][1]) * Math::BigFloat->new (2)->bpow ($_[1][0])
1320 },
1321
1322 30 => sub { # rational number
1323 require Math::BigRat;
1324 Math::BigRat->new ("$_[1][0]/$_[1][1]") # separate parameters only work in recent versons
1104 }, 1325 },
1105 1326
1106 21 => sub { pop }, # expected conversion to base64url encoding 1327 21 => sub { pop }, # expected conversion to base64url encoding
1107 22 => sub { pop }, # expected conversion to base64 encoding 1328 22 => sub { pop }, # expected conversion to base64 encoding
1108 23 => sub { pop }, # expected conversion to base16 encoding 1329 23 => sub { pop }, # expected conversion to base16 encoding
1118 # 34 # base64 rfc46484, utf-8 1339 # 34 # base64 rfc46484, utf-8
1119 # 35 # regex pcre/ecma262, utf-8 1340 # 35 # regex pcre/ecma262, utf-8
1120 # 36 # mime message rfc2045, utf-8 1341 # 36 # mime message rfc2045, utf-8
1121); 1342);
1122 1343
1123sub CBOR::XS::default_filter { 1344sub default_filter {
1124 &{ $FILTER{$_[0]} or return } 1345 &{ $FILTER{$_[0]} or return }
1346}
1347
1348our %SAFE_FILTER = map { $_ => $FILTER{$_} } 0, 1, 21, 22, 23, 32;
1349
1350sub safe_filter {
1351 &{ $SAFE_FILTER{$_[0]} or return }
1125} 1352}
1126 1353
1127sub URI::TO_CBOR { 1354sub URI::TO_CBOR {
1128 my $uri = $_[0]->as_string; 1355 my $uri = $_[0]->as_string;
1129 utf8::upgrade $uri; 1356 utf8::upgrade $uri;
1130 tag 32, $uri 1357 tag 32, $uri
1131} 1358}
1132 1359
1133sub Math::BigInt::TO_CBOR { 1360sub Math::BigInt::TO_CBOR {
1134 if ($_[0] >= -2147483648 && $_[0] <= 2147483647) { 1361 if (-2147483648 <= $_[0] && $_[0] <= 2147483647) {
1135 $_[0]->numify 1362 $_[0]->numify
1136 } else { 1363 } else {
1137 my $hex = substr $_[0]->as_hex, 2; 1364 my $hex = substr $_[0]->as_hex, 2;
1138 $hex = "0$hex" if 1 & length $hex; # sigh 1365 $hex = "0$hex" if 1 & length $hex; # sigh
1139 tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex 1366 tag $_[0] >= 0 ? 2 : 3, pack "H*", $hex
1140 } 1367 }
1141} 1368}
1142 1369
1143sub Math::BigFloat::TO_CBOR { 1370sub Math::BigFloat::TO_CBOR {
1144 my ($m, $e) = $_[0]->parts; 1371 my ($m, $e) = $_[0]->parts;
1372
1373 -9223372036854775808 <= $e && $e <= 18446744073709551615
1145 tag 4, [$e->numify, $m] 1374 ? tag 4, [$e->numify, $m]
1375 : tag 264, [$e, $m]
1376}
1377
1378sub Math::BigRat::TO_CBOR {
1379 my ($n, $d) = $_[0]->parts;
1380
1381 # older versions of BigRat need *1, as they not always return numbers
1382
1383 $d*1 == 1
1384 ? $n*1
1385 : tag 30, [$n*1, $d*1]
1146} 1386}
1147 1387
1148sub Time::Piece::TO_CBOR { 1388sub Time::Piece::TO_CBOR {
1149 tag 1, 0 + $_[0]->epoch 1389 tag 1, 0 + $_[0]->epoch
1150} 1390}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines