From 9caf8b0e3fa6d8bdd38c08227d28c17b3e8048a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Glondu?= Date: Sun, 4 Aug 2019 11:12:07 +0200 Subject: Import cryptokit_1.13-1.debian.tar.xz [dgit import tarball cryptokit 1.13-1 cryptokit_1.13-1.debian.tar.xz] --- META.cryptokit.in | 7 + changelog | 301 +++++++++++++++++++++++++++++++++ compat | 1 + control | 80 +++++++++ control.in | 73 ++++++++ copyright | 53 ++++++ gbp.conf | 2 + libcryptokit-ocaml-dev.doc-base.apiref | 8 + libcryptokit-ocaml-dev.docs | 1 + libcryptokit-ocaml-dev.examples | 2 + libcryptokit-ocaml-dev.install.in | 8 + libcryptokit-ocaml.install.in | 4 + rules | 35 ++++ source/format | 1 + watch | 3 + 15 files changed, 579 insertions(+) create mode 100644 META.cryptokit.in create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 control.in create mode 100644 copyright create mode 100644 gbp.conf create mode 100644 libcryptokit-ocaml-dev.doc-base.apiref create mode 100644 libcryptokit-ocaml-dev.docs create mode 100644 libcryptokit-ocaml-dev.examples create mode 100644 libcryptokit-ocaml-dev.install.in create mode 100644 libcryptokit-ocaml.install.in create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/META.cryptokit.in b/META.cryptokit.in new file mode 100644 index 0000000..910f7b0 --- /dev/null +++ b/META.cryptokit.in @@ -0,0 +1,7 @@ +name="cryptokit" +version="@VERSION@" +description="Cryptographic primitives" +requires="num unix" +archive(byte)="cryptokit.cma" +archive(native)="cryptokit.cmxa" +directory="+cryptokit" diff --git a/changelog b/changelog new file mode 100644 index 0000000..c835b92 --- /dev/null +++ b/changelog @@ -0,0 +1,301 @@ +cryptokit (1.13-1) unstable; urgency=medium + + * New upstream release + * Update Vcs-* + * Remove Samuel from Uploaders + * Bump debhelper compat level to 12 + * Bump Standards-Version to 4.4.0 + + -- Stéphane Glondu Sun, 04 Aug 2019 11:12:07 +0200 + +cryptokit (1.11-1) unstable; urgency=medium + + * New upstream release + * Change upstream website to github + * Add ocamlbuild and zarith to Build-Depends + * Update Vcs-* + * Bump debhelper compat to 10 + * Bump Standards-Version to 4.0.0 + + -- Stéphane Glondu Fri, 14 Jul 2017 14:38:54 +0200 + +cryptokit (1.10-1) unstable; urgency=medium + + * New upstream release + * Bump Standards-Version to 3.9.6 (no changes) + + -- Stéphane Glondu Sat, 02 May 2015 16:10:00 +0200 + +cryptokit (1.9-2) unstable; urgency=low + + * Upload to unstable + + -- Stéphane Glondu Tue, 03 Dec 2013 08:11:18 +0100 + +cryptokit (1.9-1) experimental; urgency=low + + * New upstream release + * Update Vcs-* + + -- Stéphane Glondu Sat, 09 Nov 2013 10:52:39 +0100 + +cryptokit (1.7-2) experimental; urgency=low + + * Compile with OCaml >= 4 + + -- Stéphane Glondu Thu, 25 Jul 2013 21:32:18 +0200 + +cryptokit (1.7-1) unstable; urgency=low + + [ Stéphane Glondu ] + * New upstream release + * Use format version 1.0 in debian/copyright + * Bump Standards-Version to 3.9.4 + + [ Sylvain Le Gall ] + * Remove Sylvain Le Gall from uploaders + + -- Stéphane Glondu Wed, 08 May 2013 14:48:43 +0200 + +cryptokit (1.5-1) unstable; urgency=low + + [ Stéphane Glondu ] + * New upstream release + - relocated to forge.o.o, update Homepage and debian/watch accordingly + * Bump debhelper compat level to 8 + * Switch source package format to 3.0 (quilt) + * Bump Standards-Version to 3.9.2 + + [ Stefano Zacchiroli ] + * remove myself from Uploaders + + -- Stéphane Glondu Mon, 21 Nov 2011 21:23:10 +0100 + +cryptokit (1.3-14) unstable; urgency=low + + [ Stéphane Glondu ] + * Add missing dependency on zlib1g-dev (Closes: #536505) + * Remove control.in + * debian/control: + - remove Remi Vanicat and Sven Luther from Uploaders + - move to section ocaml + - update Standards-Version to 3.8.3 + - update for dh-ocaml 0.9, and add versioned build-dependency + + [ Mehdi Dogguy ] + * Update email addresses and remove DMUA + + -- Stéphane Glondu Fri, 09 Oct 2009 11:17:23 +0200 + +cryptokit (1.3-13) unstable; urgency=medium + + * Install all *.a files (including the one attached to cryptokit.cmxa) + (Closes: #527816) + + -- Stephane Glondu Tue, 12 May 2009 11:27:02 +0200 + +cryptokit (1.3-12) unstable; urgency=low + + * Used ifeq instead of ifdef in debian/rules: a variable can be defined + and empty. Fixes FTBFS on non-native archs, Closes: #524247. + * Add myself to Uploaders. + + -- Mehdi Dogguy Wed, 15 Apr 2009 22:31:51 +0200 + +cryptokit (1.3-11) unstable; urgency=low + + * Add myself to Uploaders and DMUA + * Move to new archive section ocaml + * Move .cma and META to libcryptokit-ocaml, build .cmxs + * Remove unused patches and dpatch dependency + * Remove clean target from debian/rules (not needed) + * Bump Standards-Version to 3.8.1 + + -- Stephane Glondu Sun, 12 Apr 2009 00:36:22 +0200 + +cryptokit (1.3-10) unstable; urgency=low + + * Add missing build-dependency on dh-ocaml. + + -- Samuel Mimram Wed, 25 Feb 2009 18:22:56 +0100 + +cryptokit (1.3-9) unstable; urgency=low + + [ Stephane Glondu ] + * Remove Julien from Uploaders + + [ Samuel Mimram ] + * Rebuild with OCaml 3.11. + * Switch packaging to git + * Update compat to 7. + * Update standards version to 3.8.0. + + -- Samuel Mimram Tue, 24 Feb 2009 19:09:23 +0100 + +cryptokit (1.3-8) unstable; urgency=medium + + [ Stefano Zacchiroli ] + * fix vcs-svn field to point just above the debian/ dir + + [ Stephane Glondu ] + * Enable zlib support, closes: #469040. + + [ Sylvain Le Gall ] + * Add homepage field in debian/control + + -- Sylvain Le Gall Mon, 03 Mar 2008 11:49:24 +0100 + +cryptokit (1.3-7) unstable; urgency=low + + * Depend on ocaml-nox instead of ocaml, closes: #450594. + * Updated stantards version to 3.7.3, no changes needed. + + -- Samuel Mimram Sat, 22 Dec 2007 00:49:16 +0100 + +cryptokit (1.3-6) unstable; urgency=low + + * Build for ocaml 3.10.0 + * Generate documentation with ocamldoc, doesn't ship the one provided by + upstream (generate almost the same thing, but with a more recent version + of ocamldoc and in the right place) + + -- Sylvain Le Gall Tue, 04 Sep 2007 00:26:44 +0200 + +cryptokit (1.3-5) experimental; urgency=low + + * Add dependency on ocaml package + + -- Sylvain Le Gall Tue, 24 Jul 2007 00:56:00 +0200 + +cryptokit (1.3-4) experimental; urgency=low + + [ Sylvain Le Gall ] + * Upgrade debian/watch version to 3, + * Upgrade debhelper debian/compat to 5, + * Replace dependency Source-Version by source:Version, + * Use CDBS for debian/rules, + * Use @OCamlTeam@ for Uploaders field in debian/control.in, + * Add versioned Build-Depends on dpkg-dev (>= 1.13.19), + * Rebuild for ocaml 3.10.0 + + [ Samuel Mimram ] + * Updated doc-base entry, closes: #318423. + + [ Julien Cristau ] + * Remove inactive people from the Uploaders field. + + -- Sylvain Le Gall Sat, 07 Jul 2007 23:26:24 +0200 + +cryptokit (1.3-3) unstable; urgency=low + + * Rebuild with OCaml 3.09.2. + * Updated standards version to 3.7.2, no changes needed. + * We don't need to remove rpaths anymore. + + -- Samuel Mimram Fri, 19 May 2006 14:09:09 +0000 + +cryptokit (1.3-2) unstable; urgency=low + + * Rebuild for OCaml 3.09.1 + + -- Sylvain Le Gall Tue, 10 Jan 2006 23:55:51 +0100 + +cryptokit (1.3-1) unstable; urgency=low + + * New upstream release + * Upgrade standards version to 3.6.2.0 (no change) + * Stop using numerix, remove dependencies and patches related to numerix + * Use svn-buildpackage + * Get rid of hardcoded OCaml ABI + * Rewrite the META to META.in and place it in METAS/, add "num" to the list + of requires (and remove "numerix"). + + -- Sylvain Le Gall Tue, 20 Dec 2005 00:45:55 +0100 + +cryptokit (1.2-8) unstable; urgency=medium + + * Updated to OCaml 3.08.3. + * Using dh_shlibdeps. + * Added -g and -fPIC to the CFLAGS. + * Installing META in /usr/lib/ocaml/XXX/cryptokit. + + -- Samuel Mimram Tue, 5 Apr 2005 22:02:17 +0200 + +cryptokit (1.2-7) unstable; urgency=high + + * Rebuilding with ocaml 3.08.2 to get rid of the inconsistent assumptions over + the Unix module, closes: #285780. + + -- Samuel Mimram Sat, 1 Jan 2005 18:14:01 +0100 + +cryptokit (1.2-6) unstable; urgency=medium + + * Corrected a bug in the patch to handle too big buffers. + + -- Samuel Mimram Tue, 16 Nov 2004 20:25:15 +0100 + +cryptokit (1.2-5) unstable; urgency=medium + + * Added a patch to raise an exception when the input buffer is too big for + the put_string method of uncompress, see: + http://caml.inria.fr/archives/200411/msg00008.html + + -- Samuel Mimram Wed, 3 Nov 2004 14:25:49 +0100 + +cryptokit (1.2-4) unstable; urgency=low + + * Made the dependency on numerix stronger to ensure we get the 3.08 version + + -- Mike Furr Tue, 27 Jul 2004 19:49:33 -0400 + +cryptokit (1.2-3) unstable; urgency=low + + * Rebuild against ocaml 3.08 (Closes: #261208) + * Changed deps to ocaml-nox + * Moved meta file to correct location (Closes: #247133) + + -- Mike Furr Tue, 27 Jul 2004 11:56:44 -0400 + +cryptokit (1.2-2) unstable; urgency=low + + * Changed debian/rules to only call allopt target on platforms that have the + ocamlopt compiler (Closes: 243542) + * Added myself to Uploaders list. + + -- Mike Furr Wed, 14 Apr 2004 19:01:30 -0400 + +cryptokit (1.2-1) unstable; urgency=low + + * First upload (closes: Bug#203256) + * debian/control: explicit Section: lines for binary packages + * debian/control: Maintainer: Debian OCaml Maintainers, etc. + * Sign with DSA subkey of new GPG key + + -- Michael K. Edwards Mon, 19 Jan 2004 11:48:52 -0800 + +cryptokit (1.2-0.4) unstable; urgency=low + + * Build against Numerix packages with Big (new nums library) support + * Include examples and speed test results in docs + * Build with Numerix.Slong on i386, Numerix.Gmp elsewhere + + -- Michael K. Edwards (in Debian context) Thu, 18 Dec 2003 02:34:23 -0800 + +cryptokit (1.2-0.3) unstable; urgency=low + + * Split into libcryptokit-ocaml{,dev}, and build against split Numerix + packages. + + -- Michael K. Edwards (in Debian context) Wed, 17 Dec 2003 13:00:32 -0800 + +cryptokit (1.2-0.2) unstable; urgency=low + + * Ported to Numerix from (non-free) Nat bignum library + + -- Michael K. Edwards (in Debian context) Mon, 15 Dec 2003 01:40:56 -0800 + +cryptokit (1.2-0.1) unstable; urgency=low + + * Initial Release + + -- Michael K. Edwards (in Debian context) Sat, 13 Dec 2003 14:33:27 -0800 diff --git a/compat b/compat new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +12 diff --git a/control b/control new file mode 100644 index 0000000..637dd9b --- /dev/null +++ b/control @@ -0,0 +1,80 @@ +Source: cryptokit +Section: ocaml +Priority: optional +Maintainer: Debian OCaml Maintainers +Uploaders: + Ralf Treinen , + Stéphane Glondu , + Mehdi Dogguy +Build-Depends: + ocaml-findlib (>= 1.4), + ocaml-nox (>= 4), + debhelper (>= 12), + zlib1g-dev, + ocamlbuild, + libzarith-ocaml-dev, + dh-ocaml (>= 0.9) +Standards-Version: 4.4.0 +Homepage: https://github.com/xavierleroy/cryptokit +Vcs-Git: https://salsa.debian.org/ocaml-team/cryptokit.git +Vcs-Browser: https://salsa.debian.org/ocaml-team/cryptokit + +Package: libcryptokit-ocaml +Architecture: any +Depends: + ${ocaml:Depends}, + ${shlibs:Depends}, + ${misc:Depends} +Provides: ${ocaml:Provides} +Description: cryptographic algorithm library for OCaml - runtime + The Cryptokit library for Objective Caml provides a variety of + cryptographic primitives that can be used to implement cryptographic + protocols in security-sensitive applications. The primitives provided + include: + . + - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB and OFB modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, MD5, and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + . + Additional ciphers and hashes can easily be used in conjunction with + the library. In particular, basic mechanisms such as chaining modes, + output buffering, and padding are provided by generic classes that can + easily be composed with user-provided ciphers. More generally, the library + promotes a "Lego"-like style of constructing and composing + transformations over character streams. + . + This package provides just the shared library for Cryptokit. + +Package: libcryptokit-ocaml-dev +Architecture: any +Depends: + zlib1g-dev, + ${ocaml:Depends}, + ${shlibs:Depends}, + ${misc:Depends} +Provides: ${ocaml:Provides} +Description: cryptographic algorithm library for OCaml - development + The Cryptokit library for Objective Caml provides a variety of + cryptographic primitives that can be used to implement cryptographic + protocols in security-sensitive applications. The primitives provided + include: + . + - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB and OFB modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, MD5, and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + . + Additional ciphers and hashes can easily be used in conjunction with + the library. In particular, basic mechanisms such as chaining modes, + output buffering, and padding are provided by generic classes that can + easily be composed with user-provided ciphers. More generally, the library + promotes a "Lego"-like style of constructing and composing + transformations over character streams. + . + This package provides static libraries, interfaces, and documentation + for Cryptokit. diff --git a/control.in b/control.in new file mode 100644 index 0000000..92035b7 --- /dev/null +++ b/control.in @@ -0,0 +1,73 @@ +Source: cryptokit +Section: ocaml +Priority: optional +Maintainer: Debian OCaml Maintainers +Uploaders: @OCamlTeam@ +Build-Depends: + @cdbs@, + debhelper (>= 7), + zlib1g-dev, + dh-ocaml (>= 0.9) +Standards-Version: 3.8.2 +Homepage: http://pauillac.inria.fr/~xleroy/software.html#cryptokit +Vcs-Git: git://git.debian.org/git/pkg-ocaml-maint/packages/cryptokit.git +Vcs-Browser: http://git.debian.org/?p=pkg-ocaml-maint/packages/cryptokit.git + +Package: libcryptokit-ocaml +Architecture: any +Depends: + ${ocaml:Depends}, + ${shlibs:Depends}, + ${misc:Depends} +Provides: ${ocaml:Provides} +Description: cryptographic algorithm library for OCaml - runtime + The Cryptokit library for Objective Caml provides a variety of + cryptographic primitives that can be used to implement cryptographic + protocols in security-sensitive applications. The primitives provided + include: + . + - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB and OFB modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, MD5, and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + . + Additional ciphers and hashes can easily be used in conjunction with + the library. In particular, basic mechanisms such as chaining modes, + output buffering, and padding are provided by generic classes that can + easily be composed with user-provided ciphers. More generally, the library + promotes a "Lego"-like style of constructing and composing + transformations over character streams. + . + This package provides just the shared library for Cryptokit. + +Package: libcryptokit-ocaml-dev +Architecture: any +Depends: + ${ocaml:Depends}, + ${shlibs:Depends}, + ${misc:Depends} +Provides: ${ocaml:Provides} +Description: cryptographic algorithm library for OCaml - development + The Cryptokit library for Objective Caml provides a variety of + cryptographic primitives that can be used to implement cryptographic + protocols in security-sensitive applications. The primitives provided + include: + . + - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB and OFB modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, MD5, and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + . + Additional ciphers and hashes can easily be used in conjunction with + the library. In particular, basic mechanisms such as chaining modes, + output buffering, and padding are provided by generic classes that can + easily be composed with user-provided ciphers. More generally, the library + promotes a "Lego"-like style of constructing and composing + transformations over character streams. + . + This package provides static libraries, interfaces, and documentation + for Cryptokit. diff --git a/copyright b/copyright new file mode 100644 index 0000000..aa51102 --- /dev/null +++ b/copyright @@ -0,0 +1,53 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Packaged-By: Michael K. Edwards +Packaged-Date: Sun, 14 Dec 2003 02:24:27 -0800 +Upstream-Contact: Xavier Leroy + +Files: * +Copyright: 2001-2012, Inria + 2003, Michael K. Edwards +License: LGPL-2-exception and GPL-2 + Cryptokit is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as + published by the Free Software Foundation; either version 2, or (at + your option) any later version, including its successor, the GNU + Lesser General Public License. + . + Cryptokit 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 may have received a copy of the GNU Library General Public + License along with Cryptokit; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301, USA. + . + 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 INRIA, or a + modified version of the Library that is distributed under the + conditions defined in clause 3 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. + . + However, the RSA and Diffie-Hellman operations in this version of + Cryptokit have been reimplemented using the Numerix multi-precision + integer library, which is licensed under the GNU General Public + License. Consequently, any use of this Library together with Numerix + will be governed by the GNU General Public License and the special + exception listed above will not apply to the resulting work. + . + On Debian systems the complete text of Version 2 of the Library + General Public License can be found in + `/usr/share/common-licenses/LGPL-2', and its successor, Version 2.1 of + the Lesser General Public License, can be found in + `/usr/share/common-licenses/LGPL-2.1'. The General Public License + mentioned in connection with Numerix can also be found in + `/usr/share/common-licenses/GPL-2'. diff --git a/gbp.conf b/gbp.conf new file mode 100644 index 0000000..cec628c --- /dev/null +++ b/gbp.conf @@ -0,0 +1,2 @@ +[DEFAULT] +pristine-tar = True diff --git a/libcryptokit-ocaml-dev.doc-base.apiref b/libcryptokit-ocaml-dev.doc-base.apiref new file mode 100644 index 0000000..2b3a38d --- /dev/null +++ b/libcryptokit-ocaml-dev.doc-base.apiref @@ -0,0 +1,8 @@ +Document: libcryptokit-ocaml-dev-ocamldoc-api-reference +Title: libcryptokit-ocaml-dev OCamldoc API Reference +Abstract: API reference manual for libcryptokit-ocaml-dev (generated via OCamldoc) +Section: Programming/OCaml + +Format: HTML +Index: /usr/share/doc/libcryptokit-ocaml-dev/cryptokit/index.html +Files: /usr/share/doc/libcryptokit-ocaml-dev/cryptokit/* diff --git a/libcryptokit-ocaml-dev.docs b/libcryptokit-ocaml-dev.docs new file mode 100644 index 0000000..71dfd5b --- /dev/null +++ b/libcryptokit-ocaml-dev.docs @@ -0,0 +1 @@ +README.txt diff --git a/libcryptokit-ocaml-dev.examples b/libcryptokit-ocaml-dev.examples new file mode 100644 index 0000000..3ffbb01 --- /dev/null +++ b/libcryptokit-ocaml-dev.examples @@ -0,0 +1,2 @@ +test/test.ml +test/speedtest.ml diff --git a/libcryptokit-ocaml-dev.install.in b/libcryptokit-ocaml-dev.install.in new file mode 100644 index 0000000..e97c929 --- /dev/null +++ b/libcryptokit-ocaml-dev.install.in @@ -0,0 +1,8 @@ +usr/share/doc +@OCamlStdlibDir@/cryptokit/*.a +@OCamlStdlibDir@/cryptokit/*.cmi +@OCamlStdlibDir@/cryptokit/*.mli +@OCamlStdlibDir@/cryptokit/*.annot +@OCamlStdlibDir@/cryptokit/*.cmt* +OPT: @OCamlStdlibDir@/cryptokit/*.cmxa +OPT: @OCamlStdlibDir@/cryptokit/*.cmx diff --git a/libcryptokit-ocaml.install.in b/libcryptokit-ocaml.install.in new file mode 100644 index 0000000..f1033c5 --- /dev/null +++ b/libcryptokit-ocaml.install.in @@ -0,0 +1,4 @@ +@OCamlDllDir@/*.so +@OCamlStdlibDir@/cryptokit/META +@OCamlStdlibDir@/cryptokit/cryptokit.cma +DYN: @OCamlStdlibDir@/cryptokit/*.cmxs diff --git a/rules b/rules new file mode 100755 index 0000000..a35c9d9 --- /dev/null +++ b/rules @@ -0,0 +1,35 @@ +#!/usr/bin/make -f + +DESTDIR=$(CURDIR)/debian/tmp +include /usr/share/ocaml/ocamlvars.mk +export OCAMLFIND_DESTDIR=$(DESTDIR)/$(OCAML_STDLIB_DIR) + +%: + dh $@ --with ocaml + +.PHONY: override_dh_auto_configure +override_dh_auto_configure: + ocaml setup.ml -configure --prefix /usr --destdir '$(DESTDIR)' --docdir /usr/share/doc/libcryptokit-ocaml-dev + +.PHONY: override_dh_auto_build +override_dh_auto_build: + ocaml setup.ml -build + ocaml setup.ml -doc + +.PHONY: override_dh_auto_test +override_dh_auto_test: + ocaml setup.ml -test + +.PHONY: override_dh_auto_install +override_dh_auto_install: + mkdir -p '$(OCAMLFIND_DESTDIR)' + mkdir -p '$(DESTDIR)$(OCAML_DLL_DIR)' + ocaml setup.ml -install + +.PHONY: override_dh_auto_clean +override_dh_auto_clean: + ocaml setup.ml -distclean + +.PHONY: override_dh_missing +override_dh_missing: + dh_missing --fail-missing -X.so.owner diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..8ea330b --- /dev/null +++ b/watch @@ -0,0 +1,3 @@ +version=3 +opts=uversionmangle=s/^(.)(.+)$/$1.$2/ \ +https://github.com/xavierleroy/cryptokit/releases .*/release([0-9]+)\.tar\.gz -- cgit v1.2.3 From 9d199b3b7004a90d18f329dedabcca89e2203377 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Glondu?= Date: Sun, 4 Aug 2019 11:12:07 +0200 Subject: Import cryptokit_1.13.orig.tar.gz [dgit import orig cryptokit_1.13.orig.tar.gz] --- .gitignore | 5 + AUTHORS.txt | 8 + Changes | 84 + INSTALL.txt | 39 + LICENSE | 501 +++ LICENSE.txt | 501 +++ Makefile | 41 + README.md | 84 + README.txt | 35 + _oasis | 144 + _tags | 122 + configure | 27 + myocamlbuild.ml | 1207 +++++++ setup.ml | 8075 +++++++++++++++++++++++++++++++++++++++++++ src/META | 12 + src/aesni.c | 329 ++ src/aesni.h | 40 + src/api-cryptokit.odocl | 5 + src/arcfour.c | 59 + src/arcfour.h | 28 + src/blowfish.c | 512 +++ src/blowfish.h | 34 + src/chacha20.c | 162 + src/chacha20.h | 23 + src/cryptokit.ml | 2026 +++++++++++ src/cryptokit.mldylib | 5 + src/cryptokit.mli | 1160 +++++++ src/cryptokit.mllib | 5 + src/cryptokitBignum.ml | 117 + src/cryptokitBignum.mli | 41 + src/cryptokitBignumOld.ml | 479 +++ src/cryptokitBignumOld.mli | 41 + src/d3des.c | 382 ++ src/d3des.h | 28 + src/keccak.c | 185 + src/keccak.h | 21 + src/libcryptokit_stubs.clib | 28 + src/rijndael-alg-fst.c | 1400 ++++++++ src/rijndael-alg-fst.h | 47 + src/ripemd160.c | 392 +++ src/ripemd160.h | 32 + src/sha1.c | 172 + src/sha1.h | 30 + src/sha256.c | 232 ++ src/sha256.h | 37 + src/sha512.c | 302 ++ src/sha512.h | 37 + src/stubs-aes.c | 96 + src/stubs-arcfour.c | 50 + src/stubs-blowfish.c | 78 + src/stubs-chacha20.c | 58 + src/stubs-des.c | 43 + src/stubs-md5.c | 62 + src/stubs-misc.c | 58 + src/stubs-ripemd160.c | 45 + src/stubs-rng.c | 144 + src/stubs-sha1.c | 45 + src/stubs-sha256.c | 63 + src/stubs-sha3.c | 90 + src/stubs-sha512.c | 62 + src/stubs-zlib.c | 229 ++ test/prngtest.ml | 49 + test/speedtest.ml | 141 + test/test.ml | 959 +++++ 64 files changed, 21548 insertions(+) create mode 100644 .gitignore create mode 100644 AUTHORS.txt create mode 100644 Changes create mode 100644 INSTALL.txt create mode 100644 LICENSE create mode 100644 LICENSE.txt create mode 100644 Makefile create mode 100644 README.md create mode 100644 README.txt create mode 100644 _oasis create mode 100644 _tags create mode 100755 configure create mode 100644 myocamlbuild.ml create mode 100644 setup.ml create mode 100644 src/META create mode 100644 src/aesni.c create mode 100644 src/aesni.h create mode 100644 src/api-cryptokit.odocl create mode 100644 src/arcfour.c create mode 100644 src/arcfour.h create mode 100644 src/blowfish.c create mode 100644 src/blowfish.h create mode 100644 src/chacha20.c create mode 100644 src/chacha20.h create mode 100644 src/cryptokit.ml create mode 100644 src/cryptokit.mldylib create mode 100644 src/cryptokit.mli create mode 100644 src/cryptokit.mllib create mode 100644 src/cryptokitBignum.ml create mode 100644 src/cryptokitBignum.mli create mode 100644 src/cryptokitBignumOld.ml create mode 100644 src/cryptokitBignumOld.mli create mode 100644 src/d3des.c create mode 100644 src/d3des.h create mode 100644 src/keccak.c create mode 100644 src/keccak.h create mode 100644 src/libcryptokit_stubs.clib create mode 100644 src/rijndael-alg-fst.c create mode 100644 src/rijndael-alg-fst.h create mode 100644 src/ripemd160.c create mode 100644 src/ripemd160.h create mode 100644 src/sha1.c create mode 100644 src/sha1.h create mode 100644 src/sha256.c create mode 100644 src/sha256.h create mode 100644 src/sha512.c create mode 100644 src/sha512.h create mode 100644 src/stubs-aes.c create mode 100644 src/stubs-arcfour.c create mode 100644 src/stubs-blowfish.c create mode 100644 src/stubs-chacha20.c create mode 100644 src/stubs-des.c create mode 100644 src/stubs-md5.c create mode 100644 src/stubs-misc.c create mode 100644 src/stubs-ripemd160.c create mode 100644 src/stubs-rng.c create mode 100644 src/stubs-sha1.c create mode 100644 src/stubs-sha256.c create mode 100644 src/stubs-sha3.c create mode 100644 src/stubs-sha512.c create mode 100644 src/stubs-zlib.c create mode 100644 test/prngtest.ml create mode 100644 test/speedtest.ml create mode 100644 test/test.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ffcec6b --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +_build +setup.data +setup.log +*.native +*~ diff --git a/AUTHORS.txt b/AUTHORS.txt new file mode 100644 index 0000000..5925336 --- /dev/null +++ b/AUTHORS.txt @@ -0,0 +1,8 @@ +(* OASIS_START *) +(* DO NOT EDIT (digest: e625e8e0d101a44e16ea9cac5c37eaa0) *) + +Authors of cryptokit: + +* Xavier Leroy + +(* OASIS_STOP *) diff --git a/Changes b/Changes new file mode 100644 index 0000000..475c242 --- /dev/null +++ b/Changes @@ -0,0 +1,84 @@ +Release 1.13: +- Add the Chacha20 stream cipher. +- Add the AES-CMAC (a.k.a. AES-OMAC1) message authentication code. +- Pseudo-random number generator: replace the old AES-CBC-Fibonacci generator + with a faster, simpler generator based on Chacha20. +- Add an alternate pseudo-random number generator based on AES in CTR mode. +- Documentation: warn about known cryptographic weaknesses in Triple DES, + Blowfish, and ARCfour. +- Documentation: warn about problems with variable-length messages in + MACs based on block ciphers in CBC mode. + +Release 1.12: +- Fix x86-32 compilation error and improve detection of AES-NI for x86 + processors (Jeremie Dimino, Etienne Millon) + (Closes: #1646) +- AES-NI: align key_schedule on a 16 byte boundary (Etienne Millon) + (Closes: #1709) +- Add original Keccak submission to SHA-3 (Yoichi Hirai) + +Release 1.11: +- Adapt to "safe string" mode (OCaml 4.02 and later required). + The API should remain backward-compatible for clients compiled + in "unsafe string" mode. +- Update SHA-3 to the official NIST standard (different padding than + in the Keccak submission). (Closes: #1528) +- Fixed bounds checking in "add_substring" methods of hash functions + and other functions that operate on a substring of a string. + (Closes: #1480) +- Use hardware implementation of AES when available on x86 processors. + (Faster than the software implementation and less sensitive to + side channel attacks.) +- Use the Zarith library to implement RSA. + (Faster than the previous implementation and less sensitive to + side channel attacks.) +- Support the hardware random number generator present in recent + x86 processors. +- Rebuilt generated files with Oasis 0.4.6 for OCaml 4.03 compatibility. + +Release 1.10: +- Add all SHA-2 hash functions: SHA-224, SHA-384 and SHA-512 + in addition to the existing SHA-256. (Closes: #1223) +- Add support for CTR (Counter) chaining mode. +- Fix compilation error with OCaml 4.03+dev. +- Avoid using some obsolete OCaml stdlib functions. + +Release 1.9: + - More fixes to build in Windows with zlib (mingw and msvc). + +Release 1.8: + - Build .cmxs with C bindings (Closes: #1303) + - Use advapi32 on Windows (Close: #1055) + - Allow to define --zlib-include and --zlib-libdir if zlib is not installed in + the standard location. + +Release 1.7: +- Added SHA-3 hash function. + +Release 1.6: +- Regenerate setup.ml with oasis 0.3.0~rc6 version + +Release 1.5: +- Fix bug check in buffered_output#ensure_capacity (Closes: #879) +- Allow to have padding in Base64 (Closes: #897) + +Release 1.4: +- Added Blowfish block cipher. +- Added MAC functions based on HMAC construction applied to + SHA-256 and RIPEMD-160. +- Added OASIS and findlib support (Closes: #589) + +Release 1.3: +- Added hash functions SHA-256 and RIPEMD-160. +- Added "flush" method to transforms. +- Fixed infinite loop in decompression of incorrect data. + +Release 1.2: +- MS Windows port + +Release 1.1: +- Added Diffie-Hellman key agreement +- Exported raw modular arithmetic operations (mod_power, mod_mult) + +Release 1.0: +- First public release diff --git a/INSTALL.txt b/INSTALL.txt new file mode 100644 index 0000000..2df34bc --- /dev/null +++ b/INSTALL.txt @@ -0,0 +1,39 @@ +(* OASIS_START *) +(* DO NOT EDIT (digest: 2db6139613bebbb21b8bceb9f1e7d363) *) + +This is the INSTALL file for the cryptokit distribution. + +This package uses OASIS to generate its build system. See section OASIS for +full information. + +Dependencies +============ + +In order to compile this package, you will need: + +* ocaml for all, test bench, test main, doc api-cryptokit +* findlib +* zarith for library cryptokit + +Installing +========== + +1. Uncompress the source archive and go to the root of the package +2. Run 'ocaml setup.ml -configure' +3. Run 'ocaml setup.ml -build' +4. Run 'ocaml setup.ml -install' + +Uninstalling +============ + +1. Go to the root of the package +2. Run 'ocaml setup.ml -uninstall' + +OASIS +===== + +OASIS is a program that generates a setup.ml file using a simple '_oasis' +configuration file. The generated setup only depends on the standard OCaml +installation: no additional library is required. + +(* OASIS_STOP *) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..604c2ba --- /dev/null +++ b/LICENSE @@ -0,0 +1,501 @@ +This 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 INRIA, or a +modified version of the Library that is distributed under the +conditions defined in clause 3 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 LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + 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 Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, 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 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 a program 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. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, 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 companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + 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, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +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. + + 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. + + 6. As an exception to the Sections above, you may also compile 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) 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. + + c) 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. + + d) 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 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. + + 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. + + 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 to +this License. + + 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 Library 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. + + 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 + + Appendix: 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 Library 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, 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! diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..604c2ba --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,501 @@ +This 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 INRIA, or a +modified version of the Library that is distributed under the +conditions defined in clause 3 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 LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + 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 Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, 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 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 a program 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. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, 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 companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + 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, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +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. + + 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. + + 6. As an exception to the Sections above, you may also compile 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) 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. + + c) 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. + + d) 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 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. + + 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. + + 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 to +this License. + + 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 Library 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. + + 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 + + Appendix: 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 Library 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, 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! diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3639f14 --- /dev/null +++ b/Makefile @@ -0,0 +1,41 @@ +# OASIS_START +# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) + +SETUP = ocaml setup.ml + +build: setup.data + $(SETUP) -build $(BUILDFLAGS) + +doc: setup.data build + $(SETUP) -doc $(DOCFLAGS) + +test: setup.data build + $(SETUP) -test $(TESTFLAGS) + +all: + $(SETUP) -all $(ALLFLAGS) + +install: setup.data + $(SETUP) -install $(INSTALLFLAGS) + +uninstall: setup.data + $(SETUP) -uninstall $(UNINSTALLFLAGS) + +reinstall: setup.data + $(SETUP) -reinstall $(REINSTALLFLAGS) + +clean: + $(SETUP) -clean $(CLEANFLAGS) + +distclean: + $(SETUP) -distclean $(DISTCLEANFLAGS) + +setup.data: + $(SETUP) -configure $(CONFIGUREFLAGS) + +configure: + $(SETUP) -configure $(CONFIGUREFLAGS) + +.PHONY: build doc test all install uninstall reinstall clean distclean configure + +# OASIS_STOP diff --git a/README.md b/README.md new file mode 100644 index 0000000..fb23f8a --- /dev/null +++ b/README.md @@ -0,0 +1,84 @@ +# The Cryptokit library + +## Overview + +The Cryptokit library for OCaml provides a variety of cryptographic primitives that can be used to implement cryptographic protocols in security-sensitive applications. The primitives provided include: + +* Symmetric-key ciphers: AES, Chacha20, DES, Triple-DES, Blowfish, ARCfour, in ECB, CBC, CFB, OFB and counter modes. +* Public-key cryptography: RSA encryption and signature, Diffie-Hellman key agreement. +* Hash functions and MACs: SHA-3, SHA-1, SHA-2, RIPEMD-160, MD5, and MACs based on AES and DES. +* Random number generation. +* Encodings and compression: base 64, hexadecimal, Zlib compression. + +Additional ciphers and hashes can easily be used in conjunction with the library. In particular, basic mechanisms such as chaining modes, output buffering, and padding are provided by generic classes that can easily be composed with user-provided ciphers. More generally, the library promotes a "Lego"-like style of constructing and composing transformations over character streams. + +This library is distributed under the conditions of the GNU Library General Public license version 2, with the special OCaml exception on linking described in file LICENSE. + +## Requirements + +* OCaml 4.02 or more recent. +* The findlib/ocamlfind tool. +* The Zarith library, version 1.4 or more recent. +* The Zlib C library, version 1.1.3 or up is recommended. If it is not installed on your system (look for libz.a or libz.so), get it from http://www.gzip.org/, or indicate in the Makefile that you do not have it. If you are running Linux or BSD or MacOS, your distribution provides precompiled binaries for this library. +* If the operating system does not provide the `/dev/random` device for random number generation, consider installing the [EGD](http://egd.sourceforge.net/) entropy gathering daemon. Without `/dev/random` nor EGD, this library cannot generate cryptographically-strong random data nor RSA keys. The remainder of the library still works, though. + +## Installation + +``` +./configure --enable-tests +make +make test +make install +``` + +## Documentation + +See the extensive documentation comments in file src/cryptokit.mli. + +Compilation options: `ocamlfind ocamlopt -package cryptokit`... + +Linking options: `ocamlfind ocamlopt -linkpkg -package cryptokit`... + +## Warnings and disclaimers + +Disclaimer 1: the author is not an expert in cryptography. While reasonable care has been taken to select good, widely-used implementations of the ciphers and hashes, and follow recommended practices found in reputable applied cryptography textbooks, you are advised to review thoroughly the implementation of this module before using it in a security-critical application. + +Disclaimer 2: some knowledge of cryptography is needed to use effectively this library. A recommended reading is the [Handbook of Applied Cryptography](http://www.cacr.math.uwaterloo.ca/hac/). Building secure applications out of cryptographic primitives also requires a general background in computer security. + +Disclaimer 3: in some countries, the use, distribution, import and/or export of cryptographic applications is restricted by law. The precise restrictions may depend on the strenght of the cryptography used (e.g. key size), but also on its purpose (e.g. confidentiality vs. authentication). It is up to the users of this library to comply with regulations applicable in their country. + +## Design notes and references + +The library is organized around the concept of "transforms". A transform is an object that accepts strings, sub-strings, characters and bytes as input, transforms them, and buffers the output. While it is possible to enter all input, then fetch the output, lower memory requirements can be achieved by purging the output periodically during data input. + +The AES implementation is the public-domain optimized reference implementation by Daemen, Rijmen and Barreto. On x86 processors that support the AES-NI extensions, hardware implementation is used instead. + +The Chacha20 implementation is due to D.J.Bernstein, https://cr.yp.to/streamciphers/timings/estreambench/submissions/salsa20/chacha8/regs/chacha.c . It is in the public domain. + +The DES implementation is based on Outerbridge's popular "d3des" implementation. This is not the fastest DES implementation available, but one of the cleanest. Outerbridge's code is marked as public domain. + +The Blowfish implementation is that of Paul Kocher with some performance improvements. It is under the LGPL. It passes the test vectors listed at http://www.schneier.com/code/vectors.txt + +ARCfour (``alleged RC4'') is implemented from scratch, based on the algorithm described in Schneier's _Applied Cryptography_ + +SHA-1 is also implemented from scratch, based on the algorithm described in the _Handbook of Applied Cryptography_. It passes the FIPS test vectors. + +SHA-2 is implemented from scratch based on FIPS publication 180-2. It passes the FIPS test vectors. + +SHA-3 is based on the "readable" implementation of Keccak written by Markku-Juhani O. Saarinen . + +RIPEMD-160 is based on the reference implementation by A.Bosselaers. It passes the test vectors listed at http://www.esat.kuleuven.ac.be/~bosselae/ripemd160.html + +MD5 uses the public-domain implementation by Colin Plumb that is also used in the OCaml runtime system for module Digest. + +RSA encryption and decryption was implemented from scratch, using the Zarith OCaml library for arbitrary-precision arithmetic, which itself uses GMP. Modular exponentiation is the constant-time implementation provided by GMP. The Chinese remainder theorem is exploited when possible, though. Like all ciphers in this library, the RSA implementation is *not* protected against timing attacks. + +RSA key generation uses GMP's `nextprime` function for probabilistic primality testing. + +The hardware RNG uses the RDRAND instruction of recent x86 processors, if supported. It is not available on other platforms. + +The seeded PRNG is just the Chacha20 stream cipher encrypting the all-zeroes message. The seed is used as the Chacha20 key. An alternate seeded PRNG is provided, based on AES encryption of a 128-bit counter. Both PRNGs pass the Dieharder statistical tests. Still, better use the system RNG or the hardware RNG if high-quality random numbers are needed. + +## Performance + +If you configure with the options `--enable-tests --enable-bench`, then do `make test`, a simple benchmark is performed and shows the speed of various operations from this library. diff --git a/README.txt b/README.txt new file mode 100644 index 0000000..406f45d --- /dev/null +++ b/README.txt @@ -0,0 +1,35 @@ +(* OASIS_START *) +(* DO NOT EDIT (digest: 38dc311195a3981d90ae188e25b31bc8) *) + +cryptokit - Cryptographic primitives +==================================== + +This library provides a variety of cryptographic primitives that can be used +to implement cryptographic protocols in security-sensitive applications. The +primitives provided include: + +- Symmetric-key ciphers: AES, Chacha20, Blowfish, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB, OFB and counter modes. +- Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. - +Hash functions and MACs: SHA-1, SHA-2, SHA-3, RIPEMD160, MD5, + and MACs based on AES and DES. +- Random number generation. - Encodings and compression: base 64, +hexadecimal, Zlib compression. + +Additional ciphers and hashes can easily be used in conjunction with the +library. In particular, basic mechanisms such as chaining modes, output +buffering, and padding are provided by generic classes that can easily be +composed with user-provided ciphers. More generally, the library promotes a +"Lego"-like style of constructing and composing transformations over +character streams. + +See the file [INSTALL.txt](INSTALL.txt) for building and installation +instructions. + +Copyright and license +--------------------- + +cryptokit is distributed under the terms of the GNU Lesser General Public +License version 2 with OCaml linking exception. + +(* OASIS_STOP *) diff --git a/_oasis b/_oasis new file mode 100644 index 0000000..abebe23 --- /dev/null +++ b/_oasis @@ -0,0 +1,144 @@ +OASISFormat: 0.3 +Name: cryptokit +Version: 1.13 +Authors: Xavier Leroy +License: LGPL-2 with OCaml linking exception +BuildTools: ocamlbuild, ocamldoc +Plugins: META (0.3), DevFiles (0.3), StdFiles (0.3) + +Synopsis: Cryptographic primitives +Description: + This library provides a variety of cryptographic primitives that can be used + to implement cryptographic protocols in security-sensitive applications. The + primitives provided include: + . + - Symmetric-key ciphers: AES, Chacha20, Blowfish, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB, OFB and counter modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, SHA-2, SHA-3, RIPEMD160, MD5, + and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + . + Additional ciphers and hashes can easily be used in conjunction with + the library. In particular, basic mechanisms such as chaining modes, + output buffering, and padding are provided by generic classes that can + easily be composed with user-provided ciphers. More generally, the library + promotes a "Lego"-like style of constructing and composing + transformations over character streams. + +Flag zlib + Description: Enable ZLib + Default$: !os_type(Win32) + +Flag hardwaresupport + Description: Enable hardware support for AES and GCM (needs GCC or Clang) + Default$: (architecture(amd64) || architecture(i386)) && !os_type(Win32) + +Library cryptokit + Path: src + Modules: CryptokitBignum, Cryptokit + CSources: aesni.c, + aesni.h, + arcfour.c, + arcfour.h, + stubs-arcfour.c, + blowfish.c, + blowfish.h, + stubs-blowfish.c, + d3des.c, + d3des.h, + stubs-des.c, + rijndael-alg-fst.c, + rijndael-alg-fst.h, + ripemd160.c, + ripemd160.h, + stubs-ripemd160.c, + sha1.c, + sha1.h, + stubs-sha1.c, + sha256.c, + sha256.h, + stubs-sha256.c, + sha512.c, + sha512.h, + stubs-sha512.c, + stubs-aes.c, + stubs-md5.c, + stubs-misc.c, + stubs-rng.c, + stubs-zlib.c, + keccak.h, + keccak.c, + stubs-sha3.c, + chacha20.h, + chacha20.c, + stubs-chacha20.c + BuildDepends: unix, zarith + if flag(zlib) + CCOpt: -DHAVE_ZLIB + if system(win32) || system(win64) + CCLib: zlib.lib + else + CCLib: -lz + if system(win32) || system(win64) + CCLib+: advapi32.lib + else if system(mingw) || system(mingw64) + CCLib+: -ladvapi32 + if flag(hardwaresupport) + CCOpt+: -maes + +Executable test + Path: test + MainIs: test.ml + CompiledObject: native + BuildDepends: cryptokit + Build$: flag(tests) + Install: false + +Executable prngtest + Path: test + MainIs: prngtest.ml + CompiledObject: native + BuildDepends: cryptokit + Build$: flag(tests) + Install: false + +Test main + Command: $test + TestTools: test + +Flag bench + Description: Build and run benchmark + Default: false + +Executable speedtest + Path: test + MainIs: speedtest.ml + CompiledObject: native + BuildDepends: cryptokit + Install: false + Build$: flag(bench) + +Test bench + Command: $speedtest + Run$: flag(bench) + TestTools: speedtest + +Document "api-cryptokit" + Title: API reference for Cryptokit + Type: ocamlbuild (0.3) + InstallDir: $htmldir/cryptokit + BuildTools+: ocamldoc + XOCamlBuildPath: src/ + XOCamlbuildLibraries: cryptokit + +SourceRepository head + Type: git + Location: https://github.com/xavierleroy/cryptokit + Browser: https://github.com/xavierleroy/cryptokit + +SourceRepository this + Type: git + Location: https://github.com/xavierleroy/cryptokit/releases/tag/release113 + Browser: https://github.com/xavierleroy/cryptokit/releases/tag/release113 diff --git a/_tags b/_tags new file mode 100644 index 0000000..e5e0082 --- /dev/null +++ b/_tags @@ -0,0 +1,122 @@ +# OASIS_START +# DO NOT EDIT (digest: 62ba61e1d8ad56a1e96795f7c6fb78e2) +# Ignore VCS directories, you can use the same kind of rule outside +# OASIS_START/STOP if you want to exclude directories that contains +# useless stuff for the build process +true: annot, bin_annot +<**/.svn>: -traverse +<**/.svn>: not_hygienic +".bzr": -traverse +".bzr": not_hygienic +".hg": -traverse +".hg": not_hygienic +".git": -traverse +".git": not_hygienic +"_darcs": -traverse +"_darcs": not_hygienic +# Library cryptokit +"src/cryptokit.cmxs": use_cryptokit +: oasis_library_cryptokit_ccopt +"src/aesni.c": oasis_library_cryptokit_ccopt +"src/arcfour.c": oasis_library_cryptokit_ccopt +"src/stubs-arcfour.c": oasis_library_cryptokit_ccopt +"src/blowfish.c": oasis_library_cryptokit_ccopt +"src/stubs-blowfish.c": oasis_library_cryptokit_ccopt +"src/d3des.c": oasis_library_cryptokit_ccopt +"src/stubs-des.c": oasis_library_cryptokit_ccopt +"src/rijndael-alg-fst.c": oasis_library_cryptokit_ccopt +"src/ripemd160.c": oasis_library_cryptokit_ccopt +"src/stubs-ripemd160.c": oasis_library_cryptokit_ccopt +"src/sha1.c": oasis_library_cryptokit_ccopt +"src/stubs-sha1.c": oasis_library_cryptokit_ccopt +"src/sha256.c": oasis_library_cryptokit_ccopt +"src/stubs-sha256.c": oasis_library_cryptokit_ccopt +"src/sha512.c": oasis_library_cryptokit_ccopt +"src/stubs-sha512.c": oasis_library_cryptokit_ccopt +"src/stubs-aes.c": oasis_library_cryptokit_ccopt +"src/stubs-md5.c": oasis_library_cryptokit_ccopt +"src/stubs-misc.c": oasis_library_cryptokit_ccopt +"src/stubs-rng.c": oasis_library_cryptokit_ccopt +"src/stubs-zlib.c": oasis_library_cryptokit_ccopt +"src/keccak.c": oasis_library_cryptokit_ccopt +"src/stubs-sha3.c": oasis_library_cryptokit_ccopt +"src/chacha20.c": oasis_library_cryptokit_ccopt +"src/stubs-chacha20.c": oasis_library_cryptokit_ccopt +: oasis_library_cryptokit_cclib +"src/libcryptokit_stubs.lib": oasis_library_cryptokit_cclib +"src/dllcryptokit_stubs.dll": oasis_library_cryptokit_cclib +"src/libcryptokit_stubs.a": oasis_library_cryptokit_cclib +"src/dllcryptokit_stubs.so": oasis_library_cryptokit_cclib +: use_libcryptokit_stubs +: pkg_unix +: pkg_zarith +"src/aesni.c": pkg_unix +"src/aesni.c": pkg_zarith +"src/arcfour.c": pkg_unix +"src/arcfour.c": pkg_zarith +"src/stubs-arcfour.c": pkg_unix +"src/stubs-arcfour.c": pkg_zarith +"src/blowfish.c": pkg_unix +"src/blowfish.c": pkg_zarith +"src/stubs-blowfish.c": pkg_unix +"src/stubs-blowfish.c": pkg_zarith +"src/d3des.c": pkg_unix +"src/d3des.c": pkg_zarith +"src/stubs-des.c": pkg_unix +"src/stubs-des.c": pkg_zarith +"src/rijndael-alg-fst.c": pkg_unix +"src/rijndael-alg-fst.c": pkg_zarith +"src/ripemd160.c": pkg_unix +"src/ripemd160.c": pkg_zarith +"src/stubs-ripemd160.c": pkg_unix +"src/stubs-ripemd160.c": pkg_zarith +"src/sha1.c": pkg_unix +"src/sha1.c": pkg_zarith +"src/stubs-sha1.c": pkg_unix +"src/stubs-sha1.c": pkg_zarith +"src/sha256.c": pkg_unix +"src/sha256.c": pkg_zarith +"src/stubs-sha256.c": pkg_unix +"src/stubs-sha256.c": pkg_zarith +"src/sha512.c": pkg_unix +"src/sha512.c": pkg_zarith +"src/stubs-sha512.c": pkg_unix +"src/stubs-sha512.c": pkg_zarith +"src/stubs-aes.c": pkg_unix +"src/stubs-aes.c": pkg_zarith +"src/stubs-md5.c": pkg_unix +"src/stubs-md5.c": pkg_zarith +"src/stubs-misc.c": pkg_unix +"src/stubs-misc.c": pkg_zarith +"src/stubs-rng.c": pkg_unix +"src/stubs-rng.c": pkg_zarith +"src/stubs-zlib.c": pkg_unix +"src/stubs-zlib.c": pkg_zarith +"src/keccak.c": pkg_unix +"src/keccak.c": pkg_zarith +"src/stubs-sha3.c": pkg_unix +"src/stubs-sha3.c": pkg_zarith +"src/chacha20.c": pkg_unix +"src/chacha20.c": pkg_zarith +"src/stubs-chacha20.c": pkg_unix +"src/stubs-chacha20.c": pkg_zarith +# Executable test +"test/test.native": pkg_unix +"test/test.native": pkg_zarith +"test/test.native": use_cryptokit +# Executable prngtest +"test/prngtest.native": pkg_unix +"test/prngtest.native": pkg_zarith +"test/prngtest.native": use_cryptokit +# Executable speedtest +"test/speedtest.native": pkg_unix +"test/speedtest.native": pkg_zarith +"test/speedtest.native": use_cryptokit +: pkg_unix +: pkg_zarith +: use_cryptokit +# OASIS_STOP +"build": not_hygienic +"build": -traverse +"src/cryptokit.cmxs": use_libcryptokit_stubs +<*/*.cm{o,x}>: safe_string diff --git a/configure b/configure new file mode 100755 index 0000000..6acfaeb --- /dev/null +++ b/configure @@ -0,0 +1,27 @@ +#!/bin/sh + +# OASIS_START +# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) +set -e + +FST=true +for i in "$@"; do + if $FST; then + set -- + FST=false + fi + + case $i in + --*=*) + ARG=${i%%=*} + VAL=${i##*=} + set -- "$@" "$ARG" "$VAL" + ;; + *) + set -- "$@" "$i" + ;; + esac +done + +ocaml setup.ml -configure "$@" +# OASIS_STOP diff --git a/myocamlbuild.ml b/myocamlbuild.ml new file mode 100644 index 0000000..a07c579 --- /dev/null +++ b/myocamlbuild.ml @@ -0,0 +1,1207 @@ +(* OASIS_START *) +(* DO NOT EDIT (digest: 7ab3acc49c3c9131310ec300b2562fe8) *) +module OASISGettext = struct +(* # 22 "src/oasis/OASISGettext.ml" *) + + + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str + + + let fn_ fmt1 fmt2 n = + if n = 1 then + fmt1^^"" + else + fmt2^^"" + + + let init = [] +end + +module OASISString = struct +(* # 22 "src/oasis/OASISString.ml" *) + + + (** Various string utilities. + + Mostly inspired by extlib and batteries ExtString and BatString libraries. + + @author Sylvain Le Gall + *) + + + let nsplitf str f = + if str = "" then + [] + else + let buf = Buffer.create 13 in + let lst = ref [] in + let push () = + lst := Buffer.contents buf :: !lst; + Buffer.clear buf + in + let str_len = String.length str in + for i = 0 to str_len - 1 do + if f str.[i] then + push () + else + Buffer.add_char buf str.[i] + done; + push (); + List.rev !lst + + + (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the + separator. + *) + let nsplit str c = + nsplitf str ((=) c) + + + let find ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + what_idx := 0; + incr str_idx + done; + if !what_idx <> String.length what then + raise Not_found + else + !str_idx - !what_idx + + + let sub_start str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str len (str_len - len) + + + let sub_end ?(offset=0) str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str 0 (str_len - len) + + + let starts_with ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + let ok = ref true in + while !ok && + !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + ok := false; + incr str_idx + done; + !what_idx = String.length what + + + let strip_starts_with ~what str = + if starts_with ~what str then + sub_start str (String.length what) + else + raise Not_found + + + let ends_with ~what ?(offset=0) str = + let what_idx = ref ((String.length what) - 1) in + let str_idx = ref ((String.length str) - 1) in + let ok = ref true in + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx + else + ok := false; + decr str_idx + done; + !what_idx = -1 + + + let strip_ends_with ~what str = + if ends_with ~what str then + sub_end str (String.length what) + else + raise Not_found + + + let replace_chars f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_char buf (f c)) s; + Buffer.contents buf + + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + +end + +module OASISUtils = struct +(* # 22 "src/oasis/OASISUtils.ml" *) + + + open OASISGettext + + + module MapExt = + struct + module type S = + sig + include Map.S + val add_list: 'a t -> (key * 'a) list -> 'a t + val of_list: (key * 'a) list -> 'a t + val to_list: 'a t -> (key * 'a) list + end + + module Make (Ord: Map.OrderedType) = + struct + include Map.Make(Ord) + + let rec add_list t = + function + | (k, v) :: tl -> add_list (add k v t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] + end + end + + + module MapString = MapExt.Make(String) + + + module SetExt = + struct + module type S = + sig + include Set.S + val add_list: t -> elt list -> t + val of_list: elt list -> t + val to_list: t -> elt list + end + + module Make (Ord: Set.OrderedType) = + struct + include Set.Make(Ord) + + let rec add_list t = + function + | e :: tl -> add_list (add e t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list = elements + end + end + + + module SetString = SetExt.Make(String) + + + let compare_csl s1 s2 = + String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) + + + module HashStringCsl = + Hashtbl.Make + (struct + type t = string + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) + end) + + module SetStringCsl = + SetExt.Make + (struct + type t = string + let compare = compare_csl + end) + + + let varname_of_string ?(hyphen='_') s = + if String.length s = 0 then + begin + invalid_arg "varname_of_string" + end + else + begin + let buf = + OASISString.replace_chars + (fun c -> + if ('a' <= c && c <= 'z') + || + ('A' <= c && c <= 'Z') + || + ('0' <= c && c <= '9') then + c + else + hyphen) + s; + in + let buf = + (* Start with a _ if digit *) + if '0' <= s.[0] && s.[0] <= '9' then + "_"^buf + else + buf + in + OASISString.lowercase_ascii buf + end + + + let varname_concat ?(hyphen='_') p s = + let what = String.make 1 hyphen in + let p = + try + OASISString.strip_ends_with ~what p + with Not_found -> + p + in + let s = + try + OASISString.strip_starts_with ~what s + with Not_found -> + s + in + p^what^s + + + let is_varname str = + str = varname_of_string str + + + let failwithf fmt = Printf.ksprintf failwith fmt + + + let rec file_location ?pos1 ?pos2 ?lexbuf () = + match pos1, pos2, lexbuf with + | Some p, None, _ | None, Some p, _ -> + file_location ~pos1:p ~pos2:p ?lexbuf () + | Some p1, Some p2, _ -> + let open Lexing in + let fn, lineno = p1.pos_fname, p1.pos_lnum in + let c1 = p1.pos_cnum - p1.pos_bol in + let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in + Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 + | _, _, Some lexbuf -> + file_location + ~pos1:(Lexing.lexeme_start_p lexbuf) + ~pos2:(Lexing.lexeme_end_p lexbuf) + () + | None, None, None -> + s_ "" + + + let failwithpf ?pos1 ?pos2 ?lexbuf fmt = + let loc = file_location ?pos1 ?pos2 ?lexbuf () in + Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt + + +end + +module OASISExpr = struct +(* # 22 "src/oasis/OASISExpr.ml" *) + + + open OASISGettext + open OASISUtils + + + type test = string + type flag = string + + + type t = + | EBool of bool + | ENot of t + | EAnd of t * t + | EOr of t * t + | EFlag of flag + | ETest of test * string + + + type 'a choices = (t * 'a) list + + + let eval var_get t = + let rec eval' = + function + | EBool b -> + b + + | ENot e -> + not (eval' e) + + | EAnd (e1, e2) -> + (eval' e1) && (eval' e2) + + | EOr (e1, e2) -> + (eval' e1) || (eval' e2) + + | EFlag nm -> + let v = + var_get nm + in + assert(v = "true" || v = "false"); + (v = "true") + + | ETest (nm, vl) -> + let v = + var_get nm + in + (v = vl) + in + eval' t + + + let choose ?printer ?name var_get lst = + let rec choose_aux = + function + | (cond, vl) :: tl -> + if eval var_get cond then + vl + else + choose_aux tl + | [] -> + let str_lst = + if lst = [] then + s_ "" + else + String.concat + (s_ ", ") + (List.map + (fun (cond, vl) -> + match printer with + | Some p -> p vl + | None -> s_ "") + lst) + in + match name with + | Some nm -> + failwith + (Printf.sprintf + (f_ "No result for the choice list '%s': %s") + nm str_lst) + | None -> + failwith + (Printf.sprintf + (f_ "No result for a choice list: %s") + str_lst) + in + choose_aux (List.rev lst) + + +end + + +# 437 "myocamlbuild.ml" +module BaseEnvLight = struct +(* # 22 "src/base/BaseEnvLight.ml" *) + + + module MapString = Map.Make(String) + + + type t = string MapString.t + + + let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" + + + let load ?(allow_empty=false) ?(filename=default_filename) ?stream () = + let line = ref 1 in + let lexer st = + let st_line = + Stream.from + (fun _ -> + try + match Stream.next st with + | '\n' -> incr line; Some '\n' + | c -> Some c + with Stream.Failure -> None) + in + Genlex.make_lexer ["="] st_line + in + let rec read_file lxr mp = + match Stream.npeek 3 lxr with + | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> + Stream.junk lxr; Stream.junk lxr; Stream.junk lxr; + read_file lxr (MapString.add nm value mp) + | [] -> mp + | _ -> + failwith + (Printf.sprintf "Malformed data file '%s' line %d" filename !line) + in + match stream with + | Some st -> read_file (lexer st) MapString.empty + | None -> + if Sys.file_exists filename then begin + let chn = open_in_bin filename in + let st = Stream.of_channel chn in + try + let mp = read_file (lexer st) MapString.empty in + close_in chn; mp + with e -> + close_in chn; raise e + end else if allow_empty then begin + MapString.empty + end else begin + failwith + (Printf.sprintf + "Unable to load environment, the file '%s' doesn't exist." + filename) + end + + let rec var_expand str env = + let buff = Buffer.create ((String.length str) * 2) in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) env + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + + + let var_get name env = var_expand (MapString.find name env) env + let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst +end + + +# 517 "myocamlbuild.ml" +module MyOCamlbuildFindlib = struct +(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) + + + (** OCamlbuild extension, copied from + * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html + * by N. Pouillard and others + * + * Updated on 2016-06-02 + * + * Modified by Sylvain Le Gall + *) + open Ocamlbuild_plugin + + + type conf = {no_automatic_syntax: bool} + + + let run_and_read = Ocamlbuild_pack.My_unix.run_and_read + + + let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings + + + let exec_from_conf exec = + let exec = + let env = BaseEnvLight.load ~allow_empty:true () in + try + BaseEnvLight.var_get exec env + with Not_found -> + Printf.eprintf "W: Cannot get variable %s\n" exec; + exec + in + let fix_win32 str = + if Sys.os_type = "Win32" then begin + let buff = Buffer.create (String.length str) in + (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. + *) + String.iter + (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) + str; + Buffer.contents buff + end else begin + str + end + in + fix_win32 exec + + + let split s ch = + let buf = Buffer.create 13 in + let x = ref [] in + let flush () = + x := (Buffer.contents buf) :: !x; + Buffer.clear buf + in + String.iter + (fun c -> + if c = ch then + flush () + else + Buffer.add_char buf c) + s; + flush (); + List.rev !x + + + let split_nl s = split s '\n' + + + let before_space s = + try + String.before s (String.index s ' ') + with Not_found -> s + + (* ocamlfind command *) + let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] + + (* This lists all supported packages. *) + let find_packages () = + List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) + + + (* Mock to list available syntaxes. *) + let find_syntaxes () = ["camlp4o"; "camlp4r"] + + + let well_known_syntax = [ + "camlp4.quotations.o"; + "camlp4.quotations.r"; + "camlp4.exceptiontracer"; + "camlp4.extend"; + "camlp4.foldgenerator"; + "camlp4.listcomprehension"; + "camlp4.locationstripper"; + "camlp4.macro"; + "camlp4.mapgenerator"; + "camlp4.metagenerator"; + "camlp4.profiler"; + "camlp4.tracer" + ] + + + let dispatch conf = + function + | After_options -> + (* By using Before_options one let command line options have an higher + * priority on the contrary using After_options will guarantee to have + * the higher priority override default commands by ocamlfind ones *) + Options.ocamlc := ocamlfind & A"ocamlc"; + Options.ocamlopt := ocamlfind & A"ocamlopt"; + Options.ocamldep := ocamlfind & A"ocamldep"; + Options.ocamldoc := ocamlfind & A"ocamldoc"; + Options.ocamlmktop := ocamlfind & A"ocamlmktop"; + Options.ocamlmklib := ocamlfind & A"ocamlmklib" + + | After_rules -> + + (* Avoid warnings for unused tag *) + flag ["tests"] N; + + (* When one link an OCaml library/binary/package, one should use + * -linkpkg *) + flag ["ocaml"; "link"; "program"] & A"-linkpkg"; + + (* For each ocamlfind package one inject the -package option when + * compiling, computing dependencies, generating documentation and + * linking. *) + List.iter + begin fun pkg -> + let base_args = [A"-package"; A pkg] in + (* TODO: consider how to really choose camlp4o or camlp4r. *) + let syn_args = [A"-syntax"; A "camlp4o"] in + let (args, pargs) = + (* Heuristic to identify syntax extensions: whether they end in + ".syntax"; some might not. + *) + if not (conf.no_automatic_syntax) && + (Filename.check_suffix pkg "syntax" || + List.mem pkg well_known_syntax) then + (syn_args @ base_args, syn_args) + else + (base_args, []) + in + flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; + flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; + flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; + flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; + flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; + + (* TODO: Check if this is allowed for OCaml < 3.12.1 *) + flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; + flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; + flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; + flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; + end + (find_packages ()); + + (* Like -package but for extensions syntax. Morover -syntax is useless + * when linking. *) + List.iter begin fun syntax -> + flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; + flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; + flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; + flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & + S[A"-syntax"; A syntax]; + end (find_syntaxes ()); + + (* The default "thread" tag is not compatible with ocamlfind. + * Indeed, the default rules add the "threads.cma" or "threads.cmxa" + * options when using this tag. When using the "-linkpkg" option with + * ocamlfind, this module will then be added twice on the command line. + * + * To solve this, one approach is to add the "-thread" option when using + * the "threads" package using the previous plugin. + *) + flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); + flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); + flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); + flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); + flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); + flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); + flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]); + + | _ -> + () +end + +module MyOCamlbuildBase = struct +(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + + + (** Base functions for writing myocamlbuild.ml + @author Sylvain Le Gall + *) + + + open Ocamlbuild_plugin + module OC = Ocamlbuild_pack.Ocaml_compiler + + + type dir = string + type file = string + type name = string + type tag = string + + + type t = + { + lib_ocaml: (name * dir list * string list) list; + lib_c: (name * dir * file list) list; + flags: (tag list * (spec OASISExpr.choices)) list; + (* Replace the 'dir: include' from _tags by a precise interdepends in + * directory. + *) + includes: (dir * dir list) list; + } + + +(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + + + let env_filename = Pathname.basename BaseEnvLight.default_filename + + + let dispatch_combine lst = + fun e -> + List.iter + (fun dispatch -> dispatch e) + lst + + + let tag_libstubs nm = + "use_lib"^nm^"_stubs" + + + let nm_libstubs nm = + nm^"_stubs" + + + let dispatch t e = + let env = BaseEnvLight.load ~allow_empty:true () in + match e with + | Before_options -> + let no_trailing_dot s = + if String.length s >= 1 && s.[0] = '.' then + String.sub s 1 ((String.length s) - 1) + else + s + in + List.iter + (fun (opt, var) -> + try + opt := no_trailing_dot (BaseEnvLight.var_get var env) + with Not_found -> + Printf.eprintf "W: Cannot get variable %s\n" var) + [ + Options.ext_obj, "ext_obj"; + Options.ext_lib, "ext_lib"; + Options.ext_dll, "ext_dll"; + ] + + | After_rules -> + (* Declare OCaml libraries *) + List.iter + (function + | nm, [], intf_modules -> + ocaml_lib nm; + let cmis = + List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi") + intf_modules in + dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis + | nm, dir :: tl, intf_modules -> + ocaml_lib ~dir:dir (dir^"/"^nm); + List.iter + (fun dir -> + List.iter + (fun str -> + flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) + ["compile"; "infer_interface"; "doc"]) + tl; + let cmis = + List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") + intf_modules in + dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] + cmis) + t.lib_ocaml; + + (* Declare directories dependencies, replace "include" in _tags. *) + List.iter + (fun (dir, include_dirs) -> + Pathname.define_context dir include_dirs) + t.includes; + + (* Declare C libraries *) + List.iter + (fun (lib, dir, headers) -> + (* Handle C part of library *) + flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] + (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; + A("-l"^(nm_libstubs lib))]); + + flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] + (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); + + if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then + flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] + (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); + + (* When ocaml link something that use the C library, then one + need that file to be up to date. + This holds both for programs and for libraries. + *) + dep ["link"; "ocaml"; tag_libstubs lib] + [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; + + dep ["compile"; "ocaml"; tag_libstubs lib] + [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; + + (* TODO: be more specific about what depends on headers *) + (* Depends on .h files *) + dep ["compile"; "c"] + headers; + + (* Setup search path for lib *) + flag ["link"; "ocaml"; "use_"^lib] + (S[A"-I"; P(dir)]); + ) + t.lib_c; + + (* Add flags *) + List.iter + (fun (tags, cond_specs) -> + let spec = BaseEnvLight.var_choose cond_specs env in + let rec eval_specs = + function + | S lst -> S (List.map eval_specs lst) + | A str -> A (BaseEnvLight.var_expand str env) + | spec -> spec + in + flag tags & (eval_specs spec)) + t.flags + | _ -> + () + + + let dispatch_default conf t = + dispatch_combine + [ + dispatch t; + MyOCamlbuildFindlib.dispatch conf; + ] + + +end + + +# 878 "myocamlbuild.ml" +open Ocamlbuild_plugin;; +let package_default = + { + MyOCamlbuildBase.lib_ocaml = [("cryptokit", ["src"], [])]; + lib_c = + [ + ("cryptokit", + "src", + [ + "src/aesni.h"; + "src/arcfour.h"; + "src/blowfish.h"; + "src/d3des.h"; + "src/rijndael-alg-fst.h"; + "src/ripemd160.h"; + "src/sha1.h"; + "src/sha256.h"; + "src/sha512.h"; + "src/keccak.h"; + "src/chacha20.h" + ]) + ]; + flags = + [ + (["oasis_library_cryptokit_ccopt"; "compile"], + [ + (OASISExpr.EBool true, S []); + (OASISExpr.EFlag "hardwaresupport", S [A "-ccopt"; A "-maes"]); + (OASISExpr.EFlag "zlib", S [A "-ccopt"; A "-DHAVE_ZLIB"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", OASISExpr.EFlag "hardwaresupport"), + S [A "-ccopt"; A "-DHAVE_ZLIB"; A "-ccopt"; A "-maes"]) + ]); + (["oasis_library_cryptokit_cclib"; "link"], + [ + (OASISExpr.EBool true, S []); + (OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64"))), + S [A "-cclib"; A "-ladvapi32"]); + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + S [A "-cclib"; A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "-cclib"; A "advapi32.lib"; A "-cclib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "-cclib"; A "zlib.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "-cclib"; A "zlib.lib"; A "-cclib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "-cclib"; A "zlib.lib"; A "-cclib"; A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S + [ + A "-cclib"; + A "zlib.lib"; + A "-cclib"; + A "advapi32.lib"; + A "-cclib"; + A "-ladvapi32" + ]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + S [A "-cclib"; A "-lz"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "-cclib"; A "-lz"; A "-cclib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "-cclib"; A "-lz"; A "-cclib"; A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S + [ + A "-cclib"; + A "-lz"; + A "-cclib"; + A "advapi32.lib"; + A "-cclib"; + A "-ladvapi32" + ]) + ]); + (["oasis_library_cryptokit_cclib"; "ocamlmklib"; "c"], + [ + (OASISExpr.EBool true, S []); + (OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64"))), + S [A "-ladvapi32"]); + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + S [A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "advapi32.lib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "zlib.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "zlib.lib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "zlib.lib"; A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "zlib.lib"; A "advapi32.lib"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + S [A "-lz"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "-lz"; A "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + S [A "-lz"; A "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + S [A "-lz"; A "advapi32.lib"; A "-ladvapi32"]) + ]) + ]; + includes = [("test", ["src"])] + } + ;; + +let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} + +let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; + +# 1206 "myocamlbuild.ml" +(* OASIS_STOP *) +Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml new file mode 100644 index 0000000..83da80d --- /dev/null +++ b/setup.ml @@ -0,0 +1,8075 @@ +(* setup.ml generated for the first time by OASIS v0.4.6 *) + +(* OASIS_START *) +(* DO NOT EDIT (digest: d4c571bd5629a18c3343ee6fabc026b5) *) +(* + Regenerated by OASIS v0.4.10 + Visit http://oasis.forge.ocamlcore.org for more information and + documentation about functions used in this file. +*) +module OASISGettext = struct +(* # 22 "src/oasis/OASISGettext.ml" *) + + + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str + + + let fn_ fmt1 fmt2 n = + if n = 1 then + fmt1^^"" + else + fmt2^^"" + + + let init = [] +end + +module OASISString = struct +(* # 22 "src/oasis/OASISString.ml" *) + + + (** Various string utilities. + + Mostly inspired by extlib and batteries ExtString and BatString libraries. + + @author Sylvain Le Gall + *) + + + let nsplitf str f = + if str = "" then + [] + else + let buf = Buffer.create 13 in + let lst = ref [] in + let push () = + lst := Buffer.contents buf :: !lst; + Buffer.clear buf + in + let str_len = String.length str in + for i = 0 to str_len - 1 do + if f str.[i] then + push () + else + Buffer.add_char buf str.[i] + done; + push (); + List.rev !lst + + + (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the + separator. + *) + let nsplit str c = + nsplitf str ((=) c) + + + let find ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + what_idx := 0; + incr str_idx + done; + if !what_idx <> String.length what then + raise Not_found + else + !str_idx - !what_idx + + + let sub_start str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str len (str_len - len) + + + let sub_end ?(offset=0) str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str 0 (str_len - len) + + + let starts_with ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + let ok = ref true in + while !ok && + !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + ok := false; + incr str_idx + done; + !what_idx = String.length what + + + let strip_starts_with ~what str = + if starts_with ~what str then + sub_start str (String.length what) + else + raise Not_found + + + let ends_with ~what ?(offset=0) str = + let what_idx = ref ((String.length what) - 1) in + let str_idx = ref ((String.length str) - 1) in + let ok = ref true in + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx + else + ok := false; + decr str_idx + done; + !what_idx = -1 + + + let strip_ends_with ~what str = + if ends_with ~what str then + sub_end str (String.length what) + else + raise Not_found + + + let replace_chars f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_char buf (f c)) s; + Buffer.contents buf + + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + +end + +module OASISUtils = struct +(* # 22 "src/oasis/OASISUtils.ml" *) + + + open OASISGettext + + + module MapExt = + struct + module type S = + sig + include Map.S + val add_list: 'a t -> (key * 'a) list -> 'a t + val of_list: (key * 'a) list -> 'a t + val to_list: 'a t -> (key * 'a) list + end + + module Make (Ord: Map.OrderedType) = + struct + include Map.Make(Ord) + + let rec add_list t = + function + | (k, v) :: tl -> add_list (add k v t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] + end + end + + + module MapString = MapExt.Make(String) + + + module SetExt = + struct + module type S = + sig + include Set.S + val add_list: t -> elt list -> t + val of_list: elt list -> t + val to_list: t -> elt list + end + + module Make (Ord: Set.OrderedType) = + struct + include Set.Make(Ord) + + let rec add_list t = + function + | e :: tl -> add_list (add e t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list = elements + end + end + + + module SetString = SetExt.Make(String) + + + let compare_csl s1 s2 = + String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) + + + module HashStringCsl = + Hashtbl.Make + (struct + type t = string + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) + end) + + module SetStringCsl = + SetExt.Make + (struct + type t = string + let compare = compare_csl + end) + + + let varname_of_string ?(hyphen='_') s = + if String.length s = 0 then + begin + invalid_arg "varname_of_string" + end + else + begin + let buf = + OASISString.replace_chars + (fun c -> + if ('a' <= c && c <= 'z') + || + ('A' <= c && c <= 'Z') + || + ('0' <= c && c <= '9') then + c + else + hyphen) + s; + in + let buf = + (* Start with a _ if digit *) + if '0' <= s.[0] && s.[0] <= '9' then + "_"^buf + else + buf + in + OASISString.lowercase_ascii buf + end + + + let varname_concat ?(hyphen='_') p s = + let what = String.make 1 hyphen in + let p = + try + OASISString.strip_ends_with ~what p + with Not_found -> + p + in + let s = + try + OASISString.strip_starts_with ~what s + with Not_found -> + s + in + p^what^s + + + let is_varname str = + str = varname_of_string str + + + let failwithf fmt = Printf.ksprintf failwith fmt + + + let rec file_location ?pos1 ?pos2 ?lexbuf () = + match pos1, pos2, lexbuf with + | Some p, None, _ | None, Some p, _ -> + file_location ~pos1:p ~pos2:p ?lexbuf () + | Some p1, Some p2, _ -> + let open Lexing in + let fn, lineno = p1.pos_fname, p1.pos_lnum in + let c1 = p1.pos_cnum - p1.pos_bol in + let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in + Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 + | _, _, Some lexbuf -> + file_location + ~pos1:(Lexing.lexeme_start_p lexbuf) + ~pos2:(Lexing.lexeme_end_p lexbuf) + () + | None, None, None -> + s_ "" + + + let failwithpf ?pos1 ?pos2 ?lexbuf fmt = + let loc = file_location ?pos1 ?pos2 ?lexbuf () in + Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt + + +end + +module OASISUnixPath = struct +(* # 22 "src/oasis/OASISUnixPath.ml" *) + + + type unix_filename = string + type unix_dirname = string + + + type host_filename = string + type host_dirname = string + + + let current_dir_name = "." + + + let parent_dir_name = ".." + + + let is_current_dir fn = + fn = current_dir_name || fn = "" + + + let concat f1 f2 = + if is_current_dir f1 then + f2 + else + let f1' = + try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 + in + f1'^"/"^f2 + + + let make = + function + | hd :: tl -> + List.fold_left + (fun f p -> concat f p) + hd + tl + | [] -> + invalid_arg "OASISUnixPath.make" + + + let dirname f = + try + String.sub f 0 (String.rindex f '/') + with Not_found -> + current_dir_name + + + let basename f = + try + let pos_start = + (String.rindex f '/') + 1 + in + String.sub f pos_start ((String.length f) - pos_start) + with Not_found -> + f + + + let chop_extension f = + try + let last_dot = + String.rindex f '.' + in + let sub = + String.sub f 0 last_dot + in + try + let last_slash = + String.rindex f '/' + in + if last_slash < last_dot then + sub + else + f + with Not_found -> + sub + + with Not_found -> + f + + + let capitalize_file f = + let dir = dirname f in + let base = basename f in + concat dir (OASISString.capitalize_ascii base) + + + let uncapitalize_file f = + let dir = dirname f in + let base = basename f in + concat dir (OASISString.uncapitalize_ascii base) + + +end + +module OASISHostPath = struct +(* # 22 "src/oasis/OASISHostPath.ml" *) + + + open Filename + open OASISGettext + + + module Unix = OASISUnixPath + + + let make = + function + | [] -> + invalid_arg "OASISHostPath.make" + | hd :: tl -> + List.fold_left Filename.concat hd tl + + + let of_unix ufn = + match Sys.os_type with + | "Unix" | "Cygwin" -> ufn + | "Win32" -> + make + (List.map + (fun p -> + if p = Unix.current_dir_name then + current_dir_name + else if p = Unix.parent_dir_name then + parent_dir_name + else + p) + (OASISString.nsplit ufn '/')) + | os_type -> + OASISUtils.failwithf + (f_ "Don't know the path format of os_type %S when translating unix \ + filename. %S") + os_type ufn + + +end + +module OASISFileSystem = struct +(* # 22 "src/oasis/OASISFileSystem.ml" *) + + (** File System functions + + @author Sylvain Le Gall + *) + + type 'a filename = string + + class type closer = + object + method close: unit + end + + class type reader = + object + inherit closer + method input: Buffer.t -> int -> unit + end + + class type writer = + object + inherit closer + method output: Buffer.t -> unit + end + + class type ['a] fs = + object + method string_of_filename: 'a filename -> string + method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer + method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader + method file_exists: 'a filename -> bool + method remove: 'a filename -> unit + end + + + module Mode = + struct + let default_in = [Open_rdonly] + let default_out = [Open_wronly; Open_creat; Open_trunc] + + let text_in = Open_text :: default_in + let text_out = Open_text :: default_out + + let binary_in = Open_binary :: default_in + let binary_out = Open_binary :: default_out + end + + let std_length = 4096 (* Standard buffer/read length. *) + let binary_out = Mode.binary_out + let binary_in = Mode.binary_in + + let of_unix_filename ufn = (ufn: 'a filename) + let to_unix_filename fn = (fn: string) + + + let defer_close o f = + try + let r = f o in o#close; r + with e -> + o#close; raise e + + + let stream_of_reader rdr = + let buf = Buffer.create std_length in + let pos = ref 0 in + let eof = ref false in + let rec next idx = + let bpos = idx - !pos in + if !eof then begin + None + end else if bpos < Buffer.length buf then begin + Some (Buffer.nth buf bpos) + end else begin + pos := !pos + Buffer.length buf; + Buffer.clear buf; + begin + try + rdr#input buf std_length; + with End_of_file -> + if Buffer.length buf = 0 then + eof := true + end; + next idx + end + in + Stream.from next + + + let read_all buf rdr = + try + while true do + rdr#input buf std_length + done + with End_of_file -> + () + + class ['a] host_fs rootdir : ['a] fs = + object (self) + method private host_filename fn = Filename.concat rootdir fn + method string_of_filename = self#host_filename + + method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn = + let chn = open_out_gen mode perm (self#host_filename fn) in + object + method close = close_out chn + method output buf = Buffer.output_buffer chn buf + end + + method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn = + (* TODO: use Buffer.add_channel when minimal version of OCaml will + * be >= 4.03.0 (previous version was discarding last chars). + *) + let chn = open_in_gen mode perm (self#host_filename fn) in + let strm = Stream.of_channel chn in + object + method close = close_in chn + method input buf len = + let read = ref 0 in + try + for _i = 0 to len do + Buffer.add_char buf (Stream.next strm); + incr read + done + with Stream.Failure -> + if !read = 0 then + raise End_of_file + end + + method file_exists fn = Sys.file_exists (self#host_filename fn) + method remove fn = Sys.remove (self#host_filename fn) + end + +end + +module OASISContext = struct +(* # 22 "src/oasis/OASISContext.ml" *) + + + open OASISGettext + + + type level = + [ `Debug + | `Info + | `Warning + | `Error] + + + type source + type source_filename = source OASISFileSystem.filename + + + let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn + + + type t = + { + (* TODO: replace this by a proplist. *) + quiet: bool; + info: bool; + debug: bool; + ignore_plugins: bool; + ignore_unknown_fields: bool; + printf: level -> string -> unit; + srcfs: source OASISFileSystem.fs; + load_oasis_plugin: string -> bool; + } + + + let printf lvl str = + let beg = + match lvl with + | `Error -> s_ "E: " + | `Warning -> s_ "W: " + | `Info -> s_ "I: " + | `Debug -> s_ "D: " + in + prerr_endline (beg^str) + + + let default = + ref + { + quiet = false; + info = false; + debug = false; + ignore_plugins = false; + ignore_unknown_fields = false; + printf = printf; + srcfs = new OASISFileSystem.host_fs(Sys.getcwd ()); + load_oasis_plugin = (fun _ -> false); + } + + + let quiet = + {!default with quiet = true} + + + let fspecs () = + (* TODO: don't act on default. *) + let ignore_plugins = ref false in + ["-quiet", + Arg.Unit (fun () -> default := {!default with quiet = true}), + s_ " Run quietly"; + + "-info", + Arg.Unit (fun () -> default := {!default with info = true}), + s_ " Display information message"; + + + "-debug", + Arg.Unit (fun () -> default := {!default with debug = true}), + s_ " Output debug message"; + + "-ignore-plugins", + Arg.Set ignore_plugins, + s_ " Ignore plugin's field."; + + "-C", + Arg.String + (fun str -> + Sys.chdir str; + default := {!default with srcfs = new OASISFileSystem.host_fs str}), + s_ "dir Change directory before running (affects setup.{data,log})."], + fun () -> {!default with ignore_plugins = !ignore_plugins} +end + +module PropList = struct +(* # 22 "src/oasis/PropList.ml" *) + + + open OASISGettext + + + type name = string + + + exception Not_set of name * string option + exception No_printer of name + exception Unknown_field of name * name + + + let () = + Printexc.register_printer + (function + | Not_set (nm, Some rsn) -> + Some + (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) + | Not_set (nm, None) -> + Some + (Printf.sprintf (f_ "Field '%s' is not set") nm) + | No_printer nm -> + Some + (Printf.sprintf (f_ "No default printer for value %s") nm) + | Unknown_field (nm, schm) -> + Some + (Printf.sprintf + (f_ "Field %s is not defined in schema %s") nm schm) + | _ -> + None) + + + module Data = + struct + type t = + (name, unit -> unit) Hashtbl.t + + let create () = + Hashtbl.create 13 + + let clear t = + Hashtbl.clear t + + +(* # 77 "src/oasis/PropList.ml" *) + end + + + module Schema = + struct + type ('ctxt, 'extra) value = + { + get: Data.t -> string; + set: Data.t -> ?context:'ctxt -> string -> unit; + help: (unit -> string) option; + extra: 'extra; + } + + type ('ctxt, 'extra) t = + { + name: name; + fields: (name, ('ctxt, 'extra) value) Hashtbl.t; + order: name Queue.t; + name_norm: string -> string; + } + + let create ?(case_insensitive=false) nm = + { + name = nm; + fields = Hashtbl.create 13; + order = Queue.create (); + name_norm = + (if case_insensitive then + OASISString.lowercase_ascii + else + fun s -> s); + } + + let add t nm set get extra help = + let key = + t.name_norm nm + in + + if Hashtbl.mem t.fields key then + failwith + (Printf.sprintf + (f_ "Field '%s' is already defined in schema '%s'") + nm t.name); + Hashtbl.add + t.fields + key + { + set = set; + get = get; + help = help; + extra = extra; + }; + Queue.add nm t.order + + let mem t nm = + Hashtbl.mem t.fields nm + + let find t nm = + try + Hashtbl.find t.fields (t.name_norm nm) + with Not_found -> + raise (Unknown_field (nm, t.name)) + + let get t data nm = + (find t nm).get data + + let set t data nm ?context x = + (find t nm).set + data + ?context + x + + let fold f acc t = + Queue.fold + (fun acc k -> + let v = + find t k + in + f acc k v.extra v.help) + acc + t.order + + let iter f t = + fold + (fun () -> f) + () + t + + let name t = + t.name + end + + + module Field = + struct + type ('ctxt, 'value, 'extra) t = + { + set: Data.t -> ?context:'ctxt -> 'value -> unit; + get: Data.t -> 'value; + sets: Data.t -> ?context:'ctxt -> string -> unit; + gets: Data.t -> string; + help: (unit -> string) option; + extra: 'extra; + } + + let new_id = + let last_id = + ref 0 + in + fun () -> incr last_id; !last_id + + let create ?schema ?name ?parse ?print ?default ?update ?help extra = + (* Default value container *) + let v = + ref None + in + + (* If name is not given, create unique one *) + let nm = + match name with + | Some s -> s + | None -> Printf.sprintf "_anon_%d" (new_id ()) + in + + (* Last chance to get a value: the default *) + let default () = + match default with + | Some d -> d + | None -> raise (Not_set (nm, Some (s_ "no default value"))) + in + + (* Get data *) + let get data = + (* Get value *) + try + (Hashtbl.find data nm) (); + match !v with + | Some x -> x + | None -> default () + with Not_found -> + default () + in + + (* Set data *) + let set data ?context x = + let x = + match update with + | Some f -> + begin + try + f ?context (get data) x + with Not_set _ -> + x + end + | None -> + x + in + Hashtbl.replace + data + nm + (fun () -> v := Some x) + in + + (* Parse string value, if possible *) + let parse = + match parse with + | Some f -> + f + | None -> + fun ?context s -> + failwith + (Printf.sprintf + (f_ "Cannot parse field '%s' when setting value %S") + nm + s) + in + + (* Set data, from string *) + let sets data ?context s = + set ?context data (parse ?context s) + in + + (* Output value as string, if possible *) + let print = + match print with + | Some f -> + f + | None -> + fun _ -> raise (No_printer nm) + in + + (* Get data, as a string *) + let gets data = + print (get data) + in + + begin + match schema with + | Some t -> + Schema.add t nm sets gets extra help + | None -> + () + end; + + { + set = set; + get = get; + sets = sets; + gets = gets; + help = help; + extra = extra; + } + + let fset data t ?context x = + t.set data ?context x + + let fget data t = + t.get data + + let fsets data t ?context s = + t.sets data ?context s + + let fgets data t = + t.gets data + end + + + module FieldRO = + struct + let create ?schema ?name ?parse ?print ?default ?update ?help extra = + let fld = + Field.create ?schema ?name ?parse ?print ?default ?update ?help extra + in + fun data -> Field.fget data fld + end +end + +module OASISMessage = struct +(* # 22 "src/oasis/OASISMessage.ml" *) + + + open OASISGettext + open OASISContext + + + let generic_message ~ctxt lvl fmt = + let cond = + if ctxt.quiet then + false + else + match lvl with + | `Debug -> ctxt.debug + | `Info -> ctxt.info + | _ -> true + in + Printf.ksprintf + (fun str -> + if cond then + begin + ctxt.printf lvl str + end) + fmt + + + let debug ~ctxt fmt = + generic_message ~ctxt `Debug fmt + + + let info ~ctxt fmt = + generic_message ~ctxt `Info fmt + + + let warning ~ctxt fmt = + generic_message ~ctxt `Warning fmt + + + let error ~ctxt fmt = + generic_message ~ctxt `Error fmt + +end + +module OASISVersion = struct +(* # 22 "src/oasis/OASISVersion.ml" *) + + + open OASISGettext + + + type t = string + + + type comparator = + | VGreater of t + | VGreaterEqual of t + | VEqual of t + | VLesser of t + | VLesserEqual of t + | VOr of comparator * comparator + | VAnd of comparator * comparator + + + (* Range of allowed characters *) + let is_digit c = '0' <= c && c <= '9' + let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') + let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false + + + let rec version_compare v1 v2 = + if v1 <> "" || v2 <> "" then + begin + (* Compare ascii string, using special meaning for version + * related char + *) + let val_ascii c = + if c = '~' then -1 + else if is_digit c then 0 + else if c = '\000' then 0 + else if is_alpha c then Char.code c + else (Char.code c) + 256 + in + + let len1 = String.length v1 in + let len2 = String.length v2 in + + let p = ref 0 in + + (** Compare ascii part *) + let compare_vascii () = + let cmp = ref 0 in + while !cmp = 0 && + !p < len1 && !p < len2 && + not (is_digit v1.[!p] && is_digit v2.[!p]) do + cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); + incr p + done; + if !cmp = 0 && !p < len1 && !p = len2 then + val_ascii v1.[!p] + else if !cmp = 0 && !p = len1 && !p < len2 then + - (val_ascii v2.[!p]) + else + !cmp + in + + (** Compare digit part *) + let compare_digit () = + let extract_int v p = + let start_p = !p in + while !p < String.length v && is_digit v.[!p] do + incr p + done; + let substr = + String.sub v !p ((String.length v) - !p) + in + let res = + match String.sub v start_p (!p - start_p) with + | "" -> 0 + | s -> int_of_string s + in + res, substr + in + let i1, tl1 = extract_int v1 (ref !p) in + let i2, tl2 = extract_int v2 (ref !p) in + i1 - i2, tl1, tl2 + in + + match compare_vascii () with + | 0 -> + begin + match compare_digit () with + | 0, tl1, tl2 -> + if tl1 <> "" && is_digit tl1.[0] then + 1 + else if tl2 <> "" && is_digit tl2.[0] then + -1 + else + version_compare tl1 tl2 + | n, _, _ -> + n + end + | n -> + n + end + else begin + 0 + end + + + let version_of_string str = str + + + let string_of_version t = t + + + let chop t = + try + let pos = + String.rindex t '.' + in + String.sub t 0 pos + with Not_found -> + t + + + let rec comparator_apply v op = + match op with + | VGreater cv -> + (version_compare v cv) > 0 + | VGreaterEqual cv -> + (version_compare v cv) >= 0 + | VLesser cv -> + (version_compare v cv) < 0 + | VLesserEqual cv -> + (version_compare v cv) <= 0 + | VEqual cv -> + (version_compare v cv) = 0 + | VOr (op1, op2) -> + (comparator_apply v op1) || (comparator_apply v op2) + | VAnd (op1, op2) -> + (comparator_apply v op1) && (comparator_apply v op2) + + + let rec string_of_comparator = + function + | VGreater v -> "> "^(string_of_version v) + | VEqual v -> "= "^(string_of_version v) + | VLesser v -> "< "^(string_of_version v) + | VGreaterEqual v -> ">= "^(string_of_version v) + | VLesserEqual v -> "<= "^(string_of_version v) + | VOr (c1, c2) -> + (string_of_comparator c1)^" || "^(string_of_comparator c2) + | VAnd (c1, c2) -> + (string_of_comparator c1)^" && "^(string_of_comparator c2) + + + let rec varname_of_comparator = + let concat p v = + OASISUtils.varname_concat + p + (OASISUtils.varname_of_string + (string_of_version v)) + in + function + | VGreater v -> concat "gt" v + | VLesser v -> concat "lt" v + | VEqual v -> concat "eq" v + | VGreaterEqual v -> concat "ge" v + | VLesserEqual v -> concat "le" v + | VOr (c1, c2) -> + (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) + | VAnd (c1, c2) -> + (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) + + +end + +module OASISLicense = struct +(* # 22 "src/oasis/OASISLicense.ml" *) + + + (** License for _oasis fields + @author Sylvain Le Gall + *) + + + type license = string + type license_exception = string + + + type license_version = + | Version of OASISVersion.t + | VersionOrLater of OASISVersion.t + | NoVersion + + + type license_dep_5_unit = + { + license: license; + excption: license_exception option; + version: license_version; + } + + + type license_dep_5 = + | DEP5Unit of license_dep_5_unit + | DEP5Or of license_dep_5 list + | DEP5And of license_dep_5 list + + + type t = + | DEP5License of license_dep_5 + | OtherLicense of string (* URL *) + + +end + +module OASISExpr = struct +(* # 22 "src/oasis/OASISExpr.ml" *) + + + open OASISGettext + open OASISUtils + + + type test = string + type flag = string + + + type t = + | EBool of bool + | ENot of t + | EAnd of t * t + | EOr of t * t + | EFlag of flag + | ETest of test * string + + + type 'a choices = (t * 'a) list + + + let eval var_get t = + let rec eval' = + function + | EBool b -> + b + + | ENot e -> + not (eval' e) + + | EAnd (e1, e2) -> + (eval' e1) && (eval' e2) + + | EOr (e1, e2) -> + (eval' e1) || (eval' e2) + + | EFlag nm -> + let v = + var_get nm + in + assert(v = "true" || v = "false"); + (v = "true") + + | ETest (nm, vl) -> + let v = + var_get nm + in + (v = vl) + in + eval' t + + + let choose ?printer ?name var_get lst = + let rec choose_aux = + function + | (cond, vl) :: tl -> + if eval var_get cond then + vl + else + choose_aux tl + | [] -> + let str_lst = + if lst = [] then + s_ "" + else + String.concat + (s_ ", ") + (List.map + (fun (cond, vl) -> + match printer with + | Some p -> p vl + | None -> s_ "") + lst) + in + match name with + | Some nm -> + failwith + (Printf.sprintf + (f_ "No result for the choice list '%s': %s") + nm str_lst) + | None -> + failwith + (Printf.sprintf + (f_ "No result for a choice list: %s") + str_lst) + in + choose_aux (List.rev lst) + + +end + +module OASISText = struct +(* # 22 "src/oasis/OASISText.ml" *) + + type elt = + | Para of string + | Verbatim of string + | BlankLine + + type t = elt list + +end + +module OASISSourcePatterns = struct +(* # 22 "src/oasis/OASISSourcePatterns.ml" *) + + open OASISUtils + open OASISGettext + + module Templater = + struct + (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *) + type t = + { + atoms: atom list; + origin: string + } + and atom = + | Text of string + | Expr of expr + and expr = + | Ident of string + | String of string + | Call of string * expr + + + type env = + { + variables: string MapString.t; + functions: (string -> string) MapString.t; + } + + + let eval env t = + let rec eval_expr env = + function + | String str -> str + | Ident nm -> + begin + try + MapString.find nm env.variables + with Not_found -> + (* TODO: add error location within the string. *) + failwithf + (f_ "Unable to find variable %S in source pattern %S") + nm t.origin + end + + | Call (fn, expr) -> + begin + try + (MapString.find fn env.functions) (eval_expr env expr) + with Not_found -> + (* TODO: add error location within the string. *) + failwithf + (f_ "Unable to find function %S in source pattern %S") + fn t.origin + end + in + String.concat "" + (List.map + (function + | Text str -> str + | Expr expr -> eval_expr env expr) + t.atoms) + + + let parse env s = + let lxr = Genlex.make_lexer [] in + let parse_expr s = + let st = lxr (Stream.of_string s) in + match Stream.npeek 3 st with + | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm) + | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str) + | [Genlex.String str] -> String str + | [Genlex.Ident nm] -> Ident nm + (* TODO: add error location within the string. *) + | _ -> failwithf (f_ "Unable to parse expression %S") s + in + let parse s = + let lst_exprs = ref [] in + let ss = + let buff = Buffer.create (String.length s) in + Buffer.add_substitute + buff + (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000") + s; + Buffer.contents buff + in + let rec join = + function + | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2) + | [], tl -> List.map (fun e -> Expr e) tl + | tl, [] -> List.map (fun e -> Text e) tl + in + join (OASISString.nsplit ss '\000', List.rev (!lst_exprs)) + in + let t = {atoms = parse s; origin = s} in + (* We rely on a simple evaluation for checking variables/functions. + It works because there is no if/loop statement. + *) + let _s : string = eval env t in + t + +(* # 144 "src/oasis/OASISSourcePatterns.ml" *) + end + + + type t = Templater.t + + + let env ~modul () = + { + Templater. + variables = MapString.of_list ["module", modul]; + functions = MapString.of_list + [ + "capitalize_file", OASISUnixPath.capitalize_file; + "uncapitalize_file", OASISUnixPath.uncapitalize_file; + ]; + } + + let all_possible_files lst ~path ~modul = + let eval = Templater.eval (env ~modul ()) in + List.fold_left + (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc) + [] lst + + + let to_string t = t.Templater.origin + + +end + +module OASISTypes = struct +(* # 22 "src/oasis/OASISTypes.ml" *) + + + type name = string + type package_name = string + type url = string + type unix_dirname = string + type unix_filename = string (* TODO: replace everywhere. *) + type host_dirname = string (* TODO: replace everywhere. *) + type host_filename = string (* TODO: replace everywhere. *) + type prog = string + type arg = string + type args = string list + type command_line = (prog * arg list) + + + type findlib_name = string + type findlib_full = string + + + type compiled_object = + | Byte + | Native + | Best + + + type dependency = + | FindlibPackage of findlib_full * OASISVersion.comparator option + | InternalLibrary of name + + + type tool = + | ExternalTool of name + | InternalExecutable of name + + + type vcs = + | Darcs + | Git + | Svn + | Cvs + | Hg + | Bzr + | Arch + | Monotone + | OtherVCS of url + + + type plugin_kind = + [ `Configure + | `Build + | `Doc + | `Test + | `Install + | `Extra + ] + + + type plugin_data_purpose = + [ `Configure + | `Build + | `Install + | `Clean + | `Distclean + | `Install + | `Uninstall + | `Test + | `Doc + | `Extra + | `Other of string + ] + + + type 'a plugin = 'a * name * OASISVersion.t option + + + type all_plugin = plugin_kind plugin + + + type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list + + + type 'a conditional = 'a OASISExpr.choices + + + type custom = + { + pre_command: (command_line option) conditional; + post_command: (command_line option) conditional; + } + + + type common_section = + { + cs_name: name; + cs_data: PropList.Data.t; + cs_plugin_data: plugin_data; + } + + + type build_section = + { + bs_build: bool conditional; + bs_install: bool conditional; + bs_path: unix_dirname; + bs_compiled_object: compiled_object; + bs_build_depends: dependency list; + bs_build_tools: tool list; + bs_interface_patterns: OASISSourcePatterns.t list; + bs_implementation_patterns: OASISSourcePatterns.t list; + bs_c_sources: unix_filename list; + bs_data_files: (unix_filename * unix_filename option) list; + bs_findlib_extra_files: unix_filename list; + bs_ccopt: args conditional; + bs_cclib: args conditional; + bs_dlllib: args conditional; + bs_dllpath: args conditional; + bs_byteopt: args conditional; + bs_nativeopt: args conditional; + } + + + type library = + { + lib_modules: string list; + lib_pack: bool; + lib_internal_modules: string list; + lib_findlib_parent: findlib_name option; + lib_findlib_name: findlib_name option; + lib_findlib_directory: unix_dirname option; + lib_findlib_containers: findlib_name list; + } + + + type object_ = + { + obj_modules: string list; + obj_findlib_fullname: findlib_name list option; + obj_findlib_directory: unix_dirname option; + } + + + type executable = + { + exec_custom: bool; + exec_main_is: unix_filename; + } + + + type flag = + { + flag_description: string option; + flag_default: bool conditional; + } + + + type source_repository = + { + src_repo_type: vcs; + src_repo_location: url; + src_repo_browser: url option; + src_repo_module: string option; + src_repo_branch: string option; + src_repo_tag: string option; + src_repo_subdir: unix_filename option; + } + + + type test = + { + test_type: [`Test] plugin; + test_command: command_line conditional; + test_custom: custom; + test_working_directory: unix_filename option; + test_run: bool conditional; + test_tools: tool list; + } + + + type doc_format = + | HTML of unix_filename (* TODO: source filename. *) + | DocText + | PDF + | PostScript + | Info of unix_filename (* TODO: source filename. *) + | DVI + | OtherDoc + + + type doc = + { + doc_type: [`Doc] plugin; + doc_custom: custom; + doc_build: bool conditional; + doc_install: bool conditional; + doc_install_dir: unix_filename; (* TODO: dest filename ?. *) + doc_title: string; + doc_authors: string list; + doc_abstract: string option; + doc_format: doc_format; + (* TODO: src filename. *) + doc_data_files: (unix_filename * unix_filename option) list; + doc_build_tools: tool list; + } + + + type section = + | Library of common_section * build_section * library + | Object of common_section * build_section * object_ + | Executable of common_section * build_section * executable + | Flag of common_section * flag + | SrcRepo of common_section * source_repository + | Test of common_section * test + | Doc of common_section * doc + + + type section_kind = + [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] + + + type package = + { + oasis_version: OASISVersion.t; + ocaml_version: OASISVersion.comparator option; + findlib_version: OASISVersion.comparator option; + alpha_features: string list; + beta_features: string list; + name: package_name; + version: OASISVersion.t; + license: OASISLicense.t; + license_file: unix_filename option; (* TODO: source filename. *) + copyrights: string list; + maintainers: string list; + authors: string list; + homepage: url option; + bugreports: url option; + synopsis: string; + description: OASISText.t option; + tags: string list; + categories: url list; + + conf_type: [`Configure] plugin; + conf_custom: custom; + + build_type: [`Build] plugin; + build_custom: custom; + + install_type: [`Install] plugin; + install_custom: custom; + uninstall_custom: custom; + + clean_custom: custom; + distclean_custom: custom; + + files_ab: unix_filename list; (* TODO: source filename. *) + sections: section list; + plugins: [`Extra] plugin list; + disable_oasis_section: unix_filename list; (* TODO: source filename. *) + schema_data: PropList.Data.t; + plugin_data: plugin_data; + } + + +end + +module OASISFeatures = struct +(* # 22 "src/oasis/OASISFeatures.ml" *) + + open OASISTypes + open OASISUtils + open OASISGettext + open OASISVersion + + module MapPlugin = + Map.Make + (struct + type t = plugin_kind * name + let compare = Pervasives.compare + end) + + module Data = + struct + type t = + { + oasis_version: OASISVersion.t; + plugin_versions: OASISVersion.t option MapPlugin.t; + alpha_features: string list; + beta_features: string list; + } + + let create oasis_version alpha_features beta_features = + { + oasis_version = oasis_version; + plugin_versions = MapPlugin.empty; + alpha_features = alpha_features; + beta_features = beta_features + } + + let of_package pkg = + create + pkg.OASISTypes.oasis_version + pkg.OASISTypes.alpha_features + pkg.OASISTypes.beta_features + + let add_plugin (plugin_kind, plugin_name, plugin_version) t = + {t with + plugin_versions = MapPlugin.add + (plugin_kind, plugin_name) + plugin_version + t.plugin_versions} + + let plugin_version plugin_kind plugin_name t = + MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions + + let to_string t = + Printf.sprintf + "oasis_version: %s; alpha_features: %s; beta_features: %s; \ + plugins_version: %s" + (OASISVersion.string_of_version (t:t).oasis_version) + (String.concat ", " t.alpha_features) + (String.concat ", " t.beta_features) + (String.concat ", " + (MapPlugin.fold + (fun (_, plg) ver_opt acc -> + (plg^ + (match ver_opt with + | Some v -> + " "^(OASISVersion.string_of_version v) + | None -> "")) + :: acc) + t.plugin_versions [])) + end + + type origin = + | Field of string * string + | Section of string + | NoOrigin + + type stage = Alpha | Beta + + + let string_of_stage = + function + | Alpha -> "alpha" + | Beta -> "beta" + + + let field_of_stage = + function + | Alpha -> "AlphaFeatures" + | Beta -> "BetaFeatures" + + type publication = InDev of stage | SinceVersion of OASISVersion.t + + type t = + { + name: string; + plugin: all_plugin option; + publication: publication; + description: unit -> string; + } + + (* TODO: mutex protect this. *) + let all_features = Hashtbl.create 13 + + + let since_version ver_str = SinceVersion (version_of_string ver_str) + let alpha = InDev Alpha + let beta = InDev Beta + + + let to_string t = + Printf.sprintf + "feature: %s; plugin: %s; publication: %s" + (t:t).name + (match t.plugin with + | None -> "" + | Some (_, nm, _) -> nm) + (match t.publication with + | InDev stage -> string_of_stage stage + | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) + + let data_check t data origin = + let no_message = "no message" in + + let check_feature features stage = + let has_feature = List.mem (t:t).name features in + if not has_feature then + match (origin:origin) with + | Field (fld, where) -> + Some + (Printf.sprintf + (f_ "Field %s in %s is only available when feature %s \ + is in field %s.") + fld where t.name (field_of_stage stage)) + | Section sct -> + Some + (Printf.sprintf + (f_ "Section %s is only available when features %s \ + is in field %s.") + sct t.name (field_of_stage stage)) + | NoOrigin -> + Some no_message + else + None + in + + let version_is_good ~min_version version fmt = + let version_is_good = + OASISVersion.comparator_apply + version (OASISVersion.VGreaterEqual min_version) + in + Printf.ksprintf + (fun str -> if version_is_good then None else Some str) + fmt + in + + match origin, t.plugin, t.publication with + | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha + | _, _, InDev Beta -> check_feature data.Data.beta_features Beta + | Field(fld, where), None, SinceVersion min_version -> + version_is_good ~min_version data.Data.oasis_version + (f_ "Field %s in %s is only valid since OASIS v%s, update \ + OASISFormat field from '%s' to '%s' after checking \ + OASIS changelog.") + fld where (string_of_version min_version) + (string_of_version data.Data.oasis_version) + (string_of_version min_version) + + | Field(fld, where), Some(plugin_knd, plugin_name, _), + SinceVersion min_version -> + begin + try + let plugin_version_current = + try + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> + failwithf + (f_ "Field %s in %s is only valid for the OASIS \ + plugin %s since v%s, but no plugin version is \ + defined in the _oasis file, change '%s' to \ + '%s (%s)' in your _oasis file.") + fld where plugin_name (string_of_version min_version) + plugin_name + plugin_name (string_of_version min_version) + with Not_found -> + failwithf + (f_ "Field %s in %s is only valid when the OASIS plugin %s \ + is defined.") + fld where plugin_name + in + version_is_good ~min_version plugin_version_current + (f_ "Field %s in %s is only valid for the OASIS plugin %s \ + since v%s, update your plugin from '%s (%s)' to \ + '%s (%s)' after checking the plugin's changelog.") + fld where plugin_name (string_of_version min_version) + plugin_name (string_of_version plugin_version_current) + plugin_name (string_of_version min_version) + with Failure msg -> + Some msg + end + + | Section sct, None, SinceVersion min_version -> + version_is_good ~min_version data.Data.oasis_version + (f_ "Section %s is only valid for since OASIS v%s, update \ + OASISFormat field from '%s' to '%s' after checking OASIS \ + changelog.") + sct (string_of_version min_version) + (string_of_version data.Data.oasis_version) + (string_of_version min_version) + + | Section sct, Some(plugin_knd, plugin_name, _), + SinceVersion min_version -> + begin + try + let plugin_version_current = + try + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> + failwithf + (f_ "Section %s is only valid for the OASIS \ + plugin %s since v%s, but no plugin version is \ + defined in the _oasis file, change '%s' to \ + '%s (%s)' in your _oasis file.") + sct plugin_name (string_of_version min_version) + plugin_name + plugin_name (string_of_version min_version) + with Not_found -> + failwithf + (f_ "Section %s is only valid when the OASIS plugin %s \ + is defined.") + sct plugin_name + in + version_is_good ~min_version plugin_version_current + (f_ "Section %s is only valid for the OASIS plugin %s \ + since v%s, update your plugin from '%s (%s)' to \ + '%s (%s)' after checking the plugin's changelog.") + sct plugin_name (string_of_version min_version) + plugin_name (string_of_version plugin_version_current) + plugin_name (string_of_version min_version) + with Failure msg -> + Some msg + end + + | NoOrigin, None, SinceVersion min_version -> + version_is_good ~min_version data.Data.oasis_version "%s" no_message + + | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> + begin + try + let plugin_version_current = + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> raise Not_found + in + version_is_good ~min_version plugin_version_current + "%s" no_message + with Not_found -> + Some no_message + end + + + let data_assert t data origin = + match data_check t data origin with + | None -> () + | Some str -> failwith str + + + let data_test t data = + match data_check t data NoOrigin with + | None -> true + | Some _ -> false + + + let package_test t pkg = + data_test t (Data.of_package pkg) + + + let create ?plugin name publication description = + let () = + if Hashtbl.mem all_features name then + failwithf "Feature '%s' is already declared." name + in + let t = + { + name = name; + plugin = plugin; + publication = publication; + description = description; + } + in + Hashtbl.add all_features name t; + t + + + let get_stage name = + try + (Hashtbl.find all_features name).publication + with Not_found -> + failwithf (f_ "Feature %s doesn't exist.") name + + + let list () = + Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] + + (* + * Real flags. + *) + + + let features = + create "features_fields" + (since_version "0.4") + (fun () -> + s_ "Enable to experiment not yet official features.") + + + let flag_docs = + create "flag_docs" + (since_version "0.3") + (fun () -> + s_ "Make building docs require '-docs' flag at configure.") + + + let flag_tests = + create "flag_tests" + (since_version "0.3") + (fun () -> + s_ "Make running tests require '-tests' flag at configure.") + + + let pack = + create "pack" + (since_version "0.3") + (fun () -> + s_ "Allow to create packed library.") + + + let section_object = + create "section_object" beta + (fun () -> + s_ "Implement an object section.") + + + let dynrun_for_release = + create "dynrun_for_release" alpha + (fun () -> + s_ "Make '-setup-update dynamic' suitable for releasing project.") + + + let compiled_setup_ml = + create "compiled_setup_ml" alpha + (fun () -> + s_ "Compile the setup.ml and speed-up actions done with it.") + + let disable_oasis_section = + create "disable_oasis_section" alpha + (fun () -> + s_ "Allow the OASIS section comments and digests to be omitted in \ + generated files.") + + let no_automatic_syntax = + create "no_automatic_syntax" alpha + (fun () -> + s_ "Disable the automatic inclusion of -syntax camlp4o for packages \ + that matches the internal heuristic (if a dependency ends with \ + a .syntax or is a well known syntax).") + + let findlib_directory = + create "findlib_directory" beta + (fun () -> + s_ "Allow to install findlib libraries in sub-directories of the target \ + findlib directory.") + + let findlib_extra_files = + create "findlib_extra_files" beta + (fun () -> + s_ "Allow to install extra files for findlib libraries.") + + let source_patterns = + create "source_patterns" alpha + (fun () -> + s_ "Customize mapping between module name and source file.") +end + +module OASISSection = struct +(* # 22 "src/oasis/OASISSection.ml" *) + + + open OASISTypes + + + let section_kind_common = + function + | Library (cs, _, _) -> + `Library, cs + | Object (cs, _, _) -> + `Object, cs + | Executable (cs, _, _) -> + `Executable, cs + | Flag (cs, _) -> + `Flag, cs + | SrcRepo (cs, _) -> + `SrcRepo, cs + | Test (cs, _) -> + `Test, cs + | Doc (cs, _) -> + `Doc, cs + + + let section_common sct = + snd (section_kind_common sct) + + + let section_common_set cs = + function + | Library (_, bs, lib) -> Library (cs, bs, lib) + | Object (_, bs, obj) -> Object (cs, bs, obj) + | Executable (_, bs, exec) -> Executable (cs, bs, exec) + | Flag (_, flg) -> Flag (cs, flg) + | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) + | Test (_, tst) -> Test (cs, tst) + | Doc (_, doc) -> Doc (cs, doc) + + + (** Key used to identify section + *) + let section_id sct = + let k, cs = + section_kind_common sct + in + k, cs.cs_name + + + let string_of_section_kind = + function + | `Library -> "library" + | `Object -> "object" + | `Executable -> "executable" + | `Flag -> "flag" + | `SrcRepo -> "src repository" + | `Test -> "test" + | `Doc -> "doc" + + + let string_of_section sct = + let k, nm = section_id sct in + (string_of_section_kind k)^" "^nm + + + let section_find id scts = + List.find + (fun sct -> id = section_id sct) + scts + + + module CSection = + struct + type t = section + + let id = section_id + + let compare t1 t2 = + compare (id t1) (id t2) + + let equal t1 t2 = + (id t1) = (id t2) + + let hash t = + Hashtbl.hash (id t) + end + + + module MapSection = Map.Make(CSection) + module SetSection = Set.Make(CSection) + + +end + +module OASISBuildSection = struct +(* # 22 "src/oasis/OASISBuildSection.ml" *) + + open OASISTypes + + (* Look for a module file, considering capitalization or not. *) + let find_module source_file_exists bs modul = + let possible_lst = + OASISSourcePatterns.all_possible_files + (bs.bs_interface_patterns @ bs.bs_implementation_patterns) + ~path:bs.bs_path + ~modul + in + match List.filter source_file_exists possible_lst with + | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst) + | [] -> + let open OASISUtils in + let _, rev_lst = + List.fold_left + (fun (set, acc) fn -> + let base_fn = OASISUnixPath.chop_extension fn in + if SetString.mem base_fn set then + set, acc + else + SetString.add base_fn set, base_fn :: acc) + (SetString.empty, []) possible_lst + in + `No_sources (List.rev rev_lst) + + +end + +module OASISExecutable = struct +(* # 22 "src/oasis/OASISExecutable.ml" *) + + + open OASISTypes + + + let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = + let dir = + OASISUnixPath.concat + bs.bs_path + (OASISUnixPath.dirname exec.exec_main_is) + in + let is_native_exec = + match bs.bs_compiled_object with + | Native -> true + | Best -> is_native () + | Byte -> false + in + + OASISUnixPath.concat + dir + (cs.cs_name^(suffix_program ())), + + if not is_native_exec && + not exec.exec_custom && + bs.bs_c_sources <> [] then + Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) + else + None + + +end + +module OASISLibrary = struct +(* # 22 "src/oasis/OASISLibrary.ml" *) + + + open OASISTypes + open OASISGettext + + let find_module ~ctxt source_file_exists cs bs modul = + match OASISBuildSection.find_module source_file_exists bs modul with + | `Sources _ as res -> res + | `No_sources _ as res -> + OASISMessage.warning + ~ctxt + (f_ "Cannot find source file matching module '%s' in library %s.") + modul cs.cs_name; + OASISMessage.warning + ~ctxt + (f_ "Use InterfacePatterns or ImplementationPatterns to define \ + this file with feature %S.") + (OASISFeatures.source_patterns.OASISFeatures.name); + res + + let source_unix_files ~ctxt (cs, bs, lib) source_file_exists = + List.fold_left + (fun acc modul -> + match find_module ~ctxt source_file_exists cs bs modul with + | `Sources (base_fn, lst) -> (base_fn, lst) :: acc + | `No_sources _ -> acc) + [] + (lib.lib_modules @ lib.lib_internal_modules) + + + let generated_unix_files + ~ctxt + ~is_native + ~has_native_dynlink + ~ext_lib + ~ext_dll + ~source_file_exists + (cs, bs, lib) = + + let find_modules lst ext = + let find_module modul = + match find_module ~ctxt source_file_exists cs bs modul with + | `Sources (_, [fn]) when ext <> "cmi" + && Filename.check_suffix fn ".mli" -> + None (* No implementation files for pure interface. *) + | `Sources (base_fn, _) -> Some [base_fn] + | `No_sources lst -> Some lst + in + List.fold_left + (fun acc nm -> + match find_module nm with + | None -> acc + | Some base_fns -> + List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc) + [] + lst + in + + (* The .cmx that be compiled along *) + let cmxs = + let should_be_built = + match bs.bs_compiled_object with + | Native -> true + | Best -> is_native + | Byte -> false + in + if should_be_built then + if lib.lib_pack then + find_modules + [cs.cs_name] + "cmx" + else + find_modules + (lib.lib_modules @ lib.lib_internal_modules) + "cmx" + else + [] + in + + let acc_nopath = + [] + in + + (* The headers and annot/cmt files that should be compiled along *) + let headers = + let sufx = + if lib.lib_pack + then [".cmti"; ".cmt"; ".annot"] + else [".cmi"; ".cmti"; ".cmt"; ".annot"] + in + List.map + (List.fold_left + (fun accu s -> + let dot = String.rindex s '.' in + let base = String.sub s 0 dot in + List.map ((^) base) sufx @ accu) + []) + (find_modules lib.lib_modules "cmi") + in + + (* Compute what libraries should be built *) + let acc_nopath = + (* Add the packed header file if required *) + let add_pack_header acc = + if lib.lib_pack then + [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc + else + acc + in + let byte acc = + add_pack_header ([cs.cs_name^".cma"] :: acc) + in + let native acc = + let acc = + add_pack_header + (if has_native_dynlink then + [cs.cs_name^".cmxs"] :: acc + else acc) + in + [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc + in + match bs.bs_compiled_object with + | Native -> byte (native acc_nopath) + | Best when is_native -> byte (native acc_nopath) + | Byte | Best -> byte acc_nopath + in + + (* Add C library to be built *) + let acc_nopath = + if bs.bs_c_sources <> [] then begin + ["lib"^cs.cs_name^"_stubs"^ext_lib] + :: + if has_native_dynlink then + ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath + else + acc_nopath + end else begin + acc_nopath + end + in + + (* All the files generated *) + List.rev_append + (List.rev_map + (List.rev_map + (OASISUnixPath.concat bs.bs_path)) + acc_nopath) + (headers @ cmxs) + + +end + +module OASISObject = struct +(* # 22 "src/oasis/OASISObject.ml" *) + + + open OASISTypes + open OASISGettext + + + let find_module ~ctxt source_file_exists cs bs modul = + match OASISBuildSection.find_module source_file_exists bs modul with + | `Sources _ as res -> res + | `No_sources _ as res -> + OASISMessage.warning + ~ctxt + (f_ "Cannot find source file matching module '%s' in object %s.") + modul cs.cs_name; + OASISMessage.warning + ~ctxt + (f_ "Use InterfacePatterns or ImplementationPatterns to define \ + this file with feature %S.") + (OASISFeatures.source_patterns.OASISFeatures.name); + res + + let source_unix_files ~ctxt (cs, bs, obj) source_file_exists = + List.fold_left + (fun acc modul -> + match find_module ~ctxt source_file_exists cs bs modul with + | `Sources (base_fn, lst) -> (base_fn, lst) :: acc + | `No_sources _ -> acc) + [] + obj.obj_modules + + + let generated_unix_files + ~ctxt + ~is_native + ~source_file_exists + (cs, bs, obj) = + + let find_module ext modul = + match find_module ~ctxt source_file_exists cs bs modul with + | `Sources (base_fn, _) -> [base_fn ^ ext] + | `No_sources lst -> lst + in + + let header, byte, native, c_object, f = + match obj.obj_modules with + | [ m ] -> (find_module ".cmi" m, + find_module ".cmo" m, + find_module ".cmx" m, + find_module ".o" m, + fun x -> x) + | _ -> ([cs.cs_name ^ ".cmi"], + [cs.cs_name ^ ".cmo"], + [cs.cs_name ^ ".cmx"], + [cs.cs_name ^ ".o"], + OASISUnixPath.concat bs.bs_path) + in + List.map (List.map f) ( + match bs.bs_compiled_object with + | Native -> + native :: c_object :: byte :: header :: [] + | Best when is_native -> + native :: c_object :: byte :: header :: [] + | Byte | Best -> + byte :: header :: []) + + +end + +module OASISFindlib = struct +(* # 22 "src/oasis/OASISFindlib.ml" *) + + + open OASISTypes + open OASISUtils + open OASISGettext + + + type library_name = name + type findlib_part_name = name + type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t + + + exception InternalLibraryNotFound of library_name + exception FindlibPackageNotFound of findlib_name + + + type group_t = + | Container of findlib_name * group_t list + | Package of (findlib_name * + common_section * + build_section * + [`Library of library | `Object of object_] * + unix_dirname option * + group_t list) + + + type data = common_section * + build_section * + [`Library of library | `Object of object_] + type tree = + | Node of (data option) * (tree MapString.t) + | Leaf of data + + + let findlib_mapping pkg = + (* Map from library name to either full findlib name or parts + parent. *) + let fndlb_parts_of_lib_name = + let fndlb_parts cs lib = + let name = + match lib.lib_findlib_name with + | Some nm -> nm + | None -> cs.cs_name + in + let name = + String.concat "." (lib.lib_findlib_containers @ [name]) + in + name + in + List.fold_left + (fun mp -> + function + | Library (cs, _, lib) -> + begin + let lib_name = cs.cs_name in + let fndlb_parts = fndlb_parts cs lib in + if MapString.mem lib_name mp then + failwithf + (f_ "The library name '%s' is used more than once.") + lib_name; + match lib.lib_findlib_parent with + | Some lib_name_parent -> + MapString.add + lib_name + (`Unsolved (lib_name_parent, fndlb_parts)) + mp + | None -> + MapString.add + lib_name + (`Solved fndlb_parts) + mp + end + + | Object (cs, _, obj) -> + begin + let obj_name = cs.cs_name in + if MapString.mem obj_name mp then + failwithf + (f_ "The object name '%s' is used more than once.") + obj_name; + let findlib_full_name = match obj.obj_findlib_fullname with + | Some ns -> String.concat "." ns + | None -> obj_name + in + MapString.add + obj_name + (`Solved findlib_full_name) + mp + end + + | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> + mp) + MapString.empty + pkg.sections + in + + (* Solve the above graph to be only library name to full findlib name. *) + let fndlb_name_of_lib_name = + let rec solve visited mp lib_name lib_name_child = + if SetString.mem lib_name visited then + failwithf + (f_ "Library '%s' is involved in a cycle \ + with regard to findlib naming.") + lib_name; + let visited = SetString.add lib_name visited in + try + match MapString.find lib_name mp with + | `Solved fndlb_nm -> + fndlb_nm, mp + | `Unsolved (lib_nm_parent, post_fndlb_nm) -> + let pre_fndlb_nm, mp = + solve visited mp lib_nm_parent lib_name + in + let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in + fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp + with Not_found -> + failwithf + (f_ "Library '%s', which is defined as the findlib parent of \ + library '%s', doesn't exist.") + lib_name lib_name_child + in + let mp = + MapString.fold + (fun lib_name status mp -> + match status with + | `Solved _ -> + (* Solved initialy, no need to go further *) + mp + | `Unsolved _ -> + let _, mp = solve SetString.empty mp lib_name "" in + mp) + fndlb_parts_of_lib_name + fndlb_parts_of_lib_name + in + MapString.map + (function + | `Solved fndlb_nm -> fndlb_nm + | `Unsolved _ -> assert false) + mp + in + + (* Convert an internal library name to a findlib name. *) + let findlib_name_of_library_name lib_nm = + try + MapString.find lib_nm fndlb_name_of_lib_name + with Not_found -> + raise (InternalLibraryNotFound lib_nm) + in + + (* Add a library to the tree. + *) + let add sct mp = + let fndlb_fullname = + let cs, _, _ = sct in + let lib_name = cs.cs_name in + findlib_name_of_library_name lib_name + in + let rec add_children nm_lst (children: tree MapString.t) = + match nm_lst with + | (hd :: tl) -> + begin + let node = + try + add_node tl (MapString.find hd children) + with Not_found -> + (* New node *) + new_node tl + in + MapString.add hd node children + end + | [] -> + (* Should not have a nameless library. *) + assert false + and add_node tl node = + if tl = [] then + begin + match node with + | Node (None, children) -> + Node (Some sct, children) + | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> + (* TODO: allow to merge Package, i.e. + * archive(byte) = "foo.cma foo_init.cmo" + *) + let cs, _, _ = sct in + failwithf + (f_ "Library '%s' and '%s' have the same findlib name '%s'") + cs.cs_name cs'.cs_name fndlb_fullname + end + else + begin + match node with + | Leaf data -> + Node (Some data, add_children tl MapString.empty) + | Node (data_opt, children) -> + Node (data_opt, add_children tl children) + end + and new_node = + function + | [] -> + Leaf sct + | hd :: tl -> + Node (None, MapString.add hd (new_node tl) MapString.empty) + in + add_children (OASISString.nsplit fndlb_fullname '.') mp + in + + let unix_directory dn lib = + let directory = + match lib with + | `Library lib -> lib.lib_findlib_directory + | `Object obj -> obj.obj_findlib_directory + in + match dn, directory with + | None, None -> None + | None, Some dn | Some dn, None -> Some dn + | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2) + in + + let rec group_of_tree dn mp = + MapString.fold + (fun nm node acc -> + let cur = + match node with + | Node (Some (cs, bs, lib), children) -> + let current_dn = unix_directory dn lib in + Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children) + | Node (None, children) -> + Container (nm, group_of_tree dn children) + | Leaf (cs, bs, lib) -> + let current_dn = unix_directory dn lib in + Package (nm, cs, bs, lib, current_dn, []) + in + cur :: acc) + mp [] + in + + let group_mp = + List.fold_left + (fun mp -> + function + | Library (cs, bs, lib) -> + add (cs, bs, `Library lib) mp + | Object (cs, bs, obj) -> + add (cs, bs, `Object obj) mp + | _ -> + mp) + MapString.empty + pkg.sections + in + + let groups = group_of_tree None group_mp in + + let library_name_of_findlib_name = + lazy begin + (* Revert findlib_name_of_library_name. *) + MapString.fold + (fun k v mp -> MapString.add v k mp) + fndlb_name_of_lib_name + MapString.empty + end + in + let library_name_of_findlib_name fndlb_nm = + try + MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) + with Not_found -> + raise (FindlibPackageNotFound fndlb_nm) + in + + groups, + findlib_name_of_library_name, + library_name_of_findlib_name + + + let findlib_of_group = + function + | Container (fndlb_nm, _) + | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm + + + let root_of_group grp = + let rec root_lib_aux = + (* We do a DFS in the group. *) + function + | Container (_, children) -> + List.fold_left + (fun res grp -> + if res = None then + root_lib_aux grp + else + res) + None + children + | Package (_, cs, bs, lib, _, _) -> + Some (cs, bs, lib) + in + match root_lib_aux grp with + | Some res -> + res + | None -> + failwithf + (f_ "Unable to determine root library of findlib library '%s'") + (findlib_of_group grp) + + +end + +module OASISFlag = struct +(* # 22 "src/oasis/OASISFlag.ml" *) + + +end + +module OASISPackage = struct +(* # 22 "src/oasis/OASISPackage.ml" *) + + +end + +module OASISSourceRepository = struct +(* # 22 "src/oasis/OASISSourceRepository.ml" *) + + +end + +module OASISTest = struct +(* # 22 "src/oasis/OASISTest.ml" *) + + +end + +module OASISDocument = struct +(* # 22 "src/oasis/OASISDocument.ml" *) + + +end + +module OASISExec = struct +(* # 22 "src/oasis/OASISExec.ml" *) + + + open OASISGettext + open OASISUtils + open OASISMessage + + + (* TODO: I don't like this quote, it is there because $(rm) foo expands to + * 'rm -f' foo... + *) + let run ~ctxt ?f_exit_code ?(quote=true) cmd args = + let cmd = + if quote then + if Sys.os_type = "Win32" then + if String.contains cmd ' ' then + (* Double the 1st double quote... win32... sigh *) + "\""^(Filename.quote cmd) + else + cmd + else + Filename.quote cmd + else + cmd + in + let cmdline = + String.concat " " (cmd :: args) + in + info ~ctxt (f_ "Running command '%s'") cmdline; + match f_exit_code, Sys.command cmdline with + | None, 0 -> () + | None, i -> + failwithf + (f_ "Command '%s' terminated with error code %d") + cmdline i + | Some f, i -> + f i + + + let run_read_output ~ctxt ?f_exit_code cmd args = + let fn = + Filename.temp_file "oasis-" ".txt" + in + try + begin + let () = + run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn]) + in + let chn = + open_in fn + in + let routput = + ref [] + in + begin + try + while true do + routput := (input_line chn) :: !routput + done + with End_of_file -> + () + end; + close_in chn; + Sys.remove fn; + List.rev !routput + end + with e -> + (try Sys.remove fn with _ -> ()); + raise e + + + let run_read_one_line ~ctxt ?f_exit_code cmd args = + match run_read_output ~ctxt ?f_exit_code cmd args with + | [fst] -> + fst + | lst -> + failwithf + (f_ "Command return unexpected output %S") + (String.concat "\n" lst) +end + +module OASISFileUtil = struct +(* # 22 "src/oasis/OASISFileUtil.ml" *) + + + open OASISGettext + + + let file_exists_case fn = + let dirname = Filename.dirname fn in + let basename = Filename.basename fn in + if Sys.file_exists dirname then + if basename = Filename.current_dir_name then + true + else + List.mem + basename + (Array.to_list (Sys.readdir dirname)) + else + false + + + let find_file ?(case_sensitive=true) paths exts = + + (* Cardinal product of two list *) + let ( * ) lst1 lst2 = + List.flatten + (List.map + (fun a -> + List.map + (fun b -> a, b) + lst2) + lst1) + in + + let rec combined_paths lst = + match lst with + | p1 :: p2 :: tl -> + let acc = + (List.map + (fun (a, b) -> Filename.concat a b) + (p1 * p2)) + in + combined_paths (acc :: tl) + | [e] -> + e + | [] -> + [] + in + + let alternatives = + List.map + (fun (p, e) -> + if String.length e > 0 && e.[0] <> '.' then + p ^ "." ^ e + else + p ^ e) + ((combined_paths paths) * exts) + in + List.find (fun file -> + (if case_sensitive then + file_exists_case file + else + Sys.file_exists file) + && not (Sys.is_directory file) + ) alternatives + + + let which ~ctxt prg = + let path_sep = + match Sys.os_type with + | "Win32" -> + ';' + | _ -> + ':' + in + let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in + let exec_ext = + match Sys.os_type with + | "Win32" -> + "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep) + | _ -> + [""] + in + find_file ~case_sensitive:false [path_lst; [prg]] exec_ext + + + (**/**) + let rec fix_dir dn = + (* Windows hack because Sys.file_exists "src\\" = false when + * Sys.file_exists "src" = true + *) + let ln = + String.length dn + in + if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then + fix_dir (String.sub dn 0 (ln - 1)) + else + dn + + + let q = Filename.quote + (**/**) + + + let cp ~ctxt ?(recurse=false) src tgt = + if recurse then + match Sys.os_type with + | "Win32" -> + OASISExec.run ~ctxt + "xcopy" [q src; q tgt; "/E"] + | _ -> + OASISExec.run ~ctxt + "cp" ["-r"; q src; q tgt] + else + OASISExec.run ~ctxt + (match Sys.os_type with + | "Win32" -> "copy" + | _ -> "cp") + [q src; q tgt] + + + let mkdir ~ctxt tgt = + OASISExec.run ~ctxt + (match Sys.os_type with + | "Win32" -> "md" + | _ -> "mkdir") + [q tgt] + + + let rec mkdir_parent ~ctxt f tgt = + let tgt = + fix_dir tgt + in + if Sys.file_exists tgt then + begin + if not (Sys.is_directory tgt) then + OASISUtils.failwithf + (f_ "Cannot create directory '%s', a file of the same name already \ + exists") + tgt + end + else + begin + mkdir_parent ~ctxt f (Filename.dirname tgt); + if not (Sys.file_exists tgt) then + begin + f tgt; + mkdir ~ctxt tgt + end + end + + + let rmdir ~ctxt tgt = + if Sys.readdir tgt = [||] then begin + match Sys.os_type with + | "Win32" -> + OASISExec.run ~ctxt "rd" [q tgt] + | _ -> + OASISExec.run ~ctxt "rm" ["-r"; q tgt] + end else begin + OASISMessage.error ~ctxt + (f_ "Cannot remove directory '%s': not empty.") + tgt + end + + + let glob ~ctxt fn = + let basename = + Filename.basename fn + in + if String.length basename >= 2 && + basename.[0] = '*' && + basename.[1] = '.' then + begin + let ext_len = + (String.length basename) - 2 + in + let ext = + String.sub basename 2 ext_len + in + let dirname = + Filename.dirname fn + in + Array.fold_left + (fun acc fn -> + try + let fn_ext = + String.sub + fn + ((String.length fn) - ext_len) + ext_len + in + if fn_ext = ext then + (Filename.concat dirname fn) :: acc + else + acc + with Invalid_argument _ -> + acc) + [] + (Sys.readdir dirname) + end + else + begin + if file_exists_case fn then + [fn] + else + [] + end +end + + +# 3159 "setup.ml" +module BaseEnvLight = struct +(* # 22 "src/base/BaseEnvLight.ml" *) + + + module MapString = Map.Make(String) + + + type t = string MapString.t + + + let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" + + + let load ?(allow_empty=false) ?(filename=default_filename) ?stream () = + let line = ref 1 in + let lexer st = + let st_line = + Stream.from + (fun _ -> + try + match Stream.next st with + | '\n' -> incr line; Some '\n' + | c -> Some c + with Stream.Failure -> None) + in + Genlex.make_lexer ["="] st_line + in + let rec read_file lxr mp = + match Stream.npeek 3 lxr with + | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> + Stream.junk lxr; Stream.junk lxr; Stream.junk lxr; + read_file lxr (MapString.add nm value mp) + | [] -> mp + | _ -> + failwith + (Printf.sprintf "Malformed data file '%s' line %d" filename !line) + in + match stream with + | Some st -> read_file (lexer st) MapString.empty + | None -> + if Sys.file_exists filename then begin + let chn = open_in_bin filename in + let st = Stream.of_channel chn in + try + let mp = read_file (lexer st) MapString.empty in + close_in chn; mp + with e -> + close_in chn; raise e + end else if allow_empty then begin + MapString.empty + end else begin + failwith + (Printf.sprintf + "Unable to load environment, the file '%s' doesn't exist." + filename) + end + + let rec var_expand str env = + let buff = Buffer.create ((String.length str) * 2) in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) env + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + + + let var_get name env = var_expand (MapString.find name env) env + let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst +end + + +# 3239 "setup.ml" +module BaseContext = struct +(* # 22 "src/base/BaseContext.ml" *) + + (* TODO: get rid of this module. *) + open OASISContext + + + let args () = fst (fspecs ()) + + + let default = default + +end + +module BaseMessage = struct +(* # 22 "src/base/BaseMessage.ml" *) + + + (** Message to user, overrid for Base + @author Sylvain Le Gall + *) + open OASISMessage + open BaseContext + + + let debug fmt = debug ~ctxt:!default fmt + + + let info fmt = info ~ctxt:!default fmt + + + let warning fmt = warning ~ctxt:!default fmt + + + let error fmt = error ~ctxt:!default fmt + +end + +module BaseEnv = struct +(* # 22 "src/base/BaseEnv.ml" *) + + open OASISGettext + open OASISUtils + open OASISContext + open PropList + + + module MapString = BaseEnvLight.MapString + + + type origin_t = + | ODefault + | OGetEnv + | OFileLoad + | OCommandLine + + + type cli_handle_t = + | CLINone + | CLIAuto + | CLIWith + | CLIEnable + | CLIUser of (Arg.key * Arg.spec * Arg.doc) list + + + type definition_t = + { + hide: bool; + dump: bool; + cli: cli_handle_t; + arg_help: string option; + group: string option; + } + + + let schema = Schema.create "environment" + + + (* Environment data *) + let env = Data.create () + + + (* Environment data from file *) + let env_from_file = ref MapString.empty + + + (* Lexer for var *) + let var_lxr = Genlex.make_lexer [] + + + let rec var_expand str = + let buff = + Buffer.create ((String.length str) * 2) + in + Buffer.add_substitute + buff + (fun var -> + try + (* TODO: this is a quick hack to allow calling Test.Command + * without defining executable name really. I.e. if there is + * an exec Executable toto, then $(toto) should be replace + * by its real name. It is however useful to have this function + * for other variable that depend on the host and should be + * written better than that. + *) + let st = + var_lxr (Stream.of_string var) + in + match Stream.npeek 3 st with + | [Genlex.Ident "utoh"; Genlex.Ident nm] -> + OASISHostPath.of_unix (var_get nm) + | [Genlex.Ident "utoh"; Genlex.String s] -> + OASISHostPath.of_unix s + | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] -> + String.escaped (var_get nm) + | [Genlex.Ident "ocaml_escaped"; Genlex.String s] -> + String.escaped s + | [Genlex.Ident nm] -> + var_get nm + | _ -> + failwithf + (f_ "Unknown expression '%s' in variable expansion of %s.") + var + str + with + | Unknown_field (_, _) -> + failwithf + (f_ "No variable %s defined when trying to expand %S.") + var + str + | Stream.Error e -> + failwithf + (f_ "Syntax error when parsing '%s' when trying to \ + expand %S: %s") + var + str + e) + str; + Buffer.contents buff + + + and var_get name = + let vl = + try + Schema.get schema env name + with Unknown_field _ as e -> + begin + try + MapString.find name !env_from_file + with Not_found -> + raise e + end + in + var_expand vl + + + let var_choose ?printer ?name lst = + OASISExpr.choose + ?printer + ?name + var_get + lst + + + let var_protect vl = + let buff = + Buffer.create (String.length vl) + in + String.iter + (function + | '$' -> Buffer.add_string buff "\\$" + | c -> Buffer.add_char buff c) + vl; + Buffer.contents buff + + + let var_define + ?(hide=false) + ?(dump=true) + ?short_desc + ?(cli=CLINone) + ?arg_help + ?group + name (* TODO: type constraint on the fact that name must be a valid OCaml + id *) + dflt = + + let default = + [ + OFileLoad, (fun () -> MapString.find name !env_from_file); + ODefault, dflt; + OGetEnv, (fun () -> Sys.getenv name); + ] + in + + let extra = + { + hide = hide; + dump = dump; + cli = cli; + arg_help = arg_help; + group = group; + } + in + + (* Try to find a value that can be defined + *) + let var_get_low lst = + let errors, res = + List.fold_left + (fun (errors, res) (_, v) -> + if res = None then + begin + try + errors, Some (v ()) + with + | Not_found -> + errors, res + | Failure rsn -> + (rsn :: errors), res + | e -> + (Printexc.to_string e) :: errors, res + end + else + errors, res) + ([], None) + (List.sort + (fun (o1, _) (o2, _) -> + Pervasives.compare o2 o1) + lst) + in + match res, errors with + | Some v, _ -> + v + | None, [] -> + raise (Not_set (name, None)) + | None, lst -> + raise (Not_set (name, Some (String.concat (s_ ", ") lst))) + in + + let help = + match short_desc with + | Some fs -> Some fs + | None -> None + in + + let var_get_lst = + FieldRO.create + ~schema + ~name + ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s]) + ~print:var_get_low + ~default + ~update:(fun ?context:_ x old_x -> x @ old_x) + ?help + extra + in + + fun () -> + var_expand (var_get_low (var_get_lst env)) + + + let var_redefine + ?hide + ?dump + ?short_desc + ?cli + ?arg_help + ?group + name + dflt = + if Schema.mem schema name then + begin + (* TODO: look suspsicious, we want to memorize dflt not dflt () *) + Schema.set schema env ~context:ODefault name (dflt ()); + fun () -> var_get name + end + else + begin + var_define + ?hide + ?dump + ?short_desc + ?cli + ?arg_help + ?group + name + dflt + end + + + let var_ignore (_: unit -> string) = () + + + let print_hidden = + var_define + ~hide:true + ~dump:false + ~cli:CLIAuto + ~arg_help:"Print even non-printable variable. (debug)" + "print_hidden" + (fun () -> "false") + + + let var_all () = + List.rev + (Schema.fold + (fun acc nm def _ -> + if not def.hide || bool_of_string (print_hidden ()) then + nm :: acc + else + acc) + [] + schema) + + + let default_filename = in_srcdir "setup.data" + + + let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () = + let open OASISFileSystem in + env_from_file := + let repr_filename = ctxt.srcfs#string_of_filename filename in + if ctxt.srcfs#file_exists filename then begin + let buf = Buffer.create 13 in + defer_close + (ctxt.srcfs#open_in ~mode:binary_in filename) + (read_all buf); + defer_close + (ctxt.srcfs#open_in ~mode:binary_in filename) + (fun rdr -> + OASISMessage.info ~ctxt "Loading environment from %S." repr_filename; + BaseEnvLight.load ~allow_empty + ~filename:(repr_filename) + ~stream:(stream_of_reader rdr) + ()) + end else if allow_empty then begin + BaseEnvLight.MapString.empty + end else begin + failwith + (Printf.sprintf + (f_ "Unable to load environment, the file '%s' doesn't exist.") + repr_filename) + end + + + let unload () = + env_from_file := MapString.empty; + Data.clear env + + + let dump ~ctxt ?(filename=default_filename) () = + let open OASISFileSystem in + defer_close + (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename) + (fun wrtr -> + let buf = Buffer.create 63 in + let output nm value = + Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value) + in + let mp_todo = + (* Dump data from schema *) + Schema.fold + (fun mp_todo nm def _ -> + if def.dump then begin + try + output nm (Schema.get schema env nm) + with Not_set _ -> + () + end; + MapString.remove nm mp_todo) + !env_from_file + schema + in + (* Dump data defined outside of schema *) + MapString.iter output mp_todo; + wrtr#output buf) + + let print () = + let printable_vars = + Schema.fold + (fun acc nm def short_descr_opt -> + if not def.hide || bool_of_string (print_hidden ()) then + begin + try + let value = Schema.get schema env nm in + let txt = + match short_descr_opt with + | Some s -> s () + | None -> nm + in + (txt, value) :: acc + with Not_set _ -> + acc + end + else + acc) + [] + schema + in + let max_length = + List.fold_left max 0 + (List.rev_map String.length + (List.rev_map fst printable_vars)) + in + let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in + Printf.printf "\nConfiguration:\n"; + List.iter + (fun (name, value) -> + Printf.printf "%s: %s" name (dot_pad name); + if value = "" then + Printf.printf "\n" + else + Printf.printf " %s\n" value) + (List.rev printable_vars); + Printf.printf "\n%!" + + + let args () = + let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in + [ + "--override", + Arg.Tuple + ( + let rvr = ref "" + in + let rvl = ref "" + in + [ + Arg.Set_string rvr; + Arg.Set_string rvl; + Arg.Unit + (fun () -> + Schema.set + schema + env + ~context:OCommandLine + !rvr + !rvl) + ] + ), + "var+val Override any configuration variable."; + + ] + @ + List.flatten + (Schema.fold + (fun acc name def short_descr_opt -> + let var_set s = + Schema.set + schema + env + ~context:OCommandLine + name + s + in + + let arg_name = + OASISUtils.varname_of_string ~hyphen:'-' name + in + + let hlp = + match short_descr_opt with + | Some txt -> txt () + | None -> "" + in + + let arg_hlp = + match def.arg_help with + | Some s -> s + | None -> "str" + in + + let default_value = + try + Printf.sprintf + (f_ " [%s]") + (Schema.get + schema + env + name) + with Not_set _ -> + "" + in + + let args = + match def.cli with + | CLINone -> + [] + | CLIAuto -> + [ + arg_concat "--" arg_name, + Arg.String var_set, + Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value + ] + | CLIWith -> + [ + arg_concat "--with-" arg_name, + Arg.String var_set, + Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value + ] + | CLIEnable -> + let dflt = + if default_value = " [true]" then + s_ " [default: enabled]" + else + s_ " [default: disabled]" + in + [ + arg_concat "--enable-" arg_name, + Arg.Unit (fun () -> var_set "true"), + Printf.sprintf (f_ " %s%s") hlp dflt; + + arg_concat "--disable-" arg_name, + Arg.Unit (fun () -> var_set "false"), + Printf.sprintf (f_ " %s%s") hlp dflt + ] + | CLIUser lst -> + lst + in + args :: acc) + [] + schema) +end + +module BaseArgExt = struct +(* # 22 "src/base/BaseArgExt.ml" *) + + + open OASISUtils + open OASISGettext + + + let parse argv args = + (* Simulate command line for Arg *) + let current = + ref 0 + in + + try + Arg.parse_argv + ~current:current + (Array.concat [[|"none"|]; argv]) + (Arg.align args) + (failwithf (f_ "Don't know what to do with arguments: '%s'")) + (s_ "configure options:") + with + | Arg.Help txt -> + print_endline txt; + exit 0 + | Arg.Bad txt -> + prerr_endline txt; + exit 1 +end + +module BaseCheck = struct +(* # 22 "src/base/BaseCheck.ml" *) + + + open BaseEnv + open BaseMessage + open OASISUtils + open OASISGettext + + + let prog_best prg prg_lst = + var_redefine + prg + (fun () -> + let alternate = + List.fold_left + (fun res e -> + match res with + | Some _ -> + res + | None -> + try + Some (OASISFileUtil.which ~ctxt:!BaseContext.default e) + with Not_found -> + None) + None + prg_lst + in + match alternate with + | Some prg -> prg + | None -> raise Not_found) + + + let prog prg = + prog_best prg [prg] + + + let prog_opt prg = + prog_best prg [prg^".opt"; prg] + + + let ocamlfind = + prog "ocamlfind" + + + let version + var_prefix + cmp + fversion + () = + (* Really compare version provided *) + let var = + var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) + in + var_redefine + ~hide:true + var + (fun () -> + let version_str = + match fversion () with + | "[Distributed with OCaml]" -> + begin + try + (var_get "ocaml_version") + with Not_found -> + warning + (f_ "Variable ocaml_version not defined, fallback \ + to default"); + Sys.ocaml_version + end + | res -> + res + in + let version = + OASISVersion.version_of_string version_str + in + if OASISVersion.comparator_apply version cmp then + version_str + else + failwithf + (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") + var_prefix + (OASISVersion.string_of_comparator cmp) + version_str) + () + + + let package_version pkg = + OASISExec.run_read_one_line ~ctxt:!BaseContext.default + (ocamlfind ()) + ["query"; "-format"; "%v"; pkg] + + + let package ?version_comparator pkg () = + let var = + OASISUtils.varname_concat + "pkg_" + (OASISUtils.varname_of_string pkg) + in + let findlib_dir pkg = + let dir = + OASISExec.run_read_one_line ~ctxt:!BaseContext.default + (ocamlfind ()) + ["query"; "-format"; "%d"; pkg] + in + if Sys.file_exists dir && Sys.is_directory dir then + dir + else + failwithf + (f_ "When looking for findlib package %s, \ + directory %s return doesn't exist") + pkg dir + in + let vl = + var_redefine + var + (fun () -> findlib_dir pkg) + () + in + ( + match version_comparator with + | Some ver_cmp -> + ignore + (version + var + ver_cmp + (fun _ -> package_version pkg) + ()) + | None -> + () + ); + vl +end + +module BaseOCamlcConfig = struct +(* # 22 "src/base/BaseOCamlcConfig.ml" *) + + + open BaseEnv + open OASISUtils + open OASISGettext + + + module SMap = Map.Make(String) + + + let ocamlc = + BaseCheck.prog_opt "ocamlc" + + + let ocamlc_config_map = + (* Map name to value for ocamlc -config output + (name ^": "^value) + *) + let rec split_field mp lst = + match lst with + | line :: tl -> + let mp = + try + let pos_semicolon = + String.index line ':' + in + if pos_semicolon > 1 then + ( + let name = + String.sub line 0 pos_semicolon + in + let linelen = + String.length line + in + let value = + if linelen > pos_semicolon + 2 then + String.sub + line + (pos_semicolon + 2) + (linelen - pos_semicolon - 2) + else + "" + in + SMap.add name value mp + ) + else + ( + mp + ) + with Not_found -> + ( + mp + ) + in + split_field mp tl + | [] -> + mp + in + + let cache = + lazy + (var_protect + (Marshal.to_string + (split_field + SMap.empty + (OASISExec.run_read_output + ~ctxt:!BaseContext.default + (ocamlc ()) ["-config"])) + [])) + in + var_redefine + "ocamlc_config_map" + ~hide:true + ~dump:false + (fun () -> + (* TODO: update if ocamlc change !!! *) + Lazy.force cache) + + + let var_define nm = + (* Extract data from ocamlc -config *) + let avlbl_config_get () = + Marshal.from_string + (ocamlc_config_map ()) + 0 + in + let chop_version_suffix s = + try + String.sub s 0 (String.index s '+') + with _ -> + s + in + + let nm_config, value_config = + match nm with + | "ocaml_version" -> + "version", chop_version_suffix + | _ -> nm, (fun x -> x) + in + var_redefine + nm + (fun () -> + try + let map = + avlbl_config_get () + in + let value = + SMap.find nm_config map + in + value_config value + with Not_found -> + failwithf + (f_ "Cannot find field '%s' in '%s -config' output") + nm + (ocamlc ())) + +end + +module BaseStandardVar = struct +(* # 22 "src/base/BaseStandardVar.ml" *) + + + open OASISGettext + open OASISTypes + open BaseCheck + open BaseEnv + + + let ocamlfind = BaseCheck.ocamlfind + let ocamlc = BaseOCamlcConfig.ocamlc + let ocamlopt = prog_opt "ocamlopt" + let ocamlbuild = prog "ocamlbuild" + + + (**/**) + let rpkg = + ref None + + + let pkg_get () = + match !rpkg with + | Some pkg -> pkg + | None -> failwith (s_ "OASIS Package is not set") + + + let var_cond = ref [] + + + let var_define_cond ~since_version f dflt = + let holder = ref (fun () -> dflt) in + let since_version = + OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version) + in + var_cond := + (fun ver -> + if OASISVersion.comparator_apply ver since_version then + holder := f ()) :: !var_cond; + fun () -> !holder () + + + (**/**) + + + let pkg_name = + var_define + ~short_desc:(fun () -> s_ "Package name") + "pkg_name" + (fun () -> (pkg_get ()).name) + + + let pkg_version = + var_define + ~short_desc:(fun () -> s_ "Package version") + "pkg_version" + (fun () -> + (OASISVersion.string_of_version (pkg_get ()).version)) + + + let c = BaseOCamlcConfig.var_define + + + let os_type = c "os_type" + let system = c "system" + let architecture = c "architecture" + let ccomp_type = c "ccomp_type" + let ocaml_version = c "ocaml_version" + + + (* TODO: Check standard variable presence at runtime *) + + + let standard_library_default = c "standard_library_default" + let standard_library = c "standard_library" + let standard_runtime = c "standard_runtime" + let bytecomp_c_compiler = c "bytecomp_c_compiler" + let native_c_compiler = c "native_c_compiler" + let model = c "model" + let ext_obj = c "ext_obj" + let ext_asm = c "ext_asm" + let ext_lib = c "ext_lib" + let ext_dll = c "ext_dll" + let default_executable_name = c "default_executable_name" + let systhread_supported = c "systhread_supported" + + + let flexlink = + BaseCheck.prog "flexlink" + + + let flexdll_version = + var_define + ~short_desc:(fun () -> "FlexDLL version (Win32)") + "flexdll_version" + (fun () -> + let lst = + OASISExec.run_read_output ~ctxt:!BaseContext.default + (flexlink ()) ["-help"] + in + match lst with + | line :: _ -> + Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver) + | [] -> + raise Not_found) + + + (**/**) + let p name hlp dflt = + var_define + ~short_desc:hlp + ~cli:CLIAuto + ~arg_help:"dir" + name + dflt + + + let (/) a b = + if os_type () = Sys.os_type then + Filename.concat a b + else if os_type () = "Unix" || os_type () = "Cygwin" then + OASISUnixPath.concat a b + else + OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat") + (os_type ()) + (**/**) + + + let prefix = + p "prefix" + (fun () -> s_ "Install architecture-independent files dir") + (fun () -> + match os_type () with + | "Win32" -> + let program_files = + Sys.getenv "PROGRAMFILES" + in + program_files/(pkg_name ()) + | _ -> + "/usr/local") + + + let exec_prefix = + p "exec_prefix" + (fun () -> s_ "Install architecture-dependent files in dir") + (fun () -> "$prefix") + + + let bindir = + p "bindir" + (fun () -> s_ "User executables") + (fun () -> "$exec_prefix"/"bin") + + + let sbindir = + p "sbindir" + (fun () -> s_ "System admin executables") + (fun () -> "$exec_prefix"/"sbin") + + + let libexecdir = + p "libexecdir" + (fun () -> s_ "Program executables") + (fun () -> "$exec_prefix"/"libexec") + + + let sysconfdir = + p "sysconfdir" + (fun () -> s_ "Read-only single-machine data") + (fun () -> "$prefix"/"etc") + + + let sharedstatedir = + p "sharedstatedir" + (fun () -> s_ "Modifiable architecture-independent data") + (fun () -> "$prefix"/"com") + + + let localstatedir = + p "localstatedir" + (fun () -> s_ "Modifiable single-machine data") + (fun () -> "$prefix"/"var") + + + let libdir = + p "libdir" + (fun () -> s_ "Object code libraries") + (fun () -> "$exec_prefix"/"lib") + + + let datarootdir = + p "datarootdir" + (fun () -> s_ "Read-only arch-independent data root") + (fun () -> "$prefix"/"share") + + + let datadir = + p "datadir" + (fun () -> s_ "Read-only architecture-independent data") + (fun () -> "$datarootdir") + + + let infodir = + p "infodir" + (fun () -> s_ "Info documentation") + (fun () -> "$datarootdir"/"info") + + + let localedir = + p "localedir" + (fun () -> s_ "Locale-dependent data") + (fun () -> "$datarootdir"/"locale") + + + let mandir = + p "mandir" + (fun () -> s_ "Man documentation") + (fun () -> "$datarootdir"/"man") + + + let docdir = + p "docdir" + (fun () -> s_ "Documentation root") + (fun () -> "$datarootdir"/"doc"/"$pkg_name") + + + let htmldir = + p "htmldir" + (fun () -> s_ "HTML documentation") + (fun () -> "$docdir") + + + let dvidir = + p "dvidir" + (fun () -> s_ "DVI documentation") + (fun () -> "$docdir") + + + let pdfdir = + p "pdfdir" + (fun () -> s_ "PDF documentation") + (fun () -> "$docdir") + + + let psdir = + p "psdir" + (fun () -> s_ "PS documentation") + (fun () -> "$docdir") + + + let destdir = + p "destdir" + (fun () -> s_ "Prepend a path when installing package") + (fun () -> + raise + (PropList.Not_set + ("destdir", + Some (s_ "undefined by construct")))) + + + let findlib_version = + var_define + "findlib_version" + (fun () -> + BaseCheck.package_version "findlib") + + + let is_native = + var_define + "is_native" + (fun () -> + try + let _s: string = + ocamlopt () + in + "true" + with PropList.Not_set _ -> + let _s: string = + ocamlc () + in + "false") + + + let ext_program = + var_define + "suffix_program" + (fun () -> + match os_type () with + | "Win32" | "Cygwin" -> ".exe" + | _ -> "") + + + let rm = + var_define + ~short_desc:(fun () -> s_ "Remove a file.") + "rm" + (fun () -> + match os_type () with + | "Win32" -> "del" + | _ -> "rm -f") + + + let rmdir = + var_define + ~short_desc:(fun () -> s_ "Remove a directory.") + "rmdir" + (fun () -> + match os_type () with + | "Win32" -> "rd" + | _ -> "rm -rf") + + + let debug = + var_define + ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") + ~cli:CLIEnable + "debug" + (fun () -> "true") + + + let profile = + var_define + ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") + ~cli:CLIEnable + "profile" + (fun () -> "false") + + + let tests = + var_define_cond ~since_version:"0.3" + (fun () -> + var_define + ~short_desc:(fun () -> + s_ "Compile tests executable and library and run them") + ~cli:CLIEnable + "tests" + (fun () -> "false")) + "true" + + + let docs = + var_define_cond ~since_version:"0.3" + (fun () -> + var_define + ~short_desc:(fun () -> s_ "Create documentations") + ~cli:CLIEnable + "docs" + (fun () -> "true")) + "true" + + + let native_dynlink = + var_define + ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") + ~cli:CLINone + "native_dynlink" + (fun () -> + let res = + let ocaml_lt_312 () = + OASISVersion.comparator_apply + (OASISVersion.version_of_string (ocaml_version ())) + (OASISVersion.VLesser + (OASISVersion.version_of_string "3.12.0")) + in + let flexdll_lt_030 () = + OASISVersion.comparator_apply + (OASISVersion.version_of_string (flexdll_version ())) + (OASISVersion.VLesser + (OASISVersion.version_of_string "0.30")) + in + let has_native_dynlink = + let ocamlfind = ocamlfind () in + try + let fn = + OASISExec.run_read_one_line + ~ctxt:!BaseContext.default + ocamlfind + ["query"; "-predicates"; "native"; "dynlink"; + "-format"; "%d/%a"] + in + Sys.file_exists fn + with _ -> + false + in + if not has_native_dynlink then + false + else if ocaml_lt_312 () then + false + else if (os_type () = "Win32" || os_type () = "Cygwin") + && flexdll_lt_030 () then + begin + BaseMessage.warning + (f_ ".cmxs generation disabled because FlexDLL needs to be \ + at least 0.30. Please upgrade FlexDLL from %s to 0.30.") + (flexdll_version ()); + false + end + else + true + in + string_of_bool res) + + + let init pkg = + rpkg := Some pkg; + List.iter (fun f -> f pkg.oasis_version) !var_cond + +end + +module BaseFileAB = struct +(* # 22 "src/base/BaseFileAB.ml" *) + + + open BaseEnv + open OASISGettext + open BaseMessage + open OASISContext + + + let to_filename fn = + if not (Filename.check_suffix fn ".ab") then + warning (f_ "File '%s' doesn't have '.ab' extension") fn; + OASISFileSystem.of_unix_filename (Filename.chop_extension fn) + + + let replace ~ctxt fn_lst = + let open OASISFileSystem in + let ibuf, obuf = Buffer.create 13, Buffer.create 13 in + List.iter + (fun fn -> + Buffer.clear ibuf; Buffer.clear obuf; + defer_close + (ctxt.srcfs#open_in (of_unix_filename fn)) + (read_all ibuf); + Buffer.add_string obuf (var_expand (Buffer.contents ibuf)); + defer_close + (ctxt.srcfs#open_out (to_filename fn)) + (fun wrtr -> wrtr#output obuf)) + fn_lst +end + +module BaseLog = struct +(* # 22 "src/base/BaseLog.ml" *) + + + open OASISUtils + open OASISContext + open OASISGettext + open OASISFileSystem + + + let default_filename = in_srcdir "setup.log" + + + let load ~ctxt () = + let module SetTupleString = + Set.Make + (struct + type t = string * string + let compare (s11, s12) (s21, s22) = + match String.compare s11 s21 with + | 0 -> String.compare s12 s22 + | n -> n + end) + in + if ctxt.srcfs#file_exists default_filename then begin + defer_close + (ctxt.srcfs#open_in default_filename) + (fun rdr -> + let line = ref 1 in + let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in + let rec read_aux (st, lst) = + match Stream.npeek 2 lxr with + | [Genlex.String e; Genlex.String d] -> + let t = e, d in + Stream.junk lxr; Stream.junk lxr; + if SetTupleString.mem t st then + read_aux (st, lst) + else + read_aux (SetTupleString.add t st, t :: lst) + | [] -> List.rev lst + | _ -> + failwithf + (f_ "Malformed log file '%s' at line %d") + (ctxt.srcfs#string_of_filename default_filename) + !line + in + read_aux (SetTupleString.empty, [])) + end else begin + [] + end + + + let register ~ctxt event data = + defer_close + (ctxt.srcfs#open_out + ~mode:[Open_append; Open_creat; Open_text] + ~perm:0o644 + default_filename) + (fun wrtr -> + let buf = Buffer.create 13 in + Printf.bprintf buf "%S %S\n" event data; + wrtr#output buf) + + + let unregister ~ctxt event data = + let lst = load ~ctxt () in + let buf = Buffer.create 13 in + List.iter + (fun (e, d) -> + if e <> event || d <> data then + Printf.bprintf buf "%S %S\n" e d) + lst; + if Buffer.length buf > 0 then + defer_close + (ctxt.srcfs#open_out default_filename) + (fun wrtr -> wrtr#output buf) + else + ctxt.srcfs#remove default_filename + + + let filter ~ctxt events = + let st_events = SetString.of_list events in + List.filter + (fun (e, _) -> SetString.mem e st_events) + (load ~ctxt ()) + + + let exists ~ctxt event data = + List.exists + (fun v -> (event, data) = v) + (load ~ctxt ()) +end + +module BaseBuilt = struct +(* # 22 "src/base/BaseBuilt.ml" *) + + + open OASISTypes + open OASISGettext + open BaseStandardVar + open BaseMessage + + + type t = + | BExec (* Executable *) + | BExecLib (* Library coming with executable *) + | BLib (* Library *) + | BObj (* Library *) + | BDoc (* Document *) + + + let to_log_event_file t nm = + "built_"^ + (match t with + | BExec -> "exec" + | BExecLib -> "exec_lib" + | BLib -> "lib" + | BObj -> "obj" + | BDoc -> "doc")^ + "_"^nm + + + let to_log_event_done t nm = + "is_"^(to_log_event_file t nm) + + + let register ~ctxt t nm lst = + BaseLog.register ~ctxt (to_log_event_done t nm) "true"; + List.iter + (fun alt -> + let registered = + List.fold_left + (fun registered fn -> + if OASISFileUtil.file_exists_case fn then begin + BaseLog.register ~ctxt + (to_log_event_file t nm) + (if Filename.is_relative fn then + Filename.concat (Sys.getcwd ()) fn + else + fn); + true + end else begin + registered + end) + false + alt + in + if not registered then + warning + (f_ "Cannot find an existing alternative files among: %s") + (String.concat (s_ ", ") alt)) + lst + + + let unregister ~ctxt t nm = + List.iter + (fun (e, d) -> BaseLog.unregister ~ctxt e d) + (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm]) + + + let fold ~ctxt t nm f acc = + List.fold_left + (fun acc (_, fn) -> + if OASISFileUtil.file_exists_case fn then begin + f acc fn + end else begin + warning + (f_ "File '%s' has been marked as built \ + for %s but doesn't exist") + fn + (Printf.sprintf + (match t with + | BExec | BExecLib -> (f_ "executable %s") + | BLib -> (f_ "library %s") + | BObj -> (f_ "object %s") + | BDoc -> (f_ "documentation %s")) + nm); + acc + end) + acc + (BaseLog.filter ~ctxt [to_log_event_file t nm]) + + + let is_built ~ctxt t nm = + List.fold_left + (fun _ (_, d) -> try bool_of_string d with _ -> false) + false + (BaseLog.filter ~ctxt [to_log_event_done t nm]) + + + let of_executable ffn (cs, bs, exec) = + let unix_exec_is, unix_dll_opt = + OASISExecutable.unix_exec_is + (cs, bs, exec) + (fun () -> + bool_of_string + (is_native ())) + ext_dll + ext_program + in + let evs = + (BExec, cs.cs_name, [[ffn unix_exec_is]]) + :: + (match unix_dll_opt with + | Some fn -> + [BExecLib, cs.cs_name, [[ffn fn]]] + | None -> + []) + in + evs, + unix_exec_is, + unix_dll_opt + + + let of_library ffn (cs, bs, lib) = + let unix_lst = + OASISLibrary.generated_unix_files + ~ctxt:!BaseContext.default + ~source_file_exists:(fun fn -> + OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) + ~is_native:(bool_of_string (is_native ())) + ~has_native_dynlink:(bool_of_string (native_dynlink ())) + ~ext_lib:(ext_lib ()) + ~ext_dll:(ext_dll ()) + (cs, bs, lib) + in + let evs = + [BLib, + cs.cs_name, + List.map (List.map ffn) unix_lst] + in + evs, unix_lst + + + let of_object ffn (cs, bs, obj) = + let unix_lst = + OASISObject.generated_unix_files + ~ctxt:!BaseContext.default + ~source_file_exists:(fun fn -> + OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) + ~is_native:(bool_of_string (is_native ())) + (cs, bs, obj) + in + let evs = + [BObj, + cs.cs_name, + List.map (List.map ffn) unix_lst] + in + evs, unix_lst + +end + +module BaseCustom = struct +(* # 22 "src/base/BaseCustom.ml" *) + + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + + + let run cmd args extra_args = + OASISExec.run ~ctxt:!BaseContext.default ~quote:false + (var_expand cmd) + (List.map + var_expand + (args @ (Array.to_list extra_args))) + + + let hook ?(failsafe=false) cstm f e = + let optional_command lst = + let printer = + function + | Some (cmd, args) -> String.concat " " (cmd :: args) + | None -> s_ "No command" + in + match + var_choose + ~name:(s_ "Pre/Post Command") + ~printer + lst with + | Some (cmd, args) -> + begin + try + run cmd args [||] + with e when failsafe -> + warning + (f_ "Command '%s' fail with error: %s") + (String.concat " " (cmd :: args)) + (match e with + | Failure msg -> msg + | e -> Printexc.to_string e) + end + | None -> + () + in + let res = + optional_command cstm.pre_command; + f e + in + optional_command cstm.post_command; + res +end + +module BaseDynVar = struct +(* # 22 "src/base/BaseDynVar.ml" *) + + + open OASISTypes + open OASISGettext + open BaseEnv + open BaseBuilt + + + let init ~ctxt pkg = + (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) + (* TODO: provide compile option for library libary_byte_args_VARNAME... *) + List.iter + (function + | Executable (cs, bs, _) -> + if var_choose bs.bs_build then + var_ignore + (var_redefine + (* We don't save this variable *) + ~dump:false + ~short_desc:(fun () -> + Printf.sprintf + (f_ "Filename of executable '%s'") + cs.cs_name) + (OASISUtils.varname_of_string cs.cs_name) + (fun () -> + let fn_opt = + fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None + in + match fn_opt with + | Some fn -> fn + | None -> + raise + (PropList.Not_set + (cs.cs_name, + Some (Printf.sprintf + (f_ "Executable '%s' not yet built.") + cs.cs_name))))) + + | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> + ()) + pkg.sections +end + +module BaseTest = struct +(* # 22 "src/base/BaseTest.ml" *) + + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + + + let test ~ctxt lst pkg extra_args = + + let one_test (failure, n) (test_plugin, cs, test) = + if var_choose + ~name:(Printf.sprintf + (f_ "test %s run") + cs.cs_name) + ~printer:string_of_bool + test.test_run then + begin + let () = info (f_ "Running test '%s'") cs.cs_name in + let back_cwd = + match test.test_working_directory with + | Some dir -> + let cwd = Sys.getcwd () in + let chdir d = + info (f_ "Changing directory to '%s'") d; + Sys.chdir d + in + chdir dir; + fun () -> chdir cwd + + | None -> + fun () -> () + in + try + let failure_percent = + BaseCustom.hook + test.test_custom + (test_plugin ~ctxt pkg (cs, test)) + extra_args + in + back_cwd (); + (failure_percent +. failure, n + 1) + with e -> + begin + back_cwd (); + raise e + end + end + else + begin + info (f_ "Skipping test '%s'") cs.cs_name; + (failure, n) + end + in + let failed, n = List.fold_left one_test (0.0, 0) lst in + let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in + let msg = + Printf.sprintf + (f_ "Tests had a %.2f%% failure rate") + (100. *. failure_percent) + in + if failure_percent > 0.0 then + failwith msg + else + info "%s" msg; + + (* Possible explanation why the tests where not run. *) + if OASISFeatures.package_test OASISFeatures.flag_tests pkg && + not (bool_of_string (BaseStandardVar.tests ())) && + lst <> [] then + BaseMessage.warning + "Tests are turned off, consider enabling with \ + 'ocaml setup.ml -configure --enable-tests'" +end + +module BaseDoc = struct +(* # 22 "src/base/BaseDoc.ml" *) + + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + + + let doc ~ctxt lst pkg extra_args = + + let one_doc (doc_plugin, cs, doc) = + if var_choose + ~name:(Printf.sprintf + (f_ "documentation %s build") + cs.cs_name) + ~printer:string_of_bool + doc.doc_build then + begin + info (f_ "Building documentation '%s'") cs.cs_name; + BaseCustom.hook + doc.doc_custom + (doc_plugin ~ctxt pkg (cs, doc)) + extra_args + end + in + List.iter one_doc lst; + + if OASISFeatures.package_test OASISFeatures.flag_docs pkg && + not (bool_of_string (BaseStandardVar.docs ())) && + lst <> [] then + BaseMessage.warning + "Docs are turned off, consider enabling with \ + 'ocaml setup.ml -configure --enable-docs'" +end + +module BaseSetup = struct +(* # 22 "src/base/BaseSetup.ml" *) + + open OASISContext + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + open OASISUtils + + + type std_args_fun = + ctxt:OASISContext.t -> package -> string array -> unit + + + type ('a, 'b) section_args_fun = + name * + (ctxt:OASISContext.t -> + package -> + (common_section * 'a) -> + string array -> + 'b) + + + type t = + { + configure: std_args_fun; + build: std_args_fun; + doc: ((doc, unit) section_args_fun) list; + test: ((test, float) section_args_fun) list; + install: std_args_fun; + uninstall: std_args_fun; + clean: std_args_fun list; + clean_doc: (doc, unit) section_args_fun list; + clean_test: (test, unit) section_args_fun list; + distclean: std_args_fun list; + distclean_doc: (doc, unit) section_args_fun list; + distclean_test: (test, unit) section_args_fun list; + package: package; + oasis_fn: string option; + oasis_version: string; + oasis_digest: Digest.t option; + oasis_exec: string option; + oasis_setup_args: string list; + setup_update: bool; + } + + + (* Associate a plugin function with data from package *) + let join_plugin_sections filter_map lst = + List.rev + (List.fold_left + (fun acc sct -> + match filter_map sct with + | Some e -> + e :: acc + | None -> + acc) + [] + lst) + + + (* Search for plugin data associated with a section name *) + let lookup_plugin_section plugin action nm lst = + try + List.assoc nm lst + with Not_found -> + failwithf + (f_ "Cannot find plugin %s matching section %s for %s action") + plugin + nm + action + + + let configure ~ctxt t args = + (* Run configure *) + BaseCustom.hook + t.package.conf_custom + (fun () -> + (* Reload if preconf has changed it *) + begin + try + unload (); + load ~ctxt (); + with _ -> + () + end; + + (* Run plugin's configure *) + t.configure ~ctxt t.package args; + + (* Dump to allow postconf to change it *) + dump ~ctxt ()) + (); + + (* Reload environment *) + unload (); + load ~ctxt (); + + (* Save environment *) + print (); + + (* Replace data in file *) + BaseFileAB.replace ~ctxt t.package.files_ab + + + let build ~ctxt t args = + BaseCustom.hook + t.package.build_custom + (t.build ~ctxt t.package) + args + + + let doc ~ctxt t args = + BaseDoc.doc + ~ctxt + (join_plugin_sections + (function + | Doc (cs, e) -> + Some + (lookup_plugin_section + "documentation" + (s_ "build") + cs.cs_name + t.doc, + cs, + e) + | _ -> + None) + t.package.sections) + t.package + args + + + let test ~ctxt t args = + BaseTest.test + ~ctxt + (join_plugin_sections + (function + | Test (cs, e) -> + Some + (lookup_plugin_section + "test" + (s_ "run") + cs.cs_name + t.test, + cs, + e) + | _ -> + None) + t.package.sections) + t.package + args + + + let all ~ctxt t args = + let rno_doc = ref false in + let rno_test = ref false in + let arg_rest = ref [] in + Arg.parse_argv + ~current:(ref 0) + (Array.of_list + ((Sys.executable_name^" all") :: + (Array.to_list args))) + [ + "-no-doc", + Arg.Set rno_doc, + s_ "Don't run doc target"; + + "-no-test", + Arg.Set rno_test, + s_ "Don't run test target"; + + "--", + Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest), + s_ "All arguments for configure."; + ] + (failwithf (f_ "Don't know what to do with '%s'")) + ""; + + info "Running configure step"; + configure ~ctxt t (Array.of_list (List.rev !arg_rest)); + + info "Running build step"; + build ~ctxt t [||]; + + (* Load setup.log dynamic variables *) + BaseDynVar.init ~ctxt t.package; + + if not !rno_doc then begin + info "Running doc step"; + doc ~ctxt t [||] + end else begin + info "Skipping doc step" + end; + if not !rno_test then begin + info "Running test step"; + test ~ctxt t [||] + end else begin + info "Skipping test step" + end + + + let install ~ctxt t args = + BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args + + + let uninstall ~ctxt t args = + BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args + + + let reinstall ~ctxt t args = + uninstall ~ctxt t args; + install ~ctxt t args + + + let clean, distclean = + let failsafe f a = + try + f a + with e -> + warning + (f_ "Action fail with error: %s") + (match e with + | Failure msg -> msg + | e -> Printexc.to_string e) + in + + let generic_clean ~ctxt t cstm mains docs tests args = + BaseCustom.hook + ~failsafe:true + cstm + (fun () -> + (* Clean section *) + List.iter + (function + | Test (cs, test) -> + let f = + try + List.assoc cs.cs_name tests + with Not_found -> + fun ~ctxt:_ _ _ _ -> () + in + failsafe (f ~ctxt t.package (cs, test)) args + | Doc (cs, doc) -> + let f = + try + List.assoc cs.cs_name docs + with Not_found -> + fun ~ctxt:_ _ _ _ -> () + in + failsafe (f ~ctxt t.package (cs, doc)) args + | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ()) + t.package.sections; + (* Clean whole package *) + List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains) + () + in + + let clean ~ctxt t args = + generic_clean + ~ctxt + t + t.package.clean_custom + t.clean + t.clean_doc + t.clean_test + args + in + + let distclean ~ctxt t args = + (* Call clean *) + clean ~ctxt t args; + + (* Call distclean code *) + generic_clean + ~ctxt + t + t.package.distclean_custom + t.distclean + t.distclean_doc + t.distclean_test + args; + + (* Remove generated source files. *) + List.iter + (fun fn -> + if ctxt.srcfs#file_exists fn then begin + info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn); + ctxt.srcfs#remove fn + end) + ([BaseEnv.default_filename; BaseLog.default_filename] + @ (List.rev_map BaseFileAB.to_filename t.package.files_ab)) + in + + clean, distclean + + + let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version + + + let update_setup_ml, no_update_setup_ml_cli = + let b = ref true in + b, + ("-no-update-setup-ml", + Arg.Clear b, + s_ " Don't try to update setup.ml, even if _oasis has changed.") + + (* TODO: srcfs *) + let default_oasis_fn = "_oasis" + + + let update_setup_ml t = + let oasis_fn = + match t.oasis_fn with + | Some fn -> fn + | None -> default_oasis_fn + in + let oasis_exec = + match t.oasis_exec with + | Some fn -> fn + | None -> "oasis" + in + let ocaml = + Sys.executable_name + in + let setup_ml, args = + match Array.to_list Sys.argv with + | setup_ml :: args -> + setup_ml, args + | [] -> + failwith + (s_ "Expecting non-empty command line arguments.") + in + let ocaml, setup_ml = + if Sys.executable_name = Sys.argv.(0) then + (* We are not running in standard mode, probably the script + * is precompiled. + *) + "ocaml", "setup.ml" + else + ocaml, setup_ml + in + let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in + let do_update () = + let oasis_exec_version = + OASISExec.run_read_one_line + ~ctxt:!BaseContext.default + ~f_exit_code: + (function + | 0 -> + () + | 1 -> + failwithf + (f_ "Executable '%s' is probably an old version \ + of oasis (< 0.3.0), please update to version \ + v%s.") + oasis_exec t.oasis_version + | 127 -> + failwithf + (f_ "Cannot find executable '%s', please install \ + oasis v%s.") + oasis_exec t.oasis_version + | n -> + failwithf + (f_ "Command '%s version' exited with code %d.") + oasis_exec n) + oasis_exec ["version"] + in + if OASISVersion.comparator_apply + (OASISVersion.version_of_string oasis_exec_version) + (OASISVersion.VGreaterEqual + (OASISVersion.version_of_string t.oasis_version)) then + begin + (* We have a version >= for the executable oasis, proceed with + * update. + *) + (* TODO: delegate this check to 'oasis setup'. *) + if Sys.os_type = "Win32" then + failwithf + (f_ "It is not possible to update the running script \ + setup.ml on Windows. Please update setup.ml by \ + running '%s'.") + (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args)) + else + begin + OASISExec.run + ~ctxt:!BaseContext.default + ~f_exit_code: + (fun n -> + if n <> 0 then + failwithf + (f_ "Unable to update setup.ml using '%s', \ + please fix the problem and retry.") + oasis_exec) + oasis_exec ("setup" :: t.oasis_setup_args); + OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args) + end + end + else + failwithf + (f_ "The version of '%s' (v%s) doesn't match the version of \ + oasis used to generate the %s file. Please install at \ + least oasis v%s.") + oasis_exec oasis_exec_version setup_ml t.oasis_version + in + + if !update_setup_ml then + begin + try + match t.oasis_digest with + | Some dgst -> + if Sys.file_exists oasis_fn && + dgst <> Digest.file default_oasis_fn then + begin + do_update (); + true + end + else + false + | None -> + false + with e -> + error + (f_ "Error when updating setup.ml. If you want to avoid this error, \ + you can bypass the update of %s by running '%s %s %s %s'") + setup_ml ocaml setup_ml no_update_setup_ml_cli + (String.concat " " args); + raise e + end + else + false + + + let setup t = + let catch_exn = ref true in + let act_ref = + ref (fun ~ctxt:_ _ -> + failwithf + (f_ "No action defined, run '%s %s -help'") + Sys.executable_name + Sys.argv.(0)) + + in + let extra_args_ref = ref [] in + let allow_empty_env_ref = ref false in + let arg_handle ?(allow_empty_env=false) act = + Arg.Tuple + [ + Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); + Arg.Unit + (fun () -> + allow_empty_env_ref := allow_empty_env; + act_ref := act); + ] + in + try + let () = + Arg.parse + (Arg.align + ([ + "-configure", + arg_handle ~allow_empty_env:true configure, + s_ "[options*] Configure the whole build process."; + + "-build", + arg_handle build, + s_ "[options*] Build executables and libraries."; + + "-doc", + arg_handle doc, + s_ "[options*] Build documents."; + + "-test", + arg_handle test, + s_ "[options*] Run tests."; + + "-all", + arg_handle ~allow_empty_env:true all, + s_ "[options*] Run configure, build, doc and test targets."; + + "-install", + arg_handle install, + s_ "[options*] Install libraries, data, executables \ + and documents."; + + "-uninstall", + arg_handle uninstall, + s_ "[options*] Uninstall libraries, data, executables \ + and documents."; + + "-reinstall", + arg_handle reinstall, + s_ "[options*] Uninstall and install libraries, data, \ + executables and documents."; + + "-clean", + arg_handle ~allow_empty_env:true clean, + s_ "[options*] Clean files generated by a build."; + + "-distclean", + arg_handle ~allow_empty_env:true distclean, + s_ "[options*] Clean files generated by a build and configure."; + + "-version", + arg_handle ~allow_empty_env:true version, + s_ " Display version of OASIS used to generate this setup.ml."; + + "-no-catch-exn", + Arg.Clear catch_exn, + s_ " Don't catch exception, useful for debugging."; + ] + @ + (if t.setup_update then + [no_update_setup_ml_cli] + else + []) + @ (BaseContext.args ()))) + (failwithf (f_ "Don't know what to do with '%s'")) + (s_ "Setup and run build process current package\n") + in + + (* Instantiate the context. *) + let ctxt = !BaseContext.default in + + (* Build initial environment *) + load ~ctxt ~allow_empty:!allow_empty_env_ref (); + + (** Initialize flags *) + List.iter + (function + | Flag (cs, {flag_description = hlp; + flag_default = choices}) -> + begin + let apply ?short_desc () = + var_ignore + (var_define + ~cli:CLIEnable + ?short_desc + (OASISUtils.varname_of_string cs.cs_name) + (fun () -> + string_of_bool + (var_choose + ~name:(Printf.sprintf + (f_ "default value of flag %s") + cs.cs_name) + ~printer:string_of_bool + choices))) + in + match hlp with + | Some hlp -> apply ~short_desc:(fun () -> hlp) () + | None -> apply () + end + | _ -> + ()) + t.package.sections; + + BaseStandardVar.init t.package; + + BaseDynVar.init ~ctxt t.package; + + if not (t.setup_update && update_setup_ml t) then + !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref)) + + with e when !catch_exn -> + error "%s" (Printexc.to_string e); + exit 1 + + +end + +module BaseCompat = struct +(* # 22 "src/base/BaseCompat.ml" *) + + (** Compatibility layer to provide a stable API inside setup.ml. + This layer allows OASIS to change in between minor versions + (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This + enables to write functions that manipulate setup_t inside setup.ml. See + deps.ml for an example. + + The module opened by default will depend on the version of the _oasis. E.g. + if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and + the function Compat_0_3 will be called. If setup.ml is generated with the + -nocompat, no module will be opened. + + @author Sylvain Le Gall + *) + + module Compat_0_4 = + struct + let rctxt = ref !BaseContext.default + + module BaseSetup = + struct + module Original = BaseSetup + + open OASISTypes + + type std_args_fun = package -> string array -> unit + type ('a, 'b) section_args_fun = + name * (package -> (common_section * 'a) -> string array -> 'b) + type t = + { + configure: std_args_fun; + build: std_args_fun; + doc: ((doc, unit) section_args_fun) list; + test: ((test, float) section_args_fun) list; + install: std_args_fun; + uninstall: std_args_fun; + clean: std_args_fun list; + clean_doc: (doc, unit) section_args_fun list; + clean_test: (test, unit) section_args_fun list; + distclean: std_args_fun list; + distclean_doc: (doc, unit) section_args_fun list; + distclean_test: (test, unit) section_args_fun list; + package: package; + oasis_fn: string option; + oasis_version: string; + oasis_digest: Digest.t option; + oasis_exec: string option; + oasis_setup_args: string list; + setup_update: bool; + } + + let setup t = + let mk_std_args_fun f = + fun ~ctxt pkg args -> rctxt := ctxt; f pkg args + in + let mk_section_args_fun l = + List.map + (fun (nm, f) -> + nm, + (fun ~ctxt pkg sct args -> + rctxt := ctxt; + f pkg sct args)) + l + in + let t' = + { + Original. + configure = mk_std_args_fun t.configure; + build = mk_std_args_fun t.build; + doc = mk_section_args_fun t.doc; + test = mk_section_args_fun t.test; + install = mk_std_args_fun t.install; + uninstall = mk_std_args_fun t.uninstall; + clean = List.map mk_std_args_fun t.clean; + clean_doc = mk_section_args_fun t.clean_doc; + clean_test = mk_section_args_fun t.clean_test; + distclean = List.map mk_std_args_fun t.distclean; + distclean_doc = mk_section_args_fun t.distclean_doc; + distclean_test = mk_section_args_fun t.distclean_test; + + package = t.package; + oasis_fn = t.oasis_fn; + oasis_version = t.oasis_version; + oasis_digest = t.oasis_digest; + oasis_exec = t.oasis_exec; + oasis_setup_args = t.oasis_setup_args; + setup_update = t.setup_update; + } + in + Original.setup t' + + end + + let adapt_setup_t setup_t = + let module O = BaseSetup.Original in + let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in + let mk_section_args_fun l = + List.map + (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args)) + l + in + { + BaseSetup. + configure = mk_std_args_fun setup_t.O.configure; + build = mk_std_args_fun setup_t.O.build; + doc = mk_section_args_fun setup_t.O.doc; + test = mk_section_args_fun setup_t.O.test; + install = mk_std_args_fun setup_t.O.install; + uninstall = mk_std_args_fun setup_t.O.uninstall; + clean = List.map mk_std_args_fun setup_t.O.clean; + clean_doc = mk_section_args_fun setup_t.O.clean_doc; + clean_test = mk_section_args_fun setup_t.O.clean_test; + distclean = List.map mk_std_args_fun setup_t.O.distclean; + distclean_doc = mk_section_args_fun setup_t.O.distclean_doc; + distclean_test = mk_section_args_fun setup_t.O.distclean_test; + + package = setup_t.O.package; + oasis_fn = setup_t.O.oasis_fn; + oasis_version = setup_t.O.oasis_version; + oasis_digest = setup_t.O.oasis_digest; + oasis_exec = setup_t.O.oasis_exec; + oasis_setup_args = setup_t.O.oasis_setup_args; + setup_update = setup_t.O.setup_update; + } + end + + + module Compat_0_3 = + struct + include Compat_0_4 + end + +end + + +# 5662 "setup.ml" +module InternalConfigurePlugin = struct +(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) + + + (** Configure using internal scheme + @author Sylvain Le Gall + *) + + + open BaseEnv + open OASISTypes + open OASISUtils + open OASISGettext + open BaseMessage + + + (** Configure build using provided series of check to be done + and then output corresponding file. + *) + let configure ~ctxt:_ pkg argv = + let var_ignore_eval var = let _s: string = var () in () in + let errors = ref SetString.empty in + let buff = Buffer.create 13 in + + let add_errors fmt = + Printf.kbprintf + (fun b -> + errors := SetString.add (Buffer.contents b) !errors; + Buffer.clear b) + buff + fmt + in + + let warn_exception e = + warning "%s" (Printexc.to_string e) + in + + (* Check tools *) + let check_tools lst = + List.iter + (function + | ExternalTool tool -> + begin + try + var_ignore_eval (BaseCheck.prog tool) + with e -> + warn_exception e; + add_errors (f_ "Cannot find external tool '%s'") tool + end + | InternalExecutable nm1 -> + (* Check that matching tool is built *) + List.iter + (function + | Executable ({cs_name = nm2; _}, + {bs_build = build; _}, + _) when nm1 = nm2 -> + if not (var_choose build) then + add_errors + (f_ "Cannot find buildable internal executable \ + '%s' when checking build depends") + nm1 + | _ -> + ()) + pkg.sections) + lst + in + + let build_checks sct bs = + if var_choose bs.bs_build then + begin + if bs.bs_compiled_object = Native then + begin + try + var_ignore_eval BaseStandardVar.ocamlopt + with e -> + warn_exception e; + add_errors + (f_ "Section %s requires native compilation") + (OASISSection.string_of_section sct) + end; + + (* Check tools *) + check_tools bs.bs_build_tools; + + (* Check depends *) + List.iter + (function + | FindlibPackage (findlib_pkg, version_comparator) -> + begin + try + var_ignore_eval + (BaseCheck.package ?version_comparator findlib_pkg) + with e -> + warn_exception e; + match version_comparator with + | None -> + add_errors + (f_ "Cannot find findlib package %s") + findlib_pkg + | Some ver_cmp -> + add_errors + (f_ "Cannot find findlib package %s (%s)") + findlib_pkg + (OASISVersion.string_of_comparator ver_cmp) + end + | InternalLibrary nm1 -> + (* Check that matching library is built *) + List.iter + (function + | Library ({cs_name = nm2; _}, + {bs_build = build; _}, + _) when nm1 = nm2 -> + if not (var_choose build) then + add_errors + (f_ "Cannot find buildable internal library \ + '%s' when checking build depends") + nm1 + | _ -> + ()) + pkg.sections) + bs.bs_build_depends + end + in + + (* Parse command line *) + BaseArgExt.parse argv (BaseEnv.args ()); + + (* OCaml version *) + begin + match pkg.ocaml_version with + | Some ver_cmp -> + begin + try + var_ignore_eval + (BaseCheck.version + "ocaml" + ver_cmp + BaseStandardVar.ocaml_version) + with e -> + warn_exception e; + add_errors + (f_ "OCaml version %s doesn't match version constraint %s") + (BaseStandardVar.ocaml_version ()) + (OASISVersion.string_of_comparator ver_cmp) + end + | None -> + () + end; + + (* Findlib version *) + begin + match pkg.findlib_version with + | Some ver_cmp -> + begin + try + var_ignore_eval + (BaseCheck.version + "findlib" + ver_cmp + BaseStandardVar.findlib_version) + with e -> + warn_exception e; + add_errors + (f_ "Findlib version %s doesn't match version constraint %s") + (BaseStandardVar.findlib_version ()) + (OASISVersion.string_of_comparator ver_cmp) + end + | None -> + () + end; + (* Make sure the findlib version is fine for the OCaml compiler. *) + begin + let ocaml_ge4 = + OASISVersion.version_compare + (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ())) + (OASISVersion.version_of_string "4.0.0") >= 0 in + if ocaml_ge4 then + let findlib_lt132 = + OASISVersion.version_compare + (OASISVersion.version_of_string (BaseStandardVar.findlib_version())) + (OASISVersion.version_of_string "1.3.2") < 0 in + if findlib_lt132 then + add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2" + end; + + (* FlexDLL *) + if BaseStandardVar.os_type () = "Win32" || + BaseStandardVar.os_type () = "Cygwin" then + begin + try + var_ignore_eval BaseStandardVar.flexlink + with e -> + warn_exception e; + add_errors (f_ "Cannot find 'flexlink'") + end; + + (* Check build depends *) + List.iter + (function + | Executable (_, bs, _) + | Library (_, bs, _) as sct -> + build_checks sct bs + | Doc (_, doc) -> + if var_choose doc.doc_build then + check_tools doc.doc_build_tools + | Test (_, test) -> + if var_choose test.test_run then + check_tools test.test_tools + | _ -> + ()) + pkg.sections; + + (* Check if we need native dynlink (presence of libraries that compile to + native) + *) + begin + let has_cmxa = + List.exists + (function + | Library (_, bs, _) -> + var_choose bs.bs_build && + (bs.bs_compiled_object = Native || + (bs.bs_compiled_object = Best && + bool_of_string (BaseStandardVar.is_native ()))) + | _ -> + false) + pkg.sections + in + if has_cmxa then + var_ignore_eval BaseStandardVar.native_dynlink + end; + + (* Check errors *) + if SetString.empty != !errors then + begin + List.iter + (fun e -> error "%s" e) + (SetString.elements !errors); + failwithf + (fn_ + "%d configuration error" + "%d configuration errors" + (SetString.cardinal !errors)) + (SetString.cardinal !errors) + end + + +end + +module InternalInstallPlugin = struct +(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *) + + + (** Install using internal scheme + @author Sylvain Le Gall + *) + + + (* TODO: rewrite this module with OASISFileSystem. *) + + open BaseEnv + open BaseStandardVar + open BaseMessage + open OASISTypes + open OASISFindlib + open OASISGettext + open OASISUtils + + + let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec) + let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, []) + let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, []) + let doc_hook = ref (fun (cs, doc) -> cs, doc) + + let install_file_ev = "install-file" + let install_dir_ev = "install-dir" + let install_findlib_ev = "install-findlib" + + + (* TODO: this can be more generic and used elsewhere. *) + let win32_max_command_line_length = 8000 + + + let split_install_command ocamlfind findlib_name meta files = + if Sys.os_type = "Win32" then + (* Arguments for the first command: *) + let first_args = ["install"; findlib_name; meta] in + (* Arguments for remaining commands: *) + let other_args = ["install"; findlib_name; "-add"] in + (* Extract as much files as possible from [files], [len] is + the current command line length: *) + let rec get_files len acc files = + match files with + | [] -> + (List.rev acc, []) + | file :: rest -> + let len = len + 1 + String.length file in + if len > win32_max_command_line_length then + (List.rev acc, files) + else + get_files len (file :: acc) rest + in + (* Split the command into several commands. *) + let rec split args files = + match files with + | [] -> + [] + | _ -> + (* Length of "ocamlfind install [META|-add]" *) + let len = + List.fold_left + (fun len arg -> + len + 1 (* for the space *) + String.length arg) + (String.length ocamlfind) + args + in + match get_files len [] files with + | ([], _) -> + failwith (s_ "Command line too long.") + | (firsts, others) -> + let cmd = args @ firsts in + (* Use -add for remaining commands: *) + let () = + let findlib_ge_132 = + OASISVersion.comparator_apply + (OASISVersion.version_of_string + (BaseStandardVar.findlib_version ())) + (OASISVersion.VGreaterEqual + (OASISVersion.version_of_string "1.3.2")) + in + if not findlib_ge_132 then + failwithf + (f_ "Installing the library %s require to use the \ + flag '-add' of ocamlfind because the command \ + line is too long. This flag is only available \ + for findlib 1.3.2. Please upgrade findlib from \ + %s to 1.3.2") + findlib_name (BaseStandardVar.findlib_version ()) + in + let cmds = split other_args others in + cmd :: cmds + in + (* The first command does not use -add: *) + split first_args files + else + ["install" :: findlib_name :: meta :: files] + + + let install = + + let in_destdir fn = + try + (* Practically speaking destdir is prepended at the beginning of the + target filename + *) + (destdir ())^fn + with PropList.Not_set _ -> + fn + in + + let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir = + let tgt_dir = + if prepend_destdir then in_destdir (envdir ()) else envdir () + in + let tgt_file = + Filename.concat + tgt_dir + (match tgt_fn with + | Some fn -> + fn + | None -> + Filename.basename src_file) + in + (* Create target directory if needed *) + OASISFileUtil.mkdir_parent + ~ctxt + (fun dn -> + info (f_ "Creating directory '%s'") dn; + BaseLog.register ~ctxt install_dir_ev dn) + (Filename.dirname tgt_file); + + (* Really install files *) + info (f_ "Copying file '%s' to '%s'") src_file tgt_file; + OASISFileUtil.cp ~ctxt src_file tgt_file; + BaseLog.register ~ctxt install_file_ev tgt_file + in + + (* Install the files for a library. *) + + let install_lib_files ~ctxt findlib_name files = + let findlib_dir = + let dn = + let findlib_destdir = + OASISExec.run_read_one_line ~ctxt (ocamlfind ()) + ["printconf" ; "destdir"] + in + Filename.concat findlib_destdir findlib_name + in + fun () -> dn + in + let () = + if not (OASISFileUtil.file_exists_case (findlib_dir ())) then + failwithf + (f_ "Directory '%s' doesn't exist for findlib library %s") + (findlib_dir ()) findlib_name + in + let f dir file = + let basename = Filename.basename file in + let tgt_fn = Filename.concat dir basename in + (* Destdir is already include in printconf. *) + install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir + in + List.iter (fun (dir, files) -> List.iter (f dir) files) files ; + in + + (* Install data into defined directory *) + let install_data ~ctxt srcdir lst tgtdir = + let tgtdir = + OASISHostPath.of_unix (var_expand tgtdir) + in + List.iter + (fun (src, tgt_opt) -> + let real_srcs = + OASISFileUtil.glob + ~ctxt:!BaseContext.default + (Filename.concat srcdir src) + in + if real_srcs = [] then + failwithf + (f_ "Wildcard '%s' doesn't match any files") + src; + List.iter + (fun fn -> + install_file ~ctxt + fn + (fun () -> + match tgt_opt with + | Some s -> + OASISHostPath.of_unix (var_expand s) + | None -> + tgtdir)) + real_srcs) + lst + in + + let make_fnames modul sufx = + List.fold_right + begin fun sufx accu -> + (OASISString.capitalize_ascii modul ^ sufx) :: + (OASISString.uncapitalize_ascii modul ^ sufx) :: + accu + end + sufx + [] + in + + (** Install all libraries *) + let install_libs ~ctxt pkg = + + let find_first_existing_files_in_path bs lst = + let path = OASISHostPath.of_unix bs.bs_path in + List.find + OASISFileUtil.file_exists_case + (List.map (Filename.concat path) lst) + in + + let files_of_modules new_files typ cs bs modules = + List.fold_left + (fun acc modul -> + begin + try + (* Add uncompiled header from the source tree *) + [find_first_existing_files_in_path + bs (make_fnames modul [".mli"; ".ml"])] + with Not_found -> + warning + (f_ "Cannot find source header for module %s \ + in %s %s") + typ modul cs.cs_name; + [] + end + @ + List.fold_left + (fun acc fn -> + try + find_first_existing_files_in_path bs [fn] :: acc + with Not_found -> + acc) + acc (make_fnames modul [".annot";".cmti";".cmt"])) + new_files + modules + in + + let files_of_build_section (f_data, new_files) typ cs bs = + let extra_files = + List.map + (fun fn -> + try + find_first_existing_files_in_path bs [fn] + with Not_found -> + failwithf + (f_ "Cannot find extra findlib file %S in %s %s ") + fn + typ + cs.cs_name) + bs.bs_findlib_extra_files + in + let f_data () = + (* Install data associated with the library *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat + (datarootdir ()) + pkg.name); + f_data () + in + f_data, new_files @ extra_files + in + + let files_of_library (f_data, acc) data_lib = + let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in + if var_choose bs.bs_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin + (* Start with lib_extra *) + let new_files = lib_extra in + let new_files = + files_of_modules new_files "library" cs bs lib.lib_modules + in + let f_data, new_files = + files_of_build_section (f_data, new_files) "library" cs bs + in + let new_files = + (* Get generated files *) + BaseBuilt.fold + ~ctxt + BaseBuilt.BLib + cs.cs_name + (fun acc fn -> fn :: acc) + new_files + in + let acc = (dn, new_files) :: acc in + + let f_data () = + (* Install data associated with the library *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat + (datarootdir ()) + pkg.name); + f_data () + in + + (f_data, acc) + end else begin + (f_data, acc) + end + and files_of_object (f_data, acc) data_obj = + let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in + if var_choose bs.bs_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin + (* Start with obj_extra *) + let new_files = obj_extra in + let new_files = + files_of_modules new_files "object" cs bs obj.obj_modules + in + let f_data, new_files = + files_of_build_section (f_data, new_files) "object" cs bs + in + + let new_files = + (* Get generated files *) + BaseBuilt.fold + ~ctxt + BaseBuilt.BObj + cs.cs_name + (fun acc fn -> fn :: acc) + new_files + in + let acc = (dn, new_files) :: acc in + + let f_data () = + (* Install data associated with the object *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat (datarootdir ()) pkg.name); + f_data () + in + (f_data, acc) + end else begin + (f_data, acc) + end + in + + (* Install one group of library *) + let install_group_lib grp = + (* Iterate through all group nodes *) + let rec install_group_lib_aux data_and_files grp = + let data_and_files, children = + match grp with + | Container (_, children) -> + data_and_files, children + | Package (_, cs, bs, `Library lib, dn, children) -> + files_of_library data_and_files (cs, bs, lib, dn), children + | Package (_, cs, bs, `Object obj, dn, children) -> + files_of_object data_and_files (cs, bs, obj, dn), children + in + List.fold_left + install_group_lib_aux + data_and_files + children + in + + (* Findlib name of the root library *) + let findlib_name = findlib_of_group grp in + + (* Determine root library *) + let root_lib = root_of_group grp in + + (* All files to install for this library *) + let f_data, files = install_group_lib_aux (ignore, []) grp in + + (* Really install, if there is something to install *) + if files = [] then begin + warning + (f_ "Nothing to install for findlib library '%s'") findlib_name + end else begin + let meta = + (* Search META file *) + let _, bs, _ = root_lib in + let res = Filename.concat bs.bs_path "META" in + if not (OASISFileUtil.file_exists_case res) then + failwithf + (f_ "Cannot find file '%s' for findlib library %s") + res + findlib_name; + res + in + let files = + (* Make filename shorter to avoid hitting command max line length + * too early, esp. on Windows. + *) + (* TODO: move to OASISHostPath as make_relative. *) + let remove_prefix p n = + let plen = String.length p in + let nlen = String.length n in + if plen <= nlen && String.sub n 0 plen = p then begin + let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in + let cutpoint = + plen + + (if plen < nlen && n.[plen] = fn_sep then 1 else 0) + in + String.sub n cutpoint (nlen - cutpoint) + end else begin + n + end + in + List.map + (fun (dir, fn) -> + (dir, List.map (remove_prefix (Sys.getcwd ())) fn)) + files + in + let ocamlfind = ocamlfind () in + let nodir_files, dir_files = + List.fold_left + (fun (nodir, dir) (dn, lst) -> + match dn with + | Some dn -> nodir, (dn, lst) :: dir + | None -> lst @ nodir, dir) + ([], []) + (List.rev files) + in + info (f_ "Installing findlib library '%s'") findlib_name; + List.iter + (OASISExec.run ~ctxt ocamlfind) + (split_install_command ocamlfind findlib_name meta nodir_files); + install_lib_files ~ctxt findlib_name dir_files; + BaseLog.register ~ctxt install_findlib_ev findlib_name + end; + + (* Install data files *) + f_data (); + in + + let group_libs, _, _ = findlib_mapping pkg in + + (* We install libraries in groups *) + List.iter install_group_lib group_libs + in + + let install_execs ~ctxt pkg = + let install_exec data_exec = + let cs, bs, _ = !exec_hook data_exec in + if var_choose bs.bs_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin + let exec_libdir () = Filename.concat (libdir ()) pkg.name in + BaseBuilt.fold + ~ctxt + BaseBuilt.BExec + cs.cs_name + (fun () fn -> + install_file ~ctxt + ~tgt_fn:(cs.cs_name ^ ext_program ()) + fn + bindir) + (); + BaseBuilt.fold + ~ctxt + BaseBuilt.BExecLib + cs.cs_name + (fun () fn -> install_file ~ctxt fn exec_libdir) + (); + install_data ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat (datarootdir ()) pkg.name) + end + in + List.iter + (function + | Executable (cs, bs, exec)-> install_exec (cs, bs, exec) + | _ -> ()) + pkg.sections + in + + let install_docs ~ctxt pkg = + let install_doc data = + let cs, doc = !doc_hook data in + if var_choose doc.doc_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin + let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in + BaseBuilt.fold + ~ctxt + BaseBuilt.BDoc + cs.cs_name + (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir)) + (); + install_data ~ctxt + Filename.current_dir_name + doc.doc_data_files + doc.doc_install_dir + end + in + List.iter + (function + | Doc (cs, doc) -> install_doc (cs, doc) + | _ -> ()) + pkg.sections + in + fun ~ctxt pkg _ -> + install_libs ~ctxt pkg; + install_execs ~ctxt pkg; + install_docs ~ctxt pkg + + + (* Uninstall already installed data *) + let uninstall ~ctxt _ _ = + let uninstall_aux (ev, data) = + if ev = install_file_ev then begin + if OASISFileUtil.file_exists_case data then begin + info (f_ "Removing file '%s'") data; + Sys.remove data + end else begin + warning (f_ "File '%s' doesn't exist anymore") data + end + end else if ev = install_dir_ev then begin + if Sys.file_exists data && Sys.is_directory data then begin + if Sys.readdir data = [||] then begin + info (f_ "Removing directory '%s'") data; + OASISFileUtil.rmdir ~ctxt data + end else begin + warning + (f_ "Directory '%s' is not empty (%s)") + data + (String.concat ", " (Array.to_list (Sys.readdir data))) + end + end else begin + warning (f_ "Directory '%s' doesn't exist anymore") data + end + end else if ev = install_findlib_ev then begin + info (f_ "Removing findlib library '%s'") data; + OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data] + end else begin + failwithf (f_ "Unknown log event '%s'") ev; + end; + BaseLog.unregister ~ctxt ev data + in + (* We process event in reverse order *) + List.iter uninstall_aux + (List.rev + (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev])); + List.iter uninstall_aux + (List.rev (BaseLog.filter ~ctxt [install_findlib_ev])) + +end + + +# 6465 "setup.ml" +module OCamlbuildCommon = struct +(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) + + + (** Functions common to OCamlbuild build and doc plugin + *) + + + open OASISGettext + open BaseEnv + open BaseStandardVar + open OASISTypes + + + type extra_args = string list + + + let ocamlbuild_clean_ev = "ocamlbuild-clean" + + + let ocamlbuildflags = + var_define + ~short_desc:(fun () -> "OCamlbuild additional flags") + "ocamlbuildflags" + (fun () -> "") + + + (** Fix special arguments depending on environment *) + let fix_args args extra_argv = + List.flatten + [ + if (os_type ()) = "Win32" then + [ + "-classic-display"; + "-no-log"; + "-no-links"; + ] + else + []; + + if OASISVersion.comparator_apply + (OASISVersion.version_of_string (ocaml_version ())) + (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then + [ + "-install-lib-dir"; + (Filename.concat (standard_library ()) "ocamlbuild") + ] + else + []; + + if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then + [ + "-byte-plugin" + ] + else + []; + args; + + if bool_of_string (debug ()) then + ["-tag"; "debug"] + else + []; + + if bool_of_string (tests ()) then + ["-tag"; "tests"] + else + []; + + if bool_of_string (profile ()) then + ["-tag"; "profile"] + else + []; + + OASISString.nsplit (ocamlbuildflags ()) ' '; + + Array.to_list extra_argv; + ] + + + (** Run 'ocamlbuild -clean' if not already done *) + let run_clean ~ctxt extra_argv = + let extra_cli = + String.concat " " (Array.to_list extra_argv) + in + (* Run if never called with these args *) + if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then + begin + OASISExec.run ~ctxt (ocamlbuild ()) (fix_args ["-clean"] extra_argv); + BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli; + at_exit + (fun () -> + try + BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli + with _ -> ()) + end + + + (** Run ocamlbuild, unregister all clean events *) + let run_ocamlbuild ~ctxt args extra_argv = + (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html + *) + OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv); + (* Remove any clean event, we must run it again *) + List.iter + (fun (e, d) -> BaseLog.unregister ~ctxt e d) + (BaseLog.filter ~ctxt [ocamlbuild_clean_ev]) + + + (** Determine real build directory *) + let build_dir extra_argv = + let rec search_args dir = + function + | "-build-dir" :: dir :: tl -> + search_args dir tl + | _ :: tl -> + search_args dir tl + | [] -> + dir + in + search_args "_build" (fix_args [] extra_argv) + + +end + +module OCamlbuildPlugin = struct +(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) + + + (** Build using ocamlbuild + @author Sylvain Le Gall + *) + + + open OASISTypes + open OASISGettext + open OASISUtils + open OASISString + open BaseEnv + open OCamlbuildCommon + open BaseStandardVar + + + let cond_targets_hook = ref (fun lst -> lst) + + + let build ~ctxt extra_args pkg argv = + (* Return the filename in build directory *) + let in_build_dir fn = + Filename.concat + (build_dir argv) + fn + in + + (* Return the unix filename in host build directory *) + let in_build_dir_of_unix fn = + in_build_dir (OASISHostPath.of_unix fn) + in + + let cond_targets = + List.fold_left + (fun acc -> + function + | Library (cs, bs, lib) when var_choose bs.bs_build -> + begin + let evs, unix_files = + BaseBuilt.of_library + in_build_dir_of_unix + (cs, bs, lib) + in + + let tgts = + List.flatten + (List.filter + (fun l -> l <> []) + (List.map + (List.filter + (fun fn -> + ends_with ~what:".cma" fn + || ends_with ~what:".cmxs" fn + || ends_with ~what:".cmxa" fn + || ends_with ~what:(ext_lib ()) fn + || ends_with ~what:(ext_dll ()) fn)) + unix_files)) + in + + match tgts with + | _ :: _ -> + (evs, tgts) :: acc + | [] -> + failwithf + (f_ "No possible ocamlbuild targets for library %s") + cs.cs_name + end + + | Object (cs, bs, obj) when var_choose bs.bs_build -> + begin + let evs, unix_files = + BaseBuilt.of_object + in_build_dir_of_unix + (cs, bs, obj) + in + + let tgts = + List.flatten + (List.filter + (fun l -> l <> []) + (List.map + (List.filter + (fun fn -> + ends_with ~what:".cmo" fn + || ends_with ~what:".cmx" fn)) + unix_files)) + in + + match tgts with + | _ :: _ -> + (evs, tgts) :: acc + | [] -> + failwithf + (f_ "No possible ocamlbuild targets for object %s") + cs.cs_name + end + + | Executable (cs, bs, exec) when var_choose bs.bs_build -> + begin + let evs, _, _ = + BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec) + in + + let target ext = + let unix_tgt = + (OASISUnixPath.concat + bs.bs_path + (OASISUnixPath.chop_extension + exec.exec_main_is))^ext + in + let evs = + (* Fix evs, we want to use the unix_tgt, without copying *) + List.map + (function + | BaseBuilt.BExec, nm, _ when nm = cs.cs_name -> + BaseBuilt.BExec, nm, + [[in_build_dir_of_unix unix_tgt]] + | ev -> + ev) + evs + in + evs, [unix_tgt] + in + + (* Add executable *) + let acc = + match bs.bs_compiled_object with + | Native -> + (target ".native") :: acc + | Best when bool_of_string (is_native ()) -> + (target ".native") :: acc + | Byte + | Best -> + (target ".byte") :: acc + in + acc + end + + | Library _ | Object _ | Executable _ | Test _ + | SrcRepo _ | Flag _ | Doc _ -> + acc) + [] + (* Keep the pkg.sections ordered *) + (List.rev pkg.sections); + in + + (* Check and register built files *) + let check_and_register (bt, bnm, lst) = + List.iter + (fun fns -> + if not (List.exists OASISFileUtil.file_exists_case fns) then + failwithf + (fn_ + "Expected built file %s doesn't exist." + "None of expected built files %s exists." + (List.length fns)) + (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns))) + lst; + (BaseBuilt.register ~ctxt bt bnm lst) + in + + (* Run the hook *) + let cond_targets = !cond_targets_hook cond_targets in + + (* Run a list of target... *) + run_ocamlbuild + ~ctxt + (List.flatten (List.map snd cond_targets) @ extra_args) + argv; + (* ... and register events *) + List.iter check_and_register (List.flatten (List.map fst cond_targets)) + + + let clean ~ctxt pkg extra_args = + run_clean ~ctxt extra_args; + List.iter + (function + | Library (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name + | Executable (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name; + BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name + | _ -> + ()) + pkg.sections + + +end + +module OCamlbuildDocPlugin = struct +(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) + + + (* Create documentation using ocamlbuild .odocl files + @author Sylvain Le Gall + *) + + + open OASISTypes + open OASISGettext + open OCamlbuildCommon + + + type run_t = + { + extra_args: string list; + run_path: unix_filename; + } + + + let doc_build ~ctxt run _ (cs, _) argv = + let index_html = + OASISUnixPath.make + [ + run.run_path; + cs.cs_name^".docdir"; + "index.html"; + ] + in + let tgt_dir = + OASISHostPath.make + [ + build_dir argv; + OASISHostPath.of_unix run.run_path; + cs.cs_name^".docdir"; + ] + in + run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv; + List.iter + (fun glb -> + match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with + | (_ :: _) as filenames -> + BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames] + | [] -> ()) + ["*.html"; "*.css"] + + + let doc_clean ~ctxt _ _ (cs, _) argv = + run_clean ~ctxt argv; + BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name + + +end + + +# 6837 "setup.ml" +module CustomPlugin = struct +(* # 22 "src/plugins/custom/CustomPlugin.ml" *) + + + (** Generate custom configure/build/doc/test/install system + @author + *) + + + open BaseEnv + open OASISGettext + open OASISTypes + + type t = + { + cmd_main: command_line conditional; + cmd_clean: (command_line option) conditional; + cmd_distclean: (command_line option) conditional; + } + + + let run = BaseCustom.run + + + let main ~ctxt:_ t _ extra_args = + let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in + run cmd args extra_args + + + let clean ~ctxt:_ t _ extra_args = + match var_choose t.cmd_clean with + | Some (cmd, args) -> run cmd args extra_args + | _ -> () + + + let distclean ~ctxt:_ t _ extra_args = + match var_choose t.cmd_distclean with + | Some (cmd, args) -> run cmd args extra_args + | _ -> () + + + module Build = + struct + let main ~ctxt t pkg extra_args = + main ~ctxt t pkg extra_args; + List.iter + (fun sct -> + let evs = + match sct with + | Library (cs, bs, lib) when var_choose bs.bs_build -> + begin + let evs, _ = + BaseBuilt.of_library + OASISHostPath.of_unix + (cs, bs, lib) + in + evs + end + | Executable (cs, bs, exec) when var_choose bs.bs_build -> + begin + let evs, _, _ = + BaseBuilt.of_executable + OASISHostPath.of_unix + (cs, bs, exec) + in + evs + end + | _ -> + [] + in + List.iter + (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst) + evs) + pkg.sections + + let clean ~ctxt t pkg extra_args = + clean ~ctxt t pkg extra_args; + (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild + * considering moving this to BaseSetup? + *) + List.iter + (function + | Library (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name + | Executable (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name; + BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name + | _ -> + ()) + pkg.sections + + let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args + end + + + module Test = + struct + let main ~ctxt t pkg (cs, _) extra_args = + try + main ~ctxt t pkg extra_args; + 0.0 + with Failure s -> + BaseMessage.warning + (f_ "Test '%s' fails: %s") + cs.cs_name + s; + 1.0 + + let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args + + let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args + end + + + module Doc = + struct + let main ~ctxt t pkg (cs, _) extra_args = + main ~ctxt t pkg extra_args; + BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [] + + let clean ~ctxt t pkg (cs, _) extra_args = + clean ~ctxt t pkg extra_args; + BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name + + let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args + end + + +end + + +# 6969 "setup.ml" +open OASISTypes;; + +let setup_t = + { + BaseSetup.configure = InternalConfigurePlugin.configure; + build = OCamlbuildPlugin.build []; + test = + [ + ("main", + CustomPlugin.Test.main + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); + ("bench", + CustomPlugin.Test.main + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$speedtest", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }) + ]; + doc = + [ + ("api-cryptokit", + OCamlbuildDocPlugin.doc_build + {OCamlbuildDocPlugin.extra_args = []; run_path = "src/"}) + ]; + install = InternalInstallPlugin.install; + uninstall = InternalInstallPlugin.uninstall; + clean = [OCamlbuildPlugin.clean]; + clean_test = + [ + ("main", + CustomPlugin.Test.clean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); + ("bench", + CustomPlugin.Test.clean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$speedtest", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }) + ]; + clean_doc = + [ + ("api-cryptokit", + OCamlbuildDocPlugin.doc_clean + {OCamlbuildDocPlugin.extra_args = []; run_path = "src/"}) + ]; + distclean = []; + distclean_test = + [ + ("main", + CustomPlugin.Test.distclean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); + ("bench", + CustomPlugin.Test.distclean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$speedtest", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }) + ]; + distclean_doc = []; + package = + { + oasis_version = "0.3"; + ocaml_version = None; + version = "1.13"; + license = + OASISLicense.DEP5License + (OASISLicense.DEP5Unit + { + OASISLicense.license = "LGPL"; + excption = Some "OCaml linking"; + version = OASISLicense.Version "2" + }); + findlib_version = None; + alpha_features = []; + beta_features = []; + name = "cryptokit"; + license_file = None; + copyrights = []; + maintainers = []; + authors = ["Xavier Leroy"]; + homepage = None; + bugreports = None; + synopsis = "Cryptographic primitives"; + description = + Some + [ + OASISText.Para + "This library provides a variety of cryptographic primitives that can be used to implement cryptographic protocols in security-sensitive applications. The primitives provided include:"; + OASISText.Para + "- Symmetric-key ciphers: AES, Chacha20, Blowfish, DES, Triple-DES, ARCfour,"; + OASISText.Verbatim + " in ECB, CBC, CFB, OFB and counter modes."; + OASISText.Para + "- Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. - Hash functions and MACs: SHA-1, SHA-2, SHA-3, RIPEMD160, MD5,"; + OASISText.Verbatim " and MACs based on AES and DES."; + OASISText.Para + "- Random number generation. - Encodings and compression: base 64, hexadecimal, Zlib compression."; + OASISText.Para + "Additional ciphers and hashes can easily be used in conjunction with the library. In particular, basic mechanisms such as chaining modes, output buffering, and padding are provided by generic classes that can easily be composed with user-provided ciphers. More generally, the library promotes a \"Lego\"-like style of constructing and composing transformations over character streams." + ]; + tags = []; + categories = []; + files_ab = []; + sections = + [ + Flag + ({ + cs_name = "zlib"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + flag_description = Some "Enable ZLib"; + flag_default = + [ + (OASISExpr.EBool true, false); + (OASISExpr.ENot + (OASISExpr.ETest ("os_type", "Win32")), + true) + ] + }); + Flag + ({ + cs_name = "hardwaresupport"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + flag_description = + Some + "Enable hardware support for AES and GCM (needs GCC or Clang)"; + flag_default = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EAnd + (OASISExpr.EOr + (OASISExpr.ETest ("architecture", "amd64"), + OASISExpr.ETest ("architecture", "i386")), + OASISExpr.ENot + (OASISExpr.ETest ("os_type", "Win32"))), + true) + ] + }); + Library + ({ + cs_name = "cryptokit"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, true)]; + bs_path = "src"; + bs_compiled_object = Best; + bs_build_depends = + [ + FindlibPackage ("unix", None); + FindlibPackage ("zarith", None) + ]; + bs_build_tools = + [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = + [ + "aesni.c"; + "aesni.h"; + "arcfour.c"; + "arcfour.h"; + "stubs-arcfour.c"; + "blowfish.c"; + "blowfish.h"; + "stubs-blowfish.c"; + "d3des.c"; + "d3des.h"; + "stubs-des.c"; + "rijndael-alg-fst.c"; + "rijndael-alg-fst.h"; + "ripemd160.c"; + "ripemd160.h"; + "stubs-ripemd160.c"; + "sha1.c"; + "sha1.h"; + "stubs-sha1.c"; + "sha256.c"; + "sha256.h"; + "stubs-sha256.c"; + "sha512.c"; + "sha512.h"; + "stubs-sha512.c"; + "stubs-aes.c"; + "stubs-md5.c"; + "stubs-misc.c"; + "stubs-rng.c"; + "stubs-zlib.c"; + "keccak.h"; + "keccak.c"; + "stubs-sha3.c"; + "chacha20.h"; + "chacha20.c"; + "stubs-chacha20.c" + ]; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = + [ + (OASISExpr.EBool true, []); + (OASISExpr.EFlag "hardwaresupport", ["-maes"]); + (OASISExpr.EFlag "zlib", ["-DHAVE_ZLIB"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EFlag "hardwaresupport"), + ["-DHAVE_ZLIB"; "-maes"]) + ]; + bs_cclib = + [ + (OASISExpr.EBool true, []); + (OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64"))), + ["-ladvapi32"]); + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + ["advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + ["advapi32.lib"; "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + ["zlib.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + ["zlib.lib"; "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + ["zlib.lib"; "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + ["zlib.lib"; "advapi32.lib"; "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + ["-lz"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + ["-lz"; "-ladvapi32"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + ["-lz"; "advapi32.lib"]); + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EAnd + (OASISExpr.EFlag "zlib", + OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest + ("system", "win32"), + OASISExpr.ETest + ("system", "win64")))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EAnd + (OASISExpr.ENot + (OASISExpr.EOr + (OASISExpr.ETest ("system", "win32"), + OASISExpr.ETest ("system", "win64"))), + OASISExpr.EOr + (OASISExpr.ETest ("system", "mingw"), + OASISExpr.ETest ("system", "mingw64")))), + ["-lz"; "advapi32.lib"; "-ladvapi32"]) + ]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + { + lib_modules = ["CryptokitBignum"; "Cryptokit"]; + lib_pack = false; + lib_internal_modules = []; + lib_findlib_parent = None; + lib_findlib_name = None; + lib_findlib_directory = None; + lib_findlib_containers = [] + }); + Executable + ({ + cs_name = "test"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "tests", true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "test"; + bs_compiled_object = Native; + bs_build_depends = [InternalLibrary "cryptokit"]; + bs_build_tools = + [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = []; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = false; exec_main_is = "test.ml"}); + Executable + ({ + cs_name = "prngtest"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "tests", true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "test"; + bs_compiled_object = Native; + bs_build_depends = [InternalLibrary "cryptokit"]; + bs_build_tools = + [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = []; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = false; exec_main_is = "prngtest.ml"}); + Test + ({ + cs_name = "main"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + test_type = (`Test, "custom", Some "0.4"); + test_command = [(OASISExpr.EBool true, ("$test", []))]; + test_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + test_working_directory = None; + test_run = + [ + (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); + (OASISExpr.EFlag "tests", true) + ]; + test_tools = + [ + ExternalTool "ocamlbuild"; + ExternalTool "ocamldoc"; + InternalExecutable "test" + ] + }); + Flag + ({ + cs_name = "bench"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + flag_description = Some "Build and run benchmark"; + flag_default = [(OASISExpr.EBool true, false)] + }); + Executable + ({ + cs_name = "speedtest"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "bench", true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "test"; + bs_compiled_object = Native; + bs_build_depends = [InternalLibrary "cryptokit"]; + bs_build_tools = + [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = []; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = false; exec_main_is = "speedtest.ml"}); + Test + ({ + cs_name = "bench"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + test_type = (`Test, "custom", Some "0.4"); + test_command = + [(OASISExpr.EBool true, ("$speedtest", []))]; + test_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + test_working_directory = None; + test_run = + [ + (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); + (OASISExpr.EFlag "tests", false); + (OASISExpr.EAnd + (OASISExpr.EFlag "tests", + OASISExpr.EFlag "bench"), + true) + ]; + test_tools = + [ + ExternalTool "ocamlbuild"; + ExternalTool "ocamldoc"; + InternalExecutable "speedtest" + ] + }); + Doc + ({ + cs_name = "api-cryptokit"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + doc_type = (`Doc, "ocamlbuild", Some "0.3"); + doc_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + doc_build = + [ + (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); + (OASISExpr.EFlag "docs", true) + ]; + doc_install = [(OASISExpr.EBool true, true)]; + doc_install_dir = "$htmldir/cryptokit"; + doc_title = "API reference for Cryptokit"; + doc_authors = []; + doc_abstract = None; + doc_format = OtherDoc; + doc_data_files = []; + doc_build_tools = + [ + ExternalTool "ocamlbuild"; + ExternalTool "ocamldoc"; + ExternalTool "ocamldoc" + ] + }); + SrcRepo + ({ + cs_name = "head"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + src_repo_type = Git; + src_repo_location = + "https://github.com/xavierleroy/cryptokit"; + src_repo_browser = + Some "https://github.com/xavierleroy/cryptokit"; + src_repo_module = None; + src_repo_branch = None; + src_repo_tag = None; + src_repo_subdir = None + }); + SrcRepo + ({ + cs_name = "this"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + src_repo_type = Git; + src_repo_location = + "https://github.com/xavierleroy/cryptokit/releases/tag/release113"; + src_repo_browser = + Some + "https://github.com/xavierleroy/cryptokit/releases/tag/release113"; + src_repo_module = None; + src_repo_branch = None; + src_repo_tag = None; + src_repo_subdir = None + }) + ]; + disable_oasis_section = []; + conf_type = (`Configure, "internal", Some "0.4"); + conf_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + build_type = (`Build, "ocamlbuild", Some "0.4"); + build_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + install_type = (`Install, "internal", Some "0.4"); + install_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + uninstall_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + clean_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + distclean_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + plugins = + [ + (`Extra, "META", Some "0.3"); + (`Extra, "DevFiles", Some "0.3"); + (`Extra, "StdFiles", Some "0.3") + ]; + schema_data = PropList.Data.create (); + plugin_data = [] + }; + oasis_fn = Some "_oasis"; + oasis_version = "0.4.10"; + oasis_digest = + Some "\212\1377\231\145\135\191\200=\177\220\134\230\157\203\214"; + oasis_exec = None; + oasis_setup_args = []; + setup_update = false + };; + +let setup () = BaseSetup.setup setup_t;; + +# 8072 "setup.ml" +let setup_t = BaseCompat.Compat_0_3.adapt_setup_t setup_t +open BaseCompat.Compat_0_3 +(* OASIS_STOP *) +let () = setup ();; diff --git a/src/META b/src/META new file mode 100644 index 0000000..e4dc5ff --- /dev/null +++ b/src/META @@ -0,0 +1,12 @@ +# OASIS_START +# DO NOT EDIT (digest: 7cb4f4b2e0b5e77bb7a0ee261fd36f90) +version = "1.13" +description = "Cryptographic primitives" +requires = "unix zarith" +archive(byte) = "cryptokit.cma" +archive(byte, plugin) = "cryptokit.cma" +archive(native) = "cryptokit.cmxa" +archive(native, plugin) = "cryptokit.cmxs" +exists_if = "cryptokit.cma" +# OASIS_STOP + diff --git a/src/aesni.c b/src/aesni.c new file mode 100644 index 0000000..4013657 --- /dev/null +++ b/src/aesni.c @@ -0,0 +1,329 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Paris */ +/* */ +/* Copyright 2016 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* Hardware-accelerated implementation of AES */ + +#include "stdlib.h" +#include "aesni.h" + +#ifdef __AES__ +#include +#include +#include + +int aesni_available = -1; + +int aesni_check_available(void) +{ + unsigned int eax, ebx, ecx, edx; + if(__get_cpuid(1, &eax, &ebx, &ecx, &edx)) { + aesni_available = (ecx & 0x2000000) != 0; + } else { + aesni_available = 0; + } + return aesni_available; +} + +static inline __m128i aesni_128_assist(__m128i t1, __m128i t2) +{ + __m128i t3; + t2 = _mm_shuffle_epi32 (t2 ,0xff); + t3 = _mm_slli_si128 (t1, 0x4); + t1 = _mm_xor_si128 (t1, t3); + t3 = _mm_slli_si128 (t3, 0x4); + t1 = _mm_xor_si128 (t1, t3); + t3 = _mm_slli_si128 (t3, 0x4); + t1 = _mm_xor_si128 (t1, t3); + t1 = _mm_xor_si128 (t1, t2); + return t1; +} + +static inline void aesni_192_assist(__m128i * t1, __m128i * t2, __m128i * t3) +{ + __m128i t4; + *t2 = _mm_shuffle_epi32 (*t2, 0x55); + t4 = _mm_slli_si128 (*t1, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + *t1 = _mm_xor_si128 (*t1, *t2); + *t2 = _mm_shuffle_epi32(*t1, 0xff); + t4 = _mm_slli_si128 (*t3, 0x4); + *t3 = _mm_xor_si128 (*t3, t4); + *t3 = _mm_xor_si128 (*t3, *t2); +} + +static inline void aesni_256_assist_1(__m128i * t1, __m128i * t2) +{ + __m128i t4; + *t2 = _mm_shuffle_epi32(*t2, 0xff); + t4 = _mm_slli_si128 (*t1, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t1 = _mm_xor_si128 (*t1, t4); + *t1 = _mm_xor_si128 (*t1, *t2); +} + +static inline void aesni_256_assist_2(__m128i * t1, __m128i * t3) +{ + __m128i t2, t4; + t4 = _mm_aeskeygenassist_si128 (*t1, 0x0); + t2 = _mm_shuffle_epi32(t4, 0xaa); + t4 = _mm_slli_si128 (*t3, 0x4); + *t3 = _mm_xor_si128 (*t3, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t3 = _mm_xor_si128 (*t3, t4); + t4 = _mm_slli_si128 (t4, 0x4); + *t3 = _mm_xor_si128 (*t3, t4); + *t3 = _mm_xor_si128 (*t3, t2); +} + +static int aesni_key_expansion(const unsigned char * userkey, + int keylength, + __m128i * key_schedule) +{ + __m128i t1, t2, t3; + switch (keylength) { + case 128: + t1 = _mm_loadu_si128((__m128i*)userkey); + key_schedule[0] = t1; + t2 = _mm_aeskeygenassist_si128 (t1 ,0x1); + t1 = aesni_128_assist(t1, t2); + key_schedule[1] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x2); + t1 = aesni_128_assist(t1, t2); + key_schedule[2] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x4); + t1 = aesni_128_assist(t1, t2); + key_schedule[3] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x8); + t1 = aesni_128_assist(t1, t2); + key_schedule[4] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x10); + t1 = aesni_128_assist(t1, t2); + key_schedule[5] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x20); + t1 = aesni_128_assist(t1, t2); + key_schedule[6] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x40); + t1 = aesni_128_assist(t1, t2); + key_schedule[7] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x80); + t1 = aesni_128_assist(t1, t2); + key_schedule[8] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x1b); + t1 = aesni_128_assist(t1, t2); + key_schedule[9] = t1; + t2 = _mm_aeskeygenassist_si128 (t1,0x36); + t1 = aesni_128_assist(t1, t2); + key_schedule[10] = t1; + return 10; + case 192: + t1 = _mm_loadu_si128((__m128i*)userkey); + t3 = _mm_loadu_si128((__m128i*)(userkey+16)); + key_schedule[0] = t1; + key_schedule[1] = t3; + t2 = _mm_aeskeygenassist_si128 (t3,0x1); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[1] = (__m128i)_mm_shuffle_pd((__m128d)key_schedule[1], + (__m128d)t1,0); + key_schedule[2] = (__m128i)_mm_shuffle_pd((__m128d)t1,(__m128d)t3,1); + t2 = _mm_aeskeygenassist_si128 (t3,0x2); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[3] = t1; + key_schedule[4] = t3; + t2 = _mm_aeskeygenassist_si128 (t3,0x4); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[4] = (__m128i)_mm_shuffle_pd((__m128d)key_schedule[4], + (__m128d)t1,0); + key_schedule[5] = (__m128i)_mm_shuffle_pd((__m128d)t1,(__m128d)t3,1); + t2 = _mm_aeskeygenassist_si128 (t3,0x8); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[6] = t1; + key_schedule[7] = t3; + t2 = _mm_aeskeygenassist_si128 (t3,0x10); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[7] = (__m128i)_mm_shuffle_pd((__m128d)key_schedule[7], + (__m128d)t1,0); + key_schedule[8] = (__m128i)_mm_shuffle_pd((__m128d)t1,(__m128d)t3,1); + t2 = _mm_aeskeygenassist_si128 (t3,0x20); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[9] = t1; + key_schedule[10] = t3; + t2 = _mm_aeskeygenassist_si128 (t3,0x40); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[10] = (__m128i)_mm_shuffle_pd((__m128d)key_schedule[10], + (__m128d)t1,0); + key_schedule[11] = (__m128i)_mm_shuffle_pd((__m128d)t1,(__m128d)t3,1); + t2 = _mm_aeskeygenassist_si128 (t3,0x80); + aesni_192_assist(&t1, &t2, &t3); + key_schedule[12] = t1; + return 12; + case 256: + t1 = _mm_loadu_si128((__m128i*)userkey); + t3 = _mm_loadu_si128((__m128i*)(userkey+16)); + key_schedule[0] = t1; + key_schedule[1] = t3; + t2 = _mm_aeskeygenassist_si128 (t3,0x01); + aesni_256_assist_1(&t1, &t2); + key_schedule[2] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[3] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x02); + aesni_256_assist_1(&t1, &t2); + key_schedule[4] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[5] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x04); + aesni_256_assist_1(&t1, &t2); + key_schedule[6] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[7] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x08); + aesni_256_assist_1(&t1, &t2); + key_schedule[8] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[9] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x10); + aesni_256_assist_1(&t1, &t2); + key_schedule[10] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[11] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x20); + aesni_256_assist_1(&t1, &t2); + key_schedule[12] = t1; + aesni_256_assist_2(&t1, &t3); + key_schedule[13] = t3; + t2 = _mm_aeskeygenassist_si128(t3,0x40); + aesni_256_assist_1(&t1, &t2); + key_schedule[14] = t1; + return 14; + default: + abort(); + } +} + +static void * align16(void * p) +{ + uintptr_t n = (uintptr_t) p; + n = (n + 15) & -16; + return (void *) n; +} + +int aesniKeySetupEnc(unsigned char * ckey, + const unsigned char * key, + int keylength) +{ + __m128i unaligned_key_schedule[15 + 1]; /* + 1 to leave space for alignment */ + __m128i *key_schedule = align16(unaligned_key_schedule); + int nrounds, i; + + nrounds = aesni_key_expansion(key, keylength, key_schedule); + for (i = 0; i <= nrounds; i++) { + _mm_storeu_si128((__m128i*) ckey + i, key_schedule[i]); + } + return nrounds; +} + +int aesniKeySetupDec(unsigned char * ckey, + const unsigned char * key, + int keylength) +{ + __m128i unaligned_key_schedule[15 + 1]; /* + 1 to leave space for alignment */ + __m128i *key_schedule = align16(unaligned_key_schedule); + int nrounds, i; + + nrounds = aesni_key_expansion(key, keylength, key_schedule); + _mm_storeu_si128((__m128i*) ckey + 0, key_schedule[nrounds]); + for (i = 1; i < nrounds; i++) { + _mm_storeu_si128((__m128i*) ckey + i, + _mm_aesimc_si128(key_schedule[nrounds - i])); + } + _mm_storeu_si128((__m128i*) ckey + nrounds, key_schedule[0]); + return nrounds; +} + +void aesniEncrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out) +{ + __m128i t, k; + int j; + + t = _mm_loadu_si128 ((__m128i*) in); + k = _mm_loadu_si128 ((__m128i*) key + 0); + t = _mm_xor_si128 (t, k); + j = 1; + do { + k = _mm_loadu_si128 ((__m128i*) key + j); + t = _mm_aesenc_si128 (t, k); + j++; + } while (j < nrounds); + k = _mm_loadu_si128 ((__m128i*) key + j); + t = _mm_aesenclast_si128 (t, k); + _mm_storeu_si128 ((__m128i*) out, t); +} + +void aesniDecrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out) +{ + __m128i t, k; + int j; + + t = _mm_loadu_si128 ((__m128i*) in); + k = _mm_loadu_si128 ((__m128i*) key + 0); + t = _mm_xor_si128 (t, k); + j = 1; + do { + k = _mm_loadu_si128 ((__m128i*) key + j); + t = _mm_aesdec_si128 (t, k); + j++; + } while (j < nrounds); + k = _mm_loadu_si128 ((__m128i*) key + j); + t = _mm_aesdeclast_si128 (t, k); + _mm_storeu_si128 ((__m128i*) out, t); +} + +#else + +int aesni_available = 0; + +int aesni_check_available(void) { return 0; } + +int aesniKeySetupEnc(unsigned char * ckey, + const unsigned char * key, + int keylength) +{ abort(); } + +int aesniKeySetupDec(unsigned char * ckey, + const unsigned char * key, + int keylength) +{ abort(); } + +void aesniEncrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out) +{ abort(); } + +void aesniDecrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out) +{ abort(); } + +#endif + diff --git a/src/aesni.h b/src/aesni.h new file mode 100644 index 0000000..016fb0e --- /dev/null +++ b/src/aesni.h @@ -0,0 +1,40 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Paris */ +/* */ +/* Copyright 2016 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* Hardware-accelerated implementation of AES */ + +extern int aesni_available; +/* -1: unknown, call aesni_check_available() to determine + 0: not available + 1: available +*/ + +extern int aesni_check_available(void); + +extern int aesniKeySetupEnc(unsigned char * ckey, + const unsigned char * key, + int keylength); + +extern int aesniKeySetupDec(unsigned char * ckey, + const unsigned char * key, + int keylength); + +extern void aesniEncrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out); + +extern void aesniDecrypt(const unsigned char * key, int nrounds, + const unsigned char * in, + unsigned char * out); + + diff --git a/src/api-cryptokit.odocl b/src/api-cryptokit.odocl new file mode 100644 index 0000000..c8577fb --- /dev/null +++ b/src/api-cryptokit.odocl @@ -0,0 +1,5 @@ +# OASIS_START +# DO NOT EDIT (digest: f65b9dc92e3f638af8533b26ac90c400) +CryptokitBignum +Cryptokit +# OASIS_STOP diff --git a/src/arcfour.c b/src/arcfour.c new file mode 100644 index 0000000..8388008 --- /dev/null +++ b/src/arcfour.c @@ -0,0 +1,59 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "arcfour.h" + +void arcfour_cook_key(struct arcfour_key * key, + unsigned char * key_data, + int key_data_len) +{ + unsigned char * s; + int i; + unsigned char t, index1, index2; + + s = &key->state[0]; + for (i = 0; i < 256; i++) s[i] = i; + key->x = 0; + key->y = 0; + index1 = 0; + index2 = 0; + for (i = 0; i < 256; i++) { + index2 = key_data[index1] + s[i] + index2; + t = s[i]; s[i] = s[index2]; s[index2] = t; + index1++; + if (index1 >= key_data_len) index1 = 0; + } +} + +void arcfour_encrypt(struct arcfour_key * key, + char * src, char * dst, long len) +{ + int x, y, kx, ky; + + x = key->x; + y = key->y; + for (/*nothing*/; len > 0; len--) { + x = (x + 1) & 0xFF; + kx = key->state[x]; + y = (kx + y) & 0xFF; + ky = key->state[y]; + key->state[x] = ky; key->state[y] = kx; + *dst++ = *src++ ^ key->state[(kx + ky) & 0xFF]; + } + key->x = x; + key->y = y; +} + + diff --git a/src/arcfour.h b/src/arcfour.h new file mode 100644 index 0000000..90bfb85 --- /dev/null +++ b/src/arcfour.h @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +struct arcfour_key +{ + unsigned char state[256]; + unsigned char x, y; +}; + +extern void arcfour_cook_key(struct arcfour_key * key, + unsigned char * key_data, + int key_data_len); + +extern void arcfour_encrypt(struct arcfour_key * key, + char * src, char * dst, long len); + diff --git a/src/blowfish.c b/src/blowfish.c new file mode 100644 index 0000000..a069b34 --- /dev/null +++ b/src/blowfish.c @@ -0,0 +1,512 @@ +/* +blowfish.c: C implementation of the Blowfish algorithm. + +Copyright (C) 1997 by Paul Kocher + +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.1 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + + + +COMMENTS ON USING THIS CODE: + +Normal usage is as follows: + [1] Allocate a BLOWFISH_CTX. (It may be too big for the stack.) + [2] Call Blowfish_Init with a pointer to your BLOWFISH_CTX, a pointer to + the key, and the number of bytes in the key. + [3] To encrypt a 64-bit block, call Blowfish_Encrypt with a pointer to + BLOWFISH_CTX, a pointer to the 32-bit left half of the plaintext + and a pointer to the 32-bit right half. The plaintext will be + overwritten with the ciphertext. + [4] Decryption is the same as encryption except that the plaintext and + ciphertext are reversed. + +Warning #1: The code does not check key lengths. (Caveat encryptor.) +Warning #2: Beware that Blowfish keys repeat such that "ab" = "abab". +Warning #3: It is normally a good idea to zeroize the BLOWFISH_CTX before + freeing it. +Warning #4: Endianness conversions are the responsibility of the caller. + (To encrypt bytes on a little-endian platforms, you'll probably want + to swap bytes around instead of just casting.) +Warning #5: Make sure to use a reasonable mode of operation for your + application. (If you don't know what CBC mode is, see Warning #7.) +Warning #6: This code is susceptible to timing attacks. +Warning #7: Security engineering is risky and non-intuitive. Have someone + check your work. If you don't know what you are doing, get help. + + +This is code is fast enough for most applications, but is not optimized for +speed. + +If you require this code under a license other than LGPL, please ask. (I +can be located using your favorite search engine.) Unfortunately, I do not +have time to provide unpaid support for everyone who uses this code. + + -- Paul Kocher + +Modifications by Xavier.Leroy@inria.fr, 2005. (Marked "XL".) +- Speed improvements +- Endianness handling. + +*/ + +#include +#include "blowfish.h" + +#define N 16 + +static const u32 ORIG_P[16 + 2] = { + 0x243F6A88L, 0x85A308D3L, 0x13198A2EL, 0x03707344L, + 0xA4093822L, 0x299F31D0L, 0x082EFA98L, 0xEC4E6C89L, + 0x452821E6L, 0x38D01377L, 0xBE5466CFL, 0x34E90C6CL, + 0xC0AC29B7L, 0xC97C50DDL, 0x3F84D5B5L, 0xB5470917L, + 0x9216D5D9L, 0x8979FB1BL +}; + +static const u32 ORIG_S[4][256] = { + { 0xD1310BA6L, 0x98DFB5ACL, 0x2FFD72DBL, 0xD01ADFB7L, + 0xB8E1AFEDL, 0x6A267E96L, 0xBA7C9045L, 0xF12C7F99L, + 0x24A19947L, 0xB3916CF7L, 0x0801F2E2L, 0x858EFC16L, + 0x636920D8L, 0x71574E69L, 0xA458FEA3L, 0xF4933D7EL, + 0x0D95748FL, 0x728EB658L, 0x718BCD58L, 0x82154AEEL, + 0x7B54A41DL, 0xC25A59B5L, 0x9C30D539L, 0x2AF26013L, + 0xC5D1B023L, 0x286085F0L, 0xCA417918L, 0xB8DB38EFL, + 0x8E79DCB0L, 0x603A180EL, 0x6C9E0E8BL, 0xB01E8A3EL, + 0xD71577C1L, 0xBD314B27L, 0x78AF2FDAL, 0x55605C60L, + 0xE65525F3L, 0xAA55AB94L, 0x57489862L, 0x63E81440L, + 0x55CA396AL, 0x2AAB10B6L, 0xB4CC5C34L, 0x1141E8CEL, + 0xA15486AFL, 0x7C72E993L, 0xB3EE1411L, 0x636FBC2AL, + 0x2BA9C55DL, 0x741831F6L, 0xCE5C3E16L, 0x9B87931EL, + 0xAFD6BA33L, 0x6C24CF5CL, 0x7A325381L, 0x28958677L, + 0x3B8F4898L, 0x6B4BB9AFL, 0xC4BFE81BL, 0x66282193L, + 0x61D809CCL, 0xFB21A991L, 0x487CAC60L, 0x5DEC8032L, + 0xEF845D5DL, 0xE98575B1L, 0xDC262302L, 0xEB651B88L, + 0x23893E81L, 0xD396ACC5L, 0x0F6D6FF3L, 0x83F44239L, + 0x2E0B4482L, 0xA4842004L, 0x69C8F04AL, 0x9E1F9B5EL, + 0x21C66842L, 0xF6E96C9AL, 0x670C9C61L, 0xABD388F0L, + 0x6A51A0D2L, 0xD8542F68L, 0x960FA728L, 0xAB5133A3L, + 0x6EEF0B6CL, 0x137A3BE4L, 0xBA3BF050L, 0x7EFB2A98L, + 0xA1F1651DL, 0x39AF0176L, 0x66CA593EL, 0x82430E88L, + 0x8CEE8619L, 0x456F9FB4L, 0x7D84A5C3L, 0x3B8B5EBEL, + 0xE06F75D8L, 0x85C12073L, 0x401A449FL, 0x56C16AA6L, + 0x4ED3AA62L, 0x363F7706L, 0x1BFEDF72L, 0x429B023DL, + 0x37D0D724L, 0xD00A1248L, 0xDB0FEAD3L, 0x49F1C09BL, + 0x075372C9L, 0x80991B7BL, 0x25D479D8L, 0xF6E8DEF7L, + 0xE3FE501AL, 0xB6794C3BL, 0x976CE0BDL, 0x04C006BAL, + 0xC1A94FB6L, 0x409F60C4L, 0x5E5C9EC2L, 0x196A2463L, + 0x68FB6FAFL, 0x3E6C53B5L, 0x1339B2EBL, 0x3B52EC6FL, + 0x6DFC511FL, 0x9B30952CL, 0xCC814544L, 0xAF5EBD09L, + 0xBEE3D004L, 0xDE334AFDL, 0x660F2807L, 0x192E4BB3L, + 0xC0CBA857L, 0x45C8740FL, 0xD20B5F39L, 0xB9D3FBDBL, + 0x5579C0BDL, 0x1A60320AL, 0xD6A100C6L, 0x402C7279L, + 0x679F25FEL, 0xFB1FA3CCL, 0x8EA5E9F8L, 0xDB3222F8L, + 0x3C7516DFL, 0xFD616B15L, 0x2F501EC8L, 0xAD0552ABL, + 0x323DB5FAL, 0xFD238760L, 0x53317B48L, 0x3E00DF82L, + 0x9E5C57BBL, 0xCA6F8CA0L, 0x1A87562EL, 0xDF1769DBL, + 0xD542A8F6L, 0x287EFFC3L, 0xAC6732C6L, 0x8C4F5573L, + 0x695B27B0L, 0xBBCA58C8L, 0xE1FFA35DL, 0xB8F011A0L, + 0x10FA3D98L, 0xFD2183B8L, 0x4AFCB56CL, 0x2DD1D35BL, + 0x9A53E479L, 0xB6F84565L, 0xD28E49BCL, 0x4BFB9790L, + 0xE1DDF2DAL, 0xA4CB7E33L, 0x62FB1341L, 0xCEE4C6E8L, + 0xEF20CADAL, 0x36774C01L, 0xD07E9EFEL, 0x2BF11FB4L, + 0x95DBDA4DL, 0xAE909198L, 0xEAAD8E71L, 0x6B93D5A0L, + 0xD08ED1D0L, 0xAFC725E0L, 0x8E3C5B2FL, 0x8E7594B7L, + 0x8FF6E2FBL, 0xF2122B64L, 0x8888B812L, 0x900DF01CL, + 0x4FAD5EA0L, 0x688FC31CL, 0xD1CFF191L, 0xB3A8C1ADL, + 0x2F2F2218L, 0xBE0E1777L, 0xEA752DFEL, 0x8B021FA1L, + 0xE5A0CC0FL, 0xB56F74E8L, 0x18ACF3D6L, 0xCE89E299L, + 0xB4A84FE0L, 0xFD13E0B7L, 0x7CC43B81L, 0xD2ADA8D9L, + 0x165FA266L, 0x80957705L, 0x93CC7314L, 0x211A1477L, + 0xE6AD2065L, 0x77B5FA86L, 0xC75442F5L, 0xFB9D35CFL, + 0xEBCDAF0CL, 0x7B3E89A0L, 0xD6411BD3L, 0xAE1E7E49L, + 0x00250E2DL, 0x2071B35EL, 0x226800BBL, 0x57B8E0AFL, + 0x2464369BL, 0xF009B91EL, 0x5563911DL, 0x59DFA6AAL, + 0x78C14389L, 0xD95A537FL, 0x207D5BA2L, 0x02E5B9C5L, + 0x83260376L, 0x6295CFA9L, 0x11C81968L, 0x4E734A41L, + 0xB3472DCAL, 0x7B14A94AL, 0x1B510052L, 0x9A532915L, + 0xD60F573FL, 0xBC9BC6E4L, 0x2B60A476L, 0x81E67400L, + 0x08BA6FB5L, 0x571BE91FL, 0xF296EC6BL, 0x2A0DD915L, + 0xB6636521L, 0xE7B9F9B6L, 0xFF34052EL, 0xC5855664L, + 0x53B02D5DL, 0xA99F8FA1L, 0x08BA4799L, 0x6E85076AL }, + { 0x4B7A70E9L, 0xB5B32944L, 0xDB75092EL, 0xC4192623L, + 0xAD6EA6B0L, 0x49A7DF7DL, 0x9CEE60B8L, 0x8FEDB266L, + 0xECAA8C71L, 0x699A17FFL, 0x5664526CL, 0xC2B19EE1L, + 0x193602A5L, 0x75094C29L, 0xA0591340L, 0xE4183A3EL, + 0x3F54989AL, 0x5B429D65L, 0x6B8FE4D6L, 0x99F73FD6L, + 0xA1D29C07L, 0xEFE830F5L, 0x4D2D38E6L, 0xF0255DC1L, + 0x4CDD2086L, 0x8470EB26L, 0x6382E9C6L, 0x021ECC5EL, + 0x09686B3FL, 0x3EBAEFC9L, 0x3C971814L, 0x6B6A70A1L, + 0x687F3584L, 0x52A0E286L, 0xB79C5305L, 0xAA500737L, + 0x3E07841CL, 0x7FDEAE5CL, 0x8E7D44ECL, 0x5716F2B8L, + 0xB03ADA37L, 0xF0500C0DL, 0xF01C1F04L, 0x0200B3FFL, + 0xAE0CF51AL, 0x3CB574B2L, 0x25837A58L, 0xDC0921BDL, + 0xD19113F9L, 0x7CA92FF6L, 0x94324773L, 0x22F54701L, + 0x3AE5E581L, 0x37C2DADCL, 0xC8B57634L, 0x9AF3DDA7L, + 0xA9446146L, 0x0FD0030EL, 0xECC8C73EL, 0xA4751E41L, + 0xE238CD99L, 0x3BEA0E2FL, 0x3280BBA1L, 0x183EB331L, + 0x4E548B38L, 0x4F6DB908L, 0x6F420D03L, 0xF60A04BFL, + 0x2CB81290L, 0x24977C79L, 0x5679B072L, 0xBCAF89AFL, + 0xDE9A771FL, 0xD9930810L, 0xB38BAE12L, 0xDCCF3F2EL, + 0x5512721FL, 0x2E6B7124L, 0x501ADDE6L, 0x9F84CD87L, + 0x7A584718L, 0x7408DA17L, 0xBC9F9ABCL, 0xE94B7D8CL, + 0xEC7AEC3AL, 0xDB851DFAL, 0x63094366L, 0xC464C3D2L, + 0xEF1C1847L, 0x3215D908L, 0xDD433B37L, 0x24C2BA16L, + 0x12A14D43L, 0x2A65C451L, 0x50940002L, 0x133AE4DDL, + 0x71DFF89EL, 0x10314E55L, 0x81AC77D6L, 0x5F11199BL, + 0x043556F1L, 0xD7A3C76BL, 0x3C11183BL, 0x5924A509L, + 0xF28FE6EDL, 0x97F1FBFAL, 0x9EBABF2CL, 0x1E153C6EL, + 0x86E34570L, 0xEAE96FB1L, 0x860E5E0AL, 0x5A3E2AB3L, + 0x771FE71CL, 0x4E3D06FAL, 0x2965DCB9L, 0x99E71D0FL, + 0x803E89D6L, 0x5266C825L, 0x2E4CC978L, 0x9C10B36AL, + 0xC6150EBAL, 0x94E2EA78L, 0xA5FC3C53L, 0x1E0A2DF4L, + 0xF2F74EA7L, 0x361D2B3DL, 0x1939260FL, 0x19C27960L, + 0x5223A708L, 0xF71312B6L, 0xEBADFE6EL, 0xEAC31F66L, + 0xE3BC4595L, 0xA67BC883L, 0xB17F37D1L, 0x018CFF28L, + 0xC332DDEFL, 0xBE6C5AA5L, 0x65582185L, 0x68AB9802L, + 0xEECEA50FL, 0xDB2F953BL, 0x2AEF7DADL, 0x5B6E2F84L, + 0x1521B628L, 0x29076170L, 0xECDD4775L, 0x619F1510L, + 0x13CCA830L, 0xEB61BD96L, 0x0334FE1EL, 0xAA0363CFL, + 0xB5735C90L, 0x4C70A239L, 0xD59E9E0BL, 0xCBAADE14L, + 0xEECC86BCL, 0x60622CA7L, 0x9CAB5CABL, 0xB2F3846EL, + 0x648B1EAFL, 0x19BDF0CAL, 0xA02369B9L, 0x655ABB50L, + 0x40685A32L, 0x3C2AB4B3L, 0x319EE9D5L, 0xC021B8F7L, + 0x9B540B19L, 0x875FA099L, 0x95F7997EL, 0x623D7DA8L, + 0xF837889AL, 0x97E32D77L, 0x11ED935FL, 0x16681281L, + 0x0E358829L, 0xC7E61FD6L, 0x96DEDFA1L, 0x7858BA99L, + 0x57F584A5L, 0x1B227263L, 0x9B83C3FFL, 0x1AC24696L, + 0xCDB30AEBL, 0x532E3054L, 0x8FD948E4L, 0x6DBC3128L, + 0x58EBF2EFL, 0x34C6FFEAL, 0xFE28ED61L, 0xEE7C3C73L, + 0x5D4A14D9L, 0xE864B7E3L, 0x42105D14L, 0x203E13E0L, + 0x45EEE2B6L, 0xA3AAABEAL, 0xDB6C4F15L, 0xFACB4FD0L, + 0xC742F442L, 0xEF6ABBB5L, 0x654F3B1DL, 0x41CD2105L, + 0xD81E799EL, 0x86854DC7L, 0xE44B476AL, 0x3D816250L, + 0xCF62A1F2L, 0x5B8D2646L, 0xFC8883A0L, 0xC1C7B6A3L, + 0x7F1524C3L, 0x69CB7492L, 0x47848A0BL, 0x5692B285L, + 0x095BBF00L, 0xAD19489DL, 0x1462B174L, 0x23820E00L, + 0x58428D2AL, 0x0C55F5EAL, 0x1DADF43EL, 0x233F7061L, + 0x3372F092L, 0x8D937E41L, 0xD65FECF1L, 0x6C223BDBL, + 0x7CDE3759L, 0xCBEE7460L, 0x4085F2A7L, 0xCE77326EL, + 0xA6078084L, 0x19F8509EL, 0xE8EFD855L, 0x61D99735L, + 0xA969A7AAL, 0xC50C06C2L, 0x5A04ABFCL, 0x800BCADCL, + 0x9E447A2EL, 0xC3453484L, 0xFDD56705L, 0x0E1E9EC9L, + 0xDB73DBD3L, 0x105588CDL, 0x675FDA79L, 0xE3674340L, + 0xC5C43465L, 0x713E38D8L, 0x3D28F89EL, 0xF16DFF20L, + 0x153E21E7L, 0x8FB03D4AL, 0xE6E39F2BL, 0xDB83ADF7L }, + { 0xE93D5A68L, 0x948140F7L, 0xF64C261CL, 0x94692934L, + 0x411520F7L, 0x7602D4F7L, 0xBCF46B2EL, 0xD4A20068L, + 0xD4082471L, 0x3320F46AL, 0x43B7D4B7L, 0x500061AFL, + 0x1E39F62EL, 0x97244546L, 0x14214F74L, 0xBF8B8840L, + 0x4D95FC1DL, 0x96B591AFL, 0x70F4DDD3L, 0x66A02F45L, + 0xBFBC09ECL, 0x03BD9785L, 0x7FAC6DD0L, 0x31CB8504L, + 0x96EB27B3L, 0x55FD3941L, 0xDA2547E6L, 0xABCA0A9AL, + 0x28507825L, 0x530429F4L, 0x0A2C86DAL, 0xE9B66DFBL, + 0x68DC1462L, 0xD7486900L, 0x680EC0A4L, 0x27A18DEEL, + 0x4F3FFEA2L, 0xE887AD8CL, 0xB58CE006L, 0x7AF4D6B6L, + 0xAACE1E7CL, 0xD3375FECL, 0xCE78A399L, 0x406B2A42L, + 0x20FE9E35L, 0xD9F385B9L, 0xEE39D7ABL, 0x3B124E8BL, + 0x1DC9FAF7L, 0x4B6D1856L, 0x26A36631L, 0xEAE397B2L, + 0x3A6EFA74L, 0xDD5B4332L, 0x6841E7F7L, 0xCA7820FBL, + 0xFB0AF54EL, 0xD8FEB397L, 0x454056ACL, 0xBA489527L, + 0x55533A3AL, 0x20838D87L, 0xFE6BA9B7L, 0xD096954BL, + 0x55A867BCL, 0xA1159A58L, 0xCCA92963L, 0x99E1DB33L, + 0xA62A4A56L, 0x3F3125F9L, 0x5EF47E1CL, 0x9029317CL, + 0xFDF8E802L, 0x04272F70L, 0x80BB155CL, 0x05282CE3L, + 0x95C11548L, 0xE4C66D22L, 0x48C1133FL, 0xC70F86DCL, + 0x07F9C9EEL, 0x41041F0FL, 0x404779A4L, 0x5D886E17L, + 0x325F51EBL, 0xD59BC0D1L, 0xF2BCC18FL, 0x41113564L, + 0x257B7834L, 0x602A9C60L, 0xDFF8E8A3L, 0x1F636C1BL, + 0x0E12B4C2L, 0x02E1329EL, 0xAF664FD1L, 0xCAD18115L, + 0x6B2395E0L, 0x333E92E1L, 0x3B240B62L, 0xEEBEB922L, + 0x85B2A20EL, 0xE6BA0D99L, 0xDE720C8CL, 0x2DA2F728L, + 0xD0127845L, 0x95B794FDL, 0x647D0862L, 0xE7CCF5F0L, + 0x5449A36FL, 0x877D48FAL, 0xC39DFD27L, 0xF33E8D1EL, + 0x0A476341L, 0x992EFF74L, 0x3A6F6EABL, 0xF4F8FD37L, + 0xA812DC60L, 0xA1EBDDF8L, 0x991BE14CL, 0xDB6E6B0DL, + 0xC67B5510L, 0x6D672C37L, 0x2765D43BL, 0xDCD0E804L, + 0xF1290DC7L, 0xCC00FFA3L, 0xB5390F92L, 0x690FED0BL, + 0x667B9FFBL, 0xCEDB7D9CL, 0xA091CF0BL, 0xD9155EA3L, + 0xBB132F88L, 0x515BAD24L, 0x7B9479BFL, 0x763BD6EBL, + 0x37392EB3L, 0xCC115979L, 0x8026E297L, 0xF42E312DL, + 0x6842ADA7L, 0xC66A2B3BL, 0x12754CCCL, 0x782EF11CL, + 0x6A124237L, 0xB79251E7L, 0x06A1BBE6L, 0x4BFB6350L, + 0x1A6B1018L, 0x11CAEDFAL, 0x3D25BDD8L, 0xE2E1C3C9L, + 0x44421659L, 0x0A121386L, 0xD90CEC6EL, 0xD5ABEA2AL, + 0x64AF674EL, 0xDA86A85FL, 0xBEBFE988L, 0x64E4C3FEL, + 0x9DBC8057L, 0xF0F7C086L, 0x60787BF8L, 0x6003604DL, + 0xD1FD8346L, 0xF6381FB0L, 0x7745AE04L, 0xD736FCCCL, + 0x83426B33L, 0xF01EAB71L, 0xB0804187L, 0x3C005E5FL, + 0x77A057BEL, 0xBDE8AE24L, 0x55464299L, 0xBF582E61L, + 0x4E58F48FL, 0xF2DDFDA2L, 0xF474EF38L, 0x8789BDC2L, + 0x5366F9C3L, 0xC8B38E74L, 0xB475F255L, 0x46FCD9B9L, + 0x7AEB2661L, 0x8B1DDF84L, 0x846A0E79L, 0x915F95E2L, + 0x466E598EL, 0x20B45770L, 0x8CD55591L, 0xC902DE4CL, + 0xB90BACE1L, 0xBB8205D0L, 0x11A86248L, 0x7574A99EL, + 0xB77F19B6L, 0xE0A9DC09L, 0x662D09A1L, 0xC4324633L, + 0xE85A1F02L, 0x09F0BE8CL, 0x4A99A025L, 0x1D6EFE10L, + 0x1AB93D1DL, 0x0BA5A4DFL, 0xA186F20FL, 0x2868F169L, + 0xDCB7DA83L, 0x573906FEL, 0xA1E2CE9BL, 0x4FCD7F52L, + 0x50115E01L, 0xA70683FAL, 0xA002B5C4L, 0x0DE6D027L, + 0x9AF88C27L, 0x773F8641L, 0xC3604C06L, 0x61A806B5L, + 0xF0177A28L, 0xC0F586E0L, 0x006058AAL, 0x30DC7D62L, + 0x11E69ED7L, 0x2338EA63L, 0x53C2DD94L, 0xC2C21634L, + 0xBBCBEE56L, 0x90BCB6DEL, 0xEBFC7DA1L, 0xCE591D76L, + 0x6F05E409L, 0x4B7C0188L, 0x39720A3DL, 0x7C927C24L, + 0x86E3725FL, 0x724D9DB9L, 0x1AC15BB4L, 0xD39EB8FCL, + 0xED545578L, 0x08FCA5B5L, 0xD83D7CD3L, 0x4DAD0FC4L, + 0x1E50EF5EL, 0xB161E6F8L, 0xA28514D9L, 0x6C51133CL, + 0x6FD5C7E7L, 0x56E14EC4L, 0x362ABFCEL, 0xDDC6C837L, + 0xD79A3234L, 0x92638212L, 0x670EFA8EL, 0x406000E0L }, + { 0x3A39CE37L, 0xD3FAF5CFL, 0xABC27737L, 0x5AC52D1BL, + 0x5CB0679EL, 0x4FA33742L, 0xD3822740L, 0x99BC9BBEL, + 0xD5118E9DL, 0xBF0F7315L, 0xD62D1C7EL, 0xC700C47BL, + 0xB78C1B6BL, 0x21A19045L, 0xB26EB1BEL, 0x6A366EB4L, + 0x5748AB2FL, 0xBC946E79L, 0xC6A376D2L, 0x6549C2C8L, + 0x530FF8EEL, 0x468DDE7DL, 0xD5730A1DL, 0x4CD04DC6L, + 0x2939BBDBL, 0xA9BA4650L, 0xAC9526E8L, 0xBE5EE304L, + 0xA1FAD5F0L, 0x6A2D519AL, 0x63EF8CE2L, 0x9A86EE22L, + 0xC089C2B8L, 0x43242EF6L, 0xA51E03AAL, 0x9CF2D0A4L, + 0x83C061BAL, 0x9BE96A4DL, 0x8FE51550L, 0xBA645BD6L, + 0x2826A2F9L, 0xA73A3AE1L, 0x4BA99586L, 0xEF5562E9L, + 0xC72FEFD3L, 0xF752F7DAL, 0x3F046F69L, 0x77FA0A59L, + 0x80E4A915L, 0x87B08601L, 0x9B09E6ADL, 0x3B3EE593L, + 0xE990FD5AL, 0x9E34D797L, 0x2CF0B7D9L, 0x022B8B51L, + 0x96D5AC3AL, 0x017DA67DL, 0xD1CF3ED6L, 0x7C7D2D28L, + 0x1F9F25CFL, 0xADF2B89BL, 0x5AD6B472L, 0x5A88F54CL, + 0xE029AC71L, 0xE019A5E6L, 0x47B0ACFDL, 0xED93FA9BL, + 0xE8D3C48DL, 0x283B57CCL, 0xF8D56629L, 0x79132E28L, + 0x785F0191L, 0xED756055L, 0xF7960E44L, 0xE3D35E8CL, + 0x15056DD4L, 0x88F46DBAL, 0x03A16125L, 0x0564F0BDL, + 0xC3EB9E15L, 0x3C9057A2L, 0x97271AECL, 0xA93A072AL, + 0x1B3F6D9BL, 0x1E6321F5L, 0xF59C66FBL, 0x26DCF319L, + 0x7533D928L, 0xB155FDF5L, 0x03563482L, 0x8ABA3CBBL, + 0x28517711L, 0xC20AD9F8L, 0xABCC5167L, 0xCCAD925FL, + 0x4DE81751L, 0x3830DC8EL, 0x379D5862L, 0x9320F991L, + 0xEA7A90C2L, 0xFB3E7BCEL, 0x5121CE64L, 0x774FBE32L, + 0xA8B6E37EL, 0xC3293D46L, 0x48DE5369L, 0x6413E680L, + 0xA2AE0810L, 0xDD6DB224L, 0x69852DFDL, 0x09072166L, + 0xB39A460AL, 0x6445C0DDL, 0x586CDECFL, 0x1C20C8AEL, + 0x5BBEF7DDL, 0x1B588D40L, 0xCCD2017FL, 0x6BB4E3BBL, + 0xDDA26A7EL, 0x3A59FF45L, 0x3E350A44L, 0xBCB4CDD5L, + 0x72EACEA8L, 0xFA6484BBL, 0x8D6612AEL, 0xBF3C6F47L, + 0xD29BE463L, 0x542F5D9EL, 0xAEC2771BL, 0xF64E6370L, + 0x740E0D8DL, 0xE75B1357L, 0xF8721671L, 0xAF537D5DL, + 0x4040CB08L, 0x4EB4E2CCL, 0x34D2466AL, 0x0115AF84L, + 0xE1B00428L, 0x95983A1DL, 0x06B89FB4L, 0xCE6EA048L, + 0x6F3F3B82L, 0x3520AB82L, 0x011A1D4BL, 0x277227F8L, + 0x611560B1L, 0xE7933FDCL, 0xBB3A792BL, 0x344525BDL, + 0xA08839E1L, 0x51CE794BL, 0x2F32C9B7L, 0xA01FBAC9L, + 0xE01CC87EL, 0xBCC7D1F6L, 0xCF0111C3L, 0xA1E8AAC7L, + 0x1A908749L, 0xD44FBD9AL, 0xD0DADECBL, 0xD50ADA38L, + 0x0339C32AL, 0xC6913667L, 0x8DF9317CL, 0xE0B12B4FL, + 0xF79E59B7L, 0x43F5BB3AL, 0xF2D519FFL, 0x27D9459CL, + 0xBF97222CL, 0x15E6FC2AL, 0x0F91FC71L, 0x9B941525L, + 0xFAE59361L, 0xCEB69CEBL, 0xC2A86459L, 0x12BAA8D1L, + 0xB6C1075EL, 0xE3056A0CL, 0x10D25065L, 0xCB03A442L, + 0xE0EC6E0EL, 0x1698DB3BL, 0x4C98A0BEL, 0x3278E964L, + 0x9F1F9532L, 0xE0D392DFL, 0xD3A0342BL, 0x8971F21EL, + 0x1B0A7441L, 0x4BA3348CL, 0xC5BE7120L, 0xC37632D8L, + 0xDF359F8DL, 0x9B992F2EL, 0xE60B6F47L, 0x0FE3F11DL, + 0xE54CDA54L, 0x1EDAD891L, 0xCE6279CFL, 0xCD3E7E6FL, + 0x1618B166L, 0xFD2C1D05L, 0x848FD2C5L, 0xF6FB2299L, + 0xF523F357L, 0xA6327623L, 0x93A83531L, 0x56CCCD02L, + 0xACF08162L, 0x5A75EBB5L, 0x6E163697L, 0x88D273CCL, + 0xDE966292L, 0x81B949D0L, 0x4C50901BL, 0x71C65614L, + 0xE6C6C7BDL, 0x327A140AL, 0x45E1D006L, 0xC3F27B9AL, + 0xC9AA53FDL, 0x62A80F00L, 0xBB25BFE2L, 0x35BDD2F6L, + 0x71126905L, 0xB2040222L, 0xB6CBCF7CL, 0xCD769C2BL, + 0x53113EC0L, 0x1640E3D3L, 0x38ABBD60L, 0x2547ADF0L, + 0xBA38209CL, 0xF746CE76L, 0x77AFA1C5L, 0x20756060L, + 0x85CBFE4EL, 0x8AE88DD8L, 0x7AAAF9B0L, 0x4CF9AA7EL, + 0x1948C25CL, 0x02FB8A8CL, 0x01C36AE4L, 0xD6EBE1F9L, + 0x90D4F869L, 0xA65CDEA0L, 0x3F09252DL, 0xC208E69FL, + 0xB74E6132L, 0xCE77E25BL, 0x578FDFE3L, 0x3AC372E6L } +}; + + +/* XL: turned F into a macro + endianness handling */ + +#if 0 +static u32 F(BLOWFISH_CTX *ctx, u32 x) { + unsigned short a, b, c, d; + u32 y; + + d = (unsigned short)(x & 0xFF); + x >>= 8; + c = (unsigned short)(x & 0xFF); + x >>= 8; + b = (unsigned short)(x & 0xFF); + x >>= 8; + a = (unsigned short)(x & 0xFF); + y = ctx->S[0][a] + ctx->S[1][b]; + y = y ^ ctx->S[2][c]; + y = y + ctx->S[3][d]; + + return y; +} +#else + +#define F(ctx,x) \ + (((ctx->S[0][x >> 24] \ + + ctx->S[1][(x >> 16) & 0xFF]) \ + ^ ctx->S[2][(x >> 8) & 0xFF]) \ + + ctx->S[3][x & 0xFF]) + +#endif + +void Blowfish_Encrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr){ + u32 Xl; + u32 Xr; + +#if 0 + u32 temp; + short i; + + Xl = *xl; + Xr = *xr; + + for (i = 0; i < N; ++i) { + Xl = Xl ^ ctx->P[i]; + Xr = F(ctx, Xl) ^ Xr; + + temp = Xl; + Xl = Xr; + Xr = temp; + } + + temp = Xl; + Xl = Xr; + Xr = temp; + + Xr = Xr ^ ctx->P[N]; + Xl = Xl ^ ctx->P[N + 1]; + + *xl = Xl; + *xr = Xr; + +#else + + Xl = *xl; + Xr = *xr; + + /* XL: loop unrolling */ + Xl ^= ctx->P[0]; + Xr ^= F(ctx,Xl) ^ ctx->P[1]; Xl ^= F(ctx,Xr) ^ ctx->P[2]; + Xr ^= F(ctx,Xl) ^ ctx->P[3]; Xl ^= F(ctx,Xr) ^ ctx->P[4]; + Xr ^= F(ctx,Xl) ^ ctx->P[5]; Xl ^= F(ctx,Xr) ^ ctx->P[6]; + Xr ^= F(ctx,Xl) ^ ctx->P[7]; Xl ^= F(ctx,Xr) ^ ctx->P[8]; + Xr ^= F(ctx,Xl) ^ ctx->P[9]; Xl ^= F(ctx,Xr) ^ ctx->P[10]; + Xr ^= F(ctx,Xl) ^ ctx->P[11]; Xl ^= F(ctx,Xr) ^ ctx->P[12]; + Xr ^= F(ctx,Xl) ^ ctx->P[13]; Xl ^= F(ctx,Xr) ^ ctx->P[14]; + Xr ^= F(ctx,Xl) ^ ctx->P[15]; Xl ^= F(ctx,Xr) ^ ctx->P[16]; + Xr ^= ctx->P[17]; + + *xl = Xr; + *xr = Xl; +#endif +} + +void Blowfish_Decrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr){ + u32 Xl; + u32 Xr; + +#if 0 + u32 temp; + short i; + + Xl = *xl; + Xr = *xr; + + for (i = N + 1; i > 1; --i) { + Xl = Xl ^ ctx->P[i]; + Xr = F(ctx, Xl) ^ Xr; + + /* Exchange Xl and Xr */ + temp = Xl; + Xl = Xr; + Xr = temp; + } + + /* Exchange Xl and Xr */ + temp = Xl; + Xl = Xr; + Xr = temp; + + Xr = Xr ^ ctx->P[1]; + Xl = Xl ^ ctx->P[0]; + + *xl = Xl; + *xr = Xr; + +#else + + Xl = *xl; + Xr = *xr; + + /* XL: loop unrolling */ + Xl ^= ctx->P[17]; + Xr ^= F(ctx,Xl) ^ ctx->P[16]; Xl ^= F(ctx,Xr) ^ ctx->P[15]; + Xr ^= F(ctx,Xl) ^ ctx->P[14]; Xl ^= F(ctx,Xr) ^ ctx->P[13]; + Xr ^= F(ctx,Xl) ^ ctx->P[12]; Xl ^= F(ctx,Xr) ^ ctx->P[11]; + Xr ^= F(ctx,Xl) ^ ctx->P[10]; Xl ^= F(ctx,Xr) ^ ctx->P[9]; + Xr ^= F(ctx,Xl) ^ ctx->P[8]; Xl ^= F(ctx,Xr) ^ ctx->P[7]; + Xr ^= F(ctx,Xl) ^ ctx->P[6]; Xl ^= F(ctx,Xr) ^ ctx->P[5]; + Xr ^= F(ctx,Xl) ^ ctx->P[4]; Xl ^= F(ctx,Xr) ^ ctx->P[3]; + Xr ^= F(ctx,Xl) ^ ctx->P[2]; Xl ^= F(ctx,Xr) ^ ctx->P[1]; + Xr ^= ctx->P[0]; + + *xl = Xr; + *xr = Xl; +#endif +} + + +void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen) { + int i, j, k; + u32 data, datal, datar; + + for (i = 0; i < 4; i++) { + for (j = 0; j < 256; j++) + ctx->S[i][j] = ORIG_S[i][j]; + } + + j = 0; + for (i = 0; i < N + 2; ++i) { + data = 0x00000000; + for (k = 0; k < 4; ++k) { + data = (data << 8) | key[j]; + j = j + 1; + if (j >= keyLen) + j = 0; + } + ctx->P[i] = ORIG_P[i] ^ data; + } + + datal = 0x00000000; + datar = 0x00000000; + + for (i = 0; i < N + 2; i += 2) { + Blowfish_Encrypt(ctx, &datal, &datar); + ctx->P[i] = datal; + ctx->P[i + 1] = datar; + } + + for (i = 0; i < 4; ++i) { + for (j = 0; j < 256; j += 2) { + Blowfish_Encrypt(ctx, &datal, &datar); + ctx->S[i][j] = datal; + ctx->S[i][j + 1] = datar; + } + } +} + + diff --git a/src/blowfish.h b/src/blowfish.h new file mode 100644 index 0000000..618d870 --- /dev/null +++ b/src/blowfish.h @@ -0,0 +1,34 @@ +/* +blowfish.h: Header file for blowfish.c + +Copyright (C) 1997 by Paul Kocher + +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.1 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +See blowfish.c for more information about this file. +*/ + +typedef unsigned int u32; + +typedef struct { + u32 P[16 + 2]; + u32 S[4][256]; +} BLOWFISH_CTX; + +void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen); +void Blowfish_Encrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr); +void Blowfish_Decrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr); + + + diff --git a/src/chacha20.c b/src/chacha20.c new file mode 100644 index 0000000..de56811 --- /dev/null +++ b/src/chacha20.c @@ -0,0 +1,162 @@ +/* Based on D. J. Bernstein's chacha-regs.c version 200801118, + https://cr.yp.to/streamciphers/timings/estreambench/submissions/salsa20/chacha8/regs/chacha.c + The initial code is in the public domain */ + +#include +#include +#include +#include +#include +#include "chacha20.h" + +static inline void U32TO8_LITTLE(uint8_t * dst, uint32_t val) +{ +#ifdef ARCH_BIG_ENDIAN + dst[0] = val; + dst[1] = val >> 8; + dst[2] = val >> 16; + dst[3] = val >> 24; +#else + *((uint32_t *) dst) = val; +#endif +} + +static inline uint32_t U8TO32_LITTLE(const uint8_t * src) +{ + return (uint32_t) src[0] + + ((uint32_t) src[1] << 8) + + ((uint32_t) src[2] << 16) + + ((uint32_t) src[3] << 24); +} + +#define ROTATE(v,c) ((v) << (c) | (v) >> (32 - (c))) +#define XOR(v,w) ((v) ^ (w)) +#define PLUS(v,w) ((v) + (w)) +#define PLUSONE(v) ((v) + 1) + +#define QUARTERROUND(a,b,c,d) \ + a = PLUS(a,b); d = ROTATE(XOR(d,a),16); \ + c = PLUS(c,d); b = ROTATE(XOR(b,c),12); \ + a = PLUS(a,b); d = ROTATE(XOR(d,a), 8); \ + c = PLUS(c,d); b = ROTATE(XOR(b,c), 7); + +static void chacha20_block(chacha20_ctx * ctx) +{ + uint32_t x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15; + int i; + + x0 = ctx->input[0]; + x1 = ctx->input[1]; + x2 = ctx->input[2]; + x3 = ctx->input[3]; + x4 = ctx->input[4]; + x5 = ctx->input[5]; + x6 = ctx->input[6]; + x7 = ctx->input[7]; + x8 = ctx->input[8]; + x9 = ctx->input[9]; + x10 = ctx->input[10]; + x11 = ctx->input[11]; + x12 = ctx->input[12]; + x13 = ctx->input[13]; + x14 = ctx->input[14]; + x15 = ctx->input[15]; + for (i = 10; i > 0; i --) { + QUARTERROUND( x0, x4, x8,x12) + QUARTERROUND( x1, x5, x9,x13) + QUARTERROUND( x2, x6,x10,x14) + QUARTERROUND( x3, x7,x11,x15) + QUARTERROUND( x0, x5,x10,x15) + QUARTERROUND( x1, x6,x11,x12) + QUARTERROUND( x2, x7, x8,x13) + QUARTERROUND( x3, x4, x9,x14) + } + x0 = PLUS(x0,ctx->input[0]); + x1 = PLUS(x1,ctx->input[1]); + x2 = PLUS(x2,ctx->input[2]); + x3 = PLUS(x3,ctx->input[3]); + x4 = PLUS(x4,ctx->input[4]); + x5 = PLUS(x5,ctx->input[5]); + x6 = PLUS(x6,ctx->input[6]); + x7 = PLUS(x7,ctx->input[7]); + x8 = PLUS(x8,ctx->input[8]); + x9 = PLUS(x9,ctx->input[9]); + x10 = PLUS(x10,ctx->input[10]); + x11 = PLUS(x11,ctx->input[11]); + x12 = PLUS(x12,ctx->input[12]); + x13 = PLUS(x13,ctx->input[13]); + x14 = PLUS(x14,ctx->input[14]); + x15 = PLUS(x15,ctx->input[15]); + U32TO8_LITTLE(ctx->output + 0,x0); + U32TO8_LITTLE(ctx->output + 4,x1); + U32TO8_LITTLE(ctx->output + 8,x2); + U32TO8_LITTLE(ctx->output + 12,x3); + U32TO8_LITTLE(ctx->output + 16,x4); + U32TO8_LITTLE(ctx->output + 20,x5); + U32TO8_LITTLE(ctx->output + 24,x6); + U32TO8_LITTLE(ctx->output + 28,x7); + U32TO8_LITTLE(ctx->output + 32,x8); + U32TO8_LITTLE(ctx->output + 36,x9); + U32TO8_LITTLE(ctx->output + 40,x10); + U32TO8_LITTLE(ctx->output + 44,x11); + U32TO8_LITTLE(ctx->output + 48,x12); + U32TO8_LITTLE(ctx->output + 52,x13); + U32TO8_LITTLE(ctx->output + 56,x14); + U32TO8_LITTLE(ctx->output + 60,x15); + /* Increment the 64-bit counter and, on overflow, the 64-bit nonce */ + /* (Incrementing the nonce is not standard but a reasonable default.) */ + if (++ ctx->input[12] == 0) + if (++ ctx->input[13] == 0) + if (++ ctx->input[14] == 0) + ++ ctx->input[15]; +} + +void chacha20_transform(chacha20_ctx * ctx, + const uint8_t * in, uint8_t * out, size_t len) +{ + int n = ctx->next; + for (/*nothing*/; len > 0; len--) { + if (n >= 64) { chacha20_block(ctx); n = 0; } + *out++ = *in++ ^ ctx->output[n++]; + } + ctx->next = n; +} + +void chacha20_extract(chacha20_ctx * ctx, + uint8_t * out, size_t len) +{ + int n = ctx->next; + for (/*nothing*/; len > 0; len--) { + if (n >= 64) { chacha20_block(ctx); n = 0; } + *out++ = ctx->output[n++]; + } + ctx->next = n; +} + +void chacha20_init(chacha20_ctx * ctx, + const uint8_t * key, size_t key_length, + const uint8_t iv[8], + uint64_t counter) +{ + const uint8_t *constants = + (uint8_t *) (key_length == 32 ? "expand 32-byte k" : "expand 16-byte k"); + assert (key_length == 16 || key_length == 32); + ctx->input[0] = U8TO32_LITTLE(constants + 0); + ctx->input[1] = U8TO32_LITTLE(constants + 4); + ctx->input[2] = U8TO32_LITTLE(constants + 8); + ctx->input[3] = U8TO32_LITTLE(constants + 12); + ctx->input[4] = U8TO32_LITTLE(key + 0); + ctx->input[5] = U8TO32_LITTLE(key + 4); + ctx->input[6] = U8TO32_LITTLE(key + 8); + ctx->input[7] = U8TO32_LITTLE(key + 12); + if (key_length == 32) key += 16; + ctx->input[8] = U8TO32_LITTLE(key + 0); + ctx->input[9] = U8TO32_LITTLE(key + 4); + ctx->input[10] = U8TO32_LITTLE(key + 8); + ctx->input[11] = U8TO32_LITTLE(key + 12); + ctx->input[12] = (uint32_t) counter; + ctx->input[13] = (uint32_t) (counter >> 32); + ctx->input[14] = U8TO32_LITTLE(iv + 0); + ctx->input[15] = U8TO32_LITTLE(iv + 4); + ctx->next = 64; +} diff --git a/src/chacha20.h b/src/chacha20.h new file mode 100644 index 0000000..26ba1fd --- /dev/null +++ b/src/chacha20.h @@ -0,0 +1,23 @@ +/* Based on D. J. Bernstein's chacha-regs.c version 200801118, + https://cr.yp.to/streamciphers/timings/estreambench/submissions/salsa20/chacha8/regs/chacha.c + The initial code is in the public domain */ + +#include +#include + +typedef struct { + uint32_t input[16]; /* The current state */ + uint8_t output[64]; /* Output data for the current state */ + int next; /* Index of next unused byte in output */ +} chacha20_ctx; + +void chacha20_init(chacha20_ctx * ctx, + const uint8_t * key, size_t key_length, + const uint8_t iv[8], + uint64_t ctr); + +void chacha20_extract(chacha20_ctx * ctx, + uint8_t * out, size_t len); + +void chacha20_transform(chacha20_ctx * ctx, + const uint8_t * in, uint8_t * out, size_t len); diff --git a/src/cryptokit.ml b/src/cryptokit.ml new file mode 100644 index 0000000..597139a --- /dev/null +++ b/src/cryptokit.ml @@ -0,0 +1,2026 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +let wipe_bytes s = Bytes.fill s 0 (Bytes.length s) '\000' +let wipe_string s = wipe_bytes (Bytes.unsafe_of_string s) + +let shl1_bytes src soff dst doff len = + let rec shl1 carry i = + if i >= 0 then begin + let n = Char.code (Bytes.get src (soff + i)) in + Bytes.set dst (doff + i) (Char.unsafe_chr ((n lsl 1) lor carry)); + shl1 (n lsr 7) (i - 1) + end + in shl1 0 (len - 1) + +type error = + | Wrong_key_size + | Wrong_IV_size + | Wrong_data_length + | Bad_padding + | Output_buffer_overflow + | Incompatible_block_size + | Number_too_long + | Seed_too_short + | Message_too_long + | Bad_encoding + | Compression_error of string * string + | No_entropy_source + | Entropy_source_closed + | Compression_not_supported + +exception Error of error + +let _ = Callback.register_exception "Cryptokit.Error" (Error Wrong_key_size) + +(* Interface with C *) + +type dir = Encrypt | Decrypt + +external xor_bytes: bytes -> int -> bytes -> int -> int -> unit = "caml_xor_string" +external xor_string: string -> int -> bytes -> int -> int -> unit = "caml_xor_string" +external aes_cook_encrypt_key : string -> bytes = "caml_aes_cook_encrypt_key" +external aes_cook_decrypt_key : string -> bytes = "caml_aes_cook_decrypt_key" +external aes_encrypt : bytes -> bytes -> int -> bytes -> int -> unit = "caml_aes_encrypt" +external aes_decrypt : bytes -> bytes -> int -> bytes -> int -> unit = "caml_aes_decrypt" +external blowfish_cook_key : string -> bytes = "caml_blowfish_cook_key" +external blowfish_encrypt : bytes -> bytes -> int -> bytes -> int -> unit = "caml_blowfish_encrypt" +external blowfish_decrypt : bytes -> bytes -> int -> bytes -> int -> unit = "caml_blowfish_decrypt" +external des_cook_key : string -> int -> dir -> bytes = "caml_des_cook_key" +external des_transform : bytes -> bytes -> int -> bytes -> int -> unit = "caml_des_transform" +external arcfour_cook_key : string -> bytes = "caml_arcfour_cook_key" +external arcfour_transform : bytes -> bytes -> int -> bytes -> int -> int -> unit = "caml_arcfour_transform_bytecode" "caml_arcfour_transform" +external chacha20_cook_key : string -> bytes -> int64 -> bytes = "caml_chacha20_cook_key" +external chacha20_transform : bytes -> bytes -> int -> bytes -> int -> int -> unit = "caml_chacha20_transform_bytecode" "caml_chacha20_transform" +external chacha20_extract : bytes -> bytes -> int -> int -> unit = "caml_chacha20_extract" + +external sha1_init: unit -> bytes = "caml_sha1_init" +external sha1_update: bytes -> bytes -> int -> int -> unit = "caml_sha1_update" +external sha1_final: bytes -> string = "caml_sha1_final" +external sha256_init: unit -> bytes = "caml_sha256_init" +external sha224_init: unit -> bytes = "caml_sha224_init" +external sha256_update: bytes -> bytes -> int -> int -> unit = "caml_sha256_update" +external sha256_final: bytes -> string = "caml_sha256_final" +external sha224_final: bytes -> string = "caml_sha224_final" +external sha512_init: unit -> bytes = "caml_sha512_init" +external sha384_init: unit -> bytes = "caml_sha384_init" +external sha512_update: bytes -> bytes -> int -> int -> unit = "caml_sha512_update" +external sha512_final: bytes -> string = "caml_sha512_final" +external sha384_final: bytes -> string = "caml_sha384_final" +type sha3_context +external sha3_init: int -> sha3_context = "caml_sha3_init" +external sha3_absorb: sha3_context -> bytes -> int -> int -> unit = "caml_sha3_absorb" +external sha3_extract: bool -> sha3_context -> string = "caml_sha3_extract" +external sha3_wipe: sha3_context -> unit = "caml_sha3_wipe" +external ripemd160_init: unit -> bytes = "caml_ripemd160_init" +external ripemd160_update: bytes -> bytes -> int -> int -> unit = "caml_ripemd160_update" +external ripemd160_final: bytes -> string = "caml_ripemd160_final" +external md5_init: unit -> bytes = "caml_md5_init" +external md5_update: bytes -> bytes -> int -> int -> unit = "caml_md5_update" +external md5_final: bytes -> string = "caml_md5_final" + +(* Abstract transform type *) + +class type transform = + object + method input_block_size: int + method output_block_size: int + + method put_substring: bytes -> int -> int -> unit + method put_string: string -> unit + method put_char: char -> unit + method put_byte: int -> unit + + method finish: unit + method flush: unit + + method available_output: int + + method get_string: string + method get_substring: bytes * int * int + method get_char: char + method get_byte: int + + method wipe: unit + end + +let transform_string tr s = + tr#put_string s; + tr#finish; + let r = tr#get_string in tr#wipe; r + +let transform_channel tr ?len ic oc = + let ibuf = Bytes.create 256 in + let rec transf_to_eof () = + let r = input ic ibuf 0 256 in + if r > 0 then begin + tr#put_substring ibuf 0 r; + let (obuf, opos, olen) = tr#get_substring in + output oc obuf opos olen; + transf_to_eof() + end + and transf_bounded numleft = + if numleft > 0 then begin + let r = input ic ibuf 0 (min 256 numleft) in + if r = 0 then raise End_of_file; + tr#put_substring ibuf 0 r; + let (obuf, opos, olen) = tr#get_substring in + output oc obuf opos olen; + transf_bounded (numleft - r) + end in + begin match len with + None -> transf_to_eof () + | Some l -> transf_bounded l + end; + wipe_bytes ibuf; + tr#finish; + let (obuf, opos, olen) = tr#get_substring in + output oc obuf opos olen; + tr#wipe + +class compose (tr1 : transform) (tr2 : transform) = + object(self) + method input_block_size = tr1#input_block_size + method output_block_size = tr2#output_block_size + + method put_substring buf ofs len = + tr1#put_substring buf ofs len; self#transfer + method put_string s = + tr1#put_string s; self#transfer + method put_char c = + tr1#put_char c; self#transfer + method put_byte b = + tr1#put_byte b; self#transfer + + method private transfer = + let (buf, ofs, len) = tr1#get_substring in + tr2#put_substring buf ofs len + + method available_output = tr2#available_output + method get_string = tr2#get_string + method get_substring = tr2#get_substring + method get_char = tr2#get_char + method get_byte = tr2#get_byte + + method flush = tr1#flush; self#transfer; tr2#flush + method finish = tr1#finish; self#transfer; tr2#finish + + method wipe = tr1#wipe; tr2#wipe + end + +let compose tr1 tr2 = new compose tr1 tr2 + +class type hash = + object + method hash_size: int + method add_substring: bytes -> int -> int -> unit + method add_string: string -> unit + method add_char: char -> unit + method add_byte: int -> unit + method result: string + method wipe: unit + end + +let hash_string hash s = + hash#add_string s; + let r = hash#result in + hash#wipe; + r + +let hash_channel hash ?len ic = + let ibuf = Bytes.create 256 in + let rec hash_to_eof () = + let r = input ic ibuf 0 256 in + if r > 0 then begin + hash#add_substring ibuf 0 r; + hash_to_eof() + end + and hash_bounded numleft = + if numleft > 0 then begin + let r = input ic ibuf 0 (min 256 numleft) in + if r = 0 then raise End_of_file; + hash#add_substring ibuf 0 r; + hash_bounded (numleft - r) + end in + begin match len with + None -> hash_to_eof () + | Some l -> hash_bounded l + end; + wipe_bytes ibuf; + let res = hash#result in + hash#wipe; + res + +(* Padding schemes *) + +module Padding = struct + +class type scheme = + object + method pad: bytes -> int -> unit + method strip: bytes -> int + end + +class length = + object + method pad buffer used = + let n = Bytes.length buffer - used in + assert (n > 0 && n < 256); + Bytes.fill buffer used n (Char.chr n) + method strip buffer = + let blocksize = Bytes.length buffer in + let n = Char.code (Bytes.get buffer (blocksize - 1)) in + if n = 0 || n > blocksize then raise (Error Bad_padding); + (* Characters blocksize - n to blocksize - 1 must be equal to n *) + for i = blocksize - n to blocksize - 2 do + if Char.code (Bytes.get buffer i) <> n then raise (Error Bad_padding) + done; + blocksize - n + end + +let length = new length + +class _8000 = + object + method pad buffer used = + Bytes.set buffer used '\128'; + for i = used + 1 to Bytes.length buffer - 1 do + Bytes.set buffer i '\000' + done + method strip buffer = + let rec strip pos = + if pos < 0 then raise (Error Bad_padding) else + match Bytes.get buffer pos with + '\128' -> pos + | '\000' -> strip (pos - 1) + | _ -> raise (Error Bad_padding) + in strip (Bytes.length buffer - 1) + end + +let _8000 = new _8000 + +end + +(* Generic handling of output buffering *) + +class buffered_output initial_buffer_size = + object(self) + val mutable obuf = Bytes.create initial_buffer_size + val mutable obeg = 0 + val mutable oend = 0 + + method private ensure_capacity n = + let len = Bytes.length obuf in + if oend + n > len then begin + if oend - obeg + n < len then begin + Bytes.blit obuf obeg obuf 0 (oend - obeg); + oend <- oend - obeg; + obeg <- 0 + end else begin + let newlen = ref (2 * len) in + while oend - obeg + n > (!newlen) do + newlen := (!newlen) * 2 + done; + if (!newlen) > Sys.max_string_length then begin + if (oend - obeg + n) <= Sys.max_string_length then + newlen := Sys.max_string_length + else + raise (Error Output_buffer_overflow) + end; + let newbuf = Bytes.create (!newlen) in + Bytes.blit obuf obeg newbuf 0 (oend - obeg); + obuf <- newbuf; + oend <- oend - obeg; + obeg <- 0 + end + end + + method available_output = oend - obeg + + method get_substring = + let res = (obuf, obeg, oend - obeg) in obeg <- 0; oend <- 0; res + + method get_string = + let res = Bytes.sub_string obuf obeg (oend - obeg) in obeg <- 0; oend <- 0; res + + method get_char = + if obeg >= oend then raise End_of_file; + let r = Bytes.get obuf obeg in + obeg <- obeg + 1; + r + + method get_byte = + Char.code self#get_char + + method wipe = + wipe_bytes obuf + end + +(* Block ciphers *) + +module Block = struct + +class type block_cipher = + object + method blocksize: int + method transform: bytes -> int -> bytes -> int -> unit + method wipe: unit + end + +class aes_encrypt key = + object + val ckey = + let kl = String.length key in + if kl = 16 || kl = 24 || kl = 32 + then aes_cook_encrypt_key key + else raise(Error Wrong_key_size) + method blocksize = 16 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 16 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 16 + then invalid_arg "aes#transform"; + aes_encrypt ckey src src_ofs dst dst_ofs + method wipe = + wipe_bytes ckey; + Bytes.set ckey (Bytes.length ckey - 1) '\016' + end + +class aes_decrypt key = + object + val ckey = + let kl = String.length key in + if kl = 16 || kl = 24 || kl = 32 + then aes_cook_decrypt_key key + else raise(Error Wrong_key_size) + method blocksize = 16 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 16 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 16 + then invalid_arg "aes#transform"; + aes_decrypt ckey src src_ofs dst dst_ofs + method wipe = + wipe_bytes ckey; + Bytes.set ckey (Bytes.length ckey - 1) '\016' + end + +class blowfish_encrypt key = + object + val ckey = + let kl = String.length key in + if kl >= 4 && kl <= 56 + then blowfish_cook_key key + else raise(Error Wrong_key_size) + method blocksize = 8 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 8 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 8 + then invalid_arg "blowfish#transform"; + blowfish_encrypt ckey src src_ofs dst dst_ofs + method wipe = + wipe_bytes ckey + end + +class blowfish_decrypt key = + object + val ckey = + let kl = String.length key in + if kl >= 4 && kl <= 56 + then blowfish_cook_key key + else raise(Error Wrong_key_size) + method blocksize = 8 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 8 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 8 + then invalid_arg "blowfish#transform"; + blowfish_decrypt ckey src src_ofs dst dst_ofs + method wipe = + wipe_bytes ckey + end + +class des direction key = + object + val ckey = + if String.length key = 8 + then des_cook_key key 0 direction + else raise(Error Wrong_key_size) + method blocksize = 8 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 8 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 8 + then invalid_arg "des#transform"; + des_transform ckey src src_ofs dst dst_ofs + method wipe = + wipe_bytes ckey + end + +class des_encrypt = des Encrypt +class des_decrypt = des Decrypt + +class triple_des_encrypt key = + let _ = + let kl = String.length key in + if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size) in + let ckey1 = + des_cook_key key 0 Encrypt in + let ckey2 = + des_cook_key key 8 Decrypt in + let ckey3 = + if String.length key = 24 + then des_cook_key key 16 Encrypt + else ckey1 in + object + method blocksize = 8 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 8 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 8 + then invalid_arg "triple_des#transform"; + des_transform ckey1 src src_ofs dst dst_ofs; + des_transform ckey2 dst dst_ofs dst dst_ofs; + des_transform ckey3 dst dst_ofs dst dst_ofs + method wipe = + wipe_bytes ckey1; + wipe_bytes ckey2; + wipe_bytes ckey3 + end + +class triple_des_decrypt key = + let _ = + let kl = String.length key in + if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size) in + let ckey3 = + des_cook_key key 0 Decrypt in + let ckey2 = + des_cook_key key 8 Encrypt in + let ckey1 = + if String.length key = 24 + then des_cook_key key 16 Decrypt + else ckey3 in + object + method blocksize = 8 + method transform src src_ofs dst dst_ofs = + if src_ofs < 0 || src_ofs > Bytes.length src - 8 + || dst_ofs < 0 || dst_ofs > Bytes.length dst - 8 + then invalid_arg "triple_des#transform"; + des_transform ckey1 src src_ofs dst dst_ofs; + des_transform ckey2 dst dst_ofs dst dst_ofs; + des_transform ckey3 dst dst_ofs dst dst_ofs + method wipe = + wipe_bytes ckey1; + wipe_bytes ckey2; + wipe_bytes ckey3 + end + +(* Chaining modes *) + +let make_initial_iv blocksize = function + | None -> + Bytes.make blocksize '\000' + | Some s -> + if String.length s <> blocksize then raise (Error Wrong_IV_size); + Bytes.of_string s + +class cbc_encrypt ?iv:iv_init (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + val iv = make_initial_iv blocksize iv_init + method blocksize = blocksize + method transform src src_off dst dst_off = + xor_bytes src src_off iv 0 blocksize; + cipher#transform iv 0 dst dst_off; + Bytes.blit dst dst_off iv 0 blocksize + method wipe = + cipher#wipe; + wipe_bytes iv + end + +class cbc_decrypt ?iv:iv_init (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + val iv = make_initial_iv blocksize iv_init + val next_iv = Bytes.create blocksize + method blocksize = blocksize + method transform src src_off dst dst_off = + Bytes.blit src src_off next_iv 0 blocksize; + cipher#transform src src_off dst dst_off; + xor_bytes iv 0 dst dst_off blocksize; + Bytes.blit next_iv 0 iv 0 blocksize + method wipe = + cipher#wipe; + wipe_bytes iv; + wipe_bytes next_iv + end + +class cfb_encrypt ?iv:iv_init chunksize (cipher : block_cipher) = + let blocksize = cipher#blocksize in + let _ = assert (chunksize > 0 && chunksize <= blocksize) in + object(self) + val iv = make_initial_iv blocksize iv_init + val out = Bytes.create blocksize + method blocksize = chunksize + method transform src src_off dst dst_off = + cipher#transform iv 0 out 0; + Bytes.blit src src_off dst dst_off chunksize; + xor_bytes out 0 dst dst_off chunksize; + Bytes.blit iv chunksize iv 0 (blocksize - chunksize); + Bytes.blit dst dst_off iv (blocksize - chunksize) chunksize + method wipe = + cipher#wipe; + wipe_bytes iv; + wipe_bytes out + end + +class cfb_decrypt ?iv:iv_init chunksize (cipher : block_cipher) = + let blocksize = cipher#blocksize in + let _ = assert (chunksize > 0 && chunksize <= blocksize) in + object(self) + val iv = make_initial_iv blocksize iv_init + val out = Bytes.create blocksize + method blocksize = chunksize + method transform src src_off dst dst_off = + cipher#transform iv 0 out 0; + Bytes.blit iv chunksize iv 0 (blocksize - chunksize); + Bytes.blit src src_off iv (blocksize - chunksize) chunksize; + Bytes.blit src src_off dst dst_off chunksize; + xor_bytes out 0 dst dst_off chunksize + method wipe = + cipher#wipe; + wipe_bytes iv; + wipe_bytes out + end + +class ofb ?iv:iv_init chunksize (cipher : block_cipher) = + let blocksize = cipher#blocksize in + let _ = assert (chunksize > 0 && chunksize <= blocksize) in + object(self) + val iv = make_initial_iv blocksize iv_init + method blocksize = chunksize + method transform src src_off dst dst_off = + cipher#transform iv 0 iv 0; + Bytes.blit src src_off dst dst_off chunksize; + xor_bytes iv 0 dst dst_off chunksize + method wipe = + cipher#wipe; + wipe_bytes iv + end + +let rec increment_counter c lim pos = + if pos >= lim then begin + let i = 1 + Char.code (Bytes.get c pos) in + Bytes.set c pos (Char.unsafe_chr i); + if i = 0x100 then increment_counter c lim (pos - 1) + end + +class ctr ?iv:iv_init ?inc (cipher : block_cipher) = + let blocksize = cipher#blocksize in + let nincr = + match inc with + | None -> blocksize + | Some n -> assert (n > 0 && n <= blocksize); n in + object(self) + val iv = make_initial_iv blocksize iv_init + val out = Bytes.create blocksize + method blocksize = blocksize + method transform src src_off dst dst_off = + cipher#transform iv 0 out 0; + Bytes.blit src src_off dst dst_off blocksize; + xor_bytes out 0 dst dst_off blocksize; + increment_counter iv (blocksize - nincr) (blocksize - 1) + method wipe = + cipher#wipe; + wipe_bytes iv; + wipe_bytes out + end + +(* Wrapping of a block cipher as a transform *) + +class cipher (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + val ibuf = Bytes.create blocksize + val mutable used = 0 + + inherit buffered_output (max 256 (2 * blocksize)) as output_buffer + + method input_block_size = blocksize + method output_block_size = blocksize + + method put_substring src ofs len = + if len <= 0 then () else + if used + len <= blocksize then begin + (* Just accumulate len characters in ibuf *) + Bytes.blit src ofs ibuf used len; + used <- used + len + end else begin + (* Fill buffer and run it through cipher *) + let n = blocksize - used in + Bytes.blit src ofs ibuf used n; + self#ensure_capacity blocksize; + cipher#transform ibuf 0 obuf oend; + oend <- oend + blocksize; + used <- 0; + (* Recurse on remainder of string *) + self#put_substring src (ofs + n) (len - n) + end + + method put_string s = + self#put_substring (Bytes.unsafe_of_string s) 0 (String.length s) + + method put_char c = + if used < blocksize then begin + Bytes.set ibuf used c; + used <- used + 1 + end else begin + self#ensure_capacity blocksize; + cipher#transform ibuf 0 obuf oend; + oend <- oend + blocksize; + Bytes.set ibuf 0 c; + used <- 1 + end + + method put_byte b = + self#put_char (Char.unsafe_chr b) + + method wipe = + cipher#wipe; + output_buffer#wipe; + wipe_bytes ibuf + + method flush = + if used = 0 then () + else if used = blocksize then begin + self#ensure_capacity blocksize; + cipher#transform ibuf 0 obuf oend; + used <- 0; + oend <- oend + blocksize + end + else raise (Error Wrong_data_length) + + method finish = + self#flush + end + +(* Block cipher with padding *) + +class cipher_padded_encrypt (padding : Padding.scheme) + (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + inherit cipher cipher + method input_block_size = 1 + + method finish = + if used >= blocksize then begin + self#ensure_capacity blocksize; + cipher#transform ibuf 0 obuf oend; + oend <- oend + blocksize; + used <- 0 + end; + padding#pad ibuf used; + self#ensure_capacity blocksize; + cipher#transform ibuf 0 obuf oend; + oend <- oend + blocksize + end + +class cipher_padded_decrypt (padding : Padding.scheme) + (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + inherit cipher cipher + method output_block_size = 1 + + method finish = + if used <> blocksize then raise (Error Wrong_data_length); + cipher#transform ibuf 0 ibuf 0; + let valid = padding#strip ibuf in + self#ensure_capacity valid; + Bytes.blit ibuf 0 obuf oend valid; + oend <- oend + valid + end + +(* Wrapping of a block cipher as a MAC, using CBC mode *) + +class mac ?iv:iv_init ?(pad: Padding.scheme option) (cipher : block_cipher) = + let blocksize = cipher#blocksize in + object(self) + val iv = make_initial_iv blocksize iv_init + val buffer = Bytes.create blocksize + val mutable used = 0 + + method hash_size = blocksize + + method add_substring src src_ofs len = + let rec add src_ofs len = + if len <= 0 then () else + if used + len <= blocksize then begin + (* Just accumulate len characters in buffer *) + Bytes.blit src src_ofs buffer used len; + used <- used + len + end else begin + (* Fill buffer and run it through cipher *) + let n = blocksize - used in + Bytes.blit src src_ofs buffer used n; + xor_bytes iv 0 buffer 0 blocksize; + cipher#transform buffer 0 iv 0; + used <- 0; + (* Recurse on remainder of string *) + add (src_ofs + n) (len - n) + end + in add src_ofs len + + method add_string s = + self#add_substring (Bytes.unsafe_of_string s) 0 (String.length s) + + method add_char c = + if used < blocksize then begin + Bytes.set buffer used c; + used <- used + 1 + end else begin + xor_bytes iv 0 buffer 0 blocksize; + cipher#transform buffer 0 iv 0; + Bytes.set buffer 0 c; + used <- 1 + end + + method add_byte b = + self#add_char (Char.unsafe_chr b) + + method wipe = + cipher#wipe; + wipe_bytes buffer; + wipe_bytes iv + + method result = + if used = blocksize then begin + xor_bytes iv 0 buffer 0 blocksize; + cipher#transform buffer 0 iv 0; + used <- 0 + end; + begin match pad with + None -> + if used <> 0 then raise (Error Wrong_data_length) + | Some p -> + p#pad buffer used; + xor_bytes iv 0 buffer 0 blocksize; + cipher#transform buffer 0 iv 0; + used <- 0 + end; + Bytes.to_string iv + end + +class mac_final_triple ?iv ?pad (cipher1 : block_cipher) + (cipher2 : block_cipher) + (cipher3 : block_cipher) = + let _ = if cipher1#blocksize <> cipher2#blocksize + || cipher2#blocksize <> cipher3#blocksize + then raise(Error Incompatible_block_size) in + object + inherit mac ?iv ?pad cipher1 as super + method result = + let r = Bytes.of_string super#result in + cipher2#transform r 0 r 0; + cipher3#transform r 0 r 0; + Bytes.unsafe_to_string r + method wipe = + super#wipe; cipher2#wipe; cipher3#wipe + end + +(* Wrapping of a block ciper as a MAC, in CMAC mode (a.k.a. OMAC1) *) + +class cmac ?iv:iv_init (cipher : block_cipher) k1 k2 = + object (self) + inherit mac ?iv:iv_init cipher as super + + method result = + let blocksize = cipher#blocksize in + let k' = + if used = blocksize then k1 else (Padding._8000#pad buffer used; k2) in + xor_bytes iv 0 buffer 0 blocksize; + xor_bytes k' 0 buffer 0 blocksize; + cipher#transform buffer 0 iv 0; + used <- 0; (* really useful? *) + Bytes.to_string iv + + method wipe = + super#wipe; + wipe_bytes k1; + wipe_bytes k2 + end +end + +(* Stream ciphers *) + +module Stream = struct + +class type stream_cipher = + object + method transform: bytes -> int -> bytes -> int -> int -> unit + method wipe: unit + end + +class arcfour key = + object + val ckey = + if String.length key > 0 && String.length key <= 256 + then arcfour_cook_key key + else raise(Error Wrong_key_size) + method transform src src_ofs dst dst_ofs len = + if len < 0 + || src_ofs < 0 || src_ofs > Bytes.length src - len + || dst_ofs < 0 || dst_ofs > Bytes.length dst - len + then invalid_arg "arcfour#transform"; + arcfour_transform ckey src src_ofs dst dst_ofs len + method wipe = + wipe_bytes ckey + end + +class chacha20 ?iv ?(ctr = 0L) key = + object + val ckey = + let iv = Block.make_initial_iv 8 iv in + if String.length key = 16 || String.length key = 32 + then chacha20_cook_key key iv ctr + else raise(Error Wrong_key_size) + method transform src src_ofs dst dst_ofs len = + if len < 0 + || src_ofs < 0 || src_ofs > Bytes.length src - len + || dst_ofs < 0 || dst_ofs > Bytes.length dst - len + then invalid_arg "chacha20#transform"; + chacha20_transform ckey src src_ofs dst dst_ofs len + method wipe = + wipe_bytes ckey + end + +(* Wrapping of a stream cipher as a cipher *) + +class cipher (cipher : stream_cipher) = + object(self) + val charbuf = Bytes.create 1 + + inherit buffered_output 256 as output_buffer + method input_block_size = 1 + method output_block_size = 1 + + method put_substring src ofs len = + self#ensure_capacity len; + cipher#transform src ofs obuf oend len; + oend <- oend + len + + method put_string s = + self#put_substring (Bytes.unsafe_of_string s) 0 (String.length s) + + method put_char c = + Bytes.set charbuf 0 c; + self#ensure_capacity 1; + cipher#transform charbuf 0 obuf oend 1; + oend <- oend + 1 + + method put_byte b = + self#put_char (Char.unsafe_chr b) + + method flush = () + method finish = () + + method wipe = + cipher#wipe; + output_buffer#wipe; + wipe_bytes charbuf + end + +end + +(* Hash functions *) + +module Hash = struct + +class sha1 = + object(self) + val context = sha1_init() + method hash_size = 20 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "sha1#add_substring"; + sha1_update context src ofs len + method add_string src = + sha1_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + sha1_final context + method wipe = + wipe_bytes context + end + +let sha1 () = new sha1 + +class sha224 = + object(self) + val context = sha224_init() + method hash_size = 24 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "sha224#add_substring"; + sha256_update context src ofs len + method add_string src = + sha256_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + sha224_final context + method wipe = + wipe_bytes context + end + +let sha224 () = new sha224 + +class sha256 = + object(self) + val context = sha256_init() + method hash_size = 32 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "sha256#add_substring"; + sha256_update context src ofs len + method add_string src = + sha256_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + sha256_final context + method wipe = + wipe_bytes context + end + +let sha256 () = new sha256 + +class sha384 = + object(self) + val context = sha384_init() + method hash_size = 48 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "sha384#add_substring"; + sha512_update context src ofs len + method add_string src = + sha512_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + sha384_final context + method wipe = + wipe_bytes context + end + +let sha384 () = new sha384 + +class sha512 = + object(self) + val context = sha512_init() + method hash_size = 64 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "sha512#add_substring"; + sha512_update context src ofs len + method add_string src = + sha512_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + sha512_final context + method wipe = + wipe_bytes context + end + +let sha512 () = new sha512 + +let sha2 sz = + match sz with + | 224 -> new sha224 + | 256 -> new sha256 + | 384 -> new sha384 + | 512 -> new sha512 + | _ -> raise (Error Wrong_key_size) + +class sha3 sz official = + object(self) + val context = + if sz = 224 || sz = 256 || sz = 384 || sz = 512 + then sha3_init sz + else raise (Error Wrong_key_size) + method hash_size = sz / 8 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg ((if official then "sha3" else "keccak")^"#add_substring"); + sha3_absorb context src ofs len + method add_string src = + sha3_absorb context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = sha3_extract official context + method wipe = + sha3_wipe context + end + +let sha3 sz = new sha3 sz true + +let keccak sz = new sha3 sz false + +class ripemd160 = + object(self) + val context = ripemd160_init() + method hash_size = 32 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "ripemd160#add_substring"; + ripemd160_update context src ofs len + method add_string src = + ripemd160_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + ripemd160_final context + method wipe = + wipe_bytes context + end + +let ripemd160 () = new ripemd160 + +class md5 = + object(self) + val context = md5_init() + method hash_size = 16 + method add_substring src ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length src - len + then invalid_arg "md5#add_substring"; + md5_update context src ofs len + method add_string src = + md5_update context (Bytes.unsafe_of_string src) 0 (String.length src) + method add_char c = + self#add_string (String.make 1 c) + method add_byte b = + self#add_char (Char.unsafe_chr b) + method result = + md5_final context + method wipe = + wipe_bytes context + end + +let md5 () = new md5 + +end + +(* High-level entry points for ciphers *) + +module Cipher = struct + +type direction = dir = Encrypt | Decrypt + +type chaining_mode = + ECB + | CBC + | CFB of int + | OFB of int + | CTR + | CTR_N of int + +let make_block_cipher ?(mode = CBC) ?pad ?iv dir block_cipher = + let chained_cipher = + match (mode, dir) with + (ECB, _) -> block_cipher + | (CBC, Encrypt) -> new Block.cbc_encrypt ?iv block_cipher + | (CBC, Decrypt) -> new Block.cbc_decrypt ?iv block_cipher + | (CFB n, Encrypt) -> new Block.cfb_encrypt ?iv n block_cipher + | (CFB n, Decrypt) -> new Block.cfb_decrypt ?iv n block_cipher + | (OFB n, _) -> new Block.ofb ?iv n block_cipher + | (CTR, _) -> new Block.ctr ?iv block_cipher + | (CTR_N n, _) -> new Block.ctr ?iv ~inc:n block_cipher in + match pad with + None -> new Block.cipher chained_cipher + | Some p -> + match dir with + Encrypt -> new Block.cipher_padded_encrypt p chained_cipher + | Decrypt -> new Block.cipher_padded_decrypt p chained_cipher + +let normalize_dir mode dir = + match mode with + | Some(CFB _) | Some(OFB _) | Some(CTR) | Some(CTR_N _) -> Encrypt + | _ -> dir + +let aes ?mode ?pad ?iv key dir = + make_block_cipher ?mode ?pad ?iv dir + (match normalize_dir mode dir with + Encrypt -> new Block.aes_encrypt key + | Decrypt -> new Block.aes_decrypt key) + +let blowfish ?mode ?pad ?iv key dir = + make_block_cipher ?mode ?pad ?iv dir + (match normalize_dir mode dir with + Encrypt -> new Block.blowfish_encrypt key + | Decrypt -> new Block.blowfish_decrypt key) + +let des ?mode ?pad ?iv key dir = + make_block_cipher ?mode ?pad ?iv dir + (new Block.des (normalize_dir mode dir) key) + +let triple_des ?mode ?pad ?iv key dir = + make_block_cipher ?mode ?pad ?iv dir + (match normalize_dir mode dir with + Encrypt -> new Block.triple_des_encrypt key + | Decrypt -> new Block.triple_des_decrypt key) + +let arcfour key dir = new Stream.cipher (new Stream.arcfour key) + +let chacha20 ?iv ?ctr key dir = + new Stream.cipher (new Stream.chacha20 key ?iv ?ctr) + +end + +(* The hmac construction *) + +module HMAC(H: sig class h: hash val blocksize: int end) = + struct + let hmac_pad key byte = + let key = + if String.length key > H.blocksize + then hash_string (new H.h) key + else key in + let r = Bytes.make H.blocksize (Char.chr byte) in + xor_string key 0 r 0 (String.length key); + r + class hmac key = + object(self) + inherit H.h as super + initializer + (let b = hmac_pad key 0x36 in + self#add_substring b 0 (Bytes.length b); + wipe_bytes b) + method result = + let h' = new H.h in + let b = hmac_pad key 0x5C in + h'#add_substring b 0 (Bytes.length b); + wipe_bytes b; + h'#add_string (super#result); + let r = h'#result in + h'#wipe; + r + end + end + +(* High-level entry points for MACs *) + +module MAC = struct + +module HMAC_SHA1 = + HMAC(struct class h = Hash.sha1 let blocksize = 64 end) +module HMAC_SHA256 = + HMAC(struct class h = Hash.sha256 let blocksize = 64 end) +module HMAC_SHA512 = + HMAC(struct class h = Hash.sha512 let blocksize = 128 end) +module HMAC_RIPEMD160 = + HMAC(struct class h = Hash.ripemd160 let blocksize = 64 end) +module HMAC_MD5 = + HMAC(struct class h = Hash.md5 let blocksize = 64 end) + +let hmac_sha1 key = new HMAC_SHA1.hmac key +let hmac_sha256 key = new HMAC_SHA256.hmac key +let hmac_sha512 key = new HMAC_SHA512.hmac key +let hmac_ripemd160 key = new HMAC_RIPEMD160.hmac key +let hmac_md5 key = new HMAC_MD5.hmac key + +let aes ?iv ?pad key = + new Block.mac ?iv ?pad (new Block.aes_encrypt key) +let des ?iv ?pad key = + new Block.mac ?iv ?pad (new Block.des_encrypt key) +let triple_des ?iv ?pad key = + new Block.mac ?iv ?pad (new Block.triple_des_encrypt key) +let des_final_triple_des ?iv ?pad key = + let kl = String.length key in + if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size); + let k1 = String.sub key 0 8 in + let k2 = String.sub key 8 8 in + let k3 = if kl = 24 then String.sub key 16 8 else k1 in + let c1 = new Block.des_encrypt k1 + and c2 = new Block.des_decrypt k2 + and c3 = new Block.des_encrypt k3 in + wipe_string k1; wipe_string k2; wipe_string k3; + new Block.mac_final_triple ?iv ?pad c1 c2 c3 + +let aes_cmac ?iv key = + let cipher = new Block.aes_encrypt key in + let b = Bytes.make 16 '\000' in + let l = Bytes.create 16 in + cipher#transform b 0 l 0; (* l = AES-128(K, 000...000 *) + Bytes.set b 15 '\x87'; (* b = the Rb constant *) + let k1 = Bytes.create 16 in + shl1_bytes l 0 k1 0 16; + if Char.code (Bytes.get l 0) land 0x80 > 0 then xor_bytes b 0 k1 0 16; + let k2 = Bytes.create 16 in + shl1_bytes k1 0 k2 0 16; + if Char.code (Bytes.get k1 0) land 0x80 > 0 then xor_bytes b 0 k2 0 16; + wipe_bytes l; + new Block.cmac ?iv cipher k1 k2 +end + +(* Random number generation *) + +module Random = struct + +class type rng = + object + method random_bytes: bytes -> int -> int -> unit + method wipe: unit + end + +let string rng len = + let res = Bytes.create len in + rng#random_bytes res 0 len; + Bytes.unsafe_to_string res + +type system_rng_handle +external get_system_rng: unit -> system_rng_handle = "caml_get_system_rng" +external close_system_rng: system_rng_handle -> unit = "caml_close_system_rng" +external system_rng_random_bytes: + system_rng_handle -> bytes -> int -> int -> bool + = "caml_system_rng_random_bytes" + +class system_rng = + object(self) + val h = get_system_rng () + method random_bytes buf ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length buf - len + then invalid_arg "random_bytes"; + if system_rng_random_bytes h buf ofs len + then () + else raise(Error Entropy_source_closed) + method wipe = + close_system_rng h + end + +let system_rng () = + try new system_rng with Not_found -> raise(Error No_entropy_source) + +class device_rng filename = + object(self) + val fd = Unix.openfile filename [Unix.O_RDONLY] 0 + method random_bytes buf ofs len = + if len > 0 then begin + let n = Unix.read fd buf ofs len in + if n = 0 then raise(Error Entropy_source_closed); + if n < len then self#random_bytes buf (ofs + n) (len - n) + end + method wipe = + Unix.close fd + end + +let device_rng filename = new device_rng filename + +class egd_rng socketname = + object(self) + val fd = + let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + try + Unix.connect s (Unix.ADDR_UNIX socketname); s + with exn -> + Unix.close s; raise exn + method random_bytes buf ofs len = + if len > 0 then begin + let reqd = min 255 len in + let msg = Bytes.create 2 in + Bytes.set msg 0 '\002'; (* read entropy blocking *) + Bytes.set msg 1 (Char.chr reqd); + ignore (Unix.write fd msg 0 2); + let rec do_read ofs len = + if len > 0 then begin + let r = Unix.read fd buf ofs len in + if r = 0 then raise(Error Entropy_source_closed); + do_read (ofs + r) (len - r) + end in + do_read ofs reqd; + if reqd < len then self#random_bytes buf (ofs + reqd) (len - reqd) + end + method wipe = + Unix.close fd + end + +let egd_rng socketname = new egd_rng socketname + +external hardware_rng_available: unit -> bool = "caml_hardware_rng_available" +external hardware_rng_random_bytes: bytes -> int -> int -> bool = "caml_hardware_rng_random_bytes" + +class hardware_rng = + object + method random_bytes buf ofs len = + if ofs < 0 || len < 0 || ofs > Bytes.length buf - len + then invalid_arg "hardware_rng#random_bytes"; + if not (hardware_rng_random_bytes buf ofs len) + then raise (Error Entropy_source_closed) + method wipe = + () + end + +let hardware_rng () = + if hardware_rng_available () + then new hardware_rng + else raise (Error No_entropy_source) + +class no_rng = + object + method random_bytes (buf:bytes) (ofs:int) (len:int) : unit = + raise (Error No_entropy_source) + method wipe = () + end + +let secure_rng = + try + new system_rng + with Not_found -> + try + new device_rng "/dev/random" + with Unix.Unix_error(_,_,_) -> + try + new egd_rng (Sys.getenv "EGD_SOCKET") + with Not_found | Unix.Unix_error(_,_,_) -> + try + new egd_rng (Filename.concat (Sys.getenv "HOME") ".gnupg/entropy") + with Not_found | Unix.Unix_error(_,_,_) -> + try + new egd_rng "/var/run/egd-pool" + with Unix.Unix_error(_,_,_) -> + try + new egd_rng "/dev/egd-pool" + with Unix.Unix_error(_,_,_) -> + try + new egd_rng "/etc/egd-pool" + with Unix.Unix_error(_,_,_) -> + new no_rng + +class pseudo_rng seed = + let _ = if String.length seed < 16 then raise (Error Seed_too_short) in + object (self) + val ckey = + let l = String.length seed in + chacha20_cook_key + (if l >= 32 then String.sub seed 0 32 + else if l > 16 then seed ^ String.make (32 - l) '\000' + else seed) + (Bytes.make 8 '\000') 0L + method random_bytes buf ofs len = + if len < 0 || ofs < 0 || ofs > Bytes.length buf - len + then invalid_arg "pseudo_rng#random_bytes" + else chacha20_extract ckey buf ofs len + method wipe = + wipe_bytes ckey; wipe_string seed +end + +let pseudo_rng seed = new pseudo_rng seed + +class pseudo_rng_aes_ctr seed = + let _ = if String.length seed < 16 then raise (Error Seed_too_short) in + object (self) + val cipher = new Block.aes_encrypt (String.sub seed 0 16) + val ctr = Bytes.make 16 '\000' + val obuf = Bytes.create 16 + val mutable opos = 16 + + method random_bytes buf ofs len = + if len > 0 then begin + if opos >= 16 then begin + (* Encrypt the counter *) + cipher#transform ctr 0 obuf 0; + (* Increment the counter *) + Block.increment_counter ctr 0 15; + (* We have 16 fresh bytes of pseudo-random data *) + opos <- 0 + end; + let r = min (16 - opos) len in + Bytes.blit obuf opos buf ofs r; + opos <- opos + r; + if r < len then self#random_bytes buf (ofs + r) (len - r) + end + + method wipe = + wipe_bytes obuf; wipe_string seed + end + +let pseudo_rng_aes_ctr seed = new pseudo_rng_aes_ctr seed + +end + +(* RSA operations *) + +module Bn = CryptokitBignum + +module RSA = struct + +type key = + { size: int; + n: string; + e: string; + d: string; + p: string; + q: string; + dp: string; + dq: string; + qinv: string } + +let wipe_key k = + wipe_string k.n; + wipe_string k.e; + wipe_string k.d; + wipe_string k.p; + wipe_string k.q; + wipe_string k.dp; + wipe_string k.dq; + wipe_string k.qinv + +let encrypt key msg = + let msg = Bn.of_bytes msg in + let n = Bn.of_bytes key.n in + let e = Bn.of_bytes key.e in + if Bn.compare msg n >= 0 then raise (Error Message_too_long); + let r = Bn.mod_power msg e n in + let s = Bn.to_bytes ~numbits:key.size r in + Bn.wipe msg; Bn.wipe n; Bn.wipe e; Bn.wipe r; + s + +let unwrap_signature = encrypt + +let decrypt key msg = + let msg = Bn.of_bytes msg in + let n = Bn.of_bytes key.n in + let d = Bn.of_bytes key.d in + if Bn.compare msg n >= 0 then raise (Error Message_too_long); + let r = Bn.mod_power msg d n in + let s = Bn.to_bytes ~numbits:key.size r in + Bn.wipe msg; Bn.wipe n; Bn.wipe d; Bn.wipe r; + s + +let sign = decrypt + +let decrypt_CRT key msg = + let msg = Bn.of_bytes msg in + let n = Bn.of_bytes key.n in + let p = Bn.of_bytes key.p in + let q = Bn.of_bytes key.q in + let dp = Bn.of_bytes key.dp in + let dq = Bn.of_bytes key.dq in + let qinv = Bn.of_bytes key.qinv in + if Bn.compare msg n >= 0 then raise (Error Message_too_long); + let r = Bn.mod_power_CRT msg p q dp dq qinv in + let s = Bn.to_bytes ~numbits:key.size r in + Bn.wipe msg; Bn.wipe n; Bn.wipe p; Bn.wipe q; + Bn.wipe dp; Bn.wipe dq; Bn.wipe qinv; Bn.wipe r; + s + +let sign_CRT = decrypt_CRT + +let new_key ?(rng = Random.secure_rng) ?e numbits = + if numbits < 32 || numbits land 1 > 0 then raise(Error Wrong_key_size); + let numbits2 = numbits / 2 in + (* Generate primes p, q with numbits / 2 digits. + If fixed exponent e, make sure gcd(p-1,e) = 1 and + gcd(q-1,e) = 1. *) + let rec gen_factor nbits = + let n = Bn.random_prime ~rng:(rng#random_bytes) nbits in + match e with + None -> n + | Some e -> + if Bn.relative_prime (Bn.sub n Bn.one) (Bn.of_int e) + then n + else gen_factor nbits in + (* Make sure p > q *) + let rec gen_factors nbits = + let p = gen_factor nbits + and q = gen_factor nbits in + let cmp = Bn.compare p q in + if cmp = 0 then gen_factors nbits else + if cmp < 0 then (q, p) else (p, q) in + let (p, q) = gen_factors numbits2 in + (* p1 = p - 1 and q1 = q - 1 *) + let p1 = Bn.sub p Bn.one + and q1 = Bn.sub q Bn.one in + (* If no fixed exponent specified, generate random exponent e such that + gcd(p-1,e) = 1 and gcd(q-1,e) = 1 *) + let e = + match e with + Some e -> Bn.of_int e + | None -> + let rec gen_exponent () = + let n = Bn.random ~rng:(rng#random_bytes) numbits in + if Bn.relative_prime n p1 && Bn.relative_prime n q1 + then n + else gen_exponent () in + gen_exponent () in + (* n = pq *) + let n = Bn.mult p q in + (* d = e^-1 mod (p-1)(q-1) *) + let d = Bn.mod_inv e (Bn.mult p1 q1) in + (* dp = d mod p-1 and dq = d mod q-1 *) + let dp = Bn.mod_ d p1 and dq = Bn.mod_ d q1 in + (* qinv = q^-1 mod p *) + let qinv = Bn.mod_inv q p in + (* Build key *) + let res = + { size = numbits; + n = Bn.to_bytes ~numbits:numbits n; + e = Bn.to_bytes ~numbits:numbits e; + d = Bn.to_bytes ~numbits:numbits d; + p = Bn.to_bytes ~numbits:numbits2 p; + q = Bn.to_bytes ~numbits:numbits2 q; + dp = Bn.to_bytes ~numbits:numbits2 dp; + dq = Bn.to_bytes ~numbits:numbits2 dq; + qinv = Bn.to_bytes ~numbits:numbits2 qinv } in + Bn.wipe n; Bn.wipe e; Bn.wipe d; + Bn.wipe p; Bn.wipe q; + Bn.wipe p1; Bn.wipe q1; + Bn.wipe dp; Bn.wipe dq; Bn.wipe qinv; + res + +end + +(* Diffie-Hellman key agreement *) + +module DH = struct + +type parameters = + { p: string; + g: string; + privlen: int } + +let new_parameters ?(rng = Random.secure_rng) ?(privlen = 160) numbits = + if numbits < 32 || numbits <= privlen then raise(Error Wrong_key_size); + let np = Bn.random_prime ~rng:(rng#random_bytes) numbits in + let rec find_generator () = + let g = Bn.random ~rng:(rng#random_bytes) (numbits - 1) in + if Bn.compare g Bn.one <= 0 then find_generator() else g in + let ng = find_generator () in + { p = Bn.to_bytes ~numbits np; + g = Bn.to_bytes ~numbits ng; + privlen = privlen } + +type private_secret = Bn.t + +let private_secret ?(rng = Random.secure_rng) params = + Bn.random ~rng:(rng#random_bytes) params.privlen + +let message params privsec = + Bn.to_bytes ~numbits:(String.length params.p * 8) + (Bn.mod_power (Bn.of_bytes params.g) privsec (Bn.of_bytes params.p)) + +let shared_secret params privsec othermsg = + let res = + Bn.to_bytes ~numbits:(String.length params.p * 8) + (Bn.mod_power (Bn.of_bytes othermsg) privsec (Bn.of_bytes params.p)) + in Bn.wipe privsec; res + +let derive_key ?(diversification = "") sharedsec numbytes = + let result = Bytes.create numbytes in + let rec derive pos counter = + if pos < numbytes then begin + let h = + hash_string (Hash.sha1()) + (diversification ^ sharedsec ^ string_of_int counter) in + String.blit h 0 result pos (min (String.length h) (numbytes - pos)); + wipe_string h; + derive (pos + String.length h) (counter + 1) + end in + derive 0 1; + Bytes.unsafe_to_string result + +end + +(* Base64 encoding *) + +module Base64 = struct + +let base64_conv_table = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + +class encode multiline padding = + object (self) + method input_block_size = 1 + method output_block_size = 1 + + inherit buffered_output 256 as output_buffer + + val ibuf = Bytes.create 3 + val mutable ipos = 0 + val mutable ocolumn = 0 + + method put_char c = + Bytes.set ibuf ipos c; + ipos <- ipos + 1; + if ipos = 3 then begin + let b0 = Char.code (Bytes.get ibuf 0) + and b1 = Char.code (Bytes.get ibuf 1) + and b2 = Char.code (Bytes.get ibuf 2) in + self#ensure_capacity 4; + Bytes.set obuf oend base64_conv_table.[b0 lsr 2]; + Bytes.set obuf (oend+1) base64_conv_table.[(b0 land 3) lsl 4 + (b1 lsr 4)]; + Bytes.set obuf (oend+2) base64_conv_table.[(b1 land 15) lsl 2 + (b2 lsr 6)]; + Bytes.set obuf (oend+3) base64_conv_table.[b2 land 63]; + oend <- oend + 4; + ipos <- 0; + ocolumn <- ocolumn + 4; + if multiline && ocolumn >= 72 then begin + self#ensure_capacity 1; + Bytes.set obuf oend '\n'; + oend <- oend + 1; + ocolumn <- 0 + end + end + + method put_substring s ofs len = + for i = ofs to ofs + len - 1 do self#put_char (Bytes.get s i) done + + method put_string s = + String.iter self#put_char s + + method put_byte b = self#put_char (Char.chr b) + + method flush : unit = raise (Error Wrong_data_length) + + method finish = + begin match ipos with + 1 -> + self#ensure_capacity 2; + let b0 = Char.code (Bytes.get ibuf 0) in + Bytes.set obuf oend base64_conv_table.[b0 lsr 2]; + Bytes.set obuf (oend+1) base64_conv_table.[(b0 land 3) lsl 4]; + oend <- oend + 2 + | 2 -> + self#ensure_capacity 3; + let b0 = Char.code (Bytes.get ibuf 0) + and b1 = Char.code (Bytes.get ibuf 1) in + Bytes.set obuf oend base64_conv_table.[b0 lsr 2]; + Bytes.set obuf (oend+1) base64_conv_table.[(b0 land 3) lsl 4 + (b1 lsr 4)]; + Bytes.set obuf (oend+2) (base64_conv_table.[(b1 land 15) lsl 2]); + oend <- oend + 3 + | _ -> () + end; + if multiline || padding then begin + let num_equals = + match ipos with 1 -> 2 | 2 -> 1 | _ -> 0 in + self#ensure_capacity num_equals; + Bytes.fill obuf oend num_equals '='; + oend <- oend + num_equals + end; + if multiline && ocolumn > 0 then begin + self#ensure_capacity 1; + Bytes.set obuf oend '\n'; + oend <- oend + 1 + end; + ocolumn <- 0 + + method wipe = + wipe_bytes ibuf; output_buffer#wipe + end + +let encode_multiline () = new encode true true +let encode_compact () = new encode false false +let encode_compact_pad () = new encode false true + +let base64_decode_char c = + match c with + 'A' .. 'Z' -> Char.code c - 65 + | 'a' .. 'z' -> Char.code c - 97 + 26 + | '0' .. '9' -> Char.code c - 48 + 52 + | '+' -> 62 + | '/' -> 63 + | ' '|'\t'|'\n'|'\r' -> -1 + | _ -> raise (Error Bad_encoding) + +class decode = + object (self) + inherit buffered_output 256 as output_buffer + + method input_block_size = 1 + method output_block_size = 1 + + val ibuf = Array.make 4 0 + val mutable ipos = 0 + val mutable finished = false + + method put_char c = + if c = '=' then finished <- true else begin + let n = base64_decode_char c in + if n >= 0 then begin + if finished then raise(Error Bad_encoding); + ibuf.(ipos) <- n; + ipos <- ipos + 1; + if ipos = 4 then begin + self#ensure_capacity 3; + Bytes.set obuf oend (Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4)); + Bytes.set obuf (oend+1) (Char.chr((ibuf.(1) land 15) lsl 4 + ibuf.(2) lsr 2)); + Bytes.set obuf (oend+2) (Char.chr((ibuf.(2) land 3) lsl 6 + ibuf.(3))); + oend <- oend + 3; + ipos <- 0 + end + end + end + + method put_substring s ofs len = + for i = ofs to ofs + len - 1 do self#put_char (Bytes.get s i) done + + method put_string s = + String.iter self#put_char s + + method put_byte b = self#put_char (Char.chr b) + + method flush : unit = raise (Error Wrong_data_length) + + method finish = + finished <- true; + match ipos with + | 1 -> raise(Error Bad_encoding) + | 2 -> + self#ensure_capacity 1; + Bytes.set obuf oend (Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4)); + oend <- oend + 1 + | 3 -> + self#ensure_capacity 2; + Bytes.set obuf oend (Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4)); + Bytes.set obuf (oend+1) (Char.chr((ibuf.(1) land 15) lsl 4 + ibuf.(2) lsr 2)); + oend <- oend + 2 + | _ -> () + + method wipe = + Array.fill ibuf 0 4 0; output_buffer#wipe + end + +let decode () = new decode + +end + +(* Hexadecimal encoding *) + +module Hexa = struct + +let hex_conv_table = "0123456789abcdef" + +class encode = + object (self) + method input_block_size = 1 + method output_block_size = 1 + + inherit buffered_output 256 as output_buffer + + method put_byte b = + self#ensure_capacity 2; + Bytes.set obuf oend (hex_conv_table.[b lsr 4]); + Bytes.set obuf (oend+1) (hex_conv_table.[b land 0xF]); + oend <- oend + 2 + + method put_char c = self#put_byte (Char.code c) + + method put_substring s ofs len = + for i = ofs to ofs + len - 1 do self#put_char (Bytes.get s i) done + + method put_string s = + String.iter self#put_char s + + method flush = () + method finish = () + + method wipe = output_buffer#wipe + end + +let encode () = new encode + +let hex_decode_char c = + match c with + | '0' .. '9' -> Char.code c - 48 + | 'A' .. 'F' -> Char.code c - 65 + 10 + | 'a' .. 'f' -> Char.code c - 97 + 10 + | ' '|'\t'|'\n'|'\r' -> -1 + | _ -> raise (Error Bad_encoding) + +class decode = + object (self) + inherit buffered_output 256 as output_buffer + + method input_block_size = 1 + method output_block_size = 1 + + val ibuf = Array.make 2 0 + val mutable ipos = 0 + + method put_char c = + let n = hex_decode_char c in + if n >= 0 then begin + ibuf.(ipos) <- n; + ipos <- ipos + 1; + if ipos = 2 then begin + self#ensure_capacity 1; + Bytes.set obuf oend (Char.chr(ibuf.(0) lsl 4 lor ibuf.(1))); + oend <- oend + 1; + ipos <- 0 + end + end + + method put_substring s ofs len = + for i = ofs to ofs + len - 1 do self#put_char (Bytes.get s i) done + + method put_string s = + String.iter self#put_char s + + method put_byte b = self#put_char (Char.chr b) + + method flush = + if ipos <> 0 then raise(Error Wrong_data_length) + + method finish = + if ipos <> 0 then raise(Error Bad_encoding) + + method wipe = + Array.fill ibuf 0 2 0; output_buffer#wipe + end + +let decode () = new decode + +end + +(* Compression *) + +module Zlib = struct + +type stream + +type flush_command = + Z_NO_FLUSH + | Z_SYNC_FLUSH + | Z_FULL_FLUSH + | Z_FINISH + +external deflate_init: int -> bool -> stream = "caml_zlib_deflateInit" +external deflate: + stream -> bytes -> int -> int -> bytes -> int -> int -> flush_command + -> bool * int * int + = "caml_zlib_deflate_bytecode" "caml_zlib_deflate" +external deflate_end: stream -> unit = "caml_zlib_deflateEnd" + +external inflate_init: bool -> stream = "caml_zlib_inflateInit" +external inflate: + stream -> bytes -> int -> int -> bytes -> int -> int -> flush_command + -> bool * int * int + = "caml_zlib_inflate_bytecode" "caml_zlib_inflate" +external inflate_end: stream -> unit = "caml_zlib_inflateEnd" + +class compress level = + object(self) + val zs = deflate_init level false + + inherit buffered_output 512 as output_buffer + + method input_block_size = 1 + method output_block_size = 1 + + method put_substring src ofs len = + if len > 0 then begin + self#ensure_capacity 256; + let (_, used_in, used_out) = + deflate zs + src ofs len + obuf oend (Bytes.length obuf - oend) + Z_NO_FLUSH in + oend <- oend + used_out; + if used_in < len + then self#put_substring src (ofs + used_in) (len - used_in) + end + + method put_string s = + self#put_substring (Bytes.unsafe_of_string s) 0 (String.length s) + + method put_char c = self#put_string (String.make 1 c) + + method put_byte b = self#put_char (Char.chr b) + + method flush = + self#ensure_capacity 256; + let (_, _, used_out) = + deflate zs + (Bytes.unsafe_of_string "") 0 0 + obuf oend (Bytes.length obuf - oend) + Z_SYNC_FLUSH in + oend <- oend + used_out; + if oend = Bytes.length obuf then self#flush + + method finish = + self#ensure_capacity 256; + let (finished, _, used_out) = + deflate zs + (Bytes.unsafe_of_string "") 0 0 + obuf oend (Bytes.length obuf - oend) + Z_FINISH in + oend <- oend + used_out; + if finished then deflate_end zs else self#finish + + method wipe = + output_buffer#wipe +end + +let compress ?(level = 6) () = new compress level + +class uncompress = + object(self) + val zs = inflate_init false + + inherit buffered_output 512 as output_buffer + + method input_block_size = 1 + method output_block_size = 1 + + method put_substring src ofs len = + if len > 0 then begin + self#ensure_capacity 256; + let (finished, used_in, used_out) = + inflate zs + src ofs len + obuf oend (Bytes.length obuf - oend) + Z_SYNC_FLUSH in + oend <- oend + used_out; + if used_in < len then begin + if finished then + raise(Error(Compression_error("Zlib.uncompress", + "garbage at end of compressed data"))); + self#put_substring src (ofs + used_in) (len - used_in) + end + end + + method put_string s = + self#put_substring (Bytes.unsafe_of_string s) 0 (String.length s) + + method put_char c = self#put_string (String.make 1 c) + + method put_byte b = self#put_char (Char.chr b) + + method flush = () + + method finish = + let rec do_finish first_finish = + self#ensure_capacity 256; + let (finished, _, used_out) = + inflate zs + (Bytes.unsafe_of_string " ") 0 (if first_finish then 1 else 0) + obuf oend (Bytes.length obuf - oend) + Z_SYNC_FLUSH in + oend <- oend + used_out; + if not finished then do_finish false in + do_finish true; inflate_end zs + + method wipe = + output_buffer#wipe +end + +let uncompress () = new uncompress + +end + +(* Utilities *) + +let xor_bytes src src_ofs dst dst_ofs len = + if len < 0 + || src_ofs < 0 || src_ofs > Bytes.length src - len + || dst_ofs < 0 || dst_ofs > Bytes.length dst - len + then invalid_arg "xor_bytes"; + xor_bytes src src_ofs dst dst_ofs len + +let xor_string src src_ofs dst dst_ofs len = + if len < 0 + || src_ofs < 0 || src_ofs > String.length src - len + || dst_ofs < 0 || dst_ofs > Bytes.length dst - len + then invalid_arg "xor_string"; + xor_string src src_ofs dst dst_ofs len + +let mod_power a b c = + Bn.to_bytes ~numbits:(String.length c * 8) + (Bn.mod_power (Bn.of_bytes a) (Bn.of_bytes b) (Bn.of_bytes c)) +let mod_mult a b c = + Bn.to_bytes ~numbits:(String.length c * 8) + (Bn.mod_ (Bn.mult (Bn.of_bytes a) (Bn.of_bytes b)) + (Bn.of_bytes c)) diff --git a/src/cryptokit.mldylib b/src/cryptokit.mldylib new file mode 100644 index 0000000..c8577fb --- /dev/null +++ b/src/cryptokit.mldylib @@ -0,0 +1,5 @@ +# OASIS_START +# DO NOT EDIT (digest: f65b9dc92e3f638af8533b26ac90c400) +CryptokitBignum +Cryptokit +# OASIS_STOP diff --git a/src/cryptokit.mli b/src/cryptokit.mli new file mode 100644 index 0000000..49d42de --- /dev/null +++ b/src/cryptokit.mli @@ -0,0 +1,1160 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(** The Cryptokit library provides a variety of cryptographic primitives + that can be used to implement cryptographic protocols in + security-sensitive applications. The primitives provided include: + - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, + in ECB, CBC, CFB and OFB modes. + - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. + - Hash functions and MACs: SHA-1, SHA-256, SHA-512. SHA-3, RIPEMD-160, MD5, + and MACs based on AES and DES. + - Random number generation. + - Encodings and compression: base 64, hexadecimal, Zlib compression. + + To use this library, link with + [ocamlc unix.cma nums.cma cryptokit.cma] + or + [ocamlopt unix.cmxa nums.cmxa cryptokit.cmxa]. +*) + +(** {1 General-purpose abstract interfaces} *) + +(** A transform is an arbitrary mapping from sequences of characters + to sequences of characters. Examples of transforms include + ciphering, deciphering, compression, decompression, and encoding + of binary data as text. Input data to a transform is provided + by successive calls to the methods [put_substring], [put_string], + [put_char] or [put_byte]. The result of transforming the input + data is buffered internally, and can be obtained via the + [get_string], [get_substring], [get_char] and [get_byte] methods. *) +class type transform = + object + method put_substring: bytes -> int -> int -> unit + (** [put_substring b pos len] processes [len] characters of + byte sequence [b], starting at character number [pos], + through the transform. *) + method put_string: string -> unit + (** [put_string str] processes all characters of string [str] + through the transform. *) + method put_char: char -> unit + (** [put_char c] processes character [c] through the transform. *) + method put_byte: int -> unit + (** [put_byte b] processes the character having code [b] + through the transform. [b] must be between [0] and [255] + inclusive. *) + method finish: unit + (** Call method [finish] to indicate that no further data will + be processed through the transform. This causes the transform + to flush its internal buffers and perform all appropriate + finalization actions, e.g. add final padding. Raise [Error + Wrong_data_length] if the total length of input data + provided via the [put_*] methods is not an integral number + of the input block size (see + {!Cryptokit.transform.input_block_size}). After calling + [finish], the transform can no longer accept additional + data. Hence, do not call any of the [put_*] methods nor + [flush] after calling [finish]. *) + method flush: unit + (** [flush] causes the transform to flush its internal buffers + and make all output processed up to this point available through + the [get_*] methods. + Raise [Error Wrong_data_length] if the total length + of input data provided via the [put_*] methods is not + an integral number of the input block size + (see {!Cryptokit.transform.input_block_size}). + (For padded block ciphers, the input block size used here + is that of the underlying block cipher, without the padding.) + Unlike method [finish], method [flush] does not add final + padding and leaves the transform in a state where it can + still accept more input. *) + method available_output: int + (** Return the number of characters of output currently available. + The output can be recovered with the [get_*] methods. *) + method get_string: string + (** Return a character string containing all output characters + available at this point. The internal output buffer is emptied; + in other terms, all currently available output is consumed + (and returned to the caller) by a call to [get_string]. *) + method get_substring: bytes * int * int + (** Return a triple [(buf,pos,len)], where [buf] is the internal + output buffer for the transform, [pos] the position of the + first character of available output, and [len] the number of + characters of available output. The byte array [buf] will be + modified later, so the caller must immediately copy + characters [pos] to [pos+len-1] of [buf] to some other + location. The internal output buffer is emptied; + in other terms, all currently available output is consumed + (and returned to the caller) by a call to [get_substring]. *) + method get_char: char + (** Return the first character of output, and remove it from the + internal output buffer. Raise [End_of_file] if no output + is currently available. *) + method get_byte: int + (** Return the code of the first character of output, + and remove it from the internal output buffer. + Raise [End_of_file] if no output is currently available. *) + method input_block_size: int + (** Some transforms (e.g. unpadded block ciphers) process + input data by blocks of several characters. This method + returns the size of input blocks for the current transform. + If [input_block_size > 1], the user of the transform + must ensure that the total length of input data provided + between calls to [flush] and [finish] is an integral + multiple of [input_block_size]. + If [input_block_size = 1], the transform can accept + input data of arbitrary length. *) + method output_block_size: int + (** Some transforms (e.g. block ciphers) always produce output + data by blocks of several characters. This method + returns the size of output blocks for the current transform. + If [output_block_size > 1], the total length of output data + produced by the transform is always an integral multiple + of [output_block_size]. + If [output_block_size = 1], the transform produces output data + of arbitrary length. *) + method wipe: unit + (** Erase all internal buffers and data structures of this transform, + overwriting them with zeroes. A transform may contain sensitive + data such as secret key-derived material, or parts of the + input or output data. Calling [wipe] ensures that this sensitive + data will not remain in memory longer than strictly necessary, + thus making invasive attacks more difficult. + It is thus prudent practice to call [wipe] on every + transform that the program no longer needs. + After calling [wipe], the transform is no longer in a working + state: do not call any other methods after calling [wipe]. *) + end + +val transform_string: transform -> string -> string + (** [transform_string t s] runs the string [s] through the + transform [t] and returns the transformed string. + The transform [t] is wiped before returning, hence can + no longer be used for further transformations. *) + +val transform_channel: + transform -> ?len:int -> in_channel -> out_channel -> unit + (** [transform_channel t ic oc] reads characters from input channel [ic], + runs them through the transform [t], and writes the transformed + data to the output channel [oc]. If the optional [len] argument + is provided, exactly [len] characters are read from [ic] and + transformed; [End_of_file] is raised if [ic] does not contain + at least [len] characters. If [len] is not provided, [ic] is + read all the way to end of file. + The transform [t] is wiped before returning, hence can + no longer be used for further transformations. *) + +val compose: transform -> transform -> transform + (** Compose two transforms, feeding the output of the first transform + to the input of the second transform. *) + +(** A hash is a function that maps arbitrarily-long character + sequences to small, fixed-size strings. *) +class type hash = + object + method add_substring: bytes -> int -> int -> unit + (** [add_substring b pos len] adds [len] characters from byte array + [b], starting at character number [pos], to the running + hash computation. *) + method add_string: string -> unit + (** [add_string str] adds all characters of string [str] + to the running hash computation. *) + method add_char: char -> unit + (** [add_char c] adds character [c] to the running hash computation. *) + method add_byte: int -> unit + (** [add_byte b] adds the character having code [b] + to the running hash computation. [b] must be between [0] and [255] + inclusive. *) + method result: string + (** Terminate the hash computation and return the hash value for + the input data provided via the [add_*] methods. The hash + value is a string of length [hash_size] characters. + After calling [result], the hash can no longer accept + additional data. Hence, do not call any of the [add_*] methods + after [result]. *) + method hash_size: int + (** Return the size of hash values produced by this hash function, + in bytes. *) + method wipe: unit + (** Erase all internal buffers and data structures of this hash, + overwriting them with zeroes. See {!Cryptokit.transform.wipe}. *) + end + +val hash_string: hash -> string -> string + (** [hash_string h s] runs the string [s] through the hash function [h] + and returns the hash value of [s]. + The hash [h] is wiped before returning, hence can + no longer be used for further hash computations. *) +val hash_channel: hash -> ?len:int -> in_channel -> string + (** [hash_channel h ic] reads characters from the input channel [ic], + computes their hash value and returns it. + If the optional [len] argument is provided, exactly [len] characters + are read from [ic] and hashed; [End_of_file] is raised if [ic] + does not contain at least [len] characters. + If [len] is not provided, [ic] is read all the way to end of file. + The hash [h] is wiped before returning, hence can + no longer be used for further hash computations. *) + +(** {1 Utilities: random numbers and padding schemes} *) + +(** The [Random] module provides random and pseudo-random number generators + suitable for generating cryptographic keys, nonces, or challenges. *) +module Random : sig + + class type rng = + object + method random_bytes: bytes -> int -> int -> unit + (** [random_bytes buf pos len] stores [len] random bytes + in byte array [buf], starting at position [pos]. *) + method wipe: unit + (** Erases the internal state of the generator. + Do not call [random_bytes] after calling [wipe]. *) + end + (** Generic interface for a random number generator. *) + + val string: rng -> int -> string + (** [random_string rng len] returns a string of [len] random bytes + read from the generator [rng]. *) + + val secure_rng: rng + (** A high-quality random number generator, using hard-to-predict + system data to generate entropy. This generator either uses + the OS-provided RNG, if any, or reads from + [/dev/random] on systems that supports it, or interrogates + the EGD daemon otherwise (see [http://egd.sourceforge.net/]). + For EGD, the following paths are tried to locate the Unix socket + used to communicate with EGD: + - the value of the environment variable [EGD_SOCKET]; + - [$HOME/.gnupg/entropy]; + - [/var/run/egd-pool]; [/dev/egd-pool]; [/etc/egd-pool]. + + The method [secure_rng#random_bytes] fails + if no suitable RNG is available. + [secure_rng#random_bytes] may block until enough entropy + has been gathered. Do not use for generating large quantities + of random data, otherwise you could exhaust the entropy sources + of the system. *) + + val system_rng: unit -> rng + (** [system_rng ()] returns a random number generator derived + from the OS-provided RNG. It raises [Error No_entropy_source] + if the OS does not provide a secure RNG. Currently, this function + is supported under Win32, and always fails under Unix. *) + + val device_rng: string -> rng + (** [device_rng devicename] returns a random number generator + that reads from the special file [devicename], e.g. + [/dev/random] or [/dev/urandom]. *) + + val egd_rng: string -> rng + (** [device_rng egd_socket] returns a random number generator + that uses the Entropy Gathering Daemon ([http://egd.sourceforge.net/]). + [egd_socket] is the path to the Unix socket that EGD uses for + communication. *) + + val hardware_rng: unit -> rng + (** A hardware random number generator based on the [RDRAND] instruction + of the x86 architecture. Available only on recent Intel and AMD + x86 processors in 64-bit mode. Raises [Error No_entropy_source] + if not available. *) + + val pseudo_rng: string -> rng + (** [pseudo_rng seed] returns a pseudo-random number generator + seeded by the string [seed]. [seed] must contain at least + 16 characters, and can be arbitrarily longer than this, + except that only the first 32 characters are used. + The seed is used as a key for the Chacha20 stream cipher. + The generated pseudo-random data is the result of encrypting + the all-zero input with Chacha20. + While this generator is believed to have very good statistical + properties, it still does not generate ``true'' randomness: + the entropy of the byte strings it produces cannot exceed the + entropy contained in the seed. As a typical use, + [Random.pseudo_rng (Random.string Random.secure_rng 20)] returns a + generator that can generate arbitrarily long strings of pseudo-random + data without delays, and with a total entropy of approximately + 160 bits. *) + + val pseudo_rng_aes_ctr: string -> rng + (** This is another pseudo-random number generator, based on the AES + block cipher in counter mode. It is slightly slower than [pseudo_rng] + while having similar randomness characteristics. + The only reason to use it instead of [pseudo_rng] is that AES + has been cryptanalyzed even more than Chacha20. + The [seed] argument must contain at least 16 characters. Only the + first 16 characters are used, as an AES key. The generated + pseudo-random data is the result of encrypting the 128-bit integers + [0, 1, 2, ...] with this key. *) + +end + +(** The [Padding] module defines a generic interface + for padding input data to an integral number of blocks, + as well as two popular padding schemes. *) +module Padding : sig + + class type scheme = + object + method pad: bytes -> int -> unit + (** [pad buf used] is called with a byte array [buf] + containing valid input data at positions [0, ..., used-1]. + The [pad] method must write padding characters in positions + [used] to [Bytes.length str - 1]. It is guaranteed that + [used < Bytes.length str], so that at least one character of + padding must be added. The padding scheme must be unambiguous + in the following sense: from [buf] after padding, it must be + possible to determine [used] unambiguously. (This is what + method {!Cryptokit.Padding.scheme.strip} does.) *) + method strip: bytes -> int + (** This is the converse of the [pad] operation: from a padded + byte array [buf] as built by method [pad], [strip buf] determines + and returns the starting position of the padding data, + or equivalently the length of valid, non-padded input data + in [buf]. This method must raise [Error Bad_padding] if + [buf] does not have the format of a padded block as produced + by [pad]. *) + end + (** Generic interface of a padding scheme. *) + + val length: scheme + (** This padding scheme pads data with [n] copies of the character + having code [n]. The integer [n] lies between 1 and the block + size (included). This constraint ensures non-ambiguity. + This scheme is defined in RFC 2040 and in PKCS 5 and 7. *) + val _8000: scheme + (** This padding scheme pads data with one [0x80] byte, followed + by as many [0] bytes as needed to fill the block. *) +end + +(** {1 Cryptographic primitives (simplified interface)} *) + +(** The [Cipher] module implements the AES, DES, Triple-DES, ARCfour + and Blowfish symmetric ciphers. Symmetric ciphers are presented + as transforms parameterized by a secret key and a ``direction'' + indicating whether encryption or decryption is to be performed. + The same secret key is used for encryption and for decryption. *) +module Cipher : sig + + type direction = Encrypt | Decrypt + (** Indicate whether the cipher should perform encryption + (transforming plaintext to ciphertext) or decryption + (transforming ciphertext to plaintext). *) + + type chaining_mode = + ECB + | CBC + | CFB of int + | OFB of int + | CTR + | CTR_N of int + (** Block ciphers such as AES or DES map a fixed-sized block of + input data to a block of output data of the same size. + A chaining mode indicates how to extend them to multiple blocks + of data. The five chaining modes supported in this library are: + - [ECB]: Electronic Code Book mode. + - [CBC]: Cipher Block Chaining mode. + - [CFB n]: Cipher Feedback Block with [n] bytes. + - [OFB n]: Output Feedback Block with [n] bytes + - [CTR]: Counter mode, incrementing all the bytes of the IV + - [CTR_N n]: Counter mode, incrementing only the final [n] + bytes of the IV. For example, [CTR_N 4] increments + the final 32 bits of the IV, as in NIST Special Publication + 800-38D. + + A detailed description of these modes is beyond the scope of + this documentation; refer to a good cryptography book. + [CBC] is a recommended default. For [CFB n] and [OFB n], + note that the blocksize is reduced to [n], but encryption + speed drops by a factor of [blocksize / n], where [blocksize] + is the block size of the underlying cipher; moreover, [n] + must be between [1] and [blocksize] included. For [CTR_N n], + [n] must be between [1] and [blocksize] included. + [CTR] is equivalent to [CTR_N blocksize]. *) + +(** {2 Recommended ciphers} *) + + val aes: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> + string -> direction -> transform + (** AES is the Advanced Encryption Standard, also known as Rijndael. + This is a modern block cipher, recently standardized. + It processes data by blocks of 128 bits (16 bytes), + and supports keys of 128, 192 or 256 bits. + The string argument is the key; it must have length 16, 24 or 32. + The direction argument specifies whether encryption or decryption + is to be performed. + + The optional [mode] argument specifies a + chaining mode, as described above; [CBC] is used by default. + + The optional [pad] argument specifies a padding scheme to + pad cleartext to an integral number of blocks. If no [pad] + argument is given, no padding is performed and the length + of the cleartext must be an integral number of blocks. + + The optional [iv] argument is the initialization vector used + by the chaining mode. It is ignored in ECB mode. If + provided, it must be a string of the same size as the block + size (16 bytes). If omitted, the null initialization vector + (16 zero bytes) is used. + + The [aes] function returns a transform that performs encryption + or decryption, depending on the direction argument. *) + + val chacha20: ?iv:string -> ?ctr:int64 -> string -> direction -> transform + (** Chacha20 is a stream cipher proposed by D. J. Bernstein in 2008. + + The Chacha20 cipher is a stream cipher, not a block cipher. + Hence, its natural block size is 1, and no padding is + required. Chaining modes do not apply. A feature of stream + ciphers is that the xor of two ciphertexts obtained with the + same key is the xor of the corresponding plaintexts, which + allows various attacks. Hence, the same key must never be + reused. + + The string argument is the key; its length must be either 16 + or (better) 32. + + The optional [iv] argument is the initialization vector (also + called nonce) that can be used to diversify the key. If present, + it must be 8 characters long. If absent, it is taken to be + eight zero bytes. + + The optional [ctr] argument is the initial value of the internal + counter. If absent, it defaults to 0. + + The direction argument is present for consistency with the + other ciphers only, and is actually ignored: for all stream + ciphers, decryption is the same function as encryption. *) + +(** {2 Weaker, older ciphers, not recommended for new applications} *) + + val des: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> + string -> direction -> transform + (** DES is the Data Encryption Standard. Very popular in the past, + but now completely insecure owing to its small key size (56 bits) + which can easily be broken by brute-force enumeration. + It should therefore be considered as weak encryption. + Its block size is 64 bits (8 bytes). + The arguments to the [des] function have the same meaning as + for the {!Cryptokit.Cipher.aes} function. The key argument is + a string of length 8 (64 bits); the least significant bit of + each key byte is ignored. *) + + val triple_des: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> + string -> direction -> transform + (** Triple DES with two or three DES keys. + This is a popular variant of DES + where each block is encrypted with a 56-bit key [k1], + decrypted with another 56-bit key [k2], then re-encrypted with + either [k1] or a third 56-bit key [k3]. + This results in a 112-bit or 168-bit key length that resists + brute-force attacks. However, the three encryptions required + on each block make this cipher quite slow (4 times slower than + AES). Moreover, the small block size (64 bits) opens the way + to collision-based attacks. Triple DES should therefore be + considered as relatively weak encryption. + The arguments to the [triple_des] function have the + same meaning as for the {!Cryptokit.Cipher.aes} function. The + key argument is a string of length 16 or 24, representing the + concatenation of the key parts [k1], [k2], and optionally + [k3]. The least significant bit of each key byte is + ignored. *) + + val arcfour: string -> direction -> transform + (** ARCfour (``alleged RC4'') is a fast stream cipher + that appears to produce equivalent results with the commercial + RC4 cipher from RSA Data Security Inc. This company holds the + RC4 trademark, and sells the real RC4 cipher. So, it is prudent + not to use ARCfour in a commercial product. + + ARCfour is popular for its speed: approximately 2 times faster + than AES. It accepts any key length up to 2048 bits. However, + the security of ARCfour is being questioned owing to several + statistical biases in its output. It should not be used for + new applications. + + The ARCfour cipher is a stream cipher, not a block cipher. + Hence, its natural block size is 1, and no padding is + required. Chaining modes do not apply. A feature of stream + ciphers is that the xor of two ciphertexts obtained with the + same key is the xor of the corresponding plaintexts, which + allows various attacks. Hence, the same key must never be + reused. + + The string argument is the key; its length must be between + 1 and 256 inclusive. The direction argument is present for + consistency with the other ciphers only, and is actually + ignored: for all stream ciphers, decryption is the same + function as encryption. *) + + val blowfish: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> + string -> direction -> transform + (** Blowfish is a fast block cipher proposed by B.Schneier in 1994. + It processes data by blocks of 64 bits (8 bytes), + and supports keys of 32 to 448 bits. + + The small block size (64 bits) of Blowfish opens the way to + some collision-based attacks. Depending on the application, + ciphers with larger block size should be preferred. + + The string argument is the key; its length must be between + 4 and 56. + + The direction argument specifies whether encryption or decryption + is to be performed. + + The optional [mode] argument specifies a + chaining mode, as described above; [CBC] is used by default. + + The optional [pad] argument specifies a padding scheme to + pad cleartext to an integral number of blocks. If no [pad] + argument is given, no padding is performed and the length + of the cleartext must be an integral number of blocks. + + The optional [iv] argument is the initialization vector used + by the chaining mode. It is ignored in ECB mode. + If provided, it must be a string of the same size as the block size + (8 bytes). If omitted, the null initialization vector + (8 zero bytes) is used. + + The [blowfish] function returns a transform that performs encryption + or decryption, depending on the direction argument. *) +end + +(** The [Hash] module implements unkeyed cryptographic hashes (SHA-1, + SHA-256, SHA-512, SHA-3, RIPEMD-160 and MD5), also known as + message digest functions. + Hash functions used in cryptography are characterized as being + one-way (given a hash value, it is computationally + infeasible to find a text that hashes to this value) and + collision-resistant (it is computationally infeasible to + find two different texts that hash to the same value). Thus, the + hash of a text can be used as a compact replacement for this text + for the purposes of ensuring integrity of the text. *) +module Hash : sig + +(** {2 Recommended hashes} *) + + val sha3: int -> hash + (** SHA-3, the latest NIST standard for cryptographic hashing, + produces hashes of 224, 256, 384 or 512 bits (24, 32, 48 or 64 + bytes). The parameter is the desired size of the hash, in + bits. It must be one of 224, 256, 384 or 512. *) + val keccak: int -> hash + (** The Keccak submission for the SHA-3 is very similar to [sha3] but + uses a slightly different padding. The parameter is the same as + that of [sha3]. *) + val sha2: int -> hash + (** SHA-2, another NIST standard for cryptographic hashing, produces + hashes of 224, 256, 384, or 512 bits (24, 32, 48 or 64 bytes). + The parameter is the desired size of the hash, in + bits. It must be one of 224, 256, 384 or 512. *) + val sha224: unit -> hash + (** SHA-224 is SHA-2 specialized to 224 bit hashes (24 bytes). *) + val sha256: unit -> hash + (** SHA-256 is SHA-2 specialized to 256 bit hashes (32 bytes). *) + val sha384: unit -> hash + (** SHA-384 is SHA-2 specialized to 384 bit hashes (48 bytes). *) + val sha512: unit -> hash + (** SHA-512 is SHA-2 specialized to 512 bit hashes (64 bytes). *) + val ripemd160: unit -> hash + (** RIPEMD-160 produces 160-bit hashes (20 bytes). *) + +(** {2 Weak hashes, not recommended for new applications} *) + + val sha1: unit -> hash + (** SHA-1 is the Secure Hash Algorithm revision 1. It is a NIST + standard, is widely used, and produces 160-bit hashes (20 bytes). + While popular in many legacy applications, it is now known + to be insecure. In particular, it is not collision-resistant. *) + val md5: unit -> hash + (** MD5 is an older hash function, producing 128-bit hashes (16 bytes). + While popular in many legacy applications, it is now known + to be insecure. In particular, it is not collision-resistant. *) +end + +(** The [MAC] module implements message authentication codes, also + known as keyed hash functions. These are hash functions parameterized + by a secret key. In addition to being one-way and collision-resistant, + a MAC has the property that without knowing the secret key, it is + computationally infeasible to find the hash for a known text, + even if many pairs of (text, MAC) are known to the attacker. + Thus, MAC can be used to authenticate the sender of a text: + the receiver of a (text, MAC) pair can recompute the MAC from the text, + and if it matches the transmitted MAC, be reasonably certain that + the text was authentified by someone who possesses the secret key. + + The module [MAC] provides five MAC functions based on the hashes + SHA-1, SHA256, SHA512, RIPEMD160 and MD5, and five MAC functions based on + the block ciphers AES, DES, and Triple-DES. *) +module MAC: sig + val hmac_sha1: string -> hash + (** [hmac_sha1 key] returns a MAC based on the HMAC construction (RFC2104) + applied to SHA-1. The returned hash values are 160 bits (20 bytes) + long. The [key] argument is the MAC key; it can have any length, + but a minimal length of 20 bytes is recommended. *) + val hmac_sha256: string -> hash + (** [hmac_sha256 key] returns a MAC based on the HMAC construction + (RFC2104) applied to SHA-256. The returned hash values are + 256 bits (32 bytes) long. The [key] argument is the MAC key; + it can have any length, but a minimal length of 32 bytes is + recommended. *) + val hmac_sha512: string -> hash + (** [hmac_sha512 key] returns a MAC based on the HMAC construction + (RFC2104) applied to SHA-512. The returned hash values are + 512 bits (64 bytes) long. The [key] argument is the MAC key; + it can have any length, but a minimal length of 64 bytes is + recommended. *) + val hmac_ripemd160: string -> hash + (** [hmac_ripemd160 key] returns a MAC based on the HMAC + construction (RFC2104) applied to RIPEMD-160. The returned + hash values are 160 bits (20 bytes) long. The [key] argument + is the MAC key; it can have any length, but a minimal length + of 20 bytes is recommended. *) + val hmac_md5: string -> hash + (** [hmac_md5 key] returns a MAC based on the HMAC construction (RFC2104) + applied to MD5. The returned hash values are 128 bits (16 bytes) + long. The [key] argument is the MAC key; it can have any length, + but a minimal length of 16 bytes is recommended. *) + val aes_cmac: ?iv:string -> string -> hash + (** [aes_cmac key] returns a MAC based on AES encryption in CMAC mode, + also known as OMAC1 mode. The input data is encrypted using + AES in CBC mode, with a special treatment of the final block + that makes this MAC suitable for input data of variable length. + The final value of the initialization vector is the MAC value. + Thus, the returned hash values are 128 bit (16 bytes) long. + The [key] argument is the MAC key; it must have length 16, 24, + or 32. The optional [iv] argument is the first value of the + initialization vector, and defaults to 0. *) + val aes: ?iv:string -> ?pad:Padding.scheme -> string -> hash + (** [aes key] returns a MAC based on AES encryption in CBC mode. + Unlike [aes_cmac], there is no special treatment for the final + block, except padding it as per the optional [pad] argument. + This makes this MAC weak when used with input data of variable + length. (It is fine for data of fixed length, though.) + The returned hash values are 128 bit (16 bytes) long. The + [key] argument is the MAC key; it must have length 16, 24, or + 32. The optional [iv] argument is the first value of the + initialization vector, and defaults to 0. The optional [pad] + argument specifies a padding scheme to pad input to an + integral number of 16-byte blocks. *) + val des: ?iv:string -> ?pad:Padding.scheme -> string -> hash + (** [des key] returns a MAC based on DES encryption in CBC mode. + The construction is identical to that used for the [aes] MAC. + The key size is 64 bits (8 bytes), of which only 56 are used. + The returned hash value has length 8 bytes. + Due to the small hash size and key size, this MAC is weak. *) + val triple_des: ?iv:string -> ?pad:Padding.scheme -> string -> hash + (** [des key] returns a MAC based on triple DES encryption in CBC mode. + The construction is identical to that used for the [aes] MAC. + The key size is 16 or 24 bytes. The returned hash value has + length 8 bytes. The key size is sufficient to protect against + brute-force attacks, but the small hash size means that this + MAC is not collision-resistant. *) + val des_final_triple_des: ?iv:string -> ?pad:Padding.scheme -> string -> hash + (** [des_final_triple_des key] returns a MAC that uses DES CBC + with the first 8 bytes of [key] as key. The final initialization + vector is then DES-decrypted with bytes 8 to 15 of [key], + and DES-encrypted again with either the last 8 bytes of [key] + (if a triple-length key is provided) or the first 8 bytes of [key] + (if a double-length key is provided). + Thus, the key is 16 or 24 bytes long, of which + 112 or 168 bits are used. The overall construction has the same + key size as a triple DES MAC, but runs faster because triple + encryption is not performed on all data blocks, but only on + the final MAC. *) +end + +(** The [RSA] module implements RSA public-key cryptography. + Public-key cryptography is asymmetric: two distinct keys are used + for encrypting a message, then decrypting it. Moreover, while one of + the keys must remain secret, the other can be made public, since + it is computationally very hard to reconstruct the private key + from the public key. This feature supports both public-key + encryption (anyone can encode with the public key, but only the + owner of the private key can decrypt) and digital signature + (only the owner of the private key can sign, but anyone can check + the signature with the public key). *) +module RSA: sig + + type key = + { size: int; (** Size of the modulus [n], in bits *) + n: string; (** Modulus [n = p.q] *) + e: string; (** Public exponent [e] *) + d: string; (** Private exponent [d] *) + p: string; (** Prime factor [p] of [n] *) + q: string; (** The other prime factor [q] of [n] *) + dp: string; (** [dp] is [d mod (p-1)] *) + dq: string; (** [dq] is [d mod (q-1)] *) + qinv: string (** [qinv] is a multiplicative inverse of [q] modulo [p] *) + } + (** The type of RSA keys. Components [size], [n] and [e] define + the public part of the key. Components [size], [n] and [d] + define the private part of the key. To speed up private key operations + through the use of the Chinese remainder theorem (CRT), additional + components [p], [q], [dp], [dq] and [qinv] are provided. These + are part of the private key. *) + + val wipe_key: key -> unit + (** Erase all components of a RSA key. *) + + val new_key: ?rng: Random.rng -> ?e: int -> int -> key + (** Generate a new, random RSA key. The non-optional [int] + argument is the desired size for the modulus, in bits + (e.g. 2048). The optional [rng] argument specifies a random + number generator to use for generating the key; it defaults to + {!Cryptokit.Random.secure_rng}. The optional [e] argument + specifies the public exponent desired. If not specified, [e] + is chosen randomly. Small values of [e] such as + [e = 65537] significantly speeds up encryption and + signature checking compared with a random [e]. + Very small values of [e] such as [e = 3] can weaken security + and are best avoided. + The result of [new_key] is a complete RSA key with all + components defined: public, private, and private for use with + the CRT. *) + + val encrypt: key -> string -> string + (** [encrypt k msg] encrypts the string [msg] with the public part + of key [k] (components [n] and [e]). + [msg] must be smaller than [key.n] when both strings + are viewed as natural numbers in big-endian notation. + In practice, [msg] should be of length [key.size / 8 - 1], + using padding if necessary. If you need to encrypt longer plaintexts + using RSA, encrypt them with a symmetric cipher, using a + randomly-generated key, and encrypt only that key with RSA. *) + val decrypt: key -> string -> string + (** [decrypt k msg] decrypts the ciphertext string [msg] with the + private part of key [k] (components [n] and [d]). The size of + [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) + val decrypt_CRT: key -> string -> string + (** [decrypt_CRT k msg] decrypts the ciphertext string [msg] with + the CRT private part of key [k] (components [n], [p], [q], + [dp], [dq] and [qinv]). The use of the Chinese remainder + theorem (CRT) allows significantly faster decryption than + {!Cryptokit.RSA.decrypt}, at no loss in security. The size of + [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) + val sign: key -> string -> string + (** [sign k msg] encrypts the plaintext string [msg] with the + private part of key [k] (components [n] and [d]), thus + performing a digital signature on [msg]. + The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. + If you need to sign longer messages, compute a cryptographic + hash of the message and sign only the hash with RSA. *) + val sign_CRT: key -> string -> string + (** [sign_CRT k msg] encrypts the plaintext string [msg] with the + CRT private part of key [k] (components [n], [p], [q], [dp], + [dq] and [qinv]), thus performing a digital signature on + [msg]. The use of the Chinese remainder theorem (CRT) allows + significantly faster signature than {!Cryptokit.RSA.sign}, at + no loss in security. The size of [msg] is limited as + described for {!Cryptokit.RSA.encrypt}. *) + val unwrap_signature: key -> string -> string + (** [unwrap_signature k msg] decrypts the ciphertext string [msg] + with the public part of key [k] (components [n] and [d]), + thus extracting the plaintext that was signed by the sender. + The size of [msg] is limited as described for + {!Cryptokit.RSA.encrypt}. *) +end + +(** The [DH] module implements Diffie-Hellman key agreement. + Key agreement is a protocol by which two parties can establish + a shared secret (typically a key for a symmetric cipher or MAC) + by exchanging messages, with the guarantee that even if an attacker + eavesdrop on the messages, he cannot recover the shared secret. + Diffie-Hellman is one such key agreement protocol, relying on + the difficulty of computing discrete logarithms. Notice that + the Diffie-Hellman protocol is vulnerable to active attacks + (man-in-the-middle attacks). + + The protocol executes as follows: + - Both parties must agree beforehand on a set of public parameters + (type {!Cryptokit.DH.parameters}). Suitable parameters + can be generated by calling {!Cryptokit.DH.new_parameters}, + or fixed parameters taken from the literature can be used. + - Each party computes a random private secret using the function + {!Cryptokit.DH.private_secret}. + - From its private secrets and the public parameters, each party + computes a message (a string) with the function {!Cryptokit.DH.message}, + and sends it to the other party. + - Each party recovers the shared secret by applying the function + {!Cryptokit.DH.shared_secret} to its private secret and to the + message received from the other party. + - Fixed-size keys can then be derived from the shared secret + using the function {!Cryptokit.DH.derive_key}. +*) +module DH: sig + + type parameters = + { p: string; (** Large prime number *) + g: string; (** Generator of [Z/pZ] *) + privlen: int (** Length of private secrets in bits *) + } + (** The type of Diffie-Hellman parameters. These parameters + need to be agreed upon by the two parties before the key agreement + protocol is run. The parameters are public and can be reused + for several runs of the protocol. *) + val new_parameters: ?rng: Random.rng -> ?privlen: int -> int -> parameters + (** Generate a new set of Diffie-Hellman parameters. + The non-optional argument is the size in bits of the [p] parameter. + It must be large enough that the discrete logarithm problem modulo + [p] is computationally unsolvable. 1024 is a reasonable value. + The optional [rng] argument specifies a random number generator + to use for generating the parameters; it defaults to + {!Cryptokit.Random.secure_rng}. The optional [privlen] argument + is the size in bits of the private secrets that are generated + during the key agreement protocol; the default is 160. *) + type private_secret + (** The abstract type of private secrets generated during key agreement. *) + val private_secret: ?rng: Random.rng -> parameters -> private_secret + (** Generate a random private secret. + The optional [rng] argument specifies a random number generator + to use; it defaults to {!Cryptokit.Random.secure_rng}. *) + val message: parameters -> private_secret -> string + (** Compute the message to be sent to the other party. *) + val shared_secret: parameters -> private_secret -> string -> string + (** Recover the shared secret from the private secret of the + present party and the message received from the other party. + The shared secret returned is a string of the same length as + the [p] parameter. The private secret is destroyed and can no + longer be used afterwards. *) + val derive_key: ?diversification: string -> string -> int -> string + (** [derive_key shared_secret numbytes] derives a secret string + (typically, a key for symmetric encryption) from the given shared + secret. [numbytes] is the desired length for the returned string. + The optional [diversification] argument is an arbitrary string + that defaults to the empty string. Different secret strings can + be obtained from the same shared secret by supplying different + [diversification] argument. The computation of the secret + string is performed by SHA-1 hashing of the diversification + string, followed by the shared secret, followed by an integer + counter. The hashing is repeated with increasing values of the + counter until [numbytes] bytes have been obtained. *) +end + +(** {1 Advanced, compositional interface to block ciphers + and stream ciphers} *) + +(** The [Block] module provides classes that implements + popular block ciphers, chaining modes, and wrapping of a block cipher + as a general transform or as a hash function. + The classes can be composed in a Lego-like fashion, facilitating + the integration of new block ciphers, modes, etc. *) +module Block : sig + + class type block_cipher = + object + method blocksize: int + (** The size in bytes of the blocks manipulated by the cipher. *) + method transform: bytes -> int -> bytes -> int -> unit + (** [transform src spos dst dpos] encrypts or decrypts one block + of data. The input data is read from byte array [src] at + positions [spos, ..., spos + blocksize - 1], and the output + data is stored in byte array [dst] at positions + [dpos, ..., dpos + blocksize - 1]. *) + method wipe: unit + (** Erase the internal state of the block cipher, such as + all key-dependent material. *) + end + (** Abstract interface for a block cipher. *) + + (** {1 Deriving transforms and hashes from block ciphers} *) + + class cipher: block_cipher -> transform + (** Wraps a block cipher as a general transform. The transform + has input block size and output block size equal to the + block size of the block cipher. No padding is performed. + Example: [new cipher (new cbc_encrypt (new aes_encrypt key))] + returns a transform that performs AES encryption in CBC mode. *) + class cipher_padded_encrypt: Padding.scheme -> block_cipher -> transform + (** Like {!Cryptokit.Block.cipher}, but performs padding on the input data + as specified by the first argument. The input block size of + the returned transform is 1; the output block size is the + block size of the block cipher. *) + class cipher_padded_decrypt: Padding.scheme -> block_cipher -> transform + (** Like {!Cryptokit.Block.cipher}, but removes padding on the output data + as specified by the first argument. The output block size of + the returned transform is 1; the input block size is the + block size of the block cipher. *) + class mac: ?iv: string -> ?pad: Padding.scheme -> block_cipher -> hash + (** Build a MAC (keyed hash function) from the given block cipher. + The block cipher is run in CBC mode, and the MAC value is + the final value of the initialization vector. + Thus, the hash size of the resulting + hash is the block size of the block cipher. + The optional argument [iv] specifies the first initialization + vector, with a default of all zeroes. The optional argument + [pad] specifies a padding scheme to be applied to the input + data; if not provided, no padding is performed. *) + class mac_final_triple: ?iv: string -> ?pad: Padding.scheme -> + block_cipher -> block_cipher -> block_cipher -> hash + (** Build a MAC (keyed hash function) from the given block ciphers + [c1], [c2] and [c3]. The input is run through [c1] in CBC + mode, as described for {!Cryptokit.Block.mac}. The final + initialization vector is then super-enciphered by [c2], then + by [c3], to provide the final MAC. This construction results + in a MAC that is as nearly as fast as {!Cryptokit.Block.mac} + [c1], but more resistant against brute-force key search + because of the additional final encryption through [c2] and + [c3]. *) + + (** {1 Some block ciphers: AES, DES, triple DES, Blowfish} *) + + class aes_encrypt: string -> block_cipher + (** The AES block cipher, in encryption mode. The string argument + is the key; its length must be 16, 24 or 32 bytes. *) + class aes_decrypt: string -> block_cipher + (** The AES block cipher, in decryption mode. *) + + class des_encrypt: string -> block_cipher + (** The DES block cipher, in encryption mode. The string argument + is the key; its length must be 8 bytes. *) + class des_decrypt: string -> block_cipher + (** The DES block cipher, in decryption mode. *) + + class triple_des_encrypt: string -> block_cipher + (** The Triple-DES block cipher, in encryption mode. + The key argument must have length 16 (two keys) or 24 (three keys). *) + class triple_des_decrypt: string -> block_cipher + (** The Triple-DES block cipher, in decryption mode. *) + + class blowfish_encrypt: string -> block_cipher + (** The Blowfish block cipher, in encryption mode. The string argument + is the key; its length must be between 4 and 56. *) + class blowfish_decrypt: string -> block_cipher + (** The Blowfish block cipher, in decryption mode. *) + + (** {1 Chaining modes} *) + + class cbc_encrypt: ?iv: string -> block_cipher -> block_cipher + (** Add Cipher Block Chaining (CBC) to the given block cipher + in encryption mode. + Each block of input is xor-ed with the previous output block + before being encrypted through the given block cipher. + The optional [iv] argument specifies the string to be xor-ed + with the first input block, and defaults to all zeroes. + The returned block cipher has the same block size as the + underlying block cipher. *) + class cbc_decrypt: ?iv: string -> block_cipher -> block_cipher + (** Add Cipher Block Chaining (CBC) to the given block cipher + in decryption mode. This works like {!Cryptokit.Block.cbc_encrypt}, + except that input blocks are first decrypted by the block + cipher before being xor-ed with the previous input block. *) + + class cfb_encrypt: ?iv: string -> int -> block_cipher -> block_cipher + (** Add Cipher Feedback Block (CFB) to the given block cipher + in encryption mode. The integer argument [n] is the number of + bytes processed at a time; it must lie between [1] and + the block size of the underlying cipher, included. + The returned block cipher has block size [n]. *) + class cfb_decrypt: ?iv: string -> int -> block_cipher -> block_cipher + (** Add Cipher Feedback Block (CFB) to the given block cipher + in decryption mode. See {!Cryptokit.Block.cfb_encrypt}. *) + class ofb: ?iv: string -> int -> block_cipher -> block_cipher + (** Add Output Feedback Block (OFB) to the given block cipher. + The integer argument [n] is the number of + bytes processed at a time; it must lie between [1] and + the block size of the underlying cipher, included. + The returned block cipher has block size [n]. + It is usable both for encryption and decryption. *) + class ctr: ?iv: string -> ?inc:int -> block_cipher -> block_cipher + (** Add Counter mode to the given block cipher. Viewing the IV + as a [blocksize]-byte integer in big-endian representation, + the blocks [IV], [IV+1], [IV+2], ... are encrypted using + the given block cipher, and the result is xor-ed with the + input blocks to produce the output blocks. The additions + [IV+n] are performed modulo 2 to the [8 * inc] power. + In other words, only the low [inc] bytes of the [IV] are + subject to incrementation; the high [blocksize - inc] bytes + are unaffected. [inc] defaults to [blocksize]. + The returned block cipher has the same block size as + the underlying block cipher, and is usable both for + encryption and decryption. *) +end + +(** The [Stream] module provides classes that implement + the ARCfour stream cipher, and the wrapping of a stream cipher + as a general transform. The classes can be composed in a Lego-like + fashion, facilitating the integration of new stream ciphers. *) +module Stream : sig + + class type stream_cipher = + object + method transform: bytes -> int -> bytes -> int -> int -> unit + (** [transform src spos dst dpos len] encrypts or decrypts + [len] characters, read from byte array [src] starting at + position [spos]. The resulting [len] characters are + stored in byte array [dst] starting at position [dpos]. *) + method wipe: unit + (** Erase the internal state of the stream cipher, such as + all key-dependent material. *) + end + (** Abstract interface for a stream cipher. *) + + class cipher: stream_cipher -> transform + (** Wraps an arbitrary stream cipher as a transform. + The transform has input and output block size of 1. *) + + class arcfour: string -> stream_cipher + (** The ARCfour (``alleged RC4'') stream cipher. + The argument is the key, and must be of length 1 to 256. + This stream cipher works by xor-ing the input with the + output of a key-dependent pseudo random number generator. + Thus, decryption is the same function as encryption. *) + + class chacha20: ?iv:string -> ?ctr:int64 -> string -> stream_cipher + (** The Chacha20 strea cipher. + The string argument is the key, and must be of length 16 or 32. + The optional [iv] argument is the initialization vector + (also known as the nonce). If present, it must be 8 bytes long. + If absent, it is taken to be eight zero bytes. + The optional [ctr] argument is the initial value of the internal + counter. If absent, it is taken to be 0. + This stream cipher works by xor-ing the input with the + output of a key-dependent pseudo random number generator. + Thus, decryption is the same function as encryption. *) +end + +(** {1 Encoding and compression of data} *) + +(** The [Base64] module supports the encoding and decoding of + binary data in base 64 format, using only alphanumeric + characters that can safely be transmitted over e-mail or + in URLs. *) +module Base64: sig + val encode_multiline : unit -> transform + (** Return a transform that performs base 64 encoding. + The output is divided in lines of length 76 characters, + and final [=] characters are used to pad the output, + as specified in the MIME standard. + The output is approximately [4/3] longer than the input. *) + val encode_compact : unit -> transform + (** Same as {!Cryptokit.Base64.encode_multiline}, but the output is not + split into lines, and no final padding is added. + This is adequate for encoding short strings for + transmission as part of URLs, for instance. *) + val encode_compact_pad : unit -> transform + (** Same as {!Cryptokit.Base64.encode_compact}, but the output is + padded with [=] characters at the end (if necessary). *) + val decode : unit -> transform + (** Return a transform that performs base 64 decoding. + The input must consist of valid base 64 characters; + blanks are ignored. Raise [Error Bad_encoding] + if invalid base 64 characters are encountered in the input. *) +end + +(** The [Hexa] module supports the encoding and decoding of + binary data as hexadecimal strings. This is a popular format + for transmitting keys in textual form. *) +module Hexa: sig + val encode : unit -> transform + (** Return a transform that encodes its input in hexadecimal. + The output is twice as long as the input, and contains + no spaces or newlines. *) + val decode : unit -> transform + (** Return a transform that decodes its input from hexadecimal. + The output is twice as short as the input. Blanks + (spaces, tabs, newlines) in the input are ignored. + Raise [Error Bad_encoding] if the input contains characters + other than hexadecimal digits and blanks. *) +end + +(** The [Zlib] module supports the compression and decompression + of data, using the [zlib] library. The algorithm used is + Lempel-Ziv compression as in the [gzip] and [zip] compressors. + While compression itself is not encryption, it is often used prior + to encryption to hide regularities in the plaintext, and reduce + the size of the ciphertext. *) +module Zlib: sig + val compress : ?level:int -> unit -> transform + (** Return a transform that compresses its input. + The optional [level] argument is an integer between 1 and 9 + specifying how hard the transform should try to compress data: + 1 is lowest but fastest compression, while 9 is highest but + slowest compression. The default level is 6. *) + val uncompress : unit -> transform + (** Return a transform that decompresses its input. *) +end + +(** {1 Error reporting} *) + +(** Error codes for this library. *) +type error = + | Wrong_key_size + (** The key is too long or too short for the given cipher. *) + | Wrong_IV_size + (** The initialization vector does not have the same size as + the block size. *) + | Wrong_data_length + (** The total length of the input data for a transform is not an + integral multiple of the input block size. *) + | Bad_padding + (** Incorrect padding bytes were found after decryption. *) + | Output_buffer_overflow + (** The output buffer for a transform exceeds the maximal length + of a Caml string. *) + | Incompatible_block_size + (** A combination of two block ciphers was attempted whereby + the ciphers have different block sizes, while they must have + the same. *) + | Number_too_long + (** Denotes an internal error in RSA key generation or encryption. *) + | Seed_too_short + (** The seed given to a pseudo random number generator is too short. *) + | Message_too_long + (** The message passed to RSA encryption or decryption is greater + than the modulus of the RSA key *) + | Bad_encoding + (** Illegal characters were found in an encoding of binary data + such as base 64 or hexadecimal. *) + | Compression_error of string * string + (** Error during compression or decompression. *) + | No_entropy_source + (** No entropy source (OS, [/dev/random] or EGD) was found for + {!Cryptokit.Random.secure_rng}. *) + | Entropy_source_closed + (** End of file on a device or EGD entropy source. *) + | Compression_not_supported + (** The data compression functions are not available. *) + +exception Error of error + (** Exception raised by functions in this library + to report error conditions. *) + +(** {1 Miscellaneous utilities} *) + +val wipe_bytes : bytes -> unit + (** [wipe_bytes s] overwrites [s] with zeroes. Can be used + to reduce the memory lifetime of sensitive data. *) +val wipe_string : string -> unit + (** [wipe_string s] overwrites [s] with zeroes. Can be used + to reduce the memory lifetime of sensitive data. *) +val xor_bytes: bytes -> int -> bytes -> int -> int -> unit + (** [xor_string src spos dst dpos len] performs the xor (exclusive or) + of characters [spos, ..., spos + len - 1] of [src] + with characters [dpos, ..., dpos + len - 1] of [dst], + storing the result in [dst] starting at position [dpos]. *) +val xor_string: string -> int -> bytes -> int -> int -> unit + (** Same as [xor_bytes], but the source is a string instead of a + byte array. *) +val mod_power: string -> string -> string -> string + (** [mod_power a b c] computes [a^b mod c], where the + strings [a], [b], [c] and the result are viewed as + arbitrary-precision integers in big-endian format. + Requires [a < c]. *) +val mod_mult: string -> string -> string -> string + (** [mod_mult a b c] computes [a*b mod c], where the + strings [a], [b], [c] and the result are viewed as + arbitrary-precision integers in big-endian format. *) diff --git a/src/cryptokit.mllib b/src/cryptokit.mllib new file mode 100644 index 0000000..c8577fb --- /dev/null +++ b/src/cryptokit.mllib @@ -0,0 +1,5 @@ +# OASIS_START +# DO NOT EDIT (digest: f65b9dc92e3f638af8533b26ac90c400) +CryptokitBignum +Cryptokit +# OASIS_STOP diff --git a/src/cryptokitBignum.ml b/src/cryptokitBignum.ml new file mode 100644 index 0000000..6995ad5 --- /dev/null +++ b/src/cryptokitBignum.ml @@ -0,0 +1,117 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* Arithmetic on big integers, based on the ZArith library. *) + +type t = Z.t + +external wipe: t -> unit = "caml_wipe_z" + +let zero = Z.zero +let one = Z.one + +let of_int = Z.of_int + +let compare = Z.compare + +let add = Z.add +let sub = Z.sub +let mult = Z.mul +let mod_ = Z.rem + +let relative_prime a b = + Z.equal (Z.gcd a b) Z.one + +let mod_power = Z.powm_sec + +let sub_mod a b p = + let d = Z.sub a b in + if Z.sign d < 0 then Z.add d p else d + +(* Modular exponentiation via the Chinese Remainder Theorem. + Compute a ^ d mod pq, where d is defined by + dp = d mod (p-1) and dq = d mod (q-1). + qinv is q^-1 mod p. + Formula: + mp = (a mod p)^dp mod p + mq = (a mod q)^dq mod q + m = ((((mp - mq) mod p) * qInv) mod p) * q + mq +*) + +let mod_power_CRT a p q dp dq qinv = + let amodp = Z.rem a p and amodq = Z.rem a q in + let mp = mod_power amodp dp p and mq = mod_power amodq dq q in + let diff = sub_mod mp mq p in + let diff_qinv = Z.mul diff qinv in + let diff_qinv_mod_p = Z.rem diff_qinv p in + let res = Z.(add (mul q diff_qinv_mod_p) mq) in + wipe amodp; wipe amodq; + (* It is possible that res == mq, so we cannot wipe mq. + For consistency we don't wipe any of the intermediate results + besides amodp and amodq. *) + res + +let mod_inv = Z.invert + +let wipe_bytes s = Bytes.fill s 0 (Bytes.length s) '\000' + +let of_bytes s = + let l = String.length s in + let t = Bytes.create l in + for i = 0 to l - 1 do Bytes.set t i s.[l - 1 - i] done; + let n = Z.of_bits (Bytes.unsafe_to_string t) in + wipe_bytes t; + n + +let to_bytes ?numbits n = + let s = Z.to_bits n in + let l = + match numbits with + | None -> String.length s + | Some nb -> assert (Z.numbits n <= nb); (nb + 7) / 8 in + let t = Bytes.make l '\000' in + for i = 0 to String.length s - 1 do + Bytes.set t (l - 1 - i) s.[i] + done; + wipe_bytes (Bytes.unsafe_of_string s); + Bytes.unsafe_to_string t + +let change_byte s i f = + Bytes.set s i (Char.chr (f (Char.code (Bytes.get s i)))) + +let random ~rng ?(odd = false) numbits = + let numbytes = (numbits + 7) / 8 in + let buf = Bytes.create numbytes in + rng buf 0 numbytes; + (* adjust low byte if requested *) + if odd then + change_byte buf 0 (fun b -> b lor 1); + (* adjust high byte so that the number is exactly numbits long *) + let mask = 1 lsl ((numbits - 1) land 7) in + change_byte buf (numbytes - 1) + (fun b -> (b land (mask - 1)) lor mask); + (* convert to a number *) + let n = Z.of_bits (Bytes.unsafe_to_string buf) in + wipe_bytes buf; + assert (Z.numbits n = numbits); + if odd then assert (Z.is_odd n); + n + +let rec random_prime ~rng numbits = + (* Generate random odd number *) + let n = random ~rng ~odd:true numbits in + (* Find next prime above n *) + let p = Z.nextprime n in + (* Make sure it has the right number of bits *) + if Z.numbits p = numbits then p else random_prime ~rng numbits + diff --git a/src/cryptokitBignum.mli b/src/cryptokitBignum.mli new file mode 100644 index 0000000..5f911b7 --- /dev/null +++ b/src/cryptokitBignum.mli @@ -0,0 +1,41 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* Arithmetic on big integers *) + +type t + +val zero : t +val one : t +val of_int : int -> t + +val compare : t -> t -> int + +val add : t -> t -> t +val sub : t -> t -> t +val mult : t -> t -> t +val mod_ : t -> t -> t + +val relative_prime : t -> t -> bool +val mod_power : t -> t -> t -> t +val mod_power_CRT : t -> t -> t -> t -> t -> t -> t +val mod_inv : t -> t -> t + +val of_bytes : string -> t +val to_bytes : ?numbits:int -> t -> string + +val random : rng:(bytes -> int -> int -> unit) -> ?odd:bool -> int -> t +val random_prime : rng:(bytes -> int -> int -> unit) -> int -> t + +val wipe : t -> unit + diff --git a/src/cryptokitBignumOld.ml b/src/cryptokitBignumOld.ml new file mode 100644 index 0000000..5174623 --- /dev/null +++ b/src/cryptokitBignumOld.ml @@ -0,0 +1,479 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* Arithmetic on big integers, based on the Nums library. *) + +(* This implementation is obsolete and was replaced by another based + on the ZArith library. It is kept for reference. *) + +open Nat + +type t = nat + +let wipe n = set_to_zero_nat n 0 (length_nat n) + +let zero = nat_of_int 0 +let one = nat_of_int 1 + +let of_int = nat_of_int + +let compare a b = + compare_nat a 0 (length_nat a) b 0 (length_nat b) + +let num_digits a = num_digits_nat a 0 (length_nat a) + +let num_bits a = + let ndigits = num_digits a in + ndigits * length_of_digit - num_leading_zero_bits_in_digit a (ndigits-1) + +let copy a = copy_nat a 0 (num_digits a) + +let add a b = + let la = num_digits a and lb = num_digits b in + if la >= lb then begin + let r = create_nat (la + 1) in + blit_nat r 0 a 0 la; + set_digit_nat r la 0; + ignore(add_nat r 0 (la + 1) b 0 lb 0); + r + end else begin + let r = create_nat (lb + 1) in + blit_nat r 0 b 0 lb; + set_digit_nat r lb 0; + ignore(add_nat r 0 (lb + 1) a 0 la 0); + r + end + +let sub a b = + let la = num_digits a + and lb = num_digits b in + let lr = max la lb in + let r = create_nat lr in + blit_nat r 0 a 0 la; + set_to_zero_nat r la (lr - la); + let carry = sub_nat r 0 lr b 0 lb 1 in + assert (carry = 1); + r + +let sub_mod a b c = + let la = num_digits a + and lb = num_digits b + and lc = num_digits c in + let lr = max (max la lb) lc in + let r = create_nat lr in + blit_nat r 0 a 0 la; + set_to_zero_nat r la (lr - la); + if sub_nat r 0 lr b 0 lb 1 = 0 then ignore (add_nat r 0 lr c 0 lc 0); + r + +let mult a b = + let la = num_digits a and lb = num_digits b in + let r = make_nat (la + lb) in + ignore(mult_nat r 0 (la + lb) a 0 la b 0 lb); + r + +let mult_add a b c = + let la = num_digits a + and lb = num_digits b + and lc = num_digits c in + let lr = 1 + max (la + lb) lc in + let r = create_nat lr in + blit_nat r 0 c 0 lc; + set_to_zero_nat r lc (lr - lc); + ignore(mult_nat r 0 lr a 0 la b 0 lb); + r + +let mod_ a b = + let la = num_digits a and lb = num_digits b in + let ltmp = max la lb + 1 in + let tmp = create_nat ltmp in + blit_nat tmp 0 a 0 la; + set_to_zero_nat tmp la (ltmp - la); + div_nat tmp 0 ltmp b 0 lb; + let lres = num_digits_nat tmp 0 lb in + let res = create_nat lres in + blit_nat res 0 tmp 0 lres; + wipe tmp; + res + +let quo_mod a b = + let la = num_digits a and lb = num_digits b in + let ltmp = max la lb + 1 in + let tmp = create_nat ltmp in + blit_nat tmp 0 a 0 la; + set_to_zero_nat tmp la (ltmp - la); + div_nat tmp 0 ltmp b 0 lb; + let lq = num_digits_nat tmp lb (ltmp - lb) in + let lm = num_digits_nat tmp 0 lb in + let q = create_nat lq in + let m = create_nat lm in + blit_nat q 0 tmp lb lq; + blit_nat m 0 tmp 0 lm; + wipe tmp; + (q, m) + +let relative_prime a b = + let la = num_digits a and lb = num_digits b in + let ltmp = max la lb in + let tmp = create_nat ltmp in + blit_nat tmp 0 a 0 la; + set_to_zero_nat tmp la (ltmp - la); + let lgcd = gcd_nat tmp 0 la b 0 lb in + let res = lgcd = 1 && is_digit_int tmp 0 && nth_digit_nat tmp 0 = 1 in + wipe tmp; + res + +(* Compute a^b mod c. Must have [a < c]. *) + +let mod_power a b c = + let la = num_digits a + and lb = num_digits b + and lc = num_digits c in + let res = make_nat lc in set_digit_nat res 0 1; (* res = 1 initially *) + let prod = create_nat (lc + lc + 1) in + let window = create_nat 2 in + (* For each bit of b, from MSB to LSB... *) + for i = lb - 1 downto 0 do + blit_nat window 0 b i 1; + for j = length_of_digit downto 1 do + (* res <- res ^ 2 mod c *) + set_to_zero_nat prod 0 (lc + lc + 1); + ignore(square_nat prod 0 (lc + lc) res 0 lc); + (* prod[lc+lc] = 0 < c[lc-1] != 0 *) + div_nat prod 0 (lc + lc + 1) c 0 lc; + (* remainder is in (prod,0,lc) *) + blit_nat res 0 prod 0 lc; + (* shift window[0] left 1 bit and test carry out; + that is, test bit number j of b[i] *) + shift_left_nat window 0 1 window 1 1; + if is_digit_odd window 1 then begin + (* res <- res * a mod c *) + set_to_zero_nat prod 0 (lc + la + 1); + ignore(mult_nat prod 0 (lc + la) res 0 lc a 0 la); + (* prod[lc+la] = 0 < c[lc-1] != 0 *) + div_nat prod 0 (lc + la + 1) c 0 lc; + (* remainder in (prod,0,lc) *) + blit_nat res 0 prod 0 lc; + end + done + done; + wipe prod; wipe window; + res + +(* Modular exponentiation via the Chinese Remainder Theorem. + Compute a ^ d mod pq, where d is defined by + dp = d mod (p-1) and dq = d mod (q-1). + qinv is q^-1 mod p. + Formula: + mp = (a mod p)^dp mod p + mq = (a mod q)^dq mod q + m = ((((mp - mq) mod p) * qInv) mod p) * q + mq +*) + +let mod_power_CRT a p q dp dq qinv = + let amodp = mod_ a p and amodq = mod_ a q in + let mp = mod_power amodp dp p and mq = mod_power amodq dq q in + let diff = sub_mod mp mq p in + let diff_qinv = mult diff qinv in + let diff_qinv_mod_p = mod_ diff_qinv p in + let res = mult_add q diff_qinv_mod_p mq in + wipe amodp; wipe amodq; wipe mp; wipe mq; + wipe diff; wipe diff_qinv; wipe diff_qinv_mod_p; + res + +(* Modular inverse. Return u such that n.u mod m = 1, or raise + Division_by_zero if no such u exists (i.e. gcd(n,m) <> 1). + Must have [n < m]. *) + +let mod_inv b c = + let rec extended_euclid u1 v1 u3 v3 sign = + if compare v3 zero = 0 then + if compare u3 one = 0 then begin + wipe v1; + if sign < 0 + then sub c u1 + else u1 + end else begin + wipe u1; wipe v1; wipe u3; + raise Division_by_zero + end + else begin + let (q,r) = quo_mod u3 v3 in + let t1 = mult_add q v1 u1 in + wipe u3; wipe q; wipe u1; + extended_euclid v1 t1 v3 r (-sign) + end in + extended_euclid (nat_of_int 1) (nat_of_int 0) (copy b) (copy c) 1 + +(* Conversions between nats and strings *) + +let bytes_per_digit = length_of_digit / 8 + +let of_bytes s = + let l = String.length s in + if l = 0 then make_nat 1 else begin + let n = make_nat ((l + bytes_per_digit - 1) / bytes_per_digit) in + let tmp = create_nat 2 in + for i = 0 to l - 1 do + let pos = i / bytes_per_digit + and shift = (i mod bytes_per_digit) * 8 in + set_digit_nat tmp 0 (Char.code s.[l-1-i]); + shift_left_nat tmp 0 1 tmp 1 shift; + lor_digit_nat n pos tmp 0 + done; + wipe tmp; + n + end + +let to_bytes ?numbits n = + let nbits = num_bits n in + begin match numbits with + None -> () + | Some n -> assert (nbits <= n) + end; + let l = ((nbits + 7) / 8) in + let s = String.create ((nbits + 7) / 8) in + let tmp = create_nat 2 in + for i = 0 to l - 1 do + let pos = i / bytes_per_digit + and shift = (i mod bytes_per_digit) * 8 in + blit_nat tmp 0 n pos 1; + shift_right_nat tmp 0 1 tmp 1 shift; + s.[l-1-i] <- Char.unsafe_chr(nth_digit_nat tmp 0) + done; + wipe tmp; + match numbits with + None -> s + | Some n -> + let l' = ((n + 7) / 8) in + if l = l' then s else String.make (l' - l) '\000' ^ s + +let wipe_string s = String.fill s 0 (String.length s) '\000' + +let random ~rng ?(odd = false) numbits = + let numdigits = ((numbits + length_of_digit - 1) / length_of_digit) in + let buf = String.create (numdigits * length_of_digit / 8) in + rng buf 0 (String.length buf); + (* move them to a nat *) + let n = of_bytes buf in + wipe_string buf; + let tmp = create_nat 2 in + (* adjust low digit of n if requested *) + if odd then + set_digit_nat tmp 0 1; + lor_digit_nat n 0 tmp 0 + end; + (* adjust high digit of n so that it is exactly numbits long *) + shift_left_nat tmp 0 1 tmp 1 ((numbits - 1) land (length_of_digit - 1)); + ignore(decr_nat tmp 0 1 0); + land_digit_nat n (numdigits - 1) tmp 0; + ignore(incr_nat tmp 0 1 1); + lor_digit_nat n (numdigits - 1) tmp 0; + (* done *) + n + +let small_primes = [ + 2; 3; 5; 7; 11; 13; 17; 19; + 23; 29; 31; 37; 41; 43; 47; 53; + 59; 61; 67; 71; 73; 79; 83; 89; + 97; 101; 103; 107; 109; 113; 127; 131; + 137; 139; 149; 151; 157; 163; 167; 173; + 179; 181; 191; 193; 197; 199; 211; 223; + 227; 229; 233; 239; 241; 251; 257; 263; + 269; 271; 277; 281; 283; 293; 307; 311; + 313; 317; 331; 337; 347; 349; 353; 359; + 367; 373; 379; 383; 389; 397; 401; 409; + 419; 421; 431; 433; 439; 443; 449; 457; + 461; 463; 467; 479; 487; 491; 499; 503; + 509; 521; 523; 541; 547; 557; 563; 569; + 571; 577; 587; 593; 599; 601; 607; 613; + 617; 619; 631; 641; 643; 647; 653; 659; + 661; 673; 677; 683; 691; 701; 709; 719; + 727; 733; 739; 743; 751; 757; 761; 769; + 773; 787; 797; 809; 811; 821; 823; 827; + 829; 839; 853; 857; 859; 863; 877; 881; + 883; 887; 907; 911; 919; 929; 937; 941; + 947; 953; 967; 971; 977; 983; 991; 997; + 1009; 1013; 1019; 1021; 1031; 1033; 1039; 1049; + 1051; 1061; 1063; 1069; 1087; 1091; 1093; 1097; + 1103; 1109; 1117; 1123; 1129; 1151; 1153; 1163; + 1171; 1181; 1187; 1193; 1201; 1213; 1217; 1223; + 1229; 1231; 1237; 1249; 1259; 1277; 1279; 1283; + 1289; 1291; 1297; 1301; 1303; 1307; 1319; 1321; + 1327; 1361; 1367; 1373; 1381; 1399; 1409; 1423; + 1427; 1429; 1433; 1439; 1447; 1451; 1453; 1459; + 1471; 1481; 1483; 1487; 1489; 1493; 1499; 1511; + 1523; 1531; 1543; 1549; 1553; 1559; 1567; 1571; + 1579; 1583; 1597; 1601; 1607; 1609; 1613; 1619; + 1621; 1627; 1637; 1657; 1663; 1667; 1669; 1693; + 1697; 1699; 1709; 1721; 1723; 1733; 1741; 1747; + 1753; 1759; 1777; 1783; 1787; 1789; 1801; 1811; + 1823; 1831; 1847; 1861; 1867; 1871; 1873; 1877; + 1879; 1889; 1901; 1907; 1913; 1931; 1933; 1949; + 1951; 1973; 1979; 1987; 1993; 1997; 1999; 2003; + 2011; 2017; 2027; 2029; 2039; 2053; 2063; 2069; + 2081; 2083; 2087; 2089; 2099; 2111; 2113; 2129; + 2131; 2137; 2141; 2143; 2153; 2161; 2179; 2203; + 2207; 2213; 2221; 2237; 2239; 2243; 2251; 2267; + 2269; 2273; 2281; 2287; 2293; 2297; 2309; 2311; + 2333; 2339; 2341; 2347; 2351; 2357; 2371; 2377; + 2381; 2383; 2389; 2393; 2399; 2411; 2417; 2423; + 2437; 2441; 2447; 2459; 2467; 2473; 2477; 2503; + 2521; 2531; 2539; 2543; 2549; 2551; 2557; 2579; + 2591; 2593; 2609; 2617; 2621; 2633; 2647; 2657; + 2659; 2663; 2671; 2677; 2683; 2687; 2689; 2693; + 2699; 2707; 2711; 2713; 2719; 2729; 2731; 2741; + 2749; 2753; 2767; 2777; 2789; 2791; 2797; 2801; + 2803; 2819; 2833; 2837; 2843; 2851; 2857; 2861; + 2879; 2887; 2897; 2903; 2909; 2917; 2927; 2939; + 2953; 2957; 2963; 2969; 2971; 2999; 3001; 3011; + 3019; 3023; 3037; 3041; 3049; 3061; 3067; 3079; + 3083; 3089; 3109; 3119; 3121; 3137; 3163; 3167; + 3169; 3181; 3187; 3191; 3203; 3209; 3217; 3221; + 3229; 3251; 3253; 3257; 3259; 3271; 3299; 3301; + 3307; 3313; 3319; 3323; 3329; 3331; 3343; 3347; + 3359; 3361; 3371; 3373; 3389; 3391; 3407; 3413; + 3433; 3449; 3457; 3461; 3463; 3467; 3469; 3491; + 3499; 3511; 3517; 3527; 3529; 3533; 3539; 3541; + 3547; 3557; 3559; 3571; 3581; 3583; 3593; 3607; + 3613; 3617; 3623; 3631; 3637; 3643; 3659; 3671; + 3673; 3677; 3691; 3697; 3701; 3709; 3719; 3727; + 3733; 3739; 3761; 3767; 3769; 3779; 3793; 3797; + 3803; 3821; 3823; 3833; 3847; 3851; 3853; 3863; + 3877; 3881; 3889; 3907; 3911; 3917; 3919; 3923; + 3929; 3931; 3943; 3947; 3967; 3989; 4001; 4003; + 4007; 4013; 4019; 4021; 4027; 4049; 4051; 4057; + 4073; 4079; 4091; 4093; 4099; 4111; 4127; 4129; + 4133; 4139; 4153; 4157; 4159; 4177; 4201; 4211; + 4217; 4219; 4229; 4231; 4241; 4243; 4253; 4259; + 4261; 4271; 4273; 4283; 4289; 4297; 4327; 4337; + 4339; 4349; 4357; 4363; 4373; 4391; 4397; 4409; + 4421; 4423; 4441; 4447; 4451; 4457; 4463; 4481; + 4483; 4493; 4507; 4513; 4517; 4519; 4523; 4547; + 4549; 4561; 4567; 4583; 4591; 4597; 4603; 4621; + 4637; 4639; 4643; 4649; 4651; 4657; 4663; 4673; + 4679; 4691; 4703; 4721; 4723; 4729; 4733; 4751; + 4759; 4783; 4787; 4789; 4793; 4799; 4801; 4813; + 4817; 4831; 4861; 4871; 4877; 4889; 4903; 4909; + 4919; 4931; 4933; 4937; 4943; 4951; 4957; 4967; + 4969; 4973; 4987; 4993; 4999; 5003; 5009; 5011; + 5021; 5023; 5039; 5051; 5059; 5077; 5081; 5087; + 5099; 5101; 5107; 5113; 5119; 5147; 5153; 5167; + 5171; 5179; 5189; 5197; 5209; 5227; 5231; 5233; + 5237; 5261; 5273; 5279; 5281; 5297; 5303; 5309; + 5323; 5333; 5347; 5351; 5381; 5387; 5393; 5399; + 5407; 5413; 5417; 5419; 5431; 5437; 5441; 5443; + 5449; 5471; 5477; 5479; 5483; 5501; 5503; 5507; + 5519; 5521; 5527; 5531; 5557; 5563; 5569; 5573; + 5581; 5591; 5623; 5639; 5641; 5647; 5651; 5653; + 5657; 5659; 5669; 5683; 5689; 5693; 5701; 5711; + 5717; 5737; 5741; 5743; 5749; 5779; 5783; 5791; + 5801; 5807; 5813; 5821; 5827; 5839; 5843; 5849; + 5851; 5857; 5861; 5867; 5869; 5879; 5881; 5897; + 5903; 5923; 5927; 5939; 5953; 5981; 5987; 6007; + 6011; 6029; 6037; 6043; 6047; 6053; 6067; 6073; + 6079; 6089; 6091; 6101; 6113; 6121; 6131; 6133; + 6143; 6151; 6163; 6173; 6197; 6199; 6203; 6211; + 6217; 6221; 6229; 6247; 6257; 6263; 6269; 6271; + 6277; 6287; 6299; 6301; 6311; 6317; 6323; 6329; + 6337; 6343; 6353; 6359; 6361; 6367; 6373; 6379; + 6389; 6397; 6421; 6427; 6449; 6451; 6469; 6473; + 6481; 6491; 6521; 6529; 6547; 6551; 6553; 6563; + 6569; 6571; 6577; 6581; 6599; 6607; 6619; 6637; + 6653; 6659; 6661; 6673; 6679; 6689; 6691; 6701; + 6703; 6709; 6719; 6733; 6737; 6761; 6763; 6779; + 6781; 6791; 6793; 6803; 6823; 6827; 6829; 6833; + 6841; 6857; 6863; 6869; 6871; 6883; 6899; 6907; + 6911; 6917; 6947; 6949; 6959; 6961; 6967; 6971; + 6977; 6983; 6991; 6997; 7001; 7013; 7019; 7027; + 7039; 7043; 7057; 7069; 7079; 7103; 7109; 7121; + 7127; 7129; 7151; 7159; 7177; 7187; 7193; 7207; + 7211; 7213; 7219; 7229; 7237; 7243; 7247; 7253; + 7283; 7297; 7307; 7309; 7321; 7331; 7333; 7349; + 7351; 7369; 7393; 7411; 7417; 7433; 7451; 7457; + 7459; 7477; 7481; 7487; 7489; 7499; 7507; 7517; + 7523; 7529; 7537; 7541; 7547; 7549; 7559; 7561; + 7573; 7577; 7583; 7589; 7591; 7603; 7607; 7621; + 7639; 7643; 7649; 7669; 7673; 7681; 7687; 7691; + 7699; 7703; 7717; 7723; 7727; 7741; 7753; 7757; + 7759; 7789; 7793; 7817; 7823; 7829; 7841; 7853; + 7867; 7873; 7877; 7879; 7883; 7901; 7907; 7919; + 7927; 7933; 7937; 7949; 7951; 7963; 7993; 8009; + 8011; 8017; 8039; 8053; 8059; 8069; 8081; 8087; + 8089; 8093; 8101; 8111; 8117; 8123; 8147; 8161; + 8167; 8171; 8179; 8191 +] + +let moduli_small_primes n = + let ln = num_digits n in + let dend = create_nat (ln + 1) + and dsor = create_nat 1 + and quot = create_nat ln + and rem = create_nat 1 in + let res = + List.map + (fun p -> + (* Compute m = n mod p *) + blit_nat dend 0 n 0 ln; + set_digit_nat dend ln 0; + set_digit_nat dsor 0 p; + div_digit_nat quot 0 rem 0 dend 0 (ln + 1) dsor 0; + nth_digit_nat rem 0) + small_primes in + wipe dend; wipe dsor; wipe quot; wipe rem; + res + +let is_divisible_by_small_prime delta remainders = + List.exists2 + (fun p m -> (m + delta) mod p = 0) + small_primes remainders + +let pseudoprime_test_values = [2;3;5;7;11;13;17;19] + +let is_pseudoprime p = + let p1 = sub p one in + let res = + List.for_all + (fun x -> + let q = mod_power (nat_of_int x) p1 p in + let r = compare q one in + wipe q; + r = 0) + pseudoprime_test_values in + wipe p1; + res + +let rec random_prime ~rng numbits = + (* Generate random odd number *) + let n = random ~rng ~odd:true numbits in + (* Precompute moduli with small primes *) + let moduli = moduli_small_primes n in + (* Search from n *) + let rec find_prime delta = + if delta < 0 then (* arithmetic overflow in incrementing delta *) + random_prime ~rng numbits + else if is_divisible_by_small_prime delta moduli then + find_prime (delta + 2) + else begin + let n' = add n (nat_of_int delta) in + if is_pseudoprime n' then + if num_bits n' = numbits then begin + wipe n; n' + end else begin (* overflow in adding delta to n *) + wipe n; wipe n'; random_prime ~rng numbits + end + else + find_prime (delta + 2) + end in + find_prime 0 + diff --git a/src/cryptokitBignumOld.mli b/src/cryptokitBignumOld.mli new file mode 100644 index 0000000..1879904 --- /dev/null +++ b/src/cryptokitBignumOld.mli @@ -0,0 +1,41 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* Arithmetic on big integers *) + +type t + +val zero : t +val one : t +val of_int : int -> t + +val compare : t -> t -> int + +val add : t -> t -> t +val sub : t -> t -> t +val mult : t -> t -> t +val mod_ : t -> t -> t + +val relative_prime : t -> t -> bool +val mod_power : t -> t -> t -> t +val mod_power_CRT : t -> t -> t -> t -> t -> t -> t +val mod_inv : t -> t -> t + +val of_bytes : string -> t +val to_bytes : ?numbits:int -> t -> bytes + +val random : rng:(bytes -> int -> int -> unit) -> ?lowbits:int -> int -> t +val random_prime : rng:(bytes -> int -> int -> unit) -> int -> t + +val wipe : t -> unit + diff --git a/src/d3des.c b/src/d3des.c new file mode 100644 index 0000000..ef58a60 --- /dev/null +++ b/src/d3des.c @@ -0,0 +1,382 @@ +/* D3DES (V5.09) - + * + * A portable, public domain, version of the Data Encryption Standard. + * + * Written with Symantec's THINK (Lightspeed) C by Richard Outerbridge. + * Thanks to: Dan Hoey for his excellent Initial and Inverse permutation + * code; Jim Gillogly & Phil Karn for the DES key schedule code; Dennis + * Ferguson, Eric Young and Dana How for comparing notes; and Ray Lau, + * for humouring me on. + * + * Copyright (c) 1988,1989,1990,1991,1992 by Richard Outerbridge. + * (GEnie : OUTER; CIS : [71755,204]) Graven Imagery, 1992. + * + * Modified and adapted by Xavier Leroy, 2002. + */ + +#include "d3des.h" + +static void scrunch(u8 *, u32 *); +static void unscrun(u32 *, u8 *); +static void desfunc(u32 *, u32 *); +static void cookey(u32 *, u32 *); + +static unsigned short bytebit[8] = { + 0200, 0100, 040, 020, 010, 04, 02, 01 }; + +static u32 bigbyte[24] = { + 0x800000L, 0x400000L, 0x200000L, 0x100000L, + 0x80000L, 0x40000L, 0x20000L, 0x10000L, + 0x8000L, 0x4000L, 0x2000L, 0x1000L, + 0x800L, 0x400L, 0x200L, 0x100L, + 0x80L, 0x40L, 0x20L, 0x10L, + 0x8L, 0x4L, 0x2L, 0x1L }; + +/* Use the key schedule specified in the Standard (ANSI X3.92-1981). */ + +static u8 pc1[56] = { + 56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, + 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, + 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, + 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3 }; + +static u8 totrot[16] = { + 1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28 }; + +static u8 pc2[48] = { + 13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, + 22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, + 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, + 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31 }; + +void d3des_cook_key(u8 key[8], int edf, u32 res[32]) + /* Thanks to James Gillogly & Phil Karn! */ +{ + register int i, j, l, m, n; + u8 pc1m[56], pcr[56]; + u32 kn[32]; + + for ( j = 0; j < 56; j++ ) { + l = pc1[j]; + m = l & 07; + pc1m[j] = (key[l >> 3] & bytebit[m]) ? 1 : 0; + } + for( i = 0; i < 16; i++ ) { + if( edf == DE1 ) m = (15 - i) << 1; + else m = i << 1; + n = m + 1; + kn[m] = kn[n] = 0L; + for( j = 0; j < 28; j++ ) { + l = j + totrot[i]; + if( l < 28 ) pcr[j] = pc1m[l]; + else pcr[j] = pc1m[l - 28]; + } + for( j = 28; j < 56; j++ ) { + l = j + totrot[i]; + if( l < 56 ) pcr[j] = pc1m[l]; + else pcr[j] = pc1m[l - 28]; + } + for( j = 0; j < 24; j++ ) { + if( pcr[pc2[j]] ) kn[m] |= bigbyte[j]; + if( pcr[pc2[j+24]] ) kn[n] |= bigbyte[j]; + } + } + cookey(kn, res); + return; +} + +static void cookey(u32 * raw1, u32 * cook) +{ + register u32 *raw0; + register int i; + + for( i = 0; i < 16; i++, raw1++ ) { + raw0 = raw1++; + *cook = (*raw0 & 0x00fc0000L) << 6; + *cook |= (*raw0 & 0x00000fc0L) << 10; + *cook |= (*raw1 & 0x00fc0000L) >> 10; + *cook++ |= (*raw1 & 0x00000fc0L) >> 6; + *cook = (*raw0 & 0x0003f000L) << 12; + *cook |= (*raw0 & 0x0000003fL) << 16; + *cook |= (*raw1 & 0x0003f000L) >> 4; + *cook++ |= (*raw1 & 0x0000003fL); + } + return; +} + +void d3des_transform(u32 key[32], u8 inblock[8], u8 outblock[8]) +{ + u32 work[2]; + + scrunch(inblock, work); + desfunc(work, key); + unscrun(work, outblock); +} + +static void scrunch(u8 * outof, u32 * into) +{ + into[0] = (outof[0] << 24) | (outof[1] << 16) | (outof[2] << 8) | outof[3]; + into[1] = (outof[4] << 24) | (outof[5] << 16) | (outof[6] << 8) | outof[7]; +} + +static void unscrun(u32 * outof, u8 * into) +{ + u32 n; + n = outof[0]; + into[0] = (n >> 24); + into[1] = (n >> 16); + into[2] = (n >> 8); + into[3] = n; + n = outof[1]; + into[4] = (n >> 24); + into[5] = (n >> 16); + into[6] = (n >> 8); + into[7] = n; +} + +static u32 SP1[64] = { + 0x01010400L, 0x00000000L, 0x00010000L, 0x01010404L, + 0x01010004L, 0x00010404L, 0x00000004L, 0x00010000L, + 0x00000400L, 0x01010400L, 0x01010404L, 0x00000400L, + 0x01000404L, 0x01010004L, 0x01000000L, 0x00000004L, + 0x00000404L, 0x01000400L, 0x01000400L, 0x00010400L, + 0x00010400L, 0x01010000L, 0x01010000L, 0x01000404L, + 0x00010004L, 0x01000004L, 0x01000004L, 0x00010004L, + 0x00000000L, 0x00000404L, 0x00010404L, 0x01000000L, + 0x00010000L, 0x01010404L, 0x00000004L, 0x01010000L, + 0x01010400L, 0x01000000L, 0x01000000L, 0x00000400L, + 0x01010004L, 0x00010000L, 0x00010400L, 0x01000004L, + 0x00000400L, 0x00000004L, 0x01000404L, 0x00010404L, + 0x01010404L, 0x00010004L, 0x01010000L, 0x01000404L, + 0x01000004L, 0x00000404L, 0x00010404L, 0x01010400L, + 0x00000404L, 0x01000400L, 0x01000400L, 0x00000000L, + 0x00010004L, 0x00010400L, 0x00000000L, 0x01010004L }; + +static u32 SP2[64] = { + 0x80108020L, 0x80008000L, 0x00008000L, 0x00108020L, + 0x00100000L, 0x00000020L, 0x80100020L, 0x80008020L, + 0x80000020L, 0x80108020L, 0x80108000L, 0x80000000L, + 0x80008000L, 0x00100000L, 0x00000020L, 0x80100020L, + 0x00108000L, 0x00100020L, 0x80008020L, 0x00000000L, + 0x80000000L, 0x00008000L, 0x00108020L, 0x80100000L, + 0x00100020L, 0x80000020L, 0x00000000L, 0x00108000L, + 0x00008020L, 0x80108000L, 0x80100000L, 0x00008020L, + 0x00000000L, 0x00108020L, 0x80100020L, 0x00100000L, + 0x80008020L, 0x80100000L, 0x80108000L, 0x00008000L, + 0x80100000L, 0x80008000L, 0x00000020L, 0x80108020L, + 0x00108020L, 0x00000020L, 0x00008000L, 0x80000000L, + 0x00008020L, 0x80108000L, 0x00100000L, 0x80000020L, + 0x00100020L, 0x80008020L, 0x80000020L, 0x00100020L, + 0x00108000L, 0x00000000L, 0x80008000L, 0x00008020L, + 0x80000000L, 0x80100020L, 0x80108020L, 0x00108000L }; + +static u32 SP3[64] = { + 0x00000208L, 0x08020200L, 0x00000000L, 0x08020008L, + 0x08000200L, 0x00000000L, 0x00020208L, 0x08000200L, + 0x00020008L, 0x08000008L, 0x08000008L, 0x00020000L, + 0x08020208L, 0x00020008L, 0x08020000L, 0x00000208L, + 0x08000000L, 0x00000008L, 0x08020200L, 0x00000200L, + 0x00020200L, 0x08020000L, 0x08020008L, 0x00020208L, + 0x08000208L, 0x00020200L, 0x00020000L, 0x08000208L, + 0x00000008L, 0x08020208L, 0x00000200L, 0x08000000L, + 0x08020200L, 0x08000000L, 0x00020008L, 0x00000208L, + 0x00020000L, 0x08020200L, 0x08000200L, 0x00000000L, + 0x00000200L, 0x00020008L, 0x08020208L, 0x08000200L, + 0x08000008L, 0x00000200L, 0x00000000L, 0x08020008L, + 0x08000208L, 0x00020000L, 0x08000000L, 0x08020208L, + 0x00000008L, 0x00020208L, 0x00020200L, 0x08000008L, + 0x08020000L, 0x08000208L, 0x00000208L, 0x08020000L, + 0x00020208L, 0x00000008L, 0x08020008L, 0x00020200L }; + +static u32 SP4[64] = { + 0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L, + 0x00802080L, 0x00800081L, 0x00800001L, 0x00002001L, + 0x00000000L, 0x00802000L, 0x00802000L, 0x00802081L, + 0x00000081L, 0x00000000L, 0x00800080L, 0x00800001L, + 0x00000001L, 0x00002000L, 0x00800000L, 0x00802001L, + 0x00000080L, 0x00800000L, 0x00002001L, 0x00002080L, + 0x00800081L, 0x00000001L, 0x00002080L, 0x00800080L, + 0x00002000L, 0x00802080L, 0x00802081L, 0x00000081L, + 0x00800080L, 0x00800001L, 0x00802000L, 0x00802081L, + 0x00000081L, 0x00000000L, 0x00000000L, 0x00802000L, + 0x00002080L, 0x00800080L, 0x00800081L, 0x00000001L, + 0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L, + 0x00802081L, 0x00000081L, 0x00000001L, 0x00002000L, + 0x00800001L, 0x00002001L, 0x00802080L, 0x00800081L, + 0x00002001L, 0x00002080L, 0x00800000L, 0x00802001L, + 0x00000080L, 0x00800000L, 0x00002000L, 0x00802080L }; + +static u32 SP5[64] = { + 0x00000100L, 0x02080100L, 0x02080000L, 0x42000100L, + 0x00080000L, 0x00000100L, 0x40000000L, 0x02080000L, + 0x40080100L, 0x00080000L, 0x02000100L, 0x40080100L, + 0x42000100L, 0x42080000L, 0x00080100L, 0x40000000L, + 0x02000000L, 0x40080000L, 0x40080000L, 0x00000000L, + 0x40000100L, 0x42080100L, 0x42080100L, 0x02000100L, + 0x42080000L, 0x40000100L, 0x00000000L, 0x42000000L, + 0x02080100L, 0x02000000L, 0x42000000L, 0x00080100L, + 0x00080000L, 0x42000100L, 0x00000100L, 0x02000000L, + 0x40000000L, 0x02080000L, 0x42000100L, 0x40080100L, + 0x02000100L, 0x40000000L, 0x42080000L, 0x02080100L, + 0x40080100L, 0x00000100L, 0x02000000L, 0x42080000L, + 0x42080100L, 0x00080100L, 0x42000000L, 0x42080100L, + 0x02080000L, 0x00000000L, 0x40080000L, 0x42000000L, + 0x00080100L, 0x02000100L, 0x40000100L, 0x00080000L, + 0x00000000L, 0x40080000L, 0x02080100L, 0x40000100L }; + +static u32 SP6[64] = { + 0x20000010L, 0x20400000L, 0x00004000L, 0x20404010L, + 0x20400000L, 0x00000010L, 0x20404010L, 0x00400000L, + 0x20004000L, 0x00404010L, 0x00400000L, 0x20000010L, + 0x00400010L, 0x20004000L, 0x20000000L, 0x00004010L, + 0x00000000L, 0x00400010L, 0x20004010L, 0x00004000L, + 0x00404000L, 0x20004010L, 0x00000010L, 0x20400010L, + 0x20400010L, 0x00000000L, 0x00404010L, 0x20404000L, + 0x00004010L, 0x00404000L, 0x20404000L, 0x20000000L, + 0x20004000L, 0x00000010L, 0x20400010L, 0x00404000L, + 0x20404010L, 0x00400000L, 0x00004010L, 0x20000010L, + 0x00400000L, 0x20004000L, 0x20000000L, 0x00004010L, + 0x20000010L, 0x20404010L, 0x00404000L, 0x20400000L, + 0x00404010L, 0x20404000L, 0x00000000L, 0x20400010L, + 0x00000010L, 0x00004000L, 0x20400000L, 0x00404010L, + 0x00004000L, 0x00400010L, 0x20004010L, 0x00000000L, + 0x20404000L, 0x20000000L, 0x00400010L, 0x20004010L }; + +static u32 SP7[64] = { + 0x00200000L, 0x04200002L, 0x04000802L, 0x00000000L, + 0x00000800L, 0x04000802L, 0x00200802L, 0x04200800L, + 0x04200802L, 0x00200000L, 0x00000000L, 0x04000002L, + 0x00000002L, 0x04000000L, 0x04200002L, 0x00000802L, + 0x04000800L, 0x00200802L, 0x00200002L, 0x04000800L, + 0x04000002L, 0x04200000L, 0x04200800L, 0x00200002L, + 0x04200000L, 0x00000800L, 0x00000802L, 0x04200802L, + 0x00200800L, 0x00000002L, 0x04000000L, 0x00200800L, + 0x04000000L, 0x00200800L, 0x00200000L, 0x04000802L, + 0x04000802L, 0x04200002L, 0x04200002L, 0x00000002L, + 0x00200002L, 0x04000000L, 0x04000800L, 0x00200000L, + 0x04200800L, 0x00000802L, 0x00200802L, 0x04200800L, + 0x00000802L, 0x04000002L, 0x04200802L, 0x04200000L, + 0x00200800L, 0x00000000L, 0x00000002L, 0x04200802L, + 0x00000000L, 0x00200802L, 0x04200000L, 0x00000800L, + 0x04000002L, 0x04000800L, 0x00000800L, 0x00200002L }; + +static u32 SP8[64] = { + 0x10001040L, 0x00001000L, 0x00040000L, 0x10041040L, + 0x10000000L, 0x10001040L, 0x00000040L, 0x10000000L, + 0x00040040L, 0x10040000L, 0x10041040L, 0x00041000L, + 0x10041000L, 0x00041040L, 0x00001000L, 0x00000040L, + 0x10040000L, 0x10000040L, 0x10001000L, 0x00001040L, + 0x00041000L, 0x00040040L, 0x10040040L, 0x10041000L, + 0x00001040L, 0x00000000L, 0x00000000L, 0x10040040L, + 0x10000040L, 0x10001000L, 0x00041040L, 0x00040000L, + 0x00041040L, 0x00040000L, 0x10041000L, 0x00001000L, + 0x00000040L, 0x10040040L, 0x00001000L, 0x00041040L, + 0x10001000L, 0x00000040L, 0x10000040L, 0x10040000L, + 0x10040040L, 0x10000000L, 0x00040000L, 0x10001040L, + 0x00000000L, 0x10041040L, 0x00040040L, 0x10000040L, + 0x10040000L, 0x10001000L, 0x10001040L, 0x00000000L, + 0x10041040L, 0x00041000L, 0x00041000L, 0x00001040L, + 0x00001040L, 0x00040040L, 0x10000000L, 0x10041000L }; + +static void desfunc(u32 * block, u32 * keys) +{ + register u32 fval, work, right, leftt; + register int round; + + leftt = block[0]; + right = block[1]; + work = ((leftt >> 4) ^ right) & 0x0f0f0f0fL; + right ^= work; + leftt ^= (work << 4); + work = ((leftt >> 16) ^ right) & 0x0000ffffL; + right ^= work; + leftt ^= (work << 16); + work = ((right >> 2) ^ leftt) & 0x33333333L; + leftt ^= work; + right ^= (work << 2); + work = ((right >> 8) ^ leftt) & 0x00ff00ffL; + leftt ^= work; + right ^= (work << 8); + right = ((right << 1) | ((right >> 31) & 1L)); + work = (leftt ^ right) & 0xaaaaaaaaL; + leftt ^= work; + right ^= work; + leftt = ((leftt << 1) | ((leftt >> 31) & 1L)); + + for( round = 0; round < 8; round++ ) { + work = (right << 28) | (right >> 4); + work ^= *keys++; + fval = SP7[ work & 0x3fL]; + fval |= SP5[(work >> 8) & 0x3fL]; + fval |= SP3[(work >> 16) & 0x3fL]; + fval |= SP1[(work >> 24) & 0x3fL]; + work = right ^ *keys++; + fval |= SP8[ work & 0x3fL]; + fval |= SP6[(work >> 8) & 0x3fL]; + fval |= SP4[(work >> 16) & 0x3fL]; + fval |= SP2[(work >> 24) & 0x3fL]; + leftt ^= fval; + work = (leftt << 28) | (leftt >> 4); + work ^= *keys++; + fval = SP7[ work & 0x3fL]; + fval |= SP5[(work >> 8) & 0x3fL]; + fval |= SP3[(work >> 16) & 0x3fL]; + fval |= SP1[(work >> 24) & 0x3fL]; + work = leftt ^ *keys++; + fval |= SP8[ work & 0x3fL]; + fval |= SP6[(work >> 8) & 0x3fL]; + fval |= SP4[(work >> 16) & 0x3fL]; + fval |= SP2[(work >> 24) & 0x3fL]; + right ^= fval; + } + + right = (right << 31) | (right >> 1); + work = (leftt ^ right) & 0xaaaaaaaaL; + leftt ^= work; + right ^= work; + leftt = (leftt << 31) | (leftt >> 1); + work = ((leftt >> 8) ^ right) & 0x00ff00ffL; + right ^= work; + leftt ^= (work << 8); + work = ((leftt >> 2) ^ right) & 0x33333333L; + right ^= work; + leftt ^= (work << 2); + work = ((right >> 16) ^ leftt) & 0x0000ffffL; + leftt ^= work; + right ^= (work << 16); + work = ((right >> 4) ^ leftt) & 0x0f0f0f0fL; + leftt ^= work; + right ^= (work << 4); + *block++ = right; + *block = leftt; +} + +/* Validation sets: + * + * Single-length key, single-length plaintext - + * Key : 0123 4567 89ab cdef + * Plain : 0123 4567 89ab cde7 + * Cipher : c957 4425 6a5e d31d + * + * Double-length key, single-length plaintext - + * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 + * Plain : 0123 4567 89ab cde7 + * Cipher : 7f1d 0a77 826b 8aff + * + * Double-length key, double-length plaintext - + * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 + * Plain : 0123 4567 89ab cdef 0123 4567 89ab cdff + * Cipher : 27a0 8440 406a df60 278f 47cf 42d6 15d7 + * + * Triple-length key, single-length plaintext - + * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 89ab cdef 0123 4567 + * Plain : 0123 4567 89ab cde7 + * Cipher : de0b 7c06 ae5e 0ed5 + * + * Triple-length key, double-length plaintext - + * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 89ab cdef 0123 4567 + * Plain : 0123 4567 89ab cdef 0123 4567 89ab cdff + * Cipher : ad0d 1b30 ac17 cf07 0ed1 1c63 81e4 4de5 + * + * d3des V5.0a rwo 9208.07 18:44 Graven Imagery + **********************************************************************/ diff --git a/src/d3des.h b/src/d3des.h new file mode 100644 index 0000000..c11120f --- /dev/null +++ b/src/d3des.h @@ -0,0 +1,28 @@ +/* d3des.h - + * + * Headers and defines for d3des.c + * Graven Imagery, 1992. + * + * Copyright (c) 1988,1989,1990,1991,1992 by Richard Outerbridge + * (GEnie : OUTER; CIS : [71755,204]) + * + * Modified and adapted by Xavier Leroy, 2002. + */ + +#define EN0 0 /* MODE == encrypt */ +#define DE1 1 /* MODE == decrypt */ + +typedef unsigned char u8; +typedef unsigned int u32; + +extern void d3des_cook_key(u8 key[8], int mode, u32 res[32]); +/* Sets the key register [res] according to the hexadecimal + * key contained in the 8 bytes of [key], according to the DES, + * for encryption or decryption according to [mode]. + */ + +extern void d3des_transform(u32 key[32], u8 from[8], u8 to[8]); +/* Encrypts/Decrypts (according to the key [key]) + * one block of eight bytes at address 'from' + * into the block at address 'to'. They can be the same. + */ diff --git a/src/keccak.c b/src/keccak.c new file mode 100644 index 0000000..c710d68 --- /dev/null +++ b/src/keccak.c @@ -0,0 +1,185 @@ +/* SHA-3 (Keccak) cryptographic hash function */ +/* Code adapted from the "readable" implementation written by + Markku-Juhani O. Saarinen */ + +#include +#include +#include +#include "keccak.h" + +#define KECCAK_ROUNDS 24 + +#define ROTL64(x, y) (((x) << (y)) | ((x) >> (64 - (y)))) + +static const u64 keccakf_rndc[24] = +{ + 0x0000000000000001, 0x0000000000008082, 0x800000000000808a, + 0x8000000080008000, 0x000000000000808b, 0x0000000080000001, + 0x8000000080008081, 0x8000000000008009, 0x000000000000008a, + 0x0000000000000088, 0x0000000080008009, 0x000000008000000a, + 0x000000008000808b, 0x800000000000008b, 0x8000000000008089, + 0x8000000000008003, 0x8000000000008002, 0x8000000000000080, + 0x000000000000800a, 0x800000008000000a, 0x8000000080008081, + 0x8000000000008080, 0x0000000080000001, 0x8000000080008008 +}; + +#if 0 +/* Inlined */ +static const int keccakf_rotc[24] = +{ + 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 2, 14, + 27, 41, 56, 8, 25, 43, 62, 18, 39, 61, 20, 44 +}; + +static const int keccakf_piln[24] = +{ + 10, 7, 11, 17, 18, 3, 5, 16, 8, 21, 24, 4, + 15, 23, 19, 13, 12, 2, 20, 14, 22, 9, 6, 1 +}; +#endif + +/* Update the state with KECCAK_ROUND rounds */ + +static void KeccakPermutation(u64 st[25]) +{ + int round, j; + u64 t, bc[5]; + + for (round = 0; round < KECCAK_ROUNDS; round++) { + + // Theta +#define THETA1(i) \ + bc[i] = st[i] ^ st[i + 5] ^ st[i + 10] ^ st[i + 15] ^ st[i + 20] + + THETA1(0); THETA1(1); THETA1(2); THETA1(3); THETA1(4); + +#define THETA2(i) \ + t = bc[(i + 4) % 5] ^ ROTL64(bc[(i + 1) % 5], 1); \ + st[0 + i] ^= t; \ + st[5 + i] ^= t; \ + st[10 + i] ^= t; \ + st[15 + i] ^= t; \ + st[20 + i] ^= t + + THETA2(0); THETA2(1); THETA2(2); THETA2(3); THETA2(4); + + + // Rho Pi + +#define RHOPI(i, rotc, piln) \ + bc[0] = st[piln]; \ + st[piln] = ROTL64(t, rotc); \ + t = bc[0] + + t = st[1]; + RHOPI(0, 1, 10); RHOPI(1, 3, 7); RHOPI(2, 6, 11); RHOPI(3, 10, 17); + RHOPI(4, 15, 18); RHOPI(5, 21, 3); RHOPI(6, 28, 5); RHOPI(7, 36, 16); + RHOPI(8, 45, 8); RHOPI(9, 55, 21); RHOPI(10, 2, 24); RHOPI(11, 14, 4); + RHOPI(12, 27, 15); RHOPI(13, 41, 23); RHOPI(14, 56, 19); RHOPI(15, 8, 13); + RHOPI(16, 25, 12); RHOPI(17, 43, 2); RHOPI(18, 62, 20); RHOPI(19, 18, 14); + RHOPI(20, 39, 22); RHOPI(21, 61, 9); RHOPI(22, 20, 6); RHOPI(23, 44, 1); + + // Chi + +#define CHI1(i,j) \ + bc[i] = st[j + i] +#define CHI2(i,j) \ + st[j + i] ^= (~bc[(i + 1) % 5]) & bc[(i + 2) % 5] + + for (j = 0; j < 25; j += 5) { + CHI1(0,j); CHI1(1,j); CHI1(2,j); CHI1(3,j); CHI1(4,j); + CHI2(0,j); CHI2(1,j); CHI2(2,j); CHI2(3,j); CHI2(4,j); + } + + // Iota + st[0] ^= keccakf_rndc[round]; + } +} + +/* Absorb the given data and permute */ + +static void KeccakAbsorb(u64 st[25], unsigned char * p, int rsiz) +{ + int i; + rsiz = rsiz / 8; + for (i = 0; i < rsiz; i += 1, p += 8) { + // fixme: use direct access for little-endian platforms without + // alignment constraints? + unsigned int l = p[0] | (p[1] << 8) | (p[2] << 16) | (p[3] << 24); + unsigned int h = p[4] | (p[5] << 8) | (p[6] << 16) | (p[7] << 24); + st[i] ^= l | ((unsigned long long) h << 32); + } + KeccakPermutation(st); +} + +/* Exported interface */ + +void SHA3_init(struct SHA3Context * ctx, int hsiz) +{ + assert (hsiz == 224 || hsiz == 256 || hsiz == 384 || hsiz == 512); + ctx->hsiz = hsiz / 8; + ctx->rsiz = 200 - 2 * ctx->hsiz; + ctx->numbytes = 0; + memset(ctx->state, 0, sizeof(ctx->state)); +} + +void SHA3_absorb(struct SHA3Context * ctx, + unsigned char * data, + unsigned long len) +{ + int n; + + /* If data was left in buffer, fill with fresh data and absorb */ + if (ctx->numbytes != 0) { + n = ctx->rsiz - ctx->numbytes; + if (len < n) { + memcpy(ctx->buffer + ctx->numbytes, data, len); + ctx->numbytes += len; + return; + } + memcpy(ctx->buffer + ctx->numbytes, data, n); + KeccakAbsorb(ctx->state, ctx->buffer, ctx->rsiz); + data += n; + len -= n; + } + /* Absorb data in blocks of [rsiz] bytes */ + while (len >= ctx->rsiz) { + KeccakAbsorb(ctx->state, data, ctx->rsiz); + data += ctx->rsiz; + len -= ctx->rsiz; + } + /* Save remaining data */ + if (len > 0) memcpy(ctx->buffer, data, len); + ctx->numbytes = len; +} + +void SHA3_extract(unsigned char padding, + struct SHA3Context * ctx, + unsigned char * output) +{ + int i, j, n; + + /* Apply final padding */ + n = ctx->numbytes; + ctx->buffer[n] = padding; + n++; + memset(ctx->buffer + n, 0, ctx->rsiz - n); + ctx->buffer[ctx->rsiz - 1] |= 0x80; + + /* Absorb remaining data + padding */ + KeccakAbsorb(ctx->state, ctx->buffer, ctx->rsiz); + + /* Extract hash as low bits of state */ + for (i = 0, j = 0; j < ctx->hsiz; i += 1, j += 8) { + u64 st = ctx->state[i]; + output[j] = st; + output[j + 1] = st >> 8; + output[j + 2] = st >> 16; + output[j + 3] = st >> 24; + if (j + 4 >= ctx->hsiz) break; + output[j + 4] = st >> 32; + output[j + 5] = st >> 40; + output[j + 6] = st >> 48; + output[j + 7] = st >> 56; + } +} diff --git a/src/keccak.h b/src/keccak.h new file mode 100644 index 0000000..790d82a --- /dev/null +++ b/src/keccak.h @@ -0,0 +1,21 @@ +/* SHA-3 (Keccak) cryptographic hash function */ + +typedef unsigned long long u64; + +struct SHA3Context { + u64 state[25]; + unsigned char buffer[144]; + int numbytes; /* number of bytes in buffer */ + int rsiz; /* number of message bytes processed by permutation */ + int hsiz; /* size of hash in bytes */ +}; + +extern void SHA3_init(struct SHA3Context * ctx, int hsiz); + +extern void SHA3_absorb(struct SHA3Context * ctx, + unsigned char * data, + unsigned long len); + +extern void SHA3_extract(unsigned char padding, + struct SHA3Context * ctx, + unsigned char * output); diff --git a/src/libcryptokit_stubs.clib b/src/libcryptokit_stubs.clib new file mode 100644 index 0000000..94cc08d --- /dev/null +++ b/src/libcryptokit_stubs.clib @@ -0,0 +1,28 @@ +# OASIS_START +# DO NOT EDIT (digest: c7ac7a160eaa5e93a581a4efbe9317de) +aesni.o +arcfour.o +stubs-arcfour.o +blowfish.o +stubs-blowfish.o +d3des.o +stubs-des.o +rijndael-alg-fst.o +ripemd160.o +stubs-ripemd160.o +sha1.o +stubs-sha1.o +sha256.o +stubs-sha256.o +sha512.o +stubs-sha512.o +stubs-aes.o +stubs-md5.o +stubs-misc.o +stubs-rng.o +stubs-zlib.o +keccak.o +stubs-sha3.o +chacha20.o +stubs-chacha20.o +# OASIS_STOP diff --git a/src/rijndael-alg-fst.c b/src/rijndael-alg-fst.c new file mode 100644 index 0000000..8a10040 --- /dev/null +++ b/src/rijndael-alg-fst.c @@ -0,0 +1,1400 @@ +/** + * rijndael-alg-fst.c + * + * @version 3.0 (December 2000) + * + * Optimised ANSI C code for the Rijndael cipher (now AES) + * + * @author Vincent Rijmen + * @author Antoon Bosselaers + * @author Paulo Barreto + * + * This code is hereby placed in the public domain. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS + * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR + * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE + * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, + * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ +#include +#include + +#include "rijndael-alg-fst.h" + +/* +Te0[x] = S [x].[02, 01, 01, 03]; +Te1[x] = S [x].[03, 02, 01, 01]; +Te2[x] = S [x].[01, 03, 02, 01]; +Te3[x] = S [x].[01, 01, 03, 02]; +Te4[x] = S [x].[01, 01, 01, 01]; + +Td0[x] = Si[x].[0e, 09, 0d, 0b]; +Td1[x] = Si[x].[0b, 0e, 09, 0d]; +Td2[x] = Si[x].[0d, 0b, 0e, 09]; +Td3[x] = Si[x].[09, 0d, 0b, 0e]; +Td4[x] = Si[x].[01, 01, 01, 01]; +*/ + +static const u32 Te0[256] = { + 0xc66363a5U, 0xf87c7c84U, 0xee777799U, 0xf67b7b8dU, + 0xfff2f20dU, 0xd66b6bbdU, 0xde6f6fb1U, 0x91c5c554U, + 0x60303050U, 0x02010103U, 0xce6767a9U, 0x562b2b7dU, + 0xe7fefe19U, 0xb5d7d762U, 0x4dababe6U, 0xec76769aU, + 0x8fcaca45U, 0x1f82829dU, 0x89c9c940U, 0xfa7d7d87U, + 0xeffafa15U, 0xb25959ebU, 0x8e4747c9U, 0xfbf0f00bU, + 0x41adadecU, 0xb3d4d467U, 0x5fa2a2fdU, 0x45afafeaU, + 0x239c9cbfU, 0x53a4a4f7U, 0xe4727296U, 0x9bc0c05bU, + 0x75b7b7c2U, 0xe1fdfd1cU, 0x3d9393aeU, 0x4c26266aU, + 0x6c36365aU, 0x7e3f3f41U, 0xf5f7f702U, 0x83cccc4fU, + 0x6834345cU, 0x51a5a5f4U, 0xd1e5e534U, 0xf9f1f108U, + 0xe2717193U, 0xabd8d873U, 0x62313153U, 0x2a15153fU, + 0x0804040cU, 0x95c7c752U, 0x46232365U, 0x9dc3c35eU, + 0x30181828U, 0x379696a1U, 0x0a05050fU, 0x2f9a9ab5U, + 0x0e070709U, 0x24121236U, 0x1b80809bU, 0xdfe2e23dU, + 0xcdebeb26U, 0x4e272769U, 0x7fb2b2cdU, 0xea75759fU, + 0x1209091bU, 0x1d83839eU, 0x582c2c74U, 0x341a1a2eU, + 0x361b1b2dU, 0xdc6e6eb2U, 0xb45a5aeeU, 0x5ba0a0fbU, + 0xa45252f6U, 0x763b3b4dU, 0xb7d6d661U, 0x7db3b3ceU, + 0x5229297bU, 0xdde3e33eU, 0x5e2f2f71U, 0x13848497U, + 0xa65353f5U, 0xb9d1d168U, 0x00000000U, 0xc1eded2cU, + 0x40202060U, 0xe3fcfc1fU, 0x79b1b1c8U, 0xb65b5bedU, + 0xd46a6abeU, 0x8dcbcb46U, 0x67bebed9U, 0x7239394bU, + 0x944a4adeU, 0x984c4cd4U, 0xb05858e8U, 0x85cfcf4aU, + 0xbbd0d06bU, 0xc5efef2aU, 0x4faaaae5U, 0xedfbfb16U, + 0x864343c5U, 0x9a4d4dd7U, 0x66333355U, 0x11858594U, + 0x8a4545cfU, 0xe9f9f910U, 0x04020206U, 0xfe7f7f81U, + 0xa05050f0U, 0x783c3c44U, 0x259f9fbaU, 0x4ba8a8e3U, + 0xa25151f3U, 0x5da3a3feU, 0x804040c0U, 0x058f8f8aU, + 0x3f9292adU, 0x219d9dbcU, 0x70383848U, 0xf1f5f504U, + 0x63bcbcdfU, 0x77b6b6c1U, 0xafdada75U, 0x42212163U, + 0x20101030U, 0xe5ffff1aU, 0xfdf3f30eU, 0xbfd2d26dU, + 0x81cdcd4cU, 0x180c0c14U, 0x26131335U, 0xc3ecec2fU, + 0xbe5f5fe1U, 0x359797a2U, 0x884444ccU, 0x2e171739U, + 0x93c4c457U, 0x55a7a7f2U, 0xfc7e7e82U, 0x7a3d3d47U, + 0xc86464acU, 0xba5d5de7U, 0x3219192bU, 0xe6737395U, + 0xc06060a0U, 0x19818198U, 0x9e4f4fd1U, 0xa3dcdc7fU, + 0x44222266U, 0x542a2a7eU, 0x3b9090abU, 0x0b888883U, + 0x8c4646caU, 0xc7eeee29U, 0x6bb8b8d3U, 0x2814143cU, + 0xa7dede79U, 0xbc5e5ee2U, 0x160b0b1dU, 0xaddbdb76U, + 0xdbe0e03bU, 0x64323256U, 0x743a3a4eU, 0x140a0a1eU, + 0x924949dbU, 0x0c06060aU, 0x4824246cU, 0xb85c5ce4U, + 0x9fc2c25dU, 0xbdd3d36eU, 0x43acacefU, 0xc46262a6U, + 0x399191a8U, 0x319595a4U, 0xd3e4e437U, 0xf279798bU, + 0xd5e7e732U, 0x8bc8c843U, 0x6e373759U, 0xda6d6db7U, + 0x018d8d8cU, 0xb1d5d564U, 0x9c4e4ed2U, 0x49a9a9e0U, + 0xd86c6cb4U, 0xac5656faU, 0xf3f4f407U, 0xcfeaea25U, + 0xca6565afU, 0xf47a7a8eU, 0x47aeaee9U, 0x10080818U, + 0x6fbabad5U, 0xf0787888U, 0x4a25256fU, 0x5c2e2e72U, + 0x381c1c24U, 0x57a6a6f1U, 0x73b4b4c7U, 0x97c6c651U, + 0xcbe8e823U, 0xa1dddd7cU, 0xe874749cU, 0x3e1f1f21U, + 0x964b4bddU, 0x61bdbddcU, 0x0d8b8b86U, 0x0f8a8a85U, + 0xe0707090U, 0x7c3e3e42U, 0x71b5b5c4U, 0xcc6666aaU, + 0x904848d8U, 0x06030305U, 0xf7f6f601U, 0x1c0e0e12U, + 0xc26161a3U, 0x6a35355fU, 0xae5757f9U, 0x69b9b9d0U, + 0x17868691U, 0x99c1c158U, 0x3a1d1d27U, 0x279e9eb9U, + 0xd9e1e138U, 0xebf8f813U, 0x2b9898b3U, 0x22111133U, + 0xd26969bbU, 0xa9d9d970U, 0x078e8e89U, 0x339494a7U, + 0x2d9b9bb6U, 0x3c1e1e22U, 0x15878792U, 0xc9e9e920U, + 0x87cece49U, 0xaa5555ffU, 0x50282878U, 0xa5dfdf7aU, + 0x038c8c8fU, 0x59a1a1f8U, 0x09898980U, 0x1a0d0d17U, + 0x65bfbfdaU, 0xd7e6e631U, 0x844242c6U, 0xd06868b8U, + 0x824141c3U, 0x299999b0U, 0x5a2d2d77U, 0x1e0f0f11U, + 0x7bb0b0cbU, 0xa85454fcU, 0x6dbbbbd6U, 0x2c16163aU, +}; +static const u32 Te1[256] = { + 0xa5c66363U, 0x84f87c7cU, 0x99ee7777U, 0x8df67b7bU, + 0x0dfff2f2U, 0xbdd66b6bU, 0xb1de6f6fU, 0x5491c5c5U, + 0x50603030U, 0x03020101U, 0xa9ce6767U, 0x7d562b2bU, + 0x19e7fefeU, 0x62b5d7d7U, 0xe64dababU, 0x9aec7676U, + 0x458fcacaU, 0x9d1f8282U, 0x4089c9c9U, 0x87fa7d7dU, + 0x15effafaU, 0xebb25959U, 0xc98e4747U, 0x0bfbf0f0U, + 0xec41adadU, 0x67b3d4d4U, 0xfd5fa2a2U, 0xea45afafU, + 0xbf239c9cU, 0xf753a4a4U, 0x96e47272U, 0x5b9bc0c0U, + 0xc275b7b7U, 0x1ce1fdfdU, 0xae3d9393U, 0x6a4c2626U, + 0x5a6c3636U, 0x417e3f3fU, 0x02f5f7f7U, 0x4f83ccccU, + 0x5c683434U, 0xf451a5a5U, 0x34d1e5e5U, 0x08f9f1f1U, + 0x93e27171U, 0x73abd8d8U, 0x53623131U, 0x3f2a1515U, + 0x0c080404U, 0x5295c7c7U, 0x65462323U, 0x5e9dc3c3U, + 0x28301818U, 0xa1379696U, 0x0f0a0505U, 0xb52f9a9aU, + 0x090e0707U, 0x36241212U, 0x9b1b8080U, 0x3ddfe2e2U, + 0x26cdebebU, 0x694e2727U, 0xcd7fb2b2U, 0x9fea7575U, + 0x1b120909U, 0x9e1d8383U, 0x74582c2cU, 0x2e341a1aU, + 0x2d361b1bU, 0xb2dc6e6eU, 0xeeb45a5aU, 0xfb5ba0a0U, + 0xf6a45252U, 0x4d763b3bU, 0x61b7d6d6U, 0xce7db3b3U, + 0x7b522929U, 0x3edde3e3U, 0x715e2f2fU, 0x97138484U, + 0xf5a65353U, 0x68b9d1d1U, 0x00000000U, 0x2cc1ededU, + 0x60402020U, 0x1fe3fcfcU, 0xc879b1b1U, 0xedb65b5bU, + 0xbed46a6aU, 0x468dcbcbU, 0xd967bebeU, 0x4b723939U, + 0xde944a4aU, 0xd4984c4cU, 0xe8b05858U, 0x4a85cfcfU, + 0x6bbbd0d0U, 0x2ac5efefU, 0xe54faaaaU, 0x16edfbfbU, + 0xc5864343U, 0xd79a4d4dU, 0x55663333U, 0x94118585U, + 0xcf8a4545U, 0x10e9f9f9U, 0x06040202U, 0x81fe7f7fU, + 0xf0a05050U, 0x44783c3cU, 0xba259f9fU, 0xe34ba8a8U, + 0xf3a25151U, 0xfe5da3a3U, 0xc0804040U, 0x8a058f8fU, + 0xad3f9292U, 0xbc219d9dU, 0x48703838U, 0x04f1f5f5U, + 0xdf63bcbcU, 0xc177b6b6U, 0x75afdadaU, 0x63422121U, + 0x30201010U, 0x1ae5ffffU, 0x0efdf3f3U, 0x6dbfd2d2U, + 0x4c81cdcdU, 0x14180c0cU, 0x35261313U, 0x2fc3ececU, + 0xe1be5f5fU, 0xa2359797U, 0xcc884444U, 0x392e1717U, + 0x5793c4c4U, 0xf255a7a7U, 0x82fc7e7eU, 0x477a3d3dU, + 0xacc86464U, 0xe7ba5d5dU, 0x2b321919U, 0x95e67373U, + 0xa0c06060U, 0x98198181U, 0xd19e4f4fU, 0x7fa3dcdcU, + 0x66442222U, 0x7e542a2aU, 0xab3b9090U, 0x830b8888U, + 0xca8c4646U, 0x29c7eeeeU, 0xd36bb8b8U, 0x3c281414U, + 0x79a7dedeU, 0xe2bc5e5eU, 0x1d160b0bU, 0x76addbdbU, + 0x3bdbe0e0U, 0x56643232U, 0x4e743a3aU, 0x1e140a0aU, + 0xdb924949U, 0x0a0c0606U, 0x6c482424U, 0xe4b85c5cU, + 0x5d9fc2c2U, 0x6ebdd3d3U, 0xef43acacU, 0xa6c46262U, + 0xa8399191U, 0xa4319595U, 0x37d3e4e4U, 0x8bf27979U, + 0x32d5e7e7U, 0x438bc8c8U, 0x596e3737U, 0xb7da6d6dU, + 0x8c018d8dU, 0x64b1d5d5U, 0xd29c4e4eU, 0xe049a9a9U, + 0xb4d86c6cU, 0xfaac5656U, 0x07f3f4f4U, 0x25cfeaeaU, + 0xafca6565U, 0x8ef47a7aU, 0xe947aeaeU, 0x18100808U, + 0xd56fbabaU, 0x88f07878U, 0x6f4a2525U, 0x725c2e2eU, + 0x24381c1cU, 0xf157a6a6U, 0xc773b4b4U, 0x5197c6c6U, + 0x23cbe8e8U, 0x7ca1ddddU, 0x9ce87474U, 0x213e1f1fU, + 0xdd964b4bU, 0xdc61bdbdU, 0x860d8b8bU, 0x850f8a8aU, + 0x90e07070U, 0x427c3e3eU, 0xc471b5b5U, 0xaacc6666U, + 0xd8904848U, 0x05060303U, 0x01f7f6f6U, 0x121c0e0eU, + 0xa3c26161U, 0x5f6a3535U, 0xf9ae5757U, 0xd069b9b9U, + 0x91178686U, 0x5899c1c1U, 0x273a1d1dU, 0xb9279e9eU, + 0x38d9e1e1U, 0x13ebf8f8U, 0xb32b9898U, 0x33221111U, + 0xbbd26969U, 0x70a9d9d9U, 0x89078e8eU, 0xa7339494U, + 0xb62d9b9bU, 0x223c1e1eU, 0x92158787U, 0x20c9e9e9U, + 0x4987ceceU, 0xffaa5555U, 0x78502828U, 0x7aa5dfdfU, + 0x8f038c8cU, 0xf859a1a1U, 0x80098989U, 0x171a0d0dU, + 0xda65bfbfU, 0x31d7e6e6U, 0xc6844242U, 0xb8d06868U, + 0xc3824141U, 0xb0299999U, 0x775a2d2dU, 0x111e0f0fU, + 0xcb7bb0b0U, 0xfca85454U, 0xd66dbbbbU, 0x3a2c1616U, +}; +static const u32 Te2[256] = { + 0x63a5c663U, 0x7c84f87cU, 0x7799ee77U, 0x7b8df67bU, + 0xf20dfff2U, 0x6bbdd66bU, 0x6fb1de6fU, 0xc55491c5U, + 0x30506030U, 0x01030201U, 0x67a9ce67U, 0x2b7d562bU, + 0xfe19e7feU, 0xd762b5d7U, 0xabe64dabU, 0x769aec76U, + 0xca458fcaU, 0x829d1f82U, 0xc94089c9U, 0x7d87fa7dU, + 0xfa15effaU, 0x59ebb259U, 0x47c98e47U, 0xf00bfbf0U, + 0xadec41adU, 0xd467b3d4U, 0xa2fd5fa2U, 0xafea45afU, + 0x9cbf239cU, 0xa4f753a4U, 0x7296e472U, 0xc05b9bc0U, + 0xb7c275b7U, 0xfd1ce1fdU, 0x93ae3d93U, 0x266a4c26U, + 0x365a6c36U, 0x3f417e3fU, 0xf702f5f7U, 0xcc4f83ccU, + 0x345c6834U, 0xa5f451a5U, 0xe534d1e5U, 0xf108f9f1U, + 0x7193e271U, 0xd873abd8U, 0x31536231U, 0x153f2a15U, + 0x040c0804U, 0xc75295c7U, 0x23654623U, 0xc35e9dc3U, + 0x18283018U, 0x96a13796U, 0x050f0a05U, 0x9ab52f9aU, + 0x07090e07U, 0x12362412U, 0x809b1b80U, 0xe23ddfe2U, + 0xeb26cdebU, 0x27694e27U, 0xb2cd7fb2U, 0x759fea75U, + 0x091b1209U, 0x839e1d83U, 0x2c74582cU, 0x1a2e341aU, + 0x1b2d361bU, 0x6eb2dc6eU, 0x5aeeb45aU, 0xa0fb5ba0U, + 0x52f6a452U, 0x3b4d763bU, 0xd661b7d6U, 0xb3ce7db3U, + 0x297b5229U, 0xe33edde3U, 0x2f715e2fU, 0x84971384U, + 0x53f5a653U, 0xd168b9d1U, 0x00000000U, 0xed2cc1edU, + 0x20604020U, 0xfc1fe3fcU, 0xb1c879b1U, 0x5bedb65bU, + 0x6abed46aU, 0xcb468dcbU, 0xbed967beU, 0x394b7239U, + 0x4ade944aU, 0x4cd4984cU, 0x58e8b058U, 0xcf4a85cfU, + 0xd06bbbd0U, 0xef2ac5efU, 0xaae54faaU, 0xfb16edfbU, + 0x43c58643U, 0x4dd79a4dU, 0x33556633U, 0x85941185U, + 0x45cf8a45U, 0xf910e9f9U, 0x02060402U, 0x7f81fe7fU, + 0x50f0a050U, 0x3c44783cU, 0x9fba259fU, 0xa8e34ba8U, + 0x51f3a251U, 0xa3fe5da3U, 0x40c08040U, 0x8f8a058fU, + 0x92ad3f92U, 0x9dbc219dU, 0x38487038U, 0xf504f1f5U, + 0xbcdf63bcU, 0xb6c177b6U, 0xda75afdaU, 0x21634221U, + 0x10302010U, 0xff1ae5ffU, 0xf30efdf3U, 0xd26dbfd2U, + 0xcd4c81cdU, 0x0c14180cU, 0x13352613U, 0xec2fc3ecU, + 0x5fe1be5fU, 0x97a23597U, 0x44cc8844U, 0x17392e17U, + 0xc45793c4U, 0xa7f255a7U, 0x7e82fc7eU, 0x3d477a3dU, + 0x64acc864U, 0x5de7ba5dU, 0x192b3219U, 0x7395e673U, + 0x60a0c060U, 0x81981981U, 0x4fd19e4fU, 0xdc7fa3dcU, + 0x22664422U, 0x2a7e542aU, 0x90ab3b90U, 0x88830b88U, + 0x46ca8c46U, 0xee29c7eeU, 0xb8d36bb8U, 0x143c2814U, + 0xde79a7deU, 0x5ee2bc5eU, 0x0b1d160bU, 0xdb76addbU, + 0xe03bdbe0U, 0x32566432U, 0x3a4e743aU, 0x0a1e140aU, + 0x49db9249U, 0x060a0c06U, 0x246c4824U, 0x5ce4b85cU, + 0xc25d9fc2U, 0xd36ebdd3U, 0xacef43acU, 0x62a6c462U, + 0x91a83991U, 0x95a43195U, 0xe437d3e4U, 0x798bf279U, + 0xe732d5e7U, 0xc8438bc8U, 0x37596e37U, 0x6db7da6dU, + 0x8d8c018dU, 0xd564b1d5U, 0x4ed29c4eU, 0xa9e049a9U, + 0x6cb4d86cU, 0x56faac56U, 0xf407f3f4U, 0xea25cfeaU, + 0x65afca65U, 0x7a8ef47aU, 0xaee947aeU, 0x08181008U, + 0xbad56fbaU, 0x7888f078U, 0x256f4a25U, 0x2e725c2eU, + 0x1c24381cU, 0xa6f157a6U, 0xb4c773b4U, 0xc65197c6U, + 0xe823cbe8U, 0xdd7ca1ddU, 0x749ce874U, 0x1f213e1fU, + 0x4bdd964bU, 0xbddc61bdU, 0x8b860d8bU, 0x8a850f8aU, + 0x7090e070U, 0x3e427c3eU, 0xb5c471b5U, 0x66aacc66U, + 0x48d89048U, 0x03050603U, 0xf601f7f6U, 0x0e121c0eU, + 0x61a3c261U, 0x355f6a35U, 0x57f9ae57U, 0xb9d069b9U, + 0x86911786U, 0xc15899c1U, 0x1d273a1dU, 0x9eb9279eU, + 0xe138d9e1U, 0xf813ebf8U, 0x98b32b98U, 0x11332211U, + 0x69bbd269U, 0xd970a9d9U, 0x8e89078eU, 0x94a73394U, + 0x9bb62d9bU, 0x1e223c1eU, 0x87921587U, 0xe920c9e9U, + 0xce4987ceU, 0x55ffaa55U, 0x28785028U, 0xdf7aa5dfU, + 0x8c8f038cU, 0xa1f859a1U, 0x89800989U, 0x0d171a0dU, + 0xbfda65bfU, 0xe631d7e6U, 0x42c68442U, 0x68b8d068U, + 0x41c38241U, 0x99b02999U, 0x2d775a2dU, 0x0f111e0fU, + 0xb0cb7bb0U, 0x54fca854U, 0xbbd66dbbU, 0x163a2c16U, +}; +static const u32 Te3[256] = { + + 0x6363a5c6U, 0x7c7c84f8U, 0x777799eeU, 0x7b7b8df6U, + 0xf2f20dffU, 0x6b6bbdd6U, 0x6f6fb1deU, 0xc5c55491U, + 0x30305060U, 0x01010302U, 0x6767a9ceU, 0x2b2b7d56U, + 0xfefe19e7U, 0xd7d762b5U, 0xababe64dU, 0x76769aecU, + 0xcaca458fU, 0x82829d1fU, 0xc9c94089U, 0x7d7d87faU, + 0xfafa15efU, 0x5959ebb2U, 0x4747c98eU, 0xf0f00bfbU, + 0xadadec41U, 0xd4d467b3U, 0xa2a2fd5fU, 0xafafea45U, + 0x9c9cbf23U, 0xa4a4f753U, 0x727296e4U, 0xc0c05b9bU, + 0xb7b7c275U, 0xfdfd1ce1U, 0x9393ae3dU, 0x26266a4cU, + 0x36365a6cU, 0x3f3f417eU, 0xf7f702f5U, 0xcccc4f83U, + 0x34345c68U, 0xa5a5f451U, 0xe5e534d1U, 0xf1f108f9U, + 0x717193e2U, 0xd8d873abU, 0x31315362U, 0x15153f2aU, + 0x04040c08U, 0xc7c75295U, 0x23236546U, 0xc3c35e9dU, + 0x18182830U, 0x9696a137U, 0x05050f0aU, 0x9a9ab52fU, + 0x0707090eU, 0x12123624U, 0x80809b1bU, 0xe2e23ddfU, + 0xebeb26cdU, 0x2727694eU, 0xb2b2cd7fU, 0x75759feaU, + 0x09091b12U, 0x83839e1dU, 0x2c2c7458U, 0x1a1a2e34U, + 0x1b1b2d36U, 0x6e6eb2dcU, 0x5a5aeeb4U, 0xa0a0fb5bU, + 0x5252f6a4U, 0x3b3b4d76U, 0xd6d661b7U, 0xb3b3ce7dU, + 0x29297b52U, 0xe3e33eddU, 0x2f2f715eU, 0x84849713U, + 0x5353f5a6U, 0xd1d168b9U, 0x00000000U, 0xeded2cc1U, + 0x20206040U, 0xfcfc1fe3U, 0xb1b1c879U, 0x5b5bedb6U, + 0x6a6abed4U, 0xcbcb468dU, 0xbebed967U, 0x39394b72U, + 0x4a4ade94U, 0x4c4cd498U, 0x5858e8b0U, 0xcfcf4a85U, + 0xd0d06bbbU, 0xefef2ac5U, 0xaaaae54fU, 0xfbfb16edU, + 0x4343c586U, 0x4d4dd79aU, 0x33335566U, 0x85859411U, + 0x4545cf8aU, 0xf9f910e9U, 0x02020604U, 0x7f7f81feU, + 0x5050f0a0U, 0x3c3c4478U, 0x9f9fba25U, 0xa8a8e34bU, + 0x5151f3a2U, 0xa3a3fe5dU, 0x4040c080U, 0x8f8f8a05U, + 0x9292ad3fU, 0x9d9dbc21U, 0x38384870U, 0xf5f504f1U, + 0xbcbcdf63U, 0xb6b6c177U, 0xdada75afU, 0x21216342U, + 0x10103020U, 0xffff1ae5U, 0xf3f30efdU, 0xd2d26dbfU, + 0xcdcd4c81U, 0x0c0c1418U, 0x13133526U, 0xecec2fc3U, + 0x5f5fe1beU, 0x9797a235U, 0x4444cc88U, 0x1717392eU, + 0xc4c45793U, 0xa7a7f255U, 0x7e7e82fcU, 0x3d3d477aU, + 0x6464acc8U, 0x5d5de7baU, 0x19192b32U, 0x737395e6U, + 0x6060a0c0U, 0x81819819U, 0x4f4fd19eU, 0xdcdc7fa3U, + 0x22226644U, 0x2a2a7e54U, 0x9090ab3bU, 0x8888830bU, + 0x4646ca8cU, 0xeeee29c7U, 0xb8b8d36bU, 0x14143c28U, + 0xdede79a7U, 0x5e5ee2bcU, 0x0b0b1d16U, 0xdbdb76adU, + 0xe0e03bdbU, 0x32325664U, 0x3a3a4e74U, 0x0a0a1e14U, + 0x4949db92U, 0x06060a0cU, 0x24246c48U, 0x5c5ce4b8U, + 0xc2c25d9fU, 0xd3d36ebdU, 0xacacef43U, 0x6262a6c4U, + 0x9191a839U, 0x9595a431U, 0xe4e437d3U, 0x79798bf2U, + 0xe7e732d5U, 0xc8c8438bU, 0x3737596eU, 0x6d6db7daU, + 0x8d8d8c01U, 0xd5d564b1U, 0x4e4ed29cU, 0xa9a9e049U, + 0x6c6cb4d8U, 0x5656faacU, 0xf4f407f3U, 0xeaea25cfU, + 0x6565afcaU, 0x7a7a8ef4U, 0xaeaee947U, 0x08081810U, + 0xbabad56fU, 0x787888f0U, 0x25256f4aU, 0x2e2e725cU, + 0x1c1c2438U, 0xa6a6f157U, 0xb4b4c773U, 0xc6c65197U, + 0xe8e823cbU, 0xdddd7ca1U, 0x74749ce8U, 0x1f1f213eU, + 0x4b4bdd96U, 0xbdbddc61U, 0x8b8b860dU, 0x8a8a850fU, + 0x707090e0U, 0x3e3e427cU, 0xb5b5c471U, 0x6666aaccU, + 0x4848d890U, 0x03030506U, 0xf6f601f7U, 0x0e0e121cU, + 0x6161a3c2U, 0x35355f6aU, 0x5757f9aeU, 0xb9b9d069U, + 0x86869117U, 0xc1c15899U, 0x1d1d273aU, 0x9e9eb927U, + 0xe1e138d9U, 0xf8f813ebU, 0x9898b32bU, 0x11113322U, + 0x6969bbd2U, 0xd9d970a9U, 0x8e8e8907U, 0x9494a733U, + 0x9b9bb62dU, 0x1e1e223cU, 0x87879215U, 0xe9e920c9U, + 0xcece4987U, 0x5555ffaaU, 0x28287850U, 0xdfdf7aa5U, + 0x8c8c8f03U, 0xa1a1f859U, 0x89898009U, 0x0d0d171aU, + 0xbfbfda65U, 0xe6e631d7U, 0x4242c684U, 0x6868b8d0U, + 0x4141c382U, 0x9999b029U, 0x2d2d775aU, 0x0f0f111eU, + 0xb0b0cb7bU, 0x5454fca8U, 0xbbbbd66dU, 0x16163a2cU, +}; +static const u32 Te4[256] = { + 0x63636363U, 0x7c7c7c7cU, 0x77777777U, 0x7b7b7b7bU, + 0xf2f2f2f2U, 0x6b6b6b6bU, 0x6f6f6f6fU, 0xc5c5c5c5U, + 0x30303030U, 0x01010101U, 0x67676767U, 0x2b2b2b2bU, + 0xfefefefeU, 0xd7d7d7d7U, 0xababababU, 0x76767676U, + 0xcacacacaU, 0x82828282U, 0xc9c9c9c9U, 0x7d7d7d7dU, + 0xfafafafaU, 0x59595959U, 0x47474747U, 0xf0f0f0f0U, + 0xadadadadU, 0xd4d4d4d4U, 0xa2a2a2a2U, 0xafafafafU, + 0x9c9c9c9cU, 0xa4a4a4a4U, 0x72727272U, 0xc0c0c0c0U, + 0xb7b7b7b7U, 0xfdfdfdfdU, 0x93939393U, 0x26262626U, + 0x36363636U, 0x3f3f3f3fU, 0xf7f7f7f7U, 0xccccccccU, + 0x34343434U, 0xa5a5a5a5U, 0xe5e5e5e5U, 0xf1f1f1f1U, + 0x71717171U, 0xd8d8d8d8U, 0x31313131U, 0x15151515U, + 0x04040404U, 0xc7c7c7c7U, 0x23232323U, 0xc3c3c3c3U, + 0x18181818U, 0x96969696U, 0x05050505U, 0x9a9a9a9aU, + 0x07070707U, 0x12121212U, 0x80808080U, 0xe2e2e2e2U, + 0xebebebebU, 0x27272727U, 0xb2b2b2b2U, 0x75757575U, + 0x09090909U, 0x83838383U, 0x2c2c2c2cU, 0x1a1a1a1aU, + 0x1b1b1b1bU, 0x6e6e6e6eU, 0x5a5a5a5aU, 0xa0a0a0a0U, + 0x52525252U, 0x3b3b3b3bU, 0xd6d6d6d6U, 0xb3b3b3b3U, + 0x29292929U, 0xe3e3e3e3U, 0x2f2f2f2fU, 0x84848484U, + 0x53535353U, 0xd1d1d1d1U, 0x00000000U, 0xededededU, + 0x20202020U, 0xfcfcfcfcU, 0xb1b1b1b1U, 0x5b5b5b5bU, + 0x6a6a6a6aU, 0xcbcbcbcbU, 0xbebebebeU, 0x39393939U, + 0x4a4a4a4aU, 0x4c4c4c4cU, 0x58585858U, 0xcfcfcfcfU, + 0xd0d0d0d0U, 0xefefefefU, 0xaaaaaaaaU, 0xfbfbfbfbU, + 0x43434343U, 0x4d4d4d4dU, 0x33333333U, 0x85858585U, + 0x45454545U, 0xf9f9f9f9U, 0x02020202U, 0x7f7f7f7fU, + 0x50505050U, 0x3c3c3c3cU, 0x9f9f9f9fU, 0xa8a8a8a8U, + 0x51515151U, 0xa3a3a3a3U, 0x40404040U, 0x8f8f8f8fU, + 0x92929292U, 0x9d9d9d9dU, 0x38383838U, 0xf5f5f5f5U, + 0xbcbcbcbcU, 0xb6b6b6b6U, 0xdadadadaU, 0x21212121U, + 0x10101010U, 0xffffffffU, 0xf3f3f3f3U, 0xd2d2d2d2U, + 0xcdcdcdcdU, 0x0c0c0c0cU, 0x13131313U, 0xececececU, + 0x5f5f5f5fU, 0x97979797U, 0x44444444U, 0x17171717U, + 0xc4c4c4c4U, 0xa7a7a7a7U, 0x7e7e7e7eU, 0x3d3d3d3dU, + 0x64646464U, 0x5d5d5d5dU, 0x19191919U, 0x73737373U, + 0x60606060U, 0x81818181U, 0x4f4f4f4fU, 0xdcdcdcdcU, + 0x22222222U, 0x2a2a2a2aU, 0x90909090U, 0x88888888U, + 0x46464646U, 0xeeeeeeeeU, 0xb8b8b8b8U, 0x14141414U, + 0xdedededeU, 0x5e5e5e5eU, 0x0b0b0b0bU, 0xdbdbdbdbU, + 0xe0e0e0e0U, 0x32323232U, 0x3a3a3a3aU, 0x0a0a0a0aU, + 0x49494949U, 0x06060606U, 0x24242424U, 0x5c5c5c5cU, + 0xc2c2c2c2U, 0xd3d3d3d3U, 0xacacacacU, 0x62626262U, + 0x91919191U, 0x95959595U, 0xe4e4e4e4U, 0x79797979U, + 0xe7e7e7e7U, 0xc8c8c8c8U, 0x37373737U, 0x6d6d6d6dU, + 0x8d8d8d8dU, 0xd5d5d5d5U, 0x4e4e4e4eU, 0xa9a9a9a9U, + 0x6c6c6c6cU, 0x56565656U, 0xf4f4f4f4U, 0xeaeaeaeaU, + 0x65656565U, 0x7a7a7a7aU, 0xaeaeaeaeU, 0x08080808U, + 0xbabababaU, 0x78787878U, 0x25252525U, 0x2e2e2e2eU, + 0x1c1c1c1cU, 0xa6a6a6a6U, 0xb4b4b4b4U, 0xc6c6c6c6U, + 0xe8e8e8e8U, 0xddddddddU, 0x74747474U, 0x1f1f1f1fU, + 0x4b4b4b4bU, 0xbdbdbdbdU, 0x8b8b8b8bU, 0x8a8a8a8aU, + 0x70707070U, 0x3e3e3e3eU, 0xb5b5b5b5U, 0x66666666U, + 0x48484848U, 0x03030303U, 0xf6f6f6f6U, 0x0e0e0e0eU, + 0x61616161U, 0x35353535U, 0x57575757U, 0xb9b9b9b9U, + 0x86868686U, 0xc1c1c1c1U, 0x1d1d1d1dU, 0x9e9e9e9eU, + 0xe1e1e1e1U, 0xf8f8f8f8U, 0x98989898U, 0x11111111U, + 0x69696969U, 0xd9d9d9d9U, 0x8e8e8e8eU, 0x94949494U, + 0x9b9b9b9bU, 0x1e1e1e1eU, 0x87878787U, 0xe9e9e9e9U, + 0xcecececeU, 0x55555555U, 0x28282828U, 0xdfdfdfdfU, + 0x8c8c8c8cU, 0xa1a1a1a1U, 0x89898989U, 0x0d0d0d0dU, + 0xbfbfbfbfU, 0xe6e6e6e6U, 0x42424242U, 0x68686868U, + 0x41414141U, 0x99999999U, 0x2d2d2d2dU, 0x0f0f0f0fU, + 0xb0b0b0b0U, 0x54545454U, 0xbbbbbbbbU, 0x16161616U, +}; +static const u32 Td0[256] = { + 0x51f4a750U, 0x7e416553U, 0x1a17a4c3U, 0x3a275e96U, + 0x3bab6bcbU, 0x1f9d45f1U, 0xacfa58abU, 0x4be30393U, + 0x2030fa55U, 0xad766df6U, 0x88cc7691U, 0xf5024c25U, + 0x4fe5d7fcU, 0xc52acbd7U, 0x26354480U, 0xb562a38fU, + 0xdeb15a49U, 0x25ba1b67U, 0x45ea0e98U, 0x5dfec0e1U, + 0xc32f7502U, 0x814cf012U, 0x8d4697a3U, 0x6bd3f9c6U, + 0x038f5fe7U, 0x15929c95U, 0xbf6d7aebU, 0x955259daU, + 0xd4be832dU, 0x587421d3U, 0x49e06929U, 0x8ec9c844U, + 0x75c2896aU, 0xf48e7978U, 0x99583e6bU, 0x27b971ddU, + 0xbee14fb6U, 0xf088ad17U, 0xc920ac66U, 0x7dce3ab4U, + 0x63df4a18U, 0xe51a3182U, 0x97513360U, 0x62537f45U, + 0xb16477e0U, 0xbb6bae84U, 0xfe81a01cU, 0xf9082b94U, + 0x70486858U, 0x8f45fd19U, 0x94de6c87U, 0x527bf8b7U, + 0xab73d323U, 0x724b02e2U, 0xe31f8f57U, 0x6655ab2aU, + 0xb2eb2807U, 0x2fb5c203U, 0x86c57b9aU, 0xd33708a5U, + 0x302887f2U, 0x23bfa5b2U, 0x02036abaU, 0xed16825cU, + 0x8acf1c2bU, 0xa779b492U, 0xf307f2f0U, 0x4e69e2a1U, + 0x65daf4cdU, 0x0605bed5U, 0xd134621fU, 0xc4a6fe8aU, + 0x342e539dU, 0xa2f355a0U, 0x058ae132U, 0xa4f6eb75U, + 0x0b83ec39U, 0x4060efaaU, 0x5e719f06U, 0xbd6e1051U, + 0x3e218af9U, 0x96dd063dU, 0xdd3e05aeU, 0x4de6bd46U, + 0x91548db5U, 0x71c45d05U, 0x0406d46fU, 0x605015ffU, + 0x1998fb24U, 0xd6bde997U, 0x894043ccU, 0x67d99e77U, + 0xb0e842bdU, 0x07898b88U, 0xe7195b38U, 0x79c8eedbU, + 0xa17c0a47U, 0x7c420fe9U, 0xf8841ec9U, 0x00000000U, + 0x09808683U, 0x322bed48U, 0x1e1170acU, 0x6c5a724eU, + 0xfd0efffbU, 0x0f853856U, 0x3daed51eU, 0x362d3927U, + 0x0a0fd964U, 0x685ca621U, 0x9b5b54d1U, 0x24362e3aU, + 0x0c0a67b1U, 0x9357e70fU, 0xb4ee96d2U, 0x1b9b919eU, + 0x80c0c54fU, 0x61dc20a2U, 0x5a774b69U, 0x1c121a16U, + 0xe293ba0aU, 0xc0a02ae5U, 0x3c22e043U, 0x121b171dU, + 0x0e090d0bU, 0xf28bc7adU, 0x2db6a8b9U, 0x141ea9c8U, + 0x57f11985U, 0xaf75074cU, 0xee99ddbbU, 0xa37f60fdU, + 0xf701269fU, 0x5c72f5bcU, 0x44663bc5U, 0x5bfb7e34U, + 0x8b432976U, 0xcb23c6dcU, 0xb6edfc68U, 0xb8e4f163U, + 0xd731dccaU, 0x42638510U, 0x13972240U, 0x84c61120U, + 0x854a247dU, 0xd2bb3df8U, 0xaef93211U, 0xc729a16dU, + 0x1d9e2f4bU, 0xdcb230f3U, 0x0d8652ecU, 0x77c1e3d0U, + 0x2bb3166cU, 0xa970b999U, 0x119448faU, 0x47e96422U, + 0xa8fc8cc4U, 0xa0f03f1aU, 0x567d2cd8U, 0x223390efU, + 0x87494ec7U, 0xd938d1c1U, 0x8ccaa2feU, 0x98d40b36U, + 0xa6f581cfU, 0xa57ade28U, 0xdab78e26U, 0x3fadbfa4U, + 0x2c3a9de4U, 0x5078920dU, 0x6a5fcc9bU, 0x547e4662U, + 0xf68d13c2U, 0x90d8b8e8U, 0x2e39f75eU, 0x82c3aff5U, + 0x9f5d80beU, 0x69d0937cU, 0x6fd52da9U, 0xcf2512b3U, + 0xc8ac993bU, 0x10187da7U, 0xe89c636eU, 0xdb3bbb7bU, + 0xcd267809U, 0x6e5918f4U, 0xec9ab701U, 0x834f9aa8U, + 0xe6956e65U, 0xaaffe67eU, 0x21bccf08U, 0xef15e8e6U, + 0xbae79bd9U, 0x4a6f36ceU, 0xea9f09d4U, 0x29b07cd6U, + 0x31a4b2afU, 0x2a3f2331U, 0xc6a59430U, 0x35a266c0U, + 0x744ebc37U, 0xfc82caa6U, 0xe090d0b0U, 0x33a7d815U, + 0xf104984aU, 0x41ecdaf7U, 0x7fcd500eU, 0x1791f62fU, + 0x764dd68dU, 0x43efb04dU, 0xccaa4d54U, 0xe49604dfU, + 0x9ed1b5e3U, 0x4c6a881bU, 0xc12c1fb8U, 0x4665517fU, + 0x9d5eea04U, 0x018c355dU, 0xfa877473U, 0xfb0b412eU, + 0xb3671d5aU, 0x92dbd252U, 0xe9105633U, 0x6dd64713U, + 0x9ad7618cU, 0x37a10c7aU, 0x59f8148eU, 0xeb133c89U, + 0xcea927eeU, 0xb761c935U, 0xe11ce5edU, 0x7a47b13cU, + 0x9cd2df59U, 0x55f2733fU, 0x1814ce79U, 0x73c737bfU, + 0x53f7cdeaU, 0x5ffdaa5bU, 0xdf3d6f14U, 0x7844db86U, + 0xcaaff381U, 0xb968c43eU, 0x3824342cU, 0xc2a3405fU, + 0x161dc372U, 0xbce2250cU, 0x283c498bU, 0xff0d9541U, + 0x39a80171U, 0x080cb3deU, 0xd8b4e49cU, 0x6456c190U, + 0x7bcb8461U, 0xd532b670U, 0x486c5c74U, 0xd0b85742U, +}; +static const u32 Td1[256] = { + 0x5051f4a7U, 0x537e4165U, 0xc31a17a4U, 0x963a275eU, + 0xcb3bab6bU, 0xf11f9d45U, 0xabacfa58U, 0x934be303U, + 0x552030faU, 0xf6ad766dU, 0x9188cc76U, 0x25f5024cU, + 0xfc4fe5d7U, 0xd7c52acbU, 0x80263544U, 0x8fb562a3U, + 0x49deb15aU, 0x6725ba1bU, 0x9845ea0eU, 0xe15dfec0U, + 0x02c32f75U, 0x12814cf0U, 0xa38d4697U, 0xc66bd3f9U, + 0xe7038f5fU, 0x9515929cU, 0xebbf6d7aU, 0xda955259U, + 0x2dd4be83U, 0xd3587421U, 0x2949e069U, 0x448ec9c8U, + 0x6a75c289U, 0x78f48e79U, 0x6b99583eU, 0xdd27b971U, + 0xb6bee14fU, 0x17f088adU, 0x66c920acU, 0xb47dce3aU, + 0x1863df4aU, 0x82e51a31U, 0x60975133U, 0x4562537fU, + 0xe0b16477U, 0x84bb6baeU, 0x1cfe81a0U, 0x94f9082bU, + 0x58704868U, 0x198f45fdU, 0x8794de6cU, 0xb7527bf8U, + 0x23ab73d3U, 0xe2724b02U, 0x57e31f8fU, 0x2a6655abU, + 0x07b2eb28U, 0x032fb5c2U, 0x9a86c57bU, 0xa5d33708U, + 0xf2302887U, 0xb223bfa5U, 0xba02036aU, 0x5ced1682U, + 0x2b8acf1cU, 0x92a779b4U, 0xf0f307f2U, 0xa14e69e2U, + 0xcd65daf4U, 0xd50605beU, 0x1fd13462U, 0x8ac4a6feU, + 0x9d342e53U, 0xa0a2f355U, 0x32058ae1U, 0x75a4f6ebU, + 0x390b83ecU, 0xaa4060efU, 0x065e719fU, 0x51bd6e10U, + 0xf93e218aU, 0x3d96dd06U, 0xaedd3e05U, 0x464de6bdU, + 0xb591548dU, 0x0571c45dU, 0x6f0406d4U, 0xff605015U, + 0x241998fbU, 0x97d6bde9U, 0xcc894043U, 0x7767d99eU, + 0xbdb0e842U, 0x8807898bU, 0x38e7195bU, 0xdb79c8eeU, + 0x47a17c0aU, 0xe97c420fU, 0xc9f8841eU, 0x00000000U, + 0x83098086U, 0x48322bedU, 0xac1e1170U, 0x4e6c5a72U, + 0xfbfd0effU, 0x560f8538U, 0x1e3daed5U, 0x27362d39U, + 0x640a0fd9U, 0x21685ca6U, 0xd19b5b54U, 0x3a24362eU, + 0xb10c0a67U, 0x0f9357e7U, 0xd2b4ee96U, 0x9e1b9b91U, + 0x4f80c0c5U, 0xa261dc20U, 0x695a774bU, 0x161c121aU, + 0x0ae293baU, 0xe5c0a02aU, 0x433c22e0U, 0x1d121b17U, + 0x0b0e090dU, 0xadf28bc7U, 0xb92db6a8U, 0xc8141ea9U, + 0x8557f119U, 0x4caf7507U, 0xbbee99ddU, 0xfda37f60U, + 0x9ff70126U, 0xbc5c72f5U, 0xc544663bU, 0x345bfb7eU, + 0x768b4329U, 0xdccb23c6U, 0x68b6edfcU, 0x63b8e4f1U, + 0xcad731dcU, 0x10426385U, 0x40139722U, 0x2084c611U, + 0x7d854a24U, 0xf8d2bb3dU, 0x11aef932U, 0x6dc729a1U, + 0x4b1d9e2fU, 0xf3dcb230U, 0xec0d8652U, 0xd077c1e3U, + 0x6c2bb316U, 0x99a970b9U, 0xfa119448U, 0x2247e964U, + 0xc4a8fc8cU, 0x1aa0f03fU, 0xd8567d2cU, 0xef223390U, + 0xc787494eU, 0xc1d938d1U, 0xfe8ccaa2U, 0x3698d40bU, + 0xcfa6f581U, 0x28a57adeU, 0x26dab78eU, 0xa43fadbfU, + 0xe42c3a9dU, 0x0d507892U, 0x9b6a5fccU, 0x62547e46U, + 0xc2f68d13U, 0xe890d8b8U, 0x5e2e39f7U, 0xf582c3afU, + 0xbe9f5d80U, 0x7c69d093U, 0xa96fd52dU, 0xb3cf2512U, + 0x3bc8ac99U, 0xa710187dU, 0x6ee89c63U, 0x7bdb3bbbU, + 0x09cd2678U, 0xf46e5918U, 0x01ec9ab7U, 0xa8834f9aU, + 0x65e6956eU, 0x7eaaffe6U, 0x0821bccfU, 0xe6ef15e8U, + 0xd9bae79bU, 0xce4a6f36U, 0xd4ea9f09U, 0xd629b07cU, + 0xaf31a4b2U, 0x312a3f23U, 0x30c6a594U, 0xc035a266U, + 0x37744ebcU, 0xa6fc82caU, 0xb0e090d0U, 0x1533a7d8U, + 0x4af10498U, 0xf741ecdaU, 0x0e7fcd50U, 0x2f1791f6U, + 0x8d764dd6U, 0x4d43efb0U, 0x54ccaa4dU, 0xdfe49604U, + 0xe39ed1b5U, 0x1b4c6a88U, 0xb8c12c1fU, 0x7f466551U, + 0x049d5eeaU, 0x5d018c35U, 0x73fa8774U, 0x2efb0b41U, + 0x5ab3671dU, 0x5292dbd2U, 0x33e91056U, 0x136dd647U, + 0x8c9ad761U, 0x7a37a10cU, 0x8e59f814U, 0x89eb133cU, + 0xeecea927U, 0x35b761c9U, 0xede11ce5U, 0x3c7a47b1U, + 0x599cd2dfU, 0x3f55f273U, 0x791814ceU, 0xbf73c737U, + 0xea53f7cdU, 0x5b5ffdaaU, 0x14df3d6fU, 0x867844dbU, + 0x81caaff3U, 0x3eb968c4U, 0x2c382434U, 0x5fc2a340U, + 0x72161dc3U, 0x0cbce225U, 0x8b283c49U, 0x41ff0d95U, + 0x7139a801U, 0xde080cb3U, 0x9cd8b4e4U, 0x906456c1U, + 0x617bcb84U, 0x70d532b6U, 0x74486c5cU, 0x42d0b857U, +}; +static const u32 Td2[256] = { + 0xa75051f4U, 0x65537e41U, 0xa4c31a17U, 0x5e963a27U, + 0x6bcb3babU, 0x45f11f9dU, 0x58abacfaU, 0x03934be3U, + 0xfa552030U, 0x6df6ad76U, 0x769188ccU, 0x4c25f502U, + 0xd7fc4fe5U, 0xcbd7c52aU, 0x44802635U, 0xa38fb562U, + 0x5a49deb1U, 0x1b6725baU, 0x0e9845eaU, 0xc0e15dfeU, + 0x7502c32fU, 0xf012814cU, 0x97a38d46U, 0xf9c66bd3U, + 0x5fe7038fU, 0x9c951592U, 0x7aebbf6dU, 0x59da9552U, + 0x832dd4beU, 0x21d35874U, 0x692949e0U, 0xc8448ec9U, + 0x896a75c2U, 0x7978f48eU, 0x3e6b9958U, 0x71dd27b9U, + 0x4fb6bee1U, 0xad17f088U, 0xac66c920U, 0x3ab47dceU, + 0x4a1863dfU, 0x3182e51aU, 0x33609751U, 0x7f456253U, + 0x77e0b164U, 0xae84bb6bU, 0xa01cfe81U, 0x2b94f908U, + 0x68587048U, 0xfd198f45U, 0x6c8794deU, 0xf8b7527bU, + 0xd323ab73U, 0x02e2724bU, 0x8f57e31fU, 0xab2a6655U, + 0x2807b2ebU, 0xc2032fb5U, 0x7b9a86c5U, 0x08a5d337U, + 0x87f23028U, 0xa5b223bfU, 0x6aba0203U, 0x825ced16U, + 0x1c2b8acfU, 0xb492a779U, 0xf2f0f307U, 0xe2a14e69U, + 0xf4cd65daU, 0xbed50605U, 0x621fd134U, 0xfe8ac4a6U, + 0x539d342eU, 0x55a0a2f3U, 0xe132058aU, 0xeb75a4f6U, + 0xec390b83U, 0xefaa4060U, 0x9f065e71U, 0x1051bd6eU, + + 0x8af93e21U, 0x063d96ddU, 0x05aedd3eU, 0xbd464de6U, + 0x8db59154U, 0x5d0571c4U, 0xd46f0406U, 0x15ff6050U, + 0xfb241998U, 0xe997d6bdU, 0x43cc8940U, 0x9e7767d9U, + 0x42bdb0e8U, 0x8b880789U, 0x5b38e719U, 0xeedb79c8U, + 0x0a47a17cU, 0x0fe97c42U, 0x1ec9f884U, 0x00000000U, + 0x86830980U, 0xed48322bU, 0x70ac1e11U, 0x724e6c5aU, + 0xfffbfd0eU, 0x38560f85U, 0xd51e3daeU, 0x3927362dU, + 0xd9640a0fU, 0xa621685cU, 0x54d19b5bU, 0x2e3a2436U, + 0x67b10c0aU, 0xe70f9357U, 0x96d2b4eeU, 0x919e1b9bU, + 0xc54f80c0U, 0x20a261dcU, 0x4b695a77U, 0x1a161c12U, + 0xba0ae293U, 0x2ae5c0a0U, 0xe0433c22U, 0x171d121bU, + 0x0d0b0e09U, 0xc7adf28bU, 0xa8b92db6U, 0xa9c8141eU, + 0x198557f1U, 0x074caf75U, 0xddbbee99U, 0x60fda37fU, + 0x269ff701U, 0xf5bc5c72U, 0x3bc54466U, 0x7e345bfbU, + 0x29768b43U, 0xc6dccb23U, 0xfc68b6edU, 0xf163b8e4U, + 0xdccad731U, 0x85104263U, 0x22401397U, 0x112084c6U, + 0x247d854aU, 0x3df8d2bbU, 0x3211aef9U, 0xa16dc729U, + 0x2f4b1d9eU, 0x30f3dcb2U, 0x52ec0d86U, 0xe3d077c1U, + 0x166c2bb3U, 0xb999a970U, 0x48fa1194U, 0x642247e9U, + 0x8cc4a8fcU, 0x3f1aa0f0U, 0x2cd8567dU, 0x90ef2233U, + 0x4ec78749U, 0xd1c1d938U, 0xa2fe8ccaU, 0x0b3698d4U, + 0x81cfa6f5U, 0xde28a57aU, 0x8e26dab7U, 0xbfa43fadU, + 0x9de42c3aU, 0x920d5078U, 0xcc9b6a5fU, 0x4662547eU, + 0x13c2f68dU, 0xb8e890d8U, 0xf75e2e39U, 0xaff582c3U, + 0x80be9f5dU, 0x937c69d0U, 0x2da96fd5U, 0x12b3cf25U, + 0x993bc8acU, 0x7da71018U, 0x636ee89cU, 0xbb7bdb3bU, + 0x7809cd26U, 0x18f46e59U, 0xb701ec9aU, 0x9aa8834fU, + 0x6e65e695U, 0xe67eaaffU, 0xcf0821bcU, 0xe8e6ef15U, + 0x9bd9bae7U, 0x36ce4a6fU, 0x09d4ea9fU, 0x7cd629b0U, + 0xb2af31a4U, 0x23312a3fU, 0x9430c6a5U, 0x66c035a2U, + 0xbc37744eU, 0xcaa6fc82U, 0xd0b0e090U, 0xd81533a7U, + 0x984af104U, 0xdaf741ecU, 0x500e7fcdU, 0xf62f1791U, + 0xd68d764dU, 0xb04d43efU, 0x4d54ccaaU, 0x04dfe496U, + 0xb5e39ed1U, 0x881b4c6aU, 0x1fb8c12cU, 0x517f4665U, + 0xea049d5eU, 0x355d018cU, 0x7473fa87U, 0x412efb0bU, + 0x1d5ab367U, 0xd25292dbU, 0x5633e910U, 0x47136dd6U, + 0x618c9ad7U, 0x0c7a37a1U, 0x148e59f8U, 0x3c89eb13U, + 0x27eecea9U, 0xc935b761U, 0xe5ede11cU, 0xb13c7a47U, + 0xdf599cd2U, 0x733f55f2U, 0xce791814U, 0x37bf73c7U, + 0xcdea53f7U, 0xaa5b5ffdU, 0x6f14df3dU, 0xdb867844U, + 0xf381caafU, 0xc43eb968U, 0x342c3824U, 0x405fc2a3U, + 0xc372161dU, 0x250cbce2U, 0x498b283cU, 0x9541ff0dU, + 0x017139a8U, 0xb3de080cU, 0xe49cd8b4U, 0xc1906456U, + 0x84617bcbU, 0xb670d532U, 0x5c74486cU, 0x5742d0b8U, +}; +static const u32 Td3[256] = { + 0xf4a75051U, 0x4165537eU, 0x17a4c31aU, 0x275e963aU, + 0xab6bcb3bU, 0x9d45f11fU, 0xfa58abacU, 0xe303934bU, + 0x30fa5520U, 0x766df6adU, 0xcc769188U, 0x024c25f5U, + 0xe5d7fc4fU, 0x2acbd7c5U, 0x35448026U, 0x62a38fb5U, + 0xb15a49deU, 0xba1b6725U, 0xea0e9845U, 0xfec0e15dU, + 0x2f7502c3U, 0x4cf01281U, 0x4697a38dU, 0xd3f9c66bU, + 0x8f5fe703U, 0x929c9515U, 0x6d7aebbfU, 0x5259da95U, + 0xbe832dd4U, 0x7421d358U, 0xe0692949U, 0xc9c8448eU, + 0xc2896a75U, 0x8e7978f4U, 0x583e6b99U, 0xb971dd27U, + 0xe14fb6beU, 0x88ad17f0U, 0x20ac66c9U, 0xce3ab47dU, + 0xdf4a1863U, 0x1a3182e5U, 0x51336097U, 0x537f4562U, + 0x6477e0b1U, 0x6bae84bbU, 0x81a01cfeU, 0x082b94f9U, + 0x48685870U, 0x45fd198fU, 0xde6c8794U, 0x7bf8b752U, + 0x73d323abU, 0x4b02e272U, 0x1f8f57e3U, 0x55ab2a66U, + 0xeb2807b2U, 0xb5c2032fU, 0xc57b9a86U, 0x3708a5d3U, + 0x2887f230U, 0xbfa5b223U, 0x036aba02U, 0x16825cedU, + 0xcf1c2b8aU, 0x79b492a7U, 0x07f2f0f3U, 0x69e2a14eU, + 0xdaf4cd65U, 0x05bed506U, 0x34621fd1U, 0xa6fe8ac4U, + 0x2e539d34U, 0xf355a0a2U, 0x8ae13205U, 0xf6eb75a4U, + 0x83ec390bU, 0x60efaa40U, 0x719f065eU, 0x6e1051bdU, + 0x218af93eU, 0xdd063d96U, 0x3e05aeddU, 0xe6bd464dU, + 0x548db591U, 0xc45d0571U, 0x06d46f04U, 0x5015ff60U, + 0x98fb2419U, 0xbde997d6U, 0x4043cc89U, 0xd99e7767U, + 0xe842bdb0U, 0x898b8807U, 0x195b38e7U, 0xc8eedb79U, + 0x7c0a47a1U, 0x420fe97cU, 0x841ec9f8U, 0x00000000U, + 0x80868309U, 0x2bed4832U, 0x1170ac1eU, 0x5a724e6cU, + 0x0efffbfdU, 0x8538560fU, 0xaed51e3dU, 0x2d392736U, + 0x0fd9640aU, 0x5ca62168U, 0x5b54d19bU, 0x362e3a24U, + 0x0a67b10cU, 0x57e70f93U, 0xee96d2b4U, 0x9b919e1bU, + 0xc0c54f80U, 0xdc20a261U, 0x774b695aU, 0x121a161cU, + 0x93ba0ae2U, 0xa02ae5c0U, 0x22e0433cU, 0x1b171d12U, + 0x090d0b0eU, 0x8bc7adf2U, 0xb6a8b92dU, 0x1ea9c814U, + 0xf1198557U, 0x75074cafU, 0x99ddbbeeU, 0x7f60fda3U, + 0x01269ff7U, 0x72f5bc5cU, 0x663bc544U, 0xfb7e345bU, + 0x4329768bU, 0x23c6dccbU, 0xedfc68b6U, 0xe4f163b8U, + 0x31dccad7U, 0x63851042U, 0x97224013U, 0xc6112084U, + 0x4a247d85U, 0xbb3df8d2U, 0xf93211aeU, 0x29a16dc7U, + 0x9e2f4b1dU, 0xb230f3dcU, 0x8652ec0dU, 0xc1e3d077U, + 0xb3166c2bU, 0x70b999a9U, 0x9448fa11U, 0xe9642247U, + 0xfc8cc4a8U, 0xf03f1aa0U, 0x7d2cd856U, 0x3390ef22U, + 0x494ec787U, 0x38d1c1d9U, 0xcaa2fe8cU, 0xd40b3698U, + 0xf581cfa6U, 0x7ade28a5U, 0xb78e26daU, 0xadbfa43fU, + 0x3a9de42cU, 0x78920d50U, 0x5fcc9b6aU, 0x7e466254U, + 0x8d13c2f6U, 0xd8b8e890U, 0x39f75e2eU, 0xc3aff582U, + 0x5d80be9fU, 0xd0937c69U, 0xd52da96fU, 0x2512b3cfU, + 0xac993bc8U, 0x187da710U, 0x9c636ee8U, 0x3bbb7bdbU, + 0x267809cdU, 0x5918f46eU, 0x9ab701ecU, 0x4f9aa883U, + 0x956e65e6U, 0xffe67eaaU, 0xbccf0821U, 0x15e8e6efU, + 0xe79bd9baU, 0x6f36ce4aU, 0x9f09d4eaU, 0xb07cd629U, + 0xa4b2af31U, 0x3f23312aU, 0xa59430c6U, 0xa266c035U, + 0x4ebc3774U, 0x82caa6fcU, 0x90d0b0e0U, 0xa7d81533U, + 0x04984af1U, 0xecdaf741U, 0xcd500e7fU, 0x91f62f17U, + 0x4dd68d76U, 0xefb04d43U, 0xaa4d54ccU, 0x9604dfe4U, + 0xd1b5e39eU, 0x6a881b4cU, 0x2c1fb8c1U, 0x65517f46U, + 0x5eea049dU, 0x8c355d01U, 0x877473faU, 0x0b412efbU, + 0x671d5ab3U, 0xdbd25292U, 0x105633e9U, 0xd647136dU, + 0xd7618c9aU, 0xa10c7a37U, 0xf8148e59U, 0x133c89ebU, + 0xa927eeceU, 0x61c935b7U, 0x1ce5ede1U, 0x47b13c7aU, + 0xd2df599cU, 0xf2733f55U, 0x14ce7918U, 0xc737bf73U, + 0xf7cdea53U, 0xfdaa5b5fU, 0x3d6f14dfU, 0x44db8678U, + 0xaff381caU, 0x68c43eb9U, 0x24342c38U, 0xa3405fc2U, + 0x1dc37216U, 0xe2250cbcU, 0x3c498b28U, 0x0d9541ffU, + 0xa8017139U, 0x0cb3de08U, 0xb4e49cd8U, 0x56c19064U, + 0xcb84617bU, 0x32b670d5U, 0x6c5c7448U, 0xb85742d0U, +}; +static const u32 Td4[256] = { + 0x52525252U, 0x09090909U, 0x6a6a6a6aU, 0xd5d5d5d5U, + 0x30303030U, 0x36363636U, 0xa5a5a5a5U, 0x38383838U, + 0xbfbfbfbfU, 0x40404040U, 0xa3a3a3a3U, 0x9e9e9e9eU, + 0x81818181U, 0xf3f3f3f3U, 0xd7d7d7d7U, 0xfbfbfbfbU, + 0x7c7c7c7cU, 0xe3e3e3e3U, 0x39393939U, 0x82828282U, + 0x9b9b9b9bU, 0x2f2f2f2fU, 0xffffffffU, 0x87878787U, + 0x34343434U, 0x8e8e8e8eU, 0x43434343U, 0x44444444U, + 0xc4c4c4c4U, 0xdedededeU, 0xe9e9e9e9U, 0xcbcbcbcbU, + 0x54545454U, 0x7b7b7b7bU, 0x94949494U, 0x32323232U, + 0xa6a6a6a6U, 0xc2c2c2c2U, 0x23232323U, 0x3d3d3d3dU, + 0xeeeeeeeeU, 0x4c4c4c4cU, 0x95959595U, 0x0b0b0b0bU, + 0x42424242U, 0xfafafafaU, 0xc3c3c3c3U, 0x4e4e4e4eU, + 0x08080808U, 0x2e2e2e2eU, 0xa1a1a1a1U, 0x66666666U, + 0x28282828U, 0xd9d9d9d9U, 0x24242424U, 0xb2b2b2b2U, + 0x76767676U, 0x5b5b5b5bU, 0xa2a2a2a2U, 0x49494949U, + 0x6d6d6d6dU, 0x8b8b8b8bU, 0xd1d1d1d1U, 0x25252525U, + 0x72727272U, 0xf8f8f8f8U, 0xf6f6f6f6U, 0x64646464U, + 0x86868686U, 0x68686868U, 0x98989898U, 0x16161616U, + 0xd4d4d4d4U, 0xa4a4a4a4U, 0x5c5c5c5cU, 0xccccccccU, + 0x5d5d5d5dU, 0x65656565U, 0xb6b6b6b6U, 0x92929292U, + 0x6c6c6c6cU, 0x70707070U, 0x48484848U, 0x50505050U, + 0xfdfdfdfdU, 0xededededU, 0xb9b9b9b9U, 0xdadadadaU, + 0x5e5e5e5eU, 0x15151515U, 0x46464646U, 0x57575757U, + 0xa7a7a7a7U, 0x8d8d8d8dU, 0x9d9d9d9dU, 0x84848484U, + 0x90909090U, 0xd8d8d8d8U, 0xababababU, 0x00000000U, + 0x8c8c8c8cU, 0xbcbcbcbcU, 0xd3d3d3d3U, 0x0a0a0a0aU, + 0xf7f7f7f7U, 0xe4e4e4e4U, 0x58585858U, 0x05050505U, + 0xb8b8b8b8U, 0xb3b3b3b3U, 0x45454545U, 0x06060606U, + 0xd0d0d0d0U, 0x2c2c2c2cU, 0x1e1e1e1eU, 0x8f8f8f8fU, + 0xcacacacaU, 0x3f3f3f3fU, 0x0f0f0f0fU, 0x02020202U, + 0xc1c1c1c1U, 0xafafafafU, 0xbdbdbdbdU, 0x03030303U, + 0x01010101U, 0x13131313U, 0x8a8a8a8aU, 0x6b6b6b6bU, + 0x3a3a3a3aU, 0x91919191U, 0x11111111U, 0x41414141U, + 0x4f4f4f4fU, 0x67676767U, 0xdcdcdcdcU, 0xeaeaeaeaU, + 0x97979797U, 0xf2f2f2f2U, 0xcfcfcfcfU, 0xcecececeU, + 0xf0f0f0f0U, 0xb4b4b4b4U, 0xe6e6e6e6U, 0x73737373U, + 0x96969696U, 0xacacacacU, 0x74747474U, 0x22222222U, + 0xe7e7e7e7U, 0xadadadadU, 0x35353535U, 0x85858585U, + 0xe2e2e2e2U, 0xf9f9f9f9U, 0x37373737U, 0xe8e8e8e8U, + 0x1c1c1c1cU, 0x75757575U, 0xdfdfdfdfU, 0x6e6e6e6eU, + 0x47474747U, 0xf1f1f1f1U, 0x1a1a1a1aU, 0x71717171U, + 0x1d1d1d1dU, 0x29292929U, 0xc5c5c5c5U, 0x89898989U, + 0x6f6f6f6fU, 0xb7b7b7b7U, 0x62626262U, 0x0e0e0e0eU, + 0xaaaaaaaaU, 0x18181818U, 0xbebebebeU, 0x1b1b1b1bU, + 0xfcfcfcfcU, 0x56565656U, 0x3e3e3e3eU, 0x4b4b4b4bU, + 0xc6c6c6c6U, 0xd2d2d2d2U, 0x79797979U, 0x20202020U, + 0x9a9a9a9aU, 0xdbdbdbdbU, 0xc0c0c0c0U, 0xfefefefeU, + 0x78787878U, 0xcdcdcdcdU, 0x5a5a5a5aU, 0xf4f4f4f4U, + 0x1f1f1f1fU, 0xddddddddU, 0xa8a8a8a8U, 0x33333333U, + 0x88888888U, 0x07070707U, 0xc7c7c7c7U, 0x31313131U, + 0xb1b1b1b1U, 0x12121212U, 0x10101010U, 0x59595959U, + 0x27272727U, 0x80808080U, 0xececececU, 0x5f5f5f5fU, + 0x60606060U, 0x51515151U, 0x7f7f7f7fU, 0xa9a9a9a9U, + 0x19191919U, 0xb5b5b5b5U, 0x4a4a4a4aU, 0x0d0d0d0dU, + 0x2d2d2d2dU, 0xe5e5e5e5U, 0x7a7a7a7aU, 0x9f9f9f9fU, + 0x93939393U, 0xc9c9c9c9U, 0x9c9c9c9cU, 0xefefefefU, + 0xa0a0a0a0U, 0xe0e0e0e0U, 0x3b3b3b3bU, 0x4d4d4d4dU, + 0xaeaeaeaeU, 0x2a2a2a2aU, 0xf5f5f5f5U, 0xb0b0b0b0U, + 0xc8c8c8c8U, 0xebebebebU, 0xbbbbbbbbU, 0x3c3c3c3cU, + 0x83838383U, 0x53535353U, 0x99999999U, 0x61616161U, + 0x17171717U, 0x2b2b2b2bU, 0x04040404U, 0x7e7e7e7eU, + 0xbabababaU, 0x77777777U, 0xd6d6d6d6U, 0x26262626U, + 0xe1e1e1e1U, 0x69696969U, 0x14141414U, 0x63636363U, + 0x55555555U, 0x21212121U, 0x0c0c0c0cU, 0x7d7d7d7dU, +}; +static const u32 rcon[] = { + 0x01000000, 0x02000000, 0x04000000, 0x08000000, + 0x10000000, 0x20000000, 0x40000000, 0x80000000, + 0x1B000000, 0x36000000, /* for 128-bit blocks, Rijndael never uses more than 10 rcon values */ +}; + +#define SWAP(x) (_lrotl(x, 8) & 0x00ff00ff | _lrotr(x, 8) & 0xff00ff00) + +#ifdef _MSC_VER +#define GETU32(p) SWAP(*((u32 *)(p))) +#define PUTU32(ct, st) { *((u32 *)(ct)) = SWAP((st)); } +#else +#define GETU32(pt) (((u32)(pt)[0] << 24) ^ ((u32)(pt)[1] << 16) ^ ((u32)(pt)[2] << 8) ^ ((u32)(pt)[3])) +#define PUTU32(ct, st) { (ct)[0] = (u8)((st) >> 24); (ct)[1] = (u8)((st) >> 16); (ct)[2] = (u8)((st) >> 8); (ct)[3] = (u8)(st); } +#endif + +/** + * Expand the cipher key into the encryption key schedule. + * + * @return the number of rounds for the given cipher key size. + */ +int rijndaelKeySetupEnc(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits) { + int i = 0; + u32 temp; + + rk[0] = GETU32(cipherKey ); + rk[1] = GETU32(cipherKey + 4); + rk[2] = GETU32(cipherKey + 8); + rk[3] = GETU32(cipherKey + 12); + if (keyBits == 128) { + for (;;) { + temp = rk[3]; + rk[4] = rk[0] ^ + (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ + (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ + (Te4[(temp ) & 0xff] & 0x0000ff00) ^ + (Te4[(temp >> 24) ] & 0x000000ff) ^ + rcon[i]; + rk[5] = rk[1] ^ rk[4]; + rk[6] = rk[2] ^ rk[5]; + rk[7] = rk[3] ^ rk[6]; + if (++i == 10) { + return 10; + } + rk += 4; + } + } + rk[4] = GETU32(cipherKey + 16); + rk[5] = GETU32(cipherKey + 20); + if (keyBits == 192) { + for (;;) { + temp = rk[ 5]; + rk[ 6] = rk[ 0] ^ + (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ + (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ + (Te4[(temp ) & 0xff] & 0x0000ff00) ^ + (Te4[(temp >> 24) ] & 0x000000ff) ^ + rcon[i]; + rk[ 7] = rk[ 1] ^ rk[ 6]; + rk[ 8] = rk[ 2] ^ rk[ 7]; + rk[ 9] = rk[ 3] ^ rk[ 8]; + if (++i == 8) { + return 12; + } + rk[10] = rk[ 4] ^ rk[ 9]; + rk[11] = rk[ 5] ^ rk[10]; + rk += 6; + } + } + rk[6] = GETU32(cipherKey + 24); + rk[7] = GETU32(cipherKey + 28); + if (keyBits == 256) { + for (;;) { + temp = rk[ 7]; + rk[ 8] = rk[ 0] ^ + (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ + (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ + (Te4[(temp ) & 0xff] & 0x0000ff00) ^ + (Te4[(temp >> 24) ] & 0x000000ff) ^ + rcon[i]; + rk[ 9] = rk[ 1] ^ rk[ 8]; + rk[10] = rk[ 2] ^ rk[ 9]; + rk[11] = rk[ 3] ^ rk[10]; + if (++i == 7) { + return 14; + } + temp = rk[11]; + rk[12] = rk[ 4] ^ + (Te4[(temp >> 24) ] & 0xff000000) ^ + (Te4[(temp >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(temp >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(temp ) & 0xff] & 0x000000ff); + rk[13] = rk[ 5] ^ rk[12]; + rk[14] = rk[ 6] ^ rk[13]; + rk[15] = rk[ 7] ^ rk[14]; + + rk += 8; + } + } + return 0; +} + +/** + * Expand the cipher key into the decryption key schedule. + * + * @return the number of rounds for the given cipher key size. + */ +int rijndaelKeySetupDec(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits) { + int Nr, i, j; + u32 temp; + + /* expand the cipher key: */ + Nr = rijndaelKeySetupEnc(rk, cipherKey, keyBits); + /* invert the order of the round keys: */ + for (i = 0, j = 4*Nr; i < j; i += 4, j -= 4) { + temp = rk[i ]; rk[i ] = rk[j ]; rk[j ] = temp; + temp = rk[i + 1]; rk[i + 1] = rk[j + 1]; rk[j + 1] = temp; + temp = rk[i + 2]; rk[i + 2] = rk[j + 2]; rk[j + 2] = temp; + temp = rk[i + 3]; rk[i + 3] = rk[j + 3]; rk[j + 3] = temp; + } + /* apply the inverse MixColumn transform to all round keys but the first and the last: */ + for (i = 1; i < Nr; i++) { + rk += 4; + rk[0] = + Td0[Te4[(rk[0] >> 24) ] & 0xff] ^ + Td1[Te4[(rk[0] >> 16) & 0xff] & 0xff] ^ + Td2[Te4[(rk[0] >> 8) & 0xff] & 0xff] ^ + Td3[Te4[(rk[0] ) & 0xff] & 0xff]; + rk[1] = + Td0[Te4[(rk[1] >> 24) ] & 0xff] ^ + Td1[Te4[(rk[1] >> 16) & 0xff] & 0xff] ^ + Td2[Te4[(rk[1] >> 8) & 0xff] & 0xff] ^ + Td3[Te4[(rk[1] ) & 0xff] & 0xff]; + rk[2] = + Td0[Te4[(rk[2] >> 24) ] & 0xff] ^ + Td1[Te4[(rk[2] >> 16) & 0xff] & 0xff] ^ + Td2[Te4[(rk[2] >> 8) & 0xff] & 0xff] ^ + Td3[Te4[(rk[2] ) & 0xff] & 0xff]; + rk[3] = + Td0[Te4[(rk[3] >> 24) ] & 0xff] ^ + Td1[Te4[(rk[3] >> 16) & 0xff] & 0xff] ^ + Td2[Te4[(rk[3] >> 8) & 0xff] & 0xff] ^ + Td3[Te4[(rk[3] ) & 0xff] & 0xff]; + } + return Nr; +} + +void rijndaelEncrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 pt[16], u8 ct[16]) { + u32 s0, s1, s2, s3, t0, t1, t2, t3; +#ifndef FULL_UNROLL + int r; +#endif /* ?FULL_UNROLL */ + + /* + * map byte array block to cipher state + * and add initial round key: + */ + s0 = GETU32(pt ) ^ rk[0]; + s1 = GETU32(pt + 4) ^ rk[1]; + s2 = GETU32(pt + 8) ^ rk[2]; + s3 = GETU32(pt + 12) ^ rk[3]; +#ifdef FULL_UNROLL + /* round 1: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[ 4]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[ 5]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[ 6]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[ 7]; + /* round 2: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[ 8]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[ 9]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[10]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[11]; + /* round 3: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[12]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[13]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[14]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[15]; + /* round 4: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[16]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[17]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[18]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[19]; + /* round 5: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[20]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[21]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[22]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[23]; + /* round 6: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[24]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[25]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[26]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[27]; + /* round 7: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[28]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[29]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[30]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[31]; + /* round 8: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[32]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[33]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[34]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[35]; + /* round 9: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[36]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[37]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[38]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[39]; + if (Nr > 10) { + /* round 10: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[40]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[41]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[42]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[43]; + /* round 11: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[44]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[45]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[46]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[47]; + if (Nr > 12) { + /* round 12: */ + s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[48]; + s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[49]; + s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[50]; + s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[51]; + /* round 13: */ + t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[52]; + t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[53]; + t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[54]; + t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[55]; + } + } + rk += Nr << 2; +#else /* !FULL_UNROLL */ + /* + * Nr - 1 full rounds: + */ + r = Nr >> 1; + for (;;) { + t0 = + Te0[(s0 >> 24) ] ^ + Te1[(s1 >> 16) & 0xff] ^ + Te2[(s2 >> 8) & 0xff] ^ + Te3[(s3 ) & 0xff] ^ + rk[4]; + t1 = + Te0[(s1 >> 24) ] ^ + Te1[(s2 >> 16) & 0xff] ^ + Te2[(s3 >> 8) & 0xff] ^ + Te3[(s0 ) & 0xff] ^ + rk[5]; + t2 = + Te0[(s2 >> 24) ] ^ + Te1[(s3 >> 16) & 0xff] ^ + Te2[(s0 >> 8) & 0xff] ^ + Te3[(s1 ) & 0xff] ^ + rk[6]; + t3 = + Te0[(s3 >> 24) ] ^ + Te1[(s0 >> 16) & 0xff] ^ + Te2[(s1 >> 8) & 0xff] ^ + Te3[(s2 ) & 0xff] ^ + rk[7]; + + rk += 8; + if (--r == 0) { + break; + } + + s0 = + Te0[(t0 >> 24) ] ^ + Te1[(t1 >> 16) & 0xff] ^ + Te2[(t2 >> 8) & 0xff] ^ + Te3[(t3 ) & 0xff] ^ + rk[0]; + s1 = + Te0[(t1 >> 24) ] ^ + Te1[(t2 >> 16) & 0xff] ^ + Te2[(t3 >> 8) & 0xff] ^ + Te3[(t0 ) & 0xff] ^ + rk[1]; + s2 = + Te0[(t2 >> 24) ] ^ + Te1[(t3 >> 16) & 0xff] ^ + Te2[(t0 >> 8) & 0xff] ^ + Te3[(t1 ) & 0xff] ^ + rk[2]; + s3 = + Te0[(t3 >> 24) ] ^ + Te1[(t0 >> 16) & 0xff] ^ + Te2[(t1 >> 8) & 0xff] ^ + Te3[(t2 ) & 0xff] ^ + rk[3]; + } +#endif /* ?FULL_UNROLL */ + /* + * apply last round and + * map cipher state to byte array block: + */ + s0 = + (Te4[(t0 >> 24) ] & 0xff000000) ^ + (Te4[(t1 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(t2 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(t3 ) & 0xff] & 0x000000ff) ^ + rk[0]; + PUTU32(ct , s0); + s1 = + (Te4[(t1 >> 24) ] & 0xff000000) ^ + (Te4[(t2 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(t3 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(t0 ) & 0xff] & 0x000000ff) ^ + rk[1]; + PUTU32(ct + 4, s1); + s2 = + (Te4[(t2 >> 24) ] & 0xff000000) ^ + (Te4[(t3 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(t0 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(t1 ) & 0xff] & 0x000000ff) ^ + rk[2]; + PUTU32(ct + 8, s2); + s3 = + (Te4[(t3 >> 24) ] & 0xff000000) ^ + (Te4[(t0 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(t1 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(t2 ) & 0xff] & 0x000000ff) ^ + rk[3]; + PUTU32(ct + 12, s3); +} + +void rijndaelDecrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 ct[16], u8 pt[16]) { + u32 s0, s1, s2, s3, t0, t1, t2, t3; +#ifndef FULL_UNROLL + int r; +#endif /* ?FULL_UNROLL */ + + /* + * map byte array block to cipher state + * and add initial round key: + */ + s0 = GETU32(ct ) ^ rk[0]; + s1 = GETU32(ct + 4) ^ rk[1]; + s2 = GETU32(ct + 8) ^ rk[2]; + s3 = GETU32(ct + 12) ^ rk[3]; +#ifdef FULL_UNROLL + /* round 1: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[ 4]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[ 5]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[ 6]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[ 7]; + /* round 2: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[ 8]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[ 9]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[10]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[11]; + /* round 3: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[12]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[13]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[14]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[15]; + /* round 4: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[16]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[17]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[18]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[19]; + /* round 5: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[20]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[21]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[22]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[23]; + /* round 6: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[24]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[25]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[26]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[27]; + /* round 7: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[28]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[29]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[30]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[31]; + /* round 8: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[32]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[33]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[34]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[35]; + /* round 9: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[36]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[37]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[38]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[39]; + if (Nr > 10) { + /* round 10: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[40]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[41]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[42]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[43]; + /* round 11: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[44]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[45]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[46]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[47]; + if (Nr > 12) { + /* round 12: */ + s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[48]; + s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[49]; + s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[50]; + s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[51]; + /* round 13: */ + t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[52]; + t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[53]; + t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[54]; + t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[55]; + } + } + rk += Nr << 2; +#else /* !FULL_UNROLL */ + /* + * Nr - 1 full rounds: + */ + r = Nr >> 1; + for (;;) { + t0 = + Td0[(s0 >> 24) ] ^ + Td1[(s3 >> 16) & 0xff] ^ + Td2[(s2 >> 8) & 0xff] ^ + Td3[(s1 ) & 0xff] ^ + rk[4]; + t1 = + Td0[(s1 >> 24) ] ^ + Td1[(s0 >> 16) & 0xff] ^ + Td2[(s3 >> 8) & 0xff] ^ + Td3[(s2 ) & 0xff] ^ + rk[5]; + t2 = + Td0[(s2 >> 24) ] ^ + Td1[(s1 >> 16) & 0xff] ^ + Td2[(s0 >> 8) & 0xff] ^ + Td3[(s3 ) & 0xff] ^ + rk[6]; + t3 = + Td0[(s3 >> 24) ] ^ + Td1[(s2 >> 16) & 0xff] ^ + Td2[(s1 >> 8) & 0xff] ^ + Td3[(s0 ) & 0xff] ^ + rk[7]; + + rk += 8; + if (--r == 0) { + break; + } + + s0 = + Td0[(t0 >> 24) ] ^ + Td1[(t3 >> 16) & 0xff] ^ + Td2[(t2 >> 8) & 0xff] ^ + Td3[(t1 ) & 0xff] ^ + rk[0]; + s1 = + Td0[(t1 >> 24) ] ^ + Td1[(t0 >> 16) & 0xff] ^ + Td2[(t3 >> 8) & 0xff] ^ + Td3[(t2 ) & 0xff] ^ + rk[1]; + s2 = + Td0[(t2 >> 24) ] ^ + Td1[(t1 >> 16) & 0xff] ^ + Td2[(t0 >> 8) & 0xff] ^ + Td3[(t3 ) & 0xff] ^ + rk[2]; + s3 = + Td0[(t3 >> 24) ] ^ + Td1[(t2 >> 16) & 0xff] ^ + Td2[(t1 >> 8) & 0xff] ^ + Td3[(t0 ) & 0xff] ^ + rk[3]; + } +#endif /* ?FULL_UNROLL */ + /* + * apply last round and + * map cipher state to byte array block: + */ + s0 = + (Td4[(t0 >> 24) ] & 0xff000000) ^ + (Td4[(t3 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(t2 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(t1 ) & 0xff] & 0x000000ff) ^ + rk[0]; + PUTU32(pt , s0); + s1 = + (Td4[(t1 >> 24) ] & 0xff000000) ^ + (Td4[(t0 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(t3 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(t2 ) & 0xff] & 0x000000ff) ^ + rk[1]; + PUTU32(pt + 4, s1); + s2 = + (Td4[(t2 >> 24) ] & 0xff000000) ^ + (Td4[(t1 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(t0 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(t3 ) & 0xff] & 0x000000ff) ^ + rk[2]; + PUTU32(pt + 8, s2); + s3 = + (Td4[(t3 >> 24) ] & 0xff000000) ^ + (Td4[(t2 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(t1 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(t0 ) & 0xff] & 0x000000ff) ^ + rk[3]; + PUTU32(pt + 12, s3); +} + +#ifdef INTERMEDIATE_VALUE_KAT + +void rijndaelEncryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds) { + int r; + u32 s0, s1, s2, s3, t0, t1, t2, t3; + + /* + * map byte array block to cipher state + * and add initial round key: + */ + s0 = GETU32(block ) ^ rk[0]; + s1 = GETU32(block + 4) ^ rk[1]; + s2 = GETU32(block + 8) ^ rk[2]; + s3 = GETU32(block + 12) ^ rk[3]; + rk += 4; + + /* + * Nr - 1 full rounds: + */ + for (r = (rounds < Nr ? rounds : Nr - 1); r > 0; r--) { + t0 = + Te0[(s0 >> 24) ] ^ + Te1[(s1 >> 16) & 0xff] ^ + Te2[(s2 >> 8) & 0xff] ^ + Te3[(s3 ) & 0xff] ^ + rk[0]; + t1 = + Te0[(s1 >> 24) ] ^ + Te1[(s2 >> 16) & 0xff] ^ + Te2[(s3 >> 8) & 0xff] ^ + Te3[(s0 ) & 0xff] ^ + rk[1]; + t2 = + Te0[(s2 >> 24) ] ^ + Te1[(s3 >> 16) & 0xff] ^ + Te2[(s0 >> 8) & 0xff] ^ + Te3[(s1 ) & 0xff] ^ + rk[2]; + t3 = + Te0[(s3 >> 24) ] ^ + Te1[(s0 >> 16) & 0xff] ^ + Te2[(s1 >> 8) & 0xff] ^ + Te3[(s2 ) & 0xff] ^ + rk[3]; + + s0 = t0; + s1 = t1; + s2 = t2; + s3 = t3; + rk += 4; + + } + + /* + * apply last round and + * map cipher state to byte array block: + */ + if (rounds == Nr) { + t0 = + (Te4[(s0 >> 24) ] & 0xff000000) ^ + (Te4[(s1 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(s2 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(s3 ) & 0xff] & 0x000000ff) ^ + rk[0]; + t1 = + (Te4[(s1 >> 24) ] & 0xff000000) ^ + (Te4[(s2 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(s3 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(s0 ) & 0xff] & 0x000000ff) ^ + rk[1]; + t2 = + (Te4[(s2 >> 24) ] & 0xff000000) ^ + (Te4[(s3 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(s0 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(s1 ) & 0xff] & 0x000000ff) ^ + rk[2]; + t3 = + (Te4[(s3 >> 24) ] & 0xff000000) ^ + (Te4[(s0 >> 16) & 0xff] & 0x00ff0000) ^ + (Te4[(s1 >> 8) & 0xff] & 0x0000ff00) ^ + (Te4[(s2 ) & 0xff] & 0x000000ff) ^ + rk[3]; + + s0 = t0; + s1 = t1; + s2 = t2; + s3 = t3; + } + + PUTU32(block , s0); + PUTU32(block + 4, s1); + PUTU32(block + 8, s2); + PUTU32(block + 12, s3); +} + +void rijndaelDecryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds) { + int r; + u32 s0, s1, s2, s3, t0, t1, t2, t3; + + /* + * map byte array block to cipher state + * and add initial round key: + */ + s0 = GETU32(block ) ^ rk[0]; + s1 = GETU32(block + 4) ^ rk[1]; + s2 = GETU32(block + 8) ^ rk[2]; + s3 = GETU32(block + 12) ^ rk[3]; + rk += 4; + + /* + * Nr - 1 full rounds: + */ + for (r = (rounds < Nr ? rounds : Nr) - 1; r > 0; r--) { + t0 = + Td0[(s0 >> 24) ] ^ + Td1[(s3 >> 16) & 0xff] ^ + Td2[(s2 >> 8) & 0xff] ^ + Td3[(s1 ) & 0xff] ^ + rk[0]; + t1 = + Td0[(s1 >> 24) ] ^ + Td1[(s0 >> 16) & 0xff] ^ + Td2[(s3 >> 8) & 0xff] ^ + Td3[(s2 ) & 0xff] ^ + rk[1]; + t2 = + Td0[(s2 >> 24) ] ^ + Td1[(s1 >> 16) & 0xff] ^ + Td2[(s0 >> 8) & 0xff] ^ + Td3[(s3 ) & 0xff] ^ + rk[2]; + t3 = + Td0[(s3 >> 24) ] ^ + Td1[(s2 >> 16) & 0xff] ^ + Td2[(s1 >> 8) & 0xff] ^ + Td3[(s0 ) & 0xff] ^ + rk[3]; + + s0 = t0; + s1 = t1; + s2 = t2; + s3 = t3; + rk += 4; + + } + + /* + * complete the last round and + * map cipher state to byte array block: + */ + t0 = + (Td4[(s0 >> 24) ] & 0xff000000) ^ + (Td4[(s3 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(s2 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(s1 ) & 0xff] & 0x000000ff); + t1 = + (Td4[(s1 >> 24) ] & 0xff000000) ^ + (Td4[(s0 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(s3 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(s2 ) & 0xff] & 0x000000ff); + t2 = + (Td4[(s2 >> 24) ] & 0xff000000) ^ + (Td4[(s1 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(s0 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(s3 ) & 0xff] & 0x000000ff); + t3 = + (Td4[(s3 >> 24) ] & 0xff000000) ^ + (Td4[(s2 >> 16) & 0xff] & 0x00ff0000) ^ + (Td4[(s1 >> 8) & 0xff] & 0x0000ff00) ^ + (Td4[(s0 ) & 0xff] & 0x000000ff); + + if (rounds == Nr) { + t0 ^= rk[0]; + t1 ^= rk[1]; + t2 ^= rk[2]; + t3 ^= rk[3]; + } + + PUTU32(block , t0); + PUTU32(block + 4, t1); + PUTU32(block + 8, t2); + PUTU32(block + 12, t3); +} + +#endif /* INTERMEDIATE_VALUE_KAT */ diff --git a/src/rijndael-alg-fst.h b/src/rijndael-alg-fst.h new file mode 100644 index 0000000..f093e5b --- /dev/null +++ b/src/rijndael-alg-fst.h @@ -0,0 +1,47 @@ +/** + * rijndael-alg-fst.h + * + * @version 3.0 (December 2000) + * + * Optimised ANSI C code for the Rijndael cipher (now AES) + * + * @author Vincent Rijmen + * @author Antoon Bosselaers + * @author Paulo Barreto + * + * This code is hereby placed in the public domain. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS + * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR + * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE + * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, + * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ +#ifndef __RIJNDAEL_ALG_FST_H +#define __RIJNDAEL_ALG_FST_H + +#define MAXKC (256/32) +#define MAXKB (256/8) +#define MAXNR 14 + +typedef unsigned char u8; +typedef unsigned short u16; +typedef unsigned int u32; + +int rijndaelKeySetupEnc(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); +int rijndaelKeySetupDec(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); +void rijndaelEncrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 pt[16], u8 ct[16]); +void rijndaelDecrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 ct[16], u8 pt[16]); + +#ifdef INTERMEDIATE_VALUE_KAT +void rijndaelEncryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds); +void rijndaelDecryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds); +#endif /* INTERMEDIATE_VALUE_KAT */ + +#endif /* __RIJNDAEL_ALG_FST_H */ diff --git a/src/ripemd160.c b/src/ripemd160.c new file mode 100644 index 0000000..b0bbf64 --- /dev/null +++ b/src/ripemd160.c @@ -0,0 +1,392 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2005 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* RIPEMD160 hashing */ + +#include +#include +#include "ripemd160.h" + +/* Refs: + - The reference implementation written by Antoon Bosselaers, + available at http://www.esat.kuleuven.ac.be/~cosicart/ps/AB-9601/ + - Handbook of Applied Cryptography, section 9.4.2, algorithm 9.55 +*/ + +/* Rotation n bits to the left */ +#define ROL(x,n) (((x) << (n)) | ((x) >> (32-(n)))) + +/* The five basic functions */ +#define F(x,y,z) ((x) ^ (y) ^ (z)) +#define G(x,y,z) (((x) & (y)) | (~(x) & (z))) +#define H(x,y,z) (((x) | ~(y)) ^ (z)) +#define I(x,y,z) (((x) & (z)) | ((y) & ~(z))) +#define J(x,y,z) ((x) ^ ((y) | ~(z))) + +/* The ten "steps" for the rounds */ +#define FF(a, b, c, d, e, x, s) {\ + (a) += F((b), (c), (d)) + (x);\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define GG(a, b, c, d, e, x, s) {\ + (a) += G((b), (c), (d)) + (x) + 0x5a827999U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define HH(a, b, c, d, e, x, s) {\ + (a) += H((b), (c), (d)) + (x) + 0x6ed9eba1U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define II(a, b, c, d, e, x, s) {\ + (a) += I((b), (c), (d)) + (x) + 0x8f1bbcdcU;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define JJ(a, b, c, d, e, x, s) {\ + (a) += J((b), (c), (d)) + (x) + 0xa953fd4eU;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define FFF(a, b, c, d, e, x, s) {\ + (a) += F((b), (c), (d)) + (x);\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define GGG(a, b, c, d, e, x, s) {\ + (a) += G((b), (c), (d)) + (x) + 0x7a6d76e9U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define HHH(a, b, c, d, e, x, s) {\ + (a) += H((b), (c), (d)) + (x) + 0x6d703ef3U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define III(a, b, c, d, e, x, s) {\ + (a) += I((b), (c), (d)) + (x) + 0x5c4dd124U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } +#define JJJ(a, b, c, d, e, x, s) {\ + (a) += J((b), (c), (d)) + (x) + 0x50a28be6U;\ + (a) = ROL((a), (s)) + (e);\ + (c) = ROL((c), 10);\ + } + +static void RIPEMD160_copy_and_swap(void * src, void * dst, int numwords) +{ +#ifdef ARCH_BIG_ENDIAN + unsigned char * s, * d; + unsigned char a, b; + for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { + a = s[0]; + b = s[1]; + d[0] = s[3]; + d[1] = s[2]; + d[2] = b; + d[3] = a; + } +#else + memcpy(dst, src, numwords * sizeof(u32)); +#endif +} + +static void RIPEMD160_compress(struct RIPEMD160Context * ctx) +{ + register u32 a, b, c, d, e; + u32 aa, bb, cc, dd, ee; + u32 data[16]; + + /* Convert buffer data to 16 little-endian integers */ + RIPEMD160_copy_and_swap(ctx->buffer, data, 16); + + /* Perform "left" rounds */ + a = ctx->state[0]; + b = ctx->state[1]; + c = ctx->state[2]; + d = ctx->state[3]; + e = ctx->state[4]; + + /* left round 1 */ + FF(a, b, c, d, e, data[ 0], 11); + FF(e, a, b, c, d, data[ 1], 14); + FF(d, e, a, b, c, data[ 2], 15); + FF(c, d, e, a, b, data[ 3], 12); + FF(b, c, d, e, a, data[ 4], 5); + FF(a, b, c, d, e, data[ 5], 8); + FF(e, a, b, c, d, data[ 6], 7); + FF(d, e, a, b, c, data[ 7], 9); + FF(c, d, e, a, b, data[ 8], 11); + FF(b, c, d, e, a, data[ 9], 13); + FF(a, b, c, d, e, data[10], 14); + FF(e, a, b, c, d, data[11], 15); + FF(d, e, a, b, c, data[12], 6); + FF(c, d, e, a, b, data[13], 7); + FF(b, c, d, e, a, data[14], 9); + FF(a, b, c, d, e, data[15], 8); + + /* left round 2 */ + GG(e, a, b, c, d, data[ 7], 7); + GG(d, e, a, b, c, data[ 4], 6); + GG(c, d, e, a, b, data[13], 8); + GG(b, c, d, e, a, data[ 1], 13); + GG(a, b, c, d, e, data[10], 11); + GG(e, a, b, c, d, data[ 6], 9); + GG(d, e, a, b, c, data[15], 7); + GG(c, d, e, a, b, data[ 3], 15); + GG(b, c, d, e, a, data[12], 7); + GG(a, b, c, d, e, data[ 0], 12); + GG(e, a, b, c, d, data[ 9], 15); + GG(d, e, a, b, c, data[ 5], 9); + GG(c, d, e, a, b, data[ 2], 11); + GG(b, c, d, e, a, data[14], 7); + GG(a, b, c, d, e, data[11], 13); + GG(e, a, b, c, d, data[ 8], 12); + + /* left round 3 */ + HH(d, e, a, b, c, data[ 3], 11); + HH(c, d, e, a, b, data[10], 13); + HH(b, c, d, e, a, data[14], 6); + HH(a, b, c, d, e, data[ 4], 7); + HH(e, a, b, c, d, data[ 9], 14); + HH(d, e, a, b, c, data[15], 9); + HH(c, d, e, a, b, data[ 8], 13); + HH(b, c, d, e, a, data[ 1], 15); + HH(a, b, c, d, e, data[ 2], 14); + HH(e, a, b, c, d, data[ 7], 8); + HH(d, e, a, b, c, data[ 0], 13); + HH(c, d, e, a, b, data[ 6], 6); + HH(b, c, d, e, a, data[13], 5); + HH(a, b, c, d, e, data[11], 12); + HH(e, a, b, c, d, data[ 5], 7); + HH(d, e, a, b, c, data[12], 5); + + /* left round 4 */ + II(c, d, e, a, b, data[ 1], 11); + II(b, c, d, e, a, data[ 9], 12); + II(a, b, c, d, e, data[11], 14); + II(e, a, b, c, d, data[10], 15); + II(d, e, a, b, c, data[ 0], 14); + II(c, d, e, a, b, data[ 8], 15); + II(b, c, d, e, a, data[12], 9); + II(a, b, c, d, e, data[ 4], 8); + II(e, a, b, c, d, data[13], 9); + II(d, e, a, b, c, data[ 3], 14); + II(c, d, e, a, b, data[ 7], 5); + II(b, c, d, e, a, data[15], 6); + II(a, b, c, d, e, data[14], 8); + II(e, a, b, c, d, data[ 5], 6); + II(d, e, a, b, c, data[ 6], 5); + II(c, d, e, a, b, data[ 2], 12); + + /* left round 5 */ + JJ(b, c, d, e, a, data[ 4], 9); + JJ(a, b, c, d, e, data[ 0], 15); + JJ(e, a, b, c, d, data[ 5], 5); + JJ(d, e, a, b, c, data[ 9], 11); + JJ(c, d, e, a, b, data[ 7], 6); + JJ(b, c, d, e, a, data[12], 8); + JJ(a, b, c, d, e, data[ 2], 13); + JJ(e, a, b, c, d, data[10], 12); + JJ(d, e, a, b, c, data[14], 5); + JJ(c, d, e, a, b, data[ 1], 12); + JJ(b, c, d, e, a, data[ 3], 13); + JJ(a, b, c, d, e, data[ 8], 14); + JJ(e, a, b, c, d, data[11], 11); + JJ(d, e, a, b, c, data[ 6], 8); + JJ(c, d, e, a, b, data[15], 5); + JJ(b, c, d, e, a, data[13], 6); + + /* Save result of left rounds */ + aa = a; bb = b; cc = c; dd = d; ee = e; + + /* Perform "right" rounds */ + a = ctx->state[0]; + b = ctx->state[1]; + c = ctx->state[2]; + d = ctx->state[3]; + e = ctx->state[4]; + + /* right round 1 */ + JJJ(a, b, c, d, e, data[ 5], 8); + JJJ(e, a, b, c, d, data[14], 9); + JJJ(d, e, a, b, c, data[ 7], 9); + JJJ(c, d, e, a, b, data[ 0], 11); + JJJ(b, c, d, e, a, data[ 9], 13); + JJJ(a, b, c, d, e, data[ 2], 15); + JJJ(e, a, b, c, d, data[11], 15); + JJJ(d, e, a, b, c, data[ 4], 5); + JJJ(c, d, e, a, b, data[13], 7); + JJJ(b, c, d, e, a, data[ 6], 7); + JJJ(a, b, c, d, e, data[15], 8); + JJJ(e, a, b, c, d, data[ 8], 11); + JJJ(d, e, a, b, c, data[ 1], 14); + JJJ(c, d, e, a, b, data[10], 14); + JJJ(b, c, d, e, a, data[ 3], 12); + JJJ(a, b, c, d, e, data[12], 6); + + /* right round 2 */ + III(e, a, b, c, d, data[ 6], 9); + III(d, e, a, b, c, data[11], 13); + III(c, d, e, a, b, data[ 3], 15); + III(b, c, d, e, a, data[ 7], 7); + III(a, b, c, d, e, data[ 0], 12); + III(e, a, b, c, d, data[13], 8); + III(d, e, a, b, c, data[ 5], 9); + III(c, d, e, a, b, data[10], 11); + III(b, c, d, e, a, data[14], 7); + III(a, b, c, d, e, data[15], 7); + III(e, a, b, c, d, data[ 8], 12); + III(d, e, a, b, c, data[12], 7); + III(c, d, e, a, b, data[ 4], 6); + III(b, c, d, e, a, data[ 9], 15); + III(a, b, c, d, e, data[ 1], 13); + III(e, a, b, c, d, data[ 2], 11); + + /* right round 3 */ + HHH(d, e, a, b, c, data[15], 9); + HHH(c, d, e, a, b, data[ 5], 7); + HHH(b, c, d, e, a, data[ 1], 15); + HHH(a, b, c, d, e, data[ 3], 11); + HHH(e, a, b, c, d, data[ 7], 8); + HHH(d, e, a, b, c, data[14], 6); + HHH(c, d, e, a, b, data[ 6], 6); + HHH(b, c, d, e, a, data[ 9], 14); + HHH(a, b, c, d, e, data[11], 12); + HHH(e, a, b, c, d, data[ 8], 13); + HHH(d, e, a, b, c, data[12], 5); + HHH(c, d, e, a, b, data[ 2], 14); + HHH(b, c, d, e, a, data[10], 13); + HHH(a, b, c, d, e, data[ 0], 13); + HHH(e, a, b, c, d, data[ 4], 7); + HHH(d, e, a, b, c, data[13], 5); + + /* right round 4 */ + GGG(c, d, e, a, b, data[ 8], 15); + GGG(b, c, d, e, a, data[ 6], 5); + GGG(a, b, c, d, e, data[ 4], 8); + GGG(e, a, b, c, d, data[ 1], 11); + GGG(d, e, a, b, c, data[ 3], 14); + GGG(c, d, e, a, b, data[11], 14); + GGG(b, c, d, e, a, data[15], 6); + GGG(a, b, c, d, e, data[ 0], 14); + GGG(e, a, b, c, d, data[ 5], 6); + GGG(d, e, a, b, c, data[12], 9); + GGG(c, d, e, a, b, data[ 2], 12); + GGG(b, c, d, e, a, data[13], 9); + GGG(a, b, c, d, e, data[ 9], 12); + GGG(e, a, b, c, d, data[ 7], 5); + GGG(d, e, a, b, c, data[10], 15); + GGG(c, d, e, a, b, data[14], 8); + + /* right round 5 */ + FFF(b, c, d, e, a, data[12] , 8); + FFF(a, b, c, d, e, data[15] , 5); + FFF(e, a, b, c, d, data[10] , 12); + FFF(d, e, a, b, c, data[ 4] , 9); + FFF(c, d, e, a, b, data[ 1] , 12); + FFF(b, c, d, e, a, data[ 5] , 5); + FFF(a, b, c, d, e, data[ 8] , 14); + FFF(e, a, b, c, d, data[ 7] , 6); + FFF(d, e, a, b, c, data[ 6] , 8); + FFF(c, d, e, a, b, data[ 2] , 13); + FFF(b, c, d, e, a, data[13] , 6); + FFF(a, b, c, d, e, data[14] , 5); + FFF(e, a, b, c, d, data[ 0] , 15); + FFF(d, e, a, b, c, data[ 3] , 13); + FFF(c, d, e, a, b, data[ 9] , 11); + FFF(b, c, d, e, a, data[11] , 11); + + /* Update chaining values */ + d += cc + ctx->state[1]; + ctx->state[1] = ctx->state[2] + dd + e; + ctx->state[2] = ctx->state[3] + ee + a; + ctx->state[3] = ctx->state[4] + aa + b; + ctx->state[4] = ctx->state[0] + bb + c; + ctx->state[0] = d; +} + +void RIPEMD160_init(struct RIPEMD160Context * ctx) +{ + ctx->state[0] = 0x67452301U; + ctx->state[1] = 0xEFCDAB89U; + ctx->state[2] = 0x98BADCFEU; + ctx->state[3] = 0x10325476U; + ctx->state[4] = 0xC3D2E1F0U; + ctx->numbytes = 0; + ctx->length[0] = 0; + ctx->length[1] = 0; +} + +void RIPEMD160_add_data(struct RIPEMD160Context * ctx, unsigned char * data, + unsigned long len) +{ + u32 t; + + /* Update length */ + t = ctx->length[0]; + if ((ctx->length[0] = t + (u32) (len << 3)) < t) + ctx->length[1]++; /* carry from low 32 bits to high 32 bits */ + ctx->length[1] += (u32) (len >> 29); + + /* If data was left in buffer, pad it with fresh data and munge block */ + if (ctx->numbytes != 0) { + t = 64 - ctx->numbytes; + if (len < t) { + memcpy(ctx->buffer + ctx->numbytes, data, len); + ctx->numbytes += len; + return; + } + memcpy(ctx->buffer + ctx->numbytes, data, t); + RIPEMD160_compress(ctx); + data += t; + len -= t; + } + /* Munge data in 64-byte chunks */ + while (len >= 64) { + memcpy(ctx->buffer, data, 64); + RIPEMD160_compress(ctx); + data += 64; + len -= 64; + } + /* Save remaining data */ + memcpy(ctx->buffer, data, len); + ctx->numbytes = len; +} + +void RIPEMD160_finish(struct RIPEMD160Context * ctx, unsigned char output[20]) +{ + int i = ctx->numbytes; + + /* Set first char of padding to 0x80. There is always room. */ + ctx->buffer[i++] = 0x80; + /* If we do not have room for the length (8 bytes), pad to 64 bytes + with zeroes and munge the data block */ + if (i > 56) { + memset(ctx->buffer + i, 0, 64 - i); + RIPEMD160_compress(ctx); + i = 0; + } + /* Pad to byte 56 with zeroes */ + memset(ctx->buffer + i, 0, 56 - i); + /* Add length in little-endian */ + RIPEMD160_copy_and_swap(ctx->length, ctx->buffer + 56, 2); + /* Munge the final block */ + RIPEMD160_compress(ctx); + /* Final hash value is in ctx->state modulo little-endian conversion */ + RIPEMD160_copy_and_swap(ctx->state, output, 5); +} diff --git a/src/ripemd160.h b/src/ripemd160.h new file mode 100644 index 0000000..9e61d93 --- /dev/null +++ b/src/ripemd160.h @@ -0,0 +1,32 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2005 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* RIPEMD160 hashing */ + +typedef unsigned int u32; + +struct RIPEMD160Context { + u32 state[5]; + u32 length[2]; + int numbytes; + unsigned char buffer[64]; +}; + +extern void RIPEMD160_init(struct RIPEMD160Context * ctx); +extern void RIPEMD160_add_data(struct RIPEMD160Context * ctx, + unsigned char * data, + unsigned long len); +extern void RIPEMD160_finish(struct RIPEMD160Context * ctx, + unsigned char output[20]); diff --git a/src/sha1.c b/src/sha1.c new file mode 100644 index 0000000..ff6fc7d --- /dev/null +++ b/src/sha1.c @@ -0,0 +1,172 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* SHA-1 hashing */ + +#include +#include +#include "sha1.h" + +/* Ref: Handbook of Applied Cryptography, section 9.4.2, algorithm 9.53 */ + +#define rol1(x) (((x) << 1) | ((x) >> 31)) +#define rol5(x) (((x) << 5) | ((x) >> 27)) +#define rol30(x) (((x) << 30) | ((x) >> 2)) + +static void SHA1_copy_and_swap(void * src, void * dst, int numwords) +{ +#ifdef ARCH_BIG_ENDIAN + memcpy(dst, src, numwords * sizeof(u32)); +#else + unsigned char * s, * d; + unsigned char a, b; + for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { + a = s[0]; + b = s[1]; + d[0] = s[3]; + d[1] = s[2]; + d[2] = b; + d[3] = a; + } +#endif +} + +#define F(x,y,z) ( z ^ (x & (y ^ z) ) ) +#define G(x,y,z) ( (x & y) | (z & (x | y) ) ) +#define H(x,y,z) ( x ^ y ^ z ) + +#define Y1 0x5A827999U +#define Y2 0x6ED9EBA1U +#define Y3 0x8F1BBCDCU +#define Y4 0xCA62C1D6U + +static void SHA1_transform(struct SHA1Context * ctx) +{ + int i; + register u32 a, b, c, d, e, t; + u32 data[80]; + + /* Convert buffer data to 16 big-endian integers */ + SHA1_copy_and_swap(ctx->buffer, data, 16); + + /* Expand into 80 integers */ + for (i = 16; i < 80; i++) { + t = data[i-3] ^ data[i-8] ^ data[i-14] ^ data[i-16]; + data[i] = rol1(t); + } + + /* Initialize working variables */ + a = ctx->state[0]; + b = ctx->state[1]; + c = ctx->state[2]; + d = ctx->state[3]; + e = ctx->state[4]; + + /* Perform rounds */ + for (i = 0; i < 20; i++) { + t = F(b, c, d) + Y1 + rol5(a) + e + data[i]; + e = d; d = c; c = rol30(b); b = a; a = t; + } + for (/*nothing*/; i < 40; i++) { + t = H(b, c, d) + Y2 + rol5(a) + e + data[i]; + e = d; d = c; c = rol30(b); b = a; a = t; + } + for (/*nothing*/; i < 60; i++) { + t = G(b, c, d) + Y3 + rol5(a) + e + data[i]; + e = d; d = c; c = rol30(b); b = a; a = t; + } + for (/*nothing*/; i < 80; i++) { + t = H(b, c, d) + Y4 + rol5(a) + e + data[i]; + e = d; d = c; c = rol30(b); b = a; a = t; + } + + /* Update chaining values */ + ctx->state[0] += a; + ctx->state[1] += b; + ctx->state[2] += c; + ctx->state[3] += d; + ctx->state[4] += e; +} + +void SHA1_init(struct SHA1Context * ctx) +{ + ctx->state[0] = 0x67452301U; + ctx->state[1] = 0xEFCDAB89U; + ctx->state[2] = 0x98BADCFEU; + ctx->state[3] = 0x10325476U; + ctx->state[4] = 0xC3D2E1F0U; + ctx->numbytes = 0; + ctx->length[0] = 0; + ctx->length[1] = 0; +} + +void SHA1_add_data(struct SHA1Context * ctx, unsigned char * data, + unsigned long len) +{ + u32 t; + + /* Update length */ + t = ctx->length[1]; + if ((ctx->length[1] = t + (u32) (len << 3)) < t) + ctx->length[0]++; /* carry from low 32 bits to high 32 bits */ + ctx->length[0] += (u32) (len >> 29); + + /* If data was left in buffer, pad it with fresh data and munge block */ + if (ctx->numbytes != 0) { + t = 64 - ctx->numbytes; + if (len < t) { + memcpy(ctx->buffer + ctx->numbytes, data, len); + ctx->numbytes += len; + return; + } + memcpy(ctx->buffer + ctx->numbytes, data, t); + SHA1_transform(ctx); + data += t; + len -= t; + } + /* Munge data in 64-byte chunks */ + while (len >= 64) { + memcpy(ctx->buffer, data, 64); + SHA1_transform(ctx); + data += 64; + len -= 64; + } + /* Save remaining data */ + memcpy(ctx->buffer, data, len); + ctx->numbytes = len; +} + +void SHA1_finish(struct SHA1Context * ctx, unsigned char output[20]) +{ + int i = ctx->numbytes; + + /* Set first char of padding to 0x80. There is always room. */ + ctx->buffer[i++] = 0x80; + /* If we do not have room for the length (8 bytes), pad to 64 bytes + with zeroes and munge the data block */ + if (i > 56) { + memset(ctx->buffer + i, 0, 64 - i); + SHA1_transform(ctx); + i = 0; + } + /* Pad to byte 56 with zeroes */ + memset(ctx->buffer + i, 0, 56 - i); + /* Add length in big-endian */ + SHA1_copy_and_swap(ctx->length, ctx->buffer + 56, 2); + /* Munge the final block */ + SHA1_transform(ctx); + /* Final hash value is in ctx->state modulo big-endian conversion */ + SHA1_copy_and_swap(ctx->state, output, 5); +} diff --git a/src/sha1.h b/src/sha1.h new file mode 100644 index 0000000..7ba2fc2 --- /dev/null +++ b/src/sha1.h @@ -0,0 +1,30 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* SHA-1 hashing */ + +typedef unsigned int u32; + +struct SHA1Context { + u32 state[5]; + u32 length[2]; + int numbytes; + unsigned char buffer[64]; +}; + +extern void SHA1_init(struct SHA1Context * ctx); +extern void SHA1_add_data(struct SHA1Context * ctx, unsigned char * data, + unsigned long len); +extern void SHA1_finish(struct SHA1Context * ctx, unsigned char output[20]); diff --git a/src/sha256.c b/src/sha256.c new file mode 100644 index 0000000..298b6e9 --- /dev/null +++ b/src/sha256.c @@ -0,0 +1,232 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* SHA-256 hashing */ + +#include +#include +#include "sha256.h" + +/* Ref: FIPS publication 180-2 */ + +#define ROTR(x,n) ((x) >> (n) | (x) << (32 - (n))) + +#define CH(x,y,z) (z ^ (x & (y ^ z))) +#define MAJ(x,y,z) ((x & y) | (z & (x | y))) +#define SIGMA0(x) (ROTR(x,2) ^ ROTR(x,13) ^ ROTR(x,22)) +#define SIGMA1(x) (ROTR(x,6) ^ ROTR(x,11) ^ ROTR(x,25)) +#define sigma0(x) (ROTR(x,7) ^ ROTR(x,18) ^ (x >> 3)) +#define sigma1(x) (ROTR(x,17) ^ ROTR(x,19) ^ (x >> 10)) + +static void SHA256_copy_and_swap(void * src, void * dst, int numwords) +{ +#ifdef ARCH_BIG_ENDIAN + memcpy(dst, src, numwords * sizeof(u32)); +#else + unsigned char * s, * d; + unsigned char a, b; + for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { + a = s[0]; + b = s[1]; + d[0] = s[3]; + d[1] = s[2]; + d[2] = b; + d[3] = a; + } +#endif +} + +static u32 SHA256_constants[64] = { + 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, + 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, + 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, + 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, + 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, + 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, + 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, + 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, + 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, + 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, + 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, + 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, + 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, + 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, + 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, + 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 +}; + +static void SHA256_transform(struct SHA256Context * ctx) +{ + int i; + register u32 a, b, c, d, e, f, g, h, t1, t2; + u32 data[80]; + + /* Convert buffer data to 16 big-endian integers */ + SHA256_copy_and_swap(ctx->buffer, data, 16); + + /* Expand into 80 integers */ + for (i = 16; i < 80; i++) { + data[i] = sigma1(data[i-2]) + data[i-7] + sigma0(data[i-15]) + data[i-16]; + } + + /* Initialize working variables */ + a = ctx->state[0]; + b = ctx->state[1]; + c = ctx->state[2]; + d = ctx->state[3]; + e = ctx->state[4]; + f = ctx->state[5]; + g = ctx->state[6]; + h = ctx->state[7]; + + /* Perform rounds */ +#if 0 + for (i = 0; i < 64; i++) { + t1 = h + SIGMA1(e) + CH(e, f, g) + SHA256_constants[i] + data[i]; + t2 = SIGMA0(a) + MAJ(a, b, c); + h = g; g = f; f = e; e = d + t1; + d = c; c = b; b = a; a = t1 + t2; + } +#else +#define STEP(a,b,c,d,e,f,g,h,i) \ + t1 = h + SIGMA1(e) + CH(e, f, g) + SHA256_constants[i] + data[i]; \ + t2 = SIGMA0(a) + MAJ(a, b, c); \ + d = d + t1; \ + h = t1 + t2 + + for (i = 0; i < 64; i += 8) { + STEP(a,b,c,d,e,f,g,h,i); + STEP(h,a,b,c,d,e,f,g,i+1); + STEP(g,h,a,b,c,d,e,f,i+2); + STEP(f,g,h,a,b,c,d,e,i+3); + STEP(e,f,g,h,a,b,c,d,i+4); + STEP(d,e,f,g,h,a,b,c,i+5); + STEP(c,d,e,f,g,h,a,b,i+6); + STEP(b,c,d,e,f,g,h,a,i+7); + } +#endif + + /* Update chaining values */ + ctx->state[0] += a; + ctx->state[1] += b; + ctx->state[2] += c; + ctx->state[3] += d; + ctx->state[4] += e; + ctx->state[5] += f; + ctx->state[6] += g; + ctx->state[7] += h; +} + +void SHA256_init(struct SHA256Context * ctx, int bitsize) +{ + switch (bitsize) { + case 224: + ctx->state[0] = 0xc1059ed8; + ctx->state[1] = 0x367cd507; + ctx->state[2] = 0x3070dd17; + ctx->state[3] = 0xf70e5939; + ctx->state[4] = 0xffc00b31; + ctx->state[5] = 0x68581511; + ctx->state[6] = 0x64f98fa7; + ctx->state[7] = 0xbefa4fa4; + break; + case 256: + ctx->state[0] = 0x6A09E667; + ctx->state[1] = 0xBB67AE85; + ctx->state[2] = 0x3C6EF372; + ctx->state[3] = 0xA54FF53A; + ctx->state[4] = 0x510E527F; + ctx->state[5] = 0x9B05688C; + ctx->state[6] = 0x1F83D9AB; + ctx->state[7] = 0x5BE0CD19; + break; + default: + /* The bit size is wrong. Just zero the state to produce + incorrect hashes. */ + memset(ctx->state, 0, sizeof(ctx->state)); + break; + } + ctx->numbytes = 0; + ctx->length[0] = 0; + ctx->length[1] = 0; +} + +void SHA256_add_data(struct SHA256Context * ctx, unsigned char * data, + unsigned long len) +{ + u32 t; + + /* Update length */ + t = ctx->length[1]; + if ((ctx->length[1] = t + (u32) (len << 3)) < t) + ctx->length[0]++; /* carry from low 32 bits to high 32 bits */ + ctx->length[0] += (u32) (len >> 29); + + /* If data was left in buffer, pad it with fresh data and munge block */ + if (ctx->numbytes != 0) { + t = 64 - ctx->numbytes; + if (len < t) { + memcpy(ctx->buffer + ctx->numbytes, data, len); + ctx->numbytes += len; + return; + } + memcpy(ctx->buffer + ctx->numbytes, data, t); + SHA256_transform(ctx); + data += t; + len -= t; + } + /* Munge data in 64-byte chunks */ + while (len >= 64) { + memcpy(ctx->buffer, data, 64); + SHA256_transform(ctx); + data += 64; + len -= 64; + } + /* Save remaining data */ + memcpy(ctx->buffer, data, len); + ctx->numbytes = len; +} + +void SHA256_finish(struct SHA256Context * ctx, int bitsize, + unsigned char * output) +{ + int i = ctx->numbytes; + + /* Set first char of padding to 0x80. There is always room. */ + ctx->buffer[i++] = 0x80; + /* If we do not have room for the length (8 bytes), pad to 64 bytes + with zeroes and munge the data block */ + if (i > 56) { + memset(ctx->buffer + i, 0, 64 - i); + SHA256_transform(ctx); + i = 0; + } + /* Pad to byte 56 with zeroes */ + memset(ctx->buffer + i, 0, 56 - i); + /* Add length in big-endian */ + SHA256_copy_and_swap(ctx->length, ctx->buffer + 56, 2); + /* Munge the final block */ + SHA256_transform(ctx); + /* Final hash value is in ctx->state modulo big-endian conversion */ + switch (bitsize) { + case 256: + SHA256_copy_and_swap(ctx->state, output, 8); + break; + case 224: + SHA256_copy_and_swap(ctx->state, output, 7); + break; + /* default: The bit size is wrong. Produce no output. */ + } +} diff --git a/src/sha256.h b/src/sha256.h new file mode 100644 index 0000000..20e6d48 --- /dev/null +++ b/src/sha256.h @@ -0,0 +1,37 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* SHA-256 hashing */ + +#ifndef _MSC_VER +#include +typedef uint32_t u32; +#else +typedef unsigned int u32; +#endif + +struct SHA256Context { + u32 state[8]; + u32 length[2]; + int numbytes; + unsigned char buffer[64]; +}; + +extern void SHA256_init(struct SHA256Context * ctx, int bitsize); +extern void SHA256_add_data(struct SHA256Context * ctx, unsigned char * data, + unsigned long len); +extern void SHA256_finish(struct SHA256Context * ctx, + int bitsize, + unsigned char * output); diff --git a/src/sha512.c b/src/sha512.c new file mode 100644 index 0000000..980dc3b --- /dev/null +++ b/src/sha512.c @@ -0,0 +1,302 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2015 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: sha256.c 53 2010-08-30 10:53:00Z gildor-admin $ */ + +/* SHA-512 hashing */ + +#include +#include +#include "sha512.h" + +/* Ref: FIPS publication 180-2 */ + +#define ROTR(x,n) ((x) >> (n) | (x) << (64 - (n))) + +#define CH(x,y,z) (z ^ (x & (y ^ z))) +#define MAJ(x,y,z) ((x & y) | (z & (x | y))) +#define SIGMA0(x) (ROTR(x,28) ^ ROTR(x,34) ^ ROTR(x,39)) +#define SIGMA1(x) (ROTR(x,14) ^ ROTR(x,18) ^ ROTR(x,41)) +#define sigma0(x) (ROTR(x,1) ^ ROTR(x,8) ^ (x >> 7)) +#define sigma1(x) (ROTR(x,19) ^ ROTR(x,61) ^ (x >> 6)) + +static void SHA512_copy_and_swap(void * src, void * dst, int numwords) +{ +#ifdef ARCH_BIG_ENDIAN + memcpy(dst, src, numwords * 8); +#else + unsigned char * s, * d; + unsigned char a, b; + for (s = src, d = dst; numwords > 0; s += 8, d += 8, numwords--) { + a = s[0]; + b = s[1]; + d[0] = s[7]; + d[1] = s[6]; + d[6] = b; + d[7] = a; + a = s[2]; + b = s[3]; + d[2] = s[5]; + d[3] = s[4]; + d[4] = b; + d[5] = a; + } +#endif +} + +static u64 SHA512_constants[80] = { + UINT64_C(0x428a2f98d728ae22), + UINT64_C(0x7137449123ef65cd), + UINT64_C(0xb5c0fbcfec4d3b2f), + UINT64_C(0xe9b5dba58189dbbc), + UINT64_C(0x3956c25bf348b538), + UINT64_C(0x59f111f1b605d019), + UINT64_C(0x923f82a4af194f9b), + UINT64_C(0xab1c5ed5da6d8118), + UINT64_C(0xd807aa98a3030242), + UINT64_C(0x12835b0145706fbe), + UINT64_C(0x243185be4ee4b28c), + UINT64_C(0x550c7dc3d5ffb4e2), + UINT64_C(0x72be5d74f27b896f), + UINT64_C(0x80deb1fe3b1696b1), + UINT64_C(0x9bdc06a725c71235), + UINT64_C(0xc19bf174cf692694), + UINT64_C(0xe49b69c19ef14ad2), + UINT64_C(0xefbe4786384f25e3), + UINT64_C(0x0fc19dc68b8cd5b5), + UINT64_C(0x240ca1cc77ac9c65), + UINT64_C(0x2de92c6f592b0275), + UINT64_C(0x4a7484aa6ea6e483), + UINT64_C(0x5cb0a9dcbd41fbd4), + UINT64_C(0x76f988da831153b5), + UINT64_C(0x983e5152ee66dfab), + UINT64_C(0xa831c66d2db43210), + UINT64_C(0xb00327c898fb213f), + UINT64_C(0xbf597fc7beef0ee4), + UINT64_C(0xc6e00bf33da88fc2), + UINT64_C(0xd5a79147930aa725), + UINT64_C(0x06ca6351e003826f), + UINT64_C(0x142929670a0e6e70), + UINT64_C(0x27b70a8546d22ffc), + UINT64_C(0x2e1b21385c26c926), + UINT64_C(0x4d2c6dfc5ac42aed), + UINT64_C(0x53380d139d95b3df), + UINT64_C(0x650a73548baf63de), + UINT64_C(0x766a0abb3c77b2a8), + UINT64_C(0x81c2c92e47edaee6), + UINT64_C(0x92722c851482353b), + UINT64_C(0xa2bfe8a14cf10364), + UINT64_C(0xa81a664bbc423001), + UINT64_C(0xc24b8b70d0f89791), + UINT64_C(0xc76c51a30654be30), + UINT64_C(0xd192e819d6ef5218), + UINT64_C(0xd69906245565a910), + UINT64_C(0xf40e35855771202a), + UINT64_C(0x106aa07032bbd1b8), + UINT64_C(0x19a4c116b8d2d0c8), + UINT64_C(0x1e376c085141ab53), + UINT64_C(0x2748774cdf8eeb99), + UINT64_C(0x34b0bcb5e19b48a8), + UINT64_C(0x391c0cb3c5c95a63), + UINT64_C(0x4ed8aa4ae3418acb), + UINT64_C(0x5b9cca4f7763e373), + UINT64_C(0x682e6ff3d6b2b8a3), + UINT64_C(0x748f82ee5defb2fc), + UINT64_C(0x78a5636f43172f60), + UINT64_C(0x84c87814a1f0ab72), + UINT64_C(0x8cc702081a6439ec), + UINT64_C(0x90befffa23631e28), + UINT64_C(0xa4506cebde82bde9), + UINT64_C(0xbef9a3f7b2c67915), + UINT64_C(0xc67178f2e372532b), + UINT64_C(0xca273eceea26619c), + UINT64_C(0xd186b8c721c0c207), + UINT64_C(0xeada7dd6cde0eb1e), + UINT64_C(0xf57d4f7fee6ed178), + UINT64_C(0x06f067aa72176fba), + UINT64_C(0x0a637dc5a2c898a6), + UINT64_C(0x113f9804bef90dae), + UINT64_C(0x1b710b35131c471b), + UINT64_C(0x28db77f523047d84), + UINT64_C(0x32caab7b40c72493), + UINT64_C(0x3c9ebe0a15c9bebc), + UINT64_C(0x431d67c49c100d4c), + UINT64_C(0x4cc5d4becb3e42b6), + UINT64_C(0x597f299cfc657e2a), + UINT64_C(0x5fcb6fab3ad6faec), + UINT64_C(0x6c44198c4a475817) +}; + +static void SHA512_transform(struct SHA512Context * ctx) +{ + int i; + register u64 a, b, c, d, e, f, g, h, t1, t2; + u64 data[80]; + + /* Convert buffer data to 16 big-endian integers */ + SHA512_copy_and_swap(ctx->buffer, data, 16); + + /* Expand into 80 integers */ + for (i = 16; i < 80; i++) { + data[i] = sigma1(data[i-2]) + data[i-7] + sigma0(data[i-15]) + data[i-16]; + } + + /* Initialize working variables */ + a = ctx->state[0]; + b = ctx->state[1]; + c = ctx->state[2]; + d = ctx->state[3]; + e = ctx->state[4]; + f = ctx->state[5]; + g = ctx->state[6]; + h = ctx->state[7]; + + /* Perform rounds */ +#if 0 + for (i = 0; i < 80; i++) { + t1 = h + SIGMA1(e) + CH(e, f, g) + SHA512_constants[i] + data[i]; + t2 = SIGMA0(a) + MAJ(a, b, c); + h = g; g = f; f = e; e = d + t1; + d = c; c = b; b = a; a = t1 + t2; + } +#else +#define STEP(a,b,c,d,e,f,g,h,i) \ + t1 = h + SIGMA1(e) + CH(e, f, g) + SHA512_constants[i] + data[i]; \ + t2 = SIGMA0(a) + MAJ(a, b, c); \ + d = d + t1; \ + h = t1 + t2 + + for (i = 0; i < 80; i += 8) { + STEP(a,b,c,d,e,f,g,h,i); + STEP(h,a,b,c,d,e,f,g,i+1); + STEP(g,h,a,b,c,d,e,f,i+2); + STEP(f,g,h,a,b,c,d,e,i+3); + STEP(e,f,g,h,a,b,c,d,i+4); + STEP(d,e,f,g,h,a,b,c,i+5); + STEP(c,d,e,f,g,h,a,b,i+6); + STEP(b,c,d,e,f,g,h,a,i+7); + } +#endif + + /* Update chaining values */ + ctx->state[0] += a; + ctx->state[1] += b; + ctx->state[2] += c; + ctx->state[3] += d; + ctx->state[4] += e; + ctx->state[5] += f; + ctx->state[6] += g; + ctx->state[7] += h; +} + +void SHA512_init(struct SHA512Context * ctx, int bitsize) +{ + switch (bitsize) { + case 512: + ctx->state[0] = UINT64_C(0x6a09e667f3bcc908); + ctx->state[1] = UINT64_C(0xbb67ae8584caa73b); + ctx->state[2] = UINT64_C(0x3c6ef372fe94f82b); + ctx->state[3] = UINT64_C(0xa54ff53a5f1d36f1 ); + ctx->state[4] = UINT64_C(0x510e527fade682d1); + ctx->state[5] = UINT64_C(0x9b05688c2b3e6c1f); + ctx->state[6] = UINT64_C(0x1f83d9abfb41bd6b); + ctx->state[7] = UINT64_C(0x5be0cd19137e2179); + break; + case 384: + ctx->state[0] = UINT64_C(0xcbbb9d5dc1059ed8); + ctx->state[1] = UINT64_C(0x629a292a367cd507); + ctx->state[2] = UINT64_C(0x9159015a3070dd17); + ctx->state[3] = UINT64_C(0x152fecd8f70e5939 ); + ctx->state[4] = UINT64_C(0x67332667ffc00b31); + ctx->state[5] = UINT64_C(0x8eb44a8768581511); + ctx->state[6] = UINT64_C(0xdb0c2e0d64f98fa7); + ctx->state[7] = UINT64_C(0x47b5481dbefa4fa4); + break; + default: + /* The bit size is wrong. Just zero the state to produce + incorrect hashes. */ + memset(ctx->state, 0, sizeof(ctx->state)); + break; + } + ctx->numbytes = 0; + ctx->length[0] = 0; + ctx->length[1] = 0; +} + +void SHA512_add_data(struct SHA512Context * ctx, unsigned char * data, + unsigned long len) +{ + u64 t; + + /* Update length */ + t = ctx->length[1]; + if ((ctx->length[1] = t + (u64) (len << 3)) < t) + ctx->length[0]++; /* carry from low 64 bits to high 64 bits */ + ctx->length[0] += (u64) len >> 61; + + /* If data was left in buffer, pad it with fresh data and munge block */ + if (ctx->numbytes != 0) { + unsigned long l = 128 - ctx->numbytes; + if (len < l) { + memcpy(ctx->buffer + ctx->numbytes, data, len); + ctx->numbytes += len; + return; + } + memcpy(ctx->buffer + ctx->numbytes, data, l); + SHA512_transform(ctx); + data += l; + len -= l; + } + /* Munge data in 128-byte chunks */ + while (len >= 128) { + memcpy(ctx->buffer, data, 128); + SHA512_transform(ctx); + data += 128; + len -= 128; + } + /* Save remaining data */ + memcpy(ctx->buffer, data, len); + ctx->numbytes = len; +} + +void SHA512_finish(struct SHA512Context * ctx, int bitsize, + unsigned char * output) +{ + int i = ctx->numbytes; + + /* Set first char of padding to 0x80. There is always room. */ + ctx->buffer[i++] = 0x80; + /* If we do not have room for the length (8 bytes), pad to 64 bytes + with zeroes and munge the data block */ + if (i > 112) { + memset(ctx->buffer + i, 0, 128 - i); + SHA512_transform(ctx); + i = 0; + } + /* Pad to byte 112 with zeroes */ + memset(ctx->buffer + i, 0, 112 - i); + /* Add length in big-endian */ + SHA512_copy_and_swap(ctx->length, ctx->buffer + 112, 2); + /* Munge the final block */ + SHA512_transform(ctx); + /* Final hash value is in ctx->state modulo big-endian conversion */ + switch (bitsize) { + case 512: + SHA512_copy_and_swap(ctx->state, output, 8); + break; + case 384: + SHA512_copy_and_swap(ctx->state, output, 6); + break; + /* default: The bit size is wrong. Produce no output. */ + } +} diff --git a/src/sha512.h b/src/sha512.h new file mode 100644 index 0000000..2c14239 --- /dev/null +++ b/src/sha512.h @@ -0,0 +1,37 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2015 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: sha256.h 53 2010-08-30 10:53:00Z gildor-admin $ */ + +/* SHA-512 hashing */ + +#ifndef _MSC_VER +#include +typedef uint64_t u64; +#else +typedef unsigned __int64 u64; +#define UINT64_C(x) x##ui64 +#endif + +struct SHA512Context { + u64 state[8]; + u64 length[2]; + int numbytes; + unsigned char buffer[128]; +}; + +extern void SHA512_init(struct SHA512Context * ctx, int bitsize); +extern void SHA512_add_data(struct SHA512Context * ctx, unsigned char * data, + unsigned long len); +extern void SHA512_finish(struct SHA512Context * ctx, int bitsize, + unsigned char * output); diff --git a/src/stubs-aes.c b/src/stubs-aes.c new file mode 100644 index 0000000..39a0ca3 --- /dev/null +++ b/src/stubs-aes.c @@ -0,0 +1,96 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code for AES */ + +#include "rijndael-alg-fst.h" +#include "aesni.h" +#include +#include +#include + +#define Cooked_key_NR_offset ((4 * (MAXNR + 1)) * sizeof(u32)) +#define Cooked_key_size (Cooked_key_NR_offset + 1) + +CAMLprim value caml_aes_cook_encrypt_key(value key) +{ + CAMLparam1(key); + value ckey = alloc_string(Cooked_key_size); + int nr; + + if (aesni_available == -1) aesni_check_available(); + if (aesni_available == 1) + nr = aesniKeySetupEnc((u8 *) String_val(ckey), + (const u8 *) String_val(key), + 8 * string_length(key)); + else + nr = rijndaelKeySetupEnc((u32 *) String_val(ckey), + (const u8 *) String_val(key), + 8 * string_length(key)); + Byte(ckey, Cooked_key_NR_offset) = nr; + CAMLreturn(ckey); +} + +CAMLprim value caml_aes_cook_decrypt_key(value key) +{ + CAMLparam1(key); + value ckey = alloc_string(Cooked_key_size); + int nr; + + if (aesni_available == -1) aesni_check_available(); + if (aesni_available == 1) + nr = aesniKeySetupDec((u8 *) String_val(ckey), + (const u8 *) String_val(key), + 8 * string_length(key)); + else + nr = rijndaelKeySetupDec((u32 *) String_val(ckey), + (const u8 *) String_val(key), + 8 * string_length(key)); + Byte(ckey, Cooked_key_NR_offset) = nr; + CAMLreturn(ckey); +} + +CAMLprim value caml_aes_encrypt(value ckey, value src, value src_ofs, + value dst, value dst_ofs) +{ + if (aesni_available == 1) + aesniEncrypt((const u8 *) String_val(ckey), + Byte(ckey, Cooked_key_NR_offset), + (const u8 *) &Byte(src, Long_val(src_ofs)), + (u8 *) &Byte(dst, Long_val(dst_ofs))); + else + rijndaelEncrypt((const u32 *) String_val(ckey), + Byte(ckey, Cooked_key_NR_offset), + (const u8 *) &Byte(src, Long_val(src_ofs)), + (u8 *) &Byte(dst, Long_val(dst_ofs))); + return Val_unit; +} + +CAMLprim value caml_aes_decrypt(value ckey, value src, value src_ofs, + value dst, value dst_ofs) +{ + if (aesni_available == 1) + aesniDecrypt((const u8 *) String_val(ckey), + Byte(ckey, Cooked_key_NR_offset), + (const u8 *) &Byte(src, Long_val(src_ofs)), + (u8 *) &Byte(dst, Long_val(dst_ofs))); + else + rijndaelDecrypt((const u32 *) String_val(ckey), + Byte(ckey, Cooked_key_NR_offset), + (const u8 *) &Byte(src, Long_val(src_ofs)), + (u8 *) &Byte(dst, Long_val(dst_ofs))); + return Val_unit; +} + diff --git a/src/stubs-arcfour.c b/src/stubs-arcfour.c new file mode 100644 index 0000000..c29e99c --- /dev/null +++ b/src/stubs-arcfour.c @@ -0,0 +1,50 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code for ARC4 */ + +#include "arcfour.h" +#include +#include +#include + +#define Cooked_key_size (sizeof(struct arcfour_key)) +#define Key_val(v) ((struct arcfour_key *) String_val(v)) + +CAMLprim value caml_arcfour_cook_key(value key) +{ + CAMLparam1(key); + value ckey = alloc_string(Cooked_key_size); + arcfour_cook_key(Key_val(ckey), + (unsigned char *) String_val(key), + string_length(key)); + CAMLreturn(ckey); +} + +CAMLprim value caml_arcfour_transform(value ckey, value src, value src_ofs, + value dst, value dst_ofs, value len) +{ + arcfour_encrypt(Key_val(ckey), + &Byte(src, Long_val(src_ofs)), + &Byte(dst, Long_val(dst_ofs)), + Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_arcfour_transform_bytecode(value * argv, int argc) +{ + return caml_arcfour_transform(argv[0], argv[1], argv[2], + argv[3], argv[4], argv[5]); +} diff --git a/src/stubs-blowfish.c b/src/stubs-blowfish.c new file mode 100644 index 0000000..d2eb2a1 --- /dev/null +++ b/src/stubs-blowfish.c @@ -0,0 +1,78 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2006 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code for Blowfish */ + +#include "blowfish.h" +#include +#include +#include + +CAMLprim value caml_blowfish_cook_key(value key) +{ + CAMLparam1(key); + value ckey = alloc_string(sizeof(BLOWFISH_CTX)); + Blowfish_Init((BLOWFISH_CTX *) String_val(ckey), + &Byte_u(key, 0), + caml_string_length(key)); + CAMLreturn(ckey); +} + +#ifdef ARCH_BIG_ENDIAN +#define COPY4BYTES(dst,src) \ + (dst)[0] = (src)[0], \ + (dst)[1] = (src)[1], \ + (dst)[2] = (src)[2], \ + (dst)[3] = (src)[3] +#else +#define COPY4BYTES(dst,src) \ + (dst)[0] = (src)[3], \ + (dst)[1] = (src)[2], \ + (dst)[2] = (src)[1], \ + (dst)[3] = (src)[0] +#endif + +CAMLprim value caml_blowfish_encrypt(value ckey, value src, value src_ofs, + value dst, value dst_ofs) +{ + u32 xl, xr; + unsigned char * p; + + p = &Byte_u(src, Long_val(src_ofs)); + COPY4BYTES((unsigned char *) &xl, p); + COPY4BYTES((unsigned char *) &xr, p + 4); + Blowfish_Encrypt((BLOWFISH_CTX *) String_val(ckey), &xl, &xr); + p = &Byte_u(dst, Long_val(dst_ofs)); + COPY4BYTES(p, (unsigned char *) &xl); + COPY4BYTES(p + 4, (unsigned char *) &xr); + return Val_unit; +} + +CAMLprim value caml_blowfish_decrypt(value ckey, value src, value src_ofs, + value dst, value dst_ofs) +{ + u32 xl, xr; + unsigned char * p; + + p = &Byte_u(src, Long_val(src_ofs)); + COPY4BYTES((unsigned char *) &xl, p); + COPY4BYTES((unsigned char *) &xr, p + 4); + Blowfish_Decrypt((BLOWFISH_CTX *) String_val(ckey), &xl, &xr); + p = &Byte_u(dst, Long_val(dst_ofs)); + COPY4BYTES(p, (unsigned char *) &xl); + COPY4BYTES(p + 4, (unsigned char *) &xr); + return Val_unit; +} + diff --git a/src/stubs-chacha20.c b/src/stubs-chacha20.c new file mode 100644 index 0000000..2d062aa --- /dev/null +++ b/src/stubs-chacha20.c @@ -0,0 +1,58 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* Stub code for Chacha20 */ + +#include "chacha20.h" +#include +#include +#include + +#define Cooked_key_size (sizeof(chacha20_ctx)) +#define Key_val(v) ((chacha20_ctx *) String_val(v)) + +CAMLprim value caml_chacha20_cook_key(value key, value iv, value counter) +{ + CAMLparam2(key, iv); + value ckey = alloc_string(Cooked_key_size); + chacha20_init(Key_val(ckey), + (unsigned char *) String_val(key), caml_string_length(key), + (unsigned char *) String_val(iv), Int64_val(counter)); + CAMLreturn(ckey); +} + +CAMLprim value caml_chacha20_transform(value ckey, value src, value src_ofs, + value dst, value dst_ofs, value len) +{ + chacha20_transform(Key_val(ckey), + &Byte_u(src, Long_val(src_ofs)), + &Byte_u(dst, Long_val(dst_ofs)), + Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_chacha20_transform_bytecode(value * argv, int argc) +{ + return caml_chacha20_transform(argv[0], argv[1], argv[2], + argv[3], argv[4], argv[5]); +} + +CAMLprim value caml_chacha20_extract(value ckey, + value dst, value dst_ofs, value len) +{ + chacha20_extract(Key_val(ckey), + &Byte_u(dst, Long_val(dst_ofs)), + Long_val(len)); + return Val_unit; +} + diff --git a/src/stubs-des.c b/src/stubs-des.c new file mode 100644 index 0000000..7db3168 --- /dev/null +++ b/src/stubs-des.c @@ -0,0 +1,43 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code for DES */ + +#include "d3des.h" +#include +#include +#include + +#define Cooked_key_size (32 * sizeof(u32)) + +CAMLprim value caml_des_cook_key(value key, value ofs, value direction) +{ + CAMLparam2(key,direction); + value ckey = alloc_string(Cooked_key_size); + d3des_cook_key((u8 *) &Byte(key, Long_val(ofs)), + Int_val(direction), + (u32 *) String_val(ckey)); + CAMLreturn(ckey); +} + +CAMLprim value caml_des_transform(value ckey, value src, value src_ofs, + value dst, value dst_ofs) +{ + d3des_transform((u32 *) String_val(ckey), + (u8 *) &Byte(src, Long_val(src_ofs)), + (u8 *) &Byte(dst, Long_val(dst_ofs))); + return Val_unit; +} + diff --git a/src/stubs-md5.c b/src/stubs-md5.c new file mode 100644 index 0000000..4033321 --- /dev/null +++ b/src/stubs-md5.c @@ -0,0 +1,62 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include +#include +#include + +#ifndef _MSC_VER +#include +typedef uint32_t u32; +#else +typedef unsigned int u32; +#endif + +struct MD5Context { + u32 buf[4]; + u32 bits[2]; + unsigned char in[64]; +}; + +CAMLextern void caml_MD5Init (struct MD5Context *context); +CAMLextern void caml_MD5Update (struct MD5Context *context, + unsigned char *buf, unsigned len); +CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx); + +#define Context_val(v) ((struct MD5Context *) String_val(v)) + +CAMLprim value caml_md5_init(value unit) +{ + value ctx = alloc_string(sizeof(struct MD5Context)); + caml_MD5Init(Context_val(ctx)); + return ctx; +} + +CAMLprim value caml_md5_update(value ctx, value src, value ofs, value len) +{ + caml_MD5Update(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_md5_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(16); + caml_MD5Final(&Byte_u(res, 0), Context_val(ctx)); + CAMLreturn(res); +} + diff --git a/src/stubs-misc.c b/src/stubs-misc.c new file mode 100644 index 0000000..8decda1 --- /dev/null +++ b/src/stubs-misc.c @@ -0,0 +1,58 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include +#include + +#define ALIGNMENT_OF(x) ((long)(x) & (sizeof(long) - 1)) + +CAMLprim value caml_xor_string(value src, value src_ofs, + value dst, value dst_ofs, + value len) +{ + char * s = &Byte(src, Long_val(src_ofs)); + char * d = &Byte(dst, Long_val(dst_ofs)); + long l = Long_val(len); + + if (l >= 64 && ALIGNMENT_OF(s) == ALIGNMENT_OF(d)) { + while (ALIGNMENT_OF(s) != 0 && l > 0) { + *d ^= *s; + s += 1; + d += 1; + l -= 1; + } + while (l >= sizeof(long)) { + *((long *) d) ^= *((long *) s); + s += sizeof(long); + d += sizeof(long); + l -= sizeof(long); + } + } + while (l > 0) { + *d ^= *s; + s += 1; + d += 1; + l -= 1; + } + return Val_unit; +} + +CAMLprim value caml_wipe_z(value v) +{ + if (Is_block(v) && Tag_val(v) == Custom_tag) { + memset(Data_custom_val(v), 0, (Wosize_val(v) - 1) * sizeof(value)); + } + return Val_unit; +} diff --git a/src/stubs-ripemd160.c b/src/stubs-ripemd160.c new file mode 100644 index 0000000..b1f365e --- /dev/null +++ b/src/stubs-ripemd160.c @@ -0,0 +1,45 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2005 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "ripemd160.h" +#include +#include +#include + +#define Context_val(v) ((struct RIPEMD160Context *) String_val(v)) + +CAMLprim value caml_ripemd160_init(value unit) +{ + value ctx = alloc_string(sizeof(struct RIPEMD160Context)); + RIPEMD160_init(Context_val(ctx)); + return ctx; +} + +CAMLprim value caml_ripemd160_update(value ctx, value src, value ofs, value len) +{ + RIPEMD160_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_ripemd160_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(20); + RIPEMD160_finish(Context_val(ctx), &Byte_u(res, 0)); + CAMLreturn(res); +} + diff --git a/src/stubs-rng.c b/src/stubs-rng.c new file mode 100644 index 0000000..7d07f72 --- /dev/null +++ b/src/stubs-rng.c @@ -0,0 +1,144 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2003 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code for the system-provided RNG and for hardware RNG */ + +#include +#include +#include +#include + +/* Win32 system RNG */ + +#ifdef _WIN32 + +/* Inspired by Mike Lin's port of Cryptokit 1.0 */ + +#define _WIN32_WINNT 0x0400 +#define WIN32_LEAN_AND_MEAN +#include +#include +#ifndef CRYPT_SILENT +#define CRYPT_SILENT 0 +#endif + +#define HCRYPTPROV_val(v) (*((HCRYPTPROV *) &Field(v, 0))) + +CAMLprim value caml_get_system_rng(value unit) +{ + HCRYPTPROV prov; + value res; + + if (! CryptAcquireContext(&prov, NULL, NULL, PROV_RSA_FULL, + CRYPT_VERIFYCONTEXT | CRYPT_SILENT)) + raise_not_found(); + res = alloc((sizeof(HCRYPTPROV) + sizeof(value) - 1) / sizeof(value), + Abstract_tag); + HCRYPTPROV_val(res) = prov; + return res; +} + +CAMLprim value caml_close_system_rng(value vhc) +{ + CryptReleaseContext(HCRYPTPROV_val(vhc), 0); + return Val_unit; +} + +CAMLprim value caml_system_rng_random_bytes(value vhc, value str, + value ofs, value len) +{ + return Val_bool(CryptGenRandom(HCRYPTPROV_val(vhc), + Long_val(len), + &Byte(str, Long_val(ofs)))); +} + +#else + +CAMLprim value caml_get_system_rng(value unit) +{ + raise_not_found(); + return Val_unit; /* not reached */ +} + +CAMLprim value caml_close_system_rng(value vhc) +{ + return Val_unit; +} + +CAMLprim value caml_system_rng_random_bytes(value vhc, value str, + value ofs, value len) +{ + return Val_false; +} + +#endif + +/* Intel RDRAND instruction */ + +#if defined(__GNUC__) && defined(__x86_64) + +#include +#include + +CAMLprim value caml_hardware_rng_available(value unit) +{ + uint32_t ax, bx, cx, dx; + __asm__ __volatile__ ("cpuid" + : "=a" (ax), "=b" (bx), "=c" (cx), "=d" (dx) + : "a" (1)); + return Val_bool(cx & (1U << 30)); +} + +static inline int rdrand64(uint64_t * res) +{ + uint64_t n; + unsigned char ok; + int retries; + + for (retries = 0; retries < 20; retries++) { + __asm__ __volatile__ ("rdrand %0; setc %1" : "=r" (n), "=qm" (ok)); + if (ok) { *res = n; return 1; } + } + return 0; +} + +CAMLprim value caml_hardware_rng_random_bytes(value str, value ofs, value len) +{ + unsigned char * dst = &Byte_u(str, Long_val(ofs)); + intnat nbytes = Long_val(len); + uint64_t r, rr; + + while (nbytes >= 8) { + if (! rdrand64(&r)) return Val_false; + *((uint64_t *) dst) = r; + dst += 8; + nbytes -= 8; + } + if (nbytes > 0) { + if (! rdrand64(&rr)) return Val_false; + memcpy(dst, &rr, nbytes); + } + return Val_true; +} + +#else + +CAMLprim value caml_hardware_rng_available(value unit) +{ return Val_false; } + +CAMLprim value caml_hardware_rng_random_bytes(value str, value ofs, value len) +{ return Val_false; } + +#endif diff --git a/src/stubs-sha1.c b/src/stubs-sha1.c new file mode 100644 index 0000000..88e9d63 --- /dev/null +++ b/src/stubs-sha1.c @@ -0,0 +1,45 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "sha1.h" +#include +#include +#include + +#define Context_val(v) ((struct SHA1Context *) String_val(v)) + +CAMLprim value caml_sha1_init(value unit) +{ + value ctx = alloc_string(sizeof(struct SHA1Context)); + SHA1_init(Context_val(ctx)); + return ctx; +} + +CAMLprim value caml_sha1_update(value ctx, value src, value ofs, value len) +{ + SHA1_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_sha1_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(20); + SHA1_finish(Context_val(ctx), &Byte_u(res, 0)); + CAMLreturn(res); +} + diff --git a/src/stubs-sha256.c b/src/stubs-sha256.c new file mode 100644 index 0000000..bac8686 --- /dev/null +++ b/src/stubs-sha256.c @@ -0,0 +1,63 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "sha256.h" +#include +#include +#include + +#define Context_val(v) ((struct SHA256Context *) String_val(v)) + +CAMLprim value caml_sha256_init(value unit) +{ + value ctx = alloc_string(sizeof(struct SHA256Context)); + SHA256_init(Context_val(ctx), 256); + return ctx; +} + +CAMLprim value caml_sha224_init(value unit) +{ + value ctx = alloc_string(sizeof(struct SHA256Context)); + SHA256_init(Context_val(ctx), 224); + return ctx; +} + +CAMLprim value caml_sha256_update(value ctx, value src, value ofs, value len) +{ + SHA256_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_sha256_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(32); + SHA256_finish(Context_val(ctx), 256, &Byte_u(res, 0)); + CAMLreturn(res); +} + +CAMLprim value caml_sha224_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(28); + SHA256_finish(Context_val(ctx), 224, &Byte_u(res, 0)); + CAMLreturn(res); +} + + diff --git a/src/stubs-sha3.c b/src/stubs-sha3.c new file mode 100644 index 0000000..b496f73 --- /dev/null +++ b/src/stubs-sha3.c @@ -0,0 +1,90 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2013 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: stubs-sha1.c 53 2010-08-30 10:53:00Z gildor-admin $ */ + +#include +#include "keccak.h" +#include +#include +#include +#include + +#define Context_val(v) (*((struct SHA3Context **) Data_custom_val(v))) + +static void caml_sha3_finalize(value ctx) +{ + if (Context_val(ctx) != NULL) { + caml_stat_free(Context_val(ctx)); + Context_val(ctx) = NULL; + } +} + +static struct custom_operations SHA3_context_ops = { + "fr.inria.caml.cryptokit.SHA3_context", + caml_sha3_finalize, + custom_compare_default, + custom_hash_default, + custom_deserialize_default, + custom_compare_ext_default +}; + +CAMLprim value caml_sha3_init(value vsize) +{ + struct SHA3Context * ctx = caml_stat_alloc(sizeof(struct SHA3Context)); + value res = + caml_alloc_custom(&SHA3_context_ops, + sizeof(struct SHA3Context *), + 0, 1); + SHA3_init(ctx, Int_val(vsize)); + Context_val(res) = ctx; + return res; +} + +CAMLprim value caml_sha3_absorb(value ctx, + value src, value ofs, value len) +{ + SHA3_absorb(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + + +/* On page 9 of Keccak Implementation Overview (Version 3.2) + http://keccak.noekeon.org/Keccak-implementation-3.2.pdf, + there is a figure `0x01` as the padding byte. */ +static const unsigned keccak_padding = 0x01; + +/* In a similar, updated description at http://keccak.noekeon.org/specs_summary.html, + on Table 3, `0x06` is shown as the relevant padding byte. */ +static const unsigned sha3_padding = 0x06; + +CAMLprim value caml_sha3_extract(value official, value ctx) +{ + CAMLparam2(official, ctx); + CAMLlocal1(res); + + res = alloc_string(Context_val(ctx)->hsiz); + SHA3_extract(Bool_val(official) ? sha3_padding : keccak_padding, Context_val(ctx), &Byte_u(res, 0)); + CAMLreturn(res); +} + +CAMLprim value caml_sha3_wipe(value ctx) +{ + if (Context_val(ctx) != NULL) { + memset(Context_val(ctx), 0, sizeof(struct SHA3Context)); + caml_stat_free(Context_val(ctx)); + Context_val(ctx) = NULL; + } + return Val_unit; +} + diff --git a/src/stubs-sha512.c b/src/stubs-sha512.c new file mode 100644 index 0000000..f762694 --- /dev/null +++ b/src/stubs-sha512.c @@ -0,0 +1,62 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2015 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id: stubs-sha256.c 53 2010-08-30 10:53:00Z gildor-admin $ */ + +#include "sha512.h" +#include +#include +#include + +#define Context_val(v) ((struct SHA512Context *) String_val(v)) + +CAMLprim value caml_sha512_init(value unit) +{ + value ctx = alloc_string(sizeof(struct SHA512Context)); + SHA512_init(Context_val(ctx), 512); + return ctx; +} + +CAMLprim value caml_sha384_init(value unit) +{ + value ctx = alloc_string(sizeof(struct SHA512Context)); + SHA512_init(Context_val(ctx), 384); + return ctx; +} + +CAMLprim value caml_sha512_update(value ctx, value src, value ofs, value len) +{ + SHA512_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); + return Val_unit; +} + +CAMLprim value caml_sha512_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(64); + SHA512_finish(Context_val(ctx), 512, &Byte_u(res, 0)); + CAMLreturn(res); +} + +CAMLprim value caml_sha384_final(value ctx) +{ + CAMLparam1(ctx); + CAMLlocal1(res); + + res = alloc_string(48); + SHA512_finish(Context_val(ctx), 384, &Byte_u(res, 0)); + CAMLreturn(res); +} + diff --git a/src/stubs-zlib.c b/src/stubs-zlib.c new file mode 100644 index 0000000..fd011e0 --- /dev/null +++ b/src/stubs-zlib.c @@ -0,0 +1,229 @@ +/***********************************************************************/ +/* */ +/* The Cryptokit library */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Stub code to interface with Zlib */ + +#ifdef HAVE_ZLIB +#include +#endif + +#include +#include +#include +#include +#include + +static value * caml_zlib_error_exn = NULL; + +#ifdef HAVE_ZLIB + +#define ZStream_val(v) ((z_stream *) (v)) + +static void caml_zlib_error(char * fn, value vzs) +{ + char * msg; + value s1 = Val_unit, s2 = Val_unit, tuple = Val_unit, bucket = Val_unit; + + msg = ZStream_val(vzs)->msg; + if (msg == NULL) msg = ""; + if (caml_zlib_error_exn == NULL) { + caml_zlib_error_exn = caml_named_value("Cryptokit.Error"); + if (caml_zlib_error_exn == NULL) + invalid_argument("Exception Cryptokit.Error not initialized"); + } + Begin_roots4(s1, s2, tuple, bucket); + s1 = copy_string(fn); + s2 = copy_string(msg); + tuple = alloc_small(2, 0); + Field(tuple, 0) = s1; + Field(tuple, 1) = s2; + bucket = alloc_small(2, 0); + Field(bucket, 0) = *caml_zlib_error_exn; + Field(bucket, 1) = tuple; + End_roots(); + mlraise(bucket); +} + +static value caml_zlib_new_stream(void) +{ + value res = alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value), + Abstract_tag); + ZStream_val(res)->zalloc = NULL; + ZStream_val(res)->zfree = NULL; + ZStream_val(res)->opaque = NULL; + ZStream_val(res)->next_in = NULL; + ZStream_val(res)->next_out = NULL; + return res; +} + +CAMLprim +value caml_zlib_deflateInit(value vlevel, value expect_header) +{ + value vzs = caml_zlib_new_stream(); + if (deflateInit2(ZStream_val(vzs), + Int_val(vlevel), + Z_DEFLATED, + Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS, + 8, + Z_DEFAULT_STRATEGY) != Z_OK) + caml_zlib_error("Zlib.deflateInit", vzs); + return vzs; +} + +static int caml_zlib_flush_table[] = +{ Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FULL_FLUSH, Z_FINISH }; + +CAMLprim +value caml_zlib_deflate(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen, + value vflush) +{ + z_stream * zs = ZStream_val(vzs); + int retcode; + long used_in, used_out; + value res; + + zs->next_in = &Byte_u(srcbuf, Long_val(srcpos)); + zs->avail_in = Long_val(srclen); + zs->next_out = &Byte_u(dstbuf, Long_val(dstpos)); + zs->avail_out = Long_val(dstlen); + retcode = deflate(zs, caml_zlib_flush_table[Int_val(vflush)]); + if (retcode < 0) caml_zlib_error("Zlib.deflate", vzs); + used_in = Long_val(srclen) - zs->avail_in; + used_out = Long_val(dstlen) - zs->avail_out; + zs->next_in = NULL; /* not required, but cleaner */ + zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ + res = alloc_small(3, 0); + Field(res, 0) = Val_bool(retcode == Z_STREAM_END); + Field(res, 1) = Val_int(used_in); + Field(res, 2) = Val_int(used_out); + return res; +} + +CAMLprim +value caml_zlib_deflateEnd(value vzs) +{ + if (deflateEnd(ZStream_val(vzs)) != Z_OK) + caml_zlib_error("Zlib.deflateEnd", vzs); + return Val_unit; +} + +CAMLprim +value caml_zlib_inflateInit(value expect_header) +{ + value vzs = caml_zlib_new_stream(); + if (inflateInit2(ZStream_val(vzs), + Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS) != Z_OK) + caml_zlib_error("Zlib.inflateInit", vzs); + return vzs; +} + +CAMLprim +value caml_zlib_inflate(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen, + value vflush) +{ + z_stream * zs = ZStream_val(vzs); + int retcode; + long used_in, used_out; + value res; + + zs->next_in = &Byte_u(srcbuf, Long_val(srcpos)); + zs->avail_in = Long_val(srclen); + zs->next_out = &Byte_u(dstbuf, Long_val(dstpos)); + zs->avail_out = Long_val(dstlen); + retcode = inflate(zs, caml_zlib_flush_table[Int_val(vflush)]); + if (retcode < 0 || retcode == Z_NEED_DICT) + caml_zlib_error("Zlib.inflate", vzs); + used_in = Long_val(srclen) - zs->avail_in; + used_out = Long_val(dstlen) - zs->avail_out; + zs->next_in = NULL; /* not required, but cleaner */ + zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ + res = alloc_small(3, 0); + Field(res, 0) = Val_bool(retcode == Z_STREAM_END); + Field(res, 1) = Val_int(used_in); + Field(res, 2) = Val_int(used_out); + return res; +} + +CAMLprim +value caml_zlib_inflateEnd(value vzs) +{ + if (inflateEnd(ZStream_val(vzs)) != Z_OK) + caml_zlib_error("Zlib.inflateEnd", vzs); + return Val_unit; +} + +#else + +static void caml_zlib_not_supported(void) +{ + value bucket; + if (caml_zlib_error_exn == NULL) { + caml_zlib_error_exn = caml_named_value("Cryptokit.Error"); + if (caml_zlib_error_exn == NULL) + invalid_argument("Exception Cryptokit.Error not initialized"); + } + bucket = alloc_small(2, 0); + Field(bucket, 0) = *caml_zlib_error_exn; + Field(bucket, 1) = Val_int(12); /* Compression_not_supported */ + mlraise(bucket); +} + +CAMLprim +value caml_zlib_deflateInit(value vlevel, value expect_header) +{ caml_zlib_not_supported(); return Val_unit; } + +CAMLprim +value caml_zlib_deflate(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen, + value vflush) +{ caml_zlib_not_supported(); return Val_unit; } + +CAMLprim +value caml_zlib_deflateEnd(value vzs) +{ caml_zlib_not_supported(); return Val_unit; } + +CAMLprim +value caml_zlib_inflateInit(value expect_header) +{ caml_zlib_not_supported(); return Val_unit; } + +CAMLprim +value caml_zlib_inflate(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen, + value vflush) +{ caml_zlib_not_supported(); return Val_unit; } + +CAMLprim +value caml_zlib_inflateEnd(value vzs) +{ caml_zlib_not_supported(); return Val_unit; } + +#endif + +CAMLprim +value caml_zlib_deflate_bytecode(value * arg, int nargs) +{ + return caml_zlib_deflate(arg[0], arg[1], arg[2], arg[3], + arg[4], arg[5], arg[6], arg[7]); +} + +CAMLprim +value caml_zlib_inflate_bytecode(value * arg, int nargs) +{ + return caml_zlib_inflate(arg[0], arg[1], arg[2], arg[3], + arg[4], arg[5], arg[6], arg[7]); +} + + diff --git a/test/prngtest.ml b/test/prngtest.ml new file mode 100644 index 0000000..b6fb6a3 --- /dev/null +++ b/test/prngtest.ml @@ -0,0 +1,49 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* Generate pseudorandom data on stdout, for testing with "dieharder" *) + +open Cryptokit + +let output_pr_data rng = + let b = Bytes.create 64 in + while true do + rng#random_bytes b 0 64; + output stdout b 0 64 + done + +let usage() = + prerr_string {|Usage: + ./prngtest.native aes-ctr | dieharder -a -g 200 + ./prngtest.native chacha20 | dieharder -a -g 200 + ./prngtest.native hardware | dieharder -a -g 200 +Warning: each dieharder run takes a long time. +|}; + exit 2 + +let _ = + let seed = + if Array.length Sys.argv > 2 + then Sys.argv.(2) + else "Supercalifragilistusexpialidolcius" in + let rng = + if Array.length Sys.argv > 1 then begin + match Sys.argv.(1) with + | "aes-ctr" -> Random.pseudo_rng_aes_ctr seed + | "chacha20" -> Random.pseudo_rng seed + | "hardware" -> Random.hardware_rng () + | _ -> usage() + end else usage() in + output_pr_data rng + + diff --git a/test/speedtest.ml b/test/speedtest.ml new file mode 100644 index 0000000..0552d90 --- /dev/null +++ b/test/speedtest.ml @@ -0,0 +1,141 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Performance measurement *) + +open Cryptokit + +let time_fn msg fn = + let start = Sys.time() in + let res = fn() in + let stop = Sys.time() in + Printf.printf "%6.2f %s\n" (stop -. start) msg; + flush stdout; + res + +let rec repeat n fn () = + if n <= 1 then fn() else (ignore(fn()); repeat (n-1) fn ()) + +let raw_block_cipher cipher niter () = + let msg = Bytes.create cipher#blocksize in + for i = 1 to niter do + cipher#transform msg 0 msg 0 + done + +let raw_stream_cipher cipher niter blocksize () = + let msg = Bytes.create blocksize in + for i = 1 to niter do + cipher#transform msg 0 msg 0 blocksize + done + +let transform tr niter blocksize () = + let msg = Bytes.create blocksize in + for i = 1 to niter do + tr#put_substring msg 0 blocksize; ignore(tr#get_substring) + done + +let hash h niter blocksize () = + let msg = Bytes.create blocksize in + for i = 1 to niter do + h#add_substring msg 0 blocksize + done; + ignore(h#result) + +let rng r niter blocksize () = + let buf = Bytes.create blocksize in + for i = 1 to niter do + r#random_bytes buf 0 blocksize + done + +let _ = + time_fn "Raw AES 128, 64_000_000 bytes" + (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF") 4000000); + time_fn "Raw AES 192, 64_000_000 bytes" + (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF01234567") 4000000); + time_fn "Raw AES 256, 64_000_000 bytes" + (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF0123456789ABCDEF") 4000000); + time_fn "Raw DES, 16_000_000 bytes" + (raw_block_cipher (new Block.des_encrypt "01234567") 2000000); + time_fn "Raw 3DES, 16_000_000 bytes" + (raw_block_cipher (new Block.triple_des_encrypt "0123456789ABCDEF") 2000000); + time_fn "Raw ARCfour, 64_000_000 bytes, 16-byte chunks" + (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 4000000 16); + time_fn "Raw ARCfour, 64_000_000 bytes, 64-byte chunks" + (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 1000000 64); + time_fn "Raw Chacha20, 64_000_000 bytes, 16-byte chunks" + (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 4000000 16); + time_fn "Raw Chacha20, 64_000_000 bytes, 64-byte chunks" + (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 1000000 64); + time_fn "Raw Blowfish 128, 64_000_000 bytes" + (raw_block_cipher (new Block.blowfish_encrypt "0123456789ABCDEF") 8000000); + time_fn "Wrapped AES 128 CBC, 64_000_000 bytes" + (transform (Cipher.aes "0123456789ABCDEF" Cipher.Encrypt) 4000000 16); + time_fn "Wrapped AES 192 CBC, 64_000_000 bytes" + (transform (Cipher.aes "0123456789ABCDEF01234567" Cipher.Encrypt) 4000000 16); + time_fn "Wrapped AES 256 CBC, 64_000_000 bytes" + (transform (Cipher.aes "0123456789ABCDEF0123456789ABCDEF" Cipher.Encrypt) 4000000 16); + time_fn "Wrapped DES CBC, 16_000_000 bytes" + (transform (Cipher.des "01234567" Cipher.Encrypt) 1000000 16); + time_fn "Wrapped 3DES CBC, 16_000_000 bytes" + (transform (Cipher.triple_des "0123456789ABCDEF" Cipher.Encrypt) 1000000 16); + time_fn "Wrapped ARCfour, 64_000_000 bytes" + (transform (Cipher.arcfour "0123456789ABCDEF" Cipher.Encrypt) 4000000 16); + time_fn "Wrapped Chacha20, 64_000_000 bytes" + (transform (Cipher.chacha20 "0123456789ABCDEF" Cipher.Encrypt) 4000000 16); + time_fn "Wrapped Blowfish 128 CBC, 64_000_000 bytes" + (transform (Cipher.blowfish "0123456789ABCDEF" Cipher.Encrypt) 4000000 16); + time_fn "SHA-1, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha1()) 4000000 16); + time_fn "SHA-256, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha256()) 4000000 16); + time_fn "SHA-3 224, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha3 224) 4000000 16); + time_fn "SHA-3 256, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha3 256) 4000000 16); + time_fn "SHA-3 384, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha3 384) 4000000 16); + time_fn "SHA-3 512, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha3 512) 4000000 16); + time_fn "RIPEMD-160, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.sha256()) 4000000 16); + time_fn "MD5, 64_000_000 bytes, 16-byte chunks" + (hash (Hash.md5()) 4000000 16); + time_fn "AES CMAC, 64_000_000 bytes, 16-byte chunks" + (hash (MAC.aes_cmac "0123456789ABCDEF") 4000000 16); + time_fn "HMAC-SHA1, 64_000_000 bytes, 16-byte chunks" + (hash (MAC.hmac_sha1 "0123456789ABCDEF") 4000000 16); + let prng = Random.pseudo_rng "supercalifragilistusexpialidolcius" in + let key = + time_fn "RSA key generation (2048 bits) x 10" + (repeat 10 (fun () -> RSA.new_key ~rng:prng ~e:65537 2048)) in + let plaintext = "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" in + let ciphertext = + time_fn "RSA public-key operation (2048 bits, exponent 65537) x 1000" + (repeat 1000 (fun () -> RSA.encrypt key plaintext)) in + time_fn "RSA private-key operation (2048 bits) x 100" + (repeat 100 (fun () -> ignore(RSA.decrypt key ciphertext))); + time_fn "RSA private-key operation with CRT (2048 bits) x 100" + (repeat 100 (fun () -> ignore(RSA.decrypt_CRT key ciphertext))); + time_fn "PRNG, 64_000_000 bytes" + (rng prng 1000000 64); + time_fn "PRNG AES CTR, 64_000_000 bytes" + (rng (Random.pseudo_rng_aes_ctr "supercalifragilistusexpialidolcius") 1000000 64); + begin try + let hr = Random.hardware_rng () in + time_fn "Hardware RNG, 64_000_000 bytes" + (rng hr 1000000 64) + with Error No_entropy_source -> () + end; + () diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 0000000..8e3eba6 --- /dev/null +++ b/test/test.ml @@ -0,0 +1,959 @@ +(***********************************************************************) +(* *) +(* The Cryptokit library *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Test vectors *) + +open Printf +open Cryptokit + +(* Test harness *) + +let error_occurred = ref false + +let function_tested = ref "" + +let testing_function s = + function_tested := s; + print_newline(); + print_string s; + print_newline() + +let test test_number answer correct_answer = + flush stdout; + flush stderr; + if answer <> correct_answer then begin + eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number; + flush stderr; + error_occurred := true + end else begin + printf " %d..." test_number + end + +(* Useful auxiliaries *) + +let hex s = transform_string (Hexa.decode()) s +let hexbytes s = Bytes.of_string (hex s) +let tohex s = transform_string (Hexa.encode()) s + +(* Test hex conversion first... *) +let _ = + testing_function "Hex conversion"; + test 1 "6162636465666768696a6b6c6d6e6f70710a" + (tohex "abcdefghijklmnopq\n"); + test 2 "abcdefghijklmnopq\n" + (hex "616263 64656667 \n 68696a6b 6c6d6e6f\t70710a") + +(* Basic ciphers and hashes *) + +(* AES *) +let _ = + testing_function "AES"; + let res = Bytes.create 16 in + let do_test key plain cipher testno1 testno2 = + let c = new Block.aes_encrypt (hex key) + and d = new Block.aes_decrypt (hex key) in + let plain = hexbytes plain + and cipher = hexbytes cipher in + c#transform plain 0 res 0; test testno1 res cipher; + d#transform cipher 0 res 0; test testno2 res plain in + do_test + "000102030405060708090A0B0C0D0E0F" + "00112233445566778899AABBCCDDEEFF" + "69C4E0D86A7B0430D8CDB78070B4C55A" + 1 2; + do_test + "000102030405060708090A0B0C0D0E0F1011121314151617" + "00112233445566778899AABBCCDDEEFF" + "DDA97CA4864CDFE06EAF70A0EC0D7191" + 3 4; + do_test + "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" + "00112233445566778899AABBCCDDEEFF" + "8EA2B7CA516745BFEAFC49904B496089" + 5 6 + +(* Blowfish *) + +let _ = + testing_function "Blowfish"; + let res = Bytes.create 16 in + let do_test key plain cipher testno = + let c = new Block.blowfish_encrypt (hex key) + and d = new Block.blowfish_decrypt (hex key) in + let plain = hexbytes plain + and cipher = hexbytes cipher in + c#transform plain 0 res 0; + d#transform cipher 0 res 8; + test testno res (Bytes.cat cipher plain) in + do_test "0000000000000000" "0000000000000000" "4EF997456198DD78" 1; + do_test "FFFFFFFFFFFFFFFF" "FFFFFFFFFFFFFFFF" "51866FD5B85ECB8A" 2; + do_test "3000000000000000" "1000000000000001" "7D856F9A613063F2" 3; + do_test "1111111111111111" "1111111111111111" "2466DD878B963C9D" 4; + do_test "0123456789ABCDEF" "1111111111111111" "61F9C3802281B096" 5; + do_test "1111111111111111" "0123456789ABCDEF" "7D0CC630AFDA1EC7" 6; + do_test "0000000000000000" "0000000000000000" "4EF997456198DD78" 7; + do_test "FEDCBA9876543210" "0123456789ABCDEF" "0ACEAB0FC6A0A28D" 8; + do_test "7CA110454A1A6E57" "01A1D6D039776742" "59C68245EB05282B" 9; + do_test "0131D9619DC1376E" "5CD54CA83DEF57DA" "B1B8CC0B250F09A0" 10; + do_test "07A1133E4A0B2686" "0248D43806F67172" "1730E5778BEA1DA4" 11; + do_test "3849674C2602319E" "51454B582DDF440A" "A25E7856CF2651EB" 12; + do_test "04B915BA43FEB5B6" "42FD443059577FA2" "353882B109CE8F1A" 13; + do_test "0113B970FD34F2CE" "059B5E0851CF143A" "48F4D0884C379918" 14; + do_test "0170F175468FB5E6" "0756D8E0774761D2" "432193B78951FC98" 15; + do_test "43297FAD38E373FE" "762514B829BF486A" "13F04154D69D1AE5" 16; + do_test "07A7137045DA2A16" "3BDD119049372802" "2EEDDA93FFD39C79" 17; + do_test "04689104C2FD3B2F" "26955F6835AF609A" "D887E0393C2DA6E3" 18; + do_test "37D06BB516CB7546" "164D5E404F275232" "5F99D04F5B163969" 19; + do_test "1F08260D1AC2465E" "6B056E18759F5CCA" "4A057A3B24D3977B" 20; + do_test "584023641ABA6176" "004BD6EF09176062" "452031C1E4FADA8E" 21; + do_test "025816164629B007" "480D39006EE762F2" "7555AE39F59B87BD" 22; + do_test "49793EBC79B3258F" "437540C8698F3CFA" "53C55F9CB49FC019" 23; + do_test "4FB05E1515AB73A7" "072D43A077075292" "7A8E7BFA937E89A3" 24; + do_test "49E95D6D4CA229BF" "02FE55778117F12A" "CF9C5D7A4986ADB5" 25; + do_test "018310DC409B26D6" "1D9D5C5018F728C2" "D1ABB290658BC778" 26; + do_test "1C587F1C13924FEF" "305532286D6F295A" "55CB3774D13EF201" 27; + do_test "0101010101010101" "0123456789ABCDEF" "FA34EC4847B268B2" 28; + do_test "1F1F1F1F0E0E0E0E" "0123456789ABCDEF" "A790795108EA3CAE" 29; + do_test "E0FEE0FEF1FEF1FE" "0123456789ABCDEF" "C39E072D9FAC631D" 30; + do_test "0000000000000000" "FFFFFFFFFFFFFFFF" "014933E0CDAFF6E4" 31; + do_test "FFFFFFFFFFFFFFFF" "0000000000000000" "F21E9A77B71C49BC" 32; + do_test "0123456789ABCDEF" "0000000000000000" "245946885754369A" 33; + do_test "FEDCBA9876543210" "FFFFFFFFFFFFFFFF" "6B5C5A9C5D9E0A5A" 34 + +(* DES *) +let _ = + testing_function "DES"; + let res = Bytes.create 8 in + let c = new Block.des_encrypt (hex "0123456789abcdef") + and d = new Block.des_decrypt (hex "0123456789abcdef") in + let plain = hexbytes "0123456789abcde7" + and cipher = hexbytes "c95744256a5ed31d" in + c#transform plain 0 res 0; test 1 res cipher; + d#transform cipher 0 res 0; test 2 res plain; + let rec iter n key input = + if n <= 0 then key else begin + let c = new Block.des_encrypt key in + let t1 = Bytes.create 8 in c#transform input 0 t1 0; + let t2 = Bytes.create 8 in c#transform t1 0 t2 0; + let d = new Block.des_decrypt (Bytes.unsafe_to_string t2) in + let t3 = Bytes.create 8 in d#transform t1 0 t3 0; + iter (n-1) (Bytes.unsafe_to_string t3) t1 + end in + test 3 (iter 64 (hex "5555555555555555") + (hexbytes "ffffffffffffffff")) + (hex "246e9db9c550381a") + +(* Triple DES *) +let _ = + testing_function "Triple DES"; + let res = Bytes.create 8 in + let do_test key plain cipher testno1 testno2 = + let c = new Block.triple_des_encrypt (hex key) + and d = new Block.triple_des_decrypt (hex key) in + let plain = hexbytes plain + and cipher = hexbytes cipher in + c#transform plain 0 res 0; test testno1 res cipher; + d#transform cipher 0 res 0; test testno2 res plain in + do_test + "0123456789abcdeffedcba9876543210" + "0123456789abcde7" + "7f1d0a77826b8aff" + 1 2; + do_test + "0123456789abcdef0123456789abcdef" + "0123456789abcde7" + "c95744256a5ed31d" + 3 4; + do_test + "0123456789abcdeffedcba987654321089abcdef01234567" + "0123456789abcde7" + "de0b7c06ae5e0ed5" + 5 6 + +(* ARCfour *) + +let _ = + testing_function "ARCfour"; + let do_test n1 n2 key input output = + let key = hex key + and input = hexbytes input + and output = hexbytes output in + let c = new Stream.arcfour key in + let d = new Stream.arcfour key in + let res = Bytes.create (Bytes.length input) in + c#transform input 0 res 0 (Bytes.length input); + test n1 res output; + d#transform output 0 res 0 (Bytes.length output); + test n2 res input in + do_test 1 2 "0123456789abcdef" "0123456789abcdef" "75b7878099e0c596"; + do_test 3 4 "0123456789abcdef" "0000000000000000" "7494c2e7104b0879"; + do_test 5 6 "0000000000000000" "0000000000000000" "de188941a3375d3a"; + do_test 7 8 "ef012345" "00000000000000000000" "d6a141a7ec3c38dfbd61"; + let c2 = Cipher.arcfour "key" Cipher.Encrypt in + c2#put_string (String.make 1024 'x'); + test 9 c2#available_output 1024 + +(* Chacha20 *) + +let _ = + testing_function "Chacha20"; + let do_test n1 n2 key nonce plain cipher counter = + let key = hex key + and nonce = hex nonce + and plain = hexbytes plain + and cipher = hexbytes cipher in + let c = new Stream.chacha20 ~iv:nonce ~ctr:counter key in + let d = new Stream.chacha20 ~iv:nonce ~ctr:counter key in + let res = Bytes.create (Bytes.length plain) in + c#transform plain 0 res 0 (Bytes.length plain); + test n1 res cipher; + d#transform cipher 0 res 0 (Bytes.length cipher); + test n2 res plain in + do_test 1 2 + "0000000000000000000000000000000000000000000000000000000000000000" + "0000000000000000" + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" + "76b8e0ada0f13d90405d6ae55386bd28bdd219b8a08ded1aa836efcc8b770dc7da41597c5157488d7724e03fb8d84a376a43b8f41518a11cc387b669b2ee6586" + 0L; + do_test 3 4 + "0000000000000000000000000000000000000000000000000000000000000001" + "0000000000000002" + "416e79207375626d697373696f6e20746f20746865204945544620696e74656e6465642062792074686520436f6e7472696275746f7220666f72207075626c69636174696f6e20617320616c6c206f722070617274206f6620616e204945544620496e7465726e65742d4472616674206f722052464320616e6420616e792073746174656d656e74206d6164652077697468696e2074686520636f6e74657874206f6620616e204945544620616374697669747920697320636f6e7369646572656420616e20224945544620436f6e747269627574696f6e222e20537563682073746174656d656e747320696e636c756465206f72616c2073746174656d656e747320696e20494554462073657373696f6e732c2061732077656c6c206173207772697474656e20616e6420656c656374726f6e696320636f6d6d756e69636174696f6e73206d61646520617420616e792074696d65206f7220706c6163652c207768696368206172652061646472657373656420746f" + "a3fbf07df3fa2fde4f376ca23e82737041605d9f4f4f57bd8cff2c1d4b7955ec2a97948bd3722915c8f3d337f7d370050e9e96d647b7c39f56e031ca5eb6250d4042e02785ececfa4b4bb5e8ead0440e20b6e8db09d881a7c6132f420e52795042bdfa7773d8a9051447b3291ce1411c680465552aa6c405b7764d5e87bea85ad00f8449ed8f72d0d662ab052691ca66424bc86d2df80ea41f43abf937d3259dc4b2d0dfb48a6c9139ddd7f76966e928e635553ba76c5c879d7b35d49eb2e62b0871cdac638939e25e8a1e0ef9d5280fa8ca328b351c3c765989cbcf3daa8b6ccc3aaf9f3979c92b3720fc88dc95ed84a1be059c6499b9fda236e7e818b04b0bc39c1e876b193bfe5569753f88128cc08aaa9b63d1a16f80ef2554d7189c411f5869ca52c5b83fa36ff216b9c1d30062bebcfd2dc5bce0911934fda79a86f6e698ced759c3ff9b6477338f3da4f9cd8514ea9982ccafb341b2384dd902f3d1ab7ac61dd29c6f21ba5b862f3730e37cfdc4fd806c22f221" + 1L; + do_test 5 6 + "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0" + "0000000000000002" + "2754776173206272696c6c69672c20616e642074686520736c6974687920746f7665730a446964206779726520616e642067696d626c6520696e2074686520776162653a0a416c6c206d696d737920776572652074686520626f726f676f7665732c0a416e6420746865206d6f6d65207261746873206f757467726162652e" + "62e6347f95ed87a45ffae7426f27a1df5fb69110044c0d73118effa95b01e5cf166d3df2d721caf9b21e5fb14c616871fd84c54f9d65b283196c7fe4f60553ebf39c6402c42234e32a356b3e764312a61a5532055716ead6962568f87d3f3f7704c6a8d1bcd1bf4d50d6154b6da731b187b58dfd728afa36757a797ac188d1" + 42L + +(* Blowfish *) + +let _ = + testing_function "Blowfish"; + let testcnt = ref 0 in + let res = Bytes.create 8 in + let do_test (key, plain, cipher) = + let key = hex key + and plain = hexbytes plain + and cipher = hexbytes cipher in + let c = new Block.blowfish_encrypt key + and d = new Block.blowfish_decrypt key in + c#transform plain 0 res 0; incr testcnt; test !testcnt res cipher; + d#transform cipher 0 res 0; incr testcnt; test !testcnt res plain in + List.iter do_test [ + ("0000000000000000", "0000000000000000", "4EF997456198DD78"); + ("FFFFFFFFFFFFFFFF", "FFFFFFFFFFFFFFFF", "51866FD5B85ECB8A"); + ("3000000000000000", "1000000000000001", "7D856F9A613063F2"); + ("1111111111111111", "1111111111111111", "2466DD878B963C9D"); + ("0123456789ABCDEF", "1111111111111111", "61F9C3802281B096"); + ("1111111111111111", "0123456789ABCDEF", "7D0CC630AFDA1EC7"); + ("0000000000000000", "0000000000000000", "4EF997456198DD78"); + ("FEDCBA9876543210", "0123456789ABCDEF", "0ACEAB0FC6A0A28D"); + ("7CA110454A1A6E57", "01A1D6D039776742", "59C68245EB05282B"); + ("0131D9619DC1376E", "5CD54CA83DEF57DA", "B1B8CC0B250F09A0"); + ("07A1133E4A0B2686", "0248D43806F67172", "1730E5778BEA1DA4"); + ("3849674C2602319E", "51454B582DDF440A", "A25E7856CF2651EB"); + ("04B915BA43FEB5B6", "42FD443059577FA2", "353882B109CE8F1A"); + ("0113B970FD34F2CE", "059B5E0851CF143A", "48F4D0884C379918"); + ("0170F175468FB5E6", "0756D8E0774761D2", "432193B78951FC98"); + ("43297FAD38E373FE", "762514B829BF486A", "13F04154D69D1AE5"); + ("07A7137045DA2A16", "3BDD119049372802", "2EEDDA93FFD39C79"); + ("04689104C2FD3B2F", "26955F6835AF609A", "D887E0393C2DA6E3"); + ("37D06BB516CB7546", "164D5E404F275232", "5F99D04F5B163969"); + ("1F08260D1AC2465E", "6B056E18759F5CCA", "4A057A3B24D3977B"); + ("584023641ABA6176", "004BD6EF09176062", "452031C1E4FADA8E"); + ("025816164629B007", "480D39006EE762F2", "7555AE39F59B87BD"); + ("49793EBC79B3258F", "437540C8698F3CFA", "53C55F9CB49FC019"); + ("4FB05E1515AB73A7", "072D43A077075292", "7A8E7BFA937E89A3"); + ("49E95D6D4CA229BF", "02FE55778117F12A", "CF9C5D7A4986ADB5"); + ("018310DC409B26D6", "1D9D5C5018F728C2", "D1ABB290658BC778"); + ("1C587F1C13924FEF", "305532286D6F295A", "55CB3774D13EF201"); + ("0101010101010101", "0123456789ABCDEF", "FA34EC4847B268B2"); + ("1F1F1F1F0E0E0E0E", "0123456789ABCDEF", "A790795108EA3CAE"); + ("E0FEE0FEF1FEF1FE", "0123456789ABCDEF", "C39E072D9FAC631D"); + ("0000000000000000", "FFFFFFFFFFFFFFFF", "014933E0CDAFF6E4"); + ("FFFFFFFFFFFFFFFF", "0000000000000000", "F21E9A77B71C49BC"); + ("0123456789ABCDEF", "0000000000000000", "245946885754369A"); + ("FEDCBA9876543210", "FFFFFFFFFFFFFFFF", "6B5C5A9C5D9E0A5A") + ] + +(* Input message: a million 'a' *) +let hash_million_a (h: hash) = + for i = 1 to 10_000 do + h#add_string "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + done; + h#result + +(* Input message: the extremely-long message "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" repeated 16,777,216 times: a bit string of length 233 bits. This test is from the SHA-3 Candidate Algorithm Submissions document. *) +let hash_extremely_long (h: hash) = + for i = 1 to 16_777_216 do + h#add_string "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" + done; + h#result + +(* SHA-1 *) +let _ = + testing_function "SHA-1"; + let hash s = hash_string (Hash.sha1()) s in + test 1 (hash "") (hex "da39a3ee5e6b4b0d3255bfef95601890afd80709"); + test 2 (hash "a") (hex "86f7e437faa5a7fce15d1ddcb9eaeaea377667b8"); + test 3 (hash "abc") (hex "a9993e364706816aba3e25717850c26c9cd0d89d"); + test 4 (hash "abcdefghijklmnopqrstuvwxyz") + (hex "32d10c7b8cf96570ca04ce37f2a19d84240d3a89"); + test 5 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "84983E441C3BD26EBAAE4AA1F95129E5E54670F1"); + test 6 (hash_million_a (Hash.sha1())) + (hex "34AA973CD4C4DAA4F61EEB2BDBAD27316534016F"); + test 99 (hash_extremely_long (Hash.sha1())) + (hex "7789f0c9 ef7bfc40 d9331114 3dfbe69e 2017f592") + +(* SHA-224 *) +let _ = + testing_function "SHA-2 224"; + let hash s = hash_string (Hash.sha2 224) s in + test 1 (hash "abc") + (hex "23097d22 3405d822 8642a477 bda255b3 2aadbce4 bda0b3f7 e36c9da7"); + test 2 (hash "") + (hex "d14a028c 2a3a2bc9 476102bb 288234c4 15a2b01f 828ea62a c5b3e42f"); + test 3 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "75388b16 512776cc 5dba5da1 fd890150 b0c6455c b4f58b19 52522525"); + test 4 (hash_million_a (Hash.sha2 224)) + (hex "20794655 980c91d8 bbb4c1ea 97618a4b f03f4258 1948b2ee 4ee7ad67") + +(* SHA-256 *) +let _ = + testing_function "SHA-2 256"; + let hash s = hash_string (Hash.sha2 256) s in + test 1 (hash "abc") + (hex "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"); + test 2 (hash "") + (hex "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"); + test 3 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1"); + test 4 (hash_million_a (Hash.sha2 256)) + (hex "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0"); + test 99 (hash_extremely_long (Hash.sha256())) + (hex "50e72a0e 26442fe2 552dc393 8ac58658 228c0cbf b1d2ca87 2ae43526 6fcd055e") + +(* SHA-384 *) +let _ = + testing_function "SHA-2 384"; + let hash s = hash_string (Hash.sha2 384) s in + test 1 (hash "abc") + (hex "cb00753f45a35e8b b5a03d699ac65007 272c32ab0eded163 1a8b605a43ff5bed 8086072ba1e7cc23 58baeca134c825a7"); + test 2 (hash "") + (hex "38b060a751ac9638 4cd9327eb1b1e36a 21fdb71114be0743 4c0cc7bf63f6e1da 274edebfe76f65fb d51ad2f14898b95b"); + test 3 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "3391fdddfc8dc739 3707a65b1b470939 7cf8b1d162af05ab fe8f450de5f36bc6 b0455a8520bc4e6f 5fe95b1fe3c8452b"); + test 4 (hash_million_a (Hash.sha2 384)) + (hex "9d0e1809716474cb 086e834e310a4a1c ed149e9c00f24852 7972cec5704c2a5b 07b8b3dc38ecc4eb ae97ddd87f3d8985") + +(* SHA-512 *) +let _ = + testing_function "SHA-2 512"; + let hash s = hash_string (Hash.sha2 512) s in + test 1 (hash "abc") + (hex "ddaf35a193617aba cc417349ae204131 12e6fa4e89a97ea2 0a9eeee64b55d39a 2192992a274fc1a8 36ba3c23a3feebbd 454d4423643ce80e 2a9ac94fa54ca49f"); + test 2 (hash "") + (hex "cf83e1357eefb8bd f1542850d66d8007 d620e4050b5715dc 83f4a921d36ce9ce 47d0d13c5d85f2b0 ff8318d2877eec2f 63b931bd47417a81 a538327af927da3e"); + test 3 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "204a8fc6dda82f0a 0ced7beb8e08a416 57c16ef468b228a8 279be331a703c335 96fd15c13b1b07f9 aa1d3bea57789ca0 31ad85c7a71dd703 54ec631238ca3445"); + test 4 (hash "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu") + (hex "8e959b75dae313da 8cf4f72814fc143f 8f7779c6eb9f7fa1 7299aeadb6889018 501d289e4900f7e4 331b99dec4b5433a c7d329eeb6dd2654 5e96e55b874be909"); + test 5 (hash_million_a (Hash.sha2 512)) + (hex "e718483d0ce76964 4e2e42c7bc15b463 8e1f98b13b204428 5632a803afa973eb de0ff244877ea60a 4cb0432ce577c31b eb009c5c2c49aa2e 4eadb217ad8cc09b"); + test 99 (hash_extremely_long (Hash.sha2 512)) + (hex "b47c933421ea2db1 49ad6e10fce6c7f9 3d0752380180ffd7 f4629a712134831d 77be6091b819ed35 2c2967a2e2d4fa50 50723c9630691f1a 05a7281dbe6c1086") + +(* SHA-3 *) +let _ = + testing_function "SHA-3"; + let hash n s = hash_string (Hash.sha3 n) s in + let s = "" in + test 1 (hash 224 s) + (hex "6b4e03423667dbb7 3b6e15454f0eb1ab d4597f9a1b078e3f 5b5a6bc7"); + test 2 (hash 256 s) + (hex "a7ffc6f8bf1ed766 51c14756a061d662 f580ff4de43b49fa 82d80a4b80f8434a"); + test 3 (hash 384 s) + (hex "0c63a75b845e4f7d 01107d852e4c2485 c51a50aaaa94fc61 995e71bbee983a2a c3713831264adb47 fb6bd1e058d5f004"); + test 4 (hash 512 s) + (hex "a69f73cca23a9ac5 c8b567dc185a756e 97c982164fe25859 e0d1dcc1475c80a6 15b2123af1f5f94c 11e3e9402c3ac558 f500199d95b6d3e3 01758586281dcd26"); + let s = "abc" in + test 5 (hash 224 s) + (hex "e642824c3f8cf24a d09234ee7d3c766f c9a3a5168d0c94ad 73b46fdf"); + test 6 (hash 256 s) + (hex "3a985da74fe225b2 045c172d6bd390bd 855f086e3e9d525b 46bfe24511431532"); + test 7 (hash 384 s) + (hex "ec01498288516fc9 26459f58e2c6ad8d f9b473cb0fc08c25 96da7cf0e49be4b2 98d88cea927ac7f5 39f1edf228376d25"); + test 8 (hash 512 s) + (hex "b751850b1a57168a 5693cd924b6b096e 08f621827444f70d 884f5d0240d2712e 10e116e9192af3c9 1a7ec57647e39340 57340b4cf408d5a5 6592f8274eec53f0"); + let s = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" in + test 9 (hash 224 s) + (hex "8a24108b154ada21 c9fd5574494479ba 5c7e7ab76ef264ea d0fcce33"); + test 10 (hash 256 s) + (hex "41c0dba2a9d62408 49100376a8235e2c 82e1b9998a999e21 db32dd97496d3376"); + test 11 (hash 384 s) + (hex "991c665755eb3a4b 6bbdfb75c78a492e 8c56a22c5c4d7e42 9bfdbc32b9d4ad5a a04a1f076e62fea1 9eef51acd0657c22"); + test 12 (hash 512 s) + (hex "04a371e84ecfb5b8 b77cb48610fca818 2dd457ce6f326a0f d3d7ec2f1e91636d ee691fbe0c985302 ba1b0d8dc78c0863 46b533b49c030d99 a27daf1139d6e75e"); + let s = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" in + test 13 (hash 224 s) + (hex "543e6868e1666c1a 643630df77367ae5 a62a85070a51c14c bf665cbc"); + test 14 (hash 256 s) + (hex "916f6061fe879741 ca6469b43971dfdb 28b1a32dc36cb325 4e812be27aad1d18"); + test 15 (hash 384 s) + (hex "79407d3b5916b59c 3e30b09822974791 c313fb9ecc849e40 6f23592d04f625dc 8c709b98b43b3852 b337216179aa7fc7"); + test 16 (hash 512 s) + (hex "afebb2ef542e6579 c50cad06d2e578f9 f8dd6881d7dc824d 26360feebf18a4fa 73e3261122948efc fd492e74e82e2189 ed0fb440d187f382 270cb455f21dd185"); + test 17 (hash_million_a (Hash.sha3 224)) + (hex "d69335b93325192e 516a912e6d19a15c b51c6ed5c15243e7 a7fd653c"); + test 18 (hash_million_a (Hash.sha3 256)) + (hex "5c8875ae474a3634 ba4fd55ec85bffd6 61f32aca75c6d699 d0cdcb6c115891c1"); + test 19 (hash_million_a (Hash.sha3 384)) + (hex "eee9e24d78c18553 37983451df97c8ad 9eedf256c6334f8e 948d252d5e0e7684 7aa0774ddb90a842 190d2c558b4b8340"); + test 20 (hash_million_a (Hash.sha3 512)) + (hex "3c3a876da14034ab 60627c077bb98f7e 120a2a5370212dff b3385a18d4f38859 ed311d0a9d5141ce 9cc5c66ee689b266 a8aa18ace8282a0e 0db596c90b0a7b87"); + test 99 (hash_extremely_long (Hash.sha3 512)) + (hex "235ffd53504ef836 a1342b488f483b39 6eabbfe642cf78ee 0d31feec788b23d0 d18d5c339550dd59 58a500d4b95363da 1b5fa18affc1bab2 292dc63b7d85097c") + +(* Keccak *) +(* The test cases are taken from commit dec7e6dd8e5bbfe4534f7dd4c3fb4429575b23f8 *) +let _ = + testing_function "Keccak"; + let hash n s = hash_string (Hash.keccak n) s in + let s = "abc" in + test 1 (hash 224 s) + (hex "c30411768506ebe1 c2871b1ee2e87d38 df342317300a9b97 a95ec6a8"); + test 2 (hash 256 s) + (hex "4e03657aea45a94f c7d47ba826c8d667 c0d1e6e33a64a036 ec44f58fa12d6c45"); + test 3 (hash 384 s) + (hex "f7df1165f033337b e098e7d288ad6a2f 74409d7a60b49c36 642218de161b1f99 f8c681e4afaf31a3 4db29fb763e3c28e"); + test 4 (hash 512 s) + (hex "18587dc2ea106b9a 1563e32b3312421c a164c7f1f07bc922 a9c83d77cea3a1e5 d0c6991073902537 2dc14ac964262937 9540c17e2a65b19d 77aa511a9d00bb96"); + let s = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" in + test 5 (hash 224 s) + (hex "e51faa2b4655150b 931ee8d700dc202f 763ca5f962c529ea e55012b6"); + test 6 (hash 256 s) + (hex "45d3b367a6904e6e 8d502ee04999a7c2 7647f91fa845d456 525fd352ae3d7371"); + test 7 (hash 384 s) + (hex "b41e8896428f1bcb b51e17abd6acc980 52a3502e0d5bf7fa 1af949b4d3c855e7 c4dc2c390326b3f3 e74c7b1e2b9a3657"); + test 8 (hash 512 s) + (hex "6aa6d3669597df6d 5a007b00d09c2079 5b5c4218234e1698 a944757a488ecdc0 9965435d97ca32c3 cfed7201ff30e070 cd947f1fc12b9d92 14c467d342bcba5d"); + let s = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" in + test 9 (hash 224 s) + (hex "344298994b1b0687 3eae2ce739c425c4 7291a2e24189e01b 524f88dc"); + test 10 (hash 256 s) + (hex "f519747ed599024f 3882238e5ab43960 132572b7345fbeb9 a90769dafd21ad67"); + test 11 (hash 384 s) + (hex "cc063f3468513536 8b34f7449108f6d1 0fa727b09d696ec5 331771da46a923b6 c34dbd1d4f77e595 689c1f3800681c28"); + test 12 (hash 512 s) + (hex "ac2fb35251825d3a a48468a9948c0a91 b8256f6d97d8fa41 60faff2dd9dfcc24 f3f1db7a983dad13 d53439ccac0b37e2 4037e7b95f80f59f 37a2f683c4ba4682"); + test 13 (hash_million_a (Hash.keccak 224)) + (hex "19f9167be2a04c43 abd0ed554788101b 9c339031acc8e146 8531303f"); + test 14 (hash_million_a (Hash.keccak 256)) + (hex "fadae6b49f129bbb 812be8407b7b2894 f34aecf6dbd1f9b0 f0c7e9853098fc96"); + test 15 (hash_million_a (Hash.keccak 384)) + (hex "0c8324e1ebc18282 2c5e2a086cac07c2 fe00e3bce61d01ba 8ad6b71780e2dec5 fb89e5ae90cb593e 57bc6258fdd94e17"); + test 16 (hash_million_a (Hash.keccak 512)) + (hex "5cf53f2e556be5a6 24425ede23d0e8b2 c7814b4ba0e4e09c bbf3c2fac7056f61 e048fc341262875e bc58a5183fea6514 47124370c1ebf4d6 c89bc9a7731063bb"); + let s = "" in + test 17 (hash 224 s) + (hex "f71837502ba8e108 37bdd8d365adb855 91895602fc552b48 b7390abd"); + test 18 (hash 256 s) + (hex "c5d2460186f7233c 927e7db2dcc703c0 e500b653ca82273b 7bfad8045d85a470"); + test 19 (hash 384 s) + (hex "2c23146a63a29acf 99e73b88f8c24eaa 7dc60aa771780ccc 006afbfa8fe2479b 2dd2b21362337441 ac12b515911957ff"); + test 20 (hash 512 s) + (hex "0eab42de4c3ceb92 35fc91acffe746b2 9c29a8c366b7c60e 4e67c466f36a4304 c00fa9caf9d87976 ba469bcbe06713b4 35f091ef2769fb16 0cdab33d3670680e"); + test 98 (hash_extremely_long (Hash.keccak 256)) + (hex "5f313c39963dcf79 2b5470d4ade9f3a3 56a3e4021748690a 958372e2b06f82a4"); + test 99 (hash_extremely_long (Hash.keccak 512)) + (hex "3e122edaf3739823 1cfaca4c7c216c9d 66d5b899ec1d7ac6 17c40c7261906a45 fc01617a021e5da3 bd8d4182695b5cb7 85a28237cbb16759 0e34718e56d8aab8") + +(* RIPEMD-160 *) +let _ = + testing_function "RIPEMD-160"; + let hash s = hash_string (Hash.ripemd160()) s in + test 1 (hash "") + (hex "9c1185a5c5e9fc54612808977ee8f548b2258d31"); + test 2 (hash "a") + (hex "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe"); + test 3 (hash "abc") + (hex "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc"); + test 4 (hash "message digest") + (hex "5d0689ef49d2fae572b881b123a85ffa21595f36"); + test 5 (hash "abcdefghijklmnopqrstuvwxyz") + (hex "f71c27109c692c1b56bbdceb5b9d2865b3708dbc"); + test 6 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") + (hex "12a053384a9c0c88e405a06c27dcf49ada62eb2b"); + test 7 (hash "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") + (hex "b0e20b6e3116640286ed3a87a5713079b21f5189"); + test 8 (hash "12345678901234567890123456789012345678901234567890123456789012345678901234567890") + (hex "9b752e45573d4b39f4dbd3323cab82bf63326bfb"); + test 9 (hash (String.make 1000000 'a')) + (hex "52783243c1697bdbe16d37f97f68f08325dc1528") + +(* MD5 *) +let _ = + testing_function "MD5"; + let hash s = hash_string (Hash.md5()) s in + test 1 (hash "") (hex "D41D8CD98F00B204E9800998ECF8427E"); + test 2 (hash "a") (hex "0CC175B9C0F1B6A831C399E269772661"); + test 3 (hash "abc") (hex "900150983CD24FB0D6963F7D28E17F72"); + test 4 (hash "message digest") + (hex "F96B697D7CB7938D525A2F31AAF161D0") + +(* Chaining modes *) + +open Cipher + +let some_key = hex "0123456789abcdef" + +let test_enc_dec testno cipher cleartext = + let enc = cipher some_key Encrypt and dec = cipher some_key Decrypt in + test testno (transform_string dec (transform_string enc cleartext)) + cleartext + +let _ = + testing_function "ECB"; + test_enc_dec 1 (des ~mode:ECB) "abcdefgh"; + test_enc_dec 2 (des ~mode:ECB) "abcdefgh01234567"; + test_enc_dec 3 (des ~mode:ECB ~pad:Padding.length) "0123456789"; + test_enc_dec 4 (des ~mode:ECB ~pad:Padding.length) "abcdefghijklmnopqrstuvwxyz"; + test_enc_dec 5 (des ~mode:ECB ~pad:Padding._8000) "0123456789"; + test_enc_dec 6 (des ~mode:ECB ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "CBC"; + test_enc_dec 1 (des ~mode:CBC) "abcdefgh"; + test_enc_dec 2 (des ~mode:CBC) "abcdefgh01234567"; + test_enc_dec 3 (des ~mode:CBC ~pad:Padding.length) "0123456789"; + test_enc_dec 4 (des ~mode:CBC ~pad:Padding.length) "abcdefghijklmnopqrstuvwxyz"; + test_enc_dec 5 (des ~mode:CBC ~pad:Padding.length ~iv:"#@#@#@#@") "0123456789"; + test_enc_dec 6 (des ~mode:CBC ~pad:Padding.length ~iv:"ABCDEFGH") "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "CFB 1"; + test_enc_dec 1 (des ~mode:(CFB 1)) "ab"; + test_enc_dec 2 (des ~mode:(CFB 1)) "abcd"; + test_enc_dec 3 (des ~mode:(CFB 1)) "abcdefgh01234567"; + test_enc_dec 4 (des ~mode:(CFB 1)) "abcdefghijklmnopqrstuvwxyz"; + test_enc_dec 5 (des ~mode:(CFB 1) ~iv:"#@#@#@#@") "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "CFB 4"; + test_enc_dec 1 (des ~mode:(CFB 4)) "abcd"; + test_enc_dec 2 (des ~mode:(CFB 4)) "abcdefgh01234567"; + test_enc_dec 3 (des ~mode:(CFB 4) ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "OFB 1"; + test_enc_dec 1 (des ~mode:(OFB 1)) "ab"; + test_enc_dec 2 (des ~mode:(OFB 1)) "abcd"; + test_enc_dec 3 (des ~mode:(OFB 1)) "abcdefgh01234567"; + test_enc_dec 4 (des ~mode:(OFB 1)) "abcdefghijklmnopqrstuvwxyz"; + test_enc_dec 5 (des ~mode:(OFB 1) ~iv:"#@#@#@#@") "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "OFB 8"; + test_enc_dec 1 (des ~mode:(OFB 8)) "abcdefgh"; + test_enc_dec 2 (des ~mode:(OFB 8)) "abcdefgh01234567"; + test_enc_dec 3 (des ~mode:(OFB 8) ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" + +let _ = + testing_function "CTR"; + test_enc_dec 1 (des ~mode:CTR) "abcdefgh"; + test_enc_dec 2 (des ~mode:CTR) "abcdefgh01234567"; + test_enc_dec 3 (des ~mode:CTR ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz"; + test_enc_dec 4 (des ~mode:CTR ~iv:"\000\000\000\000\255\255\255\255" ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" + +(* HMAC-SHA256 *) + +let _ = + testing_function "HMAC-SHA256"; + List.iter + (fun (testno, hexkey, msg, hexhash) -> + test testno + (hash_string (MAC.hmac_sha256 (hex hexkey)) msg) + (hex hexhash)) +[ +(1, + "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", + "abc", + "a21b1f5d4cf4f73a4dd939750f7a066a7f98cc131cb16a6692759021cfab8181"); +(2, + "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", + "104fdc1257328f08184ba73131c53caee698e36119421149ea8c712456697d30"); +(3, + "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopqabcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", + "470305fc7e40fe34d3eeb3e773d95aab73acf0fd060447a5eb4595bf33a9d1a3"); +(4, + "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b", + "Hi There", + "198a607eb44bfbc69903a0f1cf2bbdc5ba0aa3f3d9ae3c1c7a3b1696a0b68cf7"); +(5, + "4a656665", (* "Jefe" *) + "what do ya want for nothing?", + "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"); +(6, + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd", + "cdcb1220d1ecccea91e53aba3092f962e549fe6ce9ed7fdc43191fbde45c30b0"); +(7, + "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425", + "\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd", + "d4633c17f6fb8d744c66dee0f8f074556ec4af55ef07998541468eb49bd2e917"); +(8, + "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c", + "Test With Truncation", + "7546af01841fc09b1ab9c3749a5f1c17d4f589668a587b2700a9c97c1193cf42"); +(9, + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "Test Using Larger Than Block-Size Key - Hash Key First", + "6953025ed96f0c09f80a96f78e6538dbe2e7b820e3dd970e7ddd39091b32352f"); +(10, + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", + "6355ac22e890d0a3c8481a5ca4825bc884d3e7a1ff98a2fc2ac7d8e064c3b2e6") +] + +(* HMAC-SHA512 *) + +let _ = + testing_function "HMAC-SHA512"; + List.iter + (fun (testno, hexkey, hexmsg, hexhash) -> + test testno + (hash_string (MAC.hmac_sha512 (hex hexkey)) (hex hexmsg)) + (hex hexhash)) + [(1, + "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b\ + 0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b\ + 0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b\ + 0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b", + "4869205468657265", + "637edc6e01dce7e6742a99451aae82df\ + 23da3e92439e590e43e761b33e910fb8\ + ac2878ebd5803f6f0b61dbce5e251ff8\ + 789a4722c1be65aea45fd464e89f8f5b"); + (2, + "4a6566654a6566654a6566654a656665\ + 4a6566654a6566654a6566654a656665\ + 4a6566654a6566654a6566654a656665\ + 4a6566654a6566654a6566654a656665", + "7768617420646f2079612077616e7420\ + 666f72206e6f7468696e673f", + "cb370917ae8a7ce28cfd1d8f4705d614\ + 1c173b2a9362c15df235dfb251b15454\ + 6aa334ae9fb9afc2184932d8695e397b\ + fa0ffb93466cfcceaae38c833b7dba38"); + (3, + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "dddddddddddddddddddddddddddddddd\ + dddddddddddddddddddddddddddddddd\ + dddddddddddddddddddddddddddddddd\ + dddd", + "2ee7acd783624ca9398710f3ee05ae41\ + b9f9b0510c87e49e586cc9bf961733d8\ + 623c7b55cebefccf02d5581acc1c9d5f\ + b1ff68a1de45509fbe4da9a433922655")] + +(* HMAC-MD5 *) + +let _ = + testing_function "HMAC-MD5"; + test 1 + (hash_string (MAC.hmac_md5 (hex "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b")) + "Hi There") + (hex "9294727a3638bb1c13f48ef8158bfc9d"); + test 2 + (hash_string (MAC.hmac_md5 "Jefe") + "what do ya want for nothing?") + (hex "750c783e6ab0b503eaa86e310a5db738"); + test 3 + (hash_string (MAC.hmac_md5 (hex "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")) + (String.make 50 '\221')) + (hex "56be34521d144c88dbb8c733f0e8b3f6") + +(* AES-CMAC (from RFC4493) *) + +let _ = + testing_function "AES-CMAC"; + let key = hex "2b7e1516 28aed2a6 abf71588 09cf4f3c" in + let msg = hex "6bc1bee2 2e409f96 e93d7e11 7393172a \ + ae2d8a57 1e03ac9c 9eb76fac 45af8e51 \ + 30c81c46 a35ce411 e5fbc119 1a0a52ef \ + f69f2445 df4f9b17 ad2b417b e66c3710" in + test 1 + (hash_string (MAC.aes_cmac key) + "") + (hex "bb1d6929 e9593728 7fa37d12 9b756746"); + test 2 + (hash_string (MAC.aes_cmac key) + (String.sub msg 0 16)) + (hex "070a16b4 6b4d4144 f79bdd9d d04a287c"); + test 3 + (hash_string (MAC.aes_cmac key) + (String.sub msg 0 40)) + (hex "dfa66747 de9ae630 30ca3261 1497c827"); + test 4 + (hash_string (MAC.aes_cmac key) + msg) + (hex "51f0bebf 7e3b9d92 fc497417 79363cfe") + +(* RSA *) + +let some_rsa_key = { + RSA.size = 512; + RSA.n = hex "c0764797b8bec8972a0ed8c90a8c334dd049add0222c09d20be0a79e338910bcae422060906ae0221de3f3fc747ccf98aecc85d6edc52d93d5b7396776160525"; + RSA.e = hex "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010001"; + RSA.d = hex "1ae36b7522f66487d9f4610d1550290ac202c929bedc7032cc3e02acf37e3ebc1f866ee7ef7a0868d23ae2b184c1abd6d4db8ea9bec046bd82803727f2888701"; + RSA.p = hex "df02b615fe15928f41b02b586b51c2c02260ca396818ca4cba60bb892465be35"; + RSA.q = hex "dceeb60d543518b4ac74834a0546c507f2e91e389a87e2f2becc6f8c67d1c931"; + RSA.dp = hex "59487e99e375c38d732112d97d6de8687fdafc5b6b5fb16e7297d3bd1e435599"; + RSA.dq = hex "61b550de6437774db0577718ed6c770724eee466b43114b5b69c43591d313281"; + RSA.qinv = hex "744c79c4b9bea97c25e563c9407a2d09b57358afe09af67d71f8198cb7c956b8" +} + +let some_msg = "Supercalifragilistusexpialidolcius" + +let test_same_message testno msg1 msg2 = + test testno msg1 (String.sub msg2 (String.length msg2 - String.length msg1) + (String.length msg1)) + +let _ = + testing_function "RSA"; + (* Signature, no CRT *) + test_same_message 1 some_msg + (RSA.unwrap_signature some_rsa_key (RSA.sign some_rsa_key some_msg)); + (* Signature, CRT *) + test_same_message 2 some_msg + (RSA.unwrap_signature some_rsa_key (RSA.sign_CRT some_rsa_key some_msg)); + (* Encryption, no CRT *) + test_same_message 3 some_msg + (RSA.decrypt some_rsa_key (RSA.encrypt some_rsa_key some_msg)); + (* Encryption, CRT *) + test_same_message 4 some_msg + (RSA.decrypt_CRT some_rsa_key (RSA.encrypt some_rsa_key some_msg)); + (* Same, with a home-made key *) + let prng = + Random.pseudo_rng (hex "5b5e50dc5b6eaf5346eba8244e5666ac4dcd5409") in + let key = RSA.new_key ~rng:prng 1024 in + test_same_message 5 some_msg + (RSA.unwrap_signature key (RSA.sign key some_msg)); + test_same_message 6 some_msg + (RSA.unwrap_signature key (RSA.sign_CRT key some_msg)); + test_same_message 7 some_msg + (RSA.decrypt key (RSA.encrypt key some_msg)); + test_same_message 8 some_msg + (RSA.decrypt_CRT key (RSA.encrypt key some_msg)); + (* Same, with a home-made key of fixed public exponent *) + let key = RSA.new_key ~rng:prng ~e:65537 1024 in + test_same_message 9 some_msg + (RSA.unwrap_signature key (RSA.sign key some_msg)); + test_same_message 10 some_msg + (RSA.unwrap_signature key (RSA.sign_CRT key some_msg)); + test_same_message 11 some_msg + (RSA.decrypt key (RSA.encrypt key some_msg)); + test_same_message 12 some_msg + (RSA.decrypt_CRT key (RSA.encrypt key some_msg)) + +(* Diffie-Hellman *) + +let _ = + testing_function "Diffie-Hellman"; + let prng = + Random.pseudo_rng (hex "5b5e50dc5b6eaf5346eba8244e5666ac4dcd5409") in + let param = DH.new_parameters ~rng:prng 1024 in + let ps1 = DH.private_secret ~rng:prng param + and ps2 = DH.private_secret ~rng:prng param in + let msg1 = DH.message param ps1 + and msg2 = DH.message param ps2 in + let ss1 = DH.shared_secret param ps1 msg2 + and ss2 = DH.shared_secret param ps2 msg1 in + test 1 ss1 ss2 + +(* Base64 encoding *) + +let _ = + testing_function "Base64"; + test 1 +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4K +" (transform_string (Base64.encode_multiline()) +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +"); + test 2 +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4uCg== +" (transform_string (Base64.encode_multiline()) +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog.. +"); + test 3 +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4uLgo= +" (transform_string (Base64.encode_multiline()) +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog... +"); + test 4 +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +" + (transform_string (Base64.decode()) +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4K +"); + test 5 +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog.. +" + (transform_string (Base64.decode()) +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4uCg== +"); + test 6 +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog... +" + (transform_string (Base64.decode()) +"VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr +IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv +eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv +dmVyIHRoZSBsYXp5IGRvZy4uLgo= +"); + let binarytext = String.init 256 Char.chr in + test 7 binarytext + (transform_string (Base64.decode()) + (transform_string (Base64.encode_compact()) binarytext)) + +(* Compression *) + +let _ = + testing_function "Zlib compression"; + let text = +"The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +The quick brown fox jumps over the lazy dog. +" in + try + test 1 text (transform_string (Zlib.uncompress()) (transform_string (Zlib.compress()) text)); + let c = Zlib.compress() and u = Zlib.uncompress() in + c#put_string text; c#flush; u#put_string c#get_string; u#flush; + test 2 text u#get_string; + c#put_string text; c#finish; u#put_string c#get_string; u#finish; + test 3 text u#get_string + with Error Compression_not_supported -> + printf " (not supported)" + +(* Random numbers *) +(* This is not a serious statistical test of Cryptokit's RNGs + (use Dieharder or TestU01 for this). Rather, it's a simplistic + test intended to detect obvious bugs such as providing + fewer random bytes than requested. *) + +let chisquare b = + let n = Bytes.length b in + let r = 256 in + let freq = Array.make r 0 in + for i = 0 to n - 1 do + let t = Char.code (Bytes.get b i) in + freq.(t) <- freq.(t) + 1 + done; + let t = Array.fold_left (fun s x -> let x = float x in s +. x *. x) 0.0 freq + and r = float r + and n = float n in + let sr = 2.0 *. sqrt r in + abs_float ((r *. t /. n) -. n -. r) <= sr + +let test_rng ?(len = 100000) (r: Random.rng) = + let b = Bytes.create len in + r#random_bytes b 0 len; + r#wipe; + printf "chi^2 %s\n" + (if chisquare b + then "plausible" + else (error_occurred := true; "BROKEN? rerun test!")) + +let _ = + testing_function "Random number generation"; + printf " 1. PRNG: "; + test_rng (Random.pseudo_rng "abcdefghijklmnopqrstuvwxyz"); + printf " 2. PRNG based on AES CTR: "; + test_rng (Random.pseudo_rng_aes_ctr "abcdefghijklmnopqrstuvwxyz"); + printf " 3. /dev/urandom: "; + begin try + test_rng (Random.device_rng "/dev/urandom") + with Unix.Unix_error _ -> + printf "not available\n" + end; + printf " 4. Hardware RNG: "; + begin try + test_rng (Random.hardware_rng ()) + with Error No_entropy_source -> + printf "not available\n" + end; + printf " 5. System RNG: "; + begin try + test_rng (Random.system_rng ()) + with Error No_entropy_source -> + printf "not available\n" + end + + +(* End of tests *) + +let _ = + print_newline(); + if !error_occurred then begin + printf "********* TEST FAILED ***********\n"; + exit 2 + end else begin + printf "All tests successful.\n"; + exit 0 + end + -- cgit v1.2.3