CBOR-XS-1.87/ 0000755 0000000 0000000 00000000000 14477425252 011240 5 ustar root root CBOR-XS-1.87/typemap 0000644 0000000 0000000 00000000473 12232545114 012631 0 ustar root root CBOR * T_CBOR
INPUT
T_CBOR
if (!(
SvROK ($arg)
&& SvOBJECT (SvRV ($arg))
&& (SvSTASH (SvRV ($arg)) == CBOR_STASH || sv_derived_from ($arg, \"CBOR::XS\"))
))
croak (\"object is not of type CBOR::XS\");
/**/
$var = (CBOR *)SvPVX (SvRV ($arg));
CBOR-XS-1.87/COPYING 0000644 0000000 0000000 00000104513 11576712531 012273 0 ustar root root GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
.
CBOR-XS-1.87/Makefile.PL 0000644 0000000 0000000 00000001224 14476675360 013217 0 ustar root root use 5.010001; # for utf-8, and Time::Piece
use ExtUtils::MakeMaker;
use Canary::Stability CBOR::XS => 1, 5.010001;
WriteMakefile(
dist => {
PREOP => 'pod2text XS.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;',
COMPRESS => 'gzip -9v',
SUFFIX => '.gz',
},
VERSION_FROM => "XS.pm",
NAME => "CBOR::XS",
PREREQ_PM => {
common::sense => 0,
Types::Serialiser => 0,
},
TEST_REQUIRES => {
Task::Weaken => 1.06,
},
CONFIGURE_REQUIRES => {
ExtUtils::MakeMaker => 6.64,
Canary::Stability => 0,
},
);
CBOR-XS-1.87/t/ 0000755 0000000 0000000 00000000000 14477425252 011503 5 ustar root root CBOR-XS-1.87/t/55_utf8.t 0000644 0000000 0000000 00000001752 12246644027 013067 0 ustar root root BEGIN { $| = 1; print "1..9\n"; }
BEGIN { $^W = 0 } # hate
use CBOR::XS;
print "ok 1\n";
$dec = CBOR::XS->new->decode ("\x62\xc3\xbc");
print $dec eq "\xfc" ? "" : "not ", "ok 2 # $dec\n";
$dec = eval { CBOR::XS->new->decode ("\x62\xc3\xc3"); 1 };
print $dec eq 1 ? "" : "not ", "ok 3 # $dec\n";
$dec = eval { CBOR::XS->new->decode ("\x61\xc3"); 1 };
print $dec eq 1 ? "" : "not ", "ok 4 # $dec\n";
$dec = eval { CBOR::XS->new->validate_utf8->decode ("\x62\xc3\xc3"); 1 };
print !$dec ? "" : "not ", "ok 5 # $dec\n";
$dec = eval { CBOR::XS->new->validate_utf8->decode ("\x61\xc3"); 1 };
print !$dec ? "" : "not ", "ok 6 # $dec\n";
$dec = CBOR::XS->new->decode ("\xa1\x62\xc3\xbc\xf6");
print "\xfc" eq (keys %$dec)[0] ? "" : "not ", "ok 7 # $dec\n";
$dec = eval { CBOR::XS->new->decode ("\xa1\x62\xc3\xc3\xf6"); 1 };
print $dec eq 1 ? "" : "not ", "ok 8 # $dec\n";
$dec = eval { CBOR::XS->new->validate_utf8->decode ("\xa1\x62\xc3\xc3\xf6"); 1 };
print !$dec ? "" : "not ", "ok 9 # $dec\n";
CBOR-XS-1.87/t/00_load.t 0000644 0000000 0000000 00000000166 12232545004 013072 0 ustar root root BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use CBOR::XS;
$loaded = 1;
print "ok 1\n";
CBOR-XS-1.87/t/50_rfc.t 0000644 0000000 0000000 00000012611 12262426113 012732 0 ustar root root BEGIN { $| = 1; print "1..78\n"; }
# examples from rfc7049
use Data::Dumper;
use CBOR::XS;
binmode DATA;
binmode STDOUT, ":utf8";
my $test;
sub ok($;$) {
print $_[0] ? "" : "not ", "ok ", ++$test, " - $_[1]\n";
}
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Pair = ',';
$Data::Dumper::Useqq = 1;
$Data::Dumper::Indent = 0;
$Data::Dumper::Quotekeys = 1;
while () {
next unless /^([<>\+*])\s*(.*?)\s*0x([0-9a-f]+)$/;
my ($dir, $val, $hex) = ($1, $2, $3);
my $src = $val;
$src =~ y/_//d;
utf8::decode $src if $src =~ /[\x80-\xff]/;
my $bin = pack "H*", $hex;
if ($dir eq "+") {
my $dec = decode_cbor $bin;
my $str = $dec;
ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>");
my $enc = unpack "H*", encode_cbor $dec;
ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>");
}
if ($dir eq "<") {
my $dec = decode_cbor $bin;
my $str = $dec;
$str = Dumper $str if ref $str;
ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>");
}
#$src = eval $src if $src =~ /^[\[\{]/;
if ($dir eq "*") {
my $dec = decode_cbor $bin;
my $enc = unpack "H*", encode_cbor $dec;
ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>");
}
}
# first char
# < decode, check
# + decode, check, encode, check
# * decode, encode, check
__DATA__
+ 0 0x00
+ 1 0x01
+ 10 0x0a
+ 23 0x17
+ 24 0x1818
+ 25 0x1819
+ 100 0x1864
+ 1000 0x1903e8
+ 1000000 0x1a000f4240
1000000000000 0x1b000000e8d4a51000
18446744073709551615 0x1bffffffffffffffff
18446744073709551616 0xc249010000000000000000
-18446744073709551616 0x3bffffffffffffffff
-18446744073709551617 0xc349010000000000000000
+ -1 0x20
+ -10 0x29
+ -100 0x3863
+ -1000 0x3903e7
< 0 0xf90000
-0 0xf98000
< 1 0xf93c00
* 1.1 0xfb3ff199999999999a
< 1.5 0xf93e00
< 65504 0xf97bff
< 100000 0xfa47c35000
* 3.4028234663852886e+38 0xfa7f7fffff
* 1e+300 0xfb7e37e43c8800759c
5.960464477539063e-8 0xf90001
0.00006103515625 0xf90400
< -4 0xf9c400
* -4.1 0xfbc010666666666666
Infinity 0xf97c00
NaN 0xf97e00
-Infinity 0xf9fc00
* Infinity 0xfa7f800000
NaN 0xfa7fc00000
* -Infinity 0xfaff800000
Infinity 0xfb7ff0000000000000
* NaN 0xfb7ff8000000000000
-Infinity 0xfbfff0000000000000
* false 0xf4
* true 0xf5
* null 0xf6
* undefined 0xf7
simple(16) 0xf0
simple(24) 0xf818
simple(255) 0xf8ff
0("2013-03-21T20:04:00Z") 0xc074323031332d30332d32315432303a30343a30305a
* 1(1363896240) 0xc11a514b67b0
* 1(1363896240.5) 0xc1fb41d452d9ec200000
23(h'01020304') 0xd74401020304
* 24(h'6449455446') 0xd818456449455446
32("http://www.example.com") 0xd82076687474703a2f2f7777772e6578616d706c652e636f6d
* h'' 0x40
* h'01020304' 0x4401020304
* "" 0x60
+ a 0x6161
+ IETF 0x6449455446
+ "\ 0x62225c
+ ü 0x62c3bc
+ 水 0x63e6b0b4
+ 𐅑 0x64f0908591
* [] 0x80
* [1,2,3] 0x83010203
* [1,[2,3],[4,5]] 0x8301820203820405
* [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]0x98190102030405060708090a0b0c0d0e0f101112131415161718181819
* {} 0xa0
{1,2,3,4} 0xa201020304 # fails because of broken data::dumper
< {"a",1,"b",[2,3]} 0xa26161016162820203
< ["a",{"b","c"}] 0x826161a161626163
< {"a","A","b","B","c","C","d","D","e","E"}0xa56161614161626142616361436164614461656145
(_h'0102',h'030405') 0x5f42010243030405ff
< streaming 0x7f657374726561646d696e67ff
< [_] 0x9fff
< [_1,[2,3],[_4,5]] 0x9f018202039f0405ffff
< [_1,[2,3],[4,5]] 0x9f01820203820405ff
< [1,[2,3],[_4,5]] 0x83018202039f0405ff
< [1,[_2,3],[4,5]] 0x83019f0203ff820405
< [_1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]0x9f0102030405060708090a0b0c0d0e0f101112131415161718181819ff
< {_"a",1,"b",[_2,3]} 0xbf61610161629f0203ffff
< ["a",{_"b","c"}] 0x826161bf61626163ff
{_"Fun",true,"Amt",-2} 0xbf6346756ef563416d7421ff
CBOR-XS-1.87/t/58_hv.t 0000644 0000000 0000000 00000004540 12707223617 012617 0 ustar root root BEGIN { $| = 1; print "1..21\n"; }
# none of the other tests serialise hv's, gross
# also checks text_keys/text_strings
use CBOR::XS;
print "ok 1\n";
$enc = encode_cbor {};
print $enc ne "\xa0" ? "not " : "", "ok 2\n";
$enc = encode_cbor { 5 => 6 };
print $enc ne (pack "H*", "a1413506") ? "not " : "", "ok 3\n";
$enc = encode_cbor { "" => \my $dummy };
print $enc ne (pack "H*", "a140d95652f6") ? "not " : "", "ok 4\n";
$enc = encode_cbor { undef() => \my $dummy };
print $enc ne (pack "H*", "a140d95652f6") ? "not " : "", "ok 5\n";
$enc = encode_cbor { "abc" => "def" };
print $enc ne (pack "H*", "a14361626343646566") ? "not " : "", "ok 6\n";
$enc = encode_cbor { "abc" => "def", "geh" => "ijk" };
print $enc !~ /^\xa2/ ? "not " : "", "ok 7\n";
print 17 ne length $enc ? "not " : "", "ok 8\n";
$enc = encode_cbor { "\x{7f}" => undef };
print $enc ne (pack "H*", "a1417ff6") ? "not " : "", "ok 9\n";
$dec = decode_cbor pack "H*", "a1417ff6";
print +(keys %$dec)[0] ne "\x{7f}" ? "not " : "", "ok 10\n";
$enc = encode_cbor { "\x{100}" => undef };
print $enc ne (pack "H*", "a162c480f6") ? "not " : "", "ok 11\n";
$dec = decode_cbor pack "H*", "a162c480f6";
print +(keys %$dec)[0] ne "\x{100}" ? "not " : "", "ok 12\n";
$enc = encode_cbor { "\x{8f}" => undef };
print $enc ne (pack "H*", "a1418ff6") ? "not " : "", "ok 13\n";
$text_strings = CBOR::XS->new->text_strings;
$enc = $text_strings->encode ({ "\x{7f}" => "\x{3f}" });
print $enc ne (pack "H*", "a1617f613f") ? "not " : "", "ok 14\n";
$enc = $text_strings->encode ({ "\x{8f}" => "\x{c7}" });
print $enc ne (pack "H*", "a162c28f62c387") ? "not " : "", "ok 15\n";
$enc = $text_strings->encode ({ "\x{8f}gix\x{ff}x" => "a\x{80}b\x{fe}y" });
print $enc ne (pack "H*", "a168c28f676978c3bf786761c28062c3be79") ? "not " : "", "ok 16\n";
$dec = decode_cbor pack "H*", "a168c28f676978c3bf78f6";
print +(keys %$dec)[0] ne "\x{8f}gix\x{ff}x" ? "not " : "", "ok 17\n";
$text_keys = CBOR::XS->new->text_keys;
$enc = $text_keys->encode ({ "\x{7f}" => "\x{3f}" });
print $enc ne (pack "H*", "a1617f413f") ? "not " : "", "ok 18\n";
$enc = $text_keys->encode ({ "\x{8f}" => "\x{c7}" });
print $enc ne (pack "H*", "a162c28f41c7") ? "not " : "", "ok 19\n";
$enc = $text_keys->encode ({ "\x{8f}gix\x{ff}x" => "a\x{80}b\x{fe}y" });
print $enc ne (pack "H*", "a168c28f676978c3bf7845618062fe79") ? "not " : "", "ok 20\n";
print "ok 21\n";
CBOR-XS-1.87/t/56_filter.t 0000644 0000000 0000000 00000002106 12246662641 013463 0 ustar root root BEGIN { $| = 1; print "1..8\n"; }
BEGIN { $^W = 0 } # hate
use CBOR::XS;
print "ok 1\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 0, "2003-12-13T18:30:02Z")->epoch;
print $dec == 1071340202 ? "" : "not ", "ok 2 # $dec\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 0, "2003-12-13T18:30:02.25Z")->epoch;
print $dec == 1071340202.25 ? "" : "not ", "ok 3 # $dec\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 0, "2003-12-13T18:30:02+01:00")->epoch;
print $dec == 1071336602 ? "" : "not ", "ok 4 # $dec\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 0, "2003-12-13T18:30:02.25+01:00")->epoch;
print $dec == 1071336602.25 ? "" : "not ", "ok 5 # $dec\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 1, 123456789)->epoch;
print $dec == 123456789 ? "" : "not ", "ok 6 # $dec\n";
$dec = (decode_cbor encode_cbor CBOR::XS::tag 1, 123456789.75)->epoch;
print $dec == 123456789.75 ? "" : "not ", "ok 7 # $dec\n";
$dec = (decode_cbor encode_cbor decode_cbor encode_cbor CBOR::XS::tag 1, 123456789.75)->epoch;
print $dec == 123456789.75 ? "" : "not ", "ok 8 # $dec\n";
CBOR-XS-1.87/t/99_binary.t 0000644 0000000 0000000 00000001220 12233506571 013460 0 ustar root root BEGIN { $| = 1; print "1..6144\n"; }
use CBOR::XS;
our $test;
sub ok($;$) {
print $_[0] ? "" : "not ", "ok ", ++$test, " - $_[1]\n";
}
sub test($) {
my $js;
$js = CBOR::XS->new->shrink->encode ([$_[0]]);
ok ($_[0] eq ((decode_cbor $js)->[0]), 0);
$js = CBOR::XS->new->encode ([$_[0]]);
ok ($_[0] eq (CBOR::XS->new->shrink->decode($js))->[0], 1);
}
srand 0; # doesn't help too much, but its at least more deterministic
for (1..768) {
test join "", map chr ($_ & 255), 0..$_;
test join "", map chr rand 255, 0..$_;
test join "", map chr ($_ * 97 & ~0x4000), 0..$_;
test join "", map chr (rand (2**20) & ~0x800), 0..$_;
}
CBOR-XS-1.87/t/52_object.t 0000644 0000000 0000000 00000002445 12246423410 013433 0 ustar root root BEGIN { $| = 1; print "1..20\n"; }
BEGIN { $^W = 0 } # hate
use CBOR::XS;
print "ok 1\n";
sub CBOR::XS::tocbor::TO_CBOR {
print @_ == 1 ? "" : "not ", "ok 3\n";
print CBOR::XS::tocbor:: eq ref $_[0] ? "" : "not ", "ok 4\n";
print $_[0]{k} == 1 ? "" : "not ", "ok 5\n";
7
}
$obj = bless { k => 1 }, CBOR::XS::tocbor::;
print "ok 2\n";
$enc = encode_cbor $obj;
print $enc eq "\x07" ? "" : "not ", "ok 6\n";
print "ok 7\n";
sub CBOR::XS::freeze::FREEZE {
print @_ == 2 ? "" : "not ", "ok 8\n";
print $_[1] eq "CBOR" ? "" : "not ", "ok 9\n";
print CBOR::XS::freeze:: eq ref $_[0] ? "" : "not ", "ok 10\n";
print $_[0]{k} == 1 ? "" : "not ", "ok 11\n";
(3, 1, 2)
}
sub CBOR::XS::freeze::THAW {
print @_ == 5 ? "" : "not ", "ok 13\n";
print CBOR::XS::freeze:: eq $_[0] ? "" : "not ", "ok 14\n";
print $_[1] eq "CBOR" ? "" : "not ", "ok 15\n";
print $_[2] == 3 ? "" : "not ", "ok 16\n";
print $_[3] == 1 ? "" : "not ", "ok 17\n";
print $_[4] == 2 ? "" : "not ", "ok 18\n";
777
}
$obj = bless { k => 1 }, CBOR::XS::freeze::;
$enc = encode_cbor $obj;
print $enc eq (pack "H*", "d81a845043424f523a3a58533a3a667265657a65030102") ? "" : "not ", "ok 12 ", (unpack "H*", $enc), "\n";
$dec = decode_cbor $enc;
print $dec eq 777 ? "" : "not ", "ok 19\n";
print "ok 20\n";
CBOR-XS-1.87/t/53_bignum.t 0000644 0000000 0000000 00000003445 13761024360 013454 0 ustar root root BEGIN { $| = 1; print "1..105\n"; }
BEGIN { $^W = 0 } # hate
use CBOR::XS;
use Math::BigInt only => "FastCalc"; # needed for representation stability
print "ok 1\n";
my $t = decode_cbor pack "H*", "82c48221196ab3c5822003";
print $t->[0] eq "273.15" ? "" : "not ", "ok 2 # $t->[0]\n";
print $t->[1] eq "1.5" ? "" : "not ", "ok 3 # $t->[1]\n";
$t = encode_cbor $t;
print $t eq (pack "H*", "82c48221196ab3c482200f") ? "" : "not ", "ok 4 # ", (unpack "H*", $t), "\n";
# Math::BigFloat must be loaded by now...
for (5..99) {
my $n = Math::BigFloat->new ((int rand 1e9) . "." . (int rand 1e9) . "e" . ((int rand 1e8) - 0.5e8));
my $m = decode_cbor encode_cbor $n;
$n = $n->bsstr;
$m = $m->bsstr;
print $n != $m ? "not " : "ok $_ # $n eq $m\n";
}
$t = encode_cbor CBOR::XS::tag 264, [Math::BigInt->new ("99999999999999999998"), Math::BigInt->new ("799999999999999999998")];
$t = decode_cbor $t;
print "799999999999999999998e+99999999999999999998" eq $t->bsstr ? "" : "not ", "ok 100\n";
$t = encode_cbor $t;
if (0) {#d#
# TODO: this tests sometimes fails due to Math::BigFloat brokenness, so disable it for the time being.#d#
# It seems the new Math::Big* does a good job at breaking these modules more and more.#d#
# actually, this test is probably hardcoding bigfloat bugs anyway...#d#
print "d9010882c249056bc75e2d63100000c2492b5e3af16b187ffffe" eq (unpack "H*", $t) ? "" : "not ", "ok 101\n";
} else {#d#
print "ok 101\n";#d#
}#d#
$t = encode_cbor CBOR::XS::tag 30, [4, 2];
$t = decode_cbor $t;
print $t eq 2 ? "" : "not ", "ok 102 # $t\n";
$t = encode_cbor $t;
print "02" eq (unpack "H*", $t) ? "" : "not ", "ok 103\n";
$t = encode_cbor decode_cbor encode_cbor CBOR::XS::tag 30, [Math::BigInt->new (5), 2];
print "d81e820502" eq (unpack "H*", $t) ? "" : "not ", "ok 104\n";
print "ok 105\n";
CBOR-XS-1.87/t/51_types.t 0000644 0000000 0000000 00000003370 12246410403 013324 0 ustar root root BEGIN { $| = 1; print "1..21\n"; }
use Types::Serialiser;
use CBOR::XS;
print "ok 1\n";
$enc = encode_cbor Types::Serialiser::false;
print $enc ne "\xf4" ? "not " : "", "ok 2\n";
$dec = decode_cbor $enc;
print Types::Serialiser::is_false $dec ? "" : "not ", "ok 3\n";
print Types::Serialiser::is_bool $dec ? "" : "not ", "ok 4\n";
$enc = encode_cbor Types::Serialiser::true;
print $enc ne "\xf5" ? "not " : "", "ok 5\n";
$dec = decode_cbor $enc;
print Types::Serialiser::is_true $dec ? "" : "not ", "ok 6\n";
print Types::Serialiser::is_bool $dec ? "" : "not ", "ok 7\n";
$enc = encode_cbor Types::Serialiser::error;
print $enc ne "\xf7" ? "not " : "", "ok 8\n";
$dec = decode_cbor $enc;
print Types::Serialiser::is_error $dec ? "" : "not ", "ok 9\n";
$enc = encode_cbor undef;
print $enc ne "\xf6" ? "not " : "", "ok 10\n";
$dec = decode_cbor $enc;
print !defined $dec ? "" : "not ", "ok 11\n";
my $c = CBOR::XS->new->allow_sharing;
$enc = $c->encode (Types::Serialiser::false);
print $enc ne "\xf4" ? "not " : "", "ok 12\n";
$dec = $c->decode ($enc);
print Types::Serialiser::is_false $dec ? "" : "not ", "ok 13\n";
print Types::Serialiser::is_bool $dec ? "" : "not ", "ok 14\n";
$enc = $c->encode (Types::Serialiser::true);
print $enc ne "\xf5" ? "not " : "", "ok 15\n";
$dec = $c->decode ($enc);
print Types::Serialiser::is_true $dec ? "" : "not ", "ok 16\n";
print Types::Serialiser::is_bool $dec ? "" : "not ", "ok 17\n";
$enc = $c->encode (Types::Serialiser::error);
print $enc ne "\xf7" ? "not " : "", "ok 18\n";
$dec = $c->decode ($enc);
print Types::Serialiser::is_error $dec ? "" : "not ", "ok 19\n";
$enc = $c->encode (undef);
print $enc ne "\xf6" ? "not " : "", "ok 20\n";
$dec = $c->decode ($enc);
print !defined $dec ? "" : "not ", "ok 21\n";
CBOR-XS-1.87/t/54_sharing.t 0000644 0000000 0000000 00000003105 14476676753 013647 0 ustar root root BEGIN { $| = 1; print "1..16\n"; }
BEGIN { $^W = 0 } # hate
use CBOR::XS;
use Scalar::Util ();
print "ok 1\n";
sub CBOR::XS::freeze::FREEZE { 77 }
sub CBOR::XS::freeze::THAW { \my $dummy }
$enc = CBOR::XS::encode_cbor_sharing [(bless [], CBOR::XS::freeze::) x 3];
print $enc eq (pack "H*", "83d81cd81a825043424f523a3a58533a3a667265657a65184dd81d00d81d00") ? "" : "not ", "ok 2 ", (unpack "H*", $enc), "\n";
$enc = CBOR::XS->new->allow_sharing->encode ([(bless [], CBOR::XS::freeze::) x 3]);
print $enc eq (pack "H*", "83d81cd81a825043424f523a3a58533a3a667265657a65184dd81d00d81d00") ? "" : "not ", "ok 3 ", (unpack "H*", $enc), "\n";
$dec = decode_cbor $enc;
print @$dec == 3 ? "" : "not ", "ok 4 # $dec\n";
print ref $dec->[0] ? "" : "not ", "ok 5 # $dec->[0]\n";
print $dec->[0] == $dec->[2] ? "" : "not ", "ok 6 # $dec->[0] == $dec->[2]\n";
$enc = eval { CBOR::XS::decode_cbor pack "H*", "d81c81d81d00" };
print defined $enc ? "not " : "", "ok 7\n";
print $@ =~ /^cyclic / ? "" : "not ", "ok 8\n";
$dec = CBOR::XS->new->allow_cycles->decode (pack "H*", "d81c81d81d00");
print ARRAY:: eq ref $dec ? "" : "not ", "ok 9\n";
print $dec == $dec->[0] ? "" : "not ", "ok 10\n";
$dec = CBOR::XS->new->allow_weak_cycles->decode (pack "H*", "82d81c81d81d00d81d00");
print $dec->[0] == $dec->[1] ? "" : "not ", "ok 11\n";
print $dec->[0] == $dec->[0][0] ? "" : "not ", "ok 12\n";
print Scalar::Util::isweak $dec->[0] ? "not " : "", "ok 13\n";
print Scalar::Util::isweak $dec->[1] ? "not " : "", "ok 14\n";
print Scalar::Util::isweak $dec->[0][0] ? "" : "not ", "ok 15\n";
print "ok 16\n";
CBOR-XS-1.87/t/57_incr.t 0000644 0000000 0000000 00000002656 12262271061 013132 0 ustar root root BEGIN { $| = 1; print "1..123\n"; }
use CBOR::XS;
print "ok 1\n";
my $tst = 1;
sub tst($$) {
my ($cbor, $correct) = @_;
my $dec = CBOR::XS->new;
# chop
for my $step (1 .. length $cbor) {
my $buf = "";
my @cbor;
$dec->incr_reset;
for (unpack "(a$step)*", $cbor) {
$buf .= $_;
push @cbor, $dec->incr_parse_multiple ($buf);
}
print length $buf ? "not " : "", "ok ", ++$tst, "\n";
my $enc = join " ", map +(unpack "H*", encode_cbor $_), @cbor;
print $enc eq $correct ? "" : "not ", "ok ", ++$tst, " # ($step) $enc eq $correct\n";
}
}
sub err($$) {
if (eval { CBOR::XS->new->max_size (1e3)->incr_parse ($_[0]); 1 }) {
print "not ok ", ++$tst, " # unexpected success\n";
} elsif ($@ =~ $_[1]) {
print "ok ", ++$tst, "\n";
} else {
print "not ok ", ++$tst, " # $@\n";
}
}
tst "\x81\x82\x81\x80\x80\x80", "8182818080 80";
tst "\x01\x18\x55\x01", "01 1855 01";
#tst "\x18\x01\x19\x02\x02\x1a\x04\x04\x04\x04\x1b\x08\x08\x08\x08\x08\x08\x08\x08\x00", "01 190202 1a04040404 1b0808080808080808 00";
tst "\x18\x01\x19\x02\x02\x1a\x04\x04\x04\x04\x00", "01 190202 1a04040404 00";
tst "\x41A\x42CD", "4141 424344";
tst "\x58\x01A\x59\x00\x01B\x5a\x00\x00\x00\x01C\x5b\x00\x00\x00\x00\x00\x00\x00\x02XY\x01", "4141 4142 4143 425859 01";
tst "\x5f\x41A\x41B\x42CD\xff", "4441424344";
err "\xff", "major 7";
err "\x5a\xff\x00\x00\x00", "max_size";
CBOR-XS-1.87/ecb.h 0000644 0000000 0000000 00000144464 14064362426 012152 0 ustar root root /*
* libecb - http://software.schmorp.de/pkg/libecb
*
* Copyright (©) 2009-2015,2018-2021 Marc Alexander Lehmann
* Copyright (©) 2011 Emanuele Giaquinta
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without modifica-
* tion, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MER-
* CHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
* EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPE-
* CIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTH-
* ERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
*
* Alternatively, the contents of this file may be used under the terms of
* the GNU General Public License ("GPL") version 2 or any later version,
* in which case the provisions of the GPL are applicable instead of
* the above. If you wish to allow the use of your version of this file
* only under the terms of the GPL and not to allow others to use your
* version of this file under the BSD license, indicate your decision
* by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL. If you do not delete the
* provisions above, a recipient may use your version of this file under
* either the BSD or the GPL.
*/
#ifndef ECB_H
#define ECB_H
/* 16 bits major, 16 bits minor */
#define ECB_VERSION 0x00010009
#include /* for memcpy */
#if defined (_WIN32) && !defined (__MINGW32__)
typedef signed char int8_t;
typedef unsigned char uint8_t;
typedef signed char int_fast8_t;
typedef unsigned char uint_fast8_t;
typedef signed short int16_t;
typedef unsigned short uint16_t;
typedef signed int int_fast16_t;
typedef unsigned int uint_fast16_t;
typedef signed int int32_t;
typedef unsigned int uint32_t;
typedef signed int int_fast32_t;
typedef unsigned int uint_fast32_t;
#if __GNUC__
typedef signed long long int64_t;
typedef unsigned long long uint64_t;
#else /* _MSC_VER || __BORLANDC__ */
typedef signed __int64 int64_t;
typedef unsigned __int64 uint64_t;
#endif
typedef int64_t int_fast64_t;
typedef uint64_t uint_fast64_t;
#ifdef _WIN64
#define ECB_PTRSIZE 8
typedef uint64_t uintptr_t;
typedef int64_t intptr_t;
#else
#define ECB_PTRSIZE 4
typedef uint32_t uintptr_t;
typedef int32_t intptr_t;
#endif
#else
#include
#if (defined INTPTR_MAX ? INTPTR_MAX : ULONG_MAX) > 0xffffffffU
#define ECB_PTRSIZE 8
#else
#define ECB_PTRSIZE 4
#endif
#endif
#define ECB_GCC_AMD64 (__amd64 || __amd64__ || __x86_64 || __x86_64__)
#define ECB_MSVC_AMD64 (_M_AMD64 || _M_X64)
#ifndef ECB_OPTIMIZE_SIZE
#if __OPTIMIZE_SIZE__
#define ECB_OPTIMIZE_SIZE 1
#else
#define ECB_OPTIMIZE_SIZE 0
#endif
#endif
/* work around x32 idiocy by defining proper macros */
#if ECB_GCC_AMD64 || ECB_MSVC_AMD64
#if _ILP32
#define ECB_AMD64_X32 1
#else
#define ECB_AMD64 1
#endif
#endif
#if ECB_PTRSIZE >= 8 || ECB_AMD64_X32
#define ECB_64BIT_NATIVE 1
#else
#define ECB_64BIT_NATIVE 0
#endif
/* many compilers define _GNUC_ to some versions but then only implement
* what their idiot authors think are the "more important" extensions,
* causing enormous grief in return for some better fake benchmark numbers.
* or so.
* we try to detect these and simply assume they are not gcc - if they have
* an issue with that they should have done it right in the first place.
*/
#if !defined __GNUC_MINOR__ || defined __INTEL_COMPILER || defined __SUNPRO_C || defined __SUNPRO_CC || defined __llvm__ || defined __clang__
#define ECB_GCC_VERSION(major,minor) 0
#else
#define ECB_GCC_VERSION(major,minor) (__GNUC__ > (major) || (__GNUC__ == (major) && __GNUC_MINOR__ >= (minor)))
#endif
#define ECB_CLANG_VERSION(major,minor) (__clang_major__ > (major) || (__clang_major__ == (major) && __clang_minor__ >= (minor)))
#if __clang__ && defined __has_builtin
#define ECB_CLANG_BUILTIN(x) __has_builtin (x)
#else
#define ECB_CLANG_BUILTIN(x) 0
#endif
#if __clang__ && defined __has_extension
#define ECB_CLANG_EXTENSION(x) __has_extension (x)
#else
#define ECB_CLANG_EXTENSION(x) 0
#endif
#define ECB_CPP (__cplusplus+0)
#define ECB_CPP11 (__cplusplus >= 201103L)
#define ECB_CPP14 (__cplusplus >= 201402L)
#define ECB_CPP17 (__cplusplus >= 201703L)
#if ECB_CPP
#define ECB_C 0
#define ECB_STDC_VERSION 0
#else
#define ECB_C 1
#define ECB_STDC_VERSION __STDC_VERSION__
#endif
#define ECB_C99 (ECB_STDC_VERSION >= 199901L)
#define ECB_C11 (ECB_STDC_VERSION >= 201112L)
#define ECB_C17 (ECB_STDC_VERSION >= 201710L)
#if ECB_CPP
#define ECB_EXTERN_C extern "C"
#define ECB_EXTERN_C_BEG ECB_EXTERN_C {
#define ECB_EXTERN_C_END }
#else
#define ECB_EXTERN_C extern
#define ECB_EXTERN_C_BEG
#define ECB_EXTERN_C_END
#endif
/*****************************************************************************/
/* ECB_NO_THREADS - ecb is not used by multiple threads, ever */
/* ECB_NO_SMP - ecb might be used in multiple threads, but only on a single cpu */
#if ECB_NO_THREADS
#define ECB_NO_SMP 1
#endif
#if ECB_NO_SMP
#define ECB_MEMORY_FENCE do { } while (0)
#endif
/* http://www-01.ibm.com/support/knowledgecenter/SSGH3R_13.1.0/com.ibm.xlcpp131.aix.doc/compiler_ref/compiler_builtins.html */
#if __xlC__ && ECB_CPP
#include
#endif
#if 1400 <= _MSC_VER
#include /* fence functions _ReadBarrier, also bit search functions _BitScanReverse */
#endif
#ifndef ECB_MEMORY_FENCE
#if ECB_GCC_VERSION(2,5) || defined __INTEL_COMPILER || (__llvm__ && __GNUC__) || __SUNPRO_C >= 0x5110 || __SUNPRO_CC >= 0x5110
#define ECB_MEMORY_FENCE_RELAXED __asm__ __volatile__ ("" : : : "memory")
#if __i386 || __i386__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("lock; orb $0, -1(%%esp)" : : : "memory")
#define ECB_MEMORY_FENCE_ACQUIRE __asm__ __volatile__ ("" : : : "memory")
#define ECB_MEMORY_FENCE_RELEASE __asm__ __volatile__ ("" : : : "memory")
#elif ECB_GCC_AMD64
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("mfence" : : : "memory")
#define ECB_MEMORY_FENCE_ACQUIRE __asm__ __volatile__ ("" : : : "memory")
#define ECB_MEMORY_FENCE_RELEASE __asm__ __volatile__ ("" : : : "memory")
#elif __powerpc__ || __ppc__ || __powerpc64__ || __ppc64__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("sync" : : : "memory")
#elif defined __ARM_ARCH_2__ \
|| defined __ARM_ARCH_3__ || defined __ARM_ARCH_3M__ \
|| defined __ARM_ARCH_4__ || defined __ARM_ARCH_4T__ \
|| defined __ARM_ARCH_5__ || defined __ARM_ARCH_5E__ \
|| defined __ARM_ARCH_5T__ || defined __ARM_ARCH_5TE__ \
|| defined __ARM_ARCH_5TEJ__
/* should not need any, unless running old code on newer cpu - arm doesn't support that */
#elif defined __ARM_ARCH_6__ || defined __ARM_ARCH_6J__ \
|| defined __ARM_ARCH_6K__ || defined __ARM_ARCH_6ZK__ \
|| defined __ARM_ARCH_6T2__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("mcr p15,0,%0,c7,c10,5" : : "r" (0) : "memory")
#elif defined __ARM_ARCH_7__ || defined __ARM_ARCH_7A__ \
|| defined __ARM_ARCH_7R__ || defined __ARM_ARCH_7M__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("dmb" : : : "memory")
#elif __aarch64__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("dmb ish" : : : "memory")
#elif (__sparc || __sparc__) && !(__sparc_v8__ || defined __sparcv8)
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("membar #LoadStore | #LoadLoad | #StoreStore | #StoreLoad" : : : "memory")
#define ECB_MEMORY_FENCE_ACQUIRE __asm__ __volatile__ ("membar #LoadStore | #LoadLoad" : : : "memory")
#define ECB_MEMORY_FENCE_RELEASE __asm__ __volatile__ ("membar #LoadStore | #StoreStore")
#elif defined __s390__ || defined __s390x__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("bcr 15,0" : : : "memory")
#elif defined __mips__
/* GNU/Linux emulates sync on mips1 architectures, so we force its use */
/* anybody else who still uses mips1 is supposed to send in their version, with detection code. */
#define ECB_MEMORY_FENCE __asm__ __volatile__ (".set mips2; sync; .set mips0" : : : "memory")
#elif defined __alpha__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("mb" : : : "memory")
#elif defined __hppa__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("" : : : "memory")
#define ECB_MEMORY_FENCE_RELEASE __asm__ __volatile__ ("")
#elif defined __ia64__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("mf" : : : "memory")
#elif defined __m68k__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("" : : : "memory")
#elif defined __m88k__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("tb1 0,%%r0,128" : : : "memory")
#elif defined __sh__
#define ECB_MEMORY_FENCE __asm__ __volatile__ ("" : : : "memory")
#endif
#endif
#endif
#ifndef ECB_MEMORY_FENCE
#if ECB_GCC_VERSION(4,7)
/* see comment below (stdatomic.h) about the C11 memory model. */
#define ECB_MEMORY_FENCE __atomic_thread_fence (__ATOMIC_SEQ_CST)
#define ECB_MEMORY_FENCE_ACQUIRE __atomic_thread_fence (__ATOMIC_ACQUIRE)
#define ECB_MEMORY_FENCE_RELEASE __atomic_thread_fence (__ATOMIC_RELEASE)
#undef ECB_MEMORY_FENCE_RELAXED
#define ECB_MEMORY_FENCE_RELAXED __atomic_thread_fence (__ATOMIC_RELAXED)
#elif ECB_CLANG_EXTENSION(c_atomic)
/* see comment below (stdatomic.h) about the C11 memory model. */
#define ECB_MEMORY_FENCE __c11_atomic_thread_fence (__ATOMIC_SEQ_CST)
#define ECB_MEMORY_FENCE_ACQUIRE __c11_atomic_thread_fence (__ATOMIC_ACQUIRE)
#define ECB_MEMORY_FENCE_RELEASE __c11_atomic_thread_fence (__ATOMIC_RELEASE)
#undef ECB_MEMORY_FENCE_RELAXED
#define ECB_MEMORY_FENCE_RELAXED __c11_atomic_thread_fence (__ATOMIC_RELAXED)
#elif ECB_GCC_VERSION(4,4) || defined __INTEL_COMPILER || defined __clang__
#define ECB_MEMORY_FENCE __sync_synchronize ()
#elif _MSC_VER >= 1500 /* VC++ 2008 */
/* apparently, microsoft broke all the memory barrier stuff in Visual Studio 2008... */
#pragma intrinsic(_ReadBarrier,_WriteBarrier,_ReadWriteBarrier)
#define ECB_MEMORY_FENCE _ReadWriteBarrier (); MemoryBarrier()
#define ECB_MEMORY_FENCE_ACQUIRE _ReadWriteBarrier (); MemoryBarrier() /* according to msdn, _ReadBarrier is not a load fence */
#define ECB_MEMORY_FENCE_RELEASE _WriteBarrier (); MemoryBarrier()
#elif _MSC_VER >= 1400 /* VC++ 2005 */
#pragma intrinsic(_ReadBarrier,_WriteBarrier,_ReadWriteBarrier)
#define ECB_MEMORY_FENCE _ReadWriteBarrier ()
#define ECB_MEMORY_FENCE_ACQUIRE _ReadWriteBarrier () /* according to msdn, _ReadBarrier is not a load fence */
#define ECB_MEMORY_FENCE_RELEASE _WriteBarrier ()
#elif defined _WIN32
#include
#define ECB_MEMORY_FENCE MemoryBarrier () /* actually just xchg on x86... scary */
#elif __SUNPRO_C >= 0x5110 || __SUNPRO_CC >= 0x5110
#include
#define ECB_MEMORY_FENCE __machine_rw_barrier ()
#define ECB_MEMORY_FENCE_ACQUIRE __machine_acq_barrier ()
#define ECB_MEMORY_FENCE_RELEASE __machine_rel_barrier ()
#define ECB_MEMORY_FENCE_RELAXED __compiler_barrier ()
#elif __xlC__
#define ECB_MEMORY_FENCE __sync ()
#endif
#endif
#ifndef ECB_MEMORY_FENCE
#if ECB_C11 && !defined __STDC_NO_ATOMICS__
/* we assume that these memory fences work on all variables/all memory accesses, */
/* not just C11 atomics and atomic accesses */
#include
#define ECB_MEMORY_FENCE atomic_thread_fence (memory_order_seq_cst)
#define ECB_MEMORY_FENCE_ACQUIRE atomic_thread_fence (memory_order_acquire)
#define ECB_MEMORY_FENCE_RELEASE atomic_thread_fence (memory_order_release)
#endif
#endif
#ifndef ECB_MEMORY_FENCE
#if !ECB_AVOID_PTHREADS
/*
* if you get undefined symbol references to pthread_mutex_lock,
* or failure to find pthread.h, then you should implement
* the ECB_MEMORY_FENCE operations for your cpu/compiler
* OR provide pthread.h and link against the posix thread library
* of your system.
*/
#include
#define ECB_NEEDS_PTHREADS 1
#define ECB_MEMORY_FENCE_NEEDS_PTHREADS 1
static pthread_mutex_t ecb_mf_lock = PTHREAD_MUTEX_INITIALIZER;
#define ECB_MEMORY_FENCE do { pthread_mutex_lock (&ecb_mf_lock); pthread_mutex_unlock (&ecb_mf_lock); } while (0)
#endif
#endif
#if !defined ECB_MEMORY_FENCE_ACQUIRE && defined ECB_MEMORY_FENCE
#define ECB_MEMORY_FENCE_ACQUIRE ECB_MEMORY_FENCE
#endif
#if !defined ECB_MEMORY_FENCE_RELEASE && defined ECB_MEMORY_FENCE
#define ECB_MEMORY_FENCE_RELEASE ECB_MEMORY_FENCE
#endif
#if !defined ECB_MEMORY_FENCE_RELAXED && defined ECB_MEMORY_FENCE
#define ECB_MEMORY_FENCE_RELAXED ECB_MEMORY_FENCE /* very heavy-handed */
#endif
/*****************************************************************************/
#if ECB_CPP
#define ecb_inline static inline
#elif ECB_GCC_VERSION(2,5)
#define ecb_inline static __inline__
#elif ECB_C99
#define ecb_inline static inline
#else
#define ecb_inline static
#endif
#if ECB_GCC_VERSION(3,3)
#define ecb_restrict __restrict__
#elif ECB_C99
#define ecb_restrict restrict
#else
#define ecb_restrict
#endif
typedef int ecb_bool;
#define ECB_CONCAT_(a, b) a ## b
#define ECB_CONCAT(a, b) ECB_CONCAT_(a, b)
#define ECB_STRINGIFY_(a) # a
#define ECB_STRINGIFY(a) ECB_STRINGIFY_(a)
#define ECB_STRINGIFY_EXPR(expr) ((expr), ECB_STRINGIFY_ (expr))
#define ecb_function_ ecb_inline
#if ECB_GCC_VERSION(3,1) || ECB_CLANG_VERSION(2,8)
#define ecb_attribute(attrlist) __attribute__ (attrlist)
#else
#define ecb_attribute(attrlist)
#endif
#if ECB_GCC_VERSION(3,1) || ECB_CLANG_BUILTIN(__builtin_constant_p)
#define ecb_is_constant(expr) __builtin_constant_p (expr)
#else
/* possible C11 impl for integral types
typedef struct ecb_is_constant_struct ecb_is_constant_struct;
#define ecb_is_constant(expr) _Generic ((1 ? (struct ecb_is_constant_struct *)0 : (void *)((expr) - (expr)), ecb_is_constant_struct *: 0, default: 1)) */
#define ecb_is_constant(expr) 0
#endif
#if ECB_GCC_VERSION(3,1) || ECB_CLANG_BUILTIN(__builtin_expect)
#define ecb_expect(expr,value) __builtin_expect ((expr),(value))
#else
#define ecb_expect(expr,value) (expr)
#endif
#if ECB_GCC_VERSION(3,1) || ECB_CLANG_BUILTIN(__builtin_prefetch)
#define ecb_prefetch(addr,rw,locality) __builtin_prefetch (addr, rw, locality)
#else
#define ecb_prefetch(addr,rw,locality)
#endif
/* no emulation for ecb_decltype */
#if ECB_CPP11
// older implementations might have problems with decltype(x)::type, work around it
template struct ecb_decltype_t { typedef T type; };
#define ecb_decltype(x) ecb_decltype_t::type
#elif ECB_GCC_VERSION(3,0) || ECB_CLANG_VERSION(2,8)
#define ecb_decltype(x) __typeof__ (x)
#endif
#if _MSC_VER >= 1300
#define ecb_deprecated __declspec (deprecated)
#else
#define ecb_deprecated ecb_attribute ((__deprecated__))
#endif
#if _MSC_VER >= 1500
#define ecb_deprecated_message(msg) __declspec (deprecated (msg))
#elif ECB_GCC_VERSION(4,5)
#define ecb_deprecated_message(msg) ecb_attribute ((__deprecated__ (msg))
#else
#define ecb_deprecated_message(msg) ecb_deprecated
#endif
#if _MSC_VER >= 1400
#define ecb_noinline __declspec (noinline)
#else
#define ecb_noinline ecb_attribute ((__noinline__))
#endif
#define ecb_unused ecb_attribute ((__unused__))
#define ecb_const ecb_attribute ((__const__))
#define ecb_pure ecb_attribute ((__pure__))
#if ECB_C11 || __IBMC_NORETURN
/* http://www-01.ibm.com/support/knowledgecenter/SSGH3R_13.1.0/com.ibm.xlcpp131.aix.doc/language_ref/noreturn.html */
#define ecb_noreturn _Noreturn
#elif ECB_CPP11
#define ecb_noreturn [[noreturn]]
#elif _MSC_VER >= 1200
/* http://msdn.microsoft.com/en-us/library/k6ktzx3s.aspx */
#define ecb_noreturn __declspec (noreturn)
#else
#define ecb_noreturn ecb_attribute ((__noreturn__))
#endif
#if ECB_GCC_VERSION(4,3)
#define ecb_artificial ecb_attribute ((__artificial__))
#define ecb_hot ecb_attribute ((__hot__))
#define ecb_cold ecb_attribute ((__cold__))
#else
#define ecb_artificial
#define ecb_hot
#define ecb_cold
#endif
/* put around conditional expressions if you are very sure that the */
/* expression is mostly true or mostly false. note that these return */
/* booleans, not the expression. */
#define ecb_expect_false(expr) ecb_expect (!!(expr), 0)
#define ecb_expect_true(expr) ecb_expect (!!(expr), 1)
/* for compatibility to the rest of the world */
#define ecb_likely(expr) ecb_expect_true (expr)
#define ecb_unlikely(expr) ecb_expect_false (expr)
/* count trailing zero bits and count # of one bits */
#if ECB_GCC_VERSION(3,4) \
|| (ECB_CLANG_BUILTIN(__builtin_clz) && ECB_CLANG_BUILTIN(__builtin_clzll) \
&& ECB_CLANG_BUILTIN(__builtin_ctz) && ECB_CLANG_BUILTIN(__builtin_ctzll) \
&& ECB_CLANG_BUILTIN(__builtin_popcount))
/* we assume int == 32 bit, long == 32 or 64 bit and long long == 64 bit */
#define ecb_ld32(x) (__builtin_clz (x) ^ 31)
#define ecb_ld64(x) (__builtin_clzll (x) ^ 63)
#define ecb_ctz32(x) __builtin_ctz (x)
#define ecb_ctz64(x) __builtin_ctzll (x)
#define ecb_popcount32(x) __builtin_popcount (x)
/* no popcountll */
#else
ecb_function_ ecb_const int ecb_ctz32 (uint32_t x);
ecb_function_ ecb_const int
ecb_ctz32 (uint32_t x)
{
#if 1400 <= _MSC_VER && (_M_IX86 || _M_X64 || _M_IA64 || _M_ARM)
unsigned long r;
_BitScanForward (&r, x);
return (int)r;
#else
int r = 0;
x &= ~x + 1; /* this isolates the lowest bit */
#if ECB_branchless_on_i386
r += !!(x & 0xaaaaaaaa) << 0;
r += !!(x & 0xcccccccc) << 1;
r += !!(x & 0xf0f0f0f0) << 2;
r += !!(x & 0xff00ff00) << 3;
r += !!(x & 0xffff0000) << 4;
#else
if (x & 0xaaaaaaaa) r += 1;
if (x & 0xcccccccc) r += 2;
if (x & 0xf0f0f0f0) r += 4;
if (x & 0xff00ff00) r += 8;
if (x & 0xffff0000) r += 16;
#endif
return r;
#endif
}
ecb_function_ ecb_const int ecb_ctz64 (uint64_t x);
ecb_function_ ecb_const int
ecb_ctz64 (uint64_t x)
{
#if 1400 <= _MSC_VER && (_M_X64 || _M_IA64 || _M_ARM)
unsigned long r;
_BitScanForward64 (&r, x);
return (int)r;
#else
int shift = x & 0xffffffff ? 0 : 32;
return ecb_ctz32 (x >> shift) + shift;
#endif
}
ecb_function_ ecb_const int ecb_popcount32 (uint32_t x);
ecb_function_ ecb_const int
ecb_popcount32 (uint32_t x)
{
x -= (x >> 1) & 0x55555555;
x = ((x >> 2) & 0x33333333) + (x & 0x33333333);
x = ((x >> 4) + x) & 0x0f0f0f0f;
x *= 0x01010101;
return x >> 24;
}
ecb_function_ ecb_const int ecb_ld32 (uint32_t x);
ecb_function_ ecb_const int ecb_ld32 (uint32_t x)
{
#if 1400 <= _MSC_VER && (_M_IX86 || _M_X64 || _M_IA64 || _M_ARM)
unsigned long r;
_BitScanReverse (&r, x);
return (int)r;
#else
int r = 0;
if (x >> 16) { x >>= 16; r += 16; }
if (x >> 8) { x >>= 8; r += 8; }
if (x >> 4) { x >>= 4; r += 4; }
if (x >> 2) { x >>= 2; r += 2; }
if (x >> 1) { r += 1; }
return r;
#endif
}
ecb_function_ ecb_const int ecb_ld64 (uint64_t x);
ecb_function_ ecb_const int ecb_ld64 (uint64_t x)
{
#if 1400 <= _MSC_VER && (_M_X64 || _M_IA64 || _M_ARM)
unsigned long r;
_BitScanReverse64 (&r, x);
return (int)r;
#else
int r = 0;
if (x >> 32) { x >>= 32; r += 32; }
return r + ecb_ld32 (x);
#endif
}
#endif
ecb_function_ ecb_const ecb_bool ecb_is_pot32 (uint32_t x);
ecb_function_ ecb_const ecb_bool ecb_is_pot32 (uint32_t x) { return !(x & (x - 1)); }
ecb_function_ ecb_const ecb_bool ecb_is_pot64 (uint64_t x);
ecb_function_ ecb_const ecb_bool ecb_is_pot64 (uint64_t x) { return !(x & (x - 1)); }
ecb_function_ ecb_const uint8_t ecb_bitrev8 (uint8_t x);
ecb_function_ ecb_const uint8_t ecb_bitrev8 (uint8_t x)
{
return ( (x * 0x0802U & 0x22110U)
| (x * 0x8020U & 0x88440U)) * 0x10101U >> 16;
}
ecb_function_ ecb_const uint16_t ecb_bitrev16 (uint16_t x);
ecb_function_ ecb_const uint16_t ecb_bitrev16 (uint16_t x)
{
x = ((x >> 1) & 0x5555) | ((x & 0x5555) << 1);
x = ((x >> 2) & 0x3333) | ((x & 0x3333) << 2);
x = ((x >> 4) & 0x0f0f) | ((x & 0x0f0f) << 4);
x = ( x >> 8 ) | ( x << 8);
return x;
}
ecb_function_ ecb_const uint32_t ecb_bitrev32 (uint32_t x);
ecb_function_ ecb_const uint32_t ecb_bitrev32 (uint32_t x)
{
x = ((x >> 1) & 0x55555555) | ((x & 0x55555555) << 1);
x = ((x >> 2) & 0x33333333) | ((x & 0x33333333) << 2);
x = ((x >> 4) & 0x0f0f0f0f) | ((x & 0x0f0f0f0f) << 4);
x = ((x >> 8) & 0x00ff00ff) | ((x & 0x00ff00ff) << 8);
x = ( x >> 16 ) | ( x << 16);
return x;
}
/* popcount64 is only available on 64 bit cpus as gcc builtin */
/* so for this version we are lazy */
ecb_function_ ecb_const int ecb_popcount64 (uint64_t x);
ecb_function_ ecb_const int
ecb_popcount64 (uint64_t x)
{
return ecb_popcount32 (x) + ecb_popcount32 (x >> 32);
}
ecb_inline ecb_const uint8_t ecb_rotl8 (uint8_t x, unsigned int count);
ecb_inline ecb_const uint8_t ecb_rotr8 (uint8_t x, unsigned int count);
ecb_inline ecb_const uint16_t ecb_rotl16 (uint16_t x, unsigned int count);
ecb_inline ecb_const uint16_t ecb_rotr16 (uint16_t x, unsigned int count);
ecb_inline ecb_const uint32_t ecb_rotl32 (uint32_t x, unsigned int count);
ecb_inline ecb_const uint32_t ecb_rotr32 (uint32_t x, unsigned int count);
ecb_inline ecb_const uint64_t ecb_rotl64 (uint64_t x, unsigned int count);
ecb_inline ecb_const uint64_t ecb_rotr64 (uint64_t x, unsigned int count);
ecb_inline ecb_const uint8_t ecb_rotl8 (uint8_t x, unsigned int count) { return (x >> ( 8 - count)) | (x << count); }
ecb_inline ecb_const uint8_t ecb_rotr8 (uint8_t x, unsigned int count) { return (x << ( 8 - count)) | (x >> count); }
ecb_inline ecb_const uint16_t ecb_rotl16 (uint16_t x, unsigned int count) { return (x >> (16 - count)) | (x << count); }
ecb_inline ecb_const uint16_t ecb_rotr16 (uint16_t x, unsigned int count) { return (x << (16 - count)) | (x >> count); }
ecb_inline ecb_const uint32_t ecb_rotl32 (uint32_t x, unsigned int count) { return (x >> (32 - count)) | (x << count); }
ecb_inline ecb_const uint32_t ecb_rotr32 (uint32_t x, unsigned int count) { return (x << (32 - count)) | (x >> count); }
ecb_inline ecb_const uint64_t ecb_rotl64 (uint64_t x, unsigned int count) { return (x >> (64 - count)) | (x << count); }
ecb_inline ecb_const uint64_t ecb_rotr64 (uint64_t x, unsigned int count) { return (x << (64 - count)) | (x >> count); }
#if ECB_CPP
inline uint8_t ecb_ctz (uint8_t v) { return ecb_ctz32 (v); }
inline uint16_t ecb_ctz (uint16_t v) { return ecb_ctz32 (v); }
inline uint32_t ecb_ctz (uint32_t v) { return ecb_ctz32 (v); }
inline uint64_t ecb_ctz (uint64_t v) { return ecb_ctz64 (v); }
inline bool ecb_is_pot (uint8_t v) { return ecb_is_pot32 (v); }
inline bool ecb_is_pot (uint16_t v) { return ecb_is_pot32 (v); }
inline bool ecb_is_pot (uint32_t v) { return ecb_is_pot32 (v); }
inline bool ecb_is_pot (uint64_t v) { return ecb_is_pot64 (v); }
inline int ecb_ld (uint8_t v) { return ecb_ld32 (v); }
inline int ecb_ld (uint16_t v) { return ecb_ld32 (v); }
inline int ecb_ld (uint32_t v) { return ecb_ld32 (v); }
inline int ecb_ld (uint64_t v) { return ecb_ld64 (v); }
inline int ecb_popcount (uint8_t v) { return ecb_popcount32 (v); }
inline int ecb_popcount (uint16_t v) { return ecb_popcount32 (v); }
inline int ecb_popcount (uint32_t v) { return ecb_popcount32 (v); }
inline int ecb_popcount (uint64_t v) { return ecb_popcount64 (v); }
inline uint8_t ecb_bitrev (uint8_t v) { return ecb_bitrev8 (v); }
inline uint16_t ecb_bitrev (uint16_t v) { return ecb_bitrev16 (v); }
inline uint32_t ecb_bitrev (uint32_t v) { return ecb_bitrev32 (v); }
inline uint8_t ecb_rotl (uint8_t v, unsigned int count) { return ecb_rotl8 (v, count); }
inline uint16_t ecb_rotl (uint16_t v, unsigned int count) { return ecb_rotl16 (v, count); }
inline uint32_t ecb_rotl (uint32_t v, unsigned int count) { return ecb_rotl32 (v, count); }
inline uint64_t ecb_rotl (uint64_t v, unsigned int count) { return ecb_rotl64 (v, count); }
inline uint8_t ecb_rotr (uint8_t v, unsigned int count) { return ecb_rotr8 (v, count); }
inline uint16_t ecb_rotr (uint16_t v, unsigned int count) { return ecb_rotr16 (v, count); }
inline uint32_t ecb_rotr (uint32_t v, unsigned int count) { return ecb_rotr32 (v, count); }
inline uint64_t ecb_rotr (uint64_t v, unsigned int count) { return ecb_rotr64 (v, count); }
#endif
#if ECB_GCC_VERSION(4,3) || (ECB_CLANG_BUILTIN(__builtin_bswap32) && ECB_CLANG_BUILTIN(__builtin_bswap64))
#if ECB_GCC_VERSION(4,8) || ECB_CLANG_BUILTIN(__builtin_bswap16)
#define ecb_bswap16(x) __builtin_bswap16 (x)
#else
#define ecb_bswap16(x) (__builtin_bswap32 (x) >> 16)
#endif
#define ecb_bswap32(x) __builtin_bswap32 (x)
#define ecb_bswap64(x) __builtin_bswap64 (x)
#elif _MSC_VER
#include
#define ecb_bswap16(x) ((uint16_t)_byteswap_ushort ((uint16_t)(x)))
#define ecb_bswap32(x) ((uint32_t)_byteswap_ulong ((uint32_t)(x)))
#define ecb_bswap64(x) ((uint64_t)_byteswap_uint64 ((uint64_t)(x)))
#else
ecb_function_ ecb_const uint16_t ecb_bswap16 (uint16_t x);
ecb_function_ ecb_const uint16_t
ecb_bswap16 (uint16_t x)
{
return ecb_rotl16 (x, 8);
}
ecb_function_ ecb_const uint32_t ecb_bswap32 (uint32_t x);
ecb_function_ ecb_const uint32_t
ecb_bswap32 (uint32_t x)
{
return (((uint32_t)ecb_bswap16 (x)) << 16) | ecb_bswap16 (x >> 16);
}
ecb_function_ ecb_const uint64_t ecb_bswap64 (uint64_t x);
ecb_function_ ecb_const uint64_t
ecb_bswap64 (uint64_t x)
{
return (((uint64_t)ecb_bswap32 (x)) << 32) | ecb_bswap32 (x >> 32);
}
#endif
#if ECB_GCC_VERSION(4,5) || ECB_CLANG_BUILTIN(__builtin_unreachable)
#define ecb_unreachable() __builtin_unreachable ()
#else
/* this seems to work fine, but gcc always emits a warning for it :/ */
ecb_inline ecb_noreturn void ecb_unreachable (void);
ecb_inline ecb_noreturn void ecb_unreachable (void) { }
#endif
/* try to tell the compiler that some condition is definitely true */
#define ecb_assume(cond) if (!(cond)) ecb_unreachable (); else 0
ecb_inline ecb_const uint32_t ecb_byteorder_helper (void);
ecb_inline ecb_const uint32_t
ecb_byteorder_helper (void)
{
/* the union code still generates code under pressure in gcc, */
/* but less than using pointers, and always seems to */
/* successfully return a constant. */
/* the reason why we have this horrible preprocessor mess */
/* is to avoid it in all cases, at least on common architectures */
/* or when using a recent enough gcc version (>= 4.6) */
#if (defined __BYTE_ORDER__ && __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__) \
|| ((__i386 || __i386__ || _M_IX86 || ECB_GCC_AMD64 || ECB_MSVC_AMD64) && !__VOS__)
#define ECB_LITTLE_ENDIAN 1
return 0x44332211;
#elif (defined __BYTE_ORDER__ && __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) \
|| ((__AARCH64EB__ || __MIPSEB__ || __ARMEB__) && !__VOS__)
#define ECB_BIG_ENDIAN 1
return 0x11223344;
#else
union
{
uint8_t c[4];
uint32_t u;
} u = { 0x11, 0x22, 0x33, 0x44 };
return u.u;
#endif
}
ecb_inline ecb_const ecb_bool ecb_big_endian (void);
ecb_inline ecb_const ecb_bool ecb_big_endian (void) { return ecb_byteorder_helper () == 0x11223344; }
ecb_inline ecb_const ecb_bool ecb_little_endian (void);
ecb_inline ecb_const ecb_bool ecb_little_endian (void) { return ecb_byteorder_helper () == 0x44332211; }
/*****************************************************************************/
/* unaligned load/store */
ecb_inline uint_fast16_t ecb_be_u16_to_host (uint_fast16_t v) { return ecb_little_endian () ? ecb_bswap16 (v) : v; }
ecb_inline uint_fast32_t ecb_be_u32_to_host (uint_fast32_t v) { return ecb_little_endian () ? ecb_bswap32 (v) : v; }
ecb_inline uint_fast64_t ecb_be_u64_to_host (uint_fast64_t v) { return ecb_little_endian () ? ecb_bswap64 (v) : v; }
ecb_inline uint_fast16_t ecb_le_u16_to_host (uint_fast16_t v) { return ecb_big_endian () ? ecb_bswap16 (v) : v; }
ecb_inline uint_fast32_t ecb_le_u32_to_host (uint_fast32_t v) { return ecb_big_endian () ? ecb_bswap32 (v) : v; }
ecb_inline uint_fast64_t ecb_le_u64_to_host (uint_fast64_t v) { return ecb_big_endian () ? ecb_bswap64 (v) : v; }
ecb_inline uint_fast16_t ecb_peek_u16_u (const void *ptr) { uint16_t v; memcpy (&v, ptr, sizeof (v)); return v; }
ecb_inline uint_fast32_t ecb_peek_u32_u (const void *ptr) { uint32_t v; memcpy (&v, ptr, sizeof (v)); return v; }
ecb_inline uint_fast64_t ecb_peek_u64_u (const void *ptr) { uint64_t v; memcpy (&v, ptr, sizeof (v)); return v; }
ecb_inline uint_fast16_t ecb_peek_be_u16_u (const void *ptr) { return ecb_be_u16_to_host (ecb_peek_u16_u (ptr)); }
ecb_inline uint_fast32_t ecb_peek_be_u32_u (const void *ptr) { return ecb_be_u32_to_host (ecb_peek_u32_u (ptr)); }
ecb_inline uint_fast64_t ecb_peek_be_u64_u (const void *ptr) { return ecb_be_u64_to_host (ecb_peek_u64_u (ptr)); }
ecb_inline uint_fast16_t ecb_peek_le_u16_u (const void *ptr) { return ecb_le_u16_to_host (ecb_peek_u16_u (ptr)); }
ecb_inline uint_fast32_t ecb_peek_le_u32_u (const void *ptr) { return ecb_le_u32_to_host (ecb_peek_u32_u (ptr)); }
ecb_inline uint_fast64_t ecb_peek_le_u64_u (const void *ptr) { return ecb_le_u64_to_host (ecb_peek_u64_u (ptr)); }
ecb_inline uint_fast16_t ecb_host_to_be_u16 (uint_fast16_t v) { return ecb_little_endian () ? ecb_bswap16 (v) : v; }
ecb_inline uint_fast32_t ecb_host_to_be_u32 (uint_fast32_t v) { return ecb_little_endian () ? ecb_bswap32 (v) : v; }
ecb_inline uint_fast64_t ecb_host_to_be_u64 (uint_fast64_t v) { return ecb_little_endian () ? ecb_bswap64 (v) : v; }
ecb_inline uint_fast16_t ecb_host_to_le_u16 (uint_fast16_t v) { return ecb_big_endian () ? ecb_bswap16 (v) : v; }
ecb_inline uint_fast32_t ecb_host_to_le_u32 (uint_fast32_t v) { return ecb_big_endian () ? ecb_bswap32 (v) : v; }
ecb_inline uint_fast64_t ecb_host_to_le_u64 (uint_fast64_t v) { return ecb_big_endian () ? ecb_bswap64 (v) : v; }
ecb_inline void ecb_poke_u16_u (void *ptr, uint16_t v) { memcpy (ptr, &v, sizeof (v)); }
ecb_inline void ecb_poke_u32_u (void *ptr, uint32_t v) { memcpy (ptr, &v, sizeof (v)); }
ecb_inline void ecb_poke_u64_u (void *ptr, uint64_t v) { memcpy (ptr, &v, sizeof (v)); }
ecb_inline void ecb_poke_be_u16_u (void *ptr, uint_fast16_t v) { ecb_poke_u16_u (ptr, ecb_host_to_be_u16 (v)); }
ecb_inline void ecb_poke_be_u32_u (void *ptr, uint_fast32_t v) { ecb_poke_u32_u (ptr, ecb_host_to_be_u32 (v)); }
ecb_inline void ecb_poke_be_u64_u (void *ptr, uint_fast64_t v) { ecb_poke_u64_u (ptr, ecb_host_to_be_u64 (v)); }
ecb_inline void ecb_poke_le_u16_u (void *ptr, uint_fast16_t v) { ecb_poke_u16_u (ptr, ecb_host_to_le_u16 (v)); }
ecb_inline void ecb_poke_le_u32_u (void *ptr, uint_fast32_t v) { ecb_poke_u32_u (ptr, ecb_host_to_le_u32 (v)); }
ecb_inline void ecb_poke_le_u64_u (void *ptr, uint_fast64_t v) { ecb_poke_u64_u (ptr, ecb_host_to_le_u64 (v)); }
#if ECB_CPP
inline uint8_t ecb_bswap (uint8_t v) { return v; }
inline uint16_t ecb_bswap (uint16_t v) { return ecb_bswap16 (v); }
inline uint32_t ecb_bswap (uint32_t v) { return ecb_bswap32 (v); }
inline uint64_t ecb_bswap (uint64_t v) { return ecb_bswap64 (v); }
template inline T ecb_be_to_host (T v) { return ecb_little_endian () ? ecb_bswap (v) : v; }
template inline T ecb_le_to_host (T v) { return ecb_big_endian () ? ecb_bswap (v) : v; }
template inline T ecb_peek (const void *ptr) { return *(const T *)ptr; }
template inline T ecb_peek_be (const void *ptr) { return ecb_be_to_host (ecb_peek (ptr)); }
template inline T ecb_peek_le (const void *ptr) { return ecb_le_to_host (ecb_peek (ptr)); }
template inline T ecb_peek_u (const void *ptr) { T v; memcpy (&v, ptr, sizeof (v)); return v; }
template inline T ecb_peek_be_u (const void *ptr) { return ecb_be_to_host (ecb_peek_u (ptr)); }
template inline T ecb_peek_le_u (const void *ptr) { return ecb_le_to_host (ecb_peek_u (ptr)); }
template inline T ecb_host_to_be (T v) { return ecb_little_endian () ? ecb_bswap (v) : v; }
template inline T ecb_host_to_le (T v) { return ecb_big_endian () ? ecb_bswap (v) : v; }
template inline void ecb_poke (void *ptr, T v) { *(T *)ptr = v; }
template inline void ecb_poke_be (void *ptr, T v) { return ecb_poke (ptr, ecb_host_to_be (v)); }
template inline void ecb_poke_le (void *ptr, T v) { return ecb_poke (ptr, ecb_host_to_le (v)); }
template inline void ecb_poke_u (void *ptr, T v) { memcpy (ptr, &v, sizeof (v)); }
template inline void ecb_poke_be_u (void *ptr, T v) { return ecb_poke_u (ptr, ecb_host_to_be (v)); }
template inline void ecb_poke_le_u (void *ptr, T v) { return ecb_poke_u (ptr, ecb_host_to_le (v)); }
#endif
/*****************************************************************************/
/* division */
#if ECB_GCC_VERSION(3,0) || ECB_C99
/* C99 tightened the definition of %, so we can use a more efficient version */
#define ecb_mod(m,n) ((m) % (n) + ((m) % (n) < 0 ? (n) : 0))
#else
#define ecb_mod(m,n) ((m) < 0 ? ((n) - 1 - ((-1 - (m)) % (n))) : ((m) % (n)))
#endif
#if ECB_CPP
template
static inline T ecb_div_rd (T val, T div)
{
return val < 0 ? - ((-val + div - 1) / div) : (val ) / div;
}
template
static inline T ecb_div_ru (T val, T div)
{
return val < 0 ? - ((-val ) / div) : (val + div - 1) / div;
}
#else
#define ecb_div_rd(val,div) ((val) < 0 ? - ((-(val) + (div) - 1) / (div)) : ((val) ) / (div))
#define ecb_div_ru(val,div) ((val) < 0 ? - ((-(val) ) / (div)) : ((val) + (div) - 1) / (div))
#endif
/*****************************************************************************/
/* array length */
#if ecb_cplusplus_does_not_suck
/* does not work for local types (http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2008/n2657.htm) */
template
static inline int ecb_array_length (const T (&arr)[N])
{
return N;
}
#else
#define ecb_array_length(name) (sizeof (name) / sizeof (name [0]))
#endif
/*****************************************************************************/
/* IEEE 754-2008 half float conversions */
ecb_function_ ecb_const uint32_t ecb_binary16_to_binary32 (uint32_t x);
ecb_function_ ecb_const uint32_t
ecb_binary16_to_binary32 (uint32_t x)
{
unsigned int s = (x & 0x8000) << (31 - 15);
int e = (x >> 10) & 0x001f;
unsigned int m = x & 0x03ff;
if (ecb_expect_false (e == 31))
/* infinity or NaN */
e = 255 - (127 - 15);
else if (ecb_expect_false (!e))
{
if (ecb_expect_true (!m))
/* zero, handled by code below by forcing e to 0 */
e = 0 - (127 - 15);
else
{
/* subnormal, renormalise */
unsigned int s = 10 - ecb_ld32 (m);
m = (m << s) & 0x3ff; /* mask implicit bit */
e -= s - 1;
}
}
/* e and m now are normalised, or zero, (or inf or nan) */
e += 127 - 15;
return s | (e << 23) | (m << (23 - 10));
}
ecb_function_ ecb_const uint16_t ecb_binary32_to_binary16 (uint32_t x);
ecb_function_ ecb_const uint16_t
ecb_binary32_to_binary16 (uint32_t x)
{
unsigned int s = (x >> 16) & 0x00008000; /* sign bit, the easy part */
int e = ((x >> 23) & 0x000000ff) - (127 - 15); /* the desired exponent */
unsigned int m = x & 0x007fffff;
x &= 0x7fffffff;
/* if it's within range of binary16 normals, use fast path */
if (ecb_expect_true (0x38800000 <= x && x <= 0x477fefff))
{
/* mantissa round-to-even */
m += 0x00000fff + ((m >> (23 - 10)) & 1);
/* handle overflow */
if (ecb_expect_false (m >= 0x00800000))
{
m >>= 1;
e += 1;
}
return s | (e << 10) | (m >> (23 - 10));
}
/* handle large numbers and infinity */
if (ecb_expect_true (0x477fefff < x && x <= 0x7f800000))
return s | 0x7c00;
/* handle zero, subnormals and small numbers */
if (ecb_expect_true (x < 0x38800000))
{
/* zero */
if (ecb_expect_true (!x))
return s;
/* handle subnormals */
/* too small, will be zero */
if (e < (14 - 24)) /* might not be sharp, but is good enough */
return s;
m |= 0x00800000; /* make implicit bit explicit */
/* very tricky - we need to round to the nearest e (+10) bit value */
{
unsigned int bits = 14 - e;
unsigned int half = (1 << (bits - 1)) - 1;
unsigned int even = (m >> bits) & 1;
/* if this overflows, we will end up with a normalised number */
m = (m + half + even) >> bits;
}
return s | m;
}
/* handle NaNs, preserve leftmost nan bits, but make sure we don't turn them into infinities */
m >>= 13;
return s | 0x7c00 | m | !m;
}
/*******************************************************************************/
/* fast integer to ascii */
/*
* This code is pretty complicated because it is general. The idea behind it,
* however, is pretty simple: first, the number is multiplied with a scaling
* factor (2**bits / 10**(digits-1)) to convert the integer into a fixed-point
* number with the first digit in the upper bits.
* Then this digit is converted to text and masked out. The resulting number
* is then multiplied by 10, by multiplying the fixed point representation
* by 5 and shifting the (binary) decimal point one to the right, so a 4.28
* format becomes 5.27, 6.26 and so on.
* The rest involves only advancing the pointer if we already generated a
* non-zero digit, so leading zeroes are overwritten.
*/
// simply return a mask with "bits" bits set
#define ecb_i2a_mask(type,bits) ((((type)1) << (bits)) - 1)
// oputput a single digit. maskvalue is 10**digitidx
#define ecb_i2a_digit(type,bits,digitmask,maskvalue,digitidx) \
if (digitmask >= maskvalue) /* constant, used to decide how many digits to generate */ \
{ \
char digit = x >> (bits - digitidx); /* calculate the topmost digit */ \
*ptr = digit + '0'; /* output it */ \
nz = (digitmask == maskvalue) || nz || digit; /* first term == always output last digit */ \
ptr += nz; /* output digit only if non-zero digit seen */ \
x = (x & ecb_i2a_mask (type, bits - digitidx)) * 5; /* *10, but shift decimal point right */ \
}
// convert integer to fixed point format and multiply out digits, highest first
// requires magic constants: max. digits and number of bits after the decimal point
#define ecb_i2a_def(suffix,ptr,v,type,bits,digitmask,lz) \
ecb_inline char *ecb_i2a_ ## suffix (char *ptr, uint32_t u) \
{ \
char nz = lz; /* non-zero digit seen? */ \
/* convert to x.bits fixed-point */ \
type x = u * ((ecb_i2a_mask (type, bits) + digitmask) / digitmask); \
/* output up to 10 digits */ \
ecb_i2a_digit (type,bits,digitmask, 1, 0); \
ecb_i2a_digit (type,bits,digitmask, 10, 1); \
ecb_i2a_digit (type,bits,digitmask, 100, 2); \
ecb_i2a_digit (type,bits,digitmask, 1000, 3); \
ecb_i2a_digit (type,bits,digitmask, 10000, 4); \
ecb_i2a_digit (type,bits,digitmask, 100000, 5); \
ecb_i2a_digit (type,bits,digitmask, 1000000, 6); \
ecb_i2a_digit (type,bits,digitmask, 10000000, 7); \
ecb_i2a_digit (type,bits,digitmask, 100000000, 8); \
ecb_i2a_digit (type,bits,digitmask, 1000000000, 9); \
return ptr; \
}
// predefined versions of the above, for various digits
// ecb_i2a_xN = almost N digits, limit defined by macro
// ecb_i2a_N = up to N digits, leading zeroes suppressed
// ecb_i2a_0N = exactly N digits, including leading zeroes
// non-leading-zero versions, limited range
#define ECB_I2A_MAX_X5 59074 // limit for ecb_i2a_x5
#define ECB_I2A_MAX_X10 2932500665 // limit for ecb_i2a_x10
ecb_i2a_def ( x5, ptr, v, uint32_t, 26, 10000, 0)
ecb_i2a_def (x10, ptr, v, uint64_t, 60, 1000000000, 0)
// non-leading zero versions, all digits, 4 and 9 are optimal for 32/64 bit
ecb_i2a_def ( 2, ptr, v, uint32_t, 10, 10, 0)
ecb_i2a_def ( 3, ptr, v, uint32_t, 12, 100, 0)
ecb_i2a_def ( 4, ptr, v, uint32_t, 26, 1000, 0)
ecb_i2a_def ( 5, ptr, v, uint64_t, 30, 10000, 0)
ecb_i2a_def ( 6, ptr, v, uint64_t, 36, 100000, 0)
ecb_i2a_def ( 7, ptr, v, uint64_t, 44, 1000000, 0)
ecb_i2a_def ( 8, ptr, v, uint64_t, 50, 10000000, 0)
ecb_i2a_def ( 9, ptr, v, uint64_t, 56, 100000000, 0)
// leading-zero versions, all digits, 04 and 09 are optimal for 32/64 bit
ecb_i2a_def (02, ptr, v, uint32_t, 10, 10, 1)
ecb_i2a_def (03, ptr, v, uint32_t, 12, 100, 1)
ecb_i2a_def (04, ptr, v, uint32_t, 26, 1000, 1)
ecb_i2a_def (05, ptr, v, uint64_t, 30, 10000, 1)
ecb_i2a_def (06, ptr, v, uint64_t, 36, 100000, 1)
ecb_i2a_def (07, ptr, v, uint64_t, 44, 1000000, 1)
ecb_i2a_def (08, ptr, v, uint64_t, 50, 10000000, 1)
ecb_i2a_def (09, ptr, v, uint64_t, 56, 100000000, 1)
#define ECB_I2A_I32_DIGITS 11
#define ECB_I2A_U32_DIGITS 10
#define ECB_I2A_I64_DIGITS 20
#define ECB_I2A_U64_DIGITS 21
#define ECB_I2A_MAX_DIGITS 21
ecb_inline char *
ecb_i2a_u32 (char *ptr, uint32_t u)
{
#if ECB_64BIT_NATIVE
if (ecb_expect_true (u <= ECB_I2A_MAX_X10))
ptr = ecb_i2a_x10 (ptr, u);
else // x10 almost, but not fully, covers 32 bit
{
uint32_t u1 = u % 1000000000;
uint32_t u2 = u / 1000000000;
*ptr++ = u2 + '0';
ptr = ecb_i2a_09 (ptr, u1);
}
#else
if (ecb_expect_true (u <= ECB_I2A_MAX_X5))
ecb_i2a_x5 (ptr, u);
else if (ecb_expect_true (u <= ECB_I2A_MAX_X5 * 10000))
{
uint32_t u1 = u % 10000;
uint32_t u2 = u / 10000;
ptr = ecb_i2a_x5 (ptr, u2);
ptr = ecb_i2a_04 (ptr, u1);
}
else
{
uint32_t u1 = u % 10000;
uint32_t ua = u / 10000;
uint32_t u2 = ua % 10000;
uint32_t u3 = ua / 10000;
ptr = ecb_i2a_2 (ptr, u3);
ptr = ecb_i2a_04 (ptr, u2);
ptr = ecb_i2a_04 (ptr, u1);
}
#endif
return ptr;
}
ecb_inline char *
ecb_i2a_i32 (char *ptr, int32_t v)
{
*ptr = '-'; ptr += v < 0;
uint32_t u = v < 0 ? -(uint32_t)v : v;
#if ECB_64BIT_NATIVE
ptr = ecb_i2a_x10 (ptr, u); // x10 fully covers 31 bit
#else
ptr = ecb_i2a_u32 (ptr, u);
#endif
return ptr;
}
ecb_inline char *
ecb_i2a_u64 (char *ptr, uint64_t u)
{
#if ECB_64BIT_NATIVE
if (ecb_expect_true (u <= ECB_I2A_MAX_X10))
ptr = ecb_i2a_x10 (ptr, u);
else if (ecb_expect_false (u <= ECB_I2A_MAX_X10 * 1000000000))
{
uint64_t u1 = u % 1000000000;
uint64_t u2 = u / 1000000000;
ptr = ecb_i2a_x10 (ptr, u2);
ptr = ecb_i2a_09 (ptr, u1);
}
else
{
uint64_t u1 = u % 1000000000;
uint64_t ua = u / 1000000000;
uint64_t u2 = ua % 1000000000;
uint64_t u3 = ua / 1000000000;
ptr = ecb_i2a_2 (ptr, u3);
ptr = ecb_i2a_09 (ptr, u2);
ptr = ecb_i2a_09 (ptr, u1);
}
#else
if (ecb_expect_true (u <= ECB_I2A_MAX_X5))
ptr = ecb_i2a_x5 (ptr, u);
else
{
uint64_t u1 = u % 10000;
uint64_t u2 = u / 10000;
ptr = ecb_i2a_u64 (ptr, u2);
ptr = ecb_i2a_04 (ptr, u1);
}
#endif
return ptr;
}
ecb_inline char *
ecb_i2a_i64 (char *ptr, int64_t v)
{
*ptr = '-'; ptr += v < 0;
uint64_t u = v < 0 ? -(uint64_t)v : v;
#if ECB_64BIT_NATIVE
if (ecb_expect_true (u <= ECB_I2A_MAX_X10))
ptr = ecb_i2a_x10 (ptr, u);
else if (ecb_expect_false (u <= ECB_I2A_MAX_X10 * 1000000000))
{
uint64_t u1 = u % 1000000000;
uint64_t u2 = u / 1000000000;
ptr = ecb_i2a_x10 (ptr, u2);
ptr = ecb_i2a_09 (ptr, u1);
}
else
{
uint64_t u1 = u % 1000000000;
uint64_t ua = u / 1000000000;
uint64_t u2 = ua % 1000000000;
uint64_t u3 = ua / 1000000000;
// 2**31 is 19 digits, so the top is exactly one digit
*ptr++ = u3 + '0';
ptr = ecb_i2a_09 (ptr, u2);
ptr = ecb_i2a_09 (ptr, u1);
}
#else
ptr = ecb_i2a_u64 (ptr, u);
#endif
return ptr;
}
/*******************************************************************************/
/* floating point stuff, can be disabled by defining ECB_NO_LIBM */
/* basically, everything uses "ieee pure-endian" floating point numbers */
/* the only noteworthy exception is ancient armle, which uses order 43218765 */
#if 0 \
|| __i386 || __i386__ \
|| ECB_GCC_AMD64 \
|| __powerpc__ || __ppc__ || __powerpc64__ || __ppc64__ \
|| defined __s390__ || defined __s390x__ \
|| defined __mips__ \
|| defined __alpha__ \
|| defined __hppa__ \
|| defined __ia64__ \
|| defined __m68k__ \
|| defined __m88k__ \
|| defined __sh__ \
|| defined _M_IX86 || defined ECB_MSVC_AMD64 || defined _M_IA64 \
|| (defined __arm__ && (defined __ARM_EABI__ || defined __EABI__ || defined __VFP_FP__ || defined _WIN32_WCE || defined __ANDROID__)) \
|| defined __aarch64__
#define ECB_STDFP 1
#else
#define ECB_STDFP 0
#endif
#ifndef ECB_NO_LIBM
#include /* for frexp*, ldexp*, INFINITY, NAN */
/* only the oldest of old doesn't have this one. solaris. */
#ifdef INFINITY
#define ECB_INFINITY INFINITY
#else
#define ECB_INFINITY HUGE_VAL
#endif
#ifdef NAN
#define ECB_NAN NAN
#else
#define ECB_NAN ECB_INFINITY
#endif
#if ECB_C99 || _XOPEN_VERSION >= 600 || _POSIX_VERSION >= 200112L
#define ecb_ldexpf(x,e) ldexpf ((x), (e))
#define ecb_frexpf(x,e) frexpf ((x), (e))
#else
#define ecb_ldexpf(x,e) (float) ldexp ((double) (x), (e))
#define ecb_frexpf(x,e) (float) frexp ((double) (x), (e))
#endif
/* convert a float to ieee single/binary32 */
ecb_function_ ecb_const uint32_t ecb_float_to_binary32 (float x);
ecb_function_ ecb_const uint32_t
ecb_float_to_binary32 (float x)
{
uint32_t r;
#if ECB_STDFP
memcpy (&r, &x, 4);
#else
/* slow emulation, works for anything but -0 */
uint32_t m;
int e;
if (x == 0e0f ) return 0x00000000U;
if (x > +3.40282346638528860e+38f) return 0x7f800000U;
if (x < -3.40282346638528860e+38f) return 0xff800000U;
if (x != x ) return 0x7fbfffffU;
m = ecb_frexpf (x, &e) * 0x1000000U;
r = m & 0x80000000U;
if (r)
m = -m;
if (e <= -126)
{
m &= 0xffffffU;
m >>= (-125 - e);
e = -126;
}
r |= (e + 126) << 23;
r |= m & 0x7fffffU;
#endif
return r;
}
/* converts an ieee single/binary32 to a float */
ecb_function_ ecb_const float ecb_binary32_to_float (uint32_t x);
ecb_function_ ecb_const float
ecb_binary32_to_float (uint32_t x)
{
float r;
#if ECB_STDFP
memcpy (&r, &x, 4);
#else
/* emulation, only works for normals and subnormals and +0 */
int neg = x >> 31;
int e = (x >> 23) & 0xffU;
x &= 0x7fffffU;
if (e)
x |= 0x800000U;
else
e = 1;
/* we distrust ldexpf a bit and do the 2**-24 scaling by an extra multiply */
r = ecb_ldexpf (x * (0.5f / 0x800000U), e - 126);
r = neg ? -r : r;
#endif
return r;
}
/* convert a double to ieee double/binary64 */
ecb_function_ ecb_const uint64_t ecb_double_to_binary64 (double x);
ecb_function_ ecb_const uint64_t
ecb_double_to_binary64 (double x)
{
uint64_t r;
#if ECB_STDFP
memcpy (&r, &x, 8);
#else
/* slow emulation, works for anything but -0 */
uint64_t m;
int e;
if (x == 0e0 ) return 0x0000000000000000U;
if (x > +1.79769313486231470e+308) return 0x7ff0000000000000U;
if (x < -1.79769313486231470e+308) return 0xfff0000000000000U;
if (x != x ) return 0X7ff7ffffffffffffU;
m = frexp (x, &e) * 0x20000000000000U;
r = m & 0x8000000000000000;;
if (r)
m = -m;
if (e <= -1022)
{
m &= 0x1fffffffffffffU;
m >>= (-1021 - e);
e = -1022;
}
r |= ((uint64_t)(e + 1022)) << 52;
r |= m & 0xfffffffffffffU;
#endif
return r;
}
/* converts an ieee double/binary64 to a double */
ecb_function_ ecb_const double ecb_binary64_to_double (uint64_t x);
ecb_function_ ecb_const double
ecb_binary64_to_double (uint64_t x)
{
double r;
#if ECB_STDFP
memcpy (&r, &x, 8);
#else
/* emulation, only works for normals and subnormals and +0 */
int neg = x >> 63;
int e = (x >> 52) & 0x7ffU;
x &= 0xfffffffffffffU;
if (e)
x |= 0x10000000000000U;
else
e = 1;
/* we distrust ldexp a bit and do the 2**-53 scaling by an extra multiply */
r = ldexp (x * (0.5 / 0x10000000000000U), e - 1022);
r = neg ? -r : r;
#endif
return r;
}
/* convert a float to ieee half/binary16 */
ecb_function_ ecb_const uint16_t ecb_float_to_binary16 (float x);
ecb_function_ ecb_const uint16_t
ecb_float_to_binary16 (float x)
{
return ecb_binary32_to_binary16 (ecb_float_to_binary32 (x));
}
/* convert an ieee half/binary16 to float */
ecb_function_ ecb_const float ecb_binary16_to_float (uint16_t x);
ecb_function_ ecb_const float
ecb_binary16_to_float (uint16_t x)
{
return ecb_binary32_to_float (ecb_binary16_to_binary32 (x));
}
#endif
#endif
CBOR-XS-1.87/README 0000644 0000000 0000000 00000150044 14477425252 012124 0 ustar root root NAME
CBOR::XS - Concise Binary Object Representation (CBOR, RFC7049)
SYNOPSIS
use CBOR::XS;
$binary_cbor_data = encode_cbor $perl_value;
$perl_value = decode_cbor $binary_cbor_data;
# OO-interface
$coder = CBOR::XS->new;
$binary_cbor_data = $coder->encode ($perl_value);
$perl_value = $coder->decode ($binary_cbor_data);
# prefix decoding
my $many_cbor_strings = ...;
while (length $many_cbor_strings) {
my ($data, $length) = $cbor->decode_prefix ($many_cbor_strings);
# data was decoded
substr $many_cbor_strings, 0, $length, ""; # remove decoded cbor string
}
DESCRIPTION
This module converts Perl data structures to the Concise Binary Object
Representation (CBOR) and vice versa. CBOR is a fast binary
serialisation format that aims to use an (almost) superset of the JSON
data model, i.e. when you can represent something useful in JSON, you
should be able to represent it in CBOR.
In short, CBOR is a faster and quite compact binary alternative to JSON,
with the added ability of supporting serialisation of Perl objects.
(JSON often compresses better than CBOR though, so if you plan to
compress the data later and speed is less important you might want to
compare both formats first).
The primary goal of this module is to be *correct* and the secondary
goal is to be *fast*. To reach the latter goal it was written in C.
To give you a general idea about speed, with texts in the megabyte
range, "CBOR::XS" usually encodes roughly twice as fast as Storable or
JSON::XS and decodes about 15%-30% faster than those. The shorter the
data, the worse Storable performs in comparison.
Regarding compactness, "CBOR::XS"-encoded data structures are usually
about 20% smaller than the same data encoded as (compact) JSON or
Storable.
In addition to the core CBOR data format, this module implements a
number of extensions, to support cyclic and shared data structures (see
"allow_sharing" and "allow_cycles"), string deduplication (see
"pack_strings") and scalar references (always enabled).
See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and
vice versa.
FUNCTIONAL INTERFACE
The following convenience methods are provided by this module. They are
exported by default:
$cbor_data = encode_cbor $perl_scalar
Converts the given Perl data structure to CBOR representation.
Croaks on error.
$perl_scalar = decode_cbor $cbor_data
The opposite of "encode_cbor": expects a valid CBOR string to parse,
returning the resulting perl scalar. Croaks on error.
OBJECT-ORIENTED INTERFACE
The object oriented interface lets you configure your own encoding or
decoding style, within the limits of supported formats.
$cbor = new CBOR::XS
Creates a new CBOR::XS object that can be used to de/encode CBOR
strings. All boolean flags described below are by default
*disabled*.
The mutators for flags all return the CBOR object again and thus
calls can be chained:
my $cbor = CBOR::XS->new->encode ({a => [1,2]});
$cbor = new_safe CBOR::XS
Create a new, safe/secure CBOR::XS object. This is similar to "new",
but configures the coder object to be safe to use with untrusted
data. Currently, this is equivalent to:
my $cbor = CBOR::XS
->new
->validate_utf8
->forbid_objects
->filter (\&CBOR::XS::safe_filter)
->max_size (1e8);
But is more future proof (it is better to crash because of a change
than to be exploited in other ways).
$cbor = $cbor->max_depth ([$maximum_nesting_depth])
$max_depth = $cbor->get_max_depth
Sets the maximum nesting level (default 512) accepted while encoding
or decoding. If a higher nesting level is detected in CBOR data or a
Perl data structure, then the encoder and decoder will stop and
croak at that point.
Nesting level is defined by number of hash- or arrayrefs that the
encoder needs to traverse to reach a given point or the number of
"{" or "[" characters without their matching closing parenthesis
crossed to reach a given character in a string.
Setting the maximum depth to one disallows any nesting, so that
ensures that the object is only a single hash/object or array.
If no argument is given, the highest possible setting will be used,
which is rarely useful.
Note that nesting is implemented by recursion in C. The default
value has been chosen to be as large as typical operating systems
allow without crashing.
See "SECURITY CONSIDERATIONS", below, for more info on why this is
useful.
$cbor = $cbor->max_size ([$maximum_string_size])
$max_size = $cbor->get_max_size
Set the maximum length a CBOR string may have (in bytes) where
decoding is being attempted. The default is 0, meaning no limit.
When "decode" is called on a string that is longer then this many
bytes, it will not attempt to decode the string but throw an
exception. This setting has no effect on "encode" (yet).
If no argument is given, the limit check will be deactivated (same
as when 0 is specified).
See "SECURITY CONSIDERATIONS", below, for more info on why this is
useful.
$cbor = $cbor->allow_unknown ([$enable])
$enabled = $cbor->get_allow_unknown
If $enable is true (or missing), then "encode" will *not* throw an
exception when it encounters values it cannot represent in CBOR (for
example, filehandles) but instead will encode a CBOR "error" value.
If $enable is false (the default), then "encode" will throw an
exception when it encounters anything it cannot encode as CBOR.
This option does not affect "decode" in any way, and it is
recommended to leave it off unless you know your communications
partner.
$cbor = $cbor->allow_sharing ([$enable])
$enabled = $cbor->get_allow_sharing
If $enable is true (or missing), then "encode" will not
double-encode values that have been referenced before (e.g. when the
same object, such as an array, is referenced multiple times), but
instead will emit a reference to the earlier value.
This means that such values will only be encoded once, and will not
result in a deep cloning of the value on decode, in decoders
supporting the value sharing extension. This also makes it possible
to encode cyclic data structures (which need "allow_cycles" to be
enabled to be decoded by this module).
It is recommended to leave it off unless you know your communication
partner supports the value sharing extensions to CBOR
(), as without decoder
support, the resulting data structure might be unusable.
Detecting shared values incurs a runtime overhead when values are
encoded that have a reference counter larger than one, and might
unnecessarily increase the encoded size, as potentially shared
values are encoded as shareable whether or not they are actually
shared.
At the moment, only targets of references can be shared (e.g.
scalars, arrays or hashes pointed to by a reference). Weirder
constructs, such as an array with multiple "copies" of the *same*
string, which are hard but not impossible to create in Perl, are not
supported (this is the same as with Storable).
If $enable is false (the default), then "encode" will encode shared
data structures repeatedly, unsharing them in the process. Cyclic
data structures cannot be encoded in this mode.
This option does not affect "decode" in any way - shared values and
references will always be decoded properly if present.
$cbor = $cbor->allow_cycles ([$enable])
$enabled = $cbor->get_allow_cycles
If $enable is true (or missing), then "decode" will happily decode
self-referential (cyclic) data structures. By default these will not
be decoded, as they need manual cleanup to avoid memory leaks, so
code that isn't prepared for this will not leak memory.
If $enable is false (the default), then "decode" will throw an error
when it encounters a self-referential/cyclic data structure.
This option does not affect "encode" in any way - shared values and
references will always be encoded properly if present.
$cbor = $cbor->allow_weak_cycles ([$enable])
$enabled = $cbor->get_allow_weak_cycles
This works like "allow_cycles" in that it allows the resulting data
structures to contain cycles, but unlike "allow_cycles", those
cyclic rreferences will be weak. That means that code that
recurrsively walks the data structure must be prepared with cycles,
but at least not special precautions must be implemented to free
these data structures.
Only those references leading to actual cycles will be weakened -
other references, e.g. when the same hash or arrray is referenced
multiple times in an arrray, will be normal references.
This option does not affect "encode" in any way - shared values and
references will always be encoded properly if present.
$cbor = $cbor->forbid_objects ([$enable])
$enabled = $cbor->get_forbid_objects
Disables the use of the object serialiser protocol.
If $enable is true (or missing), then "encode" will will throw an
exception when it encounters perl objects that would be encoded
using the perl-object tag (26). When "decode" encounters such tags,
it will fall back to the general filter/tagged logic as if this were
an unknown tag (by default resulting in a "CBOR::XC::Tagged"
object).
If $enable is false (the default), then "encode" will use the
Types::Serialiser object serialisation protocol to serialise objects
into perl-object tags, and "decode" will do the same to decode such
tags.
See "SECURITY CONSIDERATIONS", below, for more info on why
forbidding this protocol can be useful.
$cbor = $cbor->pack_strings ([$enable])
$enabled = $cbor->get_pack_strings
If $enable is true (or missing), then "encode" will try not to
encode the same string twice, but will instead encode a reference to
the string instead. Depending on your data format, this can save a
lot of space, but also results in a very large runtime overhead
(expect encoding times to be 2-4 times as high as without).
It is recommended to leave it off unless you know your
communications partner supports the stringref extension to CBOR
(), as without decoder support,
the resulting data structure might not be usable.
If $enable is false (the default), then "encode" will encode strings
the standard CBOR way.
This option does not affect "decode" in any way - string references
will always be decoded properly if present.
$cbor = $cbor->text_keys ([$enable])
$enabled = $cbor->get_text_keys
If $enabled is true (or missing), then "encode" will encode all perl
hash keys as CBOR text strings/UTF-8 string, upgrading them as
needed.
If $enable is false (the default), then "encode" will encode hash
keys normally - upgraded perl strings (strings internally encoded as
UTF-8) as CBOR text strings, and downgraded perl strings as CBOR
byte strings.
This option does not affect "decode" in any way.
This option is useful for interoperability with CBOR decoders that
don't treat byte strings as a form of text. It is especially useful
as Perl gives very little control over hash keys.
Enabling this option can be slow, as all downgraded hash keys that
are encoded need to be scanned and converted to UTF-8.
$cbor = $cbor->text_strings ([$enable])
$enabled = $cbor->get_text_strings
This option works similar to "text_keys", above, but works on all
strings (including hash keys), so "text_keys" has no further effect
after enabling "text_strings".
If $enabled is true (or missing), then "encode" will encode all perl
strings as CBOR text strings/UTF-8 strings, upgrading them as
needed.
If $enable is false (the default), then "encode" will encode strings
normally (but see "text_keys") - upgraded perl strings (strings
internally encoded as UTF-8) as CBOR text strings, and downgraded
perl strings as CBOR byte strings.
This option does not affect "decode" in any way.
This option has similar advantages and disadvantages as "text_keys".
In addition, this option effectively removes the ability to
automatically encode byte strings, which might break some "FREEZE"
and "TO_CBOR" methods that rely on this.
A workaround is to use explicit type casts, which are unaffected by
this option.
$cbor = $cbor->validate_utf8 ([$enable])
$enabled = $cbor->get_validate_utf8
If $enable is true (or missing), then "decode" will validate that
elements (text strings) containing UTF-8 data in fact contain valid
UTF-8 data (instead of blindly accepting it). This validation
obviously takes extra time during decoding.
The concept of "valid UTF-8" used is perl's concept, which is a
superset of the official UTF-8.
If $enable is false (the default), then "decode" will blindly accept
UTF-8 data, marking them as valid UTF-8 in the resulting data
structure regardless of whether that's true or not.
Perl isn't too happy about corrupted UTF-8 in strings, but should
generally not crash or do similarly evil things. Extensions might be
not so forgiving, so it's recommended to turn on this setting if you
receive untrusted CBOR.
This option does not affect "encode" in any way - strings that are
supposedly valid UTF-8 will simply be dumped into the resulting CBOR
string without checking whether that is, in fact, true or not.
$cbor = $cbor->filter ([$cb->($tag, $value)])
$cb_or_undef = $cbor->get_filter
Sets or replaces the tagged value decoding filter (when $cb is
specified) or clears the filter (if no argument or "undef" is
provided).
The filter callback is called only during decoding, when a
non-enforced tagged value has been decoded (see "TAG HANDLING AND
EXTENSIONS" for a list of enforced tags). For specific tags, it's
often better to provide a default converter using the
%CBOR::XS::FILTER hash (see below).
The first argument is the numerical tag, the second is the (decoded)
value that has been tagged.
The filter function should return either exactly one value, which
will replace the tagged value in the decoded data structure, or no
values, which will result in default handling, which currently means
the decoder creates a "CBOR::XS::Tagged" object to hold the tag and
the value.
When the filter is cleared (the default state), the default filter
function, "CBOR::XS::default_filter", is used. This function simply
looks up the tag in the %CBOR::XS::FILTER hash. If an entry exists
it must be a code reference that is called with tag and value, and
is responsible for decoding the value. If no entry exists, it
returns no values. "CBOR::XS" provides a number of default filter
functions already, the the %CBOR::XS::FILTER hash can be freely
extended with more.
"CBOR::XS" additionally provides an alternative filter function that
is supposed to be safe to use with untrusted data (which the default
filter might not), called "CBOR::XS::safe_filter", which works the
same as the "default_filter" but uses the %CBOR::XS::SAFE_FILTER
variable instead. It is prepopulated with the tag decoding functions
that are deemed safe (basically the same as %CBOR::XS::FILTER
without all the bignum tags), and can be extended by user code as
wlel, although, obviously, one should be very careful about adding
decoding functions here, since the expectation is that they are safe
to use on untrusted data, after all.
Example: decode all tags not handled internally into
"CBOR::XS::Tagged" objects, with no other special handling (useful
when working with potentially "unsafe" CBOR data).
CBOR::XS->new->filter (sub { })->decode ($cbor_data);
Example: provide a global filter for tag 1347375694, converting the
value into some string form.
$CBOR::XS::FILTER{1347375694} = sub {
my ($tag, $value);
"tag 1347375694 value $value"
};
Example: provide your own filter function that looks up tags in your
own hash:
my %my_filter = (
998347484 => sub {
my ($tag, $value);
"tag 998347484 value $value"
};
);
my $coder = CBOR::XS->new->filter (sub {
&{ $my_filter{$_[0]} or return }
});
Example: use the safe filter function (see "SECURITY CONSIDERATIONS"
for more considerations on security).
CBOR::XS->new->filter (\&CBOR::XS::safe_filter)->decode ($cbor_data);
$cbor_data = $cbor->encode ($perl_scalar)
Converts the given Perl data structure (a scalar value) to its CBOR
representation.
$perl_scalar = $cbor->decode ($cbor_data)
The opposite of "encode": expects CBOR data and tries to parse it,
returning the resulting simple scalar or reference. Croaks on error.
($perl_scalar, $octets) = $cbor->decode_prefix ($cbor_data)
This works like the "decode" method, but instead of raising an
exception when there is trailing garbage after the CBOR string, it
will silently stop parsing there and return the number of characters
consumed so far.
This is useful if your CBOR texts are not delimited by an outer
protocol and you need to know where the first CBOR string ends amd
the next one starts - CBOR strings are self-delimited, so it is
possible to concatenate CBOR strings without any delimiters or size
fields and recover their data.
CBOR::XS->new->decode_prefix ("......")
=> ("...", 3)
INCREMENTAL PARSING
In some cases, there is the need for incremental parsing of JSON texts.
While this module always has to keep both CBOR text and resulting Perl
data structure in memory at one time, it does allow you to parse a CBOR
stream incrementally, using a similar to using "decode_prefix" to see if
a full CBOR object is available, but is much more efficient.
It basically works by parsing as much of a CBOR string as possible - if
the CBOR data is not complete yet, the parser will remember where it
was, to be able to restart when more data has been accumulated. Once
enough data is available to either decode a complete CBOR value or raise
an error, a real decode will be attempted.
A typical use case would be a network protocol that consists of sending
and receiving CBOR-encoded messages. The solution that works with CBOR
and about anything else is by prepending a length to every CBOR value,
so the receiver knows how many octets to read. More compact (and
slightly slower) would be to just send CBOR values back-to-back, as
"CBOR::XS" knows where a CBOR value ends, and doesn't need an explicit
length.
The following methods help with this:
@decoded = $cbor->incr_parse ($buffer)
This method attempts to decode exactly one CBOR value from the
beginning of the given $buffer. The value is removed from the
$buffer on success. When $buffer doesn't contain a complete value
yet, it returns nothing. Finally, when the $buffer doesn't start
with something that could ever be a valid CBOR value, it raises an
exception, just as "decode" would. In the latter case the decoder
state is undefined and must be reset before being able to parse
further.
This method modifies the $buffer in place. When no CBOR value can be
decoded, the decoder stores the current string offset. On the next
call, continues decoding at the place where it stopped before. For
this to make sense, the $buffer must begin with the same octets as
on previous unsuccessful calls.
You can call this method in scalar context, in which case it either
returns a decoded value or "undef". This makes it impossible to
distinguish between CBOR null values (which decode to "undef") and
an unsuccessful decode, which is often acceptable.
@decoded = $cbor->incr_parse_multiple ($buffer)
Same as "incr_parse", but attempts to decode as many CBOR values as
possible in one go, instead of at most one. Calls to "incr_parse"
and "incr_parse_multiple" can be interleaved.
$cbor->incr_reset
Resets the incremental decoder. This throws away any saved state, so
that subsequent calls to "incr_parse" or "incr_parse_multiple" start
to parse a new CBOR value from the beginning of the $buffer again.
This method can be called at any time, but it *must* be called if
you want to change your $buffer or there was a decoding error and
you want to reuse the $cbor object for future incremental parsings.
MAPPING
This section describes how CBOR::XS maps Perl values to CBOR values and
vice versa. These mappings are designed to "do the right thing" in most
circumstances automatically, preserving round-tripping characteristics
(what you put in comes out as something equivalent).
For the more enlightened: note that in the following descriptions,
lowercase *perl* refers to the Perl interpreter, while uppercase *Perl*
refers to the abstract Perl language itself.
CBOR -> PERL
integers
CBOR integers become (numeric) perl scalars. On perls without 64 bit
support, 64 bit integers will be truncated or otherwise corrupted.
byte strings
Byte strings will become octet strings in Perl (the Byte values
0..255 will simply become characters of the same value in Perl).
UTF-8 strings
UTF-8 strings in CBOR will be decoded, i.e. the UTF-8 octets will be
decoded into proper Unicode code points. At the moment, the validity
of the UTF-8 octets will not be validated - corrupt input will
result in corrupted Perl strings.
arrays, maps
CBOR arrays and CBOR maps will be converted into references to a
Perl array or hash, respectively. The keys of the map will be
stringified during this process.
null
CBOR null becomes "undef" in Perl.
true, false, undefined
These CBOR values become "Types:Serialiser::true",
"Types:Serialiser::false" and "Types::Serialiser::error",
respectively. They are overloaded to act almost exactly like the
numbers 1 and 0 (for true and false) or to throw an exception on
access (for error). See the Types::Serialiser manpage for details.
tagged values
Tagged items consists of a numeric tag and another CBOR value.
See "TAG HANDLING AND EXTENSIONS" and the description of "->filter"
for details on which tags are handled how.
anything else
Anything else (e.g. unsupported simple values) will raise a decoding
error.
PERL -> CBOR
The mapping from Perl to CBOR is slightly more difficult, as Perl is a
typeless language. That means this module can only guess which CBOR type
is meant by a perl value.
hash references
Perl hash references become CBOR maps. As there is no inherent
ordering in hash keys (or CBOR maps), they will usually be encoded
in a pseudo-random order. This order can be different each time a
hash is encoded.
Currently, tied hashes will use the indefinite-length format, while
normal hashes will use the fixed-length format.
array references
Perl array references become fixed-length CBOR arrays.
other references
Other unblessed references will be represented using the indirection
tag extension (tag value 22098,
). CBOR decoders are guaranteed
to be able to decode these values somehow, by either "doing the
right thing", decoding into a generic tagged object, simply ignoring
the tag, or something else.
CBOR::XS::Tagged objects
Objects of this type must be arrays consisting of a single "[tag,
value]" pair. The (numerical) tag will be encoded as a CBOR tag, the
value will be encoded as appropriate for the value. You must use
"CBOR::XS::tag" to create such objects.
Types::Serialiser::true, Types::Serialiser::false,
Types::Serialiser::error
These special values become CBOR true, CBOR false and CBOR undefined
values, respectively.
other blessed objects
Other blessed objects are serialised via "TO_CBOR" or "FREEZE". See
"TAG HANDLING AND EXTENSIONS" for specific classes handled by this
module, and "OBJECT SERIALISATION" for generic object serialisation.
simple scalars
Simple Perl scalars (any scalar that is not a reference) are the
most difficult objects to encode: CBOR::XS will encode undefined
scalars as CBOR null values, scalars that have last been used in a
string context before encoding as CBOR strings, and anything else as
number value:
# dump as number
encode_cbor [2] # yields [2]
encode_cbor [-3.0e17] # yields [-3e+17]
my $value = 5; encode_cbor [$value] # yields [5]
# used as string, so dump as string (either byte or text)
print $value;
encode_cbor [$value] # yields ["5"]
# undef becomes null
encode_cbor [undef] # yields [null]
You can force the type to be a CBOR string by stringifying it:
my $x = 3.1; # some variable containing a number
"$x"; # stringified
$x .= ""; # another, more awkward way to stringify
print $x; # perl does it for you, too, quite often
You can force whether a string is encoded as byte or text string by
using "utf8::upgrade" and "utf8::downgrade" (if "text_strings" is
disabled).
utf8::upgrade $x; # encode $x as text string
utf8::downgrade $x; # encode $x as byte string
More options are available, see "TYPE CASTS", below, and the
"text_keys" and "text_strings" options.
Perl doesn't define what operations up- and downgrade strings, so if
the difference between byte and text is important, you should up- or
downgrade your string as late as possible before encoding. You can
also force the use of CBOR text strings by using "text_keys" or
"text_strings".
You can force the type to be a CBOR number by numifying it:
my $x = "3"; # some variable containing a string
$x += 0; # numify it, ensuring it will be dumped as a number
$x *= 1; # same thing, the choice is yours.
You can not currently force the type in other, less obscure, ways.
Tell me if you need this capability (but don't forget to explain why
it's needed :).
Perl values that seem to be integers generally use the shortest
possible representation. Floating-point values will use either the
IEEE single format if possible without loss of precision, otherwise
the IEEE double format will be used. Perls that use formats other
than IEEE double to represent numerical values are supported, but
might suffer loss of precision.
TYPE CASTS
EXPERIMENTAL: As an experimental extension, "CBOR::XS" allows you to
force specific CBOR types to be used when encoding. That allows you to
encode types not normally accessible (e.g. half floats) as well as force
string types even when "text_strings" is in effect.
Type forcing is done by calling a special "cast" function which keeps a
copy of the value and returns a new value that can be handed over to any
CBOR encoder function.
The following casts are currently available (all of which are unary
operators, that is, have a prototype of "$"):
CBOR::XS::as_int $value
Forces the value to be encoded as some form of (basic, not bignum)
integer type.
CBOR::XS::as_text $value
Forces the value to be encoded as (UTF-8) text values.
CBOR::XS::as_bytes $value
Forces the value to be encoded as a (binary) string value.
Example: encode a perl string as binary even though "text_strings"
is in effect.
CBOR::XS->new->text_strings->encode ([4, "text", CBOR::XS::bytes "bytevalue"]);
CBOR::XS::as_bool $value
Converts a Perl boolean (which can be any kind of scalar) into a
CBOR boolean. Strictly the same, but shorter to write, than:
$value ? Types::Serialiser::true : Types::Serialiser::false
CBOR::XS::as_float16 $value
Forces half-float (IEEE 754 binary16) encoding of the given value.
CBOR::XS::as_float32 $value
Forces single-float (IEEE 754 binary32) encoding of the given value.
CBOR::XS::as_float64 $value
Forces double-float (IEEE 754 binary64) encoding of the given value.
CBOR::XS::as_cbor $cbor_text
Not a type cast per-se, this type cast forces the argument to be
encoded as-is. This can be used to embed pre-encoded CBOR data.
Note that no checking on the validity of the $cbor_text is done -
it's the callers responsibility to correctly encode values.
CBOR::XS::as_map [key => value...]
Treat the array reference as key value pairs and output a CBOR map.
This allows you to generate CBOR maps with arbitrary key types (or,
if you don't care about semantics, duplicate keys or pairs in a
custom order), which is otherwise hard to do with Perl.
The single argument must be an array reference with an even number
of elements.
Note that only the reference to the array is copied, the array
itself is not. Modifications done to the array before calling an
encoding function will be reflected in the encoded output.
Example: encode a CBOR map with a string and an integer as keys.
encode_cbor CBOR::XS::as_map [string => "value", 5 => "value"]
OBJECT SERIALISATION
This module implements both a CBOR-specific and the generic
Types::Serialier object serialisation protocol. The following
subsections explain both methods.
ENCODING
This module knows two way to serialise a Perl object: The CBOR-specific
way, and the generic way.
Whenever the encoder encounters a Perl object that it cannot serialise
directly (most of them), it will first look up the "TO_CBOR" method on
it.
If it has a "TO_CBOR" method, it will call it with the object as only
argument, and expects exactly one return value, which it will then
substitute and encode it in the place of the object.
Otherwise, it will look up the "FREEZE" method. If it exists, it will
call it with the object as first argument, and the constant string
"CBOR" as the second argument, to distinguish it from other serialisers.
The "FREEZE" method can return any number of values (i.e. zero or more).
These will be encoded as CBOR perl object, together with the classname.
These methods *MUST NOT* change the data structure that is being
serialised. Failure to comply to this can result in memory corruption -
and worse.
If an object supports neither "TO_CBOR" nor "FREEZE", encoding will fail
with an error.
DECODING
Objects encoded via "TO_CBOR" cannot (normally) be automatically
decoded, but objects encoded via "FREEZE" can be decoded using the
following protocol:
When an encoded CBOR perl object is encountered by the decoder, it will
look up the "THAW" method, by using the stored classname, and will fail
if the method cannot be found.
After the lookup it will call the "THAW" method with the stored
classname as first argument, the constant string "CBOR" as second
argument, and all values returned by "FREEZE" as remaining arguments.
EXAMPLES
Here is an example "TO_CBOR" method:
sub My::Object::TO_CBOR {
my ($obj) = @_;
["this is a serialised My::Object object", $obj->{id}]
}
When a "My::Object" is encoded to CBOR, it will instead encode a simple
array with two members: a string, and the "object id". Decoding this
CBOR string will yield a normal perl array reference in place of the
object.
A more useful and practical example would be a serialisation method for
the URI module. CBOR has a custom tag value for URIs, namely 32:
sub URI::TO_CBOR {
my ($self) = @_;
my $uri = "$self"; # stringify uri
utf8::upgrade $uri; # make sure it will be encoded as UTF-8 string
CBOR::XS::tag 32, "$_[0]"
}
This will encode URIs as a UTF-8 string with tag 32, which indicates an
URI.
Decoding such an URI will not (currently) give you an URI object, but
instead a CBOR::XS::Tagged object with tag number 32 and the string -
exactly what was returned by "TO_CBOR".
To serialise an object so it can automatically be deserialised, you need
to use "FREEZE" and "THAW". To take the URI module as example, this
would be a possible implementation:
sub URI::FREEZE {
my ($self, $serialiser) = @_;
"$self" # encode url string
}
sub URI::THAW {
my ($class, $serialiser, $uri) = @_;
$class->new ($uri)
}
Unlike "TO_CBOR", multiple values can be returned by "FREEZE". For
example, a "FREEZE" method that returns "type", "id" and "variant"
values would cause an invocation of "THAW" with 5 arguments:
sub My::Object::FREEZE {
my ($self, $serialiser) = @_;
($self->{type}, $self->{id}, $self->{variant})
}
sub My::Object::THAW {
my ($class, $serialiser, $type, $id, $variant) = @_;
$class- $type, id => $id, variant => $variant)
}
MAGIC HEADER
There is no way to distinguish CBOR from other formats programmatically.
To make it easier to distinguish CBOR from other formats, the CBOR
specification has a special "magic string" that can be prepended to any
CBOR string without changing its meaning.
This string is available as $CBOR::XS::MAGIC. This module does not
prepend this string to the CBOR data it generates, but it will ignore it
if present, so users can prepend this string as a "file type" indicator
as required.
THE CBOR::XS::Tagged CLASS
CBOR has the concept of tagged values - any CBOR value can be tagged
with a numeric 64 bit number, which are centrally administered.
"CBOR::XS" handles a few tags internally when en- or decoding. You can
also create tags yourself by encoding "CBOR::XS::Tagged" objects, and
the decoder will create "CBOR::XS::Tagged" objects itself when it hits
an unknown tag.
These objects are simply blessed array references - the first member of
the array being the numerical tag, the second being the value.
You can interact with "CBOR::XS::Tagged" objects in the following ways:
$tagged = CBOR::XS::tag $tag, $value
This function(!) creates a new "CBOR::XS::Tagged" object using the
given $tag (0..2**64-1) to tag the given $value (which can be any
Perl value that can be encoded in CBOR, including serialisable Perl
objects and "CBOR::XS::Tagged" objects).
$tagged->[0]
$tagged->[0] = $new_tag
$tag = $tagged->tag
$new_tag = $tagged->tag ($new_tag)
Access/mutate the tag.
$tagged->[1]
$tagged->[1] = $new_value
$value = $tagged->value
$new_value = $tagged->value ($new_value)
Access/mutate the tagged value.
EXAMPLES
Here are some examples of "CBOR::XS::Tagged" uses to tag objects.
You can look up CBOR tag value and emanings in the IANA registry at
.
Prepend a magic header ($CBOR::XS::MAGIC):
my $cbor = encode_cbor CBOR::XS::tag 55799, $value;
# same as:
my $cbor = $CBOR::XS::MAGIC . encode_cbor $value;
Serialise some URIs and a regex in an array:
my $cbor = encode_cbor [
(CBOR::XS::tag 32, "http://www.nethype.de/"),
(CBOR::XS::tag 32, "http://software.schmorp.de/"),
(CBOR::XS::tag 35, "^[Pp][Ee][Rr][lL]\$"),
];
Wrap CBOR data in CBOR:
my $cbor_cbor = encode_cbor
CBOR::XS::tag 24,
encode_cbor [1, 2, 3];
TAG HANDLING AND EXTENSIONS
This section describes how this module handles specific tagged values
and extensions. If a tag is not mentioned here and no additional filters
are provided for it, then the default handling applies (creating a
CBOR::XS::Tagged object on decoding, and only encoding the tag when
explicitly requested).
Tags not handled specifically are currently converted into a
CBOR::XS::Tagged object, which is simply a blessed array reference
consisting of the numeric tag value followed by the (decoded) CBOR
value.
Future versions of this module reserve the right to special case
additional tags (such as base64url).
ENFORCED TAGS
These tags are always handled when decoding, and their handling cannot
be overridden by the user.
26 (perl-object, )
These tags are automatically created (and decoded) for serialisable
objects using the "FREEZE/THAW" methods (the Types::Serialier object
serialisation protocol). See "OBJECT SERIALISATION" for details.
28, 29 (shareable, sharedref, )
These tags are automatically decoded when encountered (and they do
not result in a cyclic data structure, see "allow_cycles"),
resulting in shared values in the decoded object. They are only
encoded, however, when "allow_sharing" is enabled.
Not all shared values can be successfully decoded: values that
reference themselves will *currently* decode as "undef" (this is not
the same as a reference pointing to itself, which will be
represented as a value that contains an indirect reference to itself
- these will be decoded properly).
Note that considerably more shared value data structures can be
decoded than will be encoded - currently, only values pointed to by
references will be shared, others will not. While non-reference
shared values can be generated in Perl with some effort, they were
considered too unimportant to be supported in the encoder. The
decoder, however, will decode these values as shared values.
256, 25 (stringref-namespace, stringref,
)
These tags are automatically decoded when encountered. They are only
encoded, however, when "pack_strings" is enabled.
22098 (indirection, )
This tag is automatically generated when a reference are encountered
(with the exception of hash and array references). It is converted
to a reference when decoding.
55799 (self-describe CBOR, RFC 7049)
This value is not generated on encoding (unless explicitly requested
by the user), and is simply ignored when decoding.
NON-ENFORCED TAGS
These tags have default filters provided when decoding. Their handling
can be overridden by changing the %CBOR::XS::FILTER entry for the tag,
or by providing a custom "filter" callback when decoding.
When they result in decoding into a specific Perl class, the module
usually provides a corresponding "TO_CBOR" method as well.
When any of these need to load additional modules that are not part of
the perl core distribution (e.g. URI), it is (currently) up to the user
to provide these modules. The decoding usually fails with an exception
if the required module cannot be loaded.
0, 1 (date/time string, seconds since the epoch)
These tags are decoded into Time::Piece objects. The corresponding
"Time::Piece::TO_CBOR" method always encodes into tag 1 values
currently.
The Time::Piece API is generally surprisingly bad, and fractional
seconds are only accidentally kept intact, so watch out. On the plus
side, the module comes with perl since 5.10, which has to count for
something.
2, 3 (positive/negative bignum)
These tags are decoded into Math::BigInt objects. The corresponding
"Math::BigInt::TO_CBOR" method encodes "small" bigints into normal
CBOR integers, and others into positive/negative CBOR bignums.
4, 5, 264, 265 (decimal fraction/bigfloat)
Both decimal fractions and bigfloats are decoded into Math::BigFloat
objects. The corresponding "Math::BigFloat::TO_CBOR" method *always*
encodes into a decimal fraction (either tag 4 or 264).
NaN and infinities are not encoded properly, as they cannot be
represented in CBOR.
See "BIGNUM SECURITY CONSIDERATIONS" for more info.
30 (rational numbers)
These tags are decoded into Math::BigRat objects. The corresponding
"Math::BigRat::TO_CBOR" method encodes rational numbers with
denominator 1 via their numerator only, i.e., they become normal
integers or "bignums".
See "BIGNUM SECURITY CONSIDERATIONS" for more info.
21, 22, 23 (expected later JSON conversion)
CBOR::XS is not a CBOR-to-JSON converter, and will simply ignore
these tags.
32 (URI)
These objects decode into URI objects. The corresponding
"URI::TO_CBOR" method again results in a CBOR URI value.
CBOR and JSON
CBOR is supposed to implement a superset of the JSON data model, and is,
with some coercion, able to represent all JSON texts (something that
other "binary JSON" formats such as BSON generally do not support).
CBOR implements some extra hints and support for JSON interoperability,
and the spec offers further guidance for conversion between CBOR and
JSON. None of this is currently implemented in CBOR, and the guidelines
in the spec do not result in correct round-tripping of data. If JSON
interoperability is improved in the future, then the goal will be to
ensure that decoded JSON data will round-trip encoding and decoding to
CBOR intact.
SECURITY CONSIDERATIONS
Tl;dr... if you want to decode or encode CBOR from untrusted sources,
you should start with a coder object created via "new_safe" (which
implements the mitigations explained below):
my $coder = CBOR::XS->new_safe;
my $data = $coder->decode ($cbor_text);
my $cbor = $coder->encode ($data);
Longer version: When you are using CBOR in a protocol, talking to
untrusted potentially hostile creatures requires some thought:
Security of the CBOR decoder itself
First and foremost, your CBOR decoder should be secure, that is,
should not have any buffer overflows or similar bugs that could
potentially be exploited. Obviously, this module should ensure that
and I am trying hard on making that true, but you never know.
CBOR::XS can invoke almost arbitrary callbacks during decoding
CBOR::XS supports object serialisation - decoding CBOR can cause
calls to *any* "THAW" method in *any* package that exists in your
process (that is, CBOR::XS will not try to load modules, but any
existing "THAW" method or function can be called, so they all have
to be secure).
Less obviously, it will also invoke "TO_CBOR" and "FREEZE" methods -
even if all your "THAW" methods are secure, encoding data structures
from untrusted sources can invoke those and trigger bugs in those.
So, if you are not sure about the security of all the modules you
have loaded (you shouldn't), you should disable this part using
"forbid_objects" or using "new_safe".
CBOR can be extended with tags that call library code
CBOR can be extended with tags, and "CBOR::XS" has a registry of
conversion functions for many existing tags that can be extended via
third-party modules (see the "filter" method).
If you don't trust these, you should configure the "safe" filter
function, "CBOR::XS::safe_filter" ("new_safe" does this), which by
default only includes conversion functions that are considered
"safe" by the author (but again, they can be extended by third party
modules).
Depending on your level of paranoia, you can use the "safe" filter:
$cbor->filter (\&CBOR::XS::safe_filter);
... your own filter...
$cbor->filter (sub { ... do your stuffs here ... });
... or even no filter at all, disabling all tag decoding:
$cbor->filter (sub { });
This is never a problem for encoding, as the tag mechanism only
exists in CBOR texts.
Resource-starving attacks: object memory usage
You need to avoid resource-starving attacks. That means you should
limit the size of CBOR data you accept, or make sure then when your
resources run out, that's just fine (e.g. by using a separate
process that can crash safely). The size of a CBOR string in octets
is usually a good indication of the size of the resources required
to decode it into a Perl structure. While CBOR::XS can check the
size of the CBOR text (using "max_size" - done by "new_safe"), it
might be too late when you already have it in memory, so you might
want to check the size before you accept the string.
As for encoding, it is possible to construct data structures that
are relatively small but result in large CBOR texts (for example by
having an array full of references to the same big data structure,
which will all be deep-cloned during encoding by default). This is
rarely an actual issue (and the worst case is still just running out
of memory), but you can reduce this risk by using "allow_sharing".
Resource-starving attacks: stack overflows
CBOR::XS recurses using the C stack when decoding objects and
arrays. The C stack is a limited resource: for instance, on my amd64
machine with 8MB of stack size I can decode around 180k nested
arrays but only 14k nested CBOR objects (due to perl itself
recursing deeply on croak to free the temporary). If that is
exceeded, the program crashes. To be conservative, the default
nesting limit is set to 512. If your process has a smaller stack,
you should adjust this setting accordingly with the "max_depth"
method.
Resource-starving attacks: CPU en-/decoding complexity
CBOR::XS will use the Math::BigInt, Math::BigFloat and Math::BigRat
libraries to represent encode/decode bignums. These can be very slow
(as in, centuries of CPU time) and can even crash your program (and
are generally not very trustworthy). See the next section on bignum
security for details.
Data breaches: leaking information in error messages
CBOR::XS might leak contents of your Perl data structures in its
error messages, so when you serialise sensitive information you
might want to make sure that exceptions thrown by CBOR::XS will not
end up in front of untrusted eyes.
Something else...
Something else could bomb you, too, that I forgot to think of. In
that case, you get to keep the pieces. I am always open for hints,
though...
BIGNUM SECURITY CONSIDERATIONS
CBOR::XS provides a "TO_CBOR" method for both Math::BigInt and
Math::BigFloat that tries to encode the number in the simplest possible
way, that is, either a CBOR integer, a CBOR bigint/decimal fraction (tag
4) or an arbitrary-exponent decimal fraction (tag 264). Rational numbers
(Math::BigRat, tag 30) can also contain bignums as members.
CBOR::XS will also understand base-2 bigfloat or arbitrary-exponent
bigfloats (tags 5 and 265), but it will never generate these on its own.
Using the built-in Math::BigInt::Calc support, encoding and decoding
decimal fractions is generally fast. Decoding bigints can be slow for
very big numbers (tens of thousands of digits, something that could
potentially be caught by limiting the size of CBOR texts), and decoding
bigfloats or arbitrary-exponent bigfloats can be *extremely* slow
(minutes, decades) for large exponents (roughly 40 bit and longer).
Additionally, Math::BigInt can take advantage of other bignum libraries,
such as Math::GMP, which cannot handle big floats with large exponents,
and might simply abort or crash your program, due to their code quality.
This can be a concern if you want to parse untrusted CBOR. If it is, you
might want to disable decoding of tag 2 (bigint) and 3 (negative bigint)
types. You should also disable types 5 and 265, as these can be slow
even without bigints.
Disabling bigints will also partially or fully disable types that rely
on them, e.g. rational numbers that use bignums.
CBOR IMPLEMENTATION NOTES
This section contains some random implementation notes. They do not
describe guaranteed behaviour, but merely behaviour as-is implemented
right now.
64 bit integers are only properly decoded when Perl was built with 64
bit support.
Strings and arrays are encoded with a definite length. Hashes as well,
unless they are tied (or otherwise magical).
Only the double data type is supported for NV data types - when Perl
uses long double to represent floating point values, they might not be
encoded properly. Half precision types are accepted, but not encoded.
Strict mode and canonical mode are not implemented.
LIMITATIONS ON PERLS WITHOUT 64-BIT INTEGER SUPPORT
On perls that were built without 64 bit integer support (these are rare
nowadays, even on 32 bit architectures, as all major Perl distributions
are built with 64 bit integer support), support for any kind of 64 bit
value in CBOR is very limited - most likely, these 64 bit values will be
truncated, corrupted, or otherwise not decoded correctly. This also
includes string, float, array and map sizes that are stored as 64 bit
integers.
THREADS
This module is *not* guaranteed to be thread safe and there are no plans
to change this until Perl gets thread support (as opposed to the
horribly slow so-called "threads" which are simply slow and bloated
process simulations - use fork, it's *much* faster, cheaper, better).
(It might actually work, but you have been warned).
BUGS
While the goal of this module is to be correct, that unfortunately does
not mean it's bug-free, only that I think its design is bug-free. If you
keep reporting bugs they will be fixed swiftly, though.
Please refrain from using rt.cpan.org or any other bug reporting
service. I put the contact address into my modules for a reason.
SEE ALSO
The JSON and JSON::XS modules that do similar, but human-readable,
serialisation.
The Types::Serialiser module provides the data model for true, false and
error values.
AUTHOR
Marc Lehmann
http://home.schmorp.de/
CBOR-XS-1.87/Changes 0000644 0000000 0000000 00000023165 14476700401 012531 0 ustar root root Revision history for Perl extension CBOR::XS
TODO: pack_keys?
TODO: document encode_cbor_sharing?
TODO: large negative integers
TODO: type cast tests.
TODO: round-tripping of types, such as float16 - maybe types::Serialiser support?
TODO: possibly implement https://peteroupc.github.io/CBOR/extended.html, but NaNs are nonportable. rely on libecb?
TODO: https://github.com/svaarala/cbor-specs/blob/master/cbor-nonutf8-string-tags.rst, but maybe that is overkill?
1.87 Fri 08 Sep 2023 22:14:18 CEST
- shared references were not decoded correctly: instead of getting
multiple references to the same object, you got the same
reference to the same object, causing a number of issues. For
example, modifying the reference would modify all places the
reference was used, and encoding the decoded structure would
unshare the previously shared hashes, as trheir reference count
would be 1. Fixing this was rather involved, as perl lacks the
ability to easily swap or copy arrays and hashes.
- \0, \1, \undef do not work, and were not intended to ever work, as
special values, despite being mentioned in the documentation (reported
by nuclightq).
- new feature: allow_weak_cycles.
1.86 Thu 04 Nov 2021 17:48:16 CET
- fixed a wrong printf format specifier (reported by Petr Písař).
1.85 Sat 23 Oct 2021 04:59:56 CEST
- left debugging printf in code, need a test for that :(
1.84 Thu 21 Oct 2021 03:11:52 CEST
- fix a bug in validate_utf8 where we call perl's is_utf8_string with
a lenght of zero for empty strings, but perl interprets that as
"calculate length", causing spurious validation errors for
empty strings.
- include validate_utf8 in new_safe.
- avoid some warnings.
1.83 Tue Dec 8 09:27:06 CET 2020
- add CBOR::XS::as_map cast function.
1.82 Tue Dec 1 02:47:40 CET 2020
- add CBOR::XS::as_bool cast function.
1.81 Mon Nov 30 19:29:33 CET 2020
- cast functions were broken due to last-minute renaming. thats
what you get for not having a tessuite.
- Math::BigInt and Math::BigFloat are pretty broken (again),
so disable some tests. (try printing the bigfloat
799999999999999999998E99999999999999999998).
1.8 Sun Nov 29 22:35:13 CET 2020
- experimental support for some type casts, as well as embedding
raw cbor data.
1.71 Thu Nov 15 20:52:13 CET 2018
- work around what smells like a perl bug w.r.t. exceptions
thrown in callbacks.
- update libecb.
1.7 Tue Jun 27 04:02:23 CEST 2017
- SECURITY FIX: fix two bugs found by american fuzzy lop,
upgrade is advised if you accept data from untrusted
sources.
- an out-of bound sharedref or stringref index could cause an
out of bounds access - might be exploitable.
- a decoding error during indefinite array or hash decoding
could cause an endless loop.
1.6 Wed Dec 7 15:13:23 CET 2016
- greatly expand the SECURITY IMPLICATIONS and similar sections.
- new constructor new_safe, to create a secure CBOR::XS object.
- new option forbid_objects, to disallow serialisation.
- new CBOR::XS::safe_filter functionality.
- fix a crash when decoding a cyclic data structure using
stringref/pack_strings when allow_cycles is disabled.
- fix a crash when decoding hash keys with length >= 2**31.
- avoid unreasonably long decoding times for certain
types of (corrupt) cbor texts.
- support arrays and hashes with >= 2**31 members.
- avoid overflow on pointer arithmetic when checking whether enough
data is available.
- fix a memory leak that occured when decoding failed while decoding
a tagged value.
- do not leak the partially constructed result when stringifying
a hash key throws an exception.
- various code size and efficiency optimizations (reduced code
from 42 to 40kB on my system, despite the new features).
1.5 Wed Apr 27 11:38:39 CEST 2016
- Math::BigFloat madness workaround, see
http://blog.schmorp.de/2016-04-23-mathbigfloat-maintainer-fail.html
(bugreport by zdm@softvisio.net).
- add text_keys and text_strings options to force CBOR text encoding
for perl hash keys or all strings, as a result of discussions
with Fredrik Ljunggren.
- implement support for arbitrary-exponent numbers (see
http://peteroupc.github.io/CBOR/bigfrac.html, tags 264 and 265)
for both en- and decoding.
- implement support for rational numbers (see
http://peteroupc.github.io/CBOR/rational.html, tag 30) for both
en- and decoding.
- the above effectively implements all registered CBOR extensions
in a sensible manner.
- remove some weird dead code that was duplicated (%FILTER).
- add t/58_hv.t, which tests hashes and the new text_* flags.
hashes apparently were not encoded at all in any of the existing
tests.
- document Math::BigFloat base-2 performance/crash issues.
- use stability canary.
1.41 Thu 25 Feb 15:22:03 CET 2016
- avoid perl panics on nested FREEZE/THAW calls (testcase by
Victor Efimov).
1.4 Mon Feb 8 05:10:15 CET 2016
- buffer overflow fix: a fast path during decoding did not check
remaining length when decoding hash keys, found by fuzzing.
This can potentially leak information in the error message
or crash the process.
- use C style { 0 } struct initializer.
- upgrade libecb.
1.3 Mon Apr 27 22:21:04 CEST 2015
- the incremental parser didn't properly parse tagged values
(testcase by Mons Anderson).
- slightly speed up encoding of plain (nonmagical) arrays.
- try to clarify further that effectively all 32 bit architectures
have 64 bit integer support.
- upgrade libecb.
1.26 Sat Oct 25 08:35:44 CEST 2014
- update the t/57_incr.t subtest that would rely on 64 bit ints.
- disable t/50_rfc.t test that fails because of broken data::dumper.
1.25 Sun Jan 5 15:19:14 CET 2014
- map key decoding was pretty much botched due to the recent cleanups.
- work around Time::Piece->epoch returning a string value, avoid encoding
this as a tag 1 string.
- enable more testcases in t/50_rfc.t, now that they work :)
1.2 Tue Dec 10 22:06:42 CET 2013
- implement an incremental decoder.
1.12 Tue Dec 3 11:23:22 CET 2013
- work around broken Time::Piece (in old versions of the module, %z doesn't
work as documented, gives different results on different platforms(!)).
1.11 Sun Dec 1 18:00:00 CET 2013
- new setting: validate_utf8, for when you can't trust your cbor data.
- do not leak memory on decoding errors, when allow_cycles is enabled.
- add default filters for tags 0 and 1, using Time::Piece.
- more tests added.
1.1 Sat Nov 30 19:14:27 CET 2013
- INCOMPATIBLE CHANGE: new decoder setting: allow_cyclic, needed to decode
cyclic data structures (to avoid memleaks in unsuspecting code).
- no longer "share" references that aren't, i.e. true/false/null/error/tagged.
- fix stringref w.r.t. indefinite-length strings.
- verify indefinite-length string chunk types.
- do not allow extremely large arrays - assume an array element
requires at least one CBOR byte, to avoid memory exhaustion attacks.
- major code overhaul.
1.0 Thu Nov 28 16:43:31 CET 2013
- use the now official tag values for extensions. remove the
experimental notice. it's the real thing now, with real bugs.
- renamed allow_stringref to pack_strings.
- port to perl <= 5.16.
- slightly improve the documentation.
0.09 Fri Nov 22 16:54:18 CET 2013
- bignum/bigfloat/decimal support.
- uri support.
- tag filter functions support for decoding.
- do not support reference-to-1/0/undef anymore, you need to use
the Types::Serialiser objects now.
- experimental sharable extension support (http://cbor.schmorp.de/value-sharing).
- experimental stringref extension support (http://cbor.schmorp.de/stringref).
- implement indirection tag (http://cbor.schmorp.de/indirection).
0.08 Wed Oct 30 11:10:43 CET 2013
- defused another too fragile test.
0.07 Tue Oct 29 23:04:07 CET 2013
- don't crash in decode when silly values are passed in.
- considerably speed up map decoding when map keys
are utf-8 or byte strings.
- raising an exception in THAW should now work without
leaking.
0.06 Tue Oct 29 16:56:07 CET 2013
- do not leak when deserialiasing via THAW.
- implement and document CBOR::XS creation/access/mutate
methods.
0.05 Mon Oct 28 22:27:47 CET 2013
- do not leak hash keys on decoding.
0.04 Sun Oct 27 23:47:47 CET 2013
- implement TO_CBOR/FREEZE/THAW serialisation protocols.
- requested perl-object and generic-object tags from iana.
- switched to Types::Serialiser for true, false and error.
- disabled some fragile tests (thanks, andk).
0.03 Sun Oct 27 00:28:41 CEST 2013
- improve 32 bit platform compatibility.
- take more advantage of ecb.h.
- preliminary and bare-bones tagged support.
- improved docs.
0.02 Sat Oct 26 13:08:05 CEST 2013
- no aborts left.
- add $CBOR::XS::MAGIC.
- preliminary tagged decoding to arrayref.
- indefinite encoding fixed.
- half float decoding implemented.
- t/50_rfc.t adds test vectors from the rfc, which
are checked as applicable.
0.01 Fri Oct 25 21:39:56 CEST 2013
- original version; cloned from JSON-XS
CBOR-XS-1.87/XS.xs 0000644 0000000 0000000 00000134701 14476674557 012171 0 ustar root root #include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include
#include
#include
#include
#include
#include
#include
#define ECB_NO_THREADS 1
#include "ecb.h"
// compatibility with perl <5.18
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) strlen (HvNAME (hv))
#endif
#ifndef HvNAMELEN
# define HvNAMELEN(hv) HvNAMELEN_get (hv)
#endif
#ifndef HvNAMEUTF8
# define HvNAMEUTF8(hv) 0
#endif
#ifndef SvREFCNT_inc_NN
# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
#endif
#ifndef SvREFCNT_dec_NN
# define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
#endif
// perl's is_utf8_string interprets len=0 as "calculate len", but we want it to mean 0
#define cbor_is_utf8_string(str,len) (!(len) || is_utf8_string ((str), (len)))
// known major and minor types
enum cbor_type
{
MAJOR_SHIFT = 5,
MINOR_MASK = 0x1f,
MAJOR_POS_INT = 0 << MAJOR_SHIFT,
MAJOR_NEG_INT = 1 << MAJOR_SHIFT,
MAJOR_BYTES = 2 << MAJOR_SHIFT,
MAJOR_TEXT = 3 << MAJOR_SHIFT,
MAJOR_ARRAY = 4 << MAJOR_SHIFT,
MAJOR_MAP = 5 << MAJOR_SHIFT,
MAJOR_TAG = 6 << MAJOR_SHIFT,
MAJOR_MISC = 7 << MAJOR_SHIFT,
// INT/STRING/ARRAY/MAP subtypes
LENGTH_EXT1 = 24,
LENGTH_EXT2 = 25,
LENGTH_EXT4 = 26,
LENGTH_EXT8 = 27,
// SIMPLE types (effectively MISC subtypes)
SIMPLE_FALSE = 20,
SIMPLE_TRUE = 21,
SIMPLE_NULL = 22,
SIMPLE_UNDEF = 23,
// MISC subtype (unused)
MISC_EXT1 = 24,
MISC_FLOAT16 = 25,
MISC_FLOAT32 = 26,
MISC_FLOAT64 = 27,
// BYTES/TEXT/ARRAY/MAP
MINOR_INDEF = 31,
};
// known tags
enum cbor_tag
{
// extensions
CBOR_TAG_STRINGREF = 25, // http://cbor.schmorp.de/stringref
CBOR_TAG_PERL_OBJECT = 26, // http://cbor.schmorp.de/perl-object
CBOR_TAG_GENERIC_OBJECT = 27, // http://cbor.schmorp.de/generic-object
CBOR_TAG_VALUE_SHAREABLE = 28, // http://cbor.schmorp.de/value-sharing
CBOR_TAG_VALUE_SHAREDREF = 29, // http://cbor.schmorp.de/value-sharing
CBOR_TAG_STRINGREF_NAMESPACE = 256, // http://cbor.schmorp.de/stringref
CBOR_TAG_INDIRECTION = 22098, // http://cbor.schmorp.de/indirection
// rfc7049
CBOR_TAG_DATETIME = 0, // rfc4287, utf-8
CBOR_TAG_TIMESTAMP = 1, // unix timestamp, any
CBOR_TAG_POS_BIGNUM = 2, // byte string
CBOR_TAG_NEG_BIGNUM = 3, // byte string
CBOR_TAG_DECIMAL = 4, // decimal fraction, array
CBOR_TAG_BIGFLOAT = 5, // array
CBOR_TAG_CONV_B64U = 21, // base64url, any
CBOR_TAG_CONV_B64 = 22, // base64, any
CBOR_TAG_CONV_HEX = 23, // base16, any
CBOR_TAG_CBOR = 24, // embedded cbor, byte string
CBOR_TAG_URI = 32, // URI rfc3986, utf-8
CBOR_TAG_B64U = 33, // base64url rfc4648, utf-8
CBOR_TAG_B64 = 34, // base6 rfc46484, utf-8
CBOR_TAG_REGEX = 35, // regex pcre/ecma262, utf-8
CBOR_TAG_MIME = 36, // mime message rfc2045, utf-8
CBOR_TAG_MAGIC = 55799, // self-describe cbor
};
// known forced types, also hardcoded in CBOR.pm
enum
{
AS_CBOR = 0,
AS_INT = 1,
AS_BYTES = 2,
AS_TEXT = 3,
AS_FLOAT16 = 4,
AS_FLOAT32 = 5,
AS_FLOAT64 = 6,
AS_MAP = 7,
// possibly future enhancements: (generic) float, (generic) string
};
#define F_SHRINK 0x00000001UL
#define F_ALLOW_UNKNOWN 0x00000002UL
#define F_ALLOW_SHARING 0x00000004UL
#define F_ALLOW_CYCLES 0x00000008UL
#define F_ALLOW_WEAK_CYCLES 0x00000010UL
#define F_FORBID_OBJECTS 0x00000020UL
#define F_PACK_STRINGS 0x00000040UL
#define F_TEXT_KEYS 0x00000080UL
#define F_TEXT_STRINGS 0x00000100UL
#define F_VALIDATE_UTF8 0x00000200UL
#define INIT_SIZE 32 // initial scalar size to be allocated
#define SB do {
#define SE } while (0)
#define IN_RANGE_INC(type,val,beg,end) \
((unsigned type)((unsigned type)(val) - (unsigned type)(beg)) \
<= (unsigned type)((unsigned type)(end) - (unsigned type)(beg)))
#define ERR_NESTING_EXCEEDED "cbor text or perl structure exceeds maximum nesting level (max_depth set too low?)"
#ifdef USE_ITHREADS
# define CBOR_SLOW 1
# define CBOR_STASH (cbor_stash ? cbor_stash : gv_stashpv ("CBOR::XS", 1))
#else
# define CBOR_SLOW 0
# define CBOR_STASH cbor_stash
#endif
static HV *cbor_stash, *types_boolean_stash, *types_error_stash, *cbor_tagged_stash; // CBOR::XS::
static SV *types_true, *types_false, *types_error, *sv_cbor, *default_filter;
typedef struct {
U32 flags;
U32 max_depth;
STRLEN max_size;
SV *filter;
// for the incremental parser
STRLEN incr_pos; // the current offset into the text
STRLEN incr_need; // minimum bytes needed to decode
AV *incr_count; // for every nesting level, the number of outstanding values, or -1 for indef.
} CBOR;
ecb_inline void
cbor_init (CBOR *cbor)
{
Zero (cbor, 1, CBOR);
cbor->max_depth = 512;
}
ecb_inline void
cbor_free (CBOR *cbor)
{
SvREFCNT_dec (cbor->filter);
SvREFCNT_dec (cbor->incr_count);
}
/////////////////////////////////////////////////////////////////////////////
// utility functions
ecb_inline SV *
get_bool (const char *name)
{
SV *sv = get_sv (name, 1);
SvREADONLY_on (sv);
SvREADONLY_on (SvRV (sv));
return sv;
}
ecb_inline void
shrink (SV *sv)
{
sv_utf8_downgrade (sv, 1);
if (SvLEN (sv) > SvCUR (sv) + 1)
{
#ifdef SvPV_shrink_to_cur
SvPV_shrink_to_cur (sv);
#elif defined (SvPV_renew)
SvPV_renew (sv, SvCUR (sv) + 1);
#endif
}
}
// minimum length of a string to be registered for stringref
ecb_inline STRLEN
minimum_string_length (UV idx)
{
return idx <= 23 ? 3
: idx <= 0xffU ? 4
: idx <= 0xffffU ? 5
: idx <= 0xffffffffU ? 7
: 11;
}
/////////////////////////////////////////////////////////////////////////////
// encoder
// structure used for encoding CBOR
typedef struct
{
char *cur; // SvPVX (sv) + current output position
char *end; // SvEND (sv)
SV *sv; // result scalar
CBOR cbor;
U32 depth; // recursion level
HV *stringref[2]; // string => index, or 0 ([0] = bytes, [1] = utf-8)
UV stringref_idx;
HV *shareable; // ptr => index, or 0
UV shareable_idx;
} enc_t;
ecb_inline void
need (enc_t *enc, STRLEN len)
{
if (ecb_expect_false ((uintptr_t)(enc->end - enc->cur) < len))
{
STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
enc->cur = SvPVX (enc->sv) + cur;
enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
}
}
static void encode_sv (enc_t *enc, SV *sv);
ecb_inline void
encode_ch (enc_t *enc, char ch)
{
need (enc, 1);
*enc->cur++ = ch;
}
// used for tags, intregers, element counts and so on
static void
encode_uint (enc_t *enc, int major, UV len)
{
need (enc, 9);
if (ecb_expect_true (len < LENGTH_EXT1))
*enc->cur++ = major | len;
else if (ecb_expect_true (len <= 0xffU))
{
*enc->cur++ = major | LENGTH_EXT1;
*enc->cur++ = len;
}
else if (len <= 0xffffU)
{
*enc->cur++ = major | LENGTH_EXT2;
*enc->cur++ = len >> 8;
*enc->cur++ = len;
}
else if (len <= 0xffffffffU)
{
*enc->cur++ = major | LENGTH_EXT4;
*enc->cur++ = len >> 24;
*enc->cur++ = len >> 16;
*enc->cur++ = len >> 8;
*enc->cur++ = len;
}
else
{
*enc->cur++ = major | LENGTH_EXT8;
*enc->cur++ = len >> 56;
*enc->cur++ = len >> 48;
*enc->cur++ = len >> 40;
*enc->cur++ = len >> 32;
*enc->cur++ = len >> 24;
*enc->cur++ = len >> 16;
*enc->cur++ = len >> 8;
*enc->cur++ = len;
}
}
// encodes a perl value into a CBOR integer
ecb_inline void
encode_int (enc_t *enc, SV *sv)
{
if (SvIsUV (sv))
encode_uint (enc, MAJOR_POS_INT, SvUVX (sv));
else if (SvIVX (sv) >= 0)
encode_uint (enc, MAJOR_POS_INT, SvIVX (sv));
else
encode_uint (enc, MAJOR_NEG_INT, -(SvIVX (sv) + 1));
}
ecb_inline void
encode_tag (enc_t *enc, UV tag)
{
encode_uint (enc, MAJOR_TAG, tag);
}
// exceptional (hopefully) slow path for byte strings that need to be utf8-encoded
ecb_noinline static void
encode_str_utf8 (enc_t *enc, int utf8, char *str, STRLEN len)
{
STRLEN ulen = len;
U8 *p, *pend = (U8 *)str + len;
for (p = (U8 *)str; p < pend; ++p)
ulen += *p >> 7; // count set high bits
encode_uint (enc, MAJOR_TEXT, ulen);
need (enc, ulen);
for (p = (U8 *)str; p < pend; ++p)
if (*p < 0x80)
*enc->cur++ = *p;
else
{
*enc->cur++ = 0xc0 + (*p >> 6);
*enc->cur++ = 0x80 + (*p & 63);
}
}
ecb_inline void
encode_str (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
{
if (ecb_expect_false (upgrade_utf8))
if (!utf8)
{
encode_str_utf8 (enc, utf8, str, len);
return;
}
encode_uint (enc, utf8 ? MAJOR_TEXT : MAJOR_BYTES, len);
need (enc, len);
memcpy (enc->cur, str, len);
enc->cur += len;
}
ecb_inline void
encode_strref (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
{
if (ecb_expect_false (enc->cbor.flags & F_PACK_STRINGS))
{
SV **svp = hv_fetch (enc->stringref[!!utf8], str, len, 1);
if (SvOK (*svp))
{
// already registered, use stringref
encode_tag (enc, CBOR_TAG_STRINGREF);
encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
return;
}
else if (len >= minimum_string_length (enc->stringref_idx))
{
// register only
sv_setuv (*svp, enc->stringref_idx);
++enc->stringref_idx;
}
}
encode_str (enc, upgrade_utf8, utf8, str, len);
}
ecb_inline void
encode_float16 (enc_t *enc, NV nv)
{
need (enc, 1+2);
*enc->cur++ = MAJOR_MISC | MISC_FLOAT16;
uint16_t fp = ecb_float_to_binary16 (nv);
if (!ecb_big_endian ())
fp = ecb_bswap16 (fp);
memcpy (enc->cur, &fp, 2);
enc->cur += 2;
}
ecb_inline void
encode_float32 (enc_t *enc, NV nv)
{
need (enc, 1+4);
*enc->cur++ = MAJOR_MISC | MISC_FLOAT32;
uint32_t fp = ecb_float_to_binary32 (nv);
if (!ecb_big_endian ())
fp = ecb_bswap32 (fp);
memcpy (enc->cur, &fp, 4);
enc->cur += 4;
}
ecb_inline void
encode_float64 (enc_t *enc, NV nv)
{
need (enc, 1+8);
*enc->cur++ = MAJOR_MISC | MISC_FLOAT64;
uint64_t fp = ecb_double_to_binary64 (nv);
if (!ecb_big_endian ())
fp = ecb_bswap64 (fp);
memcpy (enc->cur, &fp, 8);
enc->cur += 8;
}
ecb_inline void
encode_bool (enc_t *enc, int istrue)
{
encode_ch (enc, istrue ? MAJOR_MISC | SIMPLE_TRUE : MAJOR_MISC | SIMPLE_FALSE);
}
// encodes an arrayref containing key-value pairs as CBOR map
ecb_inline void
encode_array_as_map (enc_t *enc, SV *sv)
{
if (enc->depth >= enc->cbor.max_depth)
croak (ERR_NESTING_EXCEEDED);
++enc->depth;
// as_map does error checking for us, but we re-check in case
// things have changed.
if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
croak ("CBOR::XS::as_map requires an array reference (did you change the array after calling as_map?)");
AV *av = (AV *)SvRV (sv);
int i, len = av_len (av);
if (!(len & 1))
croak ("CBOR::XS::as_map requires an even number of elements (did you change the array after calling as_map?)");
encode_uint (enc, MAJOR_MAP, (len + 1) >> 1);
for (i = 0; i <= len; ++i)
{
SV **svp = av_fetch (av, i, 0);
encode_sv (enc, svp ? *svp : &PL_sv_undef);
}
--enc->depth;
}
ecb_inline void
encode_forced (enc_t *enc, UV type, SV *sv)
{
switch (type)
{
case AS_CBOR:
{
STRLEN len;
char *str = SvPVbyte (sv, len);
need (enc, len);
memcpy (enc->cur, str, len);
enc->cur += len;
}
break;
case AS_BYTES:
{
STRLEN len;
char *str = SvPVbyte (sv, len);
encode_strref (enc, 0, 0, str, len);
}
break;
case AS_TEXT:
{
STRLEN len;
char *str = SvPVutf8 (sv, len);
encode_strref (enc, 1, 1, str, len);
}
break;
case AS_INT: encode_int (enc, sv); break;
case AS_FLOAT16: encode_float16 (enc, SvNV (sv)); break;
case AS_FLOAT32: encode_float32 (enc, SvNV (sv)); break;
case AS_FLOAT64: encode_float64 (enc, SvNV (sv)); break;
case AS_MAP: encode_array_as_map (enc, sv); break;
default:
croak ("encountered malformed CBOR::XS::Tagged object");
}
}
static void
encode_av (enc_t *enc, AV *av)
{
int i, len = av_len (av);
if (enc->depth >= enc->cbor.max_depth)
croak (ERR_NESTING_EXCEEDED);
++enc->depth;
encode_uint (enc, MAJOR_ARRAY, len + 1);
if (ecb_expect_false (SvMAGICAL (av)))
for (i = 0; i <= len; ++i)
{
SV **svp = av_fetch (av, i, 0);
encode_sv (enc, svp ? *svp : &PL_sv_undef);
}
else
for (i = 0; i <= len; ++i)
{
SV *sv = AvARRAY (av)[i];
encode_sv (enc, sv ? sv : &PL_sv_undef);
}
--enc->depth;
}
static void
encode_hv (enc_t *enc, HV *hv)
{
HE *he;
if (enc->depth >= enc->cbor.max_depth)
croak (ERR_NESTING_EXCEEDED);
++enc->depth;
int pairs = hv_iterinit (hv);
int mg = SvMAGICAL (hv);
if (ecb_expect_false (mg))
encode_ch (enc, MAJOR_MAP | MINOR_INDEF);
else
encode_uint (enc, MAJOR_MAP, pairs);
while ((he = hv_iternext (hv)))
{
if (HeKLEN (he) == HEf_SVKEY)
encode_sv (enc, HeSVKEY (he));
else
encode_strref (enc, enc->cbor.flags & (F_TEXT_KEYS | F_TEXT_STRINGS), HeKUTF8 (he), HeKEY (he), HeKLEN (he));
encode_sv (enc, ecb_expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he));
}
if (ecb_expect_false (mg))
encode_ch (enc, MAJOR_MISC | MINOR_INDEF);
--enc->depth;
}
// encode objects, arrays and special \0=false and \1=true values.
static void
encode_rv (enc_t *enc, SV *sv)
{
SvGETMAGIC (sv);
svtype svt = SvTYPE (sv);
if (ecb_expect_false (SvOBJECT (sv)))
{
HV *boolean_stash = !CBOR_SLOW || types_boolean_stash
? types_boolean_stash
: gv_stashpv ("Types::Serialiser::Boolean", 1);
HV *error_stash = !CBOR_SLOW || types_error_stash
? types_error_stash
: gv_stashpv ("Types::Serialiser::Error", 1);
HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
? cbor_tagged_stash
: gv_stashpv ("CBOR::XS::Tagged" , 1);
HV *stash = SvSTASH (sv);
if (stash == boolean_stash)
{
encode_bool (enc, SvIV (sv));
return;
}
else if (stash == error_stash)
{
encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
return;
}
else if (stash == tagged_stash)
{
if (svt != SVt_PVAV)
croak ("encountered CBOR::XS::Tagged object that isn't an array");
switch (av_len ((AV *)sv))
{
case 2-1:
// actually a tagged value
encode_uint (enc, MAJOR_TAG, SvUV (*av_fetch ((AV *)sv, 0, 1)));
encode_sv (enc, *av_fetch ((AV *)sv, 1, 1));
break;
case 3-1:
// a forced type [value, type, undef]
encode_forced (enc, SvUV (*av_fetch ((AV *)sv, 1, 1)), *av_fetch ((AV *)sv, 0, 1));
break;
default:
croak ("encountered malformed CBOR::XS::Tagged object");
}
return;
}
}
if (ecb_expect_false (SvREFCNT (sv) > 1)
&& ecb_expect_false (enc->cbor.flags & F_ALLOW_SHARING))
{
if (ecb_expect_false (!enc->shareable))
enc->shareable = (HV *)sv_2mortal ((SV *)newHV ());
SV **svp = hv_fetch (enc->shareable, (char *)&sv, sizeof (sv), 1);
if (SvOK (*svp))
{
encode_tag (enc, CBOR_TAG_VALUE_SHAREDREF);
encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
return;
}
else
{
sv_setuv (*svp, enc->shareable_idx);
++enc->shareable_idx;
encode_tag (enc, CBOR_TAG_VALUE_SHAREABLE);
}
}
if (ecb_expect_false (SvOBJECT (sv)))
{
HV *stash = SvSTASH (sv);
GV *method;
if (enc->cbor.flags & F_FORBID_OBJECTS)
croak ("encountered object '%s', but forbid_objects is enabled",
SvPV_nolen (sv_2mortal (newRV_inc (sv))));
else if ((method = gv_fetchmethod_autoload (stash, "TO_CBOR", 0)))
{
dSP;
ENTER; SAVETMPS;
PUSHMARK (SP);
// we re-bless the reference to get overload and other niceties right
XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
PUTBACK;
// G_SCALAR ensures that return value is 1
call_sv ((SV *)GvCV (method), G_SCALAR);
SPAGAIN;
// catch this surprisingly common error
if (SvROK (TOPs) && SvRV (TOPs) == sv)
croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (stash));
encode_sv (enc, POPs);
PUTBACK;
FREETMPS; LEAVE;
}
else if ((method = gv_fetchmethod_autoload (stash, "FREEZE", 0)) != 0)
{
dSP;
ENTER; SAVETMPS;
PUSHMARK (SP);
EXTEND (SP, 2);
// we re-bless the reference to get overload and other niceties right
PUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
PUSHs (sv_cbor);
PUTBACK;
int count = call_sv ((SV *)GvCV (method), G_ARRAY);
SPAGAIN;
// catch this surprisingly common error
if (count == 1 && SvROK (TOPs) && SvRV (TOPs) == sv)
croak ("%s::FREEZE(CBOR) method returned same object as was passed instead of a new one", HvNAME (stash));
encode_tag (enc, CBOR_TAG_PERL_OBJECT);
encode_uint (enc, MAJOR_ARRAY, count + 1);
encode_strref (enc, 0, HvNAMEUTF8 (stash), HvNAME (stash), HvNAMELEN (stash));
{
int i;
for (i = 0; i < count; ++i)
encode_sv (enc, SP[i + 1 - count]);
SP -= count;
}
PUTBACK;
FREETMPS; LEAVE;
}
else
croak ("encountered object '%s', but no TO_CBOR or FREEZE methods available on it",
SvPV_nolen (sv_2mortal (newRV_inc (sv))));
}
else if (svt == SVt_PVHV)
encode_hv (enc, (HV *)sv);
else if (svt == SVt_PVAV)
encode_av (enc, (AV *)sv);
else
{
encode_tag (enc, CBOR_TAG_INDIRECTION);
encode_sv (enc, sv);
}
}
static void
encode_nv (enc_t *enc, SV *sv)
{
double nv = SvNVX (sv);
need (enc, 9);
if (ecb_expect_false (nv == (NV)(U32)nv))
encode_uint (enc, MAJOR_POS_INT, (U32)nv);
//TODO: maybe I32?
else if (ecb_expect_false (nv == (float)nv))
encode_float32 (enc, nv);
else
encode_float64 (enc, nv);
}
static void
encode_sv (enc_t *enc, SV *sv)
{
SvGETMAGIC (sv);
if (SvPOKp (sv))
{
STRLEN len;
char *str = SvPV (sv, len);
encode_strref (enc, enc->cbor.flags & F_TEXT_STRINGS, SvUTF8 (sv), str, len);
}
else if (SvNOKp (sv))
encode_nv (enc, sv);
else if (SvIOKp (sv))
encode_int (enc, sv);
else if (SvROK (sv))
encode_rv (enc, SvRV (sv));
else if (!SvOK (sv))
encode_ch (enc, MAJOR_MISC | SIMPLE_NULL);
else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
else
croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data",
SvPV_nolen (sv), (unsigned int)SvFLAGS (sv));
}
static SV *
encode_cbor (SV *scalar, CBOR *cbor)
{
enc_t enc = { 0 };
enc.cbor = *cbor;
enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
enc.cur = SvPVX (enc.sv);
enc.end = SvEND (enc.sv);
SvPOK_only (enc.sv);
if (cbor->flags & F_PACK_STRINGS)
{
encode_tag (&enc, CBOR_TAG_STRINGREF_NAMESPACE);
enc.stringref[0]= (HV *)sv_2mortal ((SV *)newHV ());
enc.stringref[1]= (HV *)sv_2mortal ((SV *)newHV ());
}
encode_sv (&enc, scalar);
SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
*SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
if (enc.cbor.flags & F_SHRINK)
shrink (enc.sv);
return enc.sv;
}
/////////////////////////////////////////////////////////////////////////////
// decoder
// structure used for decoding CBOR
typedef struct
{
U8 *cur; // current parser pointer
U8 *end; // end of input string
const char *err; // parse error, if != 0
CBOR cbor;
U32 depth; // recursion depth
U32 maxdepth; // recursion depth limit
AV *shareable;
AV *stringref;
SV *decode_tagged;
SV *err_sv; // optional sv for error, needs to be freed
} dec_t;
// set dec->err to ERRSV
ecb_cold static void
err_errsv (dec_t *dec)
{
if (!dec->err)
{
dec->err_sv = newSVsv (ERRSV);
// chop off the trailing \n
SvCUR_set (dec->err_sv, SvCUR (dec->err_sv) - 1);
*SvEND (dec->err_sv) = 0;
dec->err = SvPVutf8_nolen (dec->err_sv);
}
}
// the following functions are used to reduce code size and help the compiler to optimise
ecb_cold static void
err_set (dec_t *dec, const char *reason)
{
if (!dec->err)
dec->err = reason;
}
ecb_cold static void
err_unexpected_end (dec_t *dec)
{
err_set (dec, "unexpected end of CBOR data");
}
#define ERR_DO(do) SB do; goto fail; SE
#define ERR(reason) ERR_DO (err_set (dec, reason))
#define ERR_ERRSV ERR_DO (err_errsv (dec))
#define WANT(len) if (ecb_expect_false ((uintptr_t)(dec->end - dec->cur) < (STRLEN)len)) ERR_DO (err_unexpected_end (dec))
#define DEC_INC_DEPTH if (ecb_expect_false (++dec->depth > dec->cbor.max_depth)) ERR (ERR_NESTING_EXCEEDED)
#define DEC_DEC_DEPTH --dec->depth
static UV
decode_uint (dec_t *dec)
{
U8 m = *dec->cur & MINOR_MASK;
++dec->cur;
if (ecb_expect_true (m < LENGTH_EXT1))
return m;
else if (ecb_expect_true (m == LENGTH_EXT1))
{
WANT (1);
dec->cur += 1;
return dec->cur[-1];
}
else if (ecb_expect_true (m == LENGTH_EXT2))
{
WANT (2);
dec->cur += 2;
return (((UV)dec->cur[-2]) << 8)
| ((UV)dec->cur[-1]);
}
else if (ecb_expect_true (m == LENGTH_EXT4))
{
WANT (4);
dec->cur += 4;
return (((UV)dec->cur[-4]) << 24)
| (((UV)dec->cur[-3]) << 16)
| (((UV)dec->cur[-2]) << 8)
| ((UV)dec->cur[-1]);
}
else if (ecb_expect_true (m == LENGTH_EXT8))
{
WANT (8);
dec->cur += 8;
return
#if UVSIZE < 8
0
#else
(((UV)dec->cur[-8]) << 56)
| (((UV)dec->cur[-7]) << 48)
| (((UV)dec->cur[-6]) << 40)
| (((UV)dec->cur[-5]) << 32)
#endif
| (((UV)dec->cur[-4]) << 24)
| (((UV)dec->cur[-3]) << 16)
| (((UV)dec->cur[-2]) << 8)
| ((UV)dec->cur[-1]);
}
else
ERR ("corrupted CBOR data (unsupported integer minor encoding)");
fail:
return 0;
}
static SV *decode_sv (dec_t *dec);
static SV *
decode_av (dec_t *dec)
{
AV *av = newAV ();
DEC_INC_DEPTH;
if (*dec->cur == (MAJOR_ARRAY | MINOR_INDEF))
{
++dec->cur;
for (;;)
{
WANT (1);
if (*dec->cur == (MAJOR_MISC | MINOR_INDEF) || dec->err)
{
++dec->cur;
break;
}
av_push (av, decode_sv (dec));
}
}
else
{
UV i, len = decode_uint (dec);
WANT (len); // complexity check for av_fill - need at least one byte per value, do not allow supersize arrays
av_fill (av, len - 1);
for (i = 0; i < len; ++i)
AvARRAY (av)[i] = decode_sv (dec);
}
DEC_DEC_DEPTH;
return newRV_noinc ((SV *)av);
fail:
SvREFCNT_dec_NN (av);
DEC_DEC_DEPTH;
return &PL_sv_undef;
}
static void
decode_he (dec_t *dec, HV *hv)
{
// for speed reasons, we specialcase single-string
// byte or utf-8 strings as keys, but only when !stringref
if (ecb_expect_true (!dec->stringref))
if (ecb_expect_true ((U8)(*dec->cur - MAJOR_BYTES) <= LENGTH_EXT8))
{
STRLEN len = decode_uint (dec);
char *key = (char *)dec->cur;
WANT (len);
dec->cur += len;
hv_store (hv, key, len, decode_sv (dec), 0);
return;
}
else if (ecb_expect_true ((U8)(*dec->cur - MAJOR_TEXT) <= LENGTH_EXT8))
{
STRLEN len = decode_uint (dec);
char *key = (char *)dec->cur;
WANT (len);
dec->cur += len;
if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
if (!cbor_is_utf8_string ((U8 *)key, len))
ERR ("corrupted CBOR data (invalid UTF-8 in map key)");
hv_store (hv, key, -len, decode_sv (dec), 0);
return;
}
SV *k = decode_sv (dec);
SV *v = decode_sv (dec);
// we leak memory if uncaught exceptions are thrown by random magical
// methods, and this is hopefully the only place where it can happen,
// so if there is a chance of an exception, take the very slow path.
// since catching exceptions is "undocumented/internal/forbidden" by
// the new p5p powers, we need to call out to a perl function :/
if (ecb_expect_false (SvAMAGIC (k)))
{
dSP;
ENTER; SAVETMPS;
PUSHMARK (SP);
EXTEND (SP, 3);
PUSHs (sv_2mortal (newRV_inc ((SV *)hv)));
PUSHs (sv_2mortal (k));
PUSHs (sv_2mortal (v));
PUTBACK;
call_pv ("CBOR::XS::_hv_store", G_VOID | G_DISCARD | G_EVAL);
SPAGAIN;
FREETMPS; LEAVE;
if (SvTRUE (ERRSV))
ERR_ERRSV;
return;
}
hv_store_ent (hv, k, v, 0);
SvREFCNT_dec_NN (k);
fail:
;
}
static SV *
decode_hv (dec_t *dec)
{
HV *hv = newHV ();
DEC_INC_DEPTH;
if (*dec->cur == (MAJOR_MAP | MINOR_INDEF))
{
++dec->cur;
for (;;)
{
WANT (1);
if (*dec->cur == (MAJOR_MISC | MINOR_INDEF) || dec->err)
{
++dec->cur;
break;
}
decode_he (dec, hv);
}
}
else
{
UV pairs = decode_uint (dec);
WANT (pairs); // complexity check - need at least one byte per value, do not allow supersize hashes
while (pairs--)
decode_he (dec, hv);
}
DEC_DEC_DEPTH;
return newRV_noinc ((SV *)hv);
fail:
SvREFCNT_dec_NN (hv);
DEC_DEC_DEPTH;
return &PL_sv_undef;
}
static SV *
decode_str (dec_t *dec, int utf8)
{
SV *sv = 0;
if (ecb_expect_false ((*dec->cur & MINOR_MASK) == MINOR_INDEF))
{
// indefinite length strings
++dec->cur;
U8 major = *dec->cur & MAJOR_MISC;
sv = newSVpvn ("", 0);
for (;;)
{
WANT (1);
if ((*dec->cur - major) > LENGTH_EXT8)
if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
{
++dec->cur;
break;
}
else
ERR ("corrupted CBOR data (invalid chunks in indefinite length string)");
STRLEN len = decode_uint (dec);
WANT (len);
sv_catpvn (sv, dec->cur, len);
dec->cur += len;
}
}
else
{
STRLEN len = decode_uint (dec);
WANT (len);
sv = newSVpvn (dec->cur, len);
dec->cur += len;
if (ecb_expect_false (dec->stringref)
&& SvCUR (sv) >= minimum_string_length (AvFILLp (dec->stringref) + 1))
av_push (dec->stringref, SvREFCNT_inc_NN (sv));
}
if (utf8)
{
if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
if (!cbor_is_utf8_string (SvPVX (sv), SvCUR (sv)))
ERR ("corrupted CBOR data (invalid UTF-8 in text string)");
SvUTF8_on (sv);
}
return sv;
fail:
SvREFCNT_dec (sv);
return &PL_sv_undef;
}
static SV *
decode_tagged (dec_t *dec)
{
SV *sv = 0;
UV tag = decode_uint (dec);
WANT (1);
switch (tag)
{
case CBOR_TAG_MAGIC:
sv = decode_sv (dec);
break;
case CBOR_TAG_INDIRECTION:
sv = newRV_noinc (decode_sv (dec));
break;
case CBOR_TAG_STRINGREF_NAMESPACE:
{
// do not use SAVETMPS/FREETMPS, as these will
// erase mortalised caches, e.g. "shareable"
ENTER;
SAVESPTR (dec->stringref);
dec->stringref = (AV *)sv_2mortal ((SV *)newAV ());
sv = decode_sv (dec);
LEAVE;
}
break;
case CBOR_TAG_STRINGREF:
{
if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
ERR ("corrupted CBOR data (stringref index not an unsigned integer)");
UV idx = decode_uint (dec);
if (!dec->stringref || idx >= (UV)(1 + AvFILLp (dec->stringref)))
ERR ("corrupted CBOR data (stringref index out of bounds or outside namespace)");
sv = newSVsv (AvARRAY (dec->stringref)[idx]);
}
break;
case CBOR_TAG_VALUE_SHAREABLE:
{
if (ecb_expect_false (!dec->shareable))
dec->shareable = (AV *)sv_2mortal ((SV *)newAV ());
if (ecb_expect_false (dec->cbor.flags & (F_ALLOW_CYCLES | F_ALLOW_WEAK_CYCLES)))
{
// if cycles are allowed, then we store an AV as value
// while it is being decoded, and gather unresolved
// references in it, to be re4solved after decoding.
int idx, i;
AV *av = newAV ();
av_push (dec->shareable, (SV *)av);
idx = AvFILLp (dec->shareable);
sv = decode_sv (dec);
// the AV now contains \undef for all unresolved references,
// so we fix them up here.
for (i = 0; i <= AvFILLp (av); ++i)
SvRV_set (AvARRAY (av)[i], SvREFCNT_inc_NN (SvRV (sv)));
// weaken all recursive references
if (dec->cbor.flags & F_ALLOW_WEAK_CYCLES)
for (i = 0; i <= AvFILLp (av); ++i)
sv_rvweaken (AvARRAY (av)[i]);
// now replace the AV by a reference to the completed value
SvREFCNT_dec_NN ((SV *)av);
AvARRAY (dec->shareable)[idx] = SvREFCNT_inc_NN (sv);
}
else
{
av_push (dec->shareable, &PL_sv_undef);
int idx = AvFILLp (dec->shareable);
sv = decode_sv (dec);
AvARRAY (dec->shareable)[idx] = SvREFCNT_inc_NN (sv);
}
}
break;
case CBOR_TAG_VALUE_SHAREDREF:
{
if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
ERR ("corrupted CBOR data (sharedref index not an unsigned integer)");
UV idx = decode_uint (dec);
if (!dec->shareable || idx >= (UV)(1 + AvFILLp (dec->shareable)))
ERR ("corrupted CBOR data (sharedref index out of bounds)");
sv = AvARRAY (dec->shareable)[idx];
// reference to cycle, we create a new \undef and use that, and also
// registerr it in the AV for later fixing
if (ecb_expect_false (SvTYPE (sv) == SVt_PVAV))
{
AV *av = (AV *)sv;
sv = newRV_noinc (&PL_sv_undef);
av_push (av, SvREFCNT_inc_NN (sv));
}
else if (ecb_expect_false (sv == &PL_sv_undef)) // not yet decoded, but cycles not allowed
ERR ("cyclic CBOR data structure found, but allow_cycles is not enabled");
else // we decoded the object earlier, no cycle
sv = newSVsv (sv);
}
break;
case CBOR_TAG_PERL_OBJECT:
{
if (dec->cbor.flags & F_FORBID_OBJECTS)
goto filter;
sv = decode_sv (dec);
if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
ERR ("corrupted CBOR data (non-array perl object)");
AV *av = (AV *)SvRV (sv);
int len = av_len (av) + 1;
HV *stash = gv_stashsv (*av_fetch (av, 0, 1), 0);
if (!stash)
ERR ("cannot decode perl-object (package does not exist)");
GV *method = gv_fetchmethod_autoload (stash, "THAW", 0);
if (!method)
ERR ("cannot decode perl-object (package does not have a THAW method)");
dSP;
ENTER; SAVETMPS;
PUSHMARK (SP);
EXTEND (SP, len + 1);
// we re-bless the reference to get overload and other niceties right
PUSHs (*av_fetch (av, 0, 1));
PUSHs (sv_cbor);
int i;
for (i = 1; i < len; ++i)
PUSHs (*av_fetch (av, i, 1));
PUTBACK;
call_sv ((SV *)GvCV (method), G_SCALAR | G_EVAL);
SPAGAIN;
if (SvTRUE (ERRSV))
{
FREETMPS; LEAVE;
ERR_ERRSV;
}
SvREFCNT_dec_NN (sv);
sv = SvREFCNT_inc (POPs);
PUTBACK;
FREETMPS; LEAVE;
}
break;
default:
filter:
{
SV *tag_sv = newSVuv (tag);
sv = decode_sv (dec);
dSP;
ENTER; SAVETMPS;
PUSHMARK (SP);
EXTEND (SP, 2);
PUSHs (tag_sv);
PUSHs (sv);
PUTBACK;
int count = call_sv (dec->cbor.filter ? dec->cbor.filter : default_filter, G_ARRAY | G_EVAL);
SPAGAIN;
if (SvTRUE (ERRSV))
{
SvREFCNT_dec_NN (tag_sv);
FREETMPS; LEAVE;
ERR_ERRSV;
}
if (count)
{
SvREFCNT_dec_NN (tag_sv);
SvREFCNT_dec_NN (sv);
sv = SvREFCNT_inc_NN (TOPs);
SP -= count;
}
else
{
AV *av = newAV ();
av_push (av, tag_sv);
av_push (av, sv);
HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
? cbor_tagged_stash
: gv_stashpv ("CBOR::XS::Tagged" , 1);
sv = sv_bless (newRV_noinc ((SV *)av), tagged_stash);
}
PUTBACK;
FREETMPS; LEAVE;
}
break;
}
return sv;
fail:
SvREFCNT_dec (sv);
return &PL_sv_undef;
}
static SV *
decode_sv (dec_t *dec)
{
WANT (1);
switch (*dec->cur >> MAJOR_SHIFT)
{
case MAJOR_POS_INT >> MAJOR_SHIFT: return newSVuv (decode_uint (dec));
case MAJOR_NEG_INT >> MAJOR_SHIFT: return newSViv (-1 - (IV)decode_uint (dec));
case MAJOR_BYTES >> MAJOR_SHIFT: return decode_str (dec, 0);
case MAJOR_TEXT >> MAJOR_SHIFT: return decode_str (dec, 1);
case MAJOR_ARRAY >> MAJOR_SHIFT: return decode_av (dec);
case MAJOR_MAP >> MAJOR_SHIFT: return decode_hv (dec);
case MAJOR_TAG >> MAJOR_SHIFT: return decode_tagged (dec);
case MAJOR_MISC >> MAJOR_SHIFT:
switch (*dec->cur++ & MINOR_MASK)
{
case SIMPLE_FALSE:
#if CBOR_SLOW
types_false = get_bool ("Types::Serialiser::false");
#endif
return newSVsv (types_false);
case SIMPLE_TRUE:
#if CBOR_SLOW
types_true = get_bool ("Types::Serialiser::true");
#endif
return newSVsv (types_true);
case SIMPLE_NULL:
return newSVsv (&PL_sv_undef);
case SIMPLE_UNDEF:
#if CBOR_SLOW
types_error = get_bool ("Types::Serialiser::error");
#endif
return newSVsv (types_error);
case MISC_FLOAT16:
{
WANT (2);
uint16_t fp = (dec->cur[0] << 8) | dec->cur[1];
dec->cur += 2;
return newSVnv (ecb_binary16_to_float (fp));
}
case MISC_FLOAT32:
{
uint32_t fp;
WANT (4);
memcpy (&fp, dec->cur, 4);
dec->cur += 4;
if (!ecb_big_endian ())
fp = ecb_bswap32 (fp);
return newSVnv (ecb_binary32_to_float (fp));
}
case MISC_FLOAT64:
{
uint64_t fp;
WANT (8);
memcpy (&fp, dec->cur, 8);
dec->cur += 8;
if (!ecb_big_endian ())
fp = ecb_bswap64 (fp);
return newSVnv (ecb_binary64_to_double (fp));
}
// 0..19 unassigned simple
// 24 reserved + unassigned simple (reserved values are not encodable)
// 28-30 unassigned misc
// 31 break code
default:
ERR ("corrupted CBOR data (reserved/unassigned/unexpected major 7 value)");
}
break;
}
fail:
return &PL_sv_undef;
}
static SV *
decode_cbor (SV *string, CBOR *cbor, char **offset_return)
{
dec_t dec = { 0 };
SV *sv;
STRLEN len;
char *data = SvPVbyte (string, len);
if (len > cbor->max_size && cbor->max_size)
croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
(unsigned long)len, (unsigned long)cbor->max_size);
dec.cbor = *cbor;
dec.cur = (U8 *)data;
dec.end = (U8 *)data + len;
sv = decode_sv (&dec);
if (offset_return)
*offset_return = dec.cur;
if (!(offset_return || !sv))
if (dec.cur != dec.end && !dec.err)
dec.err = "garbage after CBOR object";
if (dec.err)
{
if (dec.shareable)
{
// need to break cyclic links, which would all be in shareable
int i;
SV **svp;
for (i = av_len (dec.shareable) + 1; i--; )
if ((svp = av_fetch (dec.shareable, i, 0)))
sv_setsv (*svp, &PL_sv_undef);
}
SvREFCNT_dec_NN (sv);
if (dec.err_sv)
sv_2mortal (dec.err_sv);
croak ("%s, at offset %ld (octet 0x%02x)", dec.err, (long)(dec.cur - (U8 *)data), (int)(uint8_t)*dec.cur);
}
sv = sv_2mortal (sv);
return sv;
}
/////////////////////////////////////////////////////////////////////////////
// incremental parser
#define INCR_DONE(cbor) (AvFILLp (cbor->incr_count) < 0)
// returns 0 for notyet, 1 for success or error
static int
incr_parse (CBOR *self, SV *cborstr)
{
STRLEN cur;
SvPV (cborstr, cur);
while (ecb_expect_true (self->incr_need <= cur))
{
// table of integer count bytes
static I8 incr_len[MINOR_MASK + 1] = {
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
1, 2, 4, 8,-1,-1,-1,-2
};
const U8 *p = SvPVX (cborstr) + self->incr_pos;
U8 m = *p & MINOR_MASK;
IV count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
I8 ilen = incr_len[m];
self->incr_need = self->incr_pos + 1;
if (ecb_expect_false (ilen < 0))
{
if (m != MINOR_INDEF)
return 1; // error
if (*p == (MAJOR_MISC | MINOR_INDEF))
{
if (count >= 0)
return 1; // error
count = 1;
}
else
{
av_push (self->incr_count, newSViv (-1)); //TODO: nest
count = -1;
}
}
else
{
self->incr_need += ilen;
if (ecb_expect_false (self->incr_need > cur))
return 0;
int major = *p >> MAJOR_SHIFT;
switch (major)
{
case MAJOR_TAG >> MAJOR_SHIFT:
++count; // tags merely prefix another value
break;
case MAJOR_BYTES >> MAJOR_SHIFT:
case MAJOR_TEXT >> MAJOR_SHIFT:
case MAJOR_ARRAY >> MAJOR_SHIFT:
case MAJOR_MAP >> MAJOR_SHIFT:
{
UV len;
if (ecb_expect_false (ilen))
{
len = 0;
do {
len = (len << 8) | *++p;
} while (--ilen);
}
else
len = m;
switch (major)
{
case MAJOR_BYTES >> MAJOR_SHIFT:
case MAJOR_TEXT >> MAJOR_SHIFT:
self->incr_need += len;
if (ecb_expect_false (self->incr_need > cur))
return 0;
break;
case MAJOR_MAP >> MAJOR_SHIFT:
len <<= 1;
/* FALLTHROUGH */
case MAJOR_ARRAY >> MAJOR_SHIFT:
if (len)
{
av_push (self->incr_count, newSViv (len + 1)); //TODO: nest
count = len + 1;
}
break;
}
}
}
}
self->incr_pos = self->incr_need;
if (count > 0)
{
while (!--count)
{
if (!AvFILLp (self->incr_count))
return 1; // done
SvREFCNT_dec_NN (av_pop (self->incr_count));
count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
}
SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]) = count;
}
}
return 0;
}
/////////////////////////////////////////////////////////////////////////////
// XS interface functions
MODULE = CBOR::XS PACKAGE = CBOR::XS
BOOT:
{
cbor_stash = gv_stashpv ("CBOR::XS" , 1);
cbor_tagged_stash = gv_stashpv ("CBOR::XS::Tagged" , 1);
types_boolean_stash = gv_stashpv ("Types::Serialiser::Boolean", 1);
types_error_stash = gv_stashpv ("Types::Serialiser::Error" , 1);
types_true = get_bool ("Types::Serialiser::true" );
types_false = get_bool ("Types::Serialiser::false");
types_error = get_bool ("Types::Serialiser::error");
default_filter = newSVpv ("CBOR::XS::default_filter", 0);
sv_cbor = newSVpv ("CBOR", 0);
SvREADONLY_on (sv_cbor);
assert (("STRLEN must be an unsigned type", 0 <= (STRLEN)-1));
}
PROTOTYPES: DISABLE
void CLONE (...)
CODE:
cbor_stash = 0;
cbor_tagged_stash = 0;
types_error_stash = 0;
types_boolean_stash = 0;
void new (char *klass)
PPCODE:
{
SV *pv = NEWSV (0, sizeof (CBOR));
SvPOK_only (pv);
cbor_init ((CBOR *)SvPVX (pv));
XPUSHs (sv_2mortal (sv_bless (
newRV_noinc (pv),
strEQ (klass, "CBOR::XS") ? CBOR_STASH : gv_stashpv (klass, 1)
)));
}
void shrink (CBOR *self, int enable = 1)
ALIAS:
shrink = F_SHRINK
allow_unknown = F_ALLOW_UNKNOWN
allow_sharing = F_ALLOW_SHARING
allow_cycles = F_ALLOW_CYCLES
allow_weak_cycles = F_ALLOW_WEAK_CYCLES
forbid_objects = F_FORBID_OBJECTS
pack_strings = F_PACK_STRINGS
text_keys = F_TEXT_KEYS
text_strings = F_TEXT_STRINGS
validate_utf8 = F_VALIDATE_UTF8
PPCODE:
{
if (enable)
self->flags |= ix;
else
self->flags &= ~ix;
XPUSHs (ST (0));
}
void get_shrink (CBOR *self)
ALIAS:
get_shrink = F_SHRINK
get_allow_unknown = F_ALLOW_UNKNOWN
get_allow_sharing = F_ALLOW_SHARING
get_allow_cycles = F_ALLOW_CYCLES
get_allow_weak_cycles = F_ALLOW_WEAK_CYCLES
get_forbid_objects = F_FORBID_OBJECTS
get_pack_strings = F_PACK_STRINGS
get_text_keys = F_TEXT_KEYS
get_text_strings = F_TEXT_STRINGS
get_validate_utf8 = F_VALIDATE_UTF8
PPCODE:
XPUSHs (boolSV (self->flags & ix));
void max_depth (CBOR *self, U32 max_depth = 0x80000000UL)
PPCODE:
self->max_depth = max_depth;
XPUSHs (ST (0));
U32 get_max_depth (CBOR *self)
CODE:
RETVAL = self->max_depth;
OUTPUT:
RETVAL
void max_size (CBOR *self, U32 max_size = 0)
PPCODE:
self->max_size = max_size;
XPUSHs (ST (0));
int get_max_size (CBOR *self)
CODE:
RETVAL = self->max_size;
OUTPUT:
RETVAL
void filter (CBOR *self, SV *filter = 0)
PPCODE:
SvREFCNT_dec (self->filter);
self->filter = filter ? newSVsv (filter) : filter;
XPUSHs (ST (0));
SV *get_filter (CBOR *self)
CODE:
RETVAL = self->filter ? self->filter : NEWSV (0, 0);
OUTPUT:
RETVAL
void encode (CBOR *self, SV *scalar)
PPCODE:
PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN;
XPUSHs (scalar);
void decode (CBOR *self, SV *cborstr)
PPCODE:
PUTBACK; cborstr = decode_cbor (cborstr, self, 0); SPAGAIN;
XPUSHs (cborstr);
void decode_prefix (CBOR *self, SV *cborstr)
PPCODE:
{
SV *sv;
char *offset;
PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
EXTEND (SP, 2);
PUSHs (sv);
PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr))));
}
void incr_parse (CBOR *self, SV *cborstr)
ALIAS:
incr_parse_multiple = 1
PPCODE:
{
if (SvUTF8 (cborstr))
sv_utf8_downgrade (cborstr, 0);
if (!self->incr_count)
{
self->incr_count = newAV ();
self->incr_pos = 0;
self->incr_need = 1;
av_push (self->incr_count, newSViv (1));
}
do
{
if (!incr_parse (self, cborstr))
{
if (self->incr_need > self->max_size && self->max_size)
croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
(unsigned long)self->incr_need, (unsigned long)self->max_size);
break;
}
SV *sv;
char *offset;
PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
XPUSHs (sv);
sv_chop (cborstr, offset);
av_clear (self->incr_count);
av_push (self->incr_count, newSViv (1));
self->incr_pos = 0;
self->incr_need = self->incr_pos + 1;
}
while (ix);
}
void incr_reset (CBOR *self)
CODE:
{
SvREFCNT_dec (self->incr_count);
self->incr_count = 0;
}
void DESTROY (CBOR *self)
PPCODE:
cbor_free (self);
PROTOTYPES: ENABLE
void encode_cbor (SV *scalar)
ALIAS:
encode_cbor = 0
encode_cbor_sharing = F_ALLOW_SHARING
PPCODE:
{
CBOR cbor;
cbor_init (&cbor);
cbor.flags |= ix;
PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN;
XPUSHs (scalar);
}
void decode_cbor (SV *cborstr)
PPCODE:
{
CBOR cbor;
cbor_init (&cbor);
PUTBACK; cborstr = decode_cbor (cborstr, &cbor, 0); SPAGAIN;
XPUSHs (cborstr);
}
#ifdef __AFL_COMPILER
void
afl_init ()
CODE:
__AFL_INIT ();
int
afl_loop (unsigned int count = 10000)
CODE:
RETVAL = __AFL_LOOP (count);
OUTPUT:
RETVAL
#endif
CBOR-XS-1.87/XS.pm 0000644 0000000 0000000 00000152112 14476675427 012144 0 ustar root root =head1 NAME
CBOR::XS - Concise Binary Object Representation (CBOR, RFC7049)
=encoding utf-8
=head1 SYNOPSIS
use CBOR::XS;
$binary_cbor_data = encode_cbor $perl_value;
$perl_value = decode_cbor $binary_cbor_data;
# OO-interface
$coder = CBOR::XS->new;
$binary_cbor_data = $coder->encode ($perl_value);
$perl_value = $coder->decode ($binary_cbor_data);
# prefix decoding
my $many_cbor_strings = ...;
while (length $many_cbor_strings) {
my ($data, $length) = $cbor->decode_prefix ($many_cbor_strings);
# data was decoded
substr $many_cbor_strings, 0, $length, ""; # remove decoded cbor string
}
=head1 DESCRIPTION
This module converts Perl data structures to the Concise Binary Object
Representation (CBOR) and vice versa. CBOR is a fast binary serialisation
format that aims to use an (almost) superset of the JSON data model, i.e.
when you can represent something useful in JSON, you should be able to
represent it in CBOR.
In short, CBOR is a faster and quite compact binary alternative to JSON,
with the added ability of supporting serialisation of Perl objects. (JSON
often compresses better than CBOR though, so if you plan to compress the
data later and speed is less important you might want to compare both
formats first).
The primary goal of this module is to be I and the secondary goal
is to be I. To reach the latter goal it was written in C.
To give you a general idea about speed, with texts in the megabyte range,
C usually encodes roughly twice as fast as L or
L and decodes about 15%-30% faster than those. The shorter the
data, the worse L performs in comparison.
Regarding compactness, C-encoded data structures are usually
about 20% smaller than the same data encoded as (compact) JSON or
L.
In addition to the core CBOR data format, this module implements a
number of extensions, to support cyclic and shared data structures
(see C and C), string deduplication (see
C) and scalar references (always enabled).
See MAPPING, below, on how CBOR::XS maps perl values to CBOR values and
vice versa.
=cut
package CBOR::XS;
use common::sense;
our $VERSION = 1.87;
our @ISA = qw(Exporter);
our @EXPORT = qw(encode_cbor decode_cbor);
use Exporter;
use XSLoader;
use Types::Serialiser;
our $MAGIC = "\xd9\xd9\xf7";
=head1 FUNCTIONAL INTERFACE
The following convenience methods are provided by this module. They are
exported by default:
=over 4
=item $cbor_data = encode_cbor $perl_scalar
Converts the given Perl data structure to CBOR representation. Croaks on
error.
=item $perl_scalar = decode_cbor $cbor_data
The opposite of C: expects a valid CBOR string to parse,
returning the resulting perl scalar. Croaks on error.
=back
=head1 OBJECT-ORIENTED INTERFACE
The object oriented interface lets you configure your own encoding or
decoding style, within the limits of supported formats.
=over 4
=item $cbor = new CBOR::XS
Creates a new CBOR::XS object that can be used to de/encode CBOR
strings. All boolean flags described below are by default I.
The mutators for flags all return the CBOR object again and thus calls can
be chained:
my $cbor = CBOR::XS->new->encode ({a => [1,2]});
=item $cbor = new_safe CBOR::XS
Create a new, safe/secure CBOR::XS object. This is similar to C,
but configures the coder object to be safe to use with untrusted
data. Currently, this is equivalent to:
my $cbor = CBOR::XS
->new
->validate_utf8
->forbid_objects
->filter (\&CBOR::XS::safe_filter)
->max_size (1e8);
But is more future proof (it is better to crash because of a change than
to be exploited in other ways).
=cut
sub new_safe {
CBOR::XS
->new
->validate_utf8
->forbid_objects
->filter (\&CBOR::XS::safe_filter)
->max_size (1e8)
}
=item $cbor = $cbor->max_depth ([$maximum_nesting_depth])
=item $max_depth = $cbor->get_max_depth
Sets the maximum nesting level (default C<512>) accepted while encoding
or decoding. If a higher nesting level is detected in CBOR data or a Perl
data structure, then the encoder and decoder will stop and croak at that
point.
Nesting level is defined by number of hash- or arrayrefs that the encoder
needs to traverse to reach a given point or the number of C<{> or C<[>
characters without their matching closing parenthesis crossed to reach a
given character in a string.
Setting the maximum depth to one disallows any nesting, so that ensures
that the object is only a single hash/object or array.
If no argument is given, the highest possible setting will be used, which
is rarely useful.
Note that nesting is implemented by recursion in C. The default value has
been chosen to be as large as typical operating systems allow without
crashing.
See L, below, for more info on why this is useful.
=item $cbor = $cbor->max_size ([$maximum_string_size])
=item $max_size = $cbor->get_max_size
Set the maximum length a CBOR string may have (in bytes) where decoding
is being attempted. The default is C<0>, meaning no limit. When C
is called on a string that is longer then this many bytes, it will not
attempt to decode the string but throw an exception. This setting has no
effect on C (yet).
If no argument is given, the limit check will be deactivated (same as when
C<0> is specified).
See L, below, for more info on why this is useful.
=item $cbor = $cbor->allow_unknown ([$enable])
=item $enabled = $cbor->get_allow_unknown
If C<$enable> is true (or missing), then C will I throw an
exception when it encounters values it cannot represent in CBOR (for
example, filehandles) but instead will encode a CBOR C value.
If C<$enable> is false (the default), then C will throw an
exception when it encounters anything it cannot encode as CBOR.
This option does not affect C in any way, and it is recommended to
leave it off unless you know your communications partner.
=item $cbor = $cbor->allow_sharing ([$enable])
=item $enabled = $cbor->get_allow_sharing
If C<$enable> is true (or missing), then C will not double-encode
values that have been referenced before (e.g. when the same object, such
as an array, is referenced multiple times), but instead will emit a
reference to the earlier value.
This means that such values will only be encoded once, and will not result
in a deep cloning of the value on decode, in decoders supporting the value
sharing extension. This also makes it possible to encode cyclic data
structures (which need C to be enabled to be decoded by this
module).
It is recommended to leave it off unless you know your
communication partner supports the value sharing extensions to CBOR
(L), as without decoder support, the
resulting data structure might be unusable.
Detecting shared values incurs a runtime overhead when values are encoded
that have a reference counter larger than one, and might unnecessarily
increase the encoded size, as potentially shared values are encoded as
shareable whether or not they are actually shared.
At the moment, only targets of references can be shared (e.g. scalars,
arrays or hashes pointed to by a reference). Weirder constructs, such as
an array with multiple "copies" of the I string, which are hard but
not impossible to create in Perl, are not supported (this is the same as
with L).
If C<$enable> is false (the default), then C will encode shared
data structures repeatedly, unsharing them in the process. Cyclic data
structures cannot be encoded in this mode.
This option does not affect C in any way - shared values and
references will always be decoded properly if present.
=item $cbor = $cbor->allow_cycles ([$enable])
=item $enabled = $cbor->get_allow_cycles
If C<$enable> is true (or missing), then C will happily decode
self-referential (cyclic) data structures. By default these will not be
decoded, as they need manual cleanup to avoid memory leaks, so code that
isn't prepared for this will not leak memory.
If C<$enable> is false (the default), then C will throw an error
when it encounters a self-referential/cyclic data structure.
This option does not affect C in any way - shared values and
references will always be encoded properly if present.
=item $cbor = $cbor->allow_weak_cycles ([$enable])
=item $enabled = $cbor->get_allow_weak_cycles
This works like C in that it allows the resulting data
structures to contain cycles, but unlike C, those cyclic
rreferences will be weak. That means that code that recurrsively walks
the data structure must be prepared with cycles, but at least not special
precautions must be implemented to free these data structures.
Only those references leading to actual cycles will be weakened - other
references, e.g. when the same hash or arrray is referenced multiple times
in an arrray, will be normal references.
This option does not affect C in any way - shared values and
references will always be encoded properly if present.
=item $cbor = $cbor->forbid_objects ([$enable])
=item $enabled = $cbor->get_forbid_objects
Disables the use of the object serialiser protocol.
If C<$enable> is true (or missing), then C will will throw an
exception when it encounters perl objects that would be encoded using the
perl-object tag (26). When C encounters such tags, it will fall
back to the general filter/tagged logic as if this were an unknown tag (by
default resulting in a C object).
If C<$enable> is false (the default), then C will use the
L object serialisation protocol to serialise objects
into perl-object tags, and C will do the same to decode such tags.
See L, below, for more info on why forbidding this
protocol can be useful.
=item $cbor = $cbor->pack_strings ([$enable])
=item $enabled = $cbor->get_pack_strings
If C<$enable> is true (or missing), then C will try not to encode
the same string twice, but will instead encode a reference to the string
instead. Depending on your data format, this can save a lot of space, but
also results in a very large runtime overhead (expect encoding times to be
2-4 times as high as without).
It is recommended to leave it off unless you know your
communications partner supports the stringref extension to CBOR
(L), as without decoder support, the
resulting data structure might not be usable.
If C<$enable> is false (the default), then C will encode strings
the standard CBOR way.
This option does not affect C in any way - string references will
always be decoded properly if present.
=item $cbor = $cbor->text_keys ([$enable])
=item $enabled = $cbor->get_text_keys
If C<$enabled> is true (or missing), then C will encode all
perl hash keys as CBOR text strings/UTF-8 string, upgrading them as needed.
If C<$enable> is false (the default), then C will encode hash keys
normally - upgraded perl strings (strings internally encoded as UTF-8) as
CBOR text strings, and downgraded perl strings as CBOR byte strings.
This option does not affect C in any way.
This option is useful for interoperability with CBOR decoders that don't
treat byte strings as a form of text. It is especially useful as Perl
gives very little control over hash keys.
Enabling this option can be slow, as all downgraded hash keys that are
encoded need to be scanned and converted to UTF-8.
=item $cbor = $cbor->text_strings ([$enable])
=item $enabled = $cbor->get_text_strings
This option works similar to C, above, but works on all strings
(including hash keys), so C has no further effect after
enabling C.
If C<$enabled> is true (or missing), then C will encode all perl
strings as CBOR text strings/UTF-8 strings, upgrading them as needed.
If C<$enable> is false (the default), then C will encode strings
normally (but see C) - upgraded perl strings (strings
internally encoded as UTF-8) as CBOR text strings, and downgraded perl
strings as CBOR byte strings.
This option does not affect C in any way.
This option has similar advantages and disadvantages as C. In
addition, this option effectively removes the ability to automatically
encode byte strings, which might break some C and C
methods that rely on this.
A workaround is to use explicit type casts, which are unaffected by this option.
=item $cbor = $cbor->validate_utf8 ([$enable])
=item $enabled = $cbor->get_validate_utf8
If C<$enable> is true (or missing), then C will validate that
elements (text strings) containing UTF-8 data in fact contain valid UTF-8
data (instead of blindly accepting it). This validation obviously takes
extra time during decoding.
The concept of "valid UTF-8" used is perl's concept, which is a superset
of the official UTF-8.
If C<$enable> is false (the default), then C will blindly accept
UTF-8 data, marking them as valid UTF-8 in the resulting data structure
regardless of whether that's true or not.
Perl isn't too happy about corrupted UTF-8 in strings, but should
generally not crash or do similarly evil things. Extensions might be not
so forgiving, so it's recommended to turn on this setting if you receive
untrusted CBOR.
This option does not affect C in any way - strings that are
supposedly valid UTF-8 will simply be dumped into the resulting CBOR
string without checking whether that is, in fact, true or not.
=item $cbor = $cbor->filter ([$cb->($tag, $value)])
=item $cb_or_undef = $cbor->get_filter
Sets or replaces the tagged value decoding filter (when C<$cb> is
specified) or clears the filter (if no argument or C is provided).
The filter callback is called only during decoding, when a non-enforced
tagged value has been decoded (see L for a
list of enforced tags). For specific tags, it's often better to provide a
default converter using the C<%CBOR::XS::FILTER> hash (see below).
The first argument is the numerical tag, the second is the (decoded) value
that has been tagged.
The filter function should return either exactly one value, which will
replace the tagged value in the decoded data structure, or no values,
which will result in default handling, which currently means the decoder
creates a C object to hold the tag and the value.
When the filter is cleared (the default state), the default filter
function, C, is used. This function simply
looks up the tag in the C<%CBOR::XS::FILTER> hash. If an entry exists
it must be a code reference that is called with tag and value, and is
responsible for decoding the value. If no entry exists, it returns no
values. C provides a number of default filter functions already,
the the C<%CBOR::XS::FILTER> hash can be freely extended with more.
C additionally provides an alternative filter function that is
supposed to be safe to use with untrusted data (which the default filter
might not), called C, which works the same as
the C but uses the C<%CBOR::XS::SAFE_FILTER> variable
instead. It is prepopulated with the tag decoding functions that are
deemed safe (basically the same as C<%CBOR::XS::FILTER> without all
the bignum tags), and can be extended by user code as wlel, although,
obviously, one should be very careful about adding decoding functions
here, since the expectation is that they are safe to use on untrusted
data, after all.
Example: decode all tags not handled internally into C
objects, with no other special handling (useful when working with
potentially "unsafe" CBOR data).
CBOR::XS->new->filter (sub { })->decode ($cbor_data);
Example: provide a global filter for tag 1347375694, converting the value
into some string form.
$CBOR::XS::FILTER{1347375694} = sub {
my ($tag, $value);
"tag 1347375694 value $value"
};
Example: provide your own filter function that looks up tags in your own
hash:
my %my_filter = (
998347484 => sub {
my ($tag, $value);
"tag 998347484 value $value"
};
);
my $coder = CBOR::XS->new->filter (sub {
&{ $my_filter{$_[0]} or return }
});
Example: use the safe filter function (see L for
more considerations on security).
CBOR::XS->new->filter (\&CBOR::XS::safe_filter)->decode ($cbor_data);
=item $cbor_data = $cbor->encode ($perl_scalar)
Converts the given Perl data structure (a scalar value) to its CBOR
representation.
=item $perl_scalar = $cbor->decode ($cbor_data)
The opposite of C: expects CBOR data and tries to parse it,
returning the resulting simple scalar or reference. Croaks on error.
=item ($perl_scalar, $octets) = $cbor->decode_prefix ($cbor_data)
This works like the C method, but instead of raising an exception
when there is trailing garbage after the CBOR string, it will silently
stop parsing there and return the number of characters consumed so far.
This is useful if your CBOR texts are not delimited by an outer protocol
and you need to know where the first CBOR string ends amd the next one
starts - CBOR strings are self-delimited, so it is possible to concatenate
CBOR strings without any delimiters or size fields and recover their data.
CBOR::XS->new->decode_prefix ("......")
=> ("...", 3)
=back
=head2 INCREMENTAL PARSING
In some cases, there is the need for incremental parsing of JSON
texts. While this module always has to keep both CBOR text and resulting
Perl data structure in memory at one time, it does allow you to parse a
CBOR stream incrementally, using a similar to using "decode_prefix" to see
if a full CBOR object is available, but is much more efficient.
It basically works by parsing as much of a CBOR string as possible - if
the CBOR data is not complete yet, the parser will remember where it was,
to be able to restart when more data has been accumulated. Once enough
data is available to either decode a complete CBOR value or raise an
error, a real decode will be attempted.
A typical use case would be a network protocol that consists of sending
and receiving CBOR-encoded messages. The solution that works with CBOR and
about anything else is by prepending a length to every CBOR value, so the
receiver knows how many octets to read. More compact (and slightly slower)
would be to just send CBOR values back-to-back, as C knows where
a CBOR value ends, and doesn't need an explicit length.
The following methods help with this:
=over 4
=item @decoded = $cbor->incr_parse ($buffer)
This method attempts to decode exactly one CBOR value from the beginning
of the given C<$buffer>. The value is removed from the C<$buffer> on
success. When C<$buffer> doesn't contain a complete value yet, it returns
nothing. Finally, when the C<$buffer> doesn't start with something
that could ever be a valid CBOR value, it raises an exception, just as
C would. In the latter case the decoder state is undefined and
must be reset before being able to parse further.
This method modifies the C<$buffer> in place. When no CBOR value can be
decoded, the decoder stores the current string offset. On the next call,
continues decoding at the place where it stopped before. For this to make
sense, the C<$buffer> must begin with the same octets as on previous
unsuccessful calls.
You can call this method in scalar context, in which case it either
returns a decoded value or C. This makes it impossible to
distinguish between CBOR null values (which decode to C) and an
unsuccessful decode, which is often acceptable.
=item @decoded = $cbor->incr_parse_multiple ($buffer)
Same as C, but attempts to decode as many CBOR values as
possible in one go, instead of at most one. Calls to C and
C can be interleaved.
=item $cbor->incr_reset
Resets the incremental decoder. This throws away any saved state, so that
subsequent calls to C or C start to parse
a new CBOR value from the beginning of the C<$buffer> again.
This method can be called at any time, but it I be called if you want
to change your C<$buffer> or there was a decoding error and you want to
reuse the C<$cbor> object for future incremental parsings.
=back
=head1 MAPPING
This section describes how CBOR::XS maps Perl values to CBOR values and
vice versa. These mappings are designed to "do the right thing" in most
circumstances automatically, preserving round-tripping characteristics
(what you put in comes out as something equivalent).
For the more enlightened: note that in the following descriptions,
lowercase I refers to the Perl interpreter, while uppercase I
refers to the abstract Perl language itself.
=head2 CBOR -> PERL
=over 4
=item integers
CBOR integers become (numeric) perl scalars. On perls without 64 bit
support, 64 bit integers will be truncated or otherwise corrupted.
=item byte strings
Byte strings will become octet strings in Perl (the Byte values 0..255
will simply become characters of the same value in Perl).
=item UTF-8 strings
UTF-8 strings in CBOR will be decoded, i.e. the UTF-8 octets will be
decoded into proper Unicode code points. At the moment, the validity of
the UTF-8 octets will not be validated - corrupt input will result in
corrupted Perl strings.
=item arrays, maps
CBOR arrays and CBOR maps will be converted into references to a Perl
array or hash, respectively. The keys of the map will be stringified
during this process.
=item null
CBOR null becomes C in Perl.
=item true, false, undefined
These CBOR values become C,
C and C,
respectively. They are overloaded to act almost exactly like the numbers
C<1> and C<0> (for true and false) or to throw an exception on access (for
error). See the L manpage for details.
=item tagged values
Tagged items consists of a numeric tag and another CBOR value.
See L and the description of C<< ->filter >>
for details on which tags are handled how.
=item anything else
Anything else (e.g. unsupported simple values) will raise a decoding
error.
=back
=head2 PERL -> CBOR
The mapping from Perl to CBOR is slightly more difficult, as Perl is a
typeless language. That means this module can only guess which CBOR type
is meant by a perl value.
=over 4
=item hash references
Perl hash references become CBOR maps. As there is no inherent ordering in
hash keys (or CBOR maps), they will usually be encoded in a pseudo-random
order. This order can be different each time a hash is encoded.
Currently, tied hashes will use the indefinite-length format, while normal
hashes will use the fixed-length format.
=item array references
Perl array references become fixed-length CBOR arrays.
=item other references
Other unblessed references will be represented using
the indirection tag extension (tag value C<22098>,
L). CBOR decoders are guaranteed
to be able to decode these values somehow, by either "doing the right
thing", decoding into a generic tagged object, simply ignoring the tag, or
something else.
=item CBOR::XS::Tagged objects
Objects of this type must be arrays consisting of a single C<[tag, value]>
pair. The (numerical) tag will be encoded as a CBOR tag, the value will
be encoded as appropriate for the value. You must use C to
create such objects.
=item Types::Serialiser::true, Types::Serialiser::false, Types::Serialiser::error
These special values become CBOR true, CBOR false and CBOR undefined
values, respectively.
=item other blessed objects
Other blessed objects are serialised via C or C. See
L for specific classes handled by this
module, and L