pax_global_header00006660000000000000000000000064143111232740014510gustar00rootroot0000000000000052 comment=f786d6e7af279a5380cd7518a3bbf3b629e7381b bitstring-4.1.1/000077500000000000000000000000001431112327400135205ustar00rootroot00000000000000bitstring-4.1.1/.gitignore000066400000000000000000000005041431112327400155070ustar00rootroot00000000000000*~ *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so *.sw? *.opt *.actual *.merlin /_build /_opam /autom4te.cache /bitstring-objinfo /bitstring_config.ml /cil-tools/Makefile /config.h /config.log /config.status /create_test_pattern /META /Makefile /site /tests/80_testdata/*.actual /tests/test.bmpp /bitstring.install byteswap.h bitstring-4.1.1/.travis.yml000066400000000000000000000012031431112327400156250ustar00rootroot00000000000000language: c dist: xenial install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh script: bash -ex .travis-opam.sh env: global: - PINS="bitstring:. ppx_bitstring:." - PACKAGE=ppx_bitstring jobs: - OCAML_VERSION=4.04 TESTS=false - OCAML_VERSION=4.05 TESTS=false - OCAML_VERSION=4.06 TESTS=false - OCAML_VERSION=4.07 TESTS=false - OCAML_VERSION=4.08 - OCAML_VERSION=4.09 - OCAML_VERSION=4.10 - OCAML_VERSION=4.11 os: - linux jobs: include: - env: OCAML_VERSION=4.11 os: osx - env: OCAML_VERSION=4.11 os: freebsd - env: OCAML_VERSION=4.11 arch: arm64 bitstring-4.1.1/COPYING000066400000000000000000000430701431112327400145570ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) 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 this service 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 make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. 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. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), 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 distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the 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 a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE 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. 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 convey 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) 19yy 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 2 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, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision 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, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This 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 Library General Public License instead of this License. bitstring-4.1.1/COPYING.LIB000066400000000000000000000655361431112327400151770ustar00rootroot00000000000000The Library is distributed under the terms of the GNU Library General Public License version 2 (included below). As a special exception to the GNU Library General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by Red Hat, or a modified version of the Library that is distributed under the conditions defined in clause 2 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, 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 this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. ^L Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. ^L GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. ^L Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. ^L 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. ^L 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. ^L 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), 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 distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser 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 Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. ^L 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "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 LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY 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 LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ^L How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey 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 library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! bitstring-4.1.1/README.md000066400000000000000000000022611431112327400150000ustar00rootroot00000000000000# OCaml Bitstring Library [![Build Status](https://travis-ci.org/xguerin/bitstring.svg?branch=master)](https://travis-ci.org/xguerin/bitstring) ``` Copyright (C) 2008-2016 Red Hat Inc, Richard W.M. Jones. Copyright (C) 2016-2018 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. ``` The original `README` content can be found in the `README.orig` file. ## Documentation The documentation is located [here](https://bitstring.software). ## How to install ``` opam install bitstring opam install ppx_bitstring ``` ## How to use ### Ocamlfind ``` ocamlfind c -package bitstring -package ppx_bitstring -linkpkg ... ``` ### Dune ```lisp (executable ((name foo) (libraries (bitstring)) (preprocess (pps (ppx_bitstring))) )) ``` ## How to build ### Dependencies Required packages are detailed in the `dune-project` file. ### Building the project ``` $ dune build ``` ### Running the tests ``` $ dune runtest ``` ## License The library is licensed under the LGPL v2 or later, with the OCaml linking exception. See the file `COPYING.LIB` for full terms. Programs are licensed under the GPL v2 or later. See the file `COPYING` for full terms. All examples and tests are public domain. bitstring-4.1.1/README.orig000066400000000000000000000020211431112327400153320ustar00rootroot00000000000000ocaml-bitstring Copyright (C) 2008-2012 Red Hat Inc, Richard W.M. Jones. This library was formerly known as 'bitmatch'. Please see the html subdirectory for developer documentation. The only requirements are OCaml >= 4.02.0, camlp4, ocamldoc, and findlib. If you optionally have CIL (http://cil.sourceforge.net/) installed then there are some nice extra tools for converting C header files into matchable OCaml structures. To build: ./configure make Other make targets: make check # build and run the test suite make examples # build the examples make print-tests # print expanded test macros make print-examples # print expanded example macros To install (as root): make install LICENSE ---------------------------------------------------------------------- The library is licensed under the LGPL v2 or later, with the OCaml linking exception. See the file COPYING.LIB for full terms. Programs are licensed under the GPL v2 or later. See the file COPYING for full terms. All examples and tests are public domain. bitstring-4.1.1/bitstring.opam000066400000000000000000000020571431112327400164070ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "4.1.0" synopsis: "Bitstrings and bitstring matching for OCaml" description: """ The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. You can use this module to both parse and generate binary formats, files and protocols. Bitstring handling is added as primitives to the language, making it exceptionally simple to use and very powerful. """ maintainer: ["Xavier R. Guérin "] authors: ["Richard W.M. Jones" "Xavier R. Guérin"] license: "LGPL-2.0-or-later" homepage: "https://github.com/xguerin/bitstring" bug-reports: "https://github.com/xguerin/bitstring/issues" depends: [ "dune" {>= "2.5"} "ocaml" {>= "4.04.1"} "stdlib-shims" {>= "0.1.0"} ] build: [ ["dune" "subst"] {pinned} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/xguerin/bitstring.git" bitstring-4.1.1/docs/000077500000000000000000000000001431112327400144505ustar00rootroot00000000000000bitstring-4.1.1/docs/CNAME000066400000000000000000000000231431112327400152110ustar00rootroot00000000000000bitstring.software bitstring-4.1.1/docs/documentation.md000066400000000000000000000375171431112327400176600ustar00rootroot00000000000000# Guide ## Loading, creating bitstrings The basic data type is the `Bitstring.bitstring`, a string of bits of arbitrary length. Bitstrings can be any length in bits and operations do not need to be byte-aligned (although they will generally be more efficient if they are byte-aligned). Internally a bitstring is stored as a normal OCaml `string` together with an offset and length, where the offset and length are measured in bits. Thus one can efficiently form substrings of bitstrings, overlay a bitstring on existing data, and load and save bitstrings from files or other external sources. To load a bitstring from a file use `Bitstring.bitstring_of_file` or `Bitstring.bitstring_of_chan`. There are also functions to create bitstrings from arbitrary data. See the [reference](/reference) section. ## Matching bitstrings with patterns Use the `bitstring` extension of the `match` operator (part of the syntax extension) to break apart a bitstring into its fields. `match%bitstring` works a lot like the OCaml `match` operator. Please note the use of the `{| ... |}` verbatim notation for the matching patterns. The general form of `match%bitstring` is: ```ocaml match%bitstring EXPRESSION with | {| PATTERN |} -> CODE | {| PATTERN |} -> CODE | ... ``` As with normal match, the statement attempts to match the bitstring against each pattern in turn. If none of the patterns match then the standard library `Match_failure` exception is thrown. Patterns look a bit different from normal match patterns. They consist of a list of bitfields separated by `;` where each bitfield contains a bind variable, the width (in bits) of the field, and other information. Some example patterns: ```ocaml match%bitstring bits with | {| version : 8; name : 8; param : 8 |} -> ... (* Bitstring of at least 3 bytes. First byte is the version number, second byte is a field called name, third byte is a field called parameter. *) | {| flag : 1 |} -> printf "flag is %b\n" flag (* A single flag bit (mapped into an OCaml boolean). *) | {| len : 4; data : 1 + len |} -> printf "len = %d, data = 0x%Lx\n" len data (* A 4-bit length, followed by 1-16 bits of data, where the length of the data is computed from len. *) | {| ipv6_source : 128 : bitstring; ipv6_dest : 128 : bitstring |} -> ... (* IPv6 source and destination addresses. Each is 128 bits and is mapped into a bitstring type which will be a substring of the main bitstring expression. *) ``` You can also add conditional when-clauses: ```ocaml | {| version : 4 |} when version = 4 || version = 6 -> ... (* Only match and run the code when version is 4 or 6. If it isn't we will drop through to the next case. *) ``` Note that the pattern is only compared against the first part of the bitstring (there may be more data in the bitstring following the pattern, which is not matched). In terms of regular expressions you might say that the pattern matches `^pattern`, not `^pattern$`. To ensure that the bitstring contains only the pattern, add a length -1 bitstring to the end and test that its length is zero in the when-clause: ```ocaml | {| n : 4; rest : -1 : bitstring |} when Bitstring.bitstring_length rest = 0 -> ... (* Only matches exactly 4 bits. *) ``` Normally the first part of each field is a binding variable, but you can also match a constant, as in: ```ocaml | {| (4|6) : 4 |} -> ... (* Only matches if the first 4 bits contain either the integer 4 or the integer 6. *) ``` One may also match on strings: ```ocaml | {| "MAGIC" : 5*8 : string |} -> ... (* Only matches if the string "MAGIC" appears at the start of the input. *) ``` ### Pattern field reference The exact format of each pattern field is: `pattern : length [: qualifier [,qualifier ...]]` `pattern` is the pattern, binding variable name, or constant to match. `length` is the length in bits which may be either a constant or an expression. The length expression is just an OCaml expression and can use any values defined in the program, and refer back to earlier fields (but not to later fields). Integers can only have lengths in the range `[1..64]` bits. See the [integer types](#integer-types) section below for how these are mapped to the OCaml `int`/`int32`/`int64` types. This is checked at compile time if the length expression is constant, otherwise it is checked at runtime and you will get a runtime exception eg. in the case of a computed length expression. A bitstring field of length `-1` matches all the rest of the bitstring (thus this is only useful as the last field in a pattern). A bitstring field of length `0` matches an empty bitstring (occasionally useful when matching optional subfields). Qualifiers are a list of identifiers/expressions which control the type, signedness and endianness of the field. Permissible qualifiers are: | Qualifier | Description | |:---------------|:------------| | `int` | field has an integer type | | `string` | field is a string type | | `bitstring` | field is a bitstring type | | `signed` | field is signed | | `unsigned` | field is unsigned | | `bigendian` | field is big endian - a.k.a network byte order | | `littleendian` | field is little endian - a.k.a Intel byte order | | `nativeendian` | field is same endianness as the machine | | `endian(expr)` | `expr` should be an expression which evaluates to a `Bitstring.endian` type | | `offset(expr)` | see [computed offsets](#computed-offsets) below | | `check(expr)` | apply some constraint to the field | | `bind(expr)` | bind the field to `expr` | | `map(lambda)` | apply `lambda` to the field | `Bitstring.endian` is either `LittleEndian`, `BigEndian` or `NativeEndian`. The expression in `endian(expr)` is an arbitrary OCaml expression and can use the value of earlier fields in the bitmatch. The default settings are `int`, `unsigned`, `bigendian`, no offset. Note that many of these qualifiers cannot be used together, eg. bitstrings do not have endianness. The syntax extension should give you a compile-time error if you use incompatible qualifiers. ### Default match cases As well as a list of fields, it is possible to name the bitstring and/or have a default match case: ```ocaml | {| _ |} -> ... (* Default match case. *) | {| _ |} as pkt -> ... (* Default match case, with 'pkt' bound to the whole bitstring. *) ``` ### Function definition The `function` keyword can also be used for pattern matching: ```ocaml let pattern_matcher = function%bitstring | {| false : 1 ; a : 2 ; b : 16 : bigendian ; ... |} -> (* Do something *) | {| _ |} -> (* Do something else *) ``` ## Constructing bitstrings Bitstrings may be constructed using the `bitstring` extension of the `let` keyword. The `let%bitstring` expression takes a list of fields, similar to the list of fields for matching: ```ocaml let version = 1 ;; let data = 10 ;; let%bitstring bits = {| version : 4; data : 12 |} ;; (* Constructs a 16-bit bitstring with the first four bits containing the integer 1, and the following 12 bits containing the integer 10, arranged in network byte order. *) Bitstring.hexdump_bitstring stdout bits ;; (* Prints: 00000000 10 0a |.. | *) ``` The format of each field is the same as for pattern fields (see [Pattern field reference section](#pattern-field-reference)), and things like computed length fields, fixed value fields, insertion of bitstrings within bitstrings, etc. are all supported. ### Construction exception The `let%bitstring` expression may throw a [Bitstring.Construct_failure](/reference/#exceptions) exception at runtime. Runtime errors include: * `int` field length not in the range [1..64] * a bitstring with a length declared which doesn't have the same length at runtime * trying to insert an out-of-range value into an `int` field ## Integer types Integer types are mapped to OCaml types `bool`, `int`, `int32` or `int64` using a system which tries to ensure that (a) the types are reasonably predictable and (b) the most efficient type is preferred. The rules are slightly different depending on whether the bit length expression in the field is a compile-time constant or a computed expression. Detection of compile-time constants is quite simplistic so only simple integer literals and simple expressions (eg. `5 * 8`) are recognized as constants. In any case the bit size of an integer is limited to the range `[1..64]`. This is detected as a compile-time error if that is possible, otherwise a runtime check is added which can throw an `Invalid_argument` exception. The mapping is thus: | Bit size | Constant | Computed expression | |:---------|:---------|:--------------------| | 1 | `bool` | `int64` | | 2..31 | `int` | `int64` | | 32 | `int32` | `int64` | | 33..64 | `int64` | `int64` | A possible future extension may allow people with 64 bit computers to specify a more optimal `int` type for bit sizes in the range `32..63`. If this was implemented then such code _could not even be compiled_ on 32 bit platforms, so it would limit portability. Another future extension may be to allow computed expressions to assert min/max range for the bit size, allowing a more efficient data type than `int64` to be used. (Of course under such circumstances there would still need to be a runtime check to enforce the size). ## Advanced pattern-matching ### Computed offsets You can add an `offset(..)` qualifier to bitmatch patterns in order to move the current offset within the bitstring forwards. For example: ```ocaml match%bitstring bits with | {| field1 : 8; field2 : 8 : offset(160) |} -> ... ``` matches `field1` at the start of the bitstring and `field2` at 160 bits into the bitstring. The middle 152 bits go unmatched (ie. can be anything). The generated code is efficient. If field lengths and offsets are known to be constant at compile time, then almost all runtime checks are avoided. Non-constant field lengths and/or non-constant offsets can result in more runtime checks being added. Note that moving the offset backwards, and moving the offset in `let%bitstring` expressions, are both not supported at present. ### Check expressions You can add a `check(expr)` qualifier to bitmatch patterns. If the expression evaluates to false then the current match case fails to match (in other words, we fall through to the next match case - there is no error). For example: ```ocaml match%bitstring bits with | { field : 16 : check (field > 100) } -> ... ``` Note the difference between a check expression and a when-clause is that the when-clause is evaluated after all the fields have been matched. On the other hand a check expression is evaluated after the individual field has been matched, which means it is potentially more efficient (if the check expression fails then we don't waste any time matching later fields). We wanted to use the notation `when(expr)` here, but because `when` is a reserved word we could not do this. ### Bind expressions A bind expression is used to change the value of a matched field. For example: ```ocaml match%bitstring bits with | { len : 16 : bind (len * 8); field : len : bitstring } -> ... ``` In the example, after 'len' has been matched, its value would be multiplied by 8, so the width of 'field' is the matched value multiplied by 8. In the general case: ```ocaml | { field : ... : bind (expr) } -> ... ``` evaluates the following after the field has been matched: ```ocaml let field = expr in (* remaining fields *) ``` ### Map expressions A map expression is used to apply a `lambda` expression to a matched field. The matched field would then contain the result of the application: ```ocaml {| field : size : map (fun v -> do_something_with v) }| ``` evaluates the following after the field has been matched: ```ocaml let field = (fun v -> do_something_with v) temporary_parsed_field in (* remaining fields *) ``` ### Order of evaluation The choice is arbitrary, but we have chosen that check expressions are evaluated first, and bind/map expressions are evaluated after. This means that the result of `bind()` or `map()` is _not_ available in the check expression. Note that this rule applies regardless of the order of `check()`, `bind()`, or `map()` in the source code. ### Saving bit offsets Use `save_offset_to(variable)` to save the current bit offset within the match to a variable (strictly speaking, to a pattern). This variable is then made available in any `check()` and `bind()` clauses in the current field, _and_ to any later fields, and to the code after the `->`. For example: ```ocaml match%bitstring bits with | {| len : 16; _ : len : bitstring; field : 16 : save_offset_to (field_offset) |} -> printf "field is at bit offset %d in the match\n" field_offset ``` (In that example, `field_offset` should always have the value `len+16`). ## Security and type safety ### Security on input The main concerns for input are buffer overflows and denial of service. It is believed that this library is robust against attempted buffer overflows. In addition to OCaml's normal bounds checks, we check that field lengths are >= 0, and many additional checks. Denial of service attacks are more problematic. We only work forwards through the bitstring, thus computation will eventually terminate. As for computed lengths, code such as this is thought to be secure: ```ocaml match%bitstring bits with | {| len : 64; buffer : Int64.to_int len : bitstring |} -> ... ``` The `len` field can be set arbitrarily large by an attacker, but when pattern-matching against the `buffer` field this merely causes a test such as `if len <= remaining_size` to fail. Even if the length is chosen so that `buffer` bitstring is allocated, the allocation of sub-bitstrings is efficient and doesn't involve an arbitary-sized allocation or any copying. However the above does not necessarily apply to strings used in matching, since they may cause the library to use the [Bitstring.string_of_bitstring](/reference/#converting-bitstrings) function, which allocates a string. So you should take care if you use the `string` type particularly with a computed length that is derived from external input. The main protection against attackers should be to ensure that the main program will only read input bitstrings up to a certain length, which is outside the scope of this library. ### Security on output As with the input side, computed lengths are believed to be safe. For example: ```ocaml let len = read_untrusted_source () in let buffer = allocate_bitstring () in [%bitstring {| buffer : len : bitstring |}] ``` This code merely causes a check that buffer's length is the same as `len`. However the program function `allocate_bitstring` must refuse to allocate an oversized buffer (but that is outside the scope of this library). ### Order of evaluation In `match%bitstring` statements, fields are evaluated left to right. Note that the when-clause is evaluated _last_, so if you are relying on the when-clause to filter cases then your code may do a lot of extra and unncessary pattern-matching work on fields which may never be needed just to evaluate the when-clause. Either rearrange the code to do only the first part of the match, followed by the when-clause, followed by a second inner bitmatch, or use a `check()` qualifier within fields. ### Safety The current implementation is believed to be fully type-safe, and makes compile and run-time checks where appropriate. If you find a case where a check is missing please submit a bug report or a patch. ## Limits These are thought to be the current limits: * Integers: `[1..64]` bits. * Bitstrings (32-bit): maximum length is limited by the string size, ie. 16 MBytes. * Bitstrings (64-bit): maximum length is thought to be limited by the string size, ie. effectively unlimited. Bitstrings must be loaded into memory before we can match against them. Thus available memory may be considered a limit for some applications. bitstring-4.1.1/docs/examples.md000066400000000000000000000102121431112327400166040ustar00rootroot00000000000000# Examples ## IPv4 packets ```ocaml match%bitstring pkt with (* IPv4 packet header 0 1 2 3 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | 4 | IHL |Type of Service| Total Length | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identification |Flags| Fragment Offset | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Time to Live | Protocol | Header Checksum | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Source Address | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Destination Address | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Options | Padding | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ *) | {| 4 : 4; hdrlen : 4; tos : 8; length : 16; identification : 16; flags : 3; fragoffset : 13; ttl : 8; protocol : 8; checksum : 16; source : 32; dest : 32; options : (hdrlen-5)*32 : bitstring; payload : -1 : bitstring |} -> printf "IPv4:\n"; printf " header length: %d * 32 bit words\n" hdrlen; printf " type of service: %d\n" tos; printf " packet length: %d bytes\n" length; printf " identification: %d\n" identification; printf " flags: %d\n" flags; printf " fragment offset: %d\n" fragoffset; printf " ttl: %d\n" ttl; printf " protocol: %d\n" protocol; printf " checksum: %d\n" checksum; printf " source: %lx dest: %lx\n" source dest; printf " header options + padding:\n"; Bitstring.hexdump_bitstring stdout options; printf " packet payload:\n"; Bitstring.hexdump_bitstring stdout payload | {| version : 4 |} -> eprintf "unknown IP version %d\n" version; exit 1 | {| _ |} as pkt -> eprintf "data is smaller than one nibble:\n"; Bitstring.hexdump_bitstring stderr pkt; exit 1 ``` ## EXT3 superblock parser ```ocaml let bits = Bitstring.bitstring_of_file "tests/ext3_sb" let () = match%bitstring bits with | {| s_inodes_count : 32 : littleendian; (* Inodes count *) s_blocks_count : 32 : littleendian; (* Blocks count *) s_r_blocks_count : 32 : littleendian; (* Reserved blocks count *) s_free_blocks_count : 32 : littleendian; (* Free blocks count *) s_free_inodes_count : 32 : littleendian; (* Free inodes count *) s_first_data_block : 32 : littleendian; (* First Data Block *) s_log_block_size : 32 : littleendian; (* Block size *) s_log_frag_size : 32 : littleendian; (* Fragment size *) s_blocks_per_group : 32 : littleendian; (* # Blocks per group *) s_frags_per_group : 32 : littleendian; (* # Fragments per group *) s_inodes_per_group : 32 : littleendian; (* # Inodes per group *) s_mtime : 32 : littleendian; (* Mount time *) s_wtime : 32 : littleendian; (* Write time *) s_mnt_count : 16 : littleendian; (* Mount count *) s_max_mnt_count : 16 : littleendian; (* Maximal mount count *) 0xef53 : 16 : littleendian |} -> (* Magic signature *) printf "ext3 superblock:\n"; printf " s_inodes_count = %ld\n" s_inodes_count; printf " s_blocks_count = %ld\n" s_blocks_count; printf " s_free_inodes_count = %ld\n" s_free_inodes_count; printf " s_free_blocks_count = %ld\n" s_free_blocks_count | {| _ |} -> eprintf "not an ext3 superblock!\n%!"; exit 2 ``` ## Simple binary message parser ```ocaml (* +---------------+---------------+--------------------------+ | type | subtype | parameter | +---------------+---------------+--------------------------+ <-- 16 bits --> <-- 16 bits --> <------- 32 bits --------> All fields are in network byte order. *) let%bitstring make_message typ subtype param = {| typ : 16; subtype : 16; param : 32 |};; ``` bitstring-4.1.1/docs/index.md000066400000000000000000000016701431112327400161050ustar00rootroot00000000000000# Overview [![Build Status](https://travis-ci.org/xguerin/bitstring.svg?branch=master)](https://travis-ci.org/xguerin/bitstring) ``` Copyright (C) 2008-2016 Red Hat Inc, Richard W.M. Jones. Copyright (C) 2016-2018 Red Hat Inc, Richard W.M. Jones, Xavier R. Guérin. ``` ## How to install ``` opam install bitstring opam install ppx_bitstring ``` ## How to use ### Ocamlfind ``` ocamlfind c -package bitstring -package ppx_bitstring -linkpkg ... ``` ### Dune ```lisp (executable ((name foo) (libraries (bitstring)) (preprocess (pps (ppx_bitstring))) )) ``` ## How to build ### Building the project ``` $ dune build ``` ### Running the tests ``` $ dune runtest ``` ## License The library is licensed under the LGPL v2 or later, with the OCaml linking exception. See the file `COPYING.LIB` for full terms. Programs are licensed under the GPL v2 or later. see the file copying for full terms. All examples and tests are public domain. bitstring-4.1.1/docs/reference.md000066400000000000000000000215421431112327400167340ustar00rootroot00000000000000# Reference ## Types ```ocaml type endian = | BigEndian | LittleEndian | NativeEndian ``` ```ocaml val string_of_endian : endian -> string ``` Endianness. ```ocaml type bitstring = string * int * int ``` `bitstring` is the basic type used to store bitstrings. The type contains the underlying data (a string), the current bit offset within the string and the current bit length of the string (counting from the bit offset). Note that the offset and length are in bits, not bytes. Normally you don't need to use the bitstring type directly, since there are functions and syntax extensions which hide the details. See also `Bitstring.bitstring_of_string`, `Bitstring.bitstring_of_file`, `Bitstring.hexdump_bitstring`, `Bitstring.bitstring_length`. ```ocaml type t = bitstring ``` `t` is a synonym for the `Bitstring.bitstring type`. This allows you to use this module with functors like Set and Map from the stdlib. ## Exceptions ```ocaml exception Construct_failure of string * string * int * int ``` `Construct_failure (message, file, line, char)` may be raised by the `BITSTRING` constructor. Common reasons are that values are out of range of the fields that contain them, or that computed lengths are impossible (eg. negative length bitfields). `message` is the error message. `file`, `line` and `char` point to the original source location of the `BITSTRING` constructor that failed. ## Bitstring comparison ```ocaml val compare : bitstring -> bitstring -> int ``` `compare bs1 bs2` compares two bitstrings and returns zero if they are equal, a negative number if bs1 < bs2, or a positive number if bs1 > bs2. This tests "semantic equality" which is not affected by the offset or alignment of the underlying representation (see `Bitstring.bitstring`). The ordering is total and lexicographic. ```ocaml val equals : bitstring -> bitstring -> bool ``` `equals` returns true if and only if the two bitstrings are semantically equal. It is the same as calling compare and testing if the result is 0, but usually more efficient. ## Bitstring manipulation ```ocaml val bitstring_length : bitstring -> int ``` `bitstring_length bitstring` returns the length of the bitstring in bits. Note this just returns the third field in the `Bitstring.bitstring` tuple. ```ocaml val subbitstring : bitstring -> int -> int -> bitstring ``` `subbitstring bits off len` returns a sub-bitstring of the bitstring, starting at offset off bits and with length len bits. If the original bitstring is not long enough to do this then the function raises `Invalid_argument "subbitstring"`. Note that this function just changes the offset and length fields of the `Bitstring.bitstring` tuple, so is very efficient. ```ocaml val dropbits : int -> bitstring -> bitstring ``` Drop the first n bits of the bitstring and return a new bitstring which is shorter by n bits. If the length of the original bitstring is less than n bits, this raises `Invalid_argument "dropbits"`. Note that this function just changes the offset and length fields of the `Bitstring.bitstring` tuple, so is very efficient. ```ocaml val takebits : int -> bitstring -> bitstring ``` Take the first n bits of the bitstring and return a new bitstring which is exactly n bits long. If the length of the original bitstring is less than n bits, this raises `Invalid_argument "takebits"`. Note that this function just changes the offset and length fields of the `Bitstring.bitstring` tuple, so is very efficient. ```ocaml val concat : bitstring list -> bitstring ``` Concatenate a list of bitstrings together into a single bitstring. ## Constructing bitstrings ```ocaml val empty_bitstring : bitstring ``` `empty_bitstring` is the empty, zero-length bitstring. ```ocaml val create_bitstring : int -> bitstring ``` `create_bitstring n` creates an n bit bitstring containing all zeroes. ```ocaml val make_bitstring : int -> char -> bitstring ``` make_bitstring n c creates an n bit bitstring containing the repeated 8 bit pattern in c. For example, `make_bitstring 16 '\x5a' `will create the bitstring `0x5a5a` or in binary `0101 1010 0101 1010`. Note that the length is in bits, not bytes. The length does NOT need to be a multiple of 8. ```ocaml val zeroes_bitstring : int -> bitstring ``` zeroes_bitstring creates an n bit bitstring of all 0's. Actually this is the same as `Bitstring.create_bitstring`. ```ocaml val ones_bitstring : int -> bitstring ``` `ones_bitstring` creates an n bit bitstring of all 1's. ```ocaml val bitstring_of_string : string -> bitstring ``` `bitstring_of_string str `creates a bitstring of length String.length str * 8 (bits) containing the bits in str. Note that the bitstring uses str as the underlying string (see the representation of Bitstring.bitstring) so you should not change str after calling this. ```ocaml val bitstring_of_file : string -> bitstring ``` bitstring_of_file filename loads the named file into a bitstring. ```ocaml val bitstring_of_chan : Pervasives.in_channel -> bitstring ``` `bitstring_of_chan chan `loads the contents of the input channel chan as a bitstring. The length of the final bitstring is determined by the remaining input in chan, but will always be a multiple of 8 bits. See also Bitstring.bitstring_of_chan_max. ```ocaml val bitstring_of_chan_max : Pervasives.in_channel -> int -> bitstring ``` `bitstring_of_chan_max chan max` works like `Bitstring.bitstring_of_chan` but will only read up to max bytes from the channel (or fewer if the end of input occurs before that). ```ocaml val bitstring_of_file_descr : Unix.file_descr -> bitstring ``` `bitstring_of_file_descr fd` loads the contents of the file descriptor fd as a bitstring. See also `Bitstring.bitstring_of_chan`, `Bitstring.bitstring_of_file_descr_max`. ```ocaml val bitstring_of_file_descr_max : Unix.file_descr -> int -> bitstring ``` `bitstring_of_file_descr_max fd max` works like `Bitstring.bitstring_of_file_descr` but will only read up to max bytes from the channel (or fewer if the end of input occurs before that). ## Converting bitstrings ```ocaml val string_of_bitstring : bitstring -> string ``` `string_of_bitstring bitstring` converts a bitstring to a string (eg. to allow comparison). This function is inefficient. In the best case when the bitstring is nicely byte-aligned we do a `String.sub` operation. If the bitstring isn't aligned then this involves a lot of bit twiddling and is particularly inefficient. If the bitstring is not a multiple of 8 bits wide then the final byte of the string contains the high bits set to the remaining bits and the low bits set to 0. ```ocaml val bitstring_to_file : bitstring -> string -> unit ``` `bitstring_to_file bits` filename writes the bitstring bits to the file filename. It overwrites the output file. Some restrictions apply, see `Bitstring.bitstring_to_chan`. ```ocaml val bitstring_to_chan : bitstring -> Pervasives.out_channel -> unit ``` `bitstring_to_file bits` filename writes the bitstring bits to the channel chan. Channels are made up of bytes, bitstrings can be any bit length including fractions of bytes. So this function only works if the length of the bitstring is an exact multiple of 8 bits (otherwise it raises `Invalid_argument "bitstring_to_chan"`). Furthermore the function is efficient only in the case where the bitstring is stored fully aligned, otherwise it has to do inefficient bit twiddling like `Bitstring.string_of_bitstring`. In the common case where the bitstring was generated by the `BITSTRING` operator and is an exact multiple of 8 bits wide, then this function will always work efficiently. ## Printing bitstrings ```ocaml val hexdump_bitstring : Pervasives.out_channel -> bitstring -> unit ``` `hexdump_bitstring chan` bitstring prints the bitstring to the output channel in a format similar to the Unix command `hexdump -C`. ## Bitstring buffer ```ocaml module Buffer: sig .. end ``` Buffers are mainly used by the `BITSTRING` constructor, but may also be useful for end users. ## Get/set bits These functions let you manipulate individual bits in the bitstring. However they are not particularly efficient and you should generally use the `bitmatch` and `BITSTRING` operators when building and parsing bitstrings. These functions all raise `Invalid_argument "index out of bounds"` if the index is out of range of the bitstring. ```ocaml val set : bitstring -> int -> unit ``` set bits n sets the nth bit in the bitstring to 1. ```ocaml val clear : bitstring -> int -> unit ``` clear bits n sets the nth bit in the bitstring to 0. ```ocaml val is_set : bitstring -> int -> bool ``` is_set bits n is true if the nth bit is set to 1. ```ocaml val is_clear : bitstring -> int -> bool ``` is_clear bits n is true if the nth bit is set to 0. ```ocaml val put : bitstring -> int -> int -> unit ``` put bits n v sets the nth bit in the bitstring to 1 if v is not zero, or to 0 if v is zero. ```ocaml val get : bitstring -> int -> int ``` get bits n returns the nth bit (returns non-zero or 0). bitstring-4.1.1/dune000066400000000000000000000000661431112327400144000ustar00rootroot00000000000000(env (dev (flags (:standard -w -27-32-33-35)))) bitstring-4.1.1/dune-project000066400000000000000000000026031431112327400160430ustar00rootroot00000000000000(lang dune 2.5) (name bitstring) (version 4.1.0) (generate_opam_files true) (source (github xguerin/bitstring)) (license LGPL-2.0-or-later) (authors "Richard W.M. Jones" "Xavier R. Guérin") (maintainers "Xavier R. Guérin ") (package (name bitstring) (synopsis "Bitstrings and bitstring matching for OCaml") (description "\| The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. "\| You can use this module to both parse and generate binary formats, files and protocols. "\| Bitstring handling is added as primitives to the language, making it exceptionally simple to use and very powerful. ) (depends (dune (>= 2.5)) (ocaml (>= 4.04.1)) (stdlib-shims (>= 0.1.0)) )) (package (name ppx_bitstring) (synopsis "Bitstrings and bitstring matching for OCaml - PPX extension") (description "\| The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. "\| You can use this module to both parse and generate binary formats, files and protocols. "\| Bitstring handling is added as primitives to the language, making it exceptionally simple to use and very powerful. ) (depends (ocaml (>= 4.04.1)) (bitstring (>= 4.0.0)) (ocaml (and :with-test (>= 4.08.0))) (ppxlib (>= 0.18.0)) (ounit :with-test))) bitstring-4.1.1/examples/000077500000000000000000000000001431112327400153365ustar00rootroot00000000000000bitstring-4.1.1/examples/dune000066400000000000000000000014521431112327400162160ustar00rootroot00000000000000(executable (name elf) (modules Elf) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name ext3_superblock) (modules Ext3_superblock) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name gif) (modules Gif) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name ipv4_header) (modules Ipv4_header) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name libpcap) (modules Libpcap) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name make_ipv4_header) (modules Make_ipv4_header) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) (executable (name ping) (modules Ping) (libraries bitstring unix) (preprocess (pps ppx_bitstring))) bitstring-4.1.1/examples/elf.ml000066400000000000000000000010571431112327400164410ustar00rootroot00000000000000(* Read an ELF (Linux binary) header. * $Id$ *) open Printf let () = let filename = "/bin/ls" in let bits = Bitstring.bitstring_of_file filename in match%bitstring bits with | {| 0x7f : 8; "ELF" : 24 : string; (* ELF magic number *) _ : 12*8 : bitstring; (* ELF identifier *) e_type : 16 : littleendian; (* object file type *) e_machine : 16 : littleendian (* architecture *) |} -> printf "%s: ELF binary, type %d, arch %d\n" filename e_type e_machine | {| _ |} -> eprintf "%s: Not an ELF binary\n" filename bitstring-4.1.1/examples/ext3_sb000066400000000000000000000020001431112327400166200ustar00rootroot00000000000000L7'^ GGS]G <HxTDK/bootQbJ$MY`{u ]G@bitstring-4.1.1/examples/ext3_superblock.ml000066400000000000000000000102101431112327400207760ustar00rootroot00000000000000(* Parse an ext3 superblock. * $Id$ *) open Printf (*let () = Bitstring.debug := true*) let bits = Bitstring.bitstring_of_file "ext3_sb" (* The structure is straight from /usr/include/linux/ext3_fs.h *) let () = match%bitstring bits with | {|s_inodes_count : 32 : littleendian; (* Inodes count *) s_blocks_count : 32 : littleendian; (* Blocks count *) s_r_blocks_count : 32 : littleendian; (* Reserved blocks count *) s_free_blocks_count : 32 : littleendian; (* Free blocks count *) s_free_inodes_count : 32 : littleendian; (* Free inodes count *) s_first_data_block : 32 : littleendian; (* First Data Block *) s_log_block_size : 32 : littleendian; (* Block size *) s_log_frag_size : 32 : littleendian; (* Fragment size *) s_blocks_per_group : 32 : littleendian; (* # Blocks per group *) s_frags_per_group : 32 : littleendian; (* # Fragments per group *) s_inodes_per_group : 32 : littleendian; (* # Inodes per group *) s_mtime : 32 : littleendian; (* Mount time *) s_wtime : 32 : littleendian; (* Write time *) s_mnt_count : 16 : littleendian; (* Mount count *) s_max_mnt_count : 16 : littleendian; (* Maximal mount count *) 0xef53 : 16 : littleendian; (* Magic signature *) s_state : 16 : littleendian; (* File system state *) s_errors : 16 : littleendian; (* Behaviour when detecting errors *) s_minor_rev_level : 16 : littleendian; (* minor revision level *) s_lastcheck : 32 : littleendian; (* time of last check *) s_checkinterval : 32 : littleendian; (* max. time between checks *) s_creator_os : 32 : littleendian; (* OS *) s_rev_level : 32 : littleendian; (* Revision level *) s_def_resuid : 16 : littleendian; (* Default uid for reserved blocks *) s_def_resgid : 16 : littleendian; (* Default gid for reserved blocks *) s_first_ino : 32 : littleendian; (* First non-reserved inode *) s_inode_size : 16 : littleendian; (* size of inode structure *) s_block_group_nr : 16 : littleendian; (* block group # of this superblock *) s_feature_compat : 32 : littleendian; (* compatible feature set *) s_feature_incompat : 32 : littleendian; (* incompatible feature set *) s_feature_ro_compat : 32 : littleendian; (* readonly-compatible feature set *) s_uuid : 128 : string; (* 128-bit uuid for volume *) s_volume_name : 128 : string; (* volume name *) s_last_mounted : 512 : string; (* directory where last mounted *) s_algorithm_usage_bitmap : 32 : littleendian; (* For compression *) s_prealloc_blocks : 8; (* Nr of blocks to try to preallocate*) s_prealloc_dir_blocks : 8; (* Nr to preallocate for dirs *) s_reserved_gdt_blocks : 16 : littleendian;(* Per group desc for online growth *) s_journal_uuid : 128 : string; (* uuid of journal superblock *) s_journal_inum : 32 : littleendian; (* inode number of journal file *) s_journal_dev : 32 : littleendian; (* device number of journal file *) s_last_orphan : 32 : littleendian; (* start of list of inodes to delete *) s_hash_seed0 : 32 : littleendian; (* HTREE hash seed *) s_hash_seed1 : 32 : littleendian; s_hash_seed2 : 32 : littleendian; s_hash_seed3 : 32 : littleendian; s_def_hash_version : 8; (* Default hash version to use *) s_reserved_char_pad : 8; s_reserved_word_pad : 16 : littleendian; s_default_mount_opts : 32 : littleendian; s_first_meta_bg : 32 : littleendian; (* First metablock block group *) _ : 6080 : bitstring |} -> (* Padding to the end of the block *) printf "ext3 superblock:\n"; printf " s_inodes_count = %ld\n" s_inodes_count; printf " s_blocks_count = %ld\n" s_blocks_count; printf " s_free_inodes_count = %ld\n" s_free_inodes_count; printf " s_free_blocks_count = %ld\n" s_free_blocks_count; printf " s_uuid = %S\n" s_uuid; printf " s_volume_name = %S\n" s_volume_name; printf " s_last_mounted = %S\n" s_last_mounted | {| _ |} -> eprintf "not an ext3 superblock!\n%!"; exit 2 bitstring-4.1.1/examples/gif.ml000066400000000000000000000020231431112327400164320ustar00rootroot00000000000000(* GIF header parser. * $Id$ *) open Printf let () = if Array.length Sys.argv <= 1 then failwith "usage: gif input.gif"; let filename = Sys.argv.(1) in let bits = Bitstring.bitstring_of_file filename in match%bitstring bits with | {|("GIF87a"|"GIF89a") : 6*8 : string; (* GIF magic. *) width : 16 : littleendian; height : 16 : littleendian; colormap : 1; (* Has colormap? *) colorbits : 3; (* Color res = colorbits+1 *) sortflag : 1; bps : 3; (* Bits/pixel = bps+1 *) bg : 8; (* Background colour. *) aspectratio : 8|} -> printf "%s: GIF image:\n" filename; printf " size %d %d\n" width height; printf " has global colormap? %b\n" colormap; printf " colorbits %d\n" (colorbits+1); printf " global colormap is sorted? %b\n" sortflag; printf " bits/pixel %d\n" (bps+1); printf " background color index %d\n" bg; printf " aspect ratio %d\n" aspectratio | {|_|} -> eprintf "%s: Not a GIF image\n" filename bitstring-4.1.1/examples/ipv4_header.ml000066400000000000000000000024371431112327400200700ustar00rootroot00000000000000(* Parse and display an IPv4 header from a file. * $Id$ *) open Printf let header = Bitstring.bitstring_of_file "ipv4_header.dat" let () = match%bitstring header with | {|version : 4; hdrlen : 4; tos : 8; length : 16; identification : 16; flags : 3; fragoffset : 13; ttl : 8; protocol : 8; checksum : 16; source : 32; dest : 32; options : (hdrlen-5)*32 : bitstring; payload : -1 : bitstring|} when version = 4 -> printf "IPv%d:\n" version; printf " header length: %d * 32 bit words\n" hdrlen; printf " type of service: %d\n" tos; printf " packet length: %d bytes\n" length; printf " identification: %d\n" identification; printf " flags: %d\n" flags; printf " fragment offset: %d\n" fragoffset; printf " ttl: %d\n" ttl; printf " protocol: %d\n" protocol; printf " checksum: %d\n" checksum; printf " source: %lx dest: %lx\n" source dest; printf " header options + padding:\n"; Bitstring.hexdump_bitstring stdout options; printf " packet payload:\n"; Bitstring.hexdump_bitstring stdout payload | {|version : 4|} -> eprintf "cannot parse IP version %d\n" version | {|_|} as header -> eprintf "data is smaller than one nibble:\n"; Bitstring.hexdump_bitstring stderr header bitstring-4.1.1/examples/libpcap.ml000066400000000000000000000075151431112327400173120ustar00rootroot00000000000000(* Print out packets from a tcpdump / libpcap / wireshark capture file. * $Id$ * * To test this, capture some data using: * /usr/sbin/tcpdump -s 1500 -w /tmp/dump * then analyze it using: * ./libpcap /tmp/dump * * The file format is documented here: * http://wiki.wireshark.org/Development/LibpcapFileFormat * * libpcap endianness is determined at runtime. *) open Printf let rec main () = if Array.length Sys.argv <= 1 then failwith "libpcap dumpfile"; let bits = Bitstring.bitstring_of_file Sys.argv.(1) in let endian, file_header, bits = libpcap_header bits in (* Read the packets and print them out. *) let rec loop bits = let pkt_header, pkt_data, bits = libpcap_packet endian file_header bits in decode_and_print_packet file_header pkt_header pkt_data; loop bits in try loop bits with End_of_file -> () (* Determine the endianness (at runtime) from the magic number. *) and endian_of = function | 0xa1b2c3d4_l -> Bitstring.BigEndian | 0xd4c3b2a1_l -> Bitstring.LittleEndian | _ -> assert false and libpcap_header bits = match%bitstring bits with | {|((0xa1b2c3d4_l|0xd4c3b2a1_l) as magic) : 32; (* magic number *) major : 16 : endian (endian_of magic); (* version *) minor : 16 : endian (endian_of magic); timezone : 32 : endian (endian_of magic); (* timezone correction (secs)*) _ : 32 : endian (endian_of magic); (* always 0 apparently *) snaplen : 32 : endian (endian_of magic); (* max length of capt pckts *) network : 32 : endian (endian_of magic); (* data link layer type *) rest : -1 : bitstring |} -> endian_of magic, (major, minor, timezone, snaplen, network), rest | {|_|} -> failwith "not a libpcap/tcpdump packet capture file" and libpcap_packet e file_header bits = match%bitstring bits with | {|ts_sec : 32 : endian (e); (* packet timestamp seconds *) ts_usec : 32 : endian (e); (* packet timestamp microseconds *) incl_len : 32 : endian (e); (* packet length saved in this file *) orig_len : 32 : endian (e); (* packet length originally on wire *) pkt_data : Int32.to_int incl_len*8 : bitstring; rest : -1 : bitstring |} -> (ts_sec, ts_usec, incl_len, orig_len), pkt_data, rest | {|_|} -> raise End_of_file and decode_and_print_packet file_header pkt_header pkt_data = let (ts_sec, ts_usec, _, orig_len) = pkt_header in printf "%ld.%ld %ldB " ts_sec ts_usec orig_len; (* Assume an ethernet frame containing an IPv4/6 packet. We ignore * the ethertype field and determine the IP version from the packet * itself. If it doesn't match our assumptions, hexdump it. *) (match%bitstring pkt_data with | {|d0 : 8; d1 : 8; d2 : 8; d3 : 8; d4 : 8; d5 : 8; (* ether dest *) s0 : 8; s1 : 8; s2 : 8; s3 : 8; s4 : 8; s5 : 8; (* ether src *) _ : 16; (* ethertype *) packet : -1 : bitstring (* payload *) |} -> printf "%x:%x:%x:%x:%x:%x < %x:%x:%x:%x:%x:%x " d0 d1 d2 d3 d4 d5 s0 s1 s2 s3 s4 s5; (match%bitstring packet with | {|4 : 4; (* IPv4 *) hdrlen : 4; tos : 8; length : 16; identification : 16; flags : 3; fragoffset : 13; ttl : 8; protocol : 8; checksum : 16; s0 : 8; s1 : 8; s2 : 8; s3 : 8; d0 : 8; d1 : 8; d2 : 8; d3 : 8; _(*options*) : (hdrlen-5)*32 : bitstring; _(*payload*) : -1 : bitstring|} -> printf "IPv4 %d.%d.%d.%d < %d.%d.%d.%d " s0 s1 s2 s3 d0 d1 d2 d3 | {|6 : 4; (* IPv6 *) tclass : 8; flow : 20; length : 16; nexthdr : 8; ttl : 8; _(*source*) : 128 : bitstring; _(*dest*) : 128 : bitstring; _(*payload*) : -1 : bitstring|} -> printf "IPv6 "; | {|_|} -> printf "\n"; Bitstring.hexdump_bitstring stdout packet ) | {|_|} -> printf "\n"; Bitstring.hexdump_bitstring stdout pkt_data ); printf "\n" let () = main () bitstring-4.1.1/examples/make_ipv4_header.ml000066400000000000000000000014161431112327400210610ustar00rootroot00000000000000(* Create an IPv4 header. * $Id$ *) open Printf let version = 4 let hdrlen = 5 (* no options *) let tos = 16 let length = 64 (* total packet length *) let identification = 0 let flags = 0 let fragoffset = 0 let ttl = 255 let protocol = 17 (* UDP *) let checksum = 0 let source = 0xc0a80202_l (* 192.168.2.2 *) let dest = 0xc0a80201_l (* 192.168.2.1 *) let options = Bitstring.empty_bitstring let payload_length = (length - hdrlen*4) * 8 let payload = Bitstring.create_bitstring payload_length let%bitstring header = {| version : 4; hdrlen : 4; tos : 8; length : 16; identification : 16; flags : 3; fragoffset : 13; ttl : 8; protocol : 8; checksum : 16; source : 32; dest : 32 |} let () = Bitstring.bitstring_to_file header "ipv4_header_out.dat" bitstring-4.1.1/examples/ping.ipv4000066400000000000000000000001241431112327400170740ustar00rootroot00000000000000ET@@<B printf "IPv4:\n"; printf " header length: %d * 32 bit words\n" hdrlen; printf " type of service: %d\n" tos; printf " packet length: %d bytes\n" length; printf " identification: %d\n" identification; printf " flags: %d\n" flags; printf " fragment offset: %d\n" fragoffset; printf " ttl: %d\n" ttl; printf " protocol: %d\n" protocol; printf " checksum: %d\n" checksum; printf " source: %lx dest: %lx\n" source dest; printf " header options + padding:\n"; Bitstring.hexdump_bitstring stdout options; printf " packet payload:\n"; Bitstring.hexdump_bitstring stdout payload (* IPv6 packet header *) | {|6 : 4; tclass : 8; flow : 20; length : 16; nexthdr : 8; ttl : 8; source : 128 : bitstring; dest : 128 : bitstring; payload : -1 : bitstring|} -> printf "IPv6:\n"; printf " traffic class: %d\n" tclass; printf " flow label: %d\n" flow; printf " packet (payload) length: %d bytes\n" length; printf " next header: %d\n" nexthdr; printf " ttl: %d\n" ttl; printf " source address:\n"; Bitstring.hexdump_bitstring stdout source; printf " destination address:\n"; Bitstring.hexdump_bitstring stdout dest; printf "packet payload:\n"; Bitstring.hexdump_bitstring stdout payload | {|version : 4|} -> eprintf "unknown IP version %d\n" version; exit 1 | {|_|} as pkt -> eprintf "data is smaller than one nibble:\n"; Bitstring.hexdump_bitstring stderr pkt; exit 1 let () = let pkt = Bitstring.bitstring_of_file "ping.ipv4" in display pkt; let pkt = Bitstring.bitstring_of_file "ping.ipv6" in display pkt bitstring-4.1.1/mkdocs.yml000066400000000000000000000002541431112327400155240ustar00rootroot00000000000000site_name: OCaml Bitstring theme: readthedocs nav: - "Overview": "index.md" - "Examples": "examples.md" - "Guide": "documentation.md" - "Reference": "reference.md" bitstring-4.1.1/ppx/000077500000000000000000000000001431112327400143275ustar00rootroot00000000000000bitstring-4.1.1/ppx/dune000066400000000000000000000002341431112327400152040ustar00rootroot00000000000000(library (name ppx_bitstring) (public_name ppx_bitstring) (kind ppx_rewriter) (libraries str compiler-libs ppxlib) (preprocess (pps ppxlib.metaquot))) bitstring-4.1.1/ppx/ppx_bitstring.ml000066400000000000000000001131651431112327400175640ustar00rootroot00000000000000(* * Copyright (c) 2016 Xavier R. Guérin * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open Ppxlib open Printf open Ast_builder.Default (* Type definition *) module Entity = struct type t = { txt : string; exp : Parsetree.expression; pat : Parsetree.pattern } let mksym = let i = ref 1000 in fun name -> incr i; let i = !i in sprintf "__ppxbitstring_%s_%d" name i ;; let make ~loc v = let txt = mksym v in { txt; exp = evar ~loc txt; pat = pvar ~loc txt } end module Context = struct type t = { dat : Entity.t; off : Entity.t; len : Entity.t } let make ~loc = let dat = Entity.make ~loc "dat" and off = Entity.make ~loc "off" and len = Entity.make ~loc "len" in { dat; off; len } let next ~loc t = let off = Entity.make ~loc "off" and len = Entity.make ~loc "len" in { t with off; len } end module Type = struct type t = | Int | String | Bitstring end module Sign = struct type t = | Signed | Unsigned let to_string = function | Signed -> "signed" | Unsigned -> "unsigned" end module Endian = struct type t = | Little | Big | Native | Referred of Parsetree.expression let to_string = function | Little -> "le" | Big -> "be" | Native -> "ne" | Referred _ -> "ee" end module Qualifiers = struct type t = { value_type : Type.t option; sign : Sign.t option; endian : Endian.t option; check : Parsetree.expression option; bind : Parsetree.expression option; map : Parsetree.expression option; save_offset_to : Parsetree.expression option; offset : Parsetree.expression option; } let empty = { value_type = None; sign = None; endian = None; check = None; bind = None; map = None; save_offset_to = None; offset = None; } let default = { value_type = Some Type.Int; sign = Some Sign.Unsigned; endian = Some Endian.Big; check = None; bind = None; map = None; save_offset_to = None; offset = None; } let set_value_type_default q = match q.value_type with | None -> { q with value_type = Some Type.Int } | _ -> q ;; let set_sign_default q = match q.sign with | None -> { q with sign = Some Sign.Unsigned } | _ -> q ;; let set_endian_default q = match q.endian with | None -> { q with endian = Some Endian.Big } | _ -> q ;; let set_defaults v = v |> set_value_type_default |> set_sign_default |> set_endian_default ;; end module MatchField = struct type bitlen = (Parsetree.expression * int option) ;; type tuple = { pat : Parsetree.pattern; len : bitlen; qls : Qualifiers.t; opt : bool } type t = | Any of Parsetree.pattern | Tuple of tuple ;; end (* Exception *) let location_exn ~loc msg = Location.raise_errorf ~loc "%s" msg ;; (* Helper functions *) let split_string ~on s = Str.split (Str.regexp on) s ;; let option_bind opt f = match opt with | None -> None | Some v -> f v ;; let rec process_expr_loc ~loc expr = match expr with | { pexp_desc = Pexp_ident(ident); _ } -> let lident = Loc.make ~loc ident.txt in { expr with pexp_desc = Pexp_ident(lident); pexp_loc = loc } | { pexp_desc = Pexp_tuple(ops); _ } -> let fld = List.fold_left (fun acc exp -> acc @ [ process_expr_loc ~loc exp ]) [] ops in { expr with pexp_desc = Pexp_tuple(fld); pexp_loc = loc } | { pexp_desc = Pexp_construct(ident, ops); _ } -> let lident = Loc.make ident.txt ~loc in let lops = begin match ops with | Some o -> Some (process_expr_loc ~loc o) | None -> None end in { expr with pexp_desc = Pexp_construct(lident, lops); pexp_loc = loc } | { pexp_desc = Pexp_apply(ident, ops); _ } -> let lident = process_expr_loc ~loc ident in let fld = List.fold_left (fun acc (lbl, exp) -> acc @ [ (lbl, (process_expr_loc ~loc exp)) ]) [] ops in { expr with pexp_desc = Pexp_apply(lident, fld); pexp_loc = loc } | { pexp_desc = Pexp_fun(ident, ops, { ppat_desc = Ppat_var(pid); ppat_loc; ppat_attributes; ppat_loc_stack = [] }, exp); _ } -> let lpid = Loc.make pid.txt ~loc in let lpat = { ppat_desc = Ppat_var lpid; ppat_loc = loc; ppat_attributes; ppat_loc_stack = [] } in let lops = begin match ops with | Some o -> Some (process_expr_loc ~loc o) | None -> None end in let lexp = process_expr_loc ~loc exp in { expr with pexp_desc = Pexp_fun(ident, lops, lpat, lexp); pexp_loc = loc } | _ -> { expr with pexp_loc = loc } ;; let parse_expr expr = try Parse.expression (Lexing.from_string expr.txt) |> process_expr_loc ~loc:expr.loc with _ -> location_exn ~loc:expr.loc ("Parse expression error: '" ^ expr.txt ^ "'") ;; let process_pat_loc ~loc pat = match pat with | { ppat_desc = Ppat_var(ident); ppat_loc; ppat_attributes; _ } -> let lident = Loc.make ident.txt ~loc in { ppat_desc = Ppat_var(lident); ppat_loc = loc; ppat_attributes; ppat_loc_stack = [] } | _ -> { pat with ppat_loc = loc } ;; let parse_pattern pat = try Parse.pattern (Lexing.from_string pat.txt) |> process_pat_loc ~loc:pat.loc with _ -> location_exn ~loc:pat.loc ("Parse pattern error: '" ^ pat.txt ^ "'") ;; (* Location parser and splitter *) let find_loc_boundaries ~loc last rem = let open Location in let { loc_start; loc_end; loc_ghost } = loc in let xtr_lines = List.length rem in let xtr_char = List.fold_left (+) xtr_lines rem in let ne = { loc_start with pos_lnum = loc_start.pos_lnum + xtr_lines; pos_bol = loc_start.pos_bol + xtr_char; pos_cnum = loc_start.pos_cnum + xtr_char + last } and ns = if xtr_lines = 0 then { loc_start with pos_cnum = loc_start.pos_cnum + xtr_char + last + 1 } else { loc_start with pos_lnum = loc_start.pos_lnum + xtr_lines; pos_bol = loc_start.pos_bol + xtr_char; pos_cnum = loc_start.pos_cnum + xtr_char } in let tloc = { loc_start; loc_end = ne; loc_ghost } in let nloc = { loc_start = ns; loc_end; loc_ghost } in (tloc, nloc) ;; let rec split_loc_rec ~loc = function | [] -> [] | hd :: tl -> let line_list = split_string ~on:"\n" hd |> List.rev |> List.map String.length in begin match line_list with | [] -> [] | last::rem -> let (tloc, nloc) = find_loc_boundaries ~loc last rem in [ tloc ] @ (split_loc_rec ~loc:nloc tl) end ;; let split_loc ~loc lst = split_loc_rec ~loc lst |> List.map2 (fun e loc -> Loc.make (String.trim e) ~loc) lst ;; (* Processing qualifiers *) let check_map_functor sub = match sub with | [%expr (fun [%p? _] -> [%e? _])] -> Some (sub) | _ -> None ;; let process_qual state qual = let open Qualifiers in let loc = qual.pexp_loc in match qual with | [%expr int] -> begin match state.value_type with | Some v -> location_exn ~loc "Value type redefined" | None -> { state with value_type = Some Type.Int } end | [%expr string] -> begin match state.value_type with | Some v -> location_exn ~loc "Value type redefined" | None -> { state with value_type = Some Type.String } end | [%expr bitstring] -> begin match state.value_type with | Some v -> location_exn ~loc "Value type redefined" | None -> { state with value_type = Some Type.Bitstring } end | [%expr signed] -> begin match state.sign with | Some v -> location_exn ~loc "Signedness redefined" | None -> { state with sign = Some Sign.Signed } end | [%expr unsigned] -> begin match state.sign with | Some v -> location_exn ~loc "Signedness redefined" | None -> { state with sign = Some Sign.Unsigned } end | [%expr littleendian] -> begin match state.endian with | Some v -> location_exn ~loc "Endianness redefined" | None -> { state with endian = Some Endian.Little } end | [%expr bigendian] -> begin match state.endian with | Some v -> location_exn ~loc "Endianness redefined" | None -> { state with endian = Some Endian.Big } end | [%expr nativeendian] -> begin match state.endian with | Some v -> location_exn ~loc "Endianness redefined" | None -> { state with endian = Some Endian.Native } end | [%expr endian [%e? sub]] -> begin match state.endian with | Some v -> location_exn ~loc "Endianness redefined" | None -> { state with endian = Some (Endian.Referred sub) } end | [%expr bind [%e? sub]] -> begin match state.bind, state.map with | Some b, None -> location_exn ~loc "Bind expression redefined" | None, Some m -> location_exn ~loc "Map expression already defined" | Some b, Some m -> location_exn ~loc "Inconsistent internal state" | None, None -> { state with bind = Some sub } end | [%expr map [%e? sub]] -> begin match state.bind, state.map with | Some b, None -> location_exn ~loc "Bind expression already defined" | None, Some m -> location_exn ~loc "Map expression redefined" | Some b, Some m -> location_exn ~loc "Inconsistent internal state" | None, None -> begin match check_map_functor sub with | Some sub -> { state with map = Some sub } | None -> location_exn ~loc "Invalid map functor" end end | [%expr check [%e? sub]] -> begin match state.check with | Some v -> location_exn ~loc "Check expression redefined" | None -> { state with check = Some sub } end | [%expr save_offset_to [%e? sub]] -> begin match state.save_offset_to with | Some v -> location_exn ~loc "Save offset expression redefined" | None -> { state with save_offset_to = Some sub } end | [%expr offset [%e? sub]] -> begin match state.offset with | Some v -> location_exn ~loc "Offset expression redefined" | None -> { state with offset = Some sub } end | _ -> location_exn ~loc "Invalid qualifier" ;; let parse_quals quals = let expr = parse_expr quals in let rec process_quals state = function | [] -> state | hd :: tl -> process_quals (process_qual state hd) tl in match expr with (* single named qualifiers *) | { pexp_desc = Pexp_ident (_); _ } -> process_qual Qualifiers.empty expr (* single functional qualifiers *) | { pexp_desc = Pexp_apply (_, _); _ } -> process_qual Qualifiers.empty expr (* multiple qualifiers *) | { pexp_desc = Pexp_tuple (e); _ } -> process_quals Qualifiers.empty e (* Unrecognized expression *) | expr -> location_exn ~loc:expr.pexp_loc "Invalid qualifiers list" ;; (* Processing expression *) let rec evaluate_expr = function | [%expr [%e? lhs] + [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l + r) | _ -> None end | [%expr [%e? lhs] - [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l - r) | _ -> None end | [%expr [%e? lhs] * [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l * r) | _ -> None end | [%expr [%e? lhs] / [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l / r) | _ -> None end | [%expr [%e? lhs] land [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l land r) | _ -> None end | [%expr [%e? lhs] lor [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l lor r) | _ -> None end | [%expr [%e? lhs] lxor [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l lxor r) | _ -> None end | [%expr [%e? lhs] lsr [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l lsr r) | _ -> None end | [%expr [%e? lhs] asr [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l asr r) | _ -> None end | [%expr [%e? lhs] mod [%e? rhs]] -> begin match evaluate_expr lhs, evaluate_expr rhs with | Some l, Some r -> Some (l mod r) | _ -> None end | { pexp_desc = Pexp_constant (const); _ } -> begin match const with | Pconst_integer(i, _) -> Some (int_of_string i) | _ -> None end | _ -> None ;; (* Parsing fields *) let parse_match_fields str = let open MatchField in split_string ~on:":" str.txt |> split_loc ~loc:str.loc |> function | [ { txt = "_" ; loc } as pat ] -> MatchField.Any (parse_pattern pat) | [ spat; slen ] -> let qls = Qualifiers.default and eln = parse_expr slen and pat = parse_pattern spat and opt = false in let len = (eln, evaluate_expr eln) in MatchField.Tuple { pat; len; qls; opt } | [ spat; slen; sqls ] -> let qls = Qualifiers.set_defaults (parse_quals sqls) and eln = parse_expr slen and pat = parse_pattern spat and opt = false in let len = (eln, evaluate_expr eln) in MatchField.Tuple { pat; len; qls; opt } | [ stmt ] -> let pat_str = stmt.txt in location_exn ~loc:stmt.loc ("Invalid statement: '" ^ pat_str ^ "'") | _ -> location_exn ~loc:str.loc "Invalid number of fields in statement" ;; (* * Some operators like the subtype cast operator (:>) can throw off the parser. * The function below resolve these ambiguities on a case-by-case basis. *) let stitch_ambiguous_operators lst = let fn e = function | [] -> [ e ] | hd :: tl when hd = "" || e == "" -> e :: hd :: tl | hd :: tl when Str.first_chars hd 1 = ">" -> (e ^ ":" ^ hd) :: tl | l -> e :: l in List.fold_right fn lst [] let parse_const_fields str = let open Qualifiers in split_string ~on:":" str.txt |> stitch_ambiguous_operators |> split_loc ~loc:str.loc |> function | [ vl; len ] -> (parse_expr vl, Some (parse_expr len), Some Qualifiers.default) | [ vl; len; quals ] -> let q = Qualifiers.set_defaults (parse_quals quals) in begin match q.bind, q.map, q.check, q.save_offset_to with | Some _, _, _, _ -> location_exn ~loc:str.loc "Bind meaningless in constructor" | _, Some _, _, _ -> location_exn ~loc:str.loc "Map meaningless in constructor" | _, _, Some _, _ -> location_exn ~loc:str.loc "Check meaningless in constructor" | _, _, _, Some _ -> location_exn ~loc:str.loc "Saving offset meaningless in constructor" | None, None, None, None -> (parse_expr vl, Some (parse_expr len), Some (q)) end | [ stmt ] -> let pat_str = stmt.txt in location_exn ~loc:stmt.loc ("Invalid statement: '" ^ pat_str ^ "'") | _ -> location_exn ~loc:str.loc "Invalid number of fields in statement" ;; (* Match generators *) let check_field_len ~loc fld = let (l, v) = fld.MatchField.len in match v, fld.MatchField.qls.Qualifiers.value_type with | Some (n), Some (Type.String) -> if n < -1 || (n > 0 && (n mod 8) <> 0) then location_exn ~loc "Length of string must be > 0 and multiple of 8, or the special value -1" else Some n | Some (n), Some (Type.Bitstring) -> if n < -1 then location_exn ~loc "Length of bitstring must be >= 0 or the special value -1" else Some n | Some (n), Some (Type.Int) -> if n < 1 || n > 64 then location_exn ~loc "Length of int field must be [1..64]" else Some n | None, Some (_) -> None | _, None -> location_exn ~loc "No type to check" ;; let get_inttype ~loc ~fastpath = function | v when v > 8 && v <= 16 -> if fastpath then "int16" else "int" | v when v > 16 && v <= 31 -> if fastpath then "int32" else "int" | v when v = 32 -> "int32" | v when v > 32 && v <= 64 -> "int64" | _ -> location_exn ~loc "Invalid integer size" let gen_int_extractor_static ~loc nxt size sign endian = let edat = nxt.Context.dat.Entity.exp and eoff = nxt.Context.off.Entity.exp in let sn = Sign.to_string sign and ft = get_inttype ~loc ~fastpath:true size and en = Endian.to_string endian in let fp = sprintf "Bitstring.extract_fastpath_%s_%s_%s" ft en sn in [%expr [%e evar ~loc fp] [%e edat] ([%e eoff] lsr 3)] [@metaloc loc] ;; let gen_int_extractor_dynamic ~loc nxt size sign endian = let edat = nxt.Context.dat.Entity.exp and eoff = nxt.Context.off.Entity.exp and elen = nxt.Context.len.Entity.exp in let sn = Sign.to_string sign and it = get_inttype ~loc ~fastpath:false size and en = Endian.to_string endian in let ex = sprintf "Bitstring.extract_%s_%s_%s" it en sn in [%expr [%e evar ~loc ex] [%e edat] [%e eoff] [%e elen] [%e eint ~loc size]] [@metaloc loc] ;; let gen_int_extractor ~loc nxt fld = let open Qualifiers in let (l, v) = fld.MatchField.len in let edat = nxt.Context.dat.Entity.exp and eoff = nxt.Context.off.Entity.exp and elen = nxt.Context.len.Entity.exp in match v, fld.MatchField.qls.sign, fld.MatchField.qls.endian with (* 1-bit type *) | Some (size), Some (_), Some (_) when size = 1 -> [%expr Bitstring.extract_bit [%e edat] [%e eoff] [%e elen] [%e l]] [@metaloc loc] (* 8-bit type *) | Some (size), Some (sign), Some (_) when size >= 2 && size <= 8 -> let ex = sprintf "Bitstring.extract_char_%s" (Sign.to_string sign) in [%expr [%e evar ~loc ex] [%e edat] [%e eoff] [%e elen] [%e eint ~loc size]] [@metaloc loc] (* 16|32|64-bit type with referred endianness *) | Some (size), Some (sign), Some (Endian.Referred r) -> let ss = Sign.to_string sign and it = get_inttype ~loc ~fastpath:false size in let ex = sprintf "Bitstring.extract_%s_ee_%s" it ss in [%expr [%e evar ~loc ex] ([%e r]) [%e edat] [%e eoff] [%e elen] [%e eint ~loc size]] [@metaloc loc] (* 16|32|64-bit type with immediate endianness *) | Some (size), Some (sign), Some (endian) -> if fld.MatchField.opt then gen_int_extractor_static ~loc nxt size sign endian else gen_int_extractor_dynamic ~loc nxt size sign endian (* Variable size *) | None, Some (sign), Some (Endian.Referred r) -> let ss = Sign.to_string sign in let ex = sprintf "Bitstring.extract_int64_ee_%s" ss in [%expr [%e evar ~loc ex] ([%e r]) [%e edat] [%e eoff] [%e elen] ([%e l])] [@metaloc loc] | None, Some (sign), Some (endian) -> let es = Endian.to_string endian and ss = Sign.to_string sign in let ex = sprintf "Bitstring.extract_int64_%s_%s" es ss in [%expr [%e evar ~loc ex] [%e edat] [%e eoff] [%e elen] ([%e l])] [@metaloc loc] (* Invalid type *) | _, _, _ -> location_exn ~loc "Invalid type" ;; let gen_extractor ~loc nxt fld = let open Qualifiers in let (l, v) = fld.MatchField.len in let edat = nxt.Context.dat.Entity.exp and eoff = nxt.Context.off.Entity.exp and elen = nxt.Context.len.Entity.exp in match fld.MatchField.qls.value_type with | Some (Type.Bitstring) -> begin match v with | Some (-1) -> [%expr ([%e edat], [%e eoff], [%e elen])] [@metaloc loc] | Some (_) | None -> [%expr ([%e edat], [%e eoff], [%e l])] [@metaloc loc] end | Some (Type.String) -> [%expr (Bitstring.string_of_bitstring ([%e edat], [%e eoff], [%e l]))] [@metaloc loc] | Some (Type.Int) -> gen_int_extractor ~loc nxt fld | _ -> location_exn ~loc "Invalid type" ;; let gen_value ~loc fld res beh = let open Qualifiers in match fld.MatchField.qls.bind, fld.MatchField.qls.map with | Some b, None -> [%expr let [%p fld.pat] = [%e b] in [%e beh]][@metaloc loc] | None, Some m -> [%expr let [%p fld.pat] = [%e m] [%e res] in [%e beh]][@metaloc loc] | _, _ -> beh ;; let rec gen_next ~loc cur nxt fld beh fields = let open Entity in let open Context in let (l, v) = fld.MatchField.len in match v with | Some (-1) -> [%expr let [%p nxt.off.pat] = [%e nxt.off.exp] + [%e nxt.len.exp] and [%p nxt.len.pat] = 0 in [%e (gen_fields ~loc cur nxt beh fields)]] [@metaloc loc] | Some (_) | None -> [%expr let [%p nxt.off.pat] = [%e nxt.off.exp] + [%e l] and [%p nxt.len.pat] = [%e nxt.len.exp] - [%e l] in [%e (gen_fields ~loc cur nxt beh fields)]] [@metaloc loc] and gen_next_all ~loc cur nxt beh fields = let open Entity in let open Context in [%expr let [%p nxt.off.pat] = [%e nxt.off.exp] + [%e nxt.len.exp] and [%p nxt.len.pat] = 0 in [%e (gen_fields ~loc cur nxt beh fields)]] [@metaloc loc] and gen_match_check ~loc = function | Some chk -> chk | None -> ebool true ~loc and gen_match ~loc cur nxt fld beh fields = let open Entity in let open Context in let open Qualifiers in let value = Entity.make ~loc "val" and (l, _) = fld.MatchField.len in let mcheck = gen_match_check ~loc fld.MatchField.qls.check and mfields = gen_fields ~loc cur nxt beh fields and mres = gen_extractor ~loc nxt fld in let mwrap = gen_value ~loc fld value.exp mfields in let mcase = [%expr begin match [%e value.exp] with | [%p fld.MatchField.pat] when [%e mcheck] -> [%e mwrap] | _ -> () end][@metaloc loc] in [%expr let [%p value.pat] = [%e mres] and [%p nxt.off.pat] = [%e nxt.off.exp] + [%e l] and [%p nxt.len.pat] = [%e nxt.len.exp] - [%e l] in [%e mcase]] [@metaloc loc] and gen_offset ~loc cur nxt fld beh = let open Context in let open Entity in let open Qualifiers in match fld.MatchField.qls.offset with | Some ({ pexp_loc; _ } as off) -> [%expr let [%p nxt.off.pat] = [%e cur.off.exp] + [%e off] in [%e beh]] [@metaloc pexp_loc] | None -> beh and gen_offset_saver ~loc cur nxt fld beh = let open Context in let open Entity in let open Qualifiers in match fld.MatchField.qls.save_offset_to with | Some { pexp_desc = Pexp_ident ({ txt; loc = eloc }); _ } -> let ptxt = pvar ~loc:eloc (Longident.last_exn txt) in [%expr let [%p ptxt] = [%e nxt.off.exp] - [%e cur.off.exp] in [%e beh]] [@metaloc eloc] | Some _ | None -> beh and gen_unbound_string ~loc cur nxt fld beh fields = let p = fld.MatchField.pat in match p with | { ppat_desc = Ppat_var(_); _ } -> [%expr let [%p p] = [%e (gen_extractor ~loc nxt fld)] in [%e (gen_next_all ~loc cur nxt beh fields)]] [@metaloc loc] | [%pat? _ ] -> [%expr [%e (gen_next_all ~loc cur nxt beh fields)]] [@metaloc loc] | _ -> location_exn ~loc "Unbound string or bitstring can only be assigned to a variable or skipped" and gen_bound_bitstring ~loc cur nxt fld beh fields = let open Entity in let open Context in let p = fld.MatchField.pat and (l, _) = fld.MatchField.len in match p with | { ppat_desc = Ppat_var(_); _ } -> [%expr if Stdlib.(>=) [%e nxt.len.exp] [%e l] then let [%p p] = [%e (gen_extractor ~loc nxt fld)] in [%e (gen_next ~loc cur nxt fld beh fields)] else ()] [@metaloc loc] | [%pat? _ ] -> [%expr if Stdlib.(>=) [%e nxt.len.exp] [%e l] then [%e (gen_next ~loc cur nxt fld beh fields)] else ()] [@metaloc loc] | _ -> location_exn ~loc "Bound bitstring can only be assigned to variables or skipped" and gen_bound_string ~loc cur nxt fld beh fields = let open Entity in let open Context in let (l, _) = fld.MatchField.len in [%expr if Stdlib.(>=) [%e nxt.len.exp] [%e l] then [%e (gen_match ~loc cur nxt fld beh fields)] else ()] [@metaloc loc] and gen_bound_int_with_size ~loc cur nxt fld beh fields = let open Entity in let open Context in let (l, _) = fld.MatchField.len in [%expr if Stdlib.(>=) [%e nxt.len.exp] [%e l] then [%e (gen_match ~loc cur nxt fld beh fields)] else ()] [@metaloc loc] and gen_bound_int ~loc cur nxt fld beh fields = let open Entity in let open Context in let (l, _) = fld.MatchField.len in [%expr if Stdlib.(>=) [%e l] 1 && Stdlib.(<=) [%e l] 64 && Stdlib.(>=) [%e nxt.len.exp] [%e l] then [%e (gen_match ~loc cur nxt fld beh fields)] else ()] [@metaloc loc] and gen_fields_with_quals_by_type ~loc cur nxt fld beh fields = let open Qualifiers in match check_field_len ~loc fld, fld.MatchField.qls.value_type with | Some (-1), Some (Type.Bitstring | Type.String) -> gen_unbound_string ~loc cur nxt fld beh fields | (Some (_) | None), Some (Type.Bitstring) -> gen_bound_bitstring ~loc cur nxt fld beh fields | (Some (_) | None), Some (Type.String) -> gen_bound_string ~loc cur nxt fld beh fields | Some (s), Some (Type.Int) -> if s >= 1 && s <= 64 then gen_bound_int_with_size ~loc cur nxt fld beh fields else location_exn ~loc "Invalid bit length for type Integer" | None, Some (Type.Int) -> gen_bound_int ~loc cur nxt fld beh fields | _, _ -> location_exn ~loc "No type to generate" and gen_fields_with_quals ~loc cur nxt fld beh fields = gen_fields_with_quals_by_type ~loc cur nxt fld beh fields |> gen_offset_saver ~loc cur nxt fld |> gen_offset ~loc cur nxt fld and gen_fields ~loc cur nxt beh fields = let (exp, alias) = beh in match fields with | [] -> begin match alias with | None -> exp | Some a -> [%expr let [%p pvar ~loc a] = ([%e cur.dat.exp], [%e cur.off.exp], ([%e cur.len.exp] - [%e nxt.len.exp])) in [%e exp] ][@metaloc loc] end | MatchField.Any (_) :: tl -> begin match alias with | None -> exp | Some a -> [%expr let [%p pvar ~loc a] = ([%e cur.dat.exp], [%e cur.off.exp], [%e cur.len.exp]) in [%e exp] ][@metaloc loc] end | MatchField.Tuple (fld) :: tl -> gen_fields_with_quals ~loc cur nxt fld beh tl ;; let is_field_size_open_ended = function | (_, Some (-1)) -> true | _ -> false let check_for_open_endedness fields = let check init fld = let p = fld.MatchField.pat and l = fld.MatchField.len in let oe = is_field_size_open_ended l in if init || (oe && init) then location_exn ~loc:p.ppat_loc "Pattern is already open-ended" else oe in let inspect init = function | MatchField.Any (_) -> init && false | MatchField.Tuple fld -> check init fld in let rec scan init = function | [] -> () | hd :: tl -> scan (inspect init hd) tl in scan false fields; fields ;; let mark_optimized_fastpath fields = let open Qualifiers in let open MatchField in let check_field off tuple = match tuple with | { pat; len = (l, Some (v)); qls = { value_type = Some (Type.Int); _ }; _ } -> if (off land 7) = 0 && (v = 16 || v = 32 || v = 64) then (Some (off + v), MatchField.Tuple { tuple with opt = true }) else (None, MatchField.Tuple tuple) | _ -> (None, MatchField.Tuple tuple) in let check_offset_and_field offset fld = match offset, fld with | Some (off), MatchField.Tuple (tuple) -> check_field off tuple | _, _ -> (None, fld) in let rec scan offset result = function | [] -> result | hd :: tl -> let (noff, nfld) = check_offset_and_field offset hd in scan noff (result @ [ nfld ]) tl in scan (Some 0) [] fields ;; let gen_case_constant ~loc cur nxt res case value alias = let open Entity in let beh = [%expr [%e res.exp] := Some ([%e case.pc_rhs]); raise Exit][@metaloc loc] in let beh = match case.pc_guard with | None -> beh | Some cond -> [%expr if [%e cond] then [%e beh] else ()][@metaloc loc] in split_string ~on:";" value |> split_loc ~loc |> List.map parse_match_fields |> check_for_open_endedness |> mark_optimized_fastpath |> gen_fields ~loc cur nxt (beh, alias) let gen_case cur nxt res case = let loc = case.pc_lhs.ppat_loc in match case.pc_lhs.ppat_desc with | Ppat_constant (Pconst_string (value, _, _)) -> gen_case_constant ~loc cur nxt res case value None | Ppat_alias ({ ppat_desc = Ppat_constant (Pconst_string (value, _, _)); _ }, { txt = a; _ }) -> gen_case_constant ~loc cur nxt res case value (Some a) | _ -> location_exn ~loc "Wrong pattern type" ;; let rec gen_cases_sequence ~loc = function | [] -> location_exn ~loc "Empty case list" | [hd] -> hd | hd :: tl -> [%expr [%e hd]; [%e gen_cases_sequence ~loc tl]][@metaloc loc] ;; let gen_cases ~loc ident cases = let open Entity in let open Context in let cur = Context.make ~loc and res = Entity.make ~loc "res" in let nxt = Context.next ~loc cur and tupl = [%pat? ([%p cur.dat.pat], [%p cur.off.pat], [%p cur.len.pat])][@metaloc loc] and fnam = estring ~loc loc.Location.loc_start.pos_fname and lpos = eint ~loc loc.Location.loc_start.pos_lnum and cpos = eint ~loc (loc.Location.loc_start.pos_cnum - loc.Location.loc_start.pos_bol) in List.fold_left (fun acc case -> acc @ [ gen_case cur nxt res case ]) [] cases |> gen_cases_sequence ~loc |> fun seq -> [%expr let [%p tupl] = [%e ident] in let [%p nxt.off.pat] = [%e cur.off.exp] and [%p nxt.len.pat] = [%e cur.len.exp] and [%p res.pat] = ref None in (try [%e seq]; with | Exit -> ()); match ![%e res.exp] with | Some x -> x | None -> raise (Match_failure ([%e fnam], [%e lpos], [%e cpos]))] [@metaloc loc] ;; let gen_function ~loc cases = let open Entity in let cas = Entity.make ~loc "case" in [%expr (fun [%p cas.pat] -> [%e (gen_cases ~loc cas.exp cases)])] [@metaloc loc] (* Constructor generators *) let gen_constructor_exn ~loc = let open Location in [%expr Bitstring.Construct_failure ( [%e estring ~loc "Bad field value"], [%e estring ~loc loc.loc_start.pos_fname], [%e eint ~loc loc.loc_start.pos_lnum], [%e eint ~loc loc.loc_start.pos_cnum])] [@metaloc loc] ;; let gen_constructor_bitstring ~loc sym (l, _, _ ) = [%expr Bitstring.construct_bitstring [%e sym.Entity.exp] [%e l]] [@metaloc loc] ;; let gen_constructor_string ~loc sym (l, _, _) = [%expr Bitstring.construct_string [%e sym.Entity.exp] [%e l]] [@metaloc loc] ;; let get_1_bit_constr_value ~loc (l, _, _) = match (evaluate_expr l) with | Some (1) -> [%expr true][@metaloc loc] | Some (0) -> [%expr false][@metaloc loc] | Some (_) | None -> l ;; let gen_constructor_int ~loc sym fld = let open Qualifiers in let (l, s, q) = fld in let eexc = gen_constructor_exn ~loc and esym = sym.Entity.exp in let (fnc, vl, sz) = match (evaluate_expr s), q.sign, q.endian with (* 1-bit type *) | Some (size), Some (_), Some (_) when size = 1 -> (evar ~loc "Bitstring.construct_bit", get_1_bit_constr_value ~loc fld, [%expr 1]) (* 8-bit type *) | Some (size), Some (sign), Some (_) when size >= 2 && size <= 8 -> let sn = Sign.to_string sign in let ex = sprintf "Bitstring.construct_char_%s" sn in (evar ~loc ex, l, eint ~loc size) (* 16|32|64-bit type *) | Some (size), Some (sign), Some (Endian.Referred r) -> let ss = Sign.to_string sign and it = get_inttype ~loc ~fastpath:false size in let ex = sprintf "Bitstring.construct_%s_ee_%s" it ss in ([%expr [%e evar ~loc ex] [%e r]], l, s) | Some (size), Some (sign), Some (endian) -> let tp = get_inttype ~loc ~fastpath:false size and en = Endian.to_string endian and sn = Sign.to_string sign in let ex = sprintf "Bitstring.construct_%s_%s_%s" tp en sn in (evar ~loc ex, l, eint ~loc size) (* Variable size types *) | None, Some (sign), Some (Endian.Referred r) -> let ss = Sign.to_string sign in let ex = sprintf "Bitstring.construct_int64_ee_%s" ss in ([%expr [%e evar ~loc ex] [%e r]], l, s) | None, Some (sign), Some (endian) -> let en = Endian.to_string endian and sn = Sign.to_string sign in let ex = sprintf "Bitstring.construct_int64_%s_%s" en sn in (evar ~loc ex, l, s) (* Invalid type *) | _, _, _ -> location_exn ~loc "Invalid type" in [%expr [%e fnc] [%e esym] [%e vl] [%e sz] [%e eexc]] [@metaloc loc] ;; let gen_constructor_complete ~loc sym fld = let (_, _, q) = fld in match q.Qualifiers.value_type with | Some (Type.Bitstring) -> gen_constructor_bitstring ~loc sym fld | Some (Type.String) -> gen_constructor_string ~loc sym fld | Some (Type.Int) -> gen_constructor_int ~loc sym fld | _ -> location_exn ~loc "Invalid type" ;; let gen_constructor ~loc sym = function | (f, Some (s), Some (q)) -> gen_constructor_complete ~loc sym (f, s, q) | _ -> location_exn ~loc "Invalid field format" ;; let gen_assignment_size_of_sized_field ~loc (f, s, q) = match (evaluate_expr s), option_bind q (fun q -> q.Qualifiers.value_type) with (* Deal with String type *) | Some (-1), Some (Type.String) -> [%expr (String.length [%e f] * 8)] | Some (v), Some (Type.String) when v > 0 && (v mod 8) = 0 -> s | Some (_), Some (Type.String) -> location_exn ~loc "Length of string must be > 0 and multiple of 8, or the special value -1" (* Deal with Bitstring type *) | Some (-1), Some (Type.Bitstring) -> [%expr (Bitstring.bitstring_length [%e f])] | Some (v), Some (Type.Bitstring) when v > 0 -> s | Some (_), Some (Type.Bitstring) -> location_exn ~loc "Length of bitstring must be >= 0 or the special value -1" (* Deal with other types *) | Some (v), _ when v > 0 -> s | Some (v), _ -> location_exn ~loc "Negative or null field size in constructor" (* Unknown field size, arbitrary expression *) | None, _ -> s ;; let gen_assignment_size_of_field ~loc = function | (_, None, _) -> [%expr 0] | (f, Some (s), q) -> gen_assignment_size_of_sized_field ~loc (f, s, q) ;; let rec gen_assignment_size ~loc = function | [] -> [%expr 0] | field :: tl -> let this = gen_assignment_size_of_field ~loc field in let next = gen_assignment_size ~loc tl in [%expr [%e this] + ([%e next])][@metaloc loc] ;; let gen_assignment_behavior ~loc sym fields = let size = gen_assignment_size ~loc fields in let res = sym.Entity.exp in let rep = [%expr Bitstring.Buffer.contents [%e res]][@metaloc loc] in let len = match (evaluate_expr size) with | Some (v) -> eint v ~loc | None -> size in let post = [%expr let _res = [%e rep] in if Stdlib.(=) (Bitstring.bitstring_length _res) [%e len] then _res else raise Exit] [@metaloc loc] in let seq = List.fold_right (fun fld acc -> [%expr [%e (gen_constructor ~loc sym fld)]; [%e acc]]) fields post in [%expr let [%p sym.Entity.pat] = Bitstring.Buffer.create () in [%e seq]] [@metaloc loc] ;; let parse_assignment_behavior ~loc sym value = split_string ~on:";" value |> split_loc ~loc |> List.map (fun flds -> parse_const_fields flds) |> gen_assignment_behavior ~loc sym ;; let gen_constructor_expr ~loc value = let open Entity in let sym = Entity.make ~loc "constructor" in let beh = parse_assignment_behavior ~loc sym value in [%expr let [%p sym.pat] = fun () -> [%e beh] in [%e sym.exp] ()] ;; let transform_single_let ~loc ast expr = match ast.pvb_pat.ppat_desc, ast.pvb_expr.pexp_desc with | Parsetree.Ppat_var (s), Pexp_constant (Pconst_string (value, _, _)) -> let pat = pvar ~loc s.txt in let constructor_expr = gen_constructor_expr ~loc value in [%expr let [%p pat] = [%e constructor_expr] in [%e expr]] | _ -> location_exn ~loc "Invalid pattern type" ;; let expression_expander expr = let loc = expr.pexp_loc in match expr.pexp_desc with | Pexp_constant (Pconst_string (value, _, (_ : string option))) -> gen_constructor_expr ~loc value | Pexp_let (Nonrecursive, bindings, expr) -> List.fold_right (fun binding expr -> transform_single_let ~loc binding expr) bindings expr | Pexp_match (ident, cases) -> gen_cases ~loc ident cases | Pexp_function (cases) -> gen_function ~loc cases | _ -> location_exn ~loc "'bitstring' can only be used with 'let', 'match', and as '[%bitstring]'" let expression_rule = Extension.V3.declare "bitstring" Extension.Context.expression Ast_pattern.(single_expr_payload __) (fun ~ctxt -> expression_expander) |> Context_free.Rule.extension let structure_item_rewriter ~(ctxt : Expansion_context.Extension.t) pat expr = let loc = Expansion_context.Extension.extension_point_loc ctxt in [%stri let [%p pat] = [%e expression_expander expr]] let structure_item_rule = Extension.V3.declare "bitstring" Extension.Context.structure_item Ast_pattern.(pstr (pstr_value nonrecursive (value_binding ~pat:__ ~expr:__ ^:: nil) ^:: nil)) structure_item_rewriter |> Context_free.Rule.extension let () = Driver.register_transformation "bitstring" ~rules:[ expression_rule ; structure_item_rule ; ] bitstring-4.1.1/ppx_bitstring.opam000066400000000000000000000022171431112327400172740ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "4.1.0" synopsis: "Bitstrings and bitstring matching for OCaml - PPX extension" description: """ The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. You can use this module to both parse and generate binary formats, files and protocols. Bitstring handling is added as primitives to the language, making it exceptionally simple to use and very powerful. """ maintainer: ["Xavier R. Guérin "] authors: ["Richard W.M. Jones" "Xavier R. Guérin"] license: "LGPL-2.0-or-later" homepage: "https://github.com/xguerin/bitstring" bug-reports: "https://github.com/xguerin/bitstring/issues" depends: [ "dune" {>= "2.5"} "ocaml" {>= "4.04.1"} "bitstring" {>= "4.0.0"} "ocaml" {with-test & >= "4.08.0"} "ppxlib" {>= "0.18.0"} "ounit" {with-test} ] build: [ ["dune" "subst"] {pinned} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/xguerin/bitstring.git" bitstring-4.1.1/src/000077500000000000000000000000001431112327400143075ustar00rootroot00000000000000bitstring-4.1.1/src/bitstring.ml000066400000000000000000001212021431112327400166440ustar00rootroot00000000000000(* * Bitstring library. * * Copyright (C) 2008-2016 Red Hat Inc., Richard W.M. Jones * Copyright (C) 2016 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version, * with the OCaml linking exception described in COPYING.LIB. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Printf include Bitstring_types include Bitstring_config (* Enable runtime debug messages. Must also have been enabled * in pa_bitstring.ml. *) let debug = ref false (* Exceptions. *) exception Construct_failure of string * string * int * int (* A bitstring is simply the data itself (as a byte sequence), and the * bitoffset and the bitlength within the byte sequence. Note offset/length * are counted in bits, not bytes. *) type bitstring = bytes * int * int type t = bitstring (* Functions to create and load bitstrings. *) let empty_bitstring = Bytes.create 0, 0, 0 let make_bitstring len c = if len >= 0 then Bytes.make ((len+7) lsr 3) c, 0, len else invalid_arg ( sprintf "make_bitstring/create_bitstring: len %d < 0" len ) let create_bitstring len = make_bitstring len '\000' let zeroes_bitstring = create_bitstring let ones_bitstring len = make_bitstring len '\xff' let bitstring_of_string str = Bytes.of_string str, 0, String.length str lsl 3 let bitstring_of_chan chan = let tmpsize = 16384 in let buf = Buffer.create tmpsize in let tmp = Bytes.create tmpsize in let n = ref 0 in while n := input chan tmp 0 tmpsize; !n > 0 do Buffer.add_subbytes buf tmp 0 !n; done; Buffer.to_bytes buf, 0, Buffer.length buf lsl 3 let bitstring_of_chan_max chan max = let tmpsize = 16384 in let buf = Buffer.create tmpsize in let tmp = Bytes.create tmpsize in let len = ref 0 in let rec loop () = if !len < max then ( let r = min tmpsize (max - !len) in let n = input chan tmp 0 r in if n > 0 then ( Buffer.add_subbytes buf tmp 0 n; len := !len + n; loop () ) ) in loop (); Buffer.to_bytes buf, 0, !len lsl 3 let bitstring_of_file_descr fd = let tmpsize = 16384 in let buf = Buffer.create tmpsize in let tmp = Bytes.create tmpsize in let n = ref 0 in while n := Unix.read fd tmp 0 tmpsize; !n > 0 do Buffer.add_subbytes buf tmp 0 !n; done; Buffer.to_bytes buf, 0, Buffer.length buf lsl 3 let bitstring_of_file_descr_max fd max = let tmpsize = 16384 in let buf = Buffer.create tmpsize in let tmp = Bytes.create tmpsize in let len = ref 0 in let rec loop () = if !len < max then ( let r = min tmpsize (max - !len) in let n = Unix.read fd tmp 0 r in if n > 0 then ( Buffer.add_subbytes buf tmp 0 n; len := !len + n; loop () ) ) in loop (); Buffer.to_bytes buf, 0, !len lsl 3 let bitstring_of_file fname = let chan = open_in_bin fname in try let bs = bitstring_of_chan chan in close_in chan; bs with exn -> close_in chan; raise exn let bitstring_length (_, _, len) = len let subbitstring (data, off, len) off' len' = let off = off + off' in if off' < 0 || len' < 0 || off' > len - len' then invalid_arg "subbitstring"; (data, off, len') let dropbits n (data, off, len) = let off = off + n in let len = len - n in if len < 0 || n < 0 then invalid_arg "dropbits"; (data, off, len) let takebits n (data, off, len) = if len < n || n < 0 then invalid_arg "takebits"; (data, off, n) (*----------------------------------------------------------------------*) (* Bitwise functions. * * We try to isolate all bitwise functions within these modules. *) module I = struct (* Bitwise operations on ints. Note that we assume int <= 31 bits. *) external (<<<) : int -> int -> int = "%lslint" external (>>>) : int -> int -> int = "%lsrint" external to_int : int -> int = "%identity" let zero = 0 let one = 1 let minus_one = -1 let ff = 0xff (* Create a mask 0-31 bits wide. *) let mask bits = if bits < 30 || (bits < 32 && Sys.word_size = 64) then (one <<< bits) - 1 else if bits = 30 then max_int else if bits = 31 then minus_one else invalid_arg "Bitstring.I.mask" (* Byte swap an int of a given size. *) let byteswap v bits = if bits <= 8 then v else if bits <= 16 then ( let shift = bits-8 in let v1 = v >>> shift in let v2 = ((v land (mask shift)) <<< 8) in v2 lor v1 ) else if bits <= 24 then ( let shift = bits - 16 in let v1 = v >>> (8+shift) in let v2 = ((v >>> shift) land ff) <<< 8 in let v3 = (v land (mask shift)) <<< 16 in v3 lor v2 lor v1 ) else ( let shift = bits - 24 in let v1 = v >>> (16+shift) in let v2 = ((v >>> (8+shift)) land ff) <<< 8 in let v3 = ((v >>> shift) land ff) <<< 16 in let v4 = (v land (mask shift)) <<< 24 in v4 lor v3 lor v2 lor v1 ) (* Check a value is in range 0 .. 2^bits-1. *) let range_unsigned v bits = let mask = lnot (mask bits) in (v land mask) = zero let range_signed v bits = if v >= zero then range_unsigned v bits else if bits = 31 && Sys.word_size = 32 then v >= min_int else pred (minus_one <<< pred bits) < v (* Call function g on the top bits, then f on each full byte * (big endian - so start at top). *) let rec map_bytes_be g f v bits = if bits >= 8 then ( map_bytes_be g f (v >>> 8) (bits-8); let lsb = v land ff in f (to_int lsb) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) (* Call function g on the top bits, then f on each full byte * (little endian - so start at root). *) let rec map_bytes_le g f v bits = if bits >= 8 then ( let lsb = v land ff in f (to_int lsb); map_bytes_le g f (v >>> 8) (bits-8) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) end module I32 = struct (* Bitwise operations on int32s. Note we try to keep it as similar * as possible to the I module above, to make it easier to track * down bugs. *) let (<<<) = Int32.shift_left let (>>>) = Int32.shift_right_logical let (land) = Int32.logand let (lor) = Int32.logor let lnot = Int32.lognot let pred = Int32.pred let max_int = Int32.max_int let to_int = Int32.to_int let zero = Int32.zero let one = Int32.one let minus_one = Int32.minus_one let ff = 0xff_l (* Create a mask so many bits wide. *) let mask bits = if bits < 31 then pred (one <<< bits) else if bits = 31 then max_int else if bits = 32 then minus_one else invalid_arg "Bitstring.I32.mask" (* Byte swap an int of a given size. *) let byteswap v bits = if bits <= 8 then v else if bits <= 16 then ( let shift = bits-8 in let v1 = v >>> shift in let v2 = (v land (mask shift)) <<< 8 in v2 lor v1 ) else if bits <= 24 then ( let shift = bits - 16 in let v1 = v >>> (8+shift) in let v2 = ((v >>> shift) land ff) <<< 8 in let v3 = (v land (mask shift)) <<< 16 in v3 lor v2 lor v1 ) else ( let shift = bits - 24 in let v1 = v >>> (16+shift) in let v2 = ((v >>> (8+shift)) land ff) <<< 8 in let v3 = ((v >>> shift) land ff) <<< 16 in let v4 = (v land (mask shift)) <<< 24 in v4 lor v3 lor v2 lor v1 ) (* Check a value is in range 0 .. 2^bits-1. *) let range_unsigned v bits = let mask = lnot (mask bits) in (v land mask) = zero (* Call function g on the top bits, then f on each full byte * (big endian - so start at top). *) let rec map_bytes_be g f v bits = if bits >= 8 then ( map_bytes_be g f (v >>> 8) (bits-8); let lsb = v land ff in f (to_int lsb) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) (* Call function g on the top bits, then f on each full byte * (little endian - so start at root). *) let rec map_bytes_le g f v bits = if bits >= 8 then ( let lsb = v land ff in f (to_int lsb); map_bytes_le g f (v >>> 8) (bits-8) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) end module I64 = struct (* Bitwise operations on int64s. Note we try to keep it as similar * as possible to the I/I32 modules above, to make it easier to track * down bugs. *) let (<<<) = Int64.shift_left let (>>>) = Int64.shift_right_logical let (land) = Int64.logand let (lor) = Int64.logor let lnot = Int64.lognot let pred = Int64.pred let max_int = Int64.max_int let to_int = Int64.to_int let zero = Int64.zero let one = Int64.one let minus_one = Int64.minus_one let ff = 0xff_L (* Create a mask so many bits wide. *) let mask bits = if bits < 63 then pred (one <<< bits) else if bits = 63 then max_int else if bits = 64 then minus_one else invalid_arg "Bitstring.I64.mask" (* Byte swap an int of a given size. *) (* let byteswap v bits = *) (* Check a value is in range 0 .. 2^bits-1. *) let range_unsigned v bits = let mask = lnot (mask bits) in (v land mask) = zero (* Call function g on the top bits, then f on each full byte * (big endian - so start at top). *) let rec map_bytes_be g f v bits = if bits >= 8 then ( map_bytes_be g f (v >>> 8) (bits-8); let lsb = v land ff in f (to_int lsb) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) (* Call function g on the top bits, then f on each full byte * (little endian - so start at root). *) let rec map_bytes_le g f v bits = if bits >= 8 then ( let lsb = v land ff in f (to_int lsb); map_bytes_le g f (v >>> 8) (bits-8) ) else if bits > 0 then ( let lsb = v land (mask bits) in g (to_int lsb) bits ) end (*----------------------------------------------------------------------*) (* Extraction functions. * * NB: internal functions, called from the generated macros, and * the parameters should have been checked for sanity already). *) (* Extract and convert to numeric. A single bit is returned as * a boolean. There are no endianness or signedness considerations. *) let extract_bit data off len _ = (* final param is always 1 *) let byteoff = off lsr 3 in let bitmask = 1 lsl (7 - (off land 7)) in let b = Char.code (Bytes.get data byteoff) land bitmask <> 0 in b (*, off+1, len-1*) (* Returns 8 bit unsigned aligned bytes from the string. * If the string ends then this returns 0's. *) let _get_byte data byteoff strlen = if strlen > byteoff then Char.code (Bytes.get data byteoff) else 0 let _get_byte32 data byteoff strlen = if strlen > byteoff then Int32.of_int (Char.code (Bytes.get data byteoff)) else 0l let _get_byte64 data byteoff strlen = if strlen > byteoff then Int64.of_int (Char.code (Bytes.get data byteoff)) else 0L (* Extend signed [2..31] bits int to 31 bits int or 63 bits int for 64 bits platform*) let extend_sign len v = let b = pred Sys.word_size - len in (v lsl b) asr b let extract_and_extend_sign f data off len flen = let w = f data off len flen in extend_sign flen w (* Extract [2..8] bits. Because the result fits into a single * byte we don't have to worry about endianness, only signedness. *) let extract_char_unsigned data off len flen = let byteoff = off lsr 3 in (* Optimize the common (byte-aligned) case. *) if off land 7 = 0 then ( let byte = Char.code (Bytes.get data byteoff) in byte lsr (8 - flen) (*, off+flen, len-flen*) ) else ( (* Extract the 16 bits at byteoff and byteoff+1 (note that the * second byte might not exist in the original string). *) let strlen = Bytes.length data in let word = (_get_byte data byteoff strlen lsl 8) + _get_byte data (byteoff+1) strlen in (* Mask off the top bits. *) let bitmask = (1 lsl (16 - (off land 7))) - 1 in let word = word land bitmask in (* Shift right to get rid of the bottom bits. *) let shift = 16 - ((off land 7) + flen) in let word = word lsr shift in word (*, off+flen, len-flen*) ) let extract_char_signed = extract_and_extend_sign extract_char_unsigned (* Extract [9..31] bits. We have to consider endianness and signedness. *) let extract_int_be_unsigned data off len flen = let byteoff = off lsr 3 in let strlen = Bytes.length data in let word = (* Optimize the common (byte-aligned) case. *) if off land 7 = 0 then ( let word = (_get_byte data byteoff strlen lsl 23) + (_get_byte data (byteoff+1) strlen lsl 15) + (_get_byte data (byteoff+2) strlen lsl 7) + (_get_byte data (byteoff+3) strlen lsr 1) in word lsr (31 - flen) ) else if flen <= 24 then ( (* Extract the 31 bits at byteoff .. byteoff+3. *) let word = (_get_byte data byteoff strlen lsl 23) + (_get_byte data (byteoff+1) strlen lsl 15) + (_get_byte data (byteoff+2) strlen lsl 7) + (_get_byte data (byteoff+3) strlen lsr 1) in (* Mask off the top bits. *) let bitmask = (1 lsl (31 - (off land 7))) - 1 in let word = word land bitmask in (* Shift right to get rid of the bottom bits. *) let shift = 31 - ((off land 7) + flen) in word lsr shift ) else ( (* Extract the next 31 bits, slow method. *) let word = let c0 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c1 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c2 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c3 = extract_char_unsigned data off len 7 in (c0 lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in word lsr (31 - flen) ) in word (*, off+flen, len-flen*) let extract_int_be_signed = extract_and_extend_sign extract_int_be_unsigned let extract_int_le_unsigned data off len flen = let v = extract_int_be_unsigned data off len flen in let v = I.byteswap v flen in v let extract_int_le_signed = extract_and_extend_sign extract_int_le_unsigned let extract_int_ne_unsigned = if nativeendian = BigEndian then extract_int_be_unsigned else extract_int_le_unsigned let extract_int_ne_signed = extract_and_extend_sign extract_int_ne_unsigned let extract_int_ee_unsigned = function | BigEndian -> extract_int_be_unsigned | LittleEndian -> extract_int_le_unsigned | NativeEndian -> extract_int_ne_unsigned let extract_int_ee_signed e = extract_and_extend_sign (extract_int_ee_unsigned e) let _make_int32_be c0 c1 c2 c3 = Int32.logor (Int32.logor (Int32.logor (Int32.shift_left c0 24) (Int32.shift_left c1 16)) (Int32.shift_left c2 8)) c3 let _make_int32_le c0 c1 c2 c3 = Int32.logor (Int32.logor (Int32.logor (Int32.shift_left c3 24) (Int32.shift_left c2 16)) (Int32.shift_left c1 8)) c0 (* Extract exactly 32 bits. We have to consider endianness and signedness. *) let extract_int32_be_unsigned data off len flen = let byteoff = off lsr 3 in let strlen = Bytes.length data in let word = (* Optimize the common (byte-aligned) case. *) if off land 7 = 0 then ( let word = let c0 = _get_byte32 data byteoff strlen in let c1 = _get_byte32 data (byteoff+1) strlen in let c2 = _get_byte32 data (byteoff+2) strlen in let c3 = _get_byte32 data (byteoff+3) strlen in _make_int32_be c0 c1 c2 c3 in Int32.shift_right_logical word (32 - flen) ) else ( (* Extract the next 32 bits, slow method. *) let word = let c0 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c1 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c2 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c3 = extract_char_unsigned data off len 8 in let c0 = Int32.of_int c0 in let c1 = Int32.of_int c1 in let c2 = Int32.of_int c2 in let c3 = Int32.of_int c3 in _make_int32_be c0 c1 c2 c3 in Int32.shift_right_logical word (32 - flen) ) in word (*, off+flen, len-flen*) let extract_int32_le_unsigned data off len flen = let v = extract_int32_be_unsigned data off len flen in let v = I32.byteswap v flen in v let extract_int32_ne_unsigned = if nativeendian = BigEndian then extract_int32_be_unsigned else extract_int32_le_unsigned let extract_int32_ee_unsigned = function | BigEndian -> extract_int32_be_unsigned | LittleEndian -> extract_int32_le_unsigned | NativeEndian -> extract_int32_ne_unsigned let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 = Int64.logor (Int64.logor (Int64.logor (Int64.logor (Int64.logor (Int64.logor (Int64.logor (Int64.shift_left c0 56) (Int64.shift_left c1 48)) (Int64.shift_left c2 40)) (Int64.shift_left c3 32)) (Int64.shift_left c4 24)) (Int64.shift_left c5 16)) (Int64.shift_left c6 8)) c7 let _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 = _make_int64_be c7 c6 c5 c4 c3 c2 c1 c0 (* Extract [1..64] bits. We have to consider endianness and signedness. *) let extract_int64_be_unsigned data off len flen = let byteoff = off lsr 3 in let strlen = Bytes.length data in let word = (* Optimize the common (byte-aligned) case. *) if off land 7 = 0 then ( let word = let c0 = _get_byte64 data byteoff strlen in let c1 = _get_byte64 data (byteoff+1) strlen in let c2 = _get_byte64 data (byteoff+2) strlen in let c3 = _get_byte64 data (byteoff+3) strlen in let c4 = _get_byte64 data (byteoff+4) strlen in let c5 = _get_byte64 data (byteoff+5) strlen in let c6 = _get_byte64 data (byteoff+6) strlen in let c7 = _get_byte64 data (byteoff+7) strlen in _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in Int64.shift_right_logical word (64 - flen) ) else ( (* Extract the next 64 bits, slow method. *) let word = let c0 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c1 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c2 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c3 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c4 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c5 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c6 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c7 = extract_char_unsigned data off len 8 in let c0 = Int64.of_int c0 in let c1 = Int64.of_int c1 in let c2 = Int64.of_int c2 in let c3 = Int64.of_int c3 in let c4 = Int64.of_int c4 in let c5 = Int64.of_int c5 in let c6 = Int64.of_int c6 in let c7 = Int64.of_int c7 in _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in Int64.shift_right_logical word (64 - flen) ) in word (*, off+flen, len-flen*) let extract_int64_le_unsigned data off len flen = let byteoff = off lsr 3 in let strlen = Bytes.length data in let word = (* Optimize the common (byte-aligned) case. *) if off land 7 = 0 then ( let word = let c0 = _get_byte64 data byteoff strlen in let c1 = _get_byte64 data (byteoff+1) strlen in let c2 = _get_byte64 data (byteoff+2) strlen in let c3 = _get_byte64 data (byteoff+3) strlen in let c4 = _get_byte64 data (byteoff+4) strlen in let c5 = _get_byte64 data (byteoff+5) strlen in let c6 = _get_byte64 data (byteoff+6) strlen in let c7 = _get_byte64 data (byteoff+7) strlen in _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in Int64.logand word (I64.mask flen) ) else ( (* Extract the next 64 bits, slow method. *) let word = let c0 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c1 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c2 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c3 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c4 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c5 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c6 = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in let c7 = extract_char_unsigned data off len 8 in let c0 = Int64.of_int c0 in let c1 = Int64.of_int c1 in let c2 = Int64.of_int c2 in let c3 = Int64.of_int c3 in let c4 = Int64.of_int c4 in let c5 = Int64.of_int c5 in let c6 = Int64.of_int c6 in let c7 = Int64.of_int c7 in _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in Int64.logand word (I64.mask flen) ) in word (*, off+flen, len-flen*) let extract_int64_ne_unsigned = if nativeendian = BigEndian then extract_int64_be_unsigned else extract_int64_le_unsigned let extract_int64_ee_unsigned = function | BigEndian -> extract_int64_be_unsigned | LittleEndian -> extract_int64_le_unsigned | NativeEndian -> extract_int64_ne_unsigned external extract_fastpath_int16_be_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" external extract_fastpath_int16_le_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" external extract_fastpath_int16_ne_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" external extract_fastpath_int16_be_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" external extract_fastpath_int16_le_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" external extract_fastpath_int16_ne_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" (* external extract_fastpath_int24_be_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" external extract_fastpath_int24_le_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" external extract_fastpath_int24_ne_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" external extract_fastpath_int24_be_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" external extract_fastpath_int24_le_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" external extract_fastpath_int24_ne_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" *) external extract_fastpath_int32_be_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" external extract_fastpath_int32_le_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" external extract_fastpath_int32_ne_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" external extract_fastpath_int32_be_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" external extract_fastpath_int32_le_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" external extract_fastpath_int32_ne_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" (* external extract_fastpath_int40_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" external extract_fastpath_int40_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" external extract_fastpath_int40_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" external extract_fastpath_int40_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" external extract_fastpath_int40_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" external extract_fastpath_int40_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" external extract_fastpath_int48_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" external extract_fastpath_int48_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" external extract_fastpath_int48_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" external extract_fastpath_int48_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" external extract_fastpath_int48_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" external extract_fastpath_int48_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" external extract_fastpath_int56_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" external extract_fastpath_int56_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" external extract_fastpath_int56_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" external extract_fastpath_int56_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" external extract_fastpath_int56_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" external extract_fastpath_int56_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" *) external extract_fastpath_int64_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" external extract_fastpath_int64_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" external extract_fastpath_int64_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" external extract_fastpath_int64_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" external extract_fastpath_int64_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" external extract_fastpath_int64_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" (*----------------------------------------------------------------------*) (* Constructor functions. *) module Buffer = struct type t = { buf : Buffer.t; mutable len : int; (* Length in bits. *) (* Last byte in the buffer (if len is not aligned). We store * it outside the buffer because buffers aren't mutable. *) mutable last : int; } let create () = (* XXX We have almost enough information in the generator to * choose a good initial size. *) { buf = Buffer.create 128; len = 0; last = 0 } let contents { buf = buf; len = len; last = last } = let data = if len land 7 = 0 then Buffer.to_bytes buf else Bytes.cat (Buffer.to_bytes buf) (Bytes.make 1 (Char.chr last)) in data, 0, len (* Add exactly 8 bits. *) let add_byte t byte = let {buf; len; last} = t in if byte < 0 || byte > 255 then invalid_arg "Bitstring.Buffer.add_byte"; let shift = len land 7 in if shift = 0 then (* Target buffer is byte-aligned. *) Buffer.add_char buf (Char.chr byte) else ( (* Target buffer is unaligned. 'last' is meaningful. *) let first = byte lsr shift in let second = (byte lsl (8 - shift)) land 0xff in Buffer.add_char buf (Char.chr (last lor first)); t.last <- second ); t.len <- t.len + 8 (* Add exactly 1 bit. *) let add_bit t bit = let {buf; len; last} = t in let shift = 7 - (len land 7) in if shift > 0 then (* Somewhere in the middle of 'last'. *) t.last <- last lor ((if bit then 1 else 0) lsl shift) else ( (* Just a single spare bit in 'last'. *) let last = last lor if bit then 1 else 0 in Buffer.add_char buf (Char.chr last); t.last <- 0 ); t.len <- len + 1 (* Add a small number of bits (definitely < 8). This uses a loop * to call add_bit so it's slow. *) let _add_bits t c slen = if slen < 1 || slen >= 8 then invalid_arg "Bitstring.Buffer._add_bits"; for i = slen-1 downto 0 do let bit = c land (1 lsl i) <> 0 in add_bit t bit done let add_bits t str slen = let {buf; len; _} = t in if slen > 0 then ( if len land 7 = 0 then ( if slen land 7 = 0 then (* Common case - everything is byte-aligned. *) Buffer.add_subbytes buf str 0 (slen lsr 3) else ( (* Target buffer is aligned. Copy whole bytes then leave the * remaining bits in last. *) let slenbytes = slen lsr 3 in if slenbytes > 0 then Buffer.add_subbytes buf str 0 slenbytes; let lastidx = min slenbytes (Bytes.length str - 1) in let last = Char.code (Bytes.get str lastidx) in (* last char *) let mask = 0xff lsl (8 - (slen land 7)) in t.last <- last land mask ); t.len <- len + slen ) else ( (* Target buffer is unaligned. Copy whole bytes using * add_byte which knows how to deal with an unaligned * target buffer, then call add_bit for the remaining < 8 bits. * * XXX This is going to be dog-slow. *) let slenbytes = slen lsr 3 in for i = 0 to slenbytes-1 do let byte = Char.code (Bytes.get str i) in add_byte t byte done; let bitsleft = slen - (slenbytes lsl 3) in if bitsleft > 0 then ( let c = Char.code (Bytes.get str slenbytes) in for i = 0 to bitsleft - 1 do let bit = c land (0x80 lsr i) <> 0 in add_bit t bit done ) ); ) end (* Construct a single bit. *) let construct_bit buf b _ _ = Buffer.add_bit buf b (* Construct a field, flen = [2..8]. *) let construct_char_unsigned buf v flen exn = let max_val = 1 lsl flen in if v < 0 || v >= max_val then raise exn; if flen = 8 then Buffer.add_byte buf v else Buffer._add_bits buf v flen let construct_char_signed buf v flen exn = let max_val = 1 lsl flen and min_val = - (1 lsl pred flen) in if v < min_val || v >= max_val then raise exn; if flen = 8 then Buffer.add_byte buf (if v >= 0 then v else 256 + v) else Buffer._add_bits buf v flen (* Construct a field of up to 31 bits. *) let construct_int check_func map_func buf v flen exn = if not (check_func v flen) then raise exn; map_func (Buffer._add_bits buf) (Buffer.add_byte buf) v flen let construct_int_be_unsigned = construct_int I.range_unsigned I.map_bytes_be let construct_int_be_signed = construct_int I.range_signed I.map_bytes_be let construct_int_le_unsigned = construct_int I.range_unsigned I.map_bytes_le let construct_int_le_signed = construct_int I.range_signed I.map_bytes_le let construct_int_ne_unsigned = if nativeendian = BigEndian then construct_int_be_unsigned else construct_int_le_unsigned let construct_int_ne_signed = if nativeendian = BigEndian then construct_int_be_signed else construct_int_le_signed let construct_int_ee_unsigned = function | BigEndian -> construct_int_be_unsigned | LittleEndian -> construct_int_le_unsigned | NativeEndian -> construct_int_ne_unsigned let construct_int_ee_signed = function | BigEndian -> construct_int_be_signed | LittleEndian -> construct_int_le_signed | NativeEndian -> construct_int_ne_signed (* Construct a field of exactly 32 bits. *) let construct_int32_be_unsigned buf v flen _ = Buffer.add_byte buf (Int32.to_int (Int32.shift_right_logical v 24)); Buffer.add_byte buf (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l))); Buffer.add_byte buf (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l))); Buffer.add_byte buf (Int32.to_int (Int32.logand v 0xff_l)) let construct_int32_le_unsigned buf v flen _ = Buffer.add_byte buf (Int32.to_int (Int32.logand v 0xff_l)); Buffer.add_byte buf (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l))); Buffer.add_byte buf (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l))); Buffer.add_byte buf (Int32.to_int (Int32.shift_right_logical v 24)) let construct_int32_ne_unsigned = if nativeendian = BigEndian then construct_int32_be_unsigned else construct_int32_le_unsigned let construct_int32_ee_unsigned = function | BigEndian -> construct_int32_be_unsigned | LittleEndian -> construct_int32_le_unsigned | NativeEndian -> construct_int32_ne_unsigned (* Construct a field of up to 64 bits. *) let construct_int64_be_unsigned buf v flen exn = (* Check value is within range. *) if not (I64.range_unsigned v flen) then raise exn; (* Add the bytes. *) I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen (* Construct a field of up to 64 bits. *) let construct_int64_le_unsigned buf v flen exn = (* Check value is within range. *) if not (I64.range_unsigned v flen) then raise exn; (* Add the bytes. *) I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen let construct_int64_ne_unsigned = if nativeendian = BigEndian then construct_int64_be_unsigned else construct_int64_le_unsigned let construct_int64_ee_unsigned = function | BigEndian -> construct_int64_be_unsigned | LittleEndian -> construct_int64_le_unsigned | NativeEndian -> construct_int64_ne_unsigned (* Construct from a string of bytes, exact multiple of 8 bits * in length of course. *) let construct_string buf str = let len = String.length str in Buffer.add_bits buf (Bytes.unsafe_of_string str) (len lsl 3) (* Construct from a bitstring. *) let construct_bitstring buf (data, off, len) = (* Add individual bits until we get to the next byte boundary of * the underlying string. *) let blen = 7 - ((off + 7) land 7) in let blen = min blen len in let rec loop off len blen = if blen = 0 then (off, len) else ( let b = extract_bit data off len 1 and off = off + 1 and len = len - 1 in Buffer.add_bit buf b; loop off len (blen-1) ) in let off, len = loop off len blen in assert (len = 0 || (off land 7) = 0); (* Add the remaining 'len' bits. *) let data = let off = off lsr 3 in (* XXX dangerous allocation *) if off = 0 then data else Bytes.sub data off (Bytes.length data - off) in Buffer.add_bits buf data len (* Concatenate bitstrings. *) let concat bs = let buf = Buffer.create () in List.iter (construct_bitstring buf) bs; Buffer.contents buf (*----------------------------------------------------------------------*) (* Extract a string from a bitstring. *) let string_of_bitstring (data, off, len) = if off land 7 = 0 && len land 7 = 0 then (* Easy case: everything is byte-aligned. *) String.sub (Bytes.unsafe_to_string data) (off lsr 3) (len lsr 3) else ( (* Bit-twiddling case. *) let strlen = (len + 7) lsr 3 in let str = Bytes.make strlen '\000' in let rec loop data off len i = if len >= 8 then ( let c = extract_char_unsigned data off len 8 and off = off + 8 and len = len - 8 in Bytes.set str i (Char.chr c); loop data off len (i+1) ) else if len > 0 then ( let c = extract_char_unsigned data off len len in Bytes.set str i (Char.chr (c lsl (8-len))) ) in loop data off len 0; Bytes.unsafe_to_string str ) (* To channel. *) let bitstring_to_chan ((data, off, len) as bits) chan = (* Fail if the bitstring length isn't a multiple of 8. *) if len land 7 <> 0 then invalid_arg "bitstring_to_chan"; if off land 7 = 0 then (* Easy case: string is byte-aligned. *) output chan data (off lsr 3) (len lsr 3) else ( (* Bit-twiddling case: reuse string_of_bitstring *) let str = string_of_bitstring bits in output_string chan str ) let bitstring_to_file bits filename = let chan = open_out_bin filename in try bitstring_to_chan bits chan; close_out chan with exn -> close_out chan; raise exn (*----------------------------------------------------------------------*) (* Comparison. *) let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) = (* In the fully-aligned case, this is reduced to string comparison ... *) if off1 land 7 = 0 && len1 land 7 = 0 && off2 land 7 = 0 && len2 land 7 = 0 then ( (* ... but we have to do that by hand because the bits may * not extend to the full length of the underlying string. *) let off1 = off1 lsr 3 and off2 = off2 lsr 3 and len1 = len1 lsr 3 and len2 = len2 lsr 3 in let rec loop i = if i < len1 && i < len2 then ( let c1 = Bytes.unsafe_get data1 (off1 + i) and c2 = Bytes.unsafe_get data2 (off2 + i) in let r = compare c1 c2 in if r <> 0 then r else loop (i+1) ) else len1 - len2 in loop 0 ) else ( (* Slow/unaligned. *) let str1 = string_of_bitstring bs1 and str2 = string_of_bitstring bs2 in let r = String.compare str1 str2 in if r <> 0 then r else len1 - len2 ) let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) = if len1 <> len2 then false else if bs1 = bs2 then true else 0 = compare bs1 bs2 let is_zeroes_bitstring ((data, off, len) as bits) = if off land 7 = 0 && len land 7 = 0 then ( let off = off lsr 3 and len = len lsr 3 in let rec loop i = if i < len then ( if Bytes.unsafe_get data (off + i) <> '\000' then false else loop (i+1) ) else true in loop 0 ) else ( (* Slow/unaligned case. *) let len = bitstring_length bits in let zeroes = zeroes_bitstring len in 0 = compare bits zeroes ) let is_ones_bitstring ((data, off, len) as bits) = if off land 7 = 0 && len land 7 = 0 then ( let off = off lsr 3 and len = len lsr 3 in let rec loop i = if i < len then ( if Bytes.unsafe_get data (off + i) <> '\xff' then false else loop (i+1) ) else true in loop 0 ) else ( (* Slow/unaligned case. *) let len = bitstring_length bits in let ones = ones_bitstring len in 0 = compare bits ones ) external is_prefix_fastpath: bytes -> int -> bytes -> int -> int -> bool = "ocaml_bitstring_is_prefix_fastpath" let is_prefix ((b1, o1, l1) as bs1) ((b2, o2, l2) as bs2) = (* Fail if either bitstring is invalid *) if l2 > l1 || l1 = 0 || l2 = 0 then false (* Use the fast path if the bitstrings are aligned *) else if o1 land 7 = o2 land 7 then is_prefix_fastpath b1 o1 b2 o2 l2 (* Bitstrings are unaligned *) else let re = Str.regexp_string (string_of_bitstring bs2) in Str.string_partial_match re (string_of_bitstring bs1) 0 (*----------------------------------------------------------------------*) (* Bit get/set functions. *) let index_out_of_bounds () = invalid_arg "index out of bounds" let put (data, off, len) n v = if n < 0 || n >= len then index_out_of_bounds () else ( let i = off+n in let si = i lsr 3 and mask = 0x80 lsr (i land 7) in let c = Char.code (Bytes.get data si) in let c = if v <> 0 then c lor mask else c land (lnot mask) in Bytes.set data si (Char.unsafe_chr c) ) let set bits n = put bits n 1 let clear bits n = put bits n 0 let get (data, off, len) n = if n < 0 || n >= len then index_out_of_bounds () else ( let i = off+n in let si = i lsr 3 and mask = 0x80 lsr (i land 7) in let c = Char.code (Bytes.get data si) in c land mask ) let is_set bits n = get bits n <> 0 let is_clear bits n = get bits n = 0 (*----------------------------------------------------------------------*) (* Display functions. *) let isprint c = let c = Char.code c in c >= 32 && c < 127 let hexdump_bitstring chan (data, off, len) = let count = ref 0 in let off = ref off in let len = ref len in let linelen = ref 0 in let linechars = Bytes.make 16 ' ' in fprintf chan "00000000 "; while !len > 0 do let bits = min !len 8 in let byte = extract_char_unsigned data !off !len bits in off := !off + bits; len := !len - bits; let byte = byte lsl (8-bits) in fprintf chan "%02x " byte; incr count; Bytes.set linechars !linelen (let c = Char.chr byte in if isprint c then c else '.'); incr linelen; if !linelen = 8 then fprintf chan " "; if !linelen = 16 then ( fprintf chan " |%s|\n%08x " (Bytes.unsafe_to_string linechars) !count; linelen := 0; for i = 0 to 15 do Bytes.set linechars i ' ' done ) done; if !linelen > 0 then ( let skip = (16 - !linelen) * 3 + if !linelen < 8 then 1 else 0 in for _ = 0 to skip-1 do fprintf chan " " done; fprintf chan " |%s|\n%!" (Bytes.unsafe_to_string linechars) ) else fprintf chan "\n%!" (*----------------------------------------------------------------------*) (* Alias of functions shadowed by Core. *) let char_code = Char.code let int32_of_int = Int32.of_int bitstring-4.1.1/src/bitstring.mli000066400000000000000000001167651431112327400170370ustar00rootroot00000000000000(* * Bitstring library. * * Copyright (C) 2008-2016 Red Hat Inc., Richard W.M. Jones * Copyright (C) 2016 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version, * with the OCaml linking exception described in COPYING.LIB. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** {{:#reference}Jump straight to the reference section for documentation on types and functions}. {2 Introduction} Bitstring adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. You can use this module to both parse and generate binary formats, for example, communications protocols, disk formats and binary files. {{:http://code.google.com/p/bitstring/}OCaml bitstring website} This library used to be called "bitmatch". {2 Examples} A function which can parse IPv4 packets: {[ let display pkt = bitmatch pkt with (* IPv4 packet header 0 1 2 3 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | 4 | IHL |Type of Service| Total Length | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Identification |Flags| Fragment Offset | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Time to Live | Protocol | Header Checksum | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Source Address | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Destination Address | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Options | Padding | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ *) | { 4 : 4; hdrlen : 4; tos : 8; length : 16; identification : 16; flags : 3; fragoffset : 13; ttl : 8; protocol : 8; checksum : 16; source : 32; dest : 32; options : (hdrlen-5)*32 : bitstring; payload : -1 : bitstring } -> printf "IPv4:\n"; printf " header length: %d * 32 bit words\n" hdrlen; printf " type of service: %d\n" tos; printf " packet length: %d bytes\n" length; printf " identification: %d\n" identification; printf " flags: %d\n" flags; printf " fragment offset: %d\n" fragoffset; printf " ttl: %d\n" ttl; printf " protocol: %d\n" protocol; printf " checksum: %d\n" checksum; printf " source: %lx dest: %lx\n" source dest; printf " header options + padding:\n"; Bitstring.hexdump_bitstring stdout options; printf " packet payload:\n"; Bitstring.hexdump_bitstring stdout payload | { version : 4 } -> eprintf "unknown IP version %d\n" version; exit 1 | { _ } as pkt -> eprintf "data is smaller than one nibble:\n"; Bitstring.hexdump_bitstring stderr pkt; exit 1 ]} A program which can parse {{:http://lxr.linux.no/linux/include/linux/ext3_fs.h}Linux EXT3 filesystem superblocks}: {[ let bits = Bitstring.bitstring_of_file "tests/ext3_sb" let () = bitmatch bits with | { s_inodes_count : 32 : littleendian; (* Inodes count *) s_blocks_count : 32 : littleendian; (* Blocks count *) s_r_blocks_count : 32 : littleendian; (* Reserved blocks count *) s_free_blocks_count : 32 : littleendian; (* Free blocks count *) s_free_inodes_count : 32 : littleendian; (* Free inodes count *) s_first_data_block : 32 : littleendian; (* First Data Block *) s_log_block_size : 32 : littleendian; (* Block size *) s_log_frag_size : 32 : littleendian; (* Fragment size *) s_blocks_per_group : 32 : littleendian; (* # Blocks per group *) s_frags_per_group : 32 : littleendian; (* # Fragments per group *) s_inodes_per_group : 32 : littleendian; (* # Inodes per group *) s_mtime : 32 : littleendian; (* Mount time *) s_wtime : 32 : littleendian; (* Write time *) s_mnt_count : 16 : littleendian; (* Mount count *) s_max_mnt_count : 16 : littleendian; (* Maximal mount count *) 0xef53 : 16 : littleendian } -> (* Magic signature *) printf "ext3 superblock:\n"; printf " s_inodes_count = %ld\n" s_inodes_count; printf " s_blocks_count = %ld\n" s_blocks_count; printf " s_free_inodes_count = %ld\n" s_free_inodes_count; printf " s_free_blocks_count = %ld\n" s_free_blocks_count | { _ } -> eprintf "not an ext3 superblock!\n%!"; exit 2 ]} Constructing packets for a simple binary message protocol: {[ (* +---------------+---------------+--------------------------+ | type | subtype | parameter | +---------------+---------------+--------------------------+ <-- 16 bits --> <-- 16 bits --> <------- 32 bits --------> All fields are in network byte order. *) let make_message typ subtype param = (BITSTRING { typ : 16; subtype : 16; param : 32 }) ;; ]} {2 Loading, creating bitstrings} The basic data type is the {!bitstring}, a string of bits of arbitrary length. Bitstrings can be any length in bits and operations do not need to be byte-aligned (although they will generally be more efficient if they are byte-aligned). Internally a bitstring is stored as a normal OCaml [string] together with an offset and length, where the offset and length are measured in bits. Thus one can efficiently form substrings of bitstrings, overlay a bitstring on existing data, and load and save bitstrings from files or other external sources. To load a bitstring from a file use {!bitstring_of_file} or {!bitstring_of_chan}. There are also functions to create bitstrings from arbitrary data. See the {{:#reference}reference} below. {2 Matching bitstrings with patterns} Use the [bitmatch] operator (part of the syntax extension) to break apart a bitstring into its fields. [bitmatch] works a lot like the OCaml [match] operator. The general form of [bitmatch] is: [bitmatch] {i bitstring-expression} [with] [| {] {i pattern} [} ->] {i code} [| {] {i pattern} [} ->] {i code} [|] ... As with normal match, the statement attempts to match the bitstring against each pattern in turn. If none of the patterns match then the standard library [Match_failure] exception is thrown. Patterns look a bit different from normal match patterns. They consist of a list of bitfields separated by [;] where each bitfield contains a bind variable, the width (in bits) of the field, and other information. Some example patterns: {[ bitmatch bits with | { version : 8; name : 8; param : 8 } -> ... (* Bitstring of at least 3 bytes. First byte is the version number, second byte is a field called name, third byte is a field called parameter. *) | { flag : 1 } -> printf "flag is %b\n" flag (* A single flag bit (mapped into an OCaml boolean). *) | { len : 4; data : 1+len } -> printf "len = %d, data = 0x%Lx\n" len data (* A 4-bit length, followed by 1-16 bits of data, where the length of the data is computed from len. *) | { ipv6_source : 128 : bitstring; ipv6_dest : 128 : bitstring } -> ... (* IPv6 source and destination addresses. Each is 128 bits and is mapped into a bitstring type which will be a substring of the main bitstring expression. *) ]} You can also add conditional when-clauses: {[ | { version : 4 } when version = 4 || version = 6 -> ... (* Only match and run the code when version is 4 or 6. If it isn't we will drop through to the next case. *) ]} Note that the pattern is only compared against the first part of the bitstring (there may be more data in the bitstring following the pattern, which is not matched). In terms of regular expressions you might say that the pattern matches [^pattern], not [^pattern$]. To ensure that the bitstring contains only the pattern, add a length -1 bitstring to the end and test that its length is zero in the when-clause: {[ | { n : 4; rest : -1 : bitstring } when Bitstring.bitstring_length rest = 0 -> ... (* Only matches exactly 4 bits. *) ]} Normally the first part of each field is a binding variable, but you can also match a constant, as in: {[ | { (4|6) : 4 } -> ... (* Only matches if the first 4 bits contain either the integer 4 or the integer 6. *) ]} One may also match on strings: {[ | { "MAGIC" : 5*8 : string } -> ... (* Only matches if the string "MAGIC" appears at the start of the input. *) ]} {3:patternfieldreference Pattern field reference} The exact format of each pattern field is: [pattern : length [: qualifier [,qualifier ...]]] [pattern] is the pattern, binding variable name, or constant to match. [length] is the length in bits which may be either a constant or an expression. The length expression is just an OCaml expression and can use any values defined in the program, and refer back to earlier fields (but not to later fields). Integers can only have lengths in the range \[1..64\] bits. See the {{:#integertypes}integer types} section below for how these are mapped to the OCaml int/int32/int64 types. This is checked at compile time if the length expression is constant, otherwise it is checked at runtime and you will get a runtime exception eg. in the case of a computed length expression. A bitstring field of length -1 matches all the rest of the bitstring (thus this is only useful as the last field in a pattern). A bitstring field of length 0 matches an empty bitstring (occasionally useful when matching optional subfields). Qualifiers are a list of identifiers/expressions which control the type, signedness and endianness of the field. Permissible qualifiers are: - [int]: field has an integer type - [string]: field is a string type - [bitstring]: field is a bitstring type - [signed]: field is signed - [unsigned]: field is unsigned - [bigendian]: field is big endian - a.k.a network byte order - [littleendian]: field is little endian - a.k.a Intel byte order - [nativeendian]: field is same endianness as the machine - [endian (expr)]: [expr] should be an expression which evaluates to a {!endian} type, ie. [LittleEndian], [BigEndian] or [NativeEndian]. The expression is an arbitrary OCaml expression and can use the value of earlier fields in the bitmatch. - [offset (expr)]: see {{:#computedoffsets}computed offsets} below. The default settings are [int], [unsigned], [bigendian], no offset. Note that many of these qualifiers cannot be used together, eg. bitstrings do not have endianness. The syntax extension should give you a compile-time error if you use incompatible qualifiers. {3 Other cases in bitmatch} As well as a list of fields, it is possible to name the bitstring and/or have a default match case: {[ | { _ } -> ... (* Default match case. *) | { _ } as pkt -> ... (* Default match case, with 'pkt' bound to the whole bitstring. *) ]} {2 Constructing bitstrings} Bitstrings may be constructed using the [BITSTRING] operator (as an expression). The [BITSTRING] operator takes a list of fields, similar to the list of fields for matching: {[ let version = 1 ;; let data = 10 ;; let bits = BITSTRING { version : 4; data : 12 } ;; (* Constructs a 16-bit bitstring with the first four bits containing the integer 1, and the following 12 bits containing the integer 10, arranged in network byte order. *) Bitstring.hexdump_bitstring stdout bits ;; (* Prints: 00000000 10 0a |.. | *) ]} The format of each field is the same as for pattern fields (see {{:#patternfieldreference}Pattern field reference section}), and things like computed length fields, fixed value fields, insertion of bitstrings within bitstrings, etc. are all supported. {3 Construction exception} The [BITSTRING] operator may throw a {!Construct_failure} exception at runtime. Runtime errors include: - int field length not in the range \[1..64\] - a bitstring with a length declared which doesn't have the same length at runtime - trying to insert an out of range value into an int field (eg. an unsigned int field which is 2 bits wide can only take values in the range \[0..3\]). {2:integertypes Integer types} Integer types are mapped to OCaml types [bool], [int], [int32] or [int64] using a system which tries to ensure that (a) the types are reasonably predictable and (b) the most efficient type is preferred. The rules are slightly different depending on whether the bit length expression in the field is a compile-time constant or a computed expression. Detection of compile-time constants is quite simplistic so only simple integer literals and simple expressions (eg. [5*8]) are recognized as constants. In any case the bit size of an integer is limited to the range \[1..64\]. This is detected as a compile-time error if that is possible, otherwise a runtime check is added which can throw an [Invalid_argument] exception. The mapping is thus: {v Bit size ---- OCaml type ---- Constant Computed expression 1 bool int64 2..31 int int64 32 int32 int64 33..64 int64 int64 v} A possible future extension may allow people with 64 bit computers to specify a more optimal [int] type for bit sizes in the range [32..63]. If this was implemented then such code {i could not even be compiled} on 32 bit platforms, so it would limit portability. Another future extension may be to allow computed expressions to assert min/max range for the bit size, allowing a more efficient data type than int64 to be used. (Of course under such circumstances there would still need to be a runtime check to enforce the size). {2 Advanced pattern-matching features} {3:computedoffsets Computed offsets} You can add an [offset(..)] qualifier to bitmatch patterns in order to move the current offset within the bitstring forwards. For example: {[ bitmatch bits with | { field1 : 8; field2 : 8 : offset(160) } -> ... ]} matches [field1] at the start of the bitstring and [field2] at 160 bits into the bitstring. The middle 152 bits go unmatched (ie. can be anything). The generated code is efficient. If field lengths and offsets are known to be constant at compile time, then almost all runtime checks are avoided. Non-constant field lengths and/or non-constant offsets can result in more runtime checks being added. Note that moving the offset backwards, and moving the offset in [BITSTRING] constructors, are both not supported at present. {3 Check expressions} You can add a [check(expr)] qualifier to bitmatch patterns. If the expression evaluates to false then the current match case fails to match (in other words, we fall through to the next match case - there is no error). For example: {[ bitmatch bits with | { field : 16 : check (field > 100) } -> ... ]} Note the difference between a check expression and a when-clause is that the when-clause is evaluated after all the fields have been matched. On the other hand a check expression is evaluated after the individual field has been matched, which means it is potentially more efficient (if the check expression fails then we don't waste any time matching later fields). We wanted to use the notation [when(expr)] here, but because [when] is a reserved word we could not do this. {3 Bind expressions} A bind expression is used to change the value of a matched field. For example: {[ bitmatch bits with | { len : 16 : bind (len * 8); field : len : bitstring } -> ... ]} In the example, after 'len' has been matched, its value would be multiplied by 8, so the width of 'field' is the matched value multiplied by 8. In the general case: {[ | { field : ... : bind (expr) } -> ... ]} evaluates the following after the field has been matched: {[ let field = expr in (* remaining fields *) ]} {3 Order of evaluation of check() and bind()} The choice is arbitrary, but we have chosen that check expressions are evaluated first, and bind expressions are evaluated after. This means that the result of bind() is {i not} available in the check expression. Note that this rule applies regardless of the order of check() and bind() in the source code. {3 save_offset_to} Use [save_offset_to(variable)] to save the current bit offset within the match to a variable (strictly speaking, to a pattern). This variable is then made available in any [check()] and [bind()] clauses in the current field, {i and} to any later fields, and to the code after the [->]. For example: {[ bitmatch bits with | { len : 16; _ : len : bitstring; field : 16 : save_offset_to (field_offset) } -> printf "field is at bit offset %d in the match\n" field_offset ]} (In that example, [field_offset] should always have the value [len+16]). {2 Named patterns and persistent patterns} Please see {!Bitstring_persistent} for documentation on this subject. {2 Compiling} Using the compiler directly you can do: {v ocamlc -I +bitstring \ -pp "camlp4of bitstring.cma bitstring_persistent.cma \ `ocamlc -where`/bitstring/pa_bitstring.cmo" \ unix.cma bitstring.cma test.ml -o test v} Simpler method using findlib: {v ocamlfind ocamlc \ -package bitstring,bitstring.syntax -syntax bitstring.syntax \ -linkpkg test.ml -o test v} {2 Security and type safety} {3 Security on input} The main concerns for input are buffer overflows and denial of service. It is believed that this library is robust against attempted buffer overflows. In addition to OCaml's normal bounds checks, we check that field lengths are >= 0, and many additional checks. Denial of service attacks are more problematic. We only work forwards through the bitstring, thus computation will eventually terminate. As for computed lengths, code such as this is thought to be secure: {[ bitmatch bits with | { len : 64; buffer : Int64.to_int len : bitstring } -> ]} The [len] field can be set arbitrarily large by an attacker, but when pattern-matching against the [buffer] field this merely causes a test such as [if len <= remaining_size] to fail. Even if the length is chosen so that [buffer] bitstring is allocated, the allocation of sub-bitstrings is efficient and doesn't involve an arbitary-sized allocation or any copying. However the above does not necessarily apply to strings used in matching, since they may cause the library to use the {!Bitstring.string_of_bitstring} function, which allocates a string. So you should take care if you use the [string] type particularly with a computed length that is derived from external input. The main protection against attackers should be to ensure that the main program will only read input bitstrings up to a certain length, which is outside the scope of this library. {3 Security on output} As with the input side, computed lengths are believed to be safe. For example: {[ let len = read_untrusted_source () in let buffer = allocate_bitstring () in BITSTRING { buffer : len : bitstring } ]} This code merely causes a check that buffer's length is the same as [len]. However the program function [allocate_bitstring] must refuse to allocate an oversized buffer (but that is outside the scope of this library). {3 Order of evaluation} In [bitmatch] statements, fields are evaluated left to right. Note that the when-clause is evaluated {i last}, so if you are relying on the when-clause to filter cases then your code may do a lot of extra and unncessary pattern-matching work on fields which may never be needed just to evaluate the when-clause. Either rearrange the code to do only the first part of the match, followed by the when-clause, followed by a second inner bitmatch, or use a [check()] qualifier within fields. {3 Safety} The current implementation is believed to be fully type-safe, and makes compile and run-time checks where appropriate. If you find a case where a check is missing please submit a bug report or a patch. {2 Limits} These are thought to be the current limits: Integers: \[1..64\] bits. Bitstrings (32 bit platforms): maximum length is limited by the string size, ie. 16 MBytes. Bitstrings (64 bit platforms): maximum length is thought to be limited by the string size, ie. effectively unlimited. Bitstrings must be loaded into memory before we can match against them. Thus available memory may be considered a limit for some applications. {2:reference Reference} {3 Types} *) type endian = BigEndian | LittleEndian | NativeEndian val string_of_endian : endian -> string (** Endianness. *) type bitstring = bytes * int * int (** [bitstring] is the basic type used to store bitstrings. The type contains the underlying data (a bytes), the current bit offset within the string and the current bit length of the string (counting from the bit offset). Note that the offset and length are in {b bits}, not bytes. Normally you don't need to use the bitstring type directly, since there are functions and syntax extensions which hide the details. See also {!bitstring_of_string}, {!bitstring_of_file}, {!hexdump_bitstring}, {!bitstring_length}. *) type t = bitstring (** [t] is a synonym for the {!bitstring} type. This allows you to use this module with functors like [Set] and [Map] from the stdlib. *) (** {3 Exceptions} *) exception Construct_failure of string * string * int * int (** [Construct_failure (message, file, line, char)] may be raised by the [BITSTRING] constructor. Common reasons are that values are out of range of the fields that contain them, or that computed lengths are impossible (eg. negative length bitfields). [message] is the error message. [file], [line] and [char] point to the original source location of the [BITSTRING] constructor that failed. *) (** {3 Bitstring comparison} *) val compare : bitstring -> bitstring -> int (** [compare bs1 bs2] compares two bitstrings and returns zero if they are equal, a negative number if [bs1 < bs2], or a positive number if [bs1 > bs2]. This tests "semantic equality" which is not affected by the offset or alignment of the underlying representation (see {!bitstring}). The ordering is total and lexicographic. *) val equals : bitstring -> bitstring -> bool (** [equals] returns true if and only if the two bitstrings are semantically equal. It is the same as calling [compare] and testing if the result is [0], but usually more efficient. *) val is_zeroes_bitstring : bitstring -> bool (** Tests if the bitstring is all zero bits (cf. {!zeroes_bitstring}) *) val is_ones_bitstring : bitstring -> bool (** Tests if the bitstring is all one bits (cf. {!ones_bitstring}). *) val is_prefix: bitstring -> bitstring -> bool (** [is_prefix bs1 bs2] returns true if bs2 is a prefix of bs1 *) (** {3 Bitstring manipulation} *) val bitstring_length : bitstring -> int (** [bitstring_length bitstring] returns the length of the bitstring in bits. Note this just returns the third field in the {!bitstring} tuple. *) val subbitstring : bitstring -> int -> int -> bitstring (** [subbitstring bits off len] returns a sub-bitstring of the bitstring, starting at offset [off] bits and with length [len] bits. If the original bitstring is not long enough to do this then the function raises [Invalid_argument "subbitstring"]. Note that this function just changes the offset and length fields of the {!bitstring} tuple, so is very efficient. *) val dropbits : int -> bitstring -> bitstring (** Drop the first n bits of the bitstring and return a new bitstring which is shorter by n bits. If the length of the original bitstring is less than n bits, this raises [Invalid_argument "dropbits"]. Note that this function just changes the offset and length fields of the {!bitstring} tuple, so is very efficient. *) val takebits : int -> bitstring -> bitstring (** Take the first n bits of the bitstring and return a new bitstring which is exactly n bits long. If the length of the original bitstring is less than n bits, this raises [Invalid_argument "takebits"]. Note that this function just changes the offset and length fields of the {!bitstring} tuple, so is very efficient. *) val concat : bitstring list -> bitstring (** Concatenate a list of bitstrings together into a single bitstring. *) (** {3 Constructing bitstrings} *) val empty_bitstring : bitstring (** [empty_bitstring] is the empty, zero-length bitstring. *) val create_bitstring : int -> bitstring (** [create_bitstring n] creates an [n] bit bitstring containing all zeroes. *) val make_bitstring : int -> char -> bitstring (** [make_bitstring n c] creates an [n] bit bitstring containing the repeated 8 bit pattern in [c]. For example, [make_bitstring 16 '\x5a'] will create the bitstring [0x5a5a] or in binary [0101 1010 0101 1010]. Note that the length is in bits, not bytes. The length does NOT need to be a multiple of 8. *) val zeroes_bitstring : int -> bitstring (** [zeroes_bitstring] creates an [n] bit bitstring of all 0's. Actually this is the same as {!create_bitstring}. *) val ones_bitstring : int -> bitstring (** [ones_bitstring] creates an [n] bit bitstring of all 1's. *) val bitstring_of_string : string -> bitstring (** [bitstring_of_string str] creates a bitstring of length [String.length str * 8] (bits) containing the bits in [str]. Note that the bitstring uses [str] as the underlying string (see the representation of {!bitstring}) so you should not change [str] after calling this. *) val bitstring_of_file : string -> bitstring (** [bitstring_of_file filename] loads the named file into a bitstring. *) val bitstring_of_chan : in_channel -> bitstring (** [bitstring_of_chan chan] loads the contents of the input channel [chan] as a bitstring. The length of the final bitstring is determined by the remaining input in [chan], but will always be a multiple of 8 bits. See also {!bitstring_of_chan_max}. *) val bitstring_of_chan_max : in_channel -> int -> bitstring (** [bitstring_of_chan_max chan max] works like {!bitstring_of_chan} but will only read up to [max] bytes from the channel (or fewer if the end of input occurs before that). *) val bitstring_of_file_descr : Unix.file_descr -> bitstring (** [bitstring_of_file_descr fd] loads the contents of the file descriptor [fd] as a bitstring. See also {!bitstring_of_chan}, {!bitstring_of_file_descr_max}. *) val bitstring_of_file_descr_max : Unix.file_descr -> int -> bitstring (** [bitstring_of_file_descr_max fd max] works like {!bitstring_of_file_descr} but will only read up to [max] bytes from the channel (or fewer if the end of input occurs before that). *) (** {3 Converting bitstrings} *) val string_of_bitstring : bitstring -> string (** [string_of_bitstring bitstring] converts a bitstring to a string (eg. to allow comparison). This function is inefficient. In the best case when the bitstring is nicely byte-aligned we do a [String.sub] operation. If the bitstring isn't aligned then this involves a lot of bit twiddling and is particularly inefficient. If the bitstring is not a multiple of 8 bits wide then the final byte of the string contains the high bits set to the remaining bits and the low bits set to 0. *) val bitstring_to_file : bitstring -> string -> unit (** [bitstring_to_file bits filename] writes the bitstring [bits] to the file [filename]. It overwrites the output file. Some restrictions apply, see {!bitstring_to_chan}. *) val bitstring_to_chan : bitstring -> out_channel -> unit (** [bitstring_to_file bits filename] writes the bitstring [bits] to the channel [chan]. Channels are made up of bytes, bitstrings can be any bit length including fractions of bytes. So this function only works if the length of the bitstring is an exact multiple of 8 bits (otherwise it raises [Invalid_argument "bitstring_to_chan"]). Furthermore the function is efficient only in the case where the bitstring is stored fully aligned, otherwise it has to do inefficient bit twiddling like {!string_of_bitstring}. In the common case where the bitstring was generated by the [BITSTRING] operator and is an exact multiple of 8 bits wide, then this function will always work efficiently. *) (** {3 Printing bitstrings} *) val hexdump_bitstring : out_channel -> bitstring -> unit (** [hexdump_bitstring chan bitstring] prints the bitstring to the output channel in a format similar to the Unix command [hexdump -C]. *) (** {3 Bitstring buffer} *) module Buffer : sig type t val create : unit -> t val contents : t -> bitstring val add_bits : t -> bytes -> int -> unit val add_bit : t -> bool -> unit val add_byte : t -> int -> unit end (** Buffers are mainly used by the [BITSTRING] constructor, but may also be useful for end users. They work much like the standard library [Buffer] module. *) (** {3 Get/set bits} These functions let you manipulate individual bits in the bitstring. However they are not particularly efficient and you should generally use the [bitmatch] and [BITSTRING] operators when building and parsing bitstrings. These functions all raise [Invalid_argument "index out of bounds"] if the index is out of range of the bitstring. *) val set : bitstring -> int -> unit (** [set bits n] sets the [n]th bit in the bitstring to 1. *) val clear : bitstring -> int -> unit (** [clear bits n] sets the [n]th bit in the bitstring to 0. *) val is_set : bitstring -> int -> bool (** [is_set bits n] is true if the [n]th bit is set to 1. *) val is_clear : bitstring -> int -> bool (** [is_clear bits n] is true if the [n]th bit is set to 0. *) val put : bitstring -> int -> int -> unit (** [put bits n v] sets the [n]th bit in the bitstring to 1 if [v] is not zero, or to 0 if [v] is zero. *) val get : bitstring -> int -> int (** [get bits n] returns the [n]th bit (returns non-zero or 0). *) (** {3 Miscellaneous} *) val debug : bool ref (** Set this variable to true to enable extended debugging. This only works if debugging was also enabled in the [pa_bitstring.ml] file at compile time, otherwise it does nothing. *) (**/**) (* Private functions, called from generated code. Do not use * these directly - they are not safe. *) (* 'extract' functions are used in bitmatch statements. *) val extract_bit : bytes -> int -> int -> int -> bool val extract_char_unsigned : bytes -> int -> int -> int -> int val extract_char_signed : bytes -> int -> int -> int -> int val extract_int_be_unsigned : bytes -> int -> int -> int -> int val extract_int_be_signed : bytes -> int -> int -> int -> int val extract_int_le_unsigned : bytes -> int -> int -> int -> int val extract_int_le_signed : bytes -> int -> int -> int -> int val extract_int_ne_unsigned : bytes -> int -> int -> int -> int val extract_int_ne_signed : bytes -> int -> int -> int -> int val extract_int_ee_unsigned : endian -> bytes -> int -> int -> int -> int val extract_int_ee_signed : endian -> bytes -> int -> int -> int -> int val extract_int32_be_unsigned : bytes -> int -> int -> int -> int32 val extract_int32_le_unsigned : bytes -> int -> int -> int -> int32 val extract_int32_ne_unsigned : bytes -> int -> int -> int -> int32 val extract_int32_ee_unsigned : endian -> bytes -> int -> int -> int -> int32 val extract_int64_be_unsigned : bytes -> int -> int -> int -> int64 val extract_int64_le_unsigned : bytes -> int -> int -> int -> int64 val extract_int64_ne_unsigned : bytes -> int -> int -> int -> int64 val extract_int64_ee_unsigned : endian -> bytes -> int -> int -> int -> int64 external extract_fastpath_int16_be_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" external extract_fastpath_int16_le_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" external extract_fastpath_int16_ne_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" external extract_fastpath_int16_be_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" external extract_fastpath_int16_le_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" external extract_fastpath_int16_ne_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" (* external extract_fastpath_int24_be_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" external extract_fastpath_int24_le_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" external extract_fastpath_int24_ne_unsigned : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" external extract_fastpath_int24_be_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" external extract_fastpath_int24_le_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" external extract_fastpath_int24_ne_signed : bytes -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" *) external extract_fastpath_int32_be_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" external extract_fastpath_int32_le_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" external extract_fastpath_int32_ne_unsigned : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" external extract_fastpath_int32_be_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" external extract_fastpath_int32_le_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" external extract_fastpath_int32_ne_signed : bytes -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" (* external extract_fastpath_int40_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" external extract_fastpath_int40_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" external extract_fastpath_int40_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" external extract_fastpath_int40_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" external extract_fastpath_int40_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" external extract_fastpath_int40_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" external extract_fastpath_int48_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" external extract_fastpath_int48_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" external extract_fastpath_int48_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" external extract_fastpath_int48_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" external extract_fastpath_int48_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" external extract_fastpath_int48_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" external extract_fastpath_int56_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" external extract_fastpath_int56_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" external extract_fastpath_int56_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" external extract_fastpath_int56_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" external extract_fastpath_int56_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" external extract_fastpath_int56_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" *) external extract_fastpath_int64_be_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" external extract_fastpath_int64_le_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" external extract_fastpath_int64_ne_unsigned : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" external extract_fastpath_int64_be_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" external extract_fastpath_int64_le_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" external extract_fastpath_int64_ne_signed : bytes -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" (* 'construct' functions are used in BITSTRING constructors. *) val construct_bit : Buffer.t -> bool -> int -> exn -> unit val construct_char_unsigned : Buffer.t -> int -> int -> exn -> unit val construct_char_signed : Buffer.t -> int -> int -> exn -> unit val construct_int_be_unsigned : Buffer.t -> int -> int -> exn -> unit val construct_int_le_unsigned : Buffer.t -> int -> int -> exn -> unit val construct_int_ne_unsigned : Buffer.t -> int -> int -> exn -> unit val construct_int_ee_unsigned : endian -> Buffer.t -> int -> int -> exn -> unit val construct_int_be_signed : Buffer.t -> int -> int -> exn -> unit val construct_int_le_signed : Buffer.t -> int -> int -> exn -> unit val construct_int_ne_signed : Buffer.t -> int -> int -> exn -> unit val construct_int_ee_signed : endian -> Buffer.t -> int -> int -> exn -> unit val construct_int32_be_unsigned : Buffer.t -> int32 -> int -> exn -> unit val construct_int32_le_unsigned : Buffer.t -> int32 -> int -> exn -> unit val construct_int32_ne_unsigned : Buffer.t -> int32 -> int -> exn -> unit val construct_int32_ee_unsigned : endian -> Buffer.t -> int32 -> int -> exn -> unit val construct_int64_be_unsigned : Buffer.t -> int64 -> int -> exn -> unit val construct_int64_le_unsigned : Buffer.t -> int64 -> int -> exn -> unit val construct_int64_ne_unsigned : Buffer.t -> int64 -> int -> exn -> unit val construct_int64_ee_unsigned : endian -> Buffer.t -> int64 -> int -> exn -> unit val construct_string : Buffer.t -> string -> unit val construct_bitstring : Buffer.t -> bitstring -> unit (* Alias of functions shadowed by Core. *) val char_code : char -> int val int32_of_int : int -> int32 bitstring-4.1.1/src/bitstring_config.ml000066400000000000000000000022171431112327400201750ustar00rootroot00000000000000(* * Bitstring library. * * Copyright (C) 2008-2016 Red Hat Inc., Richard W.M. Jones * Copyright (C) 2016 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version, * with the OCaml linking exception described in COPYING.LIB. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* This file contains general configuration settings, set by the * configure script. *) let nativeendian = if Sys.big_endian then Bitstring_types.BigEndian else Bitstring_types.LittleEndian bitstring-4.1.1/src/bitstring_fastpath.c000066400000000000000000000157131431112327400203610ustar00rootroot00000000000000/* * Bitstring library. * * Copyright (C) 2008-2016 Red Hat Inc., Richard W.M. Jones * Copyright (C) 2016 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version, * with the OCaml linking exception described in COPYING.LIB. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* This file contains hand-coded, optimized C implementations of * certain very frequently used functions. */ #if defined(__APPLE__) #include #elif defined(__FreeBSD__) #include #elif defined(__MINGW32__) #include #elif defined(_WIN32) && defined(_MSC_VER) && (defined(_M_X64) || defined (_M_IX86)) #define BIG_ENDIAN 4321 #define LITTLE_ENDIAN 1234 #define BYTE_ORDER LITTLE_ENDIAN #else #include #endif #include #include #include #include #include #include #include #include #include /* * Prefix fastpath functions. */ static char prefix_mask_lookup[8] = { 0x00, 0x80, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC, 0xFE }; static int match_partial_left(int len, char source, char prefix) { register char mask = ~prefix_mask_lookup[len]; return (source & mask) == (prefix & mask); } static int match_partial_right(int len, char source, char prefix) { register char mask = prefix_mask_lookup[len]; return (source & mask) == (prefix & mask); } CAMLprim value ocaml_bitstring_is_prefix_fastpath(value b1, value o1, value b2, value o2, value l2) { CAMLparam5 (b1, o1, b2, o2, l2); int il2 = Int_val(l2); /* * Find the beginning of the bitstrings. */ int bo1 = Int_val(o1) >> 3; int bo2 = Int_val(o2) >> 3; char * ptr1 = &((char *)String_val(b1))[bo1]; char * ptr2 = &((char *)String_val(b2))[bo2]; /* * Compute the left partial match if the offset mod 8 != 0. */ int sh = Int_val(o2) & 0x7; if (sh != 0) { if (!match_partial_left(sh, *ptr1, *ptr2)) { CAMLreturn (Val_false); } il2 -= 8 - sh; ptr1++, ptr2++; } /* * Check the part of the prefix that fits in bytes using memcmp. */ int bl2 = il2 >> 3; if (memcmp(ptr1, ptr2, bl2) != 0) { CAMLreturn (Val_false); } /* * Check the remainder of the prefix if there is any. */ int rem = il2 & 0x7; if (rem) { int res = match_partial_right(rem, ptr1[bl2], ptr2[bl2]); CAMLreturn (Val_bool(res)); } /* * The prefix exists. */ CAMLreturn (Val_true); } /* * Extract fastpath functions. * * These are used in the common case for reading ints where the following * conditions are known to be true: * (a) the int size is a whole number of bytes (eg. 16, 24, 32, etc bits) * (b) the access in the match is byte-aligned * (c) the access in the underlying bitstring is byte-aligned * * These functions used to all be "noalloc" meaning they must not perform any * OCaml allocations. However starting with OCaml 4.02, a compiler optimization * means that unforunately we now have to use ordinary alloc functions in some * cases. * * The final offset in the string is calculated by the OCaml (caller) code. All * we need to do is to read the string+offset and byteswap, sign-extend as * necessary. * * There is one function for every combination of: * (i) int size: 16, 32, 64 bits * (ii) endian: bigendian, littleendian, nativeendian * (iii) signed and unsigned * * XXX Future work: Expand this to 24, 40, 48, 56 bits. This * requires some extra work because sign-extension won't "just happen". */ #if BYTE_ORDER == BIG_ENDIAN #define swap_be(size,v) #define swap_le(size,v) v = bswap_##size (v) #define swap_ne(size,v) #else #define swap_be(size,v) v = bswap_##size (v) #define swap_le(size,v) #define swap_ne(size,v) #endif #define extract_fastpath_zero_copy(size, endian, sign, type) \ CAMLprim value \ ocaml_bitstring_extract_fastpath_int##size##_##endian##_##sign \ (value strv, value offv) \ { \ CAMLparam2 (strv, offv); \ type *ptr = (type *)((char *)String_val(strv) + Int_val(offv)); \ type r; \ memcpy(&r, ptr, sizeof(r)); \ swap_##endian(size,r); \ CAMLreturn (Val_int(r)); \ } #define extract_fastpath_with_copy(size, endian, sign, type) \ CAMLprim value \ ocaml_bitstring_extract_fastpath_int##size##_##endian##_##sign \ (value strv, value offv) \ { \ CAMLparam2 (strv, offv); \ CAMLlocal1 (rv); \ type *ptr = (type *)((char *)String_val(strv) + Int_val(offv)); \ type r; \ memcpy(&r, ptr, sizeof(r)); \ swap_##endian(size,r); \ rv = caml_copy_int##size(r); \ CAMLreturn(rv); \ } extract_fastpath_zero_copy(16, be, unsigned, uint16_t) extract_fastpath_zero_copy(16, le, unsigned, uint16_t) extract_fastpath_zero_copy(16, ne, unsigned, uint16_t) extract_fastpath_zero_copy(16, be, signed , int16_t ) extract_fastpath_zero_copy(16, le, signed , int16_t ) extract_fastpath_zero_copy(16, ne, signed , int16_t ) extract_fastpath_with_copy(32, be, unsigned, uint32_t) extract_fastpath_with_copy(32, le, unsigned, uint32_t) extract_fastpath_with_copy(32, ne, unsigned, uint32_t) extract_fastpath_with_copy(32, be, signed , int32_t ) extract_fastpath_with_copy(32, le, signed , int32_t ) extract_fastpath_with_copy(32, ne, signed , int32_t ) extract_fastpath_with_copy(64, be, unsigned, uint64_t) extract_fastpath_with_copy(64, le, unsigned, uint64_t) extract_fastpath_with_copy(64, ne, unsigned, uint64_t) extract_fastpath_with_copy(64, be, signed , int64_t ) extract_fastpath_with_copy(64, le, signed , int64_t ) extract_fastpath_with_copy(64, ne, signed , int64_t ) // vim: ts=2:sts=2:sw=2:et bitstring-4.1.1/src/bitstring_types.ml000066400000000000000000000022031431112327400200670ustar00rootroot00000000000000(* * Bitstring library. * * Copyright (C) 2008-2016 Red Hat Inc., Richard W.M. Jones * Copyright (C) 2016 Red Hat Inc, Richard W.M. Jones, Xavier R. Guerin. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version, * with the OCaml linking exception described in COPYING.LIB. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * *) type endian = BigEndian | LittleEndian | NativeEndian let string_of_endian = function | BigEndian -> "bigendian" | LittleEndian -> "littleendian" | NativeEndian -> "nativeendian" bitstring-4.1.1/src/byteswap.h000066400000000000000000000043021431112327400163150ustar00rootroot00000000000000/* * byteswap.h - Byte swapping * Copyright (C) 2005, 2007 Free Software Foundation, Inc. * Written by Oskar Liljeblad , 2005. * * 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 . */ /* NB: * * This file is from Gnulib, and in accordance with the convention there, the * real license of this file comes from the module definition. It is really * LGPLv2+. * * - RWMJ. 2008/08/23 */ #ifndef _GL_BYTESWAP_H #define _GL_BYTESWAP_H /* * Given an unsigned 16-bit argument X, return the value corresponding to * X with reversed byte order. */ #define bswap_16(x) ((((x) & 0x00FF) << 8) | \ (((x) & 0xFF00) >> 8)) /* * Given an unsigned 32-bit argument X, return the value corresponding to * X with reversed byte order. */ #define bswap_32(x) ((((x) & 0x000000FF) << 24) | \ (((x) & 0x0000FF00) << 8) | \ (((x) & 0x00FF0000) >> 8) | \ (((x) & 0xFF000000) >> 24)) /* * Given an unsigned 64-bit argument X, return the value corresponding to X * with reversed byte order. */ #define bswap_64(x) ((((x) & 0x00000000000000FFULL) << 56) | \ (((x) & 0x000000000000FF00ULL) << 40) | \ (((x) & 0x0000000000FF0000ULL) << 24) | \ (((x) & 0x00000000FF000000ULL) << 8) | \ (((x) & 0x000000FF00000000ULL) >> 8) | \ (((x) & 0x0000FF0000000000ULL) >> 24) | \ (((x) & 0x00FF000000000000ULL) >> 40) | \ (((x) & 0xFF00000000000000ULL) >> 56)) #endif /* _GL_BYTESWAP_H */ // vim: ts=2:sts=2:sw=2:et bitstring-4.1.1/src/dune000066400000000000000000000002431431112327400151640ustar00rootroot00000000000000(library (name bitstring) (public_name bitstring) (foreign_stubs (language c) (names bitstring_fastpath) (flags -I.)) (libraries str unix stdlib-shims)) bitstring-4.1.1/tests/000077500000000000000000000000001431112327400146625ustar00rootroot00000000000000bitstring-4.1.1/tests/BitstringConstructorTest.ml000066400000000000000000000113131431112327400222660ustar00rootroot00000000000000(* * Copyright (c) 2016 Xavier R. Guérin * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open OUnit2 open Bitstring (* * Imbricated bitstring test *) let imbricated_bistring_test context = let result = "\xde\xad\xbe\xef\x42\x0a" in let magic = "\xde\xad\xbe\xef" in let version = 0x42 in let data = 10 in let header = [%bitstring {| version : 8 |}] in let bits = [%bitstring {| magic : -1 : string ; header : -1 : bitstring ; data : 8 |}] in let dump = Bitstring.string_of_bitstring bits in assert_equal result dump (* * Constructor style test *) let constructor_style_test context = let%bitstring bits1 = {| "GIF87a" : 6*8 : string ; 2145 : 16 : littleendian ; 2145 : 16 : littleendian ; true : 1 ; 7 : 3 ; false : 1 ; 7 : 3 ; 0 : 8 ; 0 : 8 |} in let bits2 = [%bitstring {| "GIF87a" : 6*8 : string ; 2145 : 16 : littleendian ; 2145 : 16 : littleendian ; true : 1 ; 7 : 3 ; false : 1 ; 7 : 3 ; 0 : 8 ; 0 : 8 |}] in assert_bool "Bistrings are not equal" (Bitstring.equals bits1 bits2) (* * Swap test *) let swap bs = match%bitstring bs with | {| a : 1 : bitstring; b : 1 : bitstring|} -> [%bitstring {| b : 1 : bitstring; a : 1 : bitstring |}] | {| _ |} -> failwith "invalid input" let swap_test context = let one = [%bitstring {| 1 : 2 |}] in let two = [%bitstring {| 2 : 2 |}] in let three = [%bitstring {| 3 : 2 |}] in assert_bool "Bitstring swap failed" (Bitstring.equals two (swap one)); assert_bool "Bitstring swap failed" (Bitstring.equals one (swap two)); assert_bool "Bitstring swap failed" (Bitstring.equals three (swap three)) (* * External value test *) let external_value_test context = let result = "\x00\x02\x00\x00\x00\x01\xC0" in let int16_value = 2 in let int32_value = 1_l in let bool_value = true in let bits = [%bitstring {| int16_value : 16 ; int32_value : 32 ; 1 : 1 ; bool_value : 1 ; 0 : 6 |}] in let str = Bitstring.string_of_bitstring bits in assert_equal str result (* * Int for [17,31] bits test *) let int_parser_test context = let result = "\x00\x00\x02" in let%bitstring bits = {| 2 : 24 |} in let str = Bitstring.string_of_bitstring bits in assert_equal str result (* * Int32 for 32 bits test *) let int32_parser_test context = let result = "\x00\x00\x00\x02" in let%bitstring bits = {| 2_l : 32 |} in let str = Bitstring.string_of_bitstring bits in assert_equal str result (* * Structural let *) let%bitstring ext_bits = {| 2_l : 32 |} let str_item_test context = let result = "\x00\x00\x00\x02" in let str = Bitstring.string_of_bitstring ext_bits in assert_equal str result (* * Subtyping. *) let subtype_test context = let x = 42 in let%bitstring b = {| x : 6 |} in let%bitstring c = {| (x :> int) : 6 |} in assert (Bitstring.equals b c) (* * Test suite definition *) let suite = "BitstringConstructorTest" >::: [ "imbricated_bistring_test" >:: imbricated_bistring_test; "constructor_style_test" >:: constructor_style_test; "swap_test" >:: swap_test; "external_value_test" >:: external_value_test; "int_parser_test" >:: int_parser_test; "int32_parser_test" >:: int32_parser_test; "str_item_test" >:: str_item_test; "subtype_test" >:: subtype_test; ] let () = run_test_tt_main suite bitstring-4.1.1/tests/BitstringConstructorTest.mli000066400000000000000000000000301431112327400224310ustar00rootroot00000000000000val suite : OUnit2.test bitstring-4.1.1/tests/BitstringLegacyTest.ml000066400000000000000000001206771431112327400211630ustar00rootroot00000000000000open OUnit2 open Printf (* * Helper functions *) let rec range a b = if a <= b then a :: range (a+1) b else [] (* * Just check that the extension and library load without error. *) let load_test _ = let _ = Bitstring.extract_bit in () (* * Just check that we can run some functions from the library. *) let run_test _ = let bits = Bitstring.create_bitstring 16 in ignore (Bitstring.string_of_bitstring bits) (* * Match random bits. *) let match_random_bits_test _ = Random.self_init (); for len = 0 to 999 do (* * Create a random string of bits. *) let expected = List.map (fun _ -> Random.bool ()) (range 0 (len-1)) in let bits = Bitstring.Buffer.create () in List.iter (Bitstring.Buffer.add_bit bits) expected; let bits = Bitstring.Buffer.contents bits in (* * Now read the bitstring in groups of 1, 2, 3 .. etc. bits. In each case * check the result against what we generated ('expected'). *) let actual = let rec loop bits = match%bitstring bits with | {| b0 : 1; rest : -1 : bitstring |} -> b0 :: loop rest | {| _ |} -> [] in loop bits in assert_equal actual expected; (* *) let actual = let rec loop bits = match%bitstring bits with | {| b0 : 1; b1 : 1; rest : -1 : bitstring |} -> b0 :: b1 :: loop rest | {| b0 : 1; rest : -1 : bitstring |} -> b0 :: loop rest | {| _ |} -> [] in loop bits in assert_equal actual expected; (* *) let actual = let rec loop bits = match%bitstring bits with | {| b0 : 1; b1 : 1; b2 : 1; rest : -1 : bitstring |} -> b0 :: b1 :: b2 :: loop rest | {| b0 : 1; rest : -1 : bitstring |} -> b0 :: loop rest | {| _ |} -> [] in loop bits in assert_equal actual expected; (* *) let actual = let rec loop bits = match%bitstring bits with | {| b0 : 1; b1 : 1; b2 : 1; b3 : 1; rest : -1 : bitstring |} -> b0 :: b1 :: b2 :: b3 :: loop rest | {| b0 : 1; rest : -1 : bitstring |} -> b0 :: loop rest | {| _ |} -> [] in loop bits in assert_equal actual expected; (* *) let actual = let rec loop bits = match%bitstring bits with | {| b0 : 1; b1 : 1; b2 : 1; b3 : 1; b4 : 1; b5 : 1; b6 : 1; b7 : 1; b8 : 1; rest : -1 : bitstring |} -> b0 :: b1 :: b2 :: b3 :: b4 :: b5 :: b6 :: b7 :: b8 :: loop rest | {| b0 : 1; rest : -1 : bitstring |} -> b0 :: loop rest | {| _ |} -> [] in loop bits in assert_equal actual expected; done (* * Match random bits with integers. *) let match_random_bits_with_int_test _ = Random.self_init (); for len = 1 to 99 do for bitlen = 1 to 63 do (* * Create a random string of ints. *) let expected = List.map (fun _ -> Random.int64 (Int64.sub (Int64.shift_left 1L bitlen) 1L)) (range 0 (len-1)) in let bits = Bitstring.Buffer.create () in List.iter (fun i -> Bitstring.construct_int64_be_unsigned bits i bitlen (Failure "constructing string")) expected; let bits = Bitstring.Buffer.contents bits in (* * Now read the bitstring as integers. * In each case check the result against what we generated ('expected'). *) let actual = let rec loop bits = match%bitstring bits with | {| i : bitlen; rest : -1 : bitstring |} when Bitstring.bitstring_length rest = 0 -> [i] | {| i : bitlen; rest : -1 : bitstring |} -> i :: loop rest | {| _ |} -> failwith (sprintf "loop failed with len = %d, bitlen = %d" len bitlen) in loop bits in assert_equal actual expected done done (* * Check value limits. *) let check_value_limits_test _ = let a = Array.init 387 (fun i -> i - 129) in let limits b = Array.fold_left (fun (mini,maxi) i -> try ignore (b i); (min mini i, max maxi i) with _ -> (mini, maxi)) (0,0) a in assert_equal (List.map limits [ (fun i -> [%bitstring {| i : 2 : signed |}]); (fun i -> [%bitstring {| i : 3 : signed |}]); (fun i -> [%bitstring {| i : 4 : signed |}]); (fun i -> [%bitstring {| i : 5 : signed |}]); (fun i -> [%bitstring {| i : 6 : signed |}]); (fun i -> [%bitstring {| i : 7 : signed |}]); (fun i -> [%bitstring {| i : 8 : signed |}]); ]) [ (-2, 3); (-4, 7); (-8, 15); (-16, 31); (-32, 63); (-64, 127); (-128, 255) ] (* * Signed byte create. *) let signed_byte_create_test _ = let a n = let n' = 1 lsl (pred n) in Array.to_list (Array.init n' (fun i -> -(n'-i), n'+i)) @ Array.to_list (Array.init (n' lsl 1) (fun i -> i,i)) in let t s i = List.fold_left (fun ok (n,c) -> s n = String.make 1 (Char.chr (c lsl (8-i))) && ok ) true (a i) in let ok = fst (List.fold_left (fun (ok,i) s -> t s i && ok, succ i) (true, 2) [ (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 2 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 3 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 4 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 5 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 6 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 7 : signed |}]); (fun i -> Bitstring.string_of_bitstring [%bitstring {| i : 8 : signed |}]); ]) in assert_equal ok true (* * Signed byte create and match *) let signed_byte_create_and_match_test _ = let a n = let n' = 1 lsl (pred n) in Array.to_list (Array.init (n' lsl 1) (fun i -> i-n')) in let t s i = List.fold_left (fun ok n -> s n = n && ok ) true (a i) in let ok = fst (List.fold_left (fun (ok,i) s -> t s i && ok, succ i) (true, 2) [ (fun n -> match%bitstring [%bitstring {| n : 2 : signed |}] with {| i : 2 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 3 : signed |}] with {| i : 3 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 4 : signed |}] with {| i : 4 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 5 : signed |}] with {| i : 5 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 6 : signed |}] with {| i : 6 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 7 : signed |}] with {| i : 7 : signed |} -> i | {| _ |} -> assert false); (fun n -> match%bitstring [%bitstring {| n : 8 : signed |}] with {| i : 8 : signed |} -> i | {| _ |} -> assert false); ]) in assert_equal ok true (* * Signed int limits *) let signed_int_limits_test _ = Random.self_init (); let res = List.fold_left (fun (ok, i) (b, m) -> let above_maxp = 1 lsl i in let maxp = pred above_maxp in let minp = - (above_maxp lsr 1) in let below_minp = pred minp in let gut = try ignore (b maxp); true with _ -> false in let gut2 = try ignore (b above_maxp); false with _ -> true in let gut3 = try ignore (b minp); true with _ -> false in let gut4 = try ignore (b below_minp); false with _ -> true in let gut5 = let plage = Int32.shift_left 1l i in let test () = let signed_number = Int32.to_int (Int32.add (Random.int32 plage) (Int32.of_int minp)) in let bits = b signed_number in let number' = m bits in if signed_number = number' then true else begin Printf.printf "bits:%d n=%x read=%x (%x %x)\n" i signed_number number' minp maxp; false end in let res = ref true in for i = 1 to 10_000 do res := !res && test () done; !res in (gut && gut2 && gut3 && gut4 && gut5 && ok, succ i) ) (true, 9) [ (fun n -> [%bitstring {| n : 9 : signed |}]), (fun b -> match%bitstring b with {| n: 9 : signed |} -> n); (fun n -> [%bitstring {| n : 10 : signed |}]), (fun b -> match%bitstring b with {| n : 10 : signed |} -> n); (fun n -> [%bitstring {| n : 11 : signed |}]), (fun b -> match%bitstring b with {| n : 11 : signed |} -> n); (fun n -> [%bitstring {| n : 12 : signed |}]), (fun b -> match%bitstring b with {| n : 12 : signed |} -> n); (fun n -> [%bitstring {| n : 13 : signed |}]), (fun b -> match%bitstring b with {| n : 13 : signed |} -> n); (fun n -> [%bitstring {| n : 14 : signed |}]), (fun b -> match%bitstring b with {| n : 14 : signed |} -> n); (fun n -> [%bitstring {| n : 15 : signed |}]), (fun b -> match%bitstring b with {| n : 15 : signed |} -> n); (fun n -> [%bitstring {| n : 16 : signed |}]), (fun b -> match%bitstring b with {| n : 16 : signed |} -> n); (fun n -> [%bitstring {| n : 17 : signed |}]), (fun b -> match%bitstring b with {| n : 17 : signed |} -> n); (fun n -> [%bitstring {| n : 18 : signed |}]), (fun b -> match%bitstring b with {| n : 18 : signed |} -> n); (fun n -> [%bitstring {| n : 19 : signed |}]), (fun b -> match%bitstring b with {| n : 19 : signed |} -> n); (fun n -> [%bitstring {| n : 20 : signed |}]), (fun b -> match%bitstring b with {| n : 20 : signed |} -> n); (fun n -> [%bitstring {| n : 21 : signed |}]), (fun b -> match%bitstring b with {| n : 21 : signed |} -> n); (fun n -> [%bitstring {| n : 22 : signed |}]), (fun b -> match%bitstring b with {| n : 22 : signed |} -> n); (fun n -> [%bitstring {| n : 23 : signed |}]), (fun b -> match%bitstring b with {| n : 23 : signed |} -> n); (fun n -> [%bitstring {| n : 24 : signed |}]), (fun b -> match%bitstring b with {| n : 24 : signed |} -> n); (fun n -> [%bitstring {| n : 25 : signed |}]), (fun b -> match%bitstring b with {| n : 25 : signed |} -> n); (fun n -> [%bitstring {| n : 26 : signed |}]), (fun b -> match%bitstring b with {| n : 26 : signed |} -> n); (fun n -> [%bitstring {| n : 27 : signed |}]), (fun b -> match%bitstring b with {| n : 27 : signed |} -> n); (fun n -> [%bitstring {| n : 28 : signed |}]), (fun b -> match%bitstring b with {| n : 28 : signed |} -> n); (fun n -> [%bitstring {| n : 29 : signed |}]), (fun b -> match%bitstring b with {| n : 29 : signed |} -> n); (fun n -> [%bitstring {| n : 30 : signed |}]), (fun b -> match%bitstring b with {| n : 30 : signed |} -> n); ] in assert_equal (fst res) true; begin try if Sys.word_size = 32 then begin ignore ([%bitstring {| max_int : 31 : signed |}]); ignore ([%bitstring {| min_int : 31 : signed |}]); end else begin ignore ([%bitstring {| pred (1 lsl 31) : 31 : signed |}]); ignore ([%bitstring {| (-1 lsl 30) : 31 : signed |}]); end; with _ -> assert_failure "Second test failed" end; if Sys.word_size = 64 then try ignore ([%bitstring {| 1 lsl 31 : 31 : signed |}]); ignore ([%bitstring {| pred (-1 lsl 30) : 31 : signed |}]); assert_failure "Third test failed" with _ -> () (* * Test functions which construct and extract fixed-length ints of various * sizes. Manquent les tests random pour bits = 31 *) let fixed_extraction_test _ = for i = 0 to 129 do let zeroes = Bitstring.zeroes_bitstring i in let%bitstring bits = {| zeroes : i : bitstring; true : 1; 2 : 2 : littleendian; 2 : 2 : bigendian; 2 : 2 : nativeendian; 3 : 3 : littleendian; 3 : 3 : bigendian; 3 : 3 : nativeendian; 0x5a : 8 : littleendian; 0x5a : 8 : bigendian; 0x5a : 8 : nativeendian; 0xa5a5 : 16 : littleendian; 0xa5a5 : 16 : bigendian; 0xa5a5 : 16 : nativeendian; 0xeeddcc : 24 : littleendian; 0xeeddcc : 24 : bigendian; 0xeeddcc : 24 : nativeendian; 0x48888888 : 31 : littleendian; 0x48888888 : 31 : bigendian; 0x48888888 : 31 : nativeendian; 0xaabbccdd_l : 32 : littleendian; 0xaabbccdd_l : 32 : bigendian; 0xaabbccdd_l : 32 : nativeendian; 0xaabbccddeeff_L : 48 : littleendian; 0xaabbccddeeff_L : 48 : bigendian; 0xaabbccddeeff_L : 48 : nativeendian; 0x0011aabbccddeeff_L : 64 : littleendian; 0x0011aabbccddeeff_L : 64 : bigendian; 0x0011aabbccddeeff_L : 64 : nativeendian |} in match%bitstring bits with | {| _ : i : bitstring; a : 1; b0 : 2 : littleendian; b1 : 2 : bigendian; b2 : 2 : nativeendian; c0 : 3 : littleendian; c1 : 3 : bigendian; c2 : 3 : nativeendian; d0 : 8 : littleendian; d1 : 8 : bigendian; d2 : 8 : nativeendian; e0 : 16 : littleendian; e1 : 16 : bigendian; e2 : 16 : nativeendian; f0 : 24 : littleendian; f1 : 24 : bigendian; f2 : 24 : nativeendian; g0 : 31 : littleendian; g1 : 31 : bigendian; g2 : 31 : nativeendian; h0 : 32 : littleendian; h1 : 32 : bigendian; h2 : 32 : nativeendian; j0 : 48 : littleendian; j1 : 48 : bigendian; j2 : 48 : nativeendian; k0 : 64 : littleendian; k1 : 64 : bigendian; k2 : 64 : nativeendian |} -> if a <> true || b0 <> 2 || b1 <> 2 || b2 <> 2 || c0 <> 3 || c1 <> 3 || c2 <> 3 || d0 <> 0x5a || d1 <> 0x5a || d2 <> 0x5a || e0 <> 0xa5a5 || e1 <> 0xa5a5 || e2 <> 0xa5a5 || f0 <> 0xeeddcc || f1 <> 0xeeddcc || f2 <> 0xeeddcc || g0 <> 0x48888888 || g1 <> 0x48888888 || g2 <> 0x48888888 || h0 <> 0xaabbccdd_l || h1 <> 0xaabbccdd_l || h2 <> 0xaabbccdd_l || j0 <> 0xaabbccddeeff_L || j1 <> 0xaabbccddeeff_L || j2 <> 0xaabbccddeeff_L || k0 <> 0x0011aabbccddeeff_L || k1 <> 0x0011aabbccddeeff_L || k2 <> 0x0011aabbccddeeff_L then ( eprintf "15_extract_int: match failed %b %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %ld %ld %ld %Ld %Ld %Ld %Ld %Ld %Ld\n" a b0 b1 b2 c0 c1 c2 d0 d1 d2 e0 e1 e2 f0 f1 f2 g0 g1 g2 h0 h1 h2 j0 j1 j2 k0 k1 k2; exit 1 ) | {| _ |} -> failwith "15_extract_int" done (* * Test fix for a regression when extracting 32 and 64 bit aligned integers * (discovered / fixed / tested by Hans Ole Rafaelsen). *) let bitstring_of_int32 i = [%bitstring {| i : 32 |}] let bitstring_of_int64 i = [%bitstring {| i : 64 |}] let int32_of_bitstring bits = match%bitstring bits with | {| i : 32 |} -> i let int64_of_bitstring bits = match%bitstring bits with | {| i : 64 |} -> i let extract_regression_test _ = let b1 = bitstring_of_int32 1_l in let b2 = bitstring_of_int32 2_l in let b3 = bitstring_of_int32 3_l in let i1 = int32_of_bitstring b1 in let i2 = int32_of_bitstring b2 in let i3 = int32_of_bitstring b3 in assert (i1 = 1_l); assert (i2 = 2_l); assert (i3 = 3_l); let b1 = bitstring_of_int64 1_L in let b2 = bitstring_of_int64 2_L in let b3 = bitstring_of_int64 3_L in let i1 = int64_of_bitstring b1 in let i2 = int64_of_bitstring b2 in let i3 = int64_of_bitstring b3 in assert (i1 = 1_L); assert (i2 = 2_L); assert (i3 = 3_L) (* * Construct and match against random variable sized strings. *) let nr_passes = 10000 let max_size = 8 (* max field size in bits *) (* let () = Bitstring.debug := true *) (* Return a full 64 bits of randomness. *) let rand64 () = let r0 = Int64.shift_left (Int64.of_int (Random.bits ())) 34 in (* 30 bits *) let r1 = Int64.shift_left (Int64.of_int (Random.bits ())) 4 in (* 30 bits *) let r2 = Int64.of_int (Random.int 16) in (* 4 bits *) Int64.logor (Int64.logor r0 r1) r2 (* Return unsigned mask of length bits, bits <= 64. *) let mask64 bits = if bits < 63 then Int64.pred (Int64.shift_left 1L bits) else if bits = 63 then Int64.max_int else if bits = 64 then -1L else invalid_arg "mask64" (* Return a random number between 0 and 2^bits-1 where bits <= 64. *) let rand bits = let r = rand64 () in let m = mask64 bits in Int64.logand r m (* Dump the state in case there is an error. *) let dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3 = eprintf "dumping state:\n"; eprintf " 0: %3d - %016Lx - %016Lx\n" n0sz n0 r0; eprintf " 1: %3d - %016Lx - %016Lx\n" n1sz n1 r1; eprintf " 2: %3d - %016Lx - %016Lx\n" n2sz n2 r2; eprintf " 3: %3d - %016Lx - %016Lx\n" n3sz n3 r3; eprintf "bits (length = %d):\n" (Bitstring.bitstring_length bits); Bitstring.hexdump_bitstring stderr bits; eprintf "%!" let construct_and_match_random_test _ = Random.self_init (); for pass = 0 to nr_passes-1 do let n0sz = 1 + Random.int (max_size-1) in let n0 = rand n0sz in let n1sz = 1 + Random.int (max_size-1) in let n1 = rand n1sz in let n2sz = 1 + Random.int (max_size-1) in let n2 = rand n2sz in let n3sz = 1 + Random.int (max_size-1) in let n3 = rand n3sz in (* Construct the bitstring. *) let bits = try [%bitstring {| n0 : n0sz; n1 : n1sz; n2 : n2sz; n3 : n3sz |}] with Bitstring.Construct_failure (msg, _, _, _) -> eprintf "FAILED: Construct_failure %s\n%!" msg; dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz (Bitstring.empty_bitstring) 0L 0L 0L 0L; exit 2 in let r0, r1, r2, r3 = match%bitstring bits with | {| r0 : n0sz; r1 : n1sz; r2 : n2sz; r3 : n3sz; rest : -1 : bitstring |} -> let rest_len = Bitstring.bitstring_length rest in if rest_len <> 0 then ( eprintf "FAILED: rest is not zero length (length = %d)\n%!" rest_len; dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits 0L 0L 0L 0L; exit 2 ); r0, r1, r2, r3 | {| _ |} -> eprintf "FAILED: match operator did not match\n%!"; dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits 0L 0L 0L 0L; exit 2 in (*dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3;*) if n0 <> r0 || n1 <> r1 || n2 <> r2 || n3 <> r3 then ( eprintf "FAILED: numbers returned from match are different\n%!"; dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3; exit 2 ) done (* * Test the Bitstring.Buffer module and string_of_bitstring in nasty non-aligned * corner cases. *) let nasty_non_aligned_corner_case_test _ = Random.self_init (); let str1 = Bytes.of_string "012345678" in for offset = 0 to 65 do for len = 1 to 65 do let expected = let strlen = (len+7) lsr 3 in let expected = Bytes.create strlen in for i = 0 to strlen-1 do Bytes.set expected i (Char.chr (Random.int 256)) done; let last = Char.code (Bytes.get expected (strlen-1)) in let last = last land (0xff lsl (8 - (len land 7))) in Bytes.set expected (strlen-1) (Char.chr last); expected in (* Create a random bitstring: * +-------------+-------------------------------------------+ * | (random) | bits that we check (expected) | * +-------------+-------------------------------------------+ * 0 offset offset+len * <---------------- len bits ---------------> *) let bits = let bits = Bitstring.Buffer.create () in Bitstring.Buffer.add_bits bits str1 offset; Bitstring.Buffer.add_bits bits expected len; Bitstring.Buffer.contents bits in (* Create a sub bitstring corresponding to what we want to check. *) let subbits = let bits, bitoffset, bitlen = bits in (bits, bitoffset+offset, bitlen-offset) in assert_equal (Bitstring.bitstring_length subbits) len; (* Now try to read out the substring using string_of_bitstring. *) let actual = Bitstring.string_of_bitstring subbits in if Bytes.of_string actual <> expected then ( eprintf "MISMATCH between actual and expected, offset=%d, len=%d\n" offset len; eprintf "EXPECTED string:\n"; for i = 0 to Bytes.length expected-1 do eprintf " %02x" (Char.code (Bytes.get expected i)) done; eprintf "\nACTUAL string:\n"; for i = 0 to String.length actual-1 do eprintf " %02x" (Char.code actual.[i]) done; eprintf "\nBITS:\n"; Bitstring.hexdump_bitstring stderr bits; eprintf "SUBBITS:\n"; Bitstring.hexdump_bitstring stderr subbits; exit 1 ); done done (* * Test concat and the bit get functions. *) let concat_bit_get_test _ = for i = 0 to 33 do for j = 0 to 33 do for k = 0 to 33 do let bits = Bitstring.concat [ Bitstring.ones_bitstring i; Bitstring.zeroes_bitstring j; Bitstring.ones_bitstring k ] in assert (Bitstring.bitstring_length bits = i+j+k); for n = 0 to i-1 do assert (Bitstring.is_set bits n) done; for n = i to i+j-1 do assert (Bitstring.is_clear bits n) done; for n = i+j to i+j+k-1 do assert (Bitstring.is_set bits n) done done done done (* * Compare bitstrings. *) let sgn = function | 0 -> 0 | i when i > 0 -> 1 | _ -> -1 let compare_test _ = for i = 0 to 33 do for j = 0 to 33 do let bits1 = Bitstring.ones_bitstring i and bits2 = Bitstring.ones_bitstring j in let r = Bitstring.compare bits1 bits2 in if sgn r <> sgn (compare i j) then ( eprintf "ones compare failed %d %d %d\n" i j r; exit 1 ) done done; for i = 0 to 33 do for j = 0 to 33 do let bits1 = Bitstring.zeroes_bitstring i and bits2 = Bitstring.zeroes_bitstring j in let r = Bitstring.compare bits1 bits2 in if sgn r <> sgn (compare i j) then ( eprintf "zeroes compare failed %d %d %d\n" i j r; exit 1 ) done done; for i = 0 to 33 do for j = 0 to 33 do let bits1 = Bitstring.make_bitstring i '\x55' and bits2 = Bitstring.make_bitstring j '\x55' in let r = Bitstring.compare bits1 bits2 in if sgn r <> sgn (compare i j) then ( eprintf "x55 compare failed %d %d %d\n" i j r; exit 1 ) done done; for i = 0 to 33 do for j = 0 to 33 do let bits1 = Bitstring.make_bitstring i '\x55' in let bits2 = Bitstring.make_bitstring i '\x55' in let bits2 = Bitstring.concat [Bitstring.zeroes_bitstring j; bits2] in assert (Bitstring.bitstring_length bits2 = j+i); let bits2 = Bitstring.dropbits j bits2 in assert (Bitstring.bitstring_length bits2 = i); let r = Bitstring.compare bits1 bits2 in if r <> 0 then ( eprintf "x55 non-aligned compare failed %d %d %d\n" i j r; exit 1 ) done done (* * Test subbitstring call. *) let subbitstring_test _ = let bits = Bitstring.make_bitstring 65 '\x5a' in for off = 0 to 65 do for len = 65-off to 0 do let sub = Bitstring.subbitstring bits off len in for i = 0 to len-1 do if Bitstring.get bits (off+i) <> Bitstring.get sub i then ( eprintf "33_substring: failed %d %d %d\n" off len i; exit 1 ) done done done (* * Test takebits call. *) let takebits_test _ = let bits = Bitstring.make_bitstring 65 '\x5a' in for len = 0 to 65 do let sub = Bitstring.takebits len bits in assert (Bitstring.bitstring_length sub = len) done (* * Test the various functions to load bitstrings from files. *) let file_load_test _ = let bits1 = let b1 = Bitstring.make_bitstring 800 '\x5a' in let b2 = Bitstring.make_bitstring 400 '\x88' in ( [%bitstring {| b1 : 800 : bitstring; b2 : 400 : bitstring |}] ) in let bits2 = ( let b = Bitstring.make_bitstring 800 '\xaa' in [%bitstring {| b : 800 : bitstring |}] ) in let bits = Bitstring.concat [bits1; bits2] in let filename, chan = Filename.open_temp_file ~mode:[Open_binary] "bitstring_test" ".tmp" in Bitstring.bitstring_to_chan bits chan; close_out chan; let bits' = Bitstring.bitstring_of_file filename in assert (Bitstring.equals bits bits'); let chan = open_in filename in let bits' = Bitstring.bitstring_of_chan chan in close_in chan; assert (Bitstring.equals bits bits'); let chan = open_in filename in let bits' = Bitstring.bitstring_of_chan_max chan 150 in assert (Bitstring.equals bits1 bits'); let bits' = Bitstring.bitstring_of_chan_max chan 100 in assert (Bitstring.equals bits2 bits'); close_in chan; let fd = Unix.openfile filename [Unix.O_RDONLY] 0 in let bits' = Bitstring.bitstring_of_file_descr fd in Unix.close fd; assert (Bitstring.equals bits bits'); let fd = Unix.openfile filename [Unix.O_RDONLY] 0 in let bits' = Bitstring.bitstring_of_file_descr_max fd 150 in assert (Bitstring.equals bits1 bits'); let bits' = Bitstring.bitstring_of_file_descr_max fd 100 in assert (Bitstring.equals bits2 bits'); Unix.close fd; Unix.unlink filename (* * Test if bitstrings are all zeroes or all ones. *) let zeroes_ones_test _ = for i = 0 to 33 do let bits = Bitstring.zeroes_bitstring i in if not (Bitstring.is_zeroes_bitstring bits) then ( eprintf "is_zeros_bitstring failed %d\n" i; exit 1 ); if i > 0 && Bitstring.is_ones_bitstring bits then ( eprintf "false match is_ones_bitstring %d\n" i; exit 1 ) done; for i = 0 to 33 do let bits = Bitstring.ones_bitstring i in if not (Bitstring.is_ones_bitstring bits) then ( eprintf "is_ones_bitstring failed %d\n" i; exit 1 ); if i > 0 && Bitstring.is_zeroes_bitstring bits then ( eprintf "false match is_zeroes_bitstring %d\n" i; exit 1 ) done (* * Endianness expressions *) let endianness_test _ = let rec loop = function | (e, expected) :: rest -> let%bitstring bits = {| expected : 32 : endian (e); expected : 32 : endian (e); expected : 32 : endian (e) |} in (match%bitstring bits with | {| actual : 32 : endian (e); actual : 32 : endian (e); actual : 32 : endian (e) |} -> if actual <> expected then failwith (sprintf "actual %ld <> expected %ld" actual expected) | {| _ |} as bits -> Bitstring.hexdump_bitstring stderr bits; exit 1 ); loop rest | [] -> () in loop [ Bitstring.BigEndian, 0xa1b2c3d4_l; Bitstring.BigEndian, 0xa1d4c3b2_l; Bitstring.LittleEndian, 0xa1b2c3d4_l; Bitstring.LittleEndian, 0xa1d4c3b2_l; Bitstring.NativeEndian, 0xa1b2c3d4_l; Bitstring.NativeEndian, 0xa1d4c3b2_l; ] (* * Simple offset test *) let simple_offset_test _ = let make_bits i n j m k = ( let pad1 = Bitstring.ones_bitstring (n-8) in let pad2 = Bitstring.ones_bitstring (m-n-8) in [%bitstring {| i : 8; pad1 : n-8 : bitstring; j : 8; (* this should be at offset(n) *) pad2 : m-n-8 : bitstring; k : 8 (* this should be at offset(m) *) |}] ) in let test_bits bits i n j m k = match%bitstring bits with | {| i' : 8; j' : 8 : offset(n); k' : 8 : offset(m) |} when i = i' && j = j' && k = k' -> () (* ok *) | {| _ |} -> failwith (sprintf "60_simple_offset: test_bits: failed %d %d %d %d %d" i n j m k) in for n = 8 to 128 do for m = n+8 to 256 do List.iter (fun (i,j,k) -> test_bits (make_bits i n j m k) i n j m k) [0x55, 0xaa, 0x33; 0x33, 0xaa, 0x55; 0x12, 0x34, 0x56] done; done (* * Offset string. The rotation functions used for strings are * very complicated so this is worth testing separately. *) let offset_string_test _ = let make_bits si n sj m sk = ( let pad1 = Bitstring.ones_bitstring (n-64) in let pad2 = Bitstring.ones_bitstring (m-n-8) in [%bitstring {| si : 64 : string; pad1 : n-64 : bitstring; sj : 8 : string; (* this should be at offset(n) *) pad2 : m-n-8 : bitstring; sk : 64 : string (* this should be at offset(m) *) |}] ) in let test_bits bits si n sj m sk = match%bitstring bits with | {| si' : 64 : string; sj' : 8 : string, offset(n); sk' : 64 : string, offset(m) |} when si = si' && sj = sj' && sk = sk' -> () (* ok *) | {| _ |} -> failwith (sprintf "61_offset_string: test_bits: failed %S %d %S %d %S" si n sj m sk) in for n = 64 to 128 do for m = n+8 to 256 do List.iter (fun (si,sj,sk) -> test_bits (make_bits si n sj m sk) si n sj m sk) ["ABCDEFGH", "x", "HGFEDCBA"; "01234567", "0", "76543210"; "abcdefgh", "\x55", "poiuytre"] done; done (* * Test computed offsets when original_off <> 0. *) let computed_offset_test _ = let make_bits p i n j m k = let pad0 = Bitstring.ones_bitstring p in let pad1 = Bitstring.ones_bitstring (n-8) in let pad2 = Bitstring.ones_bitstring (m-n-8) in [%bitstring {| pad0 : p : bitstring; (* will be skipped below *) i : 8; pad1 : n-8 : bitstring; j : 8; (* this should be at offset(n) *) pad2 : m-n-8 : bitstring; k : 8 (* this should be at offset(m) *) |}] in let test_bits bits p i n j m k = (* * Skip the 'p' padding bits so the match starts at a non-zero offset. *) let bits = Bitstring.dropbits p bits in match%bitstring bits with | {| i' : 8; j' : 8 : offset(n); k' : 8 : offset(m) |} when i = i' && j = j' && k = k' -> () (* ok *) | {| i' : 8; j' : 8 : offset(n); k' : 8 : offset(m) |} -> Printf.printf "\n%d %d %d\n" p n m; Bitstring.hexdump_bitstring stdout bits; Printf.printf "%x %x\n" i i'; assert_equal i i'; Printf.printf "%x %x\n" j j'; assert_equal j j'; Printf.printf "%x %x\n" k k'; assert_equal k k' | {| _ |} -> assert_failure "Bitstring parsing failure" in for p = 1 to 4 do for n = 8 to 128 do for m = n+8 to 256 do List.iter (fun (i,j,k) -> test_bits (make_bits p i n j m k) p i n j m k) [0x55, 0xaa, 0x33; 0x33, 0xaa, 0x55; 0x12, 0x34, 0x56] done; done; done (* * Test save_offset_to. *) let save_offset_to_test _ = let make_bits p i n j m k = ( let pad0 = Bitstring.ones_bitstring p in let pad1 = Bitstring.ones_bitstring (n-8) in let pad2 = Bitstring.ones_bitstring (m-n-8) in [%bitstring {| pad0 : p : bitstring; (* will be skipped below *) i : 8; pad1 : n-8 : bitstring; j : 8; (* this should be at offset(n) *) pad2 : m-n-8 : bitstring; k : 8 (* this should be at offset(m) *) |}] ) in let test_bits bits p i n j m k = (* Skip the 'p' padding bits so the match starts at a non-zero offset. *) let bits = Bitstring.dropbits p bits in match%bitstring bits with | {| i' : 8; _ : n-8 : bitstring; j' : 8 : save_offset_to (j_offset); _ : m-n-8 : bitstring; k' : 8 : save_offset_to (k_offset) |} when i = i' && j = j' && k = k' && j_offset = n && k_offset = m -> () (* ok *) | {| _ |} -> failwith (sprintf "65_save_offset_to: test_bits: failed %d %d %d %d %d %d" p i n j m k) in for p = 0 to 4 do for n = 8 to 64 do for m = n+8 to 128 do List.iter (fun (i,j,k) -> test_bits (make_bits p i n j m k) p i n j m k) [0x55, 0xaa, 0x33; 0x33, 0xaa, 0x55; 0x12, 0x34, 0x56] done; done; done (* * Test check() and bind(). *) let check_bind_test _ = let%bitstring bits = {| 101 : 16; 202 : 16 |} in match%bitstring bits with | {| i : 16 : check (i = 101), bind (i*4); j : 16 : check (j = 202) |} -> if i <> 404 || j <> 202 then failwith (sprintf "70_check_and_bind: failed: %d %d" i j) | {| _ |} -> failwith "70_check_and_bind: match failed" (* * Test hexdump. *) let () = let diff = "diff" in let files = Sys.readdir "../../../tests/data" in let files = Array.to_list files in let files = List.filter ( fun filename -> String.length filename > 3 && filename.[0] = 'r' && filename.[1] = 'n' && filename.[2] = 'd' ) files in let files = List.map ( fun filename -> let n = String.sub filename 3 (String.length filename - 3) in let n = int_of_string n in let bits = Bitstring.bitstring_of_file ("../../../tests/data/" ^ filename) in (* * 'bitstring_of_file' loads whole bytes. Truncate it to * the real bit-length. *) let bits = Bitstring.takebits n bits in filename, n, bits ) files in (* * Hexdump the bits, then compare using external 'diff' program. *) List.iter ( fun (filename, n, bits) -> let output_filename = sprintf "../../../tests/data/hex%d.actual" n in let chan = open_out output_filename in Bitstring.hexdump_bitstring chan bits; close_out chan ) files; List.iter ( fun (filename, n, bits) -> let actual_filename = sprintf "../../../tests/data/hex%d.actual" n in let expected_filename = sprintf "../../../tests/data/hex%d.expected" n in let cmd = sprintf "%s -u %s %s" (Filename.quote diff) (Filename.quote expected_filename) (Filename.quote actual_filename) in if Sys.command cmd <> 0 then ( exit 1 ) ) files (* * Regression test for bug in 'as-binding' found by Matej Kosik. * $Id$ *) let as_binding_bug_test _ = let bits = Bitstring.ones_bitstring 1 in match%bitstring bits with | {| _ : 1 |} as foo -> let len = Bitstring.bitstring_length foo in if len <> 1 then ( Bitstring.hexdump_bitstring stderr foo; eprintf "test error: length = %d, expecting 1\n" len; exit 1 ) | {| _ |} -> assert false (* * Regression test for bug in concatenation found by Phil Tomson. *) let concat_regression_test _ = let errors = ref 0 in let bs_256 = Bitstring.ones_bitstring 256 in assert (Bitstring.bitstring_length bs_256 = 256); let%bitstring bs2 = {| false : 1; (Bitstring.subbitstring bs_256 0 66) : 66 : bitstring |} in let len = Bitstring.bitstring_length bs2 in if len <> 67 then ( eprintf "invalid length of bs2: len = %d, expected 67\n" len; Bitstring.hexdump_bitstring stderr bs2; incr errors ); let%bitstring bs3 = {| false : 1; (Bitstring.subbitstring bs_256 0 66) : 66 : bitstring; (Bitstring.subbitstring bs_256 66 67) : 67 : bitstring |} in let len = Bitstring.bitstring_length bs3 in if len <> 134 then ( eprintf "invalid length of bs3: len = %d, expected 134\n" len; Bitstring.hexdump_bitstring stderr bs3; incr errors ); let%bitstring bs4 = {| (Bitstring.subbitstring bs_256 66 67) : 67 : bitstring |} in let len = Bitstring.bitstring_length bs4 in if len <> 67 then ( eprintf "invalid length of bs4: len = %d, expected 67\n" len; Bitstring.hexdump_bitstring stderr bs4; incr errors ); let bs5 = Bitstring.concat [Bitstring.subbitstring bs_256 0 66; Bitstring.subbitstring bs_256 66 67] in let len = Bitstring.bitstring_length bs5 in if len <> 133 then ( eprintf "invalid length of bs5: len = %d, expected 133\n" len; Bitstring.hexdump_bitstring stderr bs5; incr errors ); let bs6 = Bitstring.concat [ Bitstring.subbitstring bs_256 0 64; Bitstring.subbitstring bs_256 64 64] in let len = Bitstring.bitstring_length bs6 in if len <> 128 then ( eprintf "invalid length of bs6: len = %d, expected 128\n" len; Bitstring.hexdump_bitstring stderr bs6; incr errors ); let bs7 = Bitstring.concat [ Bitstring.subbitstring bs_256 0 65; Bitstring.subbitstring bs_256 65 64] in let len = Bitstring.bitstring_length bs7 in if len <> 129 then ( eprintf "invalid length of bs7: len = %d, expected 129\n" len; Bitstring.hexdump_bitstring stderr bs7; incr errors ); if !errors <> 0 then exit 1 (* * Prefix tests. *) let is_prefix_basic_aligned_test _ = (* Match mod8 bitstrings *) let%bitstring bs1 = {| 0x1234 : 16 : bigendian |} in let%bitstring bs2 = {| 0x12 : 8 |} in assert_bool "Prefix failed" (Bitstring.is_prefix bs1 bs2); (* Match other bitstrings *) let%bitstring bs1 = {| 0x1A2 : 11 : bigendian |} in let%bitstring bs2 = {| 0x1A : 7 |} in assert_bool "Prefix failed" (Bitstring.is_prefix bs1 bs2) let is_prefix_nested_aligned_test _ = (* Match mod8 bitstrings *) let%bitstring bs1 = {| 0x12345678l : 32 : bigendian |} in let%bitstring bs2 = {| 0x56 : 8 |} in begin match%bitstring bs1 with | {| _ : 16; n : -1 : bitstring |} -> assert_bool "Prefix failed" (Bitstring.is_prefix n bs2) | {| _ |} -> assert_failure "Invalid bitstring" end; (* Match other bitstrings *) begin match%bitstring bs1 with | {| _ : 18; n : -1 : bitstring |} -> begin match%bitstring bs2 with | {| _ : 2; m : -1 : bitstring |} -> assert_bool "Prefix failed" (Bitstring.is_prefix n m) | {| _ |} -> assert_failure "Invalid bitstring" end | {| _ |} -> assert_failure "Invalid bitstring" end let is_prefix_basic_unaligned_test _ = let%bitstring bs1 = {| 0x1234 : 15 : bigendian |} in let%bitstring bs2 = {| 0x12 : 7 |} in assert_bool "Prefix failed" (Bitstring.is_prefix bs1 bs2) let is_prefix_nested_unaligned_test _ = let%bitstring bs1 = {| 0x12345678l : 32 : bigendian |} in let%bitstring bs2 = {| 0x8A : 8 |} in match%bitstring bs1 with | {| _ : 13; nested : -1 : bitstring |} -> assert_bool "Prefix failed" (Bitstring.is_prefix nested bs2) | {| _ |} -> assert_failure "Invalid bitstring" let suite = "BitstringLegacyTests" >::: [ "load_test" >:: load_test; "run_test" >:: run_test; "match_random_bits_test" >:: match_random_bits_test; "match_random_bits_with_int_test" >:: match_random_bits_with_int_test; "check_value_limits_test" >:: check_value_limits_test; "signed_byte_create_test" >:: signed_byte_create_test; "signed_byte_create_and_match_test" >:: signed_byte_create_and_match_test; "signed_int_limits_test" >:: signed_int_limits_test; "fixed_extraction_test" >:: fixed_extraction_test; "extract_regression_test" >:: extract_regression_test; "construct_and_match_random_test" >:: construct_and_match_random_test; "nasty_non_aligned_corner_case_test" >:: nasty_non_aligned_corner_case_test; "concat_bit_get_test" >:: concat_bit_get_test; "compare_test" >:: compare_test; "subbitstring_test" >:: subbitstring_test; "takebits_test" >:: takebits_test; "file_load_test" >:: file_load_test; "zeroes_ones_test" >:: zeroes_ones_test; "endianness_test" >:: endianness_test; "simple_offset_test" >:: simple_offset_test; "offset_string_test" >:: offset_string_test; "computed_offset_test" >:: computed_offset_test; "save_offset_to_test" >:: save_offset_to_test; "check_bind_test" >:: check_bind_test; "as_binding_bug_test" >:: as_binding_bug_test; "concat_regression_test" >:: concat_regression_test; "is_prefix_basic_aligned_test" >:: is_prefix_basic_aligned_test; "is_prefix_nested_aligned_test" >:: is_prefix_nested_aligned_test; "is_prefix_basic_unaligned_test" >:: is_prefix_basic_unaligned_test; "is_prefix_nested_unaligned_test" >:: is_prefix_nested_unaligned_test; ] bitstring-4.1.1/tests/BitstringLegacyTest.mli000066400000000000000000000000461431112327400213170ustar00rootroot00000000000000open OUnit2 val suite : OUnit2.test bitstring-4.1.1/tests/BitstringLetStarSyntaxTest.ml000066400000000000000000000031511431112327400225270ustar00rootroot00000000000000open OUnit2 let ( let* ) = Option.bind let ( let+ ) x f = Option.map f x let ( and* ) a b = let* a = a in let+ b = b in a, b ;; let ( and+ ) = ( and* ) let match_bits_with_let_star_syntax _ = (let* bits = Some (Bitstring.bitstring_of_string "U") in Some (match%bitstring bits with | {| hi: 4; lo: 4 |} -> assert_equal hi lo | {| _ |} -> assert_failure "Something wen't terribly wrong!")) |> ignore ;; let match_bits_with_let_plus_syntax _ = (let+ bits = Some (Bitstring.bitstring_of_string "U") in match%bitstring bits with | {| hi: 4; lo: 4 |} -> assert_equal hi lo | {| _ |} -> assert_failure "Something wen't terribly wrong!") |> ignore ;; let match_bits_with_and_star_syntax _ = (let* s = Some 5 and* bits = Some (Bitstring.bitstring_of_string "U") in Some (match%bitstring bits with | {| hi: 4; lo: 4 |} -> assert_equal lo s | {| _ |} -> assert_failure "Something wen't terribly wrong!")) |> ignore ;; let match_bits_with_and_plus_syntax _ = (let* s = Some 5 and+ bits = Some (Bitstring.bitstring_of_string "U") in Some (match%bitstring bits with | {| hi: 4; lo: 4 |} -> assert_equal lo s | {| _ |} -> assert_failure "Something wen't terribly wrong!")) |> ignore ;; let suite = "BitstringLetStarSyntaxTest" >::: [ "match_bits_with_let_star_syntax" >:: match_bits_with_let_star_syntax ; "match_bits_with_let_plus_syntax" >:: match_bits_with_let_plus_syntax ; "match_bits_with_and_star_syntax" >:: match_bits_with_and_star_syntax ; "match_bits_with_and_plus_syntax" >:: match_bits_with_and_plus_syntax ] ;; bitstring-4.1.1/tests/BitstringParserTest.ml000066400000000000000000000176141431112327400212070ustar00rootroot00000000000000(* * Copyright (c) 2016 Xavier R. Guérin * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open OUnit2 open Bitstring (* * EXT3 superblock parsing test *) let ext3_test context = let bits = Bitstring.bitstring_of_file "../../../tests/data/ext3_sb" in match%bitstring bits with (* * Check if the file is an EXT3 superblock *) | {| 50200_l : 32 : littleendian (* Inodes count *) ; _ : 32 : littleendian (* Blocks count *) ; _ : 32 : littleendian (* Reserved blocks count *) ; 155333_l : 32 : littleendian (* Free blocks count *) ; 50150_l : 32 : littleendian (* Free inodes count *) ; _ : 32 : littleendian (* First Data Block *) ; _ : 32 : littleendian (* Block size *) ; _ : 32 : littleendian (* Fragment size *) ; _ : 32 : littleendian (* # Blocks per group *) ; _ : 32 : littleendian (* # Fragments per group *) ; _ : 32 : littleendian (* # Inodes per group *) ; _ : 32 : littleendian (* Mount time *) ; _ : 32 : littleendian (* Write time *) ; _ : 16 : littleendian (* Mount count *) ; _ : 16 : littleendian (* Maximal mount count *) ; 0xef53 : 16 : littleendian (* Magic signature *) |} -> () (* * Otherwise, throw an error *) | {| _ |} -> failwith "Invalid EXT3 superblock" (* * GIF parser test *) let gif_test context = let bits = Bitstring.bitstring_of_file "../../../tests/data/sad_face.gif" in match%bitstring bits with (* * Check if the file is a GIF image *) | {| ("GIF87a" | "GIF89a") : 6*8 : string ; (* GIF magic. *) 2145 : 16 : littleendian ; 2145 : 16 : littleendian ; true : 1 ; (* Has colormap? *) 7 : 3 ; (* Color res = colorbits+1 *) false : 1 ; 7 : 3 ; (* Bits/pixel = bps+1 *) 0 : 8 ; (* Background colo *) 0 : 8 |} -> () (* * Otherwise, throw an error *) | {| _ |} -> failwith "Invalid GIF image" (* * PCAP parser test *) let to_bitstring_endian = function | 0xa1b2c3d4_l | 0xa1b23c4d_l -> Bitstring.BigEndian | 0xd4c3b2a1_l | 0x4d3cb2a1_l -> Bitstring.LittleEndian | _ -> failwith "Unknown PCAP format" let pcap_ipv4_test context ipv4 = match%bitstring ipv4 with | {| 4 : 4; 5 : 4; 0 : 8; (* dscn/ecn *) 60 : 16 : bigendian; 0x92A6 : 16 : bigendian; (* ident *) 0x02 : 3; (* flags *) 0 : 13 : bigendian; (* fragment offset *) 64 : 8; (* ttl *) 0x06 : 8; 0xFA91 : 16 : bigendian; (* checksum *) 0xC0 : 8; 0xA8 : 8; 0x01 : 8; 0x21 : 8; (* source IP *) 0xCC : 8; 0xB2 : 8; 0x1F : 8; 0x08 : 8; (* destination IP *) _ : -1 : bitstring |} -> () | {| _ |} -> failwith "Not a valid IPv4 layer" let pcap_eth_test context eth = match%bitstring eth with | {| 0x00 : 8; 0xA0 : 8; 0xC5 : 8; 0x8F : 8; 0xE3 : 8; 0xC7 : 8; (* destination MAC *) 0x00 : 8; 0x0C : 8; 0x76 : 8; 0x1C : 8; 0x1B : 8; 0x97 : 8; (* source MAC *) 0x0800 : 16 : bigendian; (* EtherType *) ipv4 : -1 : bitstring |} -> pcap_ipv4_test context ipv4 | {| _ |} -> failwith "Not a valid Ethernet layer" let pcap_packet_test context endian packet = match%bitstring packet with | {| _ : 32; _ : 32; incl_len : 32 : endian (endian); orig_len : 32 : endian (endian); eth : (Int32.to_int incl_len) * 8 : bitstring |} -> pcap_eth_test context eth | {| _ |} -> failwith "Not a valid packet descriptor" let pcap_test context = let bits = Bitstring.bitstring_of_file "../../../tests/data/net.pcap" in match%bitstring bits with (* * Check if the file is a PCAP file *) | {| ((0xa1b2c3d4_l | 0xa1b23c4d_l | 0xd4c3b2a1_l | 0x4d3cb2a1_l) as magic) : 32; 2 : 16 : littleendian; (* major *) 4 : 16 : littleendian; (* minor *) _ : 32; (* time zone *) 0_l : 32; (* unused *) _ : 32; (* snaplen *) _ : 32; (* network *) packet : -1 : bitstring |} -> pcap_packet_test context (to_bitstring_endian magic) packet (* * Otherwise, throw an error *) | {| _ |} -> failwith "Not a valid PCAP file" (* * Function-style parser test *) let function_parser = function%bitstring | {| 1 : 3 ; 2 : 4 ; "hello" : 40 : string |} -> assert_bool "Bitstring is valid" true | {| _ |} -> assert_bool "Invalid bitstring" false ;; let function_parser_test context = [%bitstring {| 1 : 3; 2 : 4; "hello" : 40 : string |}] |> function_parser (* * Function-style parser test, inline *) let function_parser_inline_test context = [%bitstring {| 1 : 3; 2 : 4; "hello" : 40 : string |}] |> function%bitstring | {| 1 : 3 ; 2 : 4 ; "hello" : 40 : string |} -> assert_bool "Bitstring is valid" true | {| _ |} -> assert_bool "Invalid bitstring" false (* * parser with a guard (PR#16) *) let parser_with_guard_test context = let bits = Bitstring.bitstring_of_string "abc" in match%bitstring bits with | {| "abc" : 24 : string |} when false -> assert_bool "Guard was ignored" false | {| _ |} -> assert_bool "Guard was honored" true (* * Wrong fastpath extraction function #46 *) let wrong_fp_extraction context = let mb = ((Bytes.of_string "\000\000\145"), 0, 24) in match%bitstring mb with | {| matched_value : 24 : bigendian |} -> assert_equal matched_value 145 | {| _ |} -> assert_bool "Invalid bitstring" false let wrong_fp_extraction_dynamic context = let mb = ((Bytes.of_string "\000\000\000\145"), 0, 32) and on = 8 in match%bitstring mb with | {| _ : on ; matched_value : 24 : bigendian |} -> assert_equal matched_value 145 | {| _ |} -> assert_bool "Invalid bitstring" false (* * Test suite definition *) let suite = "BitstringParserTest" >::: [ "ext3" >:: ext3_test; "gif" >:: gif_test; "pcap" >:: pcap_test; "function" >:: function_parser_test; "function_inline" >:: function_parser_inline_test; "parser_with_guard" >:: parser_with_guard_test; "wrong_fp_extraction" >:: wrong_fp_extraction; "wrong_fp_extraction_dynamic" >:: wrong_fp_extraction_dynamic; ] bitstring-4.1.1/tests/BitstringParserTest.mli000066400000000000000000000000301431112327400213400ustar00rootroot00000000000000val suite : OUnit2.test bitstring-4.1.1/tests/BitstringQualifierTest.ml000066400000000000000000000037241431112327400216710ustar00rootroot00000000000000(* * Copyright (c) 2016 Xavier R. Guérin * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open OUnit2 open Bitstring (* * Test of the map() qualifier *) let map_test context = let source = [%bitstring {| 1 : 16 ; 2 : 16 |}] in match%bitstring source with | {| value0 : 16 : map (fun v -> v + 1) ; value1 : 16 : map (fun v -> Some v) |} -> assert_equal value0 2; begin match value1 with | Some v -> assert_equal v 2 | _ -> assert_bool "Invalid map result" false end | {| _ |} -> assert_bool "Invalid pattern" false (* * Test of the save_offset_to() qualifier *) let save_offset_test context = let source = [%bitstring {| 1 : 3 ; 2 : 7; 5 : 4; "abc" : -1 : string |}] in match%bitstring source with | {| _ : 3 : save_offset_to (off0) ; _ : 7 : save_offset_to (off1) ; _ : 4 : save_offset_to (off2) ; "abc" : 24 : save_offset_to (off3), string |} -> assert_equal off0 0; assert_equal off1 3; assert_equal off2 10; assert_equal off3 14 | {| _ |} -> assert_bool "Invalid pattern" false (* * Test suite definition *) let suite = "BitstringQualifierTest" >::: [ "map" >:: map_test; "save_offset_to" >:: save_offset_test ] let () = run_test_tt_main suite bitstring-4.1.1/tests/BitstringQualifierTest.mli000066400000000000000000000000301431112327400220250ustar00rootroot00000000000000val suite : OUnit2.test bitstring-4.1.1/tests/bitstring_tests.ml000066400000000000000000000003651431112327400204470ustar00rootroot00000000000000open OUnit2 let () = [ BitstringLegacyTest.suite; BitstringParserTest.suite; BitstringConstructorTest.suite; BitstringQualifierTest.suite; BitstringLetStarSyntaxTest.suite; ] |> List.iter (fun t -> run_test_tt_main t) bitstring-4.1.1/tests/data/000077500000000000000000000000001431112327400155735ustar00rootroot00000000000000bitstring-4.1.1/tests/data/ext3_sb000066400000000000000000000020001431112327400170550ustar00rootroot00000000000000L7'^ GGS]G <HxTDK/bootQbJ$MY`{u ]G@bitstring-4.1.1/tests/data/hex1.expected000066400000000000000000000001171431112327400201620ustar00rootroot0000000000000000000000 00 |. | bitstring-4.1.1/tests/data/hex10.expected000066400000000000000000000001171431112327400202420ustar00rootroot0000000000000000000000 cc 40 |.@ | bitstring-4.1.1/tests/data/hex1000.expected000066400000000000000000000011701431112327400204020ustar00rootroot0000000000000000000000 8e 73 d4 ea e8 ce 66 ef ac 06 e2 fe 01 95 40 65 |.s....f.......@e| 00000010 8b 6a b1 1b 1f 5a 0c 86 09 af d9 11 79 1f 9d ee |.j...Z......y...| 00000020 94 86 2d d2 9e a9 02 46 f1 0e d4 99 ac 5b 28 60 |..-....F.....[(`| 00000030 70 21 6f 5b 9b 99 85 bb 3c 4b fa 83 53 f6 c6 fb |p!o[......l.. | bitstring-4.1.1/tests/data/hex500.expected000066400000000000000000000004741431112327400203340ustar00rootroot0000000000000000000000 c7 ad 45 e8 53 ef 72 1b c0 46 17 14 40 a9 1a d0 |..E.S.r..F..@...| 00000010 3e d3 36 58 08 d7 89 68 b0 4b ac b4 54 04 00 5d |>.6X...h.K..T..]| 00000020 45 89 97 21 23 be a5 8d 36 0d 11 ea 1e 5d bb 90 |E..!#...6....]..| 00000030 71 f1 cd e2 3c fe 27 a5 b5 92 7c 58 a1 a2 80 |q...<.'...|X... | bitstring-4.1.1/tests/data/hex6.expected000066400000000000000000000001171431112327400201670ustar00rootroot0000000000000000000000 e0 |. | bitstring-4.1.1/tests/data/hex63.expected000066400000000000000000000001171431112327400202520ustar00rootroot0000000000000000000000 fd 99 44 37 d6 b2 9e 14 |..D7.... | bitstring-4.1.1/tests/data/hex64.expected000066400000000000000000000001171431112327400202530ustar00rootroot0000000000000000000000 02 6b 77 6f f6 f0 4d c8 |.kwo..M. | bitstring-4.1.1/tests/data/hex65.expected000066400000000000000000000001171431112327400202540ustar00rootroot0000000000000000000000 be 50 66 8c a3 d7 8e e3 80 |.Pf...... | bitstring-4.1.1/tests/data/hex66.expected000066400000000000000000000001171431112327400202550ustar00rootroot0000000000000000000000 65 fd ed ab 1e f9 bb b6 40 |e.......@ | bitstring-4.1.1/tests/data/hex67.expected000066400000000000000000000001171431112327400202560ustar00rootroot0000000000000000000000 a3 28 db b6 d5 7f fe 43 40 |.(.....C@ | bitstring-4.1.1/tests/data/hex7.expected000066400000000000000000000001171431112327400201700ustar00rootroot0000000000000000000000 6c |l | bitstring-4.1.1/tests/data/hex8.expected000066400000000000000000000001171431112327400201710ustar00rootroot0000000000000000000000 59 |Y | bitstring-4.1.1/tests/data/hex9.expected000066400000000000000000000001171431112327400201720ustar00rootroot0000000000000000000000 33 00 |3. | bitstring-4.1.1/tests/data/net.pcap000066400000000000000000000001621431112327400172250ustar00rootroot00000000000000ò dBkT JJŏ vE<@@!̲-4gД T>bitstring-4.1.1/tests/data/rnd1000066400000000000000000000000011431112327400163510ustar00rootroot00000000000000[bitstring-4.1.1/tests/data/rnd10000066400000000000000000000000021431112327400164320ustar00rootroot00000000000000Dbitstring-4.1.1/tests/data/rnd1000000066400000000000000000000001751431112327400166050ustar00rootroot00000000000000sf@ejZ y-ҞFԙ[(`p!o[lbitstring-4.1.1/tests/data/rnd500000066400000000000000000000000771431112327400165320ustar00rootroot00000000000000ǭESrF@>6X׉hKT]E!#6 ]q<'|Xbitstring-4.1.1/tests/data/rnd6000066400000000000000000000000011431112327400163560ustar00rootroot00000000000000bitstring-4.1.1/tests/data/rnd63000066400000000000000000000000101431112327400164410ustar00rootroot00000000000000D7ֲbitstring-4.1.1/tests/data/rnd64000066400000000000000000000000101431112327400164420ustar00rootroot00000000000000kwoMbitstring-4.1.1/tests/data/rnd65000066400000000000000000000000111431112327400164440ustar00rootroot00000000000000Pf׎bitstring-4.1.1/tests/data/rnd66000066400000000000000000000000111431112327400164450ustar00rootroot00000000000000eqbitstring-4.1.1/tests/data/rnd67000066400000000000000000000000111431112327400164460ustar00rootroot00000000000000(۶C\bitstring-4.1.1/tests/data/rnd7000066400000000000000000000000011431112327400163570ustar00rootroot00000000000000mbitstring-4.1.1/tests/data/rnd8000066400000000000000000000000011431112327400163600ustar00rootroot00000000000000Ybitstring-4.1.1/tests/data/rnd9000066400000000000000000000000021431112327400163620ustar00rootroot000000000000003[bitstring-4.1.1/tests/data/sad_face.gif000066400000000000000000001575171431112327400200270ustar00rootroot00000000000000GIF89aaa  !!""%%&&((++,,..00335577668899::;;<<==>>??777888999;;;<<x&袌6qzV<2`wrH#h'DH!*무j뭸J"XI(X "<Ё F@jfܪO4YH+n hPJ+kB M萁' kXΤG6 gw lBl`({F9 0,Gȑͥy`"@-D Hho/RAġLE4 C7S -Q6Yˆ|{ӭfZq_aQ7gr&,ߠ!"Cɮi๾8?Y`yLİ#WVBy홛uSU&#nLt)6%|>֬~XLZ Ik~U}U.G1I>Ыh)~NBy'Dcec (OAdVss erdvWQ M'(P{.P&55ev& )Xg%xKy`<z7&2Sd{s{=p9HIPrxh$u0F&L(g^Єo4 _Xs eBcdtfrH'T shd"ANBtdzxzvC46x$V(@&w0g(P"T8qi}cr cbtvq@&6x$E%0&D@gdpXc،qvN UaO2 ufθ1H=xx~0&t#o0&`gA;jz $n`#0& ; 鍊׋KBNbhڈ) 9IY'zNJ_O2h9Q`i7&e$@hvyo)98&u ObyMz>I#cXK(y}+$ $& i)N7EgLաZL"dcSq)7$a$}ixtI6N@[9(LpN`xa3v $T$jЙh6|N?azLvКacy$wWj@.Ŧh8Me1eK^ԉ)aÛIK$cW$H@myI96!@YtoLRQLšfaydwzٚ$(U$Sn ؠfH 7sx*ML2f{ 8ԡ}-K ~QoLg 3ڃ`cAZGK-QIBדGJIUمBZJ*ACL[j|ꥃCij|R x$qv7r :ȧ[=Z+M$6d$7w +wz;7 Ԏ+\$$֗|jwcz;H3+$Uƨ%25٪ճ*1BbKmQJbJ(cJ)"2KbIɫњ&|@4j&'bhK$DYL*BC LW1$wIR !=d ";1$N$ { W{?3Jo H⣙{)-{ CdG† $(06{I aC 6:$ KI ˪IL$Wd1 HZ;+x@0Šh8U$d$m.`&B[!55`|9LrqL;/0f圱+SL>Ja 2@x{~6-@"K.5=@Mp KIF$T0P K fI",»KgKbk.|8ÒČJnJ:ŦJ®ax Hԫ11JҨJ=TMg{$ĺͻ$[^ZH J"`jc$:w$/t]VJ%AKve @x@p1 w!/@` T=gǹ$ڠP$ف `A`5T{ mړEL",KN0 p|0 P$N(${Qd Y"HԭF$:F$R @ >8$o`$8X_ = 5$$ȔR N.5'"Mόwۘ~(~ిͤJҞLR! D):$"+L̲0LS} ,ȩ9L \65xP!MrO| F^n.Vo$$ |YMp[IK"K LjA0 z2MҗԱI6j , N^@NKaL 8.6M}Vy3$v>캡>q?$D"$3}ptJ>Ծ >JN& \>"HjcҏN2>fBO 6rKe&?"d]=0K 0  pHPC X$($X{.6@#JP /0  7P+T0&d(n8&]jU}#8x `о `O/ܬQ$-'NR+..{ Ь k:# $XA .dC$NXE5nG!EJIcK1eΤYM9uNJA$ZQIV uCӃ1BHYnWaŎ%[Yiծe[qΥ[.]]6T %l6auz.fcȑa"0Daok=,ϦYE&]iԩUfkرeϦu)EwRJ&^q: gnЂoѥO^uٵow1kh^կg ϧ_}tk=TpA(P pB +B 3pC;-l K418N>tEcqFkF] eʰ@G 4A#G$TrI&tI(ю"BH,Բ10<)sL24L4T" -sNq3sO>O@<:UtQ1*tRJ+RL3PGQPCUNASTSUuUV[uձ(U(}DVP5<`W`vXbcWuYfGEvZjZl[ٔjm[pU[*\tUw]ve[rMZ&\z UxM]~_~|^՞B`#xb+.Ga;5bK6dSRccDesygݤґyhm=h"yivi?!@:!t[:%kFFV{Y.>hl{ncs۠{ofǽ|p ߊo 2|r+\bq;wjrK7tv[w^bB kv+ BvD_א݀܋7xqlA5wyݓ䫷zQ{Ð7|7͂}Fc|^P~?+O#~kɠx?&P+A!@Fpm*xA fppm*J$AMMxB,$BBzNE$A mxCRK,Q }@xD$ jc7HbxEhb>~,BbxPihb(@1hc("ocA8ᎃ$d!8&Ïd$Gd%;r Hd'H $e)dde+)Lb%I4ϕ%+Rü^&S$ 0['bFS; E.SfKuMb$Ntdg;_tg=W%g? s gA Z&L@?PD FyPfCZ<"Qt&8E TEOET3IL: T;Un 3TC%jNӁ(KeX2TSjUwOMjW/@njYzOPWJNchk] g  [zP`Lx] {X],AWoH6XfViG (Kh"-\'vفemk] r : mmqRmo}"|06mqE 0ms\,- `\w`t 8WM4{<6" p^Lo}u AH{KI@9{`'aB F4|P@ gX&9`,&V+ p]bI7 i:Qf"qC c YȾFOR! ¤D8eDcSr!A(Ē3a^9Vk`î bt.'p;^qx}mlj!tH mfwd}@H64'\((Q$@I o[ gG 8,OЃ Kt"#+EH"D%q@! F H 9ҠΆ]C'M.\Kgz& ]SzՓcb[zׅ‚bc'{ͮ(zd +zݞ!{>{~w_Pwh HG~x'^0:^)f.^|An# |ET4|]z[F3q,xLAfpC }|'K>v6!g0C(0A8 j8C.h W V$)X p,h `CΠ6p8`b8e`gknrHvz}<@ @@ {pqf5+@30X``lw @Ao6XS.haA&lB'|Bm1="BI1m(B0 Clg8B4,8@gX-1|C8nKC<Ø9|C@ DA&wPCDLDepA|DHĵnh3EDL5DODP vDS<ŷ[apPlEWuT#ЃCyʖPE&ȡuxEflƅfCd,h": cF`f gGr|!F P>%c_P8$RdžPqrGq)d$(yl ?2H"~@C&HHع4X9SY3ѭi;MDU(XK\p}3"[}dV`(^.M0jDhaH.øarשQ (&1m*=xya( 0&!n ؚ+hE H!(cc!UJU\-jV;_0AAl*s "NdH ^h8Օ`QXbـ ZNF'MerԐ+fe^\eZהƖ%B._V[TXf٪͔`qnzYf_5n/,dZT pn0@Fhg I$)V҂ eyNWXVg#RA> !` vZYh7"I8(ښ \v4lAFᆉ: ]&RXWWj! '[>W!I"$ j Tpji_)TnY~50!YjtM%g66<]jHMkt3G%7f8kp!ib.8hzSCx"ߌĵӐ!_c1.]*٧q\F&^mz#b1)ږf#ۦ7zSn hV$:`6`]Bؚ* ͼ"W+n4j.]mȶ"WXW+n,R4宭?[$͘:4 S]HAdɆ[iA);2j3I1+cP܆9c;o1~Sjqs 럐D؆IpoSJq sj89Rd"(վrJxA-9aSq+G!sZpOA ߌpZh4,LU4U|ijp=VV>uK.(͗H'$`tpprL$$LD :(N|lUΘ]6N]WϜWӆ͘6xhNJmmY0ւQgQbEqϗ ey8Æ!w:Rlz7=AiZ|LT/x&YrpvW_ѝl MnZ̘%xUIE?!{z(*(2BT&Aj)zOXP3Ϩ **6 Hc?sZ+ ;lJVUű@,J;-6WcXlUd+֊;.{.ax}{Um-;/{/3!6N ;0|0 'K<1[('!<2%eplRb21<35++k 3A =o~hsM;4Q o76$5]{5?!7Wsa6mQ$`&fy7A0t#7+f [~9NJmD.8=9 .+R(dR$0!}vDN4K$<G8<H,L4O@!wBH!(#\I( +2-KJH|+6p*(1'p| s< ߌ[OlE'.| Lb&!RUQG!z B^%2N|p U  B-pRbl ;P<#Ө5+P,5 \?P8(^p(A<~~pX`(IH[Ih$. $(C)J-u&[™a T(s]򲗾UGZo"+1Q.>Nּ&6Qx1(C!6)yҳS7Np2'@@F8hDЅ2}g_S@3:l8L/"&=)JS$'⣕IhᴡљNK EP>)P*ԡRGȩ[,@2WtpʔDV*VխnF@TSxաfŕ;M*\*׹ҵPAg$P2u!|QXpp,fՏNcC+ђM#>j#m5x>"-ns֕+!.W~-\ i`?$֍9ԣ>^pFC܇:]6AN L0RnxN: ;jn>6;/,4G#OSdÊ<3ϠCЎYA h?xAreV)ӾQ -ķ/?f,߫ >ߖh ʿBH~Q\9p!%Um!/~хkm?8΅?5 I6` uN EP88^oT Tn bP e * Z3 `,P!S6a N!!,9n?@V!lphơB0!!LC! j 04!\"#6"8< $Nbq#f&&%(6L1om"*X8Q>",ʴ*". RVU@%W"Q2\X% ^WeXQMY%\ (Zޥ !jĥ_%ؑ 9^4 $`.&cJ޵R(dF '( [cff&M&hZ ("!mf&j`#kT&m !k !mpjogt!Mp6s!GurVgP'esn'w":yإud?uz'32%( yƧ{@(Q%{'~#R|p(_~dR(JF NR .1Af([.-#~(>DOBQ@(m.i!#!/(rYVh&y.)>f5a@ Z2BX10)fiZ51@"Hi5Ae]j)r -jS"%6e֩ީΌ=M@ki]8)2 Ф\'=-áN*V$Bŀ-6 e*pZ*?|gCupjTBs-TC**`Ad+{]8 (@J6+Vz\V`d !pP++eC \u+\&Qv+ 4$V)H*( h&.lՕa쁜n,v(nV0%@D$DiU7x,Ƭ̪#?dn )'A *o!,8#z58By^-ff> `WlЎ +f-۶ާ>0Cq[T,AH΂&D A T)J 0é-&⚩:L 0¦I% x$▮n0tm趮벐 ;.֮^m?pq..T7/6;$.(;N/VL66/ 6/];8MC;7`4 0āP/T Pā0 4`7C;C>԰w1=7@00@71ױqc9\1AË tA5"/2#7:L r<4:'2(98C\%3C'2,Dz,/6T-@/4C75XAO4Q5̱CgFs8A6S4H3 nI 5AHy5.J4M7K47ԴO3^P2$b6jߧ7QQ@ <'ch'0  tHKA٤6q_6r.x͌@26܊qgvc6x#F!, \#vAn7{7Ov@|it-t{7^7܄ Aj 0}A7O3y@ |#>~3p1{ԤpO}8`C>A&g&$ 6oYڸ<*n D>DhoŁ<76t&i@`@hꕟ,{E:8 E/ 7yQו ɾ9ZP|]iAI9o:e]MzcUn_1@#@zko18zzCcU (3G"hVU۫>(9Q!@\#DN [Oi#c;@O),={@rÞ W!Oi˚; '=TJA#JbTDh[򃮓TPJ#I <ćÔ {C :ImLw|3ê3狃@TXǯ|*DB@<Ο`=hBa; /OC| |O}]B]"0=(SS=ؿ~S8֛(†='ϓ:6q|=X==OW;`x5 = AgSr)>%ēv=~{68{S/j>Cn~B;雸5d`(6UC?(A[S6>b5'*ZBB#Fl/݁#R<.ddR+y02]:8//?#/ H? 4xaB 6d(C/)VxcF9vdH#I4yeJ+YtfL3iִygN;yC5z9K6ujTSVzkV[vlXcɖ5{mZkٶu.tHֵ[{p` 6|qbŋ7 ]ɓ)Hsf͛9wthѣI6]eիqvlٳi׶}wnݻy׬Āupٝ6~yr˙7w:{'Wwv۹w|xb}ew~|&}~ -4l8}Xe Vѓ"\uݕ^}QL[bb=Yv8'~}hZ\`v8uݖn%+lr=t)qYSx坷[0Uuݗ~!, z >a6P~% ,5ޘ ɹe, deNNZ$uޙf梍>-a>j~ꨥ-إ鬵޺3&ʁ+:ݎjvH&曷1^H_p 1#q=2GM?JgF?]W7m]B7g}Eb䝳xz襟T=`I4W@/,y_(域ԡ8ߟ) Xlwh9̀) = `Ȱ;T!gݑa)9f71 #ݝC9DfAM0;K 5D'>Q$ Ww$^q[]E/~舅E3J3BF7:q(3ye8ѱ=GC Z!HGkB")YIKڏ##9 Dn(I9>DTe{1R ^2WU8 dK_s\4pYϰ!sT28? Ɣ[w&6Ԧ)LdGMsN{@2Nw^[:YO{ E;v@ Eέt:w>=-ޒ~ÕD9Q> EF})Ui49UVZSR-Ha8Pj'@=!ƈ>Q$F*/'VJm1 xiUkh0upմZWU@c75|mx` A}2V> jlj[d9Y_#e嵰ᳩUjץeɪךZ}תY1jp[ܜpkmhDѕKv.O\]~$ m|-UzٛP|"^T] K#dX {ԥ%-Ո@`?Z%ypw7eP>I]L\b8rS̜M0o{▥)c#9XR<8H;ɞd˨e/Gv6o1iV` p-l\g;U-&rq΁4Z`3 9,gg B,*`W z`E$L (jQg\enV\8  v@Kc`B0бZ&T_E 6DQu\.C6C(ND#a*~Wzb=>a͔Lݝ$kݟE$^* ꕂꏁ h> .(nd݅鶻e/5Z*0޳A\mBb' M؃ޫŤKHH CԷ_ zJ3,@ "p`6j`@ l #Hi`";=P k.^JPbD72oe֪.Hrbl6,ꪭ&p6FJP "5ba &g0 6 ,"bG%lFF! *m Fi c`z$@$aAyaFi0Qk{IwЫ g`Pvd`p:@o1N&@UЊ LN D zQgAe"Ыd]ܠra꒠ %R P>mq%x*ť B񒖠QK" 5Њa@kg`ϒb ߱#."UFf"+" 2#)2#q$qfdf%, S M#l i I;&.t"O'A(aAc:^`)/R)[̫]``^Z`l+G")18^Q^^@A&-G2 \EF/3%s1#Ҋee G #"u)3// .F3%MQ g6Gq`RV^p6G20 " er`%Ii3% N:/R&{4%7G3%S< RJe4e˰I s$>/ %eS%"7FER E҄!?a:c4 [G1eB$ŗsHZ&O]L%| L1+JN\ZLqG tRXFI]@(NQ6׭8ݔ\[F E\QQN* "M\ EXsBOSJqKW6RM]DјTUo1NPkO|YB]SW%Q .jT\B]xƓY1׭%7YB[N[q[M\ ʳI\Bd[̩oݎ_R KE}#>m =n݀aÐWU%@e8I&6 ӾdU=eôщ6K RfPUڃyZ"oVMhgbmkD;#5ĥ$v׮j?pK]Ŗܥ*r݄mSscYum!N42eGVqϏC`Ţ & 펔so+̰e#jeajYC7Luo4Y%lK eu*"4voF0|Vΐ4rV2ދxo Mohw @\U4 [6ӣ^zGoKǗ[z4V7@}m@PWX 4UX-6Nx· zE=c V 2 U9EK;ĥj3?W oaKQ7CXsB* nv+qJ{vA\A3.YfXT+qxX^[n-ą ɯŊBl+:]5{0Ԛ=W R*[nڌ ÎB*m̉{8z5{AU*V|~͹ec}{ UXD*Xa],nwG[72w!ϗ}V*RVoC69W?EbIM[ft[:i@dG`夝Bm"+Kza+Ґٜ"*VJ)HYX`{$s@mNs$#;BnetD\׳Ge{Q{AX?E Rs1%\{_:M [ !Ïb]_f :ZY=YeeAlpzz!dxfRXeYEῄ崕oDOn^arG{"Y%BY%g]Ra`5$( 0Dq$Ja+^0ES~ĆYpU^g޾ryi{>{X}菞KX`)RB^?KX2SXu귞*VmS^nV!(uj?%jFX+_; ZmEV~lUX+iU?}?E *V>S_/) Vx{gȧg~?ek{BUR )e}?SRYeo_VY_߀ZP?~FR@m_|HUYKwU <0B~9|1ĉ+Z1ƍ;z2ȑ$K<2ʕ,[| 3̙4kڼ3Ν<{ 4СD=4ҥ!,| 5BiZ ӭ\z 6رd˚=6ڵlۺ} 7ܹ* ``xyE7 >8Ō;~ 9'?,5^?̜: :ѤK>:լ[~}QB;?{ <ċ?<|t紉,=ܻ{>A&ƻ?ۿ?DfZG`` .`_DNU`na~b":T~?&Lj.c2Hc6uNJy:%ÍBIdFd"#VbLW!dV^eZnedHi2<UtfjfnIR$eJepg~ h "'TE E h> iN*S&QsBP jJjTbQ?wzJkފIz?5klʾȀ?8KP#^mnmrP;8mn$+1ػo;S(C<"p /p:q<8qo s/r*#r>r6ߌs:`1s :MtF=stYROMuV#,[47qubMvHhn7\Gg wrM7I_{}sou xĽ]2x?yѝs oy瞧½Xtyꪯκ[ѹsߎ{]{|Bs/$O}_#;8Ҍ}O~r+.qoFĽt 2\,Hv*p lRpvGǸ jp/ُ4Aio, OB^Z^e.kp4!_w/_Gl z3Wv kCl}6,+PJ,} zl <)V[B|l 5*F+zK!? ["t\"@!*jC$L؞ fE,RB@̒-(+m2ZՈ#~<^xn hJsWA X[D1q#zx1JB 35 xsE$q \q1I/Y.XA$` mCF)4B{,,s/h^#\EPA-IOy&GpKReWJ Ԡ 56Ϝn JMENBJ9Ԭju\*AYPT^>*vDceS-6ut] JԢ}3m|=.V!umcCV+$ؘ^Tlr (౤-iOk B싘j.ei\k _| $@o 6 ,nuvm5;SAԭuKA}Qܵ#z hw@m{K]4.=q0tq^&[(-`>A^MZAkpdfg&xK'’0%l9y $,x4FlI6Og(|Z$+yL.Adh^1`h.tE) 0y̿6 PV >4q%<6y"Es_痰zn Ɔ~N4KbW!,MI`.OjI0ŅMOlB/b>z׼ڈVz"R`d=bFQŃ hK{YEDo"ۅcMj{.wP5z(B %0|?T6`XFw RqÁRm}+| o;?pYSѫY 62p?O3},ySv.~@q|49 H9@6/яtX1 }NӊEo`$Hk}\Sa4zF@O]o& 7av꣍_, ~7|EOy,𔯼/ el C{6vǼOK%wE"Fl|~, ~?\O7ܳqг0hɩo{ U(cm{Mlliju7Ty~BwZ?({pfkm lF20Hh¦0FT h' r xqmF?/7T&;ȃ&P?X$ #08h 70r@I//p6?0Jx@ P 0 ztV ` `  y`FE^V& Uw!:e f4mDݲ+XZ 6DwP p P 6` |I:@%!pc!rxUF,0]H-A/! ;0R@ xP ` OP!K )RJ&N"GI (GJJve;p КIU2 `aDCmYF@$PY M@ T- `|@XZר PIBD#@t$B` j#:5` I@"* g y< @AJ>0 GaI0O*B`/C )_zH pRX'%/JIP =4 kN `[y { >Z `IoAamP|ʩ' P 73@IhWI Rک*s ) 4꫿:7`I`I%ʬTT}*ё͊j3UI!3wJ1NGI3T`I`*2T슯)"TK9 ɲ Ƅj)˰ ;+eIXp"XI"ԋ JK%ko2!˲\@K"M0ɧlN{0M='ʭl@0M=ʳG MʹBML˿lCDMB,0M AMfѼC}MA@8M+BQ5M\>$Mg|JCMSL\<KM P5M 9tiKjNdBM8);MG$ MSCMM7zLMVMMPF]5M5^ :S^% D71p1u$8M jԔ?(FWQ-hKՄrRhYM֛ k]+bLMlPq-pOjw *g O+}}qOQ׃(wKM׉s OI؏&> Oؕmv0O- ٛ$P0Oc١={0O`^4bDϢWڵ!D4- 􎽍܉X ԄMdϭށt ގ ekmat޲4zr O ]cP&CMPpMP7 @P`IP%U &[n_%a&`Rwqζ0 'blQ@r{'q 3PgzRPP-%n+ (u^k(% .K'5+ ;]R<Rks'ʰx)5zRŎGRGx(O|?Þ Tn TgenzA5Rw.T& R^@nT_Y;YlA_$5To9.T3/xB/Z߬ =T0-pU (六PB՘.dmUN)ZuWG׀U$c]\H/^6 >T6_=U6Y?VP[`]foN&Uw\Uj*6 *W)xo6]wt :WnzoJDWCcuBuҙ=>Wv?s:Ud0Īon 3 Xpï%ja CWZ/#e˯3X1XcBX9oUQD-F=~RH%M4YJ-]SL5męSN=}TPEETRM>UTP^ŚU֓ ,]VXe͞EVZmݾW\uK6}U… FXbƍ?YdFƜY3I"y=ZhҥMFZji[6gmƝ[n}\8jjaQk͝?]tխWdv$ ^x͟G^Moݿuǟ_~*>f=D0AdAã''D?0C 7C?L ($Q61y0EWdE_dJq 1GwGt j$20ebD2I%dI',**!B2K-K/u $S*ҁ2M5dM7<Ϙ2JH3O=O!NAO NCE4QEe}4Ғ6@OK/4SM7tDI? )~%TSOE5U6!TW?MgV[ou ^u#2Q5Xa%Xc&^\6Zi-eybc[o71w$W6]ue:]V w¥^{7ߛIk v&`˺$]V 8b'X}`^9c? x88eWfe8rkbo9g+1˥&hna~fxc:iikK 3F;@ͯ离n eX Q;p=&dfxpfq\n@b7M 3BOG=uW)Gg2vD ,a=x'x⁴w ۟'4P81>{jxGF8a"绊ﺧ~[';*DXK4' 5Ё (ЂpPvK pAY` UB_ a 92(ġt1F1B7Z8D"ш){~ď@2C!4C*%p D.8b8F2B,^bG0U!쐃!юB6ʸG>яG6RpGBd LxJ&2q(#,d&Gl돟e(E-oAB&B#MOHbPA 0Tr+f0(9LbXH| pA8" #h&9L!0f:չNv9Y`"0 d` dP`= !F8& G0B0!>tȠ#0` @ @py֔iZx=ڹSԧl:TըRC~T6թG5pTVժWJvի_`լgE+OŅխok\Oj+wk^%jCl`kbج`%;YV6XHY PeE;ZҖX`:ZVN `ie;[[`FZ='(3a[׸W>q 2 ҷm pqnvwTcnxO9TEozջ^h;e] (uٻ_׿91/ 0iCp%pF3PV(C wxmq0 u|fGyUa~ bC>󒰀 F;rr:!xO:dAG:XpdQ{NsA$DdF0 $<@0FpJNP%PNJxE0B<% 0DjIhD tpeX&AHH؄PJ`tiKELDi~dmD| p !AhLK8NLHA q mǐIf xЁ$Y @P%̊+h ɞGwɎ F븃% P ɪDCq* $@H{DI5T 6 ?NYF؃ 2hLcq("ʻ;؁ x0vʤ={(A GƴPp; I#Db89t͹hHtsͻ"A+:|9o , BAxL `"v q4<x@7LT]f0O[fP2ժ> (D('>1P :8>0)Ie0OݫțE/iͽCXQЃͫi@vʽI м5HOUR4R;J)=J;/P%R4: *%>i.eӝ1: k*:D0:a6S?bŷܴCCu85?"ģ1h>@L==PşmXb XMU՜-B*QU활&Uճ)!a=oR]e!0K‚-%j/Dhn F/űr%qT*XVouGQ҂4{x8A w$x.|EXoyS- h׀X}13pXSɇ9h@LؐDe,:0ÌU7QAY;&:'0U,nF]UZ)t+Zu,-((\, [U `,4έUhY*۸[Bٵ@E+VI,-Eɫ>SpC+[НE+*EݤB хOI AB xI5 $E^ȇ!<8P%CH,6Ep@ڀ&߃H0+8]M\ƵpE#֪"]vpҪ` 4.HR˰v`؁ZS.{`@Z?xN`ЪRHuNva.VRf }a0q5*fag$V#0Z!N{HjIX,ₐ$*2hM)VK)!*x-F4Exby$V;_x *=h)B6dJOJ?&Db)0Hd_F~XjCOyb%d% PveW4xSֿ|peW^&Ah^"eb p$_ff~0 bn>zefm&Qf.j=xSanFt ,8Xqi(LjIP{_`gÇ}E%eNO(W=.  >@芶hx_R: %0郾E%`[_ ڑv闦_.8lhO~E LJZn7r%6j^Zw^;:A8ꩦjKLejL*&k0MS2sdMڱvS*Ȥ x_MU0z\;"6켶LpldB<8>D`4b^f($ 8c>&$gl2Bf־B:Ӷr4m.BꂥZk52ľJm;:5.A;+M#n;v+V!NV&oj=UV8f'^1@It_!N{8N&jp!ip?j[&pe1ʇ8q%^l.q%2}g jWr.$. C]+Jn&(~8%,'s2w&ʂrա&2s8&5_!=sY˵A&zX>72} zCt>'%F0!N?t&!,t)OGNiQo8%HYGuk!!ru#ۦ_B*@\q!eOu#q0z ZakON hT qGxo/v&w=VwR xk zoǶ}'q^YG~၂qm Z5Wx< H'yݟx' d]7qwv ېG\82`Myx ‚Z bWzzOp _wNpWW{P iwg}UhxJr /؟,F 7yEo y؟'p7H|'8)+/ׇxCމ/=H}pga7ۭ!(Q1G ݟ?:x}G/^ω-̟y` "Lp!Æ (q"Ŋ/b̨q#ǎ? )r$ɒ&OLr%˖._Œ)sÚ6o)Ϟ> *t(ѢF"Mt)ӦNB*u*ժVbͪu+׮^ +v,ٲfϢMv-۶A+wnCj2ͫw/߾~,x0/t# -ƎC,y2ʖ/cάy3Ξ?M,zt/ONz5֮_^y4yέ{7޾.|8Ə;f`{3C.}:a. ޿/~<ϣOhs.>)=4X" H.$L~RXbxZ2rh #X'bh23(4-v;أ?C:NSK2٤ms$YWb[r)R>͓cYgZDQХosYUL_9h٧MEa"2 RZv\Ҩʘjϥڪ mR⚫ꉬ[i2۬BcȒEbmhP;тpݎۮ|X[W5ċ0Ea 蛰 30L4S\-\/8ܱxj8Sr\63\3<+3䌓6]G# AďOC}LCWc[o]cW kݶ^ip6Cr]cb#BAݷOP6w#xCMrͣӷ@裓^:J|^ zljN^zD V^#_ CS;?c}@0N߃_Ro磟~~Bßנw7zK h"3KcwH +h ;9*n! KhBX vU ݝ02! I:Y9v1B`#vg"b'WK"ݕAZ"ةb,V5b.1jbW1qUh;oI=?r0#! iȤ5 u##DE␒$%C&YTR?bWO2 @Sf(;C([W*kt%/{'.|92\&s3aFikb3N3M#u&9i!E"u&;s'=Mυ܋8>Gz4=P>7}"4&`ЇB<\jQr(G;Q,sv(IEe*])K?S˥23.ׂ4: .",ӣ"5ibTRqCS*UjUqxjIyկ5Qi帚Pd\Nj]+[2%ìdֻ⵭)JLb4y,aïTS VۓbilNV8cT֏h\8kӪ 8P6 M"zl{ۀJo1- Q8|]9CѸ7ׁ [k^Bt'(o27Iu{Z(y^X@oI/z77$vDN D/ |m ; C8v ޱ`Ao0;E [RXۈv 82a z+Ԍ{cBo]qܡ#9q\ ˍJ2ⳉӛ/,2(7L9j lLll>X3<~mo֍;:еkܒVCn"4-:ɞ^Gc:ӂ٬5I1Nn5Fʳ~YWZk_:OU} @5TUc dc#f6: ɞ6Cγ5tToa8#~ͮ^7ue{^ 88]aq8e9`[CWwNzm8můTD>Q-)9%fЙ.PNRac=JQthk_:ի~%|mOOvi=BJujb_;}D9:DZ得Qmy<dyxI4QC@+w<3-yӣ~<9W>לzjʚ={? P'IޘF#?y)Z>i&V>DP-n3T+72) _dR4"oeAG'%I E!P :~'\mHд b`j͋<Lfݕ-%  m ,(Ȃ/hB," @8 D)BO XU%|t@HA$B :.!, '(1\|N)A8% /pB]RT܍VN"0OB*!B4"BB-Hةa\GUMB*D⢈"NL W0. oA),"bB/#a"]̀ {O)`@1.b0V,#6ֆ DkU.;~i7Қ)f~W)iɠI}Wɸڝ)obiKZL77L8s6`f]qF &Ip[~cZ^ SԹLM(ȪzrK>UUfֵ {Q-kc06j[RBj̠J}̐ޑ3Y}kv@UMBW4ݹ&p=kUcɰC4CDgnh`)Rհj< Qݑs.>ł" >L&ÚlBNi& 'Qހ,_-n(E, c6 Q. ҂hF ^QiéA~-OΨe]0 XQmN+`N]xЬfiO nnN٪ƐNPefi %ΨjLTQ E jN)v"!Qi qnܲn9hhT8n*fЕ PBr^) zcQonfiꔤLh: LѧJ-INM5aة)x]&@0NEA$c_BGYOJ DOTEL՚p:ڑ ),TuFVO̼:epi'~ϻF?u*1խTOiEh dvQr1nF mjL%]qjKibPQ $2r.(NiBAP,h$iyҜzrJ mЁOy()Ǧv&KB4xde p-i\H ^.KqoP]W)1)}R&KcȢ⠀p@6r,iNxd:gls sNݨ @?>G3tNВݸ-rDO({4pK-r4CݠhaHg)sK0؄ZĠ,MsMGPg An u.Eu*K2<-=mUh[z1NALĄP@)Yp0]. L4^'^[06qK$el4bWW[bvtK /<h ]+tNrrjh+UFsLFv v#=nT7KJ[:hQk74NsN_ĬEth"[Gsw¦N]TLFLesQa:4i{DL : 1s,7r-s9hs7o(-/@:Nihת)T6-r?gTܘw`^AgTyK[cѯٸu&+ ta nѲ!zn᫩sg  bN'sZx2QppxZ9o*7R\ CHqLB[k*:elN=qnik&r:jVtp:on2)쪣& LQq,8i,u2&(;=a6Rh) ;jxS&ot0)6w7UQ}J4рWZvwj#qSRJLCQZ₣{+  zK- \F(l'%&*Uh ~KRkL;AdM5 '6;_e2ٴ<[YL 0;!oϯAZ%#LcU)fX5}hӯ$v jErRm!!y/d4=j/U=ۙAH/9//RwJRA="욱BVdSҷK*{篢_? :I!5cّ~$UE}0Ct!{7" ?}U%+o{!P(6UQy$0,ÿSg|l320K #0E@0`A&Tp!>!F8bE1f/ CAdI'QTeK/aƔ9fM7qԉWH?:hQG&U)L;F:jUWfպkMM;lYgՕm[oƕ6Gڢi6ջ/qv;paÇqcǏ!G>qe˗1gּd"ɟA=4-ΧQV$=vEbwo­p>xq|'WyG>:Vαg[ q߫c/U}{JI?~}P׿{R P4(nLp"|ʤ )p4& P WkA -L8,DsHC;NQƗ&q4yGQ!LhL1(Ë'g rFRK/{ b1ɤ0L*78լES?aA %@M%GG1J#t7< TSO5tQI]PPQSL━Չ)Ti Rqu.kWVUajcg\z^m7iےkjGjv&" W\"\(g]΍WKƭ%7^%7\: 8;G(nI!&6)Ɉ19͒&~S|TXQ8eDXYBYyf(n8 + pKsf;m`8]psY9o&Ho. )ySk48j%:{l~@m/`8gT>s&m#-4O;K5N<3|<© ev=G8 :t$cETߌS' pp2^[D&Eȓ`B=Fy7a8}\r ]7'˞(1աŮ@(~:}?QM gV Lq{e{uIvI8>eQG#[s%gn؝={5߻\Gd?\oE8~C?VT]xEy5`cEkP$>8-=M{L kpȠ pY!?s, A;2>ȼ*p/ 埊W,`AH1S.$ FT0-8A<^ 7R"],|.,M㬂cn@p'PRP_Ţ^<(8 56`8.ae  yqZ,"m}CB f#Q&dMn &pE q19`8A6`8N%Y\19E8@6T%M E`!* O"{pC-%O+#%Hr7&5ށ/~+8!%W".`d[xCn25B4(j/`8B'SB.\l)9j b8&*Sů\ta=+9,/>.8G,K⑜[N-QqCނ$hr/υ$E0Op6bق1Kb" \ *508@/B-8+3!.NEY4/f-/K8R4庑5E\S77I 3 !Stn|S_|a97p6Zc$,S_ґ;1pc]4# c-&S`fV=7 4c63 1mbӮ1@1#>CE.cat bj&35"A8Bߌ.dvqD3c8#08XkD0EMg ht3T/8# O8 EAÌ3G)F>+4T."a8sI9nI]8+J1#.%qc^ѶrLft3*a8"7MA2Tj.O3<_ .%PPTQFOo@2 $8"TK8tRb`K'5j$f@C534z"a8QٲT) h36J8ܡ"r$D-X g@H018X"08`YK6LjZ/gMu3,8"|E$TL\?gd` ]7 qj(¢psfa4Hs_U Jf@I63|@8h VJ1aKb%Gbe$6}^`]-v3`8a"lM8pcI'gLvyS| Wv3P8M"a8>!fK" u9u{s>v3T8a"\$8hMD8j4on`5%8$"4% yfJl@i:`$m5g_$p! o] bZ@,pOYE AJ$3[.nLELsQU)I$\ nTZ2!J2kw524!"48pwY+O: Tx9)$ˤ,a5B8D"Ĕ4zaaToA|]s qշ767 ":48m~cFf@pl 0A9n!=d`Q9 #p+&t 5x .a;j!5ELA~S9&8"@8bA@rb^f4x҇`  ~ : *)D@pJs>4 ">7p鸎;8Ea!Uh/8!v7.y-EcѬ 7)U!,8=!A!AQO7.5a9i!dyyY<5!5 +|I3a\qk9Y,57pIqCoW@8ӛxcb89[?Ic9ym7!Vy zM 7Aup8ڡN-z4ap.A@8-Q:w4Rez3q7y CA8$ԧ+mp7:L_p98RzlI#@8ɺKzI 4Ҭ1G ڭU4`̂C:ۥ@8 [{[4=q-[28`#^/A@8V__C;U18NIW{i~Z7Pqók}xF{%5(A'q ;8;? 7[{ :8ɻfCc z4ڼEE :8;G 7L|AūG#5I:84-­DCr5AA;Co#iqd~+Icl!f%y:ici%bdb:sIf#q>q#d'G#ҵ~A#$IC=ɾ}Ճ^'"I{ZI#\)W#>C="5Nߢ5z"2586u);8V"5ؾ=?+7.NÄ>ӂP-CÎP?́ICd?Y"~Tu?YC.EqCyqG1q1B_uGcC-B?#ļ9q_S8<}S87~4s8 $H*\ȰÇ#JHŋ3jȱǏ CIɓ(S\ɲ˗0cʜI͛8sɳϟ3JѣH*]PFǴիUʵׯ`ÊKٳhӪ]˶۷pʝr ֻxƓ7j-AÈ+^̸ǐ#KL"5ޜ7Ep}uӨS^ͺװc˞MH^tf#Mtȓ+_μУK?Hu|Uw:ËOӫ__8Hw}/Ͽ(W'_e[(6F(Vhk(Jr$h()ht;/r8<@%C#cT*A6PF)T글pdTm` X$U)dihZy%Tհiix|nTw]S}&袌6Z`U TZ v駠**jdZU>ELi5꫰*무.UGxR*k챡kRϲIuVkز Hë?\pkٖk覫.t[TDm5$/U' P{śÀ4lg1x4lU> =/8-Dѳ?A(kq68[ɢxAm(E/[P>lWC|0KW}-=L}F b+ DW>(j_s9BgeSġ3XK [F@(l ~ tV_ąW/Xe% *Ģf(W$.L 0)(l'[0B5 2"3<)Й,&]tˆ]\ "l6Sv3qyn(\:Јmq@?iM38"pD{Ӡm` bG&??,aPָQXH(;"Z#lf;ٳB+leÆ QDM60ag)P K@η"@BNtwӘ);m&tpB2t+`6GN򒧕8sed)!qT>W8Ϲ|6.˟ yw;yH9Y%cۦ>Y`iEP딩AN>1N[4~pՇpjk-|\PfCe2܄ׂ \5}5CQ}h ayw, td{@g,h=T!CK( p;}brCP:>}b0'7>C@?Ld܀ϿS%L3 ~O:cT`)EPԖ%0B` ~X&xr"m 3ճ31 0^(:/R 4h COGA9PR!DPK0c2W0 8fxh; A{:\ C @|؇~H4pJFaT)sHt24h ~j1af3 CWw'C# r8LQP ݧ2| 3 p|XxEƷy'3GPxxH: hdFSg vgɘx<<'2E3p 1؎hK (=v = }V}wR~:C PHp y:QQ9:l H0"9yh2#C0cD4Y e]:#-v dFy[ C.(C>[zZJnut=z(jC0s2? F7=8h"b;F2$ J:$B C ɤZ#F3+2 |jzpzӔ2,bqFa:olڧ~ 8$CqP$09Wڨꇰ7K0+`b䝋s i8#F`q a A}gaw: z ZF<7}h75-FZp2aD.m g j4ٓz )C5 hpj3 FN‘:^::93.3,"FO5:=2 F*# FM@4R;0HR09 P - @ p @RI@?8&l-p(C toR: "R4H@1p<Hw  ۺ P @B ,E:`. .P^9ĀVH-9+C[b$r r"I|@ ` P 0 p @ 0{`KP2lL339`Hǃ bZR+;P$@F3pFi` Dm$ P vC !02 l)3h.01Bz@@ ,̉ 0 @L":l)R~ 9M l@ P pL9$q8Љr%m)H[,Z:PpS;PPp @$ 0  _*(3ҩUb ˘;9@R0 7ԳRԚpI50_ͤ(d&FrEթҵ',9E..E  pj1u p{A&(C(Fזattb <0IP s ~(Fp@bJaJ}8"E &kHp L5"@8wXa4L->쁡 % 48@v@p PN ͬ2`ط=&Vy/HN) ~.5P p߱&ɠ@HXAT23 /H}(x7 9x@p P ݭEQ:S/2H'!s40.K A> _Me|$&F/*by!F d^* ` 0P6Ma7NRDt4aH%f'k@p>`` @m訮C Pv06M8,=4F&@g15@}P 0 9E@#:ҹ3[#FZ&d%@< @ P R-}hu"H0/bT:a _?p  PD/D&u'a7)F%%1Y!@ ._"4 @B b ?9~3#%f6`}p/Ur 0 9I̵=E!Nw=:wMRIpN `@i ?*Fbt9= d8 jƂ_>`u (Cb2:I _ C@ëZ*;`@ ~i/4 @Na[:E(.rp ?6 `Q˗+ ^/C[b4e  ݿ EA .dp!]$NXE5nG8$YɓdK1eΤYM9u) OAF YQI.8R(C$~*"SYnWaŎ%[Yiծe[qΥ[]mljOO[X+cȑ%O Sb̉%V$P\iԩUfkرeϦ]6m^N)RE#86'*/gjO? uN#T'_yկg{ss*d>l tH 4@sC@j?DBJy3pC;CCqDճŔFJDckFE\G rH"4H$TCvd rǪpRDrK.K0sL2Os4P*N@uQH#tRJ+t-G=D;4A~4=NKK5TTSUuUV[}Q3SZkmX1CU^{W`vX`u1|lUv9V1KvZjZl}gYpinR[tUw]vu] ))vĵ^ʙWs_x`ɴdߠwaWav-xb+b3 aͦcdSVye[ިIM&d&ftyg{g{璶po&ڡviz$X!n֚Ynn{l6[#fVarlnjmipW|[ 3|s;_fr;&=W}u[wRBt' ^}w{}Bv 't(}yw< qMq~{{Wz|ghW}w"C|LgzW=饣~đ;g%P d~0wP6@ fPX G 0A^8xBPԊ!B(T mxCPR^?bC taxD$zizbU"Sb!4PNs0=F]Qc$cgs魩kd3Qs\:-Q ^PG@Rd '=&2g^ HHFyIazd'=I+R2tqd)!MRd 0=eRJ\R1K`.yLdn DG0zlɤf5 lMIx$g9WNdMGSBI*S5O]P$"yPa6hCPa`DhEaM:hG'M&â#} 66IT+IIRDi#KmzS"XZL}np9%jQ!?e 6iFUSE6fu%d8)UUejYqRUkek\paU8)zW,|$6Wvz%la e>N PV=l/79+fe=YJhjlip V-6v%xlX{[Bt=l}ێdž1%9mXwVxl\"'rNonwIPp٧VIkayYt)]\@3\{mX,x,@Qc Yqt|䕜Kr|>HrN'gYP;@GGe*|fq>sX Yszl6s>]?7B/^! ҭqlg{ PJs^]wʘuq{<]~wj 摛1GX}0~o[ٳ/v Z<2>&P _+Y`dH=f?!Z@*LH1c4@P[j@ )ъ9h@[!@L6S|6AJ[X@r  •8`C<#N/9aZB]CB"s=CE\ 7)DH,"=7XDK\ [<DN!.DK.ĀDTl{BjEWdX HEZ¸zE]E`TG[EcT<.̝`\FaOcF%fFA .BiFDlG).FtO>rl4.\tDG`DsG|7DG\=н|,H.B?ytOEHOO HH\ DHTC\-ID@pTIip|I GX,ʕ䁟\vJp JkQ\J(O5K`)lIJyJ|KWOK+HRqFt9 LO#N$Rh#'RD*Җ9--Ӌ<0]S=3SX6S7vS'=mE<ԖPJ?5Qz- TGuySL@ܺGԖX= T=JM-Ֆ=%3PmN1|90UXu өX<HbU^ufHU H[KO@t^MVX=aV}ShTVjmIUgMIE0Tj W8T=kVĄ(}fWwm LIEWr\TwWk (E}=ؕ TmF|DXu 1}S|kXND7ω$-׃@T*WXm Y)Lr5ΔY Bm}ݤYu>r}͟]ZL&(c}S,MZTaZ؋YZ zZxD _; .,@ }@b+3`{".+c`^.*%.f2c8v -b@H6ญc> {"vV;f(+b0(>NdɀQ A"(bAEdʠ"G(dFKe`~rO`]Q~UDecd0e^f'O[%dedv]嶜a$KUdfp>fgBYO^`k ff3^fgw6e't"Pl>j~g~>,fgR|~>|:ڃ]eREhyl6Ln +gZhpvI hf~(fGHFpi~М1^q2ibnAfcj =0Ljvjnf=ji^D[zKk~ek ݷN<^.N8ikk3l4xlflkPlF|fl .8~O>J)ˮm߮wa mY"lm綕y>A6nwe|n?n'"L8n0@noq8>XW&7vo}X/VoV3^p|oz&K15Pjpq!`FqlEOqI[ oKx?SqGq3?q"thq- r*h"rXl&)r1 rr1rx1ґe6?!l4wM l8i (;_K9OWtG{9G$CHOFGtqNOtTuVv(Qw%7t.Vu Q TZKXGq^O u ?;X?eʇaHw`vv!lttpr? KTvw'Bh#wh=x*w#p@r3_UxmxO`? x4yx$t0T uy)y9y;z@yoz`XZdOiz8 wz%ry% (4G-8{}(Z %bൄ!:{{h;0zt'0O|ȷ|x&8m?uwu|)w0WXOx+}0}ϪwnOhG/~ X}(@DЂ%~ox"L0oς~.ogOCȁ~,+;N,h „ 2l!Ĉ'Rh"ƌ7r#Ȑ"G.EH*Wl%̘2gҬi&Μ2t'РB-j(ҤJ2m)ԨRRj*֬Zr+ذbǒ-k,ڴjײպθrҭk7n0/.l0 #9.Ȓ'S@e[7s3ТG.m4ԪW2زgE1ܺw7zx:zw9uAx4bc䱛 %aͥ; _/8d~<] D <9{=Cwٛ/WذD @` t>8?xvp;\ 'AhbnP!790%&F<"=1A4p# LTBPDnIr(8 J8$8x.f|P m<':ch |'<)* Y'>O#'@*P 'BЅ`@#*щ C3эrTkD)*ґ4hc;ҕG6PҙҴhBC6ҝ>?FM2N}j!VjKR r@^*Xetf=@ wn}+\4:vYPqĵ~+`Stj=lP},dԎdP l F,hh=-js3D}-lc+[cBjs[dal+4P2(P4QR9rbH:+񒷼iQ2 Py+,hLfhF+UiG7N2pTxC78k SfJQcA~N cC(1s㠬s .́1%8*)g87-sL:!S9Z4\/n2?؁a_e. 0 lco3zoݙ70C4#-IE3@%zwU  wҦ>5S-Ku( ;++U]H