From ea99441e0da927e5a40cf21311265c7e22974f12 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 13 Feb 2017 13:21:17 +1100 Subject: Preference dedupe removed, bignum library obtained from internet (will be replaced later) --- src/bundles.adb | 28 +- src/bundles.ads | 13 +- src/candidates-containers.ads | 2 +- src/crypto-asymmetric-prime_tables.ads | 193 +++++ src/crypto-asymmetric.ads | 32 + src/crypto-types-big_numbers-binfield_utils.adb | 319 ++++++++ src/crypto-types-big_numbers-mod_utils.adb | 741 +++++++++++++++++++ src/crypto-types-big_numbers-utils.adb | 704 ++++++++++++++++++ src/crypto-types-big_numbers.adb | 921 +++++++++++++++++++++++ src/crypto-types-big_numbers.ads | 399 ++++++++++ src/crypto-types-random.adb | 72 ++ src/crypto-types-random.ads | 41 + src/crypto-types-random_source-file.adb | 144 ++++ src/crypto-types-random_source-file.ads | 50 ++ src/crypto-types-random_source.adb | 55 ++ src/crypto-types-random_source.ads | 27 + src/crypto-types.adb | 944 ++++++++++++++++++++++++ src/crypto-types.ads | 357 +++++++++ src/crypto.ads | 25 + src/rationals.adb | 78 +- src/rationals.ads | 12 +- 21 files changed, 5084 insertions(+), 73 deletions(-) create mode 100644 src/crypto-asymmetric-prime_tables.ads create mode 100644 src/crypto-asymmetric.ads create mode 100644 src/crypto-types-big_numbers-binfield_utils.adb create mode 100644 src/crypto-types-big_numbers-mod_utils.adb create mode 100644 src/crypto-types-big_numbers-utils.adb create mode 100644 src/crypto-types-big_numbers.adb create mode 100644 src/crypto-types-big_numbers.ads create mode 100644 src/crypto-types-random.adb create mode 100644 src/crypto-types-random.ads create mode 100644 src/crypto-types-random_source-file.adb create mode 100644 src/crypto-types-random_source-file.ads create mode 100644 src/crypto-types-random_source.adb create mode 100644 src/crypto-types-random_source.ads create mode 100644 src/crypto-types.adb create mode 100644 src/crypto-types.ads create mode 100644 src/crypto.ads (limited to 'src') diff --git a/src/bundles.adb b/src/bundles.adb index 50741ee..39c6cfa 100644 --- a/src/bundles.adb +++ b/src/bundles.adb @@ -5,17 +5,9 @@ package body Bundles is procedure Add (To : in out Bundle; - Item : in Given_Prefs.Preference_Array) - is - use type Given_Prefs.Preference_Array; + Item : in Given_Prefs.Preference_Array) is begin - for P of To.Papers loop - if P.Prefs = Item then - P.How_Many := P.How_Many + 1; - return; - end if; - end loop; - To.Papers.Append ( (How_Many => 1, Prefs => Item) ); + To.Papers.Append (Item); end Add; @@ -38,20 +30,21 @@ package body Bundles is Position := Given_Prefs.Preference_Range'First; while Position <= Given_Prefs.Preference_Range'Last and then - P.Prefs (Position) /= From + P (Position) /= From loop Position := Position + 1; end loop; Position := Position + 1; while Position <= Given_Prefs.Preference_Range'Last and then - Excluded.Contains (P.Prefs (Position)) + P (Position) /= Candidates.No_Candidate and then + Excluded.Contains (P (Position)) loop Position := Position + 1; end loop; if Position <= Given_Prefs.Preference_Range'Last and then - P.Prefs (Position) = To + P (Position) = To then Result.Papers.Append (P); end if; @@ -73,14 +66,9 @@ package body Bundles is function Count_Papers (This : in Bundle) - return Natural - is - Result : Natural := 0; + return Natural is begin - for P of This.Papers loop - Result := Result + P.How_Many; - end loop; - return Result; + return Integer (This.Papers.Length); end Count_Papers; diff --git a/src/bundles.ads b/src/bundles.ads index 5a0c274..cea046e 100644 --- a/src/bundles.ads +++ b/src/bundles.ads @@ -55,19 +55,12 @@ private use type Rationals.Fraction; - - - type Paper_Lot is record - How_Many : Positive := 1; - Prefs : Given_Prefs.Preference_Array; - end record; + use type Given_Prefs.Preference_Array; package Paper_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Paper_Lot); - - + (Index_Type => Positive, + Element_Type => Given_Prefs.Preference_Array); use type Paper_Vectors.Vector; diff --git a/src/candidates-containers.ads b/src/candidates-containers.ads index 142d1ca..60fe4cb 100644 --- a/src/candidates-containers.ads +++ b/src/candidates-containers.ads @@ -60,7 +60,7 @@ package Candidates.Containers is package CandidateID_Sets is new Ada.Containers.Ordered_Sets - (Element_Type => Extended_CandidateID); + (Element_Type => CandidateID); subtype CandidateID_Set is CandidateID_Sets.Set; diff --git a/src/crypto-asymmetric-prime_tables.ads b/src/crypto-asymmetric-prime_tables.ads new file mode 100644 index 0000000..66eba8e --- /dev/null +++ b/src/crypto-asymmetric-prime_tables.ads @@ -0,0 +1,193 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + + +with Crypto.Types; +use Crypto.Types; + +package Crypto.Asymmetric.Prime_Tables is + + One_Digit_Primes : constant array(Natural range <>) of Natural := + (2, 3, 5, 7); + + Two_Digit_Primes : constant array(Natural range <>) of Natural := + (11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, + 53, 59, 61, 67, 71, 73, 79, 83, 89, 97); + + Three_Digit_Primes : constant array(Natural range <>) of Natural := + ( 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); + + + Four_Digit_Primes : constant array(Natural range <>) of Natural := + ( 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, 8209, 8219, 8221, 8231, 8233, 8237, 8243, 8263, 8269, + 8273, 8287, 8291, 8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, + 8377, 8387, 8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, + 8501, 8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, + 8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, 8681, + 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, 8747, 8753, + 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, 8837, 8839, 8849, + 8861, 8863, 8867, 8887, 8893, 8923, 8929, 8933, 8941, 8951, 8963, + 8969, 8971, 8999, 9001, 9007, 9011, 9013, 9029, 9041, 9043, 9049, + 9059, 9067, 9091, 9103, 9109, 9127, 9133, 9137, 9151, 9157, 9161, + 9173, 9181, 9187, 9199, 9203, 9209, 9221, 9227, 9239, 9241, 9257, + 9277, 9281, 9283, 9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, + 9371, 9377, 9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, + 9439, 9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533, + 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, 9643, + 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733, 9739, 9743, + 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, 9817, 9829, 9833, + 9839, 9851, 9857, 9859, 9871, 9883, 9887, 9901, 9907, 9923, 9929, + 9931, 9941, 9949, 9967, 9973); + + + -- binary field squaring tables + + T8 : constant array (0..15) of Byte := + (0, 1, 4, 5, 16, 17, 20, 21, 64, 65, 68, 69, 80, 81, 84, 85); + + T16 : constant array (Byte) of DByte := + ( + 0, 1, 4, 5, 16, 17, 20, 21, + 64, 65, 68, 69, 80, 81, 84, 85, + 256, 257, 260, 261, 272, 273, 276, 277, + 320, 321, 324, 325, 336, 337, 340, 341, + 1024, 1025, 1028, 1029, 1040, 1041, 1044, 1045, + 1088, 1089, 1092, 1093, 1104, 1105, 1108, 1109, + 1280, 1281, 1284, 1285, 1296, 1297, 1300, 1301, + 1344, 1345, 1348, 1349, 1360, 1361, 1364, 1365, + 4096, 4097, 4100, 4101, 4112, 4113, 4116, 4117, + 4160, 4161, 4164, 4165, 4176, 4177, 4180, 4181, + 4352, 4353, 4356, 4357, 4368, 4369, 4372, 4373, + 4416, 4417, 4420, 4421, 4432, 4433, 4436, 4437, + 5120, 5121, 5124, 5125, 5136, 5137, 5140, 5141, + 5184, 5185, 5188, 5189, 5200, 5201, 5204, 5205, + 5376, 5377, 5380, 5381, 5392, 5393, 5396, 5397, + 5440, 5441, 5444, 5445, 5456, 5457, 5460, 5461, + 16384, 16385, 16388, 16389, 16400, 16401, 16404, 16405, + 16448, 16449, 16452, 16453, 16464, 16465, 16468, 16469, + 16640, 16641, 16644, 16645, 16656, 16657, 16660, 16661, + 16704, 16705, 16708, 16709, 16720, 16721, 16724, 16725, + 17408, 17409, 17412, 17413, 17424, 17425, 17428, 17429, + 17472, 17473, 17476, 17477, 17488, 17489, 17492, 17493, + 17664, 17665, 17668, 17669, 17680, 17681, 17684, 17685, + 17728, 17729, 17732, 17733, 17744, 17745, 17748, 17749, + 20480, 20481, 20484, 20485, 20496, 20497, 20500, 20501, + 20544, 20545, 20548, 20549, 20560, 20561, 20564, 20565, + 20736, 20737, 20740, 20741, 20752, 20753, 20756, 20757, + 20800, 20801, 20804, 20805, 20816, 20817, 20820, 20821, + 21504, 21505, 21508, 21509, 21520, 21521, 21524, 21525, + 21568, 21569, 21572, 21573, 21584, 21585, 21588, 21589, + 21760, 21761, 21764, 21765, 21776, 21777, 21780, 21781, + 21824, 21825, 21828, 21829, 21840, 21841, 21844, 21845 + ); + + + + end Crypto.Asymmetric.Prime_Tables; diff --git a/src/crypto-asymmetric.ads b/src/crypto-asymmetric.ads new file mode 100644 index 0000000..34fbc30 --- /dev/null +++ b/src/crypto-asymmetric.ads @@ -0,0 +1,32 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +--with Crypto; + +package Crypto.Asymmetric is + + Invalid_Public_Key_Error : exception; + Invalid_Private_Key_Error : exception; + Plaintext_Too_Long_Error : exception; + Decrypt_Error : exception; + +end Crypto.Asymmetric; diff --git a/src/crypto-types-big_numbers-binfield_utils.adb b/src/crypto-types-big_numbers-binfield_utils.adb new file mode 100644 index 0000000..5835b6d --- /dev/null +++ b/src/crypto-types-big_numbers-binfield_utils.adb @@ -0,0 +1,319 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + + +-- Most algorithms based on Kankerson, Menezes and Vanstones +-- "Guide to Elliptic Curve Cryptograpyh" (ISBN: 0-387-95273-x) + + +-- f(z) = 2^m + r(z) +-- R is the binary representation of r(z) + +with Crypto.Asymmetric.Prime_Tables; + + +separate(Crypto.Types.Big_Numbers) + +package body Binfield_Utils is + + function B_Mod(Left : D_Big_Unsigned; Right : Big_Unsigned) + return Big_Unsigned; + + function "xor"(Left, Right: D_Big_Unsigned) return D_Big_Unsigned; + + procedure Set_Last_Index(X : in out D_Big_Unsigned); + + --------------------------------------------------------------------------- + + pragma Optimize (Time); + use Crypto.Asymmetric.Prime_Tables; + + -- compute: a(z) + b(z) mod f(z) + function B_Add(Left,Right : Big_Unsigned) return Big_Unsigned is + N : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index); + C : Big_Unsigned; + begin + for I in 0..N loop + C.Number(I) := Left.Number(i) xor Right.Number(I); + end loop; + + for I in reverse 0..N loop + if C.Number(I) /= 0 then + C.Last_Index :=I; + exit; + end if; + end loop; + + return C; + end B_Add; + + --------------------------------------------------------------------------- + + + -- compute: a(z) - b(z) mod f(z) + -- in binary field is -a = a. so a - b = a + (-b) = a + b + function B_Sub(Left,Right : Big_Unsigned) return Big_Unsigned is + begin + return B_Add(Left,Right); + end B_Sub; + + + --------------------------------------------------------------------------- + + -- compute: a(z)* z mod f(Z) + function B_Mult(A, F : Big_Unsigned) + return Big_Unsigned is + C : Big_Unsigned; + M : constant Positive := Bit_Length(F)-1; + N : Natural:= M/Word'Size; + begin + C := Shift_Left(A,1); + + if C.Last_Index = N then + N:=M mod Word'Size; + + if (Shift_Right(C.Number(C.Last_Index),N)) = 1 then + C := B_Add(C,F); + end if; + end if; + return C; + + end B_Mult; + + --------------------------------------------------------------------------- + + + --Algorithm 2.34: Right to left comb method for polynominal multiplication + -- compute: a(z)*b(z) mod f(Z) + function B_Mult(Left, Right, F : Big_Unsigned) return Big_Unsigned is + C : D_Big_Unsigned; + B : Big_Unsigned := Right; + -- N : constant Natural := Bit_Length(F); + begin + for K in 0..Word'Size-1 loop + for J in 0..Left.Last_Index loop + if (Shift_Right(Left.Number(J),K) and 1) = 1 then + -- add B to C{i} + for I in J..(J+B.Last_Index) loop + C.Number(I) := C.Number(I) xor B.Number(I-J); + end loop; + end if; + end loop; + if K /= Word'Size-1 then + B:=B_Mult(B,F); + end if; + end loop; + + Set_Last_Index(C); + + return B_Mod(C,F); + + end B_Mult; + + --------------------------------------------------------------------------- + + -- Algorithm 2.39: Polynominal squaring (with wordlength W=8) + -- compute a(z)**2 mod f(z) on a 8 bit processor + -- function B_Square8(A, F : Big_Unsigned) return Big_Unsigned is + -- C : D_Big_Unsigned; + -- L : Natural; + -- begin + -- for I in 0..A.Last_Index loop + -- L := 2*I; + -- C.Number(L) := Word(T8(Natural(A.Number(I) and 15))); + -- L:= L+1; + -- C.Number(L) := + -- Word(T8(Natural(Shift_Right(A.Number(I),4) and 15))); + -- end loop; + + -- Set_Last_Index(C); + + -- return B_Mod(C,F); + -- end B_Square8; + + ------------------------------------------------------------------------- + + -- Algorithm 2.39: Polynominal squaring (with word length W=n*8 for n=>0) + -- compute a(z)**2 mod f(z) + function B_Square(A, F : Big_Unsigned) return Big_Unsigned is + K : constant Natural := Word'Size/8; + N : constant Natural := K/2-1; + --M : constant Natural := Bit_Length(F); + L : Natural; + C : D_Big_Unsigned; + begin + for I in 0..A.Last_Index loop + L := 2*I; + for J in reverse 0..N loop + C.Number(L) := Shift_Left(C.Number(L),16) xor + Word(T16(Byte(Shift_Right(A.Number(I),8*J) and 255))); + end loop; + L:= L+1; + for J in reverse K/2..K-1 loop + C.Number(L) := Shift_Left(C.Number(L),16) xor + Word(T16(Byte(Shift_Right(A.Number(I),8*J) and 255))); + end loop; + end loop; + Set_Last_Index(C); + + return B_Mod(C,F); + end B_Square; + +-------------------------------------------------------------------------- + + -- It' my own secret "blow and cut" technic. ;-) + -- compute left(z) mod right(z) + function B_Mod(Left, Right : Big_Unsigned) return Big_Unsigned is + A : Natural := Bit_Length(Left); + B : constant Natural := Bit_Length(Right); + Result : Big_Unsigned; + begin + if A < B or B=0 then + Result.Last_Index := Left.Last_Index; + Result.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index); + else + while A >= B loop + Result := Shift_Left(Right,A-B) xor Right; + A := Bit_Length(Result); + end loop; + end if; + return Result; + end B_Mod; + + + + -------------------------------------------------------------------------- + + -- Algorithm 2.49: Binary algorithm for inversion in F_{2^m} + -- computes a(z)^{-1} + function B_Inverse(X, F : Big_Unsigned) return Big_Unsigned is + U : Big_Unsigned := X; + V : Big_Unsigned := F; + G1 : Big_Unsigned := Big_Unsigned_One; + G2 : Big_Unsigned; + begin + if X = Big_Unsigned_Zero or F = Big_Unsigned_Zero then + return F; + end if; + + while U /= Big_Unsigned_One and V /= Big_Unsigned_One loop + + while Is_Even(U) loop + U := Shift_Right(U,1); + if Is_Even(G1) then + G1 := Shift_Right(G1,1); + else + G1 := Shift_Right(B_Add(G1,F),1); + end if; + end loop; + + while Is_Even(V) loop + V := Shift_Right(V,1); + if Is_Even(G2) then + G2 := Shift_Right(G2,1); + else + G2 := Shift_Right(B_Add(G2,F),1); + end if; + end loop; + + if Bit_Length(U) > Bit_Length(V) then + U := B_Add(U,V); + G1 := B_Add(G1,G2); + else + V := B_Add(V,U); + G2 := B_Add(G2,G1); + end if; + end loop; + if U = Big_Unsigned_One then + return G1; + else + return G2; + end if; + end B_Inverse; + + -------------------------------------------------------------------------- + + function B_Div(Left, Right, F : Big_Unsigned) return Big_Unsigned is + R : constant Big_Unsigned := B_Inverse(Right, F); + begin + return B_Mult(Left,R,F); + end B_Div; + + -------------------------------------------------------------------------- + -------------------------------------------------------------------------- + + function B_Mod(Left : D_Big_Unsigned; Right : Big_Unsigned) + return Big_Unsigned is + A : Natural := Bit_Length(Left); + B : constant Natural := Bit_Length(Right); + Result : Big_Unsigned; + begin + if A < B or B=0 then + Result.Last_Index := Left.Last_Index; + Result.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index); + else + declare + T : D_Big_Unsigned := Left; + Z : D_Big_Unsigned; + begin + Z.Last_Index := Right.Last_Index; + Z.Number(0..Right.Last_Index) := Right.Number(0..Right.Last_Index); + while A >= B loop + T := Shift_Left(Z,A-B) xor T; + A := Bit_Length(T); + end loop; + Result.Last_Index := T.Last_Index; + Result.Number(0..T.Last_Index) := T.Number(0..T.Last_Index); + end; + end if; + return Result; + end B_Mod; + + + -------------------------------------------------------------------------- + + function "xor"(Left, Right: D_Big_Unsigned) return D_Big_Unsigned is + Result : D_Big_Unsigned; + M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index); + begin + for I in 0..M loop + Result.Number(I) := Left.Number(I) xor Right.Number(I); + end loop; + Set_Last_Index(Result); + + return Result; + end "xor"; + + + -------------------------------------------------------------------------- + + procedure Set_Last_Index(X : in out D_Big_Unsigned) is + begin + for I in reverse 0..D_Max_Length loop + if X.Number(I) /= 0 then + X.Last_Index :=I; + exit; + end if; + end loop; + end Set_Last_Index; pragma Inline(Set_Last_Index); + +end Binfield_Utils; diff --git a/src/crypto-types-big_numbers-mod_utils.adb b/src/crypto-types-big_numbers-mod_utils.adb new file mode 100644 index 0000000..3c02df1 --- /dev/null +++ b/src/crypto-types-big_numbers-mod_utils.adb @@ -0,0 +1,741 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +with Crypto.Types.Random; +with Crypto.Asymmetric.Prime_Tables; +--with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Text_IO; + +separate(Crypto.Types.Big_Numbers) + +package body Mod_Utils is + + pragma Optimize (Time); + use Crypto.Asymmetric.Prime_Tables; + + + --------------------------------------------------------------------------- + + function Patch(Item, N : Big_Unsigned) + return Big_Unsigned is + Diff : constant Big_Unsigned:=((Big_Unsigned_Last - N) + 1) mod N; + begin + return Add(Item,Diff,N); + end Patch; pragma Inline(Patch); + + --------------------------------------------------------------------------- + + function Add(Left, Right, N : Big_Unsigned) return Big_Unsigned is + L : constant Big_Unsigned := Left mod N; + R : constant Big_Unsigned := Right mod N; + Result : constant Big_Unsigned := L + R; + begin + if Result < Max(L,R) then + return Patch(Result,N); + else return + Result mod N; + end if; + end Add; + + --------------------------------------------------------------------------- + + function Sub(Left, Right, N : Big_Unsigned) return Big_Unsigned is + L : constant Big_Unsigned := Left mod N; + R : constant Big_Unsigned := Right mod N; + begin + if R > L then + return N - R + L; + else return L-R; + end if; + end Sub; + + --------------------------------------------------------------------------- + + function Div(Left, Right, N : Big_Unsigned) return Big_Unsigned is + begin + return Mult(Left,Inverse(Right,N),N); + end Div; pragma Inline(Div); + + + --------------------------------------------------------------------------- + + --from Erik-Zenners handout "Zahlentheoretische Algorithmen" + function Pow(Base, Exponent, N : Big_Unsigned) return Big_Unsigned is + L : constant Big_Unsigned := Base mod N; + R : constant Big_Unsigned := Exponent; + Result : Big_Unsigned := Big_Unsigned_One; + begin + if L = Big_Unsigned_Zero or L = Big_Unsigned_One then + return L; + elsif R = Big_Unsigned_Zero then return Big_Unsigned_One; + else + -- Square_And_Muliply + for I in reverse 0..Bit_Length(R)-1 loop + Result := Mult(Result,Result,N); + if (Shift_Right(R, I) mod 2) = Big_Unsigned_One then + Result := Mult(Result,L,N); + end if; + end loop; + return Result mod N; + end if; + end Pow; + + --------------------------------------------------------------------------- + + --based on Erik-Zenners handout "Zahlentheoretische Algorithmen" + -- (ext. Euklid) + -- This function returns Big_unsigned_Zero if X have no inverse mod n + function Inverse(X, N : Big_Unsigned) return Big_Unsigned is + B : Big_Unsigned := X mod N; + A : Big_Unsigned := N; + begin + -- if gcd(A,B) /= 1 then A have no inverse mod B + if B = Big_Unsigned_Zero or A = Big_Unsigned_Zero or + Gcd(A,B) /= Big_Unsigned_One then + return Big_Unsigned_Zero; + end if; + + declare + T : Big_Unsigned := Big_Unsigned_One; + Tstrich, Tempt : Big_Unsigned; + Q, R : Big_Unsigned; + begin + loop + Big_Div(A,B,Q,R); + if(R = Big_Unsigned_Zero) then + return T; + end if; + + A:=B; + B:=R; + + Tempt:=T; + + T:=Sub(Tstrich,Mult(Q,T,N),N); + + Tstrich:=Tempt; + end loop; + end; + end Inverse; + + --------------------------------------------------------------------------- + + function Get_Random(N : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + begin + Random.Read(Result.Number); + + for I in reverse 0..N.Last_Index loop + if Result.Number(I) /= 0 then + Result.Last_Index := I; + exit; + end if; + end loop; + return Result mod N ; + end Get_Random; + + --------------------------------------------------------------------------- + + -- this function returns true if X is a Mersenne prim number + function Lucas_Lehmer_Test(X : Big_Unsigned) return Boolean is + Is_Mp : Boolean := false; + begin + + if X.Last_Index = 0 then + for I in 2..Word'Size-1 loop + if X.Number(0) = Shift_Left(2,I)-1 then + Is_Mp := True; + exit; + end if; + end loop; + if Is_Mp = False then return False; + end if; + else + for I in 0..X.Last_Index loop + if X.Number(I) /= Word'Last then return False; + end if; + end loop; + end if; + + declare + P : constant Word := Word(Bit_Length(X)-1); + S : Big_Unsigned := Big_Unsigned_Two+2; --S(1) = 4; + begin + for I in 2..P-1 loop + S := (Mult(S,S,X) - 2) mod X; + end loop; + + if S = Big_Unsigned_Zero then return True; + else return False; + end if; + end; + end Lucas_Lehmer_Test; + + --------------------------------------------------------------------------- + + --from Erik-Zenners handout "Zahlentheoretische Algorithmen" + function Is_Miller_Rabin_Witness(Wit, X : Big_Unsigned) return Boolean is + + B : constant Big_Unsigned := X-1; + Result : Big_Unsigned := Big_Unsigned_One; + Root : Big_Unsigned; + begin + for I in reverse 0..Bit_Length(B)-1 loop + Root := Result; + Result := Mult(Result, Result, X); + if ((Result = Big_Unsigned_One) and + (Root /= Big_Unsigned_One and Root /= B)) then return True; + elsif (Shift_Right(B,I) mod 2) = Big_Unsigned_One then + Result := Mult(Result, Wit, X); + end if; + end loop; + if Result /= Big_Unsigned_One then return True; + else return False; + end if; + end Is_Miller_Rabin_Witness; + + --------------------------------------------------------------------------- + + -- Test if Wit is a witness for N + -- If Wit is a wittness then N is no prime + function Is_Simple_Witness(Wit, N : Big_Unsigned) return Boolean is + begin + -- is Wit a "Miller-Rabin"-witness + if (Wit /= (N-Big_Unsigned_One)) and (Wit /= Big_Unsigned_One) and + Mult(Wit,Wit,N) = Big_Unsigned_One then return True; + + elsif Gcd(Wit,N) /= Big_Unsigned_One then return True; + + -- is Wit a "Fermat-Witness" + -- elsif Pow(Wit,N-1,N) /= Big_Unsigned_One then return True; + else return False; + end if; + end Is_Simple_Witness; + + --------------------------------------------------------------------------- + + + -- Returns true if N passes the specified number of Miller-Rabin tests. + function Passed_Miller_Rabin_Test(X : Big_Unsigned; S : Positive) + return Boolean is + Witness : Big_Unsigned; + begin + -- Do the tests + for I in 1..S loop + -- Generate a uniform random on (1, X) + loop + Witness := Get_Random(X); + exit when Witness > Big_Unsigned_One; + end loop; + if Is_Miller_Rabin_Witness(Witness, X) then + return False; + end if; + end loop; + return true; + end Passed_Miller_Rabin_Test; + + --------------------------------------------------------------------------- + + function Pass_Prime_Test(X : Big_Unsigned; Status : Hardness) + return Boolean is + Rounds : Natural; + X_Bit_Size : constant Natural := Bit_Length(X); + begin + if X < Big_Unsigned_Two then return False; + elsif Is_Even(X) then + if X = Big_Unsigned_Two then return True; + else return False; + end if; + end if; + + --X is odd + + for I in One_Digit_Primes'First+1..One_Digit_Primes'Last loop + if X = Word(One_Digit_Primes(I)) then return true; + elsif X mod Word(One_Digit_Primes(I)) = Big_Unsigned_Zero then + return False; + end if; + end loop; + + for I in Two_Digit_Primes'Range loop + if X = Word(Two_Digit_Primes(I)) then return true; + elsif X mod Word(Two_Digit_Primes(I)) = Big_Unsigned_Zero then + return False; + end if; + end loop; + + if Lucas_Lehmer_Test(X) then + return True; + end if; + + for I in Three_Digit_Primes'Range loop + if X = Word(Three_Digit_Primes(I)) then return true; + elsif X mod Word(Three_Digit_Primes(I)) = Big_Unsigned_Zero then + return False; + end if; + end loop; + + -- The relationship between the certainty and the number of rounds + -- we perform is given in the draft standard ANSI X9.80, "PRIME + -- NUMBER GENERATION, PRIMALITY TESTING, AND PRIMALITY CERTIFICATES". + -- Comment: + -- I don't have a look on this paper. =:) I borrowed this + -- "algorithmen" from the j2sdk1.4.1 library (java/math/BigInteger.java) + -- If you have the permission to send me the draft standard ANSI X9.80 + -- then send it, please! + -- I'm a student. I have no money for ANSI or IEEE drafts. :-( + -- It's right to require money to read a draft? + -- This really really sucks! SCNR! + + if (X_Bit_Size < 100) then Rounds := 50; + elsif (X_Bit_Size < 256) then Rounds := 27; + elsif (X_Bit_Size < 512) then Rounds := 15; + elsif (X_Bit_Size < 768) then Rounds := 8; + elsif (X_Bit_Size < 1024) then Rounds := 4; + else Rounds := 2; + end if; + + declare + Witness : Big_Unsigned; + begin + if Status = Weak then + for I in 1..Rounds loop + loop + Witness := Get_Random(X); + exit when Witness > Big_Unsigned_Two; + end loop; + if Is_Simple_Witness(Witness,X) then return False; + end if; + end loop; + else + for I in 1..Rounds loop + loop + Witness := Get_Random(X); + exit when Witness > Big_Unsigned_Two; + end loop; + if Is_Miller_Rabin_Witness(Witness,X) then return False; + end if; + end loop; + end if; + end; + return True; + end Pass_Prime_Test; + + --------------------------------------------------------------------------- + + + function Is_Prime(X : Big_Unsigned) return Boolean is + begin + return Pass_Prime_Test(X, Strong); + end Is_Prime; pragma Inline (Is_Prime); + + --------------------------------------------------------------------------- + + -- This function is faster then Is_prime but a lot of no strong pseudo + -- primes pass this test + function Looks_Like_A_Prime(X : Big_Unsigned) return Boolean is + begin + return Pass_Prime_Test(X, Weak); + end Looks_Like_A_Prime; pragma Inline(Looks_Like_A_Prime); + + --------------------------------------------------------------------------- + + function Get_Prime(N : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned := Get_Random(N); + begin + if N <= Big_Unsigned_Two then + raise Constraint_Error; + end if; + + -- make sure that Result is odd + Result.Number(0) := Result.Number(0) or 1; + loop + if Is_Prime(Result) then return Result; + else Result := (Result+2) mod N ; + end if; + end loop; + end Get_Prime; + + + --------------------------------------------------------------------------- + + + function "mod"(Left : D_Big_Unsigned; Right : Big_Unsigned) + return Big_Unsigned; + + --------------------------------------------------------------------------- + + -- Result = Left * Right (mod N) + function Mult(Left, Right, N : Big_Unsigned) return Big_Unsigned is + T : DWord; + Carry : Word := 0; + R : D_Big_Unsigned; + begin + for I in 0..Left.Last_Index loop + for J in 0..Right.Last_Index loop + T := DWord(Left.Number(I)) * DWord(Right.Number(J)) + + DWord(R.Number(I+J)) + DWord(Carry); + + R.Number(I+J) := Word(T and DWord(Word'Last)); + + Carry:= Word(Shift_Right(T,Word'Size)); + end loop; + R.Number(I+Right.Last_Index+1) := Carry + + R.Number(I+Right.Last_Index+1); + Carry := 0; + end loop; + + for I in reverse 0..D_Max_Length loop + if R.Number(I) /= 0 then + R.Last_Index := I; + exit; + end if; + end loop; + return R mod N; + end Mult; + + --------------------------------------------------------------------------- + + + -- Returns a probability N-bit prime (Result). + function Get_N_Bit_Prime(N : Positive) return Big_Unsigned is + J : Big_Unsigned := Get_Random(Shift_Left(Big_Unsigned_One,N-2)); + Index : constant Natural := (N-1)/Word'Size; + Amount : constant Natural := (N-1) mod Word'Size; + Result : Big_Unsigned := Shift_Left(J,1); + + begin + if N = 1 or N > Size then + raise Constraint_Error; + end if; + + loop + -- Make sure that Result is an odd + Set_Least_Significant_Bit (Result); + + -- Make sure that Result is a N-Bit-Number; + Result.Number (Index) := Result.Number (Index) or + Shift_Left (Word (1), Amount); + + if Amount = 0 then + Result.Last_Index := Index; + end if; + + if Is_Prime(Result) then + return Result; + else + Result:=Result-2; + if Is_Prime(Result) then + return Result; + end if; + end if; + + J := Get_Random (Shift_Left (Big_Unsigned_One, N - 2)); + Result := Shift_Left (J, 1); + end loop; + + end Get_N_Bit_Prime; + + --------------------------------------------------------------------------- + + -- computes the jacobi-symbol + -- return value: + -- 0 : if X mod N = 0 + -- 1 : if X is a quadratic resuide mod N + -- -1 : if X is a quadratic non-resuide mod N + + function Jacobi(X, N : Big_Unsigned) return Integer is + A : Big_Unsigned := X mod N; + begin + + if Is_Even(N) then + raise Constraint_Error; + end if; + + if N = Big_Unsigned_One then return 1; + elsif A = Big_Unsigned_Zero then return 0; + elsif A = Big_Unsigned_One then return 1; + end if; + + while (A mod 4) = Big_Unsigned_Zero loop + exit when (A mod 4) = Big_Unsigned_Zero; + A := Shift_Right(A,2); + end loop; + + if Is_Even(A) then + if (N mod 8 = 1) or (N mod 8 = 7) then + return Jacobi(Shift_Right(A,1),N); + else return -1*Jacobi(Shift_Right(A,1),N); + end if; + else + if (A mod 4 = 1) or (N mod 4 = 1) then + return Jacobi(N mod A, A); + else return -1*Jacobi(N mod A, A); + end if; + end if; + end Jacobi; + + ---------------------------------------------------------------------------- + -----------------------------DOUBLE_SIZE------------------------------------ + ---------------------------------------------------------------------------- + + --only needed for multiplication mod N + --here we need 2*Size-bit numbers to avoid an overflow because + --if one of our provisional result t > BIG_Unsigned_Last + --then there ist no well known algortihm to compute the + -- result of an multiplication mod m + + -- same algorithm for D_Big_Unsigned as for Big_Unsigned + + function "="(Left, Right : D_Big_Unsigned) return Boolean is + begin + if Left.Last_Index = Right.Last_Index then + for I in 0..Left.Last_Index loop + if Left.Number(I) /= Right.Number(I) then return False; + end if; + end loop; + else return False; + end if; + return True; + end"="; + + ---------------------------------------------------------------------------- + + function Shift_Left(Value : D_Big_Unsigned; Amount : Natural) + return D_Big_Unsigned is + begin + if Amount >= (D_Max_Length+1)*Word'Size or + Value = D_Big_Unsigned_Zero + then return D_Big_Unsigned_Zero; + elsif Amount = 0 then return Value; + end if; + + declare + Result : D_Big_Unsigned; + Temp : DLimbs :=(others => 0); + L : constant Natural := Amount mod Word'Size; + R : constant Natural := Word'Size-L; + M : constant Natural := Amount/Word'Size; + begin + Temp(0) := Shift_Left(Value.Number(0), L); + + for I in 1..Value.Last_Index loop + Temp(I) := Shift_Right(Value.Number(I-1), R) + + Shift_Left(Value.Number(I), L); + end loop; + + if Value.Last_Index /= D_Max_Length then + Temp(Value.Last_Index+1):= + Shift_Right(Value.Number(Value.Last_Index), R); + end if; + + for I in Temp'Range loop + if (I+M) > D_Max_Length then + exit; + end if; + Result.Number(I+M):= Temp(I); + end loop; + + for I in reverse 0..D_Max_Length loop + if Result.Number(I) /=0 then + Result.Last_Index:=I; + exit; + end if; + end loop; + return Result; + end; + end Shift_Left; pragma Inline (Shift_Left); + + --------------------------------------------------------------------------- + + + function Bit_Length(X : D_Big_Unsigned) return Natural is + begin + if X = D_Big_Unsigned_Zero then + return 0; + end if; + + for I in reverse 0..Word'Size-1 loop + if Shift_Left(1,I) <= X.Number(X.Last_Index) then + return Word'Size * X.Last_Index + I + 1 ; + end if; + end loop; + return X.Last_Index * Word'Size; + end Bit_Length; pragma Inline (Bit_Length); + + + --------------------------------------------------------------------------- + + function "<"(Left, Right : D_Big_Unsigned) return Boolean is + begin + if Left.Last_Index < Right.Last_Index then return True; + elsif Left.Last_Index > Right.Last_Index then return False; + else + for I in reverse 0..Left.Last_Index loop + if Left.Number(I) < Right.Number(I) then return True; + elsif Left.Number(I) > Right.Number(I) then return False; + end if; + end loop; + end if; + return False; + end "<"; pragma Inline ("<"); + + --------------------------------------------------------------------------- + + function ">"(Left, Right : D_Big_Unsigned) return Boolean is + begin + return Right < Left; + end ">"; pragma Inline (">"); + + + + --------------------------------------------------------------------------- + + function ">="(Left, Right : D_Big_Unsigned) return Boolean is + begin + return not(Left < Right); + end ">="; pragma Inline (">="); + + --------------------------------------------------------------------------- + + function "+"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned; + + function "-"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned is + begin + if Left = Right then return D_Big_Unsigned_Zero; + elsif Left = Right+D_Big_Unsigned_One then return D_Big_Unsigned_One; + elsif Left+D_Big_Unsigned_One = Right then return D_Big_Unsigned_Last; + + -- add the modulus if Right > Left + elsif Right > Left then + return D_Big_Unsigned_Last - Right + Left + D_Big_Unsigned_One; + else + declare + Result : D_Big_Unsigned; + Carry : Word:=0; + begin + -- Remember Left > Right + for I in 0..Left.Last_Index loop + Result.Number(I) := Left.Number(I) - Right.Number(I) - Carry; + if (Right.Number(I) > Left.Number(I)) or + (Carry= 1 and Right.Number(I) = Left.Number(I)) + then Carry :=1; + else Carry :=0; + end if; + if Result.Number(I) /= 0 then + Result.Last_Index := I; + end if; + end loop; + return Result; + end; + end if; + end "-"; + + + --------------------------------------------------------------------------- + + function "mod"(Left : D_Big_Unsigned; Right : Big_Unsigned) + return Big_Unsigned is + begin + if Left.Last_Index <= Max_Length then + declare + L : Big_Unsigned; + begin + L.Last_Index := Left.Last_Index; + L.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index); + return L mod Right; + end; + end if; + + if Right = Big_Unsigned_Zero then raise Division_By_Zero; + --elsif Right = Big_Unsigned_One then return Big_Unsigned_Zero; + end if; + + -- Now, there is only the case where (Left > Right), (Right /= 0) + -- and |Left|>|Right|. + + declare + Remainder : D_Big_Unsigned:=Left; + Temp_Right, R : D_Big_Unsigned; + Result : Big_Unsigned; + Diff: Natural; + + begin + Temp_Right.Last_Index := Right.Last_Index; + Temp_Right.Number(0..Right.Last_Index) := + Right.Number(0..Right.Last_Index); + R:=Temp_Right; + + while(Remainder >= R) loop + Diff := Bit_Length(Remainder) - Bit_Length(R); + if Diff = 0 then + Remainder := Remainder-R; + exit; + else Diff:=Diff-1; + end if; + Temp_Right := Shift_Left(R, Diff); + Remainder := Remainder-Temp_Right; + end loop; + + Result.Last_Index := Remainder.Last_Index; + Result.Number(0..Result.Last_Index) := + Remainder.Number(0..Result.Last_Index); + return Result; + end; + end "mod"; + + --------------------------------------------------------------------------- + + function "+"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned is + Result : D_Big_Unsigned; + M : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index); + Temp : Word; + Carry : Word :=0; + begin + + for I in 0..M loop + Temp :=Carry; + Result.Number(I) := Left.Number(I) + Right.Number(I) +Temp; + if Result.Number(I) < Word'Max(Left.Number(I), Right.Number(I)) + then Carry := 1; + else Carry := 0; + end if; + end loop; + + if Carry =1 and M < Max_Length then + Result.Number(M+1) := 1; + Result.Last_Index := M+1; + else + -- Set Result.Last_Index + for I in reverse 0..M loop + if Result.Number(I) /= 0 then + Result.Last_Index := I; + return Result; + end if; + end loop; + end if; + return Result; + end "+"; + + --------------------------------------------------------------------------- + +end Mod_Utils; diff --git a/src/crypto-types-big_numbers-utils.adb b/src/crypto-types-big_numbers-utils.adb new file mode 100644 index 0000000..313ce9b --- /dev/null +++ b/src/crypto-types-big_numbers-utils.adb @@ -0,0 +1,704 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +--with Ada.Integer_Text_IO; +--with Ada.Strings.Unbounded.Text_IO; +with Crypto.Types.Random; + +SEPARATE(Crypto.Types.Big_Numbers) + +package body Utils is + + pragma Optimize (Time); + + --------------------------------------------------------------------------- + + procedure Swap(X, Y : in out Big_Unsigned) is + Temp : constant Big_Unsigned := X; + begin + X := Y; + Y := Temp; + end Swap; pragma Inline (Swap); + + --------------------------------------------------------------------------- + + procedure Set_Least_Significant_Bit(X : in out Big_Unsigned) is + begin + X.Number(0) := X.Number(0) or 1; + end Set_Least_Significant_Bit; pragma Inline(Set_Least_Significant_Bit); + + --------------------------------------------------------------------------- + + function Is_Odd(X : Big_Unsigned) return Boolean is + begin + if (X.Number(0) and 1) = 1 then return True; + else return False; + end if; + end Is_Odd; pragma Inline(Is_Odd); + + --------------------------------------------------------------------------- + + function Is_Even(X : Big_Unsigned) return Boolean is + begin + if (X.Number(0) and 1) = 0 then return True; + else return False; + end if; + end Is_Even; pragma Inline(Is_Even); + + --------------------------------------------------------------------------- + + procedure Set_Most_Significant_Bit(X : in out Big_Unsigned) is + begin + X.Last_Index := Max_Length; + X.Number(Max_Length) := X.Number(Max_Length) or + Shift_Left(Word(1), Word'Size-1); + end Set_Most_Significant_Bit; pragma Inline(Set_Most_Significant_Bit); + + + --------------------------------------------------------------------------- + + function Bit_Length(X : Big_Unsigned) return Natural is + begin + if X = Big_Unsigned_Zero then + return 0; + end if; + + for I in reverse 0..Word'Size-1 loop + if Shift_Left(1,I) <= X.Number(X.Last_Index) then + return Word'Size * X.Last_Index + I + 1 ; + end if; + end loop; + return X.Last_Index * Word'Size; + end Bit_Length; pragma Inline(Bit_Length); + + --------------------------------------------------------------------------- + + function Lowest_Set_Bit(X : Big_Unsigned) return Natural is + begin + if X = Big_Unsigned_Zero then + raise Is_Zero_Error; + end if; + + for I in 0..X.Last_Index loop + if X.Number(I) /= 0 then + for J in 0..Word'Size-1 loop + if (Shift_Right(X.Number(I),J) and 1) = 1 then + return I*Word'Size+J+1; + end if; + end loop; + end if; + end loop; + return Size+1; --X = Big_unsgned_Zero = 2**(Size+1) + end Lowest_Set_Bit; pragma Inline (Lowest_Set_Bit); + + + --------------------------------------------------------------------------- + + + procedure Inc(X : in out Big_Unsigned) is + begin + if X = Big_Unsigned_Last then + X := Big_Unsigned_Zero; + else + X.Number(0) := X.Number(0) + 1; + for I in 0..X.Last_Index loop + if X.Number(I) /= 0 then + exit; + else X.Number(I+1) := X. Number(I+1) + 1; + end if; + end loop; + + -- if an mod_type overflow occure then we have some extra work do + if X.Number(X.Last_Index) = 0 then + X.Last_Index := X.Last_Index + 1; + end if; + end if; + end Inc; pragma Inline(Inc); + + --------------------------------------------------------------------------- + + procedure Dec(X : in out Big_Unsigned) is + begin + if X = Big_Unsigned_Zero then + X := Big_Unsigned_Last; + else + X.Number(0) := X.Number(0) - 1; + for I in 0..X.Last_Index loop + if X.Number(I) /= Word'Last then + exit; + else X.Number(I+1) := X.Number(I+1) - 1; + end if; + end loop; + + + -- check if we must dec the Last_index too + if X.Number(X.Last_Index) = 0 and X.Last_Index /= 0 then + X.Last_Index := X.Last_Index - 1; + end if; + end if; + end Dec; pragma Inline(Dec); + + --------------------------------------------------------------------------- + + function Shift_Left(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned is + begin + if Amount >= (Max_Length+1)*Word'Size or Value = Big_Unsigned_Zero + then return Big_Unsigned_Zero; + elsif Amount = 0 then return Value; + end if; + + declare + Result : Big_Unsigned; + Temp : Limbs:=(others => 0); + L : constant Natural := Amount mod Word'Size; + R : constant Natural := Word'Size-L; + M : constant Natural := Amount/Word'Size; + begin + Temp(0) := Shift_Left(Value.Number(0), L); + +-- for I in 1..Value.Last_Index loop +-- Temp(I) := Shift_Right(Value.Number(I-1), R) + +-- Shift_Left(Value.Number(I), L); +-- end loop; + for I in 1..Value.Last_Index loop + Temp(I) := Shift_Right(Value.Number(I-1), R) xor + Shift_Left(Value.Number(I), L); + end loop; + + if Value.Last_Index /= Max_Length then + Temp(Value.Last_Index+1):= + Shift_Right(Value.Number(Value.Last_Index), R); + end if; + + for I in Temp'Range loop + if (I+M) > Max_Length then + exit; + end if; + Result.Number(I+M):= Temp(I); + end loop; + for I in reverse 0..Max_Length loop + if Result.Number(I) /=0 then + Result.Last_Index:=I; + exit; + end if; + end loop; + return Result; + end; + end Shift_Left; -- pragma Inline (Shift_Left); + + --------------------------------------------------------------------------- + + function Shift_Right(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned is + begin + if Amount >= (Max_Length+1)*Word'Size or Value = Big_Unsigned_Zero + then return Big_Unsigned_Zero; + elsif Amount = 0 then return Value; + end if; + + declare + Result : Big_Unsigned:=Big_Unsigned_Zero; + Temp : Limbs :=(others => 0); + R : constant Natural := Amount mod Word'Size; + L : constant Natural := Word'Size-R; + M : constant Natural := Amount/Word'Size; + begin + Temp(Value.Last_Index) := + Shift_Right(Value.Number(Value.Last_Index), R); + +-- for I in reverse 0..Value.Last_Index-1 loop +-- Temp(I) := Shift_Left(Value.Number(I+1), L) + +-- Shift_Right(Value.Number(I), R); +-- end loop; + for I in reverse 0..Value.Last_Index-1 loop + Temp(I) := Shift_Left(Value.Number(I+1), L) xor + Shift_Right(Value.Number(I), R); + end loop; + + for I in reverse Temp'Range loop + if (I-M) < 0 then + exit; + end if; + Result.Number(I-M):= Temp(I); + end loop; + + for I in reverse 0..Value.Last_Index loop + if Result.Number(I) /= 0 or I = 0 then + Result.Last_Index := I; + exit; + end if; + end loop; + return Result; + end; + end Shift_Right; --pragma Inline (Shift_Right); + + + --------------------------------------------------------------------------- + + function Rotate_Left(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned is + L : constant Natural := Amount mod Size; + begin + if Value = Big_Unsigned_Last then + return Big_Unsigned_Last; + end if; + return Shift_Left(Value,L) xor Shift_Right(Value, Size-L); + end Rotate_Left; pragma Inline (Rotate_Left); + + --------------------------------------------------------------------------- + + function Rotate_Right(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned is + R : constant Natural := Amount mod Size; + begin + if Value = Big_Unsigned_Last then + return Big_Unsigned_Last; + end if; + return Shift_Right(Value,R) xor Shift_Left(Value, Size-R); + end Rotate_Right; pragma Inline (Rotate_Right); + + --------------------------------------------------------------------------- + + function Gcd(Left, Right : Big_Unsigned) return Big_Unsigned is + A : Big_Unsigned := Max(Left,Right); + B : Big_Unsigned := Min(Left,Right); + R : Big_Unsigned; + begin + while B /= Big_Unsigned_Zero loop + R := A mod B; + A := B; + B := R; + end loop; + return A; + end Gcd; pragma Inline (Gcd); + + --------------------------------------------------------------------------- + + function Get_Random return Big_Unsigned is + Result : Big_Unsigned; + begin + Random.Read(Result.Number); + return Result; + end Get_Random; pragma Inline (Get_Random); + + --------------------------------------------------------------------------- + + function Length_In_Bytes(X : Big_Unsigned) return Natural is + Len : constant Natural := Bit_Length(X); + begin + if Len mod Byte'Size = 0 then return (Len / Byte'Size); + else return (Len / Byte'Size) + 1; + end if; + end Length_In_Bytes; pragma Inline (Length_In_Bytes); + + --------------------------------------------------------------------------- + + function To_Big_Unsigned(X : Word) return Big_Unsigned is + Result : constant Big_Unsigned := + (Last_Index => 0, Number => (0 => X, OTHERS => 0)); + begin + return Result; + end To_Big_Unsigned; pragma Inline (To_Big_Unsigned); + + + function To_Words(X : Big_Unsigned) return Words is + begin + return X.Number(0..X.Last_Index); + end To_Words; pragma Inline (To_Words); + + + --------------------------------------------------------------------------- + + function Max(Left, Right : Integer) return Integer is + begin + if Left < Right then + return Right; + else + return Left; + end if; + end Max; + + + --------------------------------------------------------------------------- + + function To_Bytes(X : Big_Unsigned) return Bytes is + L : constant Natural := Max(Length_In_Bytes(X)-1,0); + M : constant Natural := 3; --(Word'Size / Byte'Size) - 1; + E : constant Integer := ((L+1) mod 4) - 1; + B : Bytes(0..L); + begin + for I in 0..X.Last_Index-1 loop + for J in 0..M loop + B(L-I*(M+1)-J) := Byte(Shift_Right(X.Number(I), J*Byte'Size) and + Word(Byte'Last)); + end loop; + end loop; + + if E >= 0 then + for I in 0..E loop + B(I) := Byte(Shift_Right(X.Number(X.Last_Index), (E-I)*Byte'Size) + and Word(Byte'Last)); + end loop; + else + for J in 0..M loop + B(M-J) := Byte(Shift_Right(X.Number(X.Last_Index), J*Byte'Size) + and Word(Byte'Last)); + end loop; + end if; + + return B; + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Big_Unsigned(X : Words) return Big_Unsigned is + Result : Big_Unsigned; + begin + if X'Length > Max_Length then + raise Constraint_Error; + else + Result.Number(0..X'Last-X'First) := X; + end if; + + for I in reverse 0..Max_Length loop + if Result.Number(I) /= 0 then + Result.Last_Index := I; + exit; + end if; + end loop; + + return Result; + end To_Big_Unsigned; + + --------------------------------------------------------------------------- + + function To_Big_Unsigned(X : Bytes) return Big_Unsigned is + Result : Big_Unsigned; + M : constant Natural := Word'Size / Byte'Size; -- Bytes per Word + Shift_Amount, counter : Natural:=0; + begin + if X'Length*Byte'Size > Size then + raise Constraint_Error; + end if; + + for I in reverse X'Range loop + Result.Number(Counter/M) := Result.Number(Counter/M) or + Shift_Left(Word(X(I)), Shift_Amount*Byte'Size); + Shift_Amount := (Shift_Amount + 1) mod M; + Counter:=Counter+1; + end loop; + + for I in reverse 0..Max_Length loop + if Result.Number(I) /= 0 then + Result.Last_Index := I; + exit; + end if; + end loop; + + return Result; + + end To_Big_Unsigned; + + --------------------------------------------------------------------------- + + procedure Big_Div(Dividend, Divisor : in Big_Unsigned; + Quotient, Remainder : out Big_Unsigned) is + Last_Divisor : constant Natural := Divisor.Last_Index; + begin + if (Last_Divisor = 0) then + case Divisor.Number(0) is + when 0 => raise Division_By_Zero; + when 1 => Quotient := Dividend; + Remainder := Big_Unsigned_Zero; + return; + when others => declare + Temp_Remainder : Word; + Temp_Divisor : constant Word := Divisor.Number(0); + begin + -- We use the function Short_Div, which is faster. + -- See below for the implementation of Short_Div. + Short_Div(Dividend, Temp_Divisor, Quotient, Temp_Remainder); + Remainder := (Last_Index => 0, + Number => (Temp_Remainder, others => 0)); + return; + end; + end case; + + elsif (Dividend < Divisor) then + Quotient := Big_Unsigned_Zero; + Remainder := Dividend; + return; + + elsif Dividend = Big_Unsigned_Zero then + Quotient := Big_Unsigned_Zero; + Remainder := Big_Unsigned_Zero; + return; + + elsif (Bit_Length(Dividend) = Bit_Length(Divisor)) then + -- Dividend > Divisor and Divisor /= 0 and + -- |Dividend|=|Divisor| => Dividend/Divisor=1 + Quotient:=Big_Unsigned_One; + Remainder:=Dividend-Divisor; + return; + end if; + + -- Now, there is only the case where (Dividend > Divisor), (Divisor /= 0) + -- and |Dividend|>|Divisor|. + + declare + Temp_Divisor: Big_Unsigned :=Divisor; + Diff: Natural; + begin + Remainder:= Dividend; + Quotient:=Big_Unsigned_Zero; + + while(Remainder >= Divisor) loop + Diff := Bit_Length(Remainder) - Bit_Length(Divisor); + if Diff = 0 then + Quotient:=Quotient+1; + Remainder:=Remainder-Divisor; + return; + else Diff:=Diff-1; + end if; + Temp_Divisor := Shift_Left(Divisor, Diff); + Remainder := Remainder-Temp_Divisor; + Quotient := Quotient + Shift_Left(Big_Unsigned_One, Diff); + end loop; + end; + end Big_Div; + + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + + procedure Short_Div(Dividend : in Big_Unsigned; + Divisor : in Word; + Quotient : out Big_Unsigned; + Remainder : out Word) is + begin + + -- simple cases + if (Dividend < Divisor) then + Remainder := Dividend.Number(0); + Quotient := Big_Unsigned_Zero; + return; + elsif (Divisor = 0) then + raise Division_By_Zero; + elsif (Divisor = 1) then + Quotient := Dividend; + Remainder := 0; + return; + elsif (Dividend = Divisor) then + Quotient := Big_Unsigned_One; + Remainder := 0; + return; + end if; + + declare + Last_Dividend : constant Natural := Dividend.Last_Index; + Temp_Quotient : Big_Unsigned; + Carry : Largest_Unsigned := 0; + Temp : Largest_Unsigned; + Temp_Divisor : constant Largest_Unsigned := + Largest_Unsigned(Divisor); + + begin + for I in reverse 0..Last_Dividend loop + Temp := Largest_Unsigned(Dividend.Number(I)) + + Shift_Left(Carry, Word'Size); + Temp_Quotient.Number(I) := Word(Temp / Temp_Divisor); + Carry := Temp mod Temp_Divisor; + end loop; + + if (Last_Dividend > 0) and then + (Temp_Quotient.Number(Last_Dividend) = 0) then + Temp_Quotient.Last_Index := Last_Dividend - 1; + else + Temp_Quotient.Last_Index := Last_Dividend; + end if; + Quotient := Temp_Quotient; + Remainder := Word(Carry); + end; + end Short_Div; + + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + +-- package IIO renames Ada.Integer_Text_IO; +-- package UIO renames Ada.Strings.Unbounded.Text_IO; + + --------------------------------------------------------------------------- + + function To_String(Item : Big_Unsigned; + Base : Number_Base := 10) return String is + S : Unbounded_String := Null_Unbounded_String; + Remainder : Word:=0; + Temp_Item : Big_Unsigned := Item; + Trans : constant array(Word range 0..15) of Character := + ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); + Base_Img : constant String := Base'Img; + begin + if Item = Big_Unsigned_Zero then + if Base = 10 then return "0"; + else + S := "#0#" & S; + S := Base_Img & S; + return Slice(S,2,Length(S)); + end if; + else + if Base /= 10 then + S := "#" & S; + end if; + while (Temp_Item /= Big_Unsigned_Zero) loop + Short_Div(Temp_Item, Word(Base), Temp_Item, Remainder); + S := Trans(Remainder) & S; + end loop; + if Base /= 10 then + S := "#" & S; + S := Base_Img & S; + return Slice(S,2,Length(S)); + end if; + end if; + return To_String(S); + end To_String; + + --------------------------------------------------------------------------- + + procedure Put(Item : in Big_Unsigned; Base : in Number_Base := 10) is + begin + Put(To_String(Item, Base)); + end Put; --pragma Inline(Put); + + --------------------------------------------------------------------------- + + procedure Put_Line(Item : in Big_Unsigned; Base : in Number_Base := 10) is + begin + Put(To_String(Item, Base)); New_Line; + end Put_Line; --pragma Inline(Put_Line); + + --------------------------------------------------------------------------- + + function Get_Digit(C : Character) return Word is + begin + case C is + when '0'..'9' => return Character'Pos(C) - Character'Pos('0'); + when 'A'..'F' => return Character'Pos(C) - Character'Pos('A') + 10; + when others => raise Conversion_Error; + end case; + end Get_Digit; pragma Inline(Get_Digit); + + --------------------------------------------------------------------------- + + function To_Big_Unsigned(S : String) return Big_Unsigned is + Fence_Count: Natural := 0; + Temp : Unbounded_String := Null_Unbounded_String; + M_B : Natural:=0; + begin + if S'Length = 0 then + raise Conversion_Error; + else + for I in reverse S'Range loop + case S(I) is + when '0' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,0); + when '1' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,1); + when '2' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,2); + when '3' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,3); + when '4' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,4); + when '5' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,5); + when '6' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,6); + when '7' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,7); + when '8' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,8); + when '9' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,9); + when 'a' | 'A' => Temp:= 'A' & Temp; M_B:=Natural'Max(M_B,11); + when 'b' | 'B' => Temp:= 'B' & Temp; M_B:=Natural'Max(M_B,12); + when 'c' | 'C' => Temp:= 'C' & Temp; M_B:=Natural'Max(M_B,13); + when 'd' | 'D' => Temp:= 'D' & Temp; M_B:=Natural'Max(M_B,14); + when 'e' | 'E' => Temp:= 'E' & Temp; M_B:=Natural'Max(M_B,15); + when 'f' | 'F' => Temp:= 'F' & Temp; M_B:=Natural'Max(M_B,16); + when '_' | ' ' => null; + when '#' => Fence_Count := Fence_Count+1; Temp:= S(I) & Temp; + when others => raise Conversion_Error; + end case; + end loop; + end if; + + declare + Result : Big_Unsigned; + S2 : constant String := To_String(Temp); + begin + + -- Base = 10 + if Fence_Count = 0 then + if M_B > 10 then + raise Conversion_Error; + end if; + for I in S2'Range loop + Result := Result * 10 + Get_Digit(S2(I)); + end loop; + return Result; + + -- Base /= 10 + -- check fences and size (Min_Size=|2#0#|=4) + elsif Fence_Count /= 2 or S2(S2'Last) /= '#' or S2(S2'First) = '#' + or S2'Length < 4 then + raise Conversion_Error; + end if; + + declare + Base : Number_Base; + begin + --Compute and check Base + if S2(S2'First+1) /= '#' then + if S2(S2'First+2) /= '#' then + raise Conversion_Error; + end if; + Base := Number_Base(Get_Digit(S2(S2'First)) * 10 + + Get_Digit(S2(S2'First+1))); + else Base := Number_Base(Get_Digit(S2(S2'First))); + end if; + + -- Check if all Characters are valid to the base + if M_B > Base then + raise Conversion_Error; + end if; + + --Time to compute the Big_Unsigned + if Base > 10 then + for I in S2'First+3..S2'Last-1 loop + Result := Result * Word(Base) + Get_Digit(S2(I)); + end loop; + else + for I in S2'First+2..S2'Last-1 loop + Result := Result * Word(Base) + Get_Digit(S2(I)); + end loop; + end if; + return Result; + end; + end; + end To_Big_Unsigned; + + --------------------------------------------------------------------------- + + end Utils; + diff --git a/src/crypto-types-big_numbers.adb b/src/crypto-types-big_numbers.adb new file mode 100644 index 0000000..b69e55b --- /dev/null +++ b/src/crypto-types-big_numbers.adb @@ -0,0 +1,921 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +package body Crypto.Types.Big_Numbers is + + -- package MIO is new Ada.Text_Io.Modular_IO (Word); + + --------------------------------------------------------------------------- + -----------------------SEPARATED_BODYS------------------------------------- + --------------------------------------------------------------------------- + + package body Utils is separate; + use Utils; + + package body Mod_Utils is separate; + use Mod_Utils; + + package body Binfield_Utils is separate; + use Binfield_Utils; + + --------------------------------------------------------------------------- + ---------------------------COMPARE_FUNCTIONS-------------------------------- + --------------------------------------------------------------------------- + + + --------------------------------------------------------------------------- + -- compare: Big_Unsigned with Big_Unsigned -- + --------------------------------------------------------------------------- + + + function "="(Left, Right : Big_Unsigned) return Boolean is + begin + if Left.Last_Index = Right.Last_Index then + for I in 0..Left.Last_Index loop + if Left.Number(I) /= Right.Number(I) then return False; + end if; + end loop; + else return False; + end if; + return True; + end "="; + + --------------------------------------------------------------------------- + + function "<"(Left, Right : Big_Unsigned) return Boolean is + begin + if Left.Last_Index < Right.Last_Index then return True; + elsif Left.Last_Index > Right.Last_Index then return False; + else + for I in reverse 0..Left.Last_Index loop + if Left.Number(I) < Right.Number(I) then return True; + elsif Left.Number(I) > Right.Number(I) then return False; + end if; + end loop; + end if; + return False; + end "<"; + + --------------------------------------------------------------------------- + + function ">"(Left, Right : Big_Unsigned) return Boolean is + begin + return Right < Left; + end ">"; + + --------------------------------------------------------------------------- + + function "<="(Left, Right : Big_Unsigned) return Boolean is + begin + return not (Right < Left); + end "<="; + + + --------------------------------------------------------------------------- + + + function ">="(Left, Right : Big_Unsigned) return Boolean is + begin + return not (Left < Right); + end ">="; + + --------------------------------------------------------------------------- + + function Min(X, Y : in Big_Unsigned) return Big_Unsigned is + begin + if (X < Y) then return X; + else return Y; + end if; + end Min; + + --------------------------------------------------------------------------- + + function Max(X, Y : in Big_Unsigned) return Big_Unsigned is + begin + if (X < Y) then return Y; + else return X; + end if; + end Max; + + + --------------------------------------------------------------------------- + -- compare: Big_Unsigned with Word -- + --------------------------------------------------------------------------- + + + function "="(Left : Big_Unsigned; Right : Word) return Boolean is + begin + if Left.Last_Index=0 and Left.Number(0) = Right then return True; + else return False; + end if; + end "="; + + --------------------------------------------------------------------------- + + function "="(Left : Word; Right : Big_Unsigned) return Boolean is + begin + return Right = Left; + end "="; + + --------------------------------------------------------------------------- + + function "<"(Left : Big_Unsigned; Right : Word) return Boolean is + begin + if Left.Last_Index > 0 then return False; + else return Left.Number(Left.Last_Index) < Right; + end if; + end "<"; + + --------------------------------------------------------------------------- + + function "<"(Left : Word; Right : Big_Unsigned) return Boolean is + begin + if Right.Last_Index > 0 then return True; + else return Left < Right.Number(Right.Last_Index); + end if; + end "<"; + + --------------------------------------------------------------------------- + + function ">"(Left : Big_Unsigned; Right : Word) return Boolean is + begin + return Right < Left; + end ">"; + + --------------------------------------------------------------------------- + + function ">"(Left : Word; Right : Big_Unsigned) return Boolean is + begin + return Right < Left; + end ">"; + + --------------------------------------------------------------------------- + + function "<="(Left : Big_Unsigned; Right : Word) return Boolean is + begin + return not (Right < Left); + end "<="; + + --------------------------------------------------------------------------- + + function "<="(Left : Word; Right : Big_Unsigned) return Boolean is + begin + return not (Right < Left); + end "<="; + + --------------------------------------------------------------------------- + + function ">="(Left : Big_Unsigned; Right : Word) return Boolean is + begin + return not (Left < Right); + end ">="; + + --------------------------------------------------------------------------- + + function ">="(Left : Word; Right : Big_Unsigned) return Boolean is + begin + return not (Left < Right); + end ">="; + + + --------------------------------------------------------------------------- + ----------------------------BASE_FUNCTIONS--------------------------------- + --------------------------------------------------------------------------- +--============================================================================-- + + function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + L : constant Natural := Natural'Max( Bit_Length(Left), Bit_Length(Right)); + begin + if L + 1 <= Word'Size then + Result.Number(0) := Left.Number(0) + Right.Number(0); + else + + declare + Carry : Big_Unsigned; + Temp : Big_Unsigned; + begin + Carry := Left and Right; + Result := Left xor Right; + Carry := Shift_Left(Carry,1); + loop + Temp := Result and Carry; + Result := Result xor Carry; + Carry := Temp; + Carry := Shift_Left(Carry,1); + exit when Carry = Big_Unsigned_Zero; + end loop; + end; + end if; + + return Result; + end "+"; + +-- function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is +-- Result: Big_Unsigned; +-- Carry : Big_Unsigned; +-- Temp : Big_Unsigned; +-- begin +-- Carry := Left and Right; +-- Result := Left xor Right; +-- Carry := Shift_Left(Carry,1); +-- --ADA Do_While +-- loop +-- Temp := Result and Carry; +-- Result := Result xor Carry; +-- Carry := Temp; +-- Carry := Shift_Left(Carry,1); +-- exit when Carry = Big_Unsigned_Zero; +-- end loop; +-- return Result; +-- end "+"; +-------------------------------------------------------------------------------- +-- function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is +-- Result : Big_Unsigned; +-- M : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index); +-- Temp : Word; +-- Carry : Word :=0; +-- begin +-- for I in 0..M loop +-- Temp :=Carry; +-- Result.Number(I) := Left.Number(I) + Right.Number(I) +Temp; +-- if Result.Number(I) < Word'Max(Left.Number(I), Right.Number(I)) +-- then Carry := 1; +-- else Carry := 0; +-- end if; +-- end loop; + +-- if Carry =1 and M < Max_Length then +-- Result.Number(M+1) := 1; +-- Result.Last_Index := M+1; +-- else +-- -- Set Result.Last_Index +-- for I in reverse 0..M loop +-- if Result.Number(I) /= 0 then +-- Result.Last_Index := I; +-- return Result; +-- end if; +-- end loop; +-- end if; +-- return Result; +-- end "+"; +--============================================================================-- + --------------------------------------------------------------------------- + + function "+"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is + Big_Right : Constant Big_Unsigned := + (Last_Index => 0, Number => (0 => Right, OTHERS => 0)); + begin + return Left + Big_Right; + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is + Big_Left : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Left, OTHERS => 0)); + begin + return Big_Left + Right; + end "+"; + + --------------------------------------------------------------------------- + + function "-"(Left, Right : Big_Unsigned) return Big_Unsigned is + begin + -- Add the modulus if Right > Left + if Right > Left then + return Big_Unsigned_Last - Right + Left + 1; +-- raise Big_Unsigned_Negative; -- RSA does not run + else + declare + Result : Big_Unsigned; + Carry : Word:=0; + begin + -- Remember: Left => Right + for I in 0..Left.Last_Index loop + Result.Number(I) := Left.Number(I) - Right.Number(I) - Carry; + if (Right.Number(I) > Left.Number(I)) or + (Carry= 1 and Right.Number(I) = Left.Number(I)) + then Carry :=1; + else Carry :=0; + end if; + if Result.Number(I) /= 0 then + Result.Last_Index := I; + end if; + end loop; + return Result; + end; + end if; + end "-"; + + --------------------------------------------------------------------------- + + function "-"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is + Big_Right : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Right, OTHERS => 0)); + begin + return Left - Big_Right; + end "-"; + + --------------------------------------------------------------------------- + + function "-"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is + Big_Left : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Left, OTHERS => 0)); + begin + return Big_Left - Right; + end "-"; + + --------------------------------------------------------------------------- + + function "-"(X : Big_Unsigned) return Big_Unsigned is + begin + if X /= Big_Unsigned_Zero then + return Big_Unsigned_Last-X-1; + else + return X; + end if; + end "-"; + + --------------------------------------------------------------------------- +--============================================================================-- + + function "*"(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned ; + L : constant Natural := Bit_Length(Left)+Bit_Length(Right); + begin + if L <= Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + elsif L > 2800 and L <= 3600 then + Result := Karatsuba_P(Left, Right); + elsif L > 3600 then + Result := Toom_Cook_P(Left, Right); + else + declare + Temp : Big_Unsigned; + begin + for I in reverse 0..Left.Last_Index loop + Temp := Left.Number(I) * Right; + Temp := Shift_Left(Temp, (I*Word'Size)); + Result := Result + Temp; + end loop; + end; + end if; + return Result; + end "*"; +-------------------------------------------------------------------------------- + + function Russ (Left,Right : Big_Unsigned)return Big_Unsigned is + Result : Big_Unsigned ; + begin + if Bit_Length(Left)+Bit_Length(Right) <= Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + else + declare + AA : Big_Unsigned := Left; + BB : Big_Unsigned := Right; + begin + while AA > Big_Unsigned_Zero loop + if (AA and Big_Unsigned_One) = 1 then + Result := Result + BB; + AA := AA - 1; + end if; + AA := Shift_Right(AA, 1); + BB := Shift_Left(BB, 1); + end loop; + end; + end if; + return Result; + end Russ; + +-------------------------------------------------------------------------------- + + function Karatsuba (Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + begin + if Bit_Length(Left)+Bit_Length(Right) < Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + else + declare + Left_1, Left_2 : Big_Unsigned; + Right_1, Right_2 : Big_Unsigned; + P_1, P_2 : Big_Unsigned; + N : constant Natural := Natural'Max( Bit_Length(Left) + , Bit_Length(Right))/2; + begin + Left_1 := Shift_Right(Left, N); + Left_2 := Left - Shift_Left( Left_1, N ); + Right_1 := Shift_Right(Right, N); + Right_2 := Right - Shift_Left( Right_1, N ); + + P_1 := Left_1 * Right_1; + P_2 := Left_2 * Right_2; + Result := Shift_Left(P_1, 2*N) + + Shift_Left(((Left_1 + Left_2)*(Right_1 + Right_2)) - P_1 - P_2, N) + + P_2; + end; + end if; + return Result; + end Karatsuba; + + +-------------------------------------------------------------------------------- + + function Karatsuba_P (Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + begin + if Bit_Length(Left)+Bit_Length(Right) < Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + else + declare + Left_1, Left_2 : Big_Unsigned:= Big_Unsigned_Zero; + Right_1, Right_2 : Big_Unsigned:= Big_Unsigned_Zero; + P_1, P_2, P_3 : Big_Unsigned:= Big_Unsigned_Zero; + N : constant Natural := Natural'Max( Bit_Length(Left), + Bit_Length(Right))/2; + ----------------------------------------------------------------------- + task type Karatsuba_Task_Type is + entry Input (Left, Right : in Big_Unsigned); + entry Output(Result : out Big_Unsigned); + end Karatsuba_Task_Type; + task body Karatsuba_Task_Type is + X : Big_Unsigned; + Left_Local : Big_Unsigned; + Right_Local : Big_Unsigned; + begin + accept Input (Left, Right : Big_Unsigned) do + Left_Local := Left; + Right_Local := Right; + end Input; + +-- X := Karatsuba(Left_Local, Right_Local); + X := Left_Local * Right_Local; + + accept Output(Result : out Big_Unsigned) do + Result := X; + end Output; + end Karatsuba_Task_Type; + Task_1 : Karatsuba_Task_Type; + Task_2 : Karatsuba_Task_Type; + Task_3 : Karatsuba_Task_Type; + ----------------------------------------------------------------------- + begin + Left_1 := Shift_Right(Left, N); + Left_2 := Left - Shift_Left( Left_1, N ); + Right_1 := Shift_Right(Right, N); + Right_2 := Right - Shift_Left( Right_1, N ); + + Task_1.Input(Left_1, Right_1); + Task_2.Input(Left_2, Right_2); + Task_3.Input((Left_1 + Left_2), (Right_1 + Right_2)); + + Task_1.Output(Result => P_1); + Task_2.Output(Result => P_2); + Task_3.Output(Result => P_3); + + Result := Shift_Left(P_1, 2*N) + + Shift_Left((P_3 - P_1 - P_2), N) + + P_2; + end; + end if; + return Result; + end Karatsuba_P; + + ----------------------------------------------------------------------- + + function Toom_Cook(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + begin + if Bit_Length(Left)+Bit_Length(Right) < Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + else + + declare + knuth_1 : Array (1..5) of Big_Unsigned; + knuth_2 : Array (1..4) of Big_Unsigned; + knuth_3 : Array (1..3) of Big_Unsigned; + knuth_4 : Array (1..2) of Big_Unsigned; + knuth_5_1 : Big_Unsigned; + L, R : Array (0..3) of Big_Unsigned; + F_Left, F_Right : Array (2..4) of Big_Unsigned; + Z : Array (0..4) of Big_Unsigned; + Length : constant Natural := Natural'Max( Bit_Length(Left) , + Bit_Length(Right) ); + N : constant Natural := Length / 3; + DN : constant Natural := 2 * N; + + begin + + -- SPLITTING ............................................................. + + L(0) := Shift_Right( Left, DN); + L(1) := Shift_Right( Left, N ) - Shift_Left( L(0), N ); + L(2) := Left - Shift_Left( L(0), DN ) - Shift_Left( L(1), N ); + R(0) := Shift_Right( Right, DN); + R(1) := Shift_Right( Right, N ) - Shift_Left( R(0), N ); + R(2) := Right - Shift_Left( R(0), DN ) - Shift_Left( R(1), N ); + + F_Left(2) := Shift_Left(L(0),2) + Shift_Left(L(1),1) + L(2); + F_Right(2) := Shift_Left(R(0),2) + Shift_Left(R(1),1) + R(2); + F_Left(3) := (Shift_Left(L(0),3) + L(0)) + (Shift_Left(L(1),1)+L(1)) + L(2); + F_Right(3) := (Shift_Left(R(0),3) + R(0)) + (Shift_Left(R(1),1)+R(1)) + R(2); + F_Left(4) := Shift_Left(L(0),4) + Shift_Left(L(1),2) + L(2); + F_Right(4) := Shift_Left(R(0),4) + Shift_Left(R(1),2) + R(2); + + -- INTERPOLATION with POINTWISE MULT ..................................... + + knuth_1(1) := L(2)* R(2); + knuth_1(2) := (L(0) + L(1) + L(2)) * (R(0) + R(1) + R(2)); + knuth_1(3) := F_Left(2) * F_Right(2); + knuth_1(4) := F_Left(3) * F_Right(3); + knuth_1(5) := F_Left(4) * F_Right(4); + + knuth_2(1) := knuth_1(2) - knuth_1(1); + knuth_2(2) := knuth_1(3) - knuth_1(2); + knuth_2(3) := knuth_1(4) - knuth_1(3); + knuth_2(4) := knuth_1(5) - knuth_1(4); + knuth_3(1) := Shift_Right((knuth_2(2) - knuth_2(1)),1); + knuth_3(2) := Shift_Right((knuth_2(3) - knuth_2(2)),1); + knuth_3(3) := Shift_Right((knuth_2(4) - knuth_2(3)),1); + knuth_4(1) := (knuth_3(2) - knuth_3(1)) / 3; + knuth_4(2) := (knuth_3(3) - knuth_3(2)) / 3; + knuth_5_1 := Shift_Right(knuth_4(2) - knuth_4(1),2); + + Z(0) := knuth_5_1; + Z(1) := knuth_4(1); + Z(2) := knuth_3(1); + Z(3) := knuth_2(1); + Z(4) := knuth_1(1); + + -- RECOMPOSITION ............................................................ + + knuth_1(1) := Z(1) - (Z(0) + Shift_Left(Z(0),1)); + knuth_1(2) := knuth_1(1) - (Shift_Left(Z(0),1)); + knuth_1(3) := knuth_1(2) - Z(0); + knuth_2(1) := Z(2) - (Shift_Left(knuth_1(1),1)); + knuth_2(2) := knuth_2(1) - knuth_1(2); + knuth_3(1) := Z(3) - knuth_2(1); + + Result := Shift_Left( Z(0), DN*2) + + Shift_Left(knuth_1(3), DN+N) + + Shift_Left(knuth_2(2), DN) + + Shift_Left(knuth_3(1), N) + + Z(4); + end; + end if; + return Result; + end Toom_Cook; + +-------------------------------------------------------------------------------- + + function Toom_Cook_P(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + begin + if Bit_Length(Left)+Bit_Length(Right) < Word'Size then + Result.Number(0) := Left.Number(0) * Right.Number(0); + else + declare + knuth_1 : Array (1..5) of Big_Unsigned; + knuth_2 : Array (1..4) of Big_Unsigned; + knuth_3 : Array (1..3) of Big_Unsigned; + knuth_4 : Array (1..2) of Big_Unsigned; + knuth_5_1 : Big_Unsigned; + L, R : Array (0..3) of Big_Unsigned; + F_Left, F_Right : Array (2..4) of Big_Unsigned; + Z : Array (0..4) of Big_Unsigned; + + Length : constant Natural := Natural'Max(Bit_Length(Left) , + Bit_Length(Right) ); + N : constant Natural := Length / 3; + DN : constant Natural := 2 * N; + + task type Toom_Cook_Task_Type is + entry Input (Left, Right : in Big_Unsigned); + entry Output(Result : out Big_Unsigned); + end Toom_Cook_Task_Type; + task body Toom_Cook_Task_Type is + X : Big_Unsigned; + Left_Local : Big_Unsigned; + Right_Local : Big_Unsigned; + begin + accept Input (Left, Right : Big_Unsigned) do + Left_Local := Left; + Right_Local := Right; + end Input; + + X := Left_Local * Right_Local; + + accept Output(Result : out Big_Unsigned) do + Result := X; + end Output; + end Toom_Cook_Task_Type; + + Task_1 : Toom_Cook_Task_Type; + Task_2 : Toom_Cook_Task_Type; + Task_3 : Toom_Cook_Task_Type; + Task_4 : Toom_Cook_Task_Type; + Task_5 : Toom_Cook_Task_Type; + + begin + -- SPLITTING ............................................................. + L(0) := Shift_Right( Left, DN); + L(1) := Shift_Right( Left, N ) - Shift_Left( L(0), N ); + L(2) := Left - Shift_Left( L(0), DN ) - Shift_Left( L(1), N ); + R(0) := Shift_Right( Right, DN); + R(1) := Shift_Right( Right, N ) - Shift_Left( R(0), N ); + R(2) := Right - Shift_Left( R(0), DN ) - Shift_Left( R(1), N ); + -- EVALUATION ............................................................ + F_Left(2) := Shift_Left(L(0),2) + Shift_Left(L(1),1) + L(2); + F_Right(2) := Shift_Left(R(0),2) + Shift_Left(R(1),1) + R(2); + F_Left(3) := (Shift_Left(L(0),3) + L(0)) + + (Shift_Left(L(1),1)+L(1)) + L(2); + F_Right(3) := (Shift_Left(R(0),3) + R(0)) + + (Shift_Left(R(1),1)+R(1)) + R(2); + F_Left(4) := Shift_Left(L(0),4) + Shift_Left(L(1),2) + L(2); + F_Right(4) := Shift_Left(R(0),4) + Shift_Left(R(1),2) + R(2); + -- INTERPOLATION with POINTWISE MULT ..................................... + Task_1.Input( L(2), R(2) ); + Task_2.Input(L(0) + L(1) + L(2), R(0) + R(1) + R(2)); + Task_3.Input(F_Left(2), F_Right(2)); + Task_4.Input(F_Left(3), F_Right(3)); + Task_5.Input(F_Left(4), F_Right(4)); + Task_1.Output(Result => knuth_1(1)); + Task_2.Output(Result => knuth_1(2)); + Task_3.Output(Result => knuth_1(3)); + Task_4.Output(Result => knuth_1(4)); + Task_5.Output(Result => knuth_1(5)); + + knuth_2(1) := knuth_1(2) - knuth_1(1); + knuth_2(2) := knuth_1(3) - knuth_1(2); + knuth_2(3) := knuth_1(4) - knuth_1(3); + knuth_2(4) := knuth_1(5) - knuth_1(4); + knuth_3(1) := Shift_Right((knuth_2(2) - knuth_2(1)),1); + knuth_3(2) := Shift_Right((knuth_2(3) - knuth_2(2)),1); + knuth_3(3) := Shift_Right((knuth_2(4) - knuth_2(3)),1); + knuth_4(1) := (knuth_3(2) - knuth_3(1)) / 3; + knuth_4(2) := (knuth_3(3) - knuth_3(2)) / 3; + knuth_5_1 := Shift_Right(knuth_4(2) - knuth_4(1),2); + + Z(0) := knuth_5_1; + Z(1) := knuth_4(1); + Z(2) := knuth_3(1); + Z(3) := knuth_2(1); + Z(4) := knuth_1(1); + -- RECOMPOSITION ......................................................... + knuth_1(1) := Z(1) - (Z(0) + Shift_Left(Z(0),1)); + knuth_1(2) := knuth_1(1) - (Shift_Left(Z(0),1)); + knuth_1(3) := knuth_1(2) - Z(0); + knuth_2(1) := Z(2) - (Shift_Left(knuth_1(1),1)); + knuth_2(2) := knuth_2(1) - knuth_1(2); + knuth_3(1) := Z(3) - knuth_2(1); + + Result := Shift_Left( Z(0), DN*2) + + Shift_Left(knuth_1(3), DN+N) + + Shift_Left(knuth_2(2), DN) + + Shift_Left(knuth_3(1), N) + + Z(4); + end; + end if; + return Result; + end Toom_Cook_P; + +--============================================================================-- + --------------------------------------------------------------------------- + + function "*"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is + begin + if Right = 0 or Left = Big_Unsigned_Zero then return Big_Unsigned_Zero; + elsif Right = 1 then return Left; + end if; + + declare + Result : Big_Unsigned; + begin + for I in 0..Word'Size loop + if (Shift_Right(Right,I) mod 2) = 1 then + Result:= Result + Shift_Left(Left,I); + end if; + end loop; + return Result; + end; + end "*"; + + --------------------------------------------------------------------------- + + function "*"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is + begin + return Right * Left; + end "*"; + + --------------------------------------------------------------------------- + + function "**"(Left, Right : Big_Unsigned) return Big_Unsigned is + begin + if Left = Big_Unsigned_Zero or Left = Big_Unsigned_One then + return Left; + end if; + + -- Square_And_Multiply + declare + Result : Big_Unsigned := Big_Unsigned_One; + begin + for I in reverse 0..Bit_Length(Right)-1 loop + Result := Result * Result; + if (Shift_Right(Right, I) mod 2) = Big_Unsigned_One then + Result := Result * Left; + end if; + end loop; + return Result; + end; + end "**"; + + --------------------------------------------------------------------------- + + + function "/"(Left, Right : Big_Unsigned) return Big_Unsigned is + Q : Big_Unsigned; + R : Big_Unsigned; + begin + Big_Div(Left,Right,Q,R); + return Q; + end "/"; + + --------------------------------------------------------------------------- + + function "/"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is + Big_Left: constant Big_Unsigned := + (Last_Index => 0, Number => (0=> Left, others => 0)); + Q : Big_Unsigned; + R : Big_Unsigned; + begin + Big_Div(Big_Left,Right,Q,R); + return Q; + end "/"; + + --------------------------------------------------------------------------- + + function "/"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is + Q : Big_Unsigned; + R : Word; + begin + Short_Div(Left,Right,Q,R); + return Q; + end "/"; + + + --------------------------------------------------------------------------- + + function "mod"(Left, Right : Big_Unsigned) return Big_Unsigned is + Q : Big_Unsigned; + R : Big_Unsigned; + begin + Big_Div(Left,Right,Q,R); + return R; + end "mod"; + + + + --------------------------------------------------------------------------- + + function "mod"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is + Q : Big_Unsigned; + R : Word; + begin + Short_Div(Left,Right,Q,R); + declare + Result: constant Big_Unsigned := + (Last_Index => 0, Number => (0 => R, others => 0)); + begin + return Result; + end; + end "mod"; + + --------------------------------------------------------------------------- + + -- This is a helper function + -- This procedure computes/adjust the Last_Index of B + procedure Last_Index(B : in out Big_Unsigned; M : in M_Len:=Max_Length) is + begin + for I in reverse 0..M loop + if B.Number(I) /= 0 then + B.Last_Index := I; + exit; + end if; + end loop; + end Last_Index; pragma Inline (Last_Index); + + --------------------------------------------------------------------------- + + + function "xor"(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index); + begin + -- xor + for I in 0..M loop + Result.Number(I) := Left.Number(I) xor Right.Number(I); + end loop; + + -- compute the Last_Index + Last_Index(Result,M); + + return Result; + + end "xor"; + + --------------------------------------------------------------------------- + + function "and"(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + M : constant Natural:= Natural'Min(Left.Last_Index, Right.Last_Index); + begin + + --and + for I in 0..M loop + Result.Number(I) := Left.Number(I) and Right.Number(I); + end loop; + + -- compute last index + Last_Index(Result, M); + + return Result; + end "and"; + + --------------------------------------------------------------------------- + + + function "and"(Left : Big_Unsigned; Right : Word) return Big_Unsigned + is + Result : Big_Unsigned; + begin + + Result.Number(0) := Left.Number(0) and Right; + + -- compute last index + Last_Index(Result, 0); + + return Result; + end "and"; + + --------------------------------------------------------------------------- + + function "and"(Left : Word; Right : Big_Unsigned) return Big_Unsigned + is + Result : Big_Unsigned; + begin + + Result.Number(0) := Left and Right.Number(0); + + -- compute last index + Last_Index(Result, 0); + + return Result; + end "and"; + + --------------------------------------------------------------------------- + + + function "or"(Left, Right : Big_Unsigned) return Big_Unsigned is + Result : Big_Unsigned; + M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index); + begin + -- or + for I in 0..M loop + Result.Number(I) := Left.Number(I) or Right.Number(I); + end loop; + + -- compute last index + Last_Index(Result, M); + + return Result; + end "or"; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + +begin + if Size mod Word'Size /= 0 then + Put("Size must be a multiple of " & Word'Image(Word'Size)); + raise Constraint_Size_Error; + end if; +end Crypto.Types.Big_Numbers; diff --git a/src/crypto-types-big_numbers.ads b/src/crypto-types-big_numbers.ads new file mode 100644 index 0000000..f75ad6b --- /dev/null +++ b/src/crypto-types-big_numbers.ads @@ -0,0 +1,399 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +-- With this packet you can generate (unsigned) n-Bit Numbers (Big_Unsigned). +-- You can only create k*m Bit-Numbers where 1 < k < 2**32 and m is the +-- size of a CPU-Word. For further informations read the ACL documentation. + +-- The look and feel is "borrowed" from J. Delcourt BIG_NUMBER package. +-- First I want to use Delcourts package directly, but then I decided to +-- rewrite it completly form scratch. ;-) + +with System; + +with Crypto.Types; +use Crypto.Types; + +generic + Size : Positive; + +package Crypto.Types.Big_Numbers is + + type Big_Unsigned is private; + subtype Number_Base is Integer range 2 .. 16; + + -- Do not use this type. This one is only needed for internal purpose. + type D_Big_Unsigned is private; + + --------------------------------------------------------------------------- + ---------------------------Constants--------------------------------------- + --------------------------------------------------------------------------- + + -- A few constants + Big_Unsigned_Zero : constant Big_Unsigned; -- 0 + Big_Unsigned_One : constant Big_Unsigned; -- 1 + Big_Unsigned_Two : constant Big_Unsigned; -- 2 + Big_Unsigned_Three : constant Big_Unsigned; -- 3 + Big_Unsigned_Four : constant Big_Unsigned; -- 4 + Big_Unsigned_Ten : constant Big_Unsigned; -- 10 + Big_Unsigned_Sixteen : constant Big_Unsigned; -- 16 + Big_Unsigned_First : constant Big_Unsigned; -- 0 + Big_Unsigned_Last : constant Big_Unsigned; -- "Big_Unsigned'Last" + + --------------------------------------------------------------------------- + ----------------------------Compare---------------------------------------- + --------------------------------------------------------------------------- + + -- compare: Big Unsigned with Big_Unsigned + function "="(Left, Right : Big_Unsigned) return Boolean; + function "<"(Left, Right : Big_Unsigned) return Boolean; + function ">"(Left, Right : Big_Unsigned) return Boolean; + + function "<="(Left, Right : Big_Unsigned) return Boolean; + function ">="(Left, Right : Big_Unsigned) return Boolean; + + function Min(X, Y : in Big_Unsigned) return Big_Unsigned; + function Max(X, Y : in Big_Unsigned) return Big_Unsigned; + + -- compare: Big Unsigned with Word + function "="(Left : Big_Unsigned; Right : Word) return Boolean; + function "="(Left : Word; Right : Big_Unsigned) return Boolean; + + function "<"(Left : Big_Unsigned; Right : Word) return Boolean; + function "<"(Left : Word; Right : Big_Unsigned) return Boolean; + + function ">"(Left : Big_Unsigned; Right : Word) return Boolean; + function ">"(Left : Word; Right : Big_Unsigned) return Boolean; + + function "<="(Left : Big_Unsigned; Right : Word) return Boolean; + function "<="(Left : Word; Right : Big_Unsigned) return Boolean; + + function ">="(Left : Big_Unsigned; Right : Word) return Boolean; + function ">="(Left : Word; Right : Big_Unsigned) return Boolean; + + + --------------------------------------------------------------------------- + -----------------------------Basic----------------------------------------- + --------------------------------------------------------------------------- + + function "+"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "+"(Left : Big_Unsigned; Right : Word) return Big_Unsigned; + function "+"(Left : Word; Right : Big_Unsigned) return Big_Unsigned; + + function "-"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "-"(Left : Big_Unsigned; Right : Word) return Big_Unsigned; + function "-"(Left : Word; Right : Big_Unsigned) return Big_Unsigned; + + function "-"(X : Big_Unsigned) return Big_Unsigned; + + function "*"(Left, Right : Big_Unsigned) return Big_Unsigned; +--============================================================================-- + function Russ (Left, Right : Big_Unsigned) return Big_Unsigned; + function Karatsuba (Left, Right : Big_Unsigned) return Big_Unsigned; + function Karatsuba_P (Left, Right : Big_Unsigned) return Big_Unsigned; +-- function Karatsuba_Prot (Left, Right : Big_Unsigned) return Big_Unsigned; + function Toom_Cook (Left, Right : Big_Unsigned) return Big_Unsigned; + function Toom_Cook_P (Left, Right : Big_Unsigned) return Big_Unsigned; +--============================================================================-- + function "*"(Left : Big_Unsigned; Right : Word) return Big_Unsigned; + function "*"(Left : Word; Right : Big_Unsigned) return Big_Unsigned; + + function "/"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "/"(Left : Big_Unsigned; Right : Word) return Big_Unsigned; + function "/"(Left : Word; Right : Big_Unsigned) return Big_Unsigned; + + function "xor"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "or" (Left, Right : Big_Unsigned) return Big_Unsigned; + + function "and"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "and"(Left: Big_Unsigned; Right: Word) return Big_Unsigned; + function "and"(Left: Word; Right: Big_Unsigned) return Big_Unsigned; + + function "**"(Left, Right : Big_Unsigned) return Big_Unsigned; + + function "mod"(Left, Right : Big_Unsigned) return Big_Unsigned; + function "mod"(Left : Big_Unsigned; Right : Word) return Big_Unsigned; + + --------------------------------------------------------------------------- + ----------------------------Utils------------------------------------------ + --------------------------------------------------------------------------- + + package Utils is + + procedure Swap(X, Y : in out Big_Unsigned); + + procedure Set_Least_Significant_Bit(X : in out Big_Unsigned); + procedure Set_Most_Significant_Bit(X : in out Big_Unsigned); + + -- Returns true if X is odd . + function Is_Odd(X : Big_Unsigned) return Boolean; + + -- Returns true if X is even. + function Is_Even(X : Big_Unsigned) return Boolean; + + + -- Caution: All operations are mod Big_unsigned_Last+1. + -- X = Big_unsigned_Zero + -- Inc(X) + -- X = Big_Unsigned_Last + -- Dec(X) + -- X = Big_unsigned_Zero + procedure Inc(X : in out Big_Unsigned); + procedure Dec(X : in out Big_Unsigned); + + function To_Big_Unsigned(X : Word) return Big_Unsigned; + + + function Shift_Left(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned; + + function Shift_Right(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned; + + function Rotate_Left(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned; + + function Rotate_Right(Value : Big_Unsigned; Amount : Natural) + return Big_Unsigned; + + function Get_Random return Big_Unsigned; + + function Bit_Length(X : Big_Unsigned) return Natural; + + function Lowest_Set_Bit(X : Big_Unsigned) return Natural; + + function Length_In_Bytes(X : Big_Unsigned) return Natural; + + function Gcd(Left, Right : Big_Unsigned) return Big_Unsigned; + + function To_Bytes(X : Big_Unsigned) return Bytes; + + function To_Big_Unsigned(X : Bytes) return Big_Unsigned; + + function To_Words(X : Big_Unsigned) return Words; + + function To_Big_Unsigned(X : Words) return Big_Unsigned; + + function To_String(Item : Big_Unsigned; + Base : Number_Base := 10) return String; + + function To_Big_Unsigned(S : String) return Big_Unsigned; + + procedure Put(Item : in Big_Unsigned; Base : in Number_Base := 10); + + procedure Put_Line(Item : in Big_Unsigned; Base : in Number_Base := 10); + + + procedure Big_Div(Dividend, Divisor : in Big_Unsigned; + Quotient, Remainder : out Big_Unsigned); + + procedure Short_Div(Dividend : in Big_Unsigned; + Divisor : in Word; + Quotient : out Big_Unsigned; + Remainder : out Word); + end Utils; + + --------------------------------------------------------------------------- + --------------------------Mod_Utils---------------------------------------- + --------------------------------------------------------------------------- + + package Mod_Utils is + -- All operations in this package are mod N + + function Add (Left, Right, N : Big_Unsigned) return Big_Unsigned; + function Sub (Left, Right, N : Big_Unsigned) return Big_Unsigned; + function Div (Left, Right, N : Big_Unsigned) return Big_Unsigned; + function Mult(Left, Right, N : Big_Unsigned) return Big_Unsigned; +-- function Barrett(Left, Right, M : Big_Unsigned) return Big_Unsigned; +-- function Mult_School(Left, Right, N : Big_Unsigned) return Big_Unsigned; + + function Pow (Base, Exponent, N : Big_Unsigned) return Big_Unsigned; + + -- Returns a random Big_Unsigned mod N + function Get_Random (N : Big_Unsigned) return Big_Unsigned; + + function Inverse (X, N : Big_Unsigned) return Big_Unsigned; + + + -- This function returns with an overwhelming probability a prim + function Get_Prime(N : Big_Unsigned) return Big_Unsigned; + + -- This function returns with an overwhelming probability a n-bit prim + function Get_N_Bit_Prime(N : Positive) return Big_Unsigned; + + -- This function returns true if X is a prim and + -- with an overwhelming probability false if X is not prime + -- The change that a snowball survive one day in hell are greater that + -- this function returns true if X is no prim. + -- functionality: + -- 1. Test if a one digit prime (2,3,5,7) divides X + -- 2. Test if a two digit prime number divides X + -- 3. Test if X is a "Lucas-Lehmer" prime + -- 4. Test if a three digit prime number divides X + -- 5. compute N random Big_Unsigneds and test if one + -- of those is an Miller-Rabin wittness ( 1 < N < 51) + -- (N depends on the Bit_Length of X). + function Is_Prime(X : Big_Unsigned) return Boolean; + + + -- a weaker but faster prime test + function Looks_Like_A_Prime(X : Big_Unsigned) return Boolean; + + + -- Returns only true if X passed n iterations of the + -- Miller-Rabin tests. This test is taken from the DSA spec (NIST FIPS + -- 186-2).The execution time of this function is proportional + -- to the value of this parameter. + -- The probability that a pseudoprim pass this test is < (1/(2**(2*S))) + function Passed_Miller_Rabin_Test(X : Big_Unsigned; + S : Positive) return Boolean; + + function Jacobi(X, N : Big_Unsigned) return Integer; + + + -- internal functions for Binfield_Utils. Please, DON'T use them. + function Shift_Left(Value : D_Big_Unsigned; Amount : Natural) + return D_Big_Unsigned; + function Bit_Length(X : D_Big_Unsigned) return Natural; + end Mod_Utils; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + + package Binfield_Utils is + + -- binary field operations + -- F is the irreducible polynom with f(z)=2^m + r(z) + -- Remember all operations are in GF(2^m) + + function B_Add(Left,Right : Big_Unsigned) return Big_Unsigned; + function B_Sub(Left,Right : Big_Unsigned) return Big_Unsigned; + + function B_Mult(Left, Right, F : Big_Unsigned) return Big_Unsigned; + function B_Div (Left, Right, F : Big_Unsigned) return Big_Unsigned; + + function B_Square(A, F : Big_Unsigned) return Big_Unsigned; + + function B_Mod(Left, Right : Big_Unsigned) return Big_Unsigned; + + function B_Inverse(X, F : Big_Unsigned) return Big_Unsigned; + + end Binfield_Utils; + + --------------------------------------------------------------------------- + -----------------------------Exceptions------------------------------------ + --------------------------------------------------------------------------- + + Constraint_Size_Error : exception; + Division_By_Zero : exception; + Conversion_Error : exception; + Is_Zero_Error : exception; + +-- Big_Unsigned_Overflow : exception; +-- Big_Unsigned_Negative : exception; + + --------------------------------------------------------------------------- + --------------------------------PRIVATE------------------------------------ + --------------------------------------------------------------------------- + +private + type Largest_Unsigned is mod System.Max_Binary_Modulus; + + Max_Length : Natural := (Size/Word'Size)-1; + D_Max_Length : Positive := 2*Max_Length+1; + + subtype Limbs is Words(0..Max_Length); + subtype DLimbs is Words(0..D_Max_Length); + + subtype M_Len is Natural range Limbs'Range; + + -- This is our Big_Unsigned + -- It represents a Size*Word'Size-bit number + -- Last_Index is the Number of the last slice who + -- contains the most significant bit of the current number. + -- Ex.: + -- Word'Size = 24 + -- Our Big_Unsigned A is equal to 2**100-7 + -- Big_Unsignesd_Last = 2**240-1 + -- So only Slice 0-4 contains a part of the current 99-Bit number (2**100-7) + -- In this case A.Last_Index = 4 because A.X(5)=...=A.X(9)=0 + + type Big_Unsigned is record + Last_Index : Natural:=0; + Number : Limbs:=(others => 0); + end record; + + type D_Big_Unsigned is record + Last_Index : Natural:=0; + Number : DLimbs:=(others => 0); + end record; + + -- prime test + type Hardness is (Weak, Strong); + + + -- Constants definitions + Big_Unsigned_Zero : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (OTHERS => 0)); + Big_Unsigned_One : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 1, OTHERS => 0)); + Big_Unsigned_Two : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 2, OTHERS => 0)); + Big_Unsigned_Three : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 3, OTHERS => 0)); + Big_Unsigned_Four : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 4, OTHERS => 0)); + Big_Unsigned_Ten : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 10, OTHERS => 0)); + Big_Unsigned_Sixteen : CONSTANT Big_Unsigned := + (Last_Index => 0, Number => (0 => 16, OTHERS => 0)); + Big_Unsigned_First : CONSTANT Big_Unsigned := + Big_Unsigned_Zero; + Big_Unsigned_Last : CONSTANT Big_Unsigned := + (Last_Index => Max_Length, Number => (OTHERS => Word'Last)); + + + D_Big_Unsigned_Zero : CONSTANT D_Big_Unsigned := + (Last_Index => 0, Number => (OTHERS => 0)); + D_Big_Unsigned_One : CONSTANT D_Big_Unsigned := + (Last_Index => 0, Number => (0 => 1, OTHERS => 0)); + D_Big_Unsigned_Last : CONSTANT D_Big_Unsigned := + (Last_Index => D_Max_Length, Number => (OTHERS => Word'Last)); + + -- Shifting + + function Shift_Left (Value : Largest_Unsigned; Amount : Natural) + return Largest_Unsigned; + function Shift_Right (Value : Largest_Unsigned; Amount : Natural) + return Largest_Unsigned; + + + + --pragma Inline("-", "/", "**", "mod", "xor", "and", "or"); + pragma Inline("=", "<", ">", "<=", ">=", Min, Max); + pragma Import (Intrinsic, Shift_Left); + pragma Import (Intrinsic, Shift_Right); + + pragma Optimize (Time); + +end Crypto.Types.Big_Numbers; diff --git a/src/crypto-types-random.adb b/src/crypto-types-random.adb new file mode 100644 index 0000000..4eb6aca --- /dev/null +++ b/src/crypto-types-random.adb @@ -0,0 +1,72 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. +--with Ada.Numerics.Discrete_Random; + +with Crypto; +with Crypto.Types.Random_Source.File; + +package body Crypto.Types.Random is + Dev_Random : Crypto.Types.Random_Source.File.Random_Source_File; + + Rnd_Src : aliased Crypto.Types.Random_Source.Random_Source'Class + := Crypto.Types.Random_Source.Random_Source'Class(Dev_Random); + + procedure Set(Source : in Crypto.Types.Random_Source.Random_Source'Class) is + begin + Rnd_Src := Source; + end Set; + + procedure Read(B : out Byte) is + begin + Rnd_Src.Read(B); + end Read; + + procedure Read(Byte_Array : out Bytes) is + begin + Rnd_Src.Read(Byte_Array); + end Read; + + procedure Read(B : out B_Block128) is + begin + Rnd_Src.Read(B); + end Read; + + procedure Read(W : out Word) is + begin + Rnd_Src.Read(W); + end Read; + + procedure Read(Word_Array : out Words) is + begin + Rnd_Src.Read(Word_Array); + end Read; + + procedure Read(D : out DWord) is + begin + Rnd_Src.Read(D); + end Read; + + procedure Read(DWord_Array : out DWords) is + begin + Rnd_Src.Read(DWord_Array); + end Read; +end Crypto.Types.Random; diff --git a/src/crypto-types-random.ads b/src/crypto-types-random.ads new file mode 100644 index 0000000..a3e0b37 --- /dev/null +++ b/src/crypto-types-random.ads @@ -0,0 +1,41 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +with Crypto.Types.Random_Source; +use Crypto.Types; + +package Crypto.Types.Random is + procedure Set(Source : in Crypto.Types.Random_Source.Random_Source'Class); + + procedure Read(B : out Byte); + procedure Read(Byte_Array : out Bytes); + procedure Read(B : out B_Block128); + + procedure Read(W : out Word); + procedure Read(Word_Array : out Words); + + procedure Read(D : out DWord); + procedure Read(DWord_Array : out DWords); + + pragma Inline (Read); + pragma Optimize (Time); +end Crypto.Types.Random; diff --git a/src/crypto-types-random_source-file.adb b/src/crypto-types-random_source-file.adb new file mode 100644 index 0000000..e665990 --- /dev/null +++ b/src/crypto-types-random_source-file.adb @@ -0,0 +1,144 @@ +package body Crypto.Types.Random_Source.File is + use Ada.Strings.Unbounded; + use Ada.Streams.Stream_IO; + + --------------------------------------------------------------------------- + ------------------------ Initialization ----------------------------------- + --------------------------------------------------------------------------- + + + procedure Initialize(This : in out Random_Source_File) is + Path : constant String := "/dev/random"; + Mode : constant File_Mode := In_File; + begin + if This.Source_File = null then + This.Source_File := new Ada.Streams.Stream_IO.File_Type; + end if; + if not Is_Open(This.Source_File.all) then + Open(This.Source_File.all, Mode, Path, "shared=yes"); + This.Source_Path := To_Unbounded_String(Path); + end if; + end Initialize; + + --------------------------------------------------------------------------- + + procedure Initialize(This : in out Random_Source_File; + File_Path : in String) is + Mode : constant File_Mode := In_File; + begin + if Is_Open(This.Source_File.all) then + Close(This.Source_File.all); + end if; + if not Is_Open(This.Source_File.all) then + Open(This.Source_File.all, Mode, File_Path, "shared=yes"); + This.Source_Path := To_Unbounded_String(File_Path); + end if; + end Initialize; + + --------------------------------------------------------------------------- + ------------------------------- Read Byte --------------------------------- + --------------------------------------------------------------------------- + + + procedure Read(This : in out Random_Source_File; B : out Byte) is + + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + Byte'Read(Stream(This.Source_File.all), B); + end if; + end Read; + + --------------------------------------------------------------------------- + + procedure Read(This : in out Random_Source_File; Byte_Array : out Bytes) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + Bytes'Read(Stream(This.Source_File.all), Byte_Array); + end if; + end Read; + + --------------------------------------------------------------------------- + + procedure Read(This : in out Random_Source_File; B : out B_Block128) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + B_Block128'Read(Stream(This.Source_File.all), B); + end if; + end Read; + + --------------------------------------------------------------------------- + ------------------------------- Read Word --------------------------------- + --------------------------------------------------------------------------- + + procedure Read(This : in out Random_Source_File; W : out Word) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + Word'Read(Stream(This.Source_File.all), W); + end if; + end Read; + + --------------------------------------------------------------------------- + + procedure Read(This : in out Random_Source_File; Word_Array : out Words) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + Words'Read(Stream(This.Source_File.all), Word_Array); + end if; + end Read; + + --------------------------------------------------------------------------- + ------------------------------- Read DWord -------------------------------- + --------------------------------------------------------------------------- + + + procedure Read(This : in out Random_Source_File; D : out DWord) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + DWord'Read(Stream(This.Source_File.all), D); + end if; + end Read; + + procedure Read(This : in out Random_Source_File; DWord_Array : out DWords) is + begin + if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then + raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path); + else + DWords'Read(Stream(This.Source_File.all), DWord_Array); + end if; + end Read; + + + --------------------------------------------------------------------------- + ------------------------------- Finalize ---------------------------------- + --------------------------------------------------------------------------- + + procedure Finalize(This : in out Random_Source_File) is + begin + if Is_Open(This.Source_File.all) then + Close(This.Source_File.all); + end if; + end Finalize; + + --------------------------------------------------------------------------- + --------------------------- Path_Starts_With ------------------------------ + --------------------------------------------------------------------------- + + function Path_Starts_With(This : Random_Source_File; S : String) return Boolean is + Path : constant String := To_String(This.Source_Path); + begin + return Path(Path'First..S'Last) = S; + end; + +end Crypto.Types.Random_Source.File; diff --git a/src/crypto-types-random_source-file.ads b/src/crypto-types-random_source-file.ads new file mode 100644 index 0000000..8a3e960 --- /dev/null +++ b/src/crypto-types-random_source-file.ads @@ -0,0 +1,50 @@ +with Ada.Streams.Stream_IO; +with Ada.Strings.Unbounded; + +package Crypto.Types.Random_Source.File is + package Rnd renames Crypto.Types.Random_Source; + + type Random_Source_File is new Rnd.Random_Source with private; + type Random_Source_File_Access is access Random_Source_File; + + Overriding + procedure Finalize(This : in out Random_Source_File); + + Overriding + procedure Initialize(This : in out Random_Source_File); + + procedure Initialize(This : in out Random_Source_File; + File_Path : in String); + Overriding + procedure Read(This : in out Random_Source_File; B : out Byte); + + Overriding + procedure Read(This : in out Random_Source_File; Byte_Array : out Bytes); + + Overriding + procedure Read(This : in out Random_Source_File; B : out B_Block128); + + Overriding + procedure Read(This : in out Random_Source_File; W : out Word); + + Overriding + Procedure Read(This : in out Random_Source_File; Word_Array : out Words); + + Overriding + procedure Read(This : in out Random_Source_File; D : out DWord); + + Overriding + procedure Read(This : in out Random_Source_File; DWord_Array : out DWords); +private + type File_Access is access Ada.Streams.Stream_IO.File_Type; + + type Random_Source_File is new Rnd.Random_Source with + record + Source_Path : Ada.Strings.Unbounded.Unbounded_String; + Source_File : File_Access; + end record; + + function Path_Starts_With(This : Random_Source_File; S : String) + return Boolean; + +end Crypto.Types.Random_Source.File; diff --git a/src/crypto-types-random_source.adb b/src/crypto-types-random_source.adb new file mode 100644 index 0000000..5fd4dbb --- /dev/null +++ b/src/crypto-types-random_source.adb @@ -0,0 +1,55 @@ +package body Crypto.Types.Random_Source is + + procedure Read(This : in out Random_Source; Byte_Array : out Bytes) is + begin + for I in Byte_Array'Range loop + Read(Random_Source'class(This),Byte_Array(I)); + end loop; + end Read; + + ---------------------------------------------------------------------- + + procedure Read(This : in out Random_Source; B : out B_Block128) is + begin + for I in B'Range loop + Read(Random_Source'class(This),B(I)); + end loop; + end Read; + + ---------------------------------------------------------------------- + + procedure Read(This : in out Random_Source; W : out Word) is + B : Byte_Word; + begin + This.Read(Bytes(B)); + W := To_Word(B); + end Read; + + ---------------------------------------------------------------------- + + procedure Read(This : in out Random_Source; Word_Array : out Words) is + begin + for I in Word_Array'Range loop + This.Read(Word_Array(I)); + end loop; + end Read; + + ---------------------------------------------------------------------- + + procedure Read(This : in out Random_Source; D : out DWord) is + B : Byte_DWord; + begin + This.Read(Bytes(B)); + D := To_DWord(B); + end Read; + + ---------------------------------------------------------------------- + + procedure Read(This : in out Random_Source; DWord_Array : out DWords) is + begin + for I in DWord_Array'Range loop + This.Read(DWord_Array(I)); + end loop; + end Read; + +end Crypto.Types.Random_Source; diff --git a/src/crypto-types-random_source.ads b/src/crypto-types-random_source.ads new file mode 100644 index 0000000..9ad55f6 --- /dev/null +++ b/src/crypto-types-random_source.ads @@ -0,0 +1,27 @@ +with Ada.Finalization; + +package Crypto.Types.Random_Source is + use Crypto.Types; + package Fin renames Ada.Finalization; + + type Random_Source is abstract new Fin.Controlled with null record; + type Random_Source_Access is access Random_Source; + + Random_Source_Read_Error : exception; + + procedure Initialize (This: in out Random_Source) is abstract; + + procedure Read(This : in out Random_Source; B : out Byte) is abstract; + + procedure Read(This : in out Random_Source; Byte_Array : out Bytes); + + procedure Read(This : in out Random_Source; B : out B_Block128); + + procedure Read(This : in out Random_Source; W : out Word); + procedure Read(This : in out Random_Source; Word_Array : out Words); + + procedure Read(This : in out Random_Source; D : out DWord); + procedure Read(This : in out Random_Source; DWord_Array : out DWords); + + pragma Inline(Read); +end Crypto.Types.Random_Source; diff --git a/src/crypto-types.adb b/src/crypto-types.adb new file mode 100644 index 0000000..ac9afc2 --- /dev/null +++ b/src/crypto-types.adb @@ -0,0 +1,944 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +with Ada.Unchecked_Conversion; + +--pragma Elaborate_All(Generic_Mod_Aux); + +package body Crypto.Types is + + package body Generic_Mod_Aux is + function "xor"(Left, Right : T_A) return T_A is + Result : T_A(0..Left'Length-1); + begin + if Left'Length /= Right'Length then + raise Constraint_Error; + end if; + for I in 0..Left'Length-1 loop + Result(I) := Left(Left'First+I) xor Right(Right'First+I); + end loop; + return Result; + end "xor"; + + ------------------------------------------------------------------------ + + function "xor"(Left : T_A; Right : T) return T_A is + Result : T_A := Left; + begin + Result(Result'Last) := Left(Result'Last) xor Right; + return Result; + end "xor"; + + ------------------------------------------------------------------------ + + function "xor"(Left : T; Right : T_A) return T_A is + begin + return Right xor Left; + end "xor"; + + + ------------------------------------------------------------------------ + + function "and"(Left, Right : T_A) return T_A is + Result : T_A(0..Left'Length-1); + begin + + if Left'Length /= Right'Length then + raise Constraint_Error; + end if; + for I in 0..Left'Length-1 loop + Result(I) := Left(Left'First+I) and Right(Right'First+I); + end loop; + return Result; + end "and"; + + ------------------------------------------------------------------------ + function "+"(Left : T_A; Right : T) return T_A is + Result: T_A(Left'Range) := Left; + begin + Result(Left'Last) := Left(Left'Last) + Right; + + -- overflow? + if Result(Left'Last) < Left(Left'Last) then + for I in reverse Left'First..Left'Last-1 loop + Result(I):=Result(I)+1; + if Result(I) /= 0 then + return Result; + end if; + end loop; + end if; + return Result; + end "+"; + + + ------------------------------------------------------------------------ + function "+"(Left : T; Right : T_A) return T_A is + begin + return Right + Left; + end "+"; + ------------------------------------------------------------------------ + + function Is_Zero(Item : T_A) return Boolean is + begin + for I in Item'Range loop + if Item(I) /= 0 then return False; + end if; + end loop; + return True; + end Is_Zero; + +------------------------------------------------------------------------ + + function Left_Part(Block : in T_A) return T_A is + Len : constant Natural := ((Block'Length+1)/2)-1; + Left : constant T_A(0..Len) := Block(Block'First..(Block'First+Len)); + begin + return Left; + end Left_Part; + + ------------------------------------------------------------------------ + + function Right_Part(Block : in T_A) return T_A is + Len : constant Natural := Block'Length/2; + Right : constant T_A(0..Len-1) := Block(Block'Last-Len+1..Block'Last); + begin + return Right; + end Right_Part; + + ------------------------------------------------------------------------ + + function Shift_Left(Value : T_A; Amount : Natural) return T_A is + Result : T_A(Value'Range) := (others => 0); + L : constant Natural := Amount mod T'Size; + M : constant Natural := Value'First+(Amount/T'Size); + begin + if Amount >= Value'Size then + return Result; + elsif Amount = 0 then + return Value; + end if; + Result(Value'Last-M) := Shift_Left(Value(Value'Last),L); + + for I in reverse Value'First..Value'Last-(M+1) loop + Result(I) := Shift_Left(Value(I),L) + xor Shift_Right(Value(I+1),T'Size-L); + end loop; + return Result; + end Shift_Left; + ------------------------------------------------------------------------- + function Shift_Right(Value : T_A; Amount : Natural) return T_A is + Result : T_A(Value'Range) := (others => 0); + L : constant Natural := Amount mod T'Size; + M : constant Natural := Value'First+(Amount/T'Size); + begin + if Amount >= Value'Size then + return Result; + elsif Amount = 0 then + return Value; + end if; + Result(Value'Last-M) := Shift_Right(Value(Value'Last),L); + + for I in reverse Value'First..Value'Last-(M+1) loop + Result(I) := Shift_Right(Value(I),L) + xor Shift_Left(Value(I+1),T'Size-L); + end loop; + return Result; + end Shift_Right; + + end Generic_Mod_Aux; + + + function Cast is new Ada.Unchecked_Conversion (Byte_Word, Word); + function Cast is new Ada.Unchecked_Conversion (Word, Byte_Word); + function DCast is new Ada.Unchecked_Conversion (Byte_DWord, DWord); + function DCast is new Ada.Unchecked_Conversion (DWord, Byte_DWord); + pragma Inline (Cast, DCast); + + + package Aux_Byte is new Generic_Mod_Aux(Byte,Bytes); + package Aux_Word is new Generic_Mod_Aux(Word,Words); + package Aux_DWord is new Generic_Mod_Aux(Dword,DWords); + + --------------------------------------------------------------------------- + + function To_Word(A,B,C,D : Character) return Word is + begin + return Cast((Byte(Character'Pos(D)), Byte(Character'Pos(C)), + Byte(Character'Pos(B)), Byte(Character'Pos(A)))); + end To_Word; + + --------------------------------------------------------------------------- + + function To_Word(A,B,C,D : Byte) return Word is + begin + return Cast((D, C, B, A)); + end To_Word; + + --------------------------------------------------------------------------- + + function To_Word (X : Byte_Word) return Word is + begin + return Cast((X(3), X(2), X(1), X(0))); + end To_Word; + + --------------------------------------------------------------------------- + + function R_To_Word (X : Byte_Word) return Word is + begin + return Cast(X); + end R_To_Word; + + --------------------------------------------------------------------------- + + function To_Bytes (X : Word) return Byte_Word is + begin + return (Cast(X)(3), Cast(X)(2), Cast(X)(1), Cast(X)(0)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function R_To_Bytes (X : Word) return Byte_Word is + begin + return Cast(X); + end R_To_Bytes; + + --------------------------------------------------------------------------- + + function Byte0 (W : Word) return Byte is + begin + return Cast(W)(3); + end Byte0; + + --------------------------------------------------------------------------- + + function Byte1 (W : Word) return Byte is + begin + return Cast(W)(2); + end Byte1; + + --------------------------------------------------------------------------- + + function Byte2 (W : Word) return Byte is + begin + return Cast(W)(1); + end Byte2; + + --------------------------------------------------------------------------- + + function Byte3 (W : Word) return Byte is + begin + return Cast(W)(0); + end Byte3; + + --------------------------------------------------------------------------- + + function To_DWord (X : Byte_DWord) return DWord is + begin + return DCast((X(7), X(6), X(5), X(4), X(3), X(2), X(1), X(0))); + end To_DWord; + + --------------------------------------------------------------------------- + + function R_To_DWord (X : Byte_DWord) return DWord is + begin + return DCast(X); + end R_To_DWord; + + --------------------------------------------------------------------------- + + function To_Bytes (X : DWord) return Byte_DWord is + begin + return (DCast(X)(7), DCast(X)(6), DCast(X)(5), DCast(X)(4), + DCast(X)(3), DCast(X)(2), DCast(X)(1), DCast(X)(0)); + + end To_Bytes; + + --------------------------------------------------------------------------- + + function R_To_Bytes (X : DWord) return Byte_DWord is + begin + return DCast(X); + end R_To_Bytes; + + --------------------------------------------------------------------------- + + function Byte0 (D : DWord) return Byte is + begin + return DCast(D)(7); + end Byte0; + + --------------------------------------------------------------------------- + function Byte1 (D : DWord) return Byte is + begin + return DCast(D)(6); + end Byte1; + + --------------------------------------------------------------------------- + + function Byte2 (D : DWord) return Byte is + begin + return DCast(D)(5); + end Byte2; + + --------------------------------------------------------------------------- + + function Byte3 (D : DWord) return Byte is + begin + return DCast(D)(4); + end Byte3; + + --------------------------------------------------------------------------- + + function Byte4 (D : DWord) return Byte is + begin + return DCast(D)(3); + end Byte4; + + --------------------------------------------------------------------------- + + function Byte5 (D : DWord) return Byte is + begin + return DCast(D)(2); + end Byte5; + + --------------------------------------------------------------------------- + + function Byte6 (D : DWord) return Byte is + begin + return DCast(D)(1); + end Byte6; + + --------------------------------------------------------------------------- + + function Byte7 (D : DWord) return Byte is + begin + return DCast(D)(0); + end Byte7; + + --------------------------------------------------------------------------- + + + function "xor"(Left, Right : Bytes) return Bytes is + begin + return Aux_Byte."xor"(Left,Right); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left : Bytes; Right : Byte) return Bytes is + begin + return Aux_Byte."xor"(Left,Right); + end "xor"; + + --------------------------------------------------------------------------- + + function "+"(Left : Bytes; Right : Byte) return Bytes is + begin + return Aux_Byte."+"(Left,Right); + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : Byte; Right : Bytes) return Bytes is + begin + return Right + Left; + end "+"; + + --------------------------------------------------------------------------- + + function "and"(Left, Right : Bytes) return Bytes is + begin + return Aux_Byte."and"(Left,Right); + end "and"; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + + function "xor"(Left, Right : Words) return Words is + begin + return Aux_Word."xor"(Left,Right); + end "xor"; + + --------------------------------------------------------------------------- + + function "+"(Left : Words; Right : Word) return Words is + + begin + return Aux_Word."+"(Left,Right); + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : Word; Right : Words) return Words is + begin + return Right + Left; + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : Words; Right : Byte) return Words is + Result: Words(Left'Range) := Left; + begin + Result(Left'Last) := Left(Left'Last) + Word(Right); + + -- overflow? + if Result(Left'Last) < Left(Left'Last) then + for I in reverse Left'First..Left'Last-1 loop + Result(I):=Result(I)+1; + if Result(I) /= 0 then + return Result; + end if; + end loop; + end if; + return Result; + end "+"; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + + function "xor"(Left, Right : DWords) return DWords is + begin + return Aux_DWord."xor"(Left,Right); + end "xor"; + + --------------------------------------------------------------------------- + + function "+"(Left : DWords; Right : DWord) return DWords is + begin + return Aux_DWord."+"(Left,Right); + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : DWord; Right : DWords) return DWords is + begin + return Right + Left; + end "+"; + + --------------------------------------------------------------------------- + + function "+"(Left : DWords; Right : Byte) return DWords is + Result: DWords(Left'Range) := Left; + begin + Result(Left'Last) := Left(Left'Last) + DWord(Right); + + -- overflow? + if Result(Left'Last) < Left(Left'Last) then + for I in reverse Left'First..Left'Last-1 loop + Result(I):=Result(I)+1; + if Result(I) /= 0 then + return Result; + end if; + end loop; + end if; + return Result; + end "+"; + + --------------------------------------------------------------------------- + + function To_Words(Byte_Array : Bytes) return Words is + L : constant Natural := + Natural(Float'Ceiling(Float(Byte_Array'Length)/4.0))-1; + W : Words(0..L) := (others => 0); + N : Integer := Byte_Array'First; + S : Natural :=24; + begin + + for I in 0..(Byte_Array'Length/4)-1 loop + W(I) := To_Word(Byte_Array(N..N+3)); + N := N+4; + end loop; + + for I in 1..(Byte_Array'Length mod 4) loop + W(L):= W(L) or Shift_Left(Word(Byte_Array(N)),S); + N := N+1; + S := S-8; + end loop; + + return W; + end To_Words; + + --------------------------------------------------------------------------- + + function To_Bytes(Word_Array : Words) return Bytes is + B : Bytes(1..Word_Array'Length*4); + C : Natural := 1; + begin + for I in Word_Array'Range loop + B(C..C+3) := To_Bytes(Word_Array(I)); + C:=C+4; + end loop; + return B; + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_DWords(Byte_Array : Bytes) return DWords is + L : constant Natural := + Natural(Float'Ceiling(Float(Byte_Array'Length)/8.0))-1; + W : DWords(0..L):=(others => 0); + N : Natural := Byte_Array'First; + S : Natural := 56; + begin + + for I in 0..(Byte_Array'Length/8)-1 loop + W(I) := To_DWord(Byte_Array(N..N+7)); + N := N+8; + end loop; + + for I in 1..(Byte_Array'Length mod 8) loop + W(L):= W(L) or Shift_Left(DWord(Byte_Array(N)),S); + N := N+1; + S := S-8; + end loop; + + return W; + end To_DWords; + + --------------------------------------------------------------------------- + + + function To_Bytes(DWord_Array : DWords) return Bytes is + B : Bytes(1..DWord_Array'Length*8); + C : Natural := 1; + begin + for I in DWord_Array'Range loop + B(C..C+7) := To_Bytes(DWord_Array(I)); + C:=C+8; + end loop; + return B; + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Hex(B : Byte) return Hex_Byte is + S : constant String := "0123456789ABCDEF"; + H : Hex_Byte; + begin + H(2) := S(Natural(B and 15)+1); + H(1) := S(Natural(Shift_Right(B,4)+1)); + return H; + end To_Hex; + + --------------------------------------------------------------------------- + + function To_Hex(W : Word) return Hex_Word is + S : constant String := "0123456789ABCDEF"; + H : Hex_Word; + T : Word := W; + begin + for I in reverse H'Range loop + H(I) := S(Natural(T and 15)+1); + T := Shift_Right(T,4); + end loop; + return H; + end To_Hex; + + --------------------------------------------------------------------------- + + + function To_Hex(D : DWord) return Hex_DWord is + S : constant String := "0123456789ABCDEF"; + H : Hex_DWord; + T : DWord := D; + begin + for I in reverse H'Range loop + H(I) := S(Natural(T and 15)+1); + T := Shift_Right(T,4); + end loop; + + return H; + end To_Hex; + + + function Hex_To_Bytes(Hex : String) return Bytes is + Return_Bytes : Bytes(0..Hex'Length/2 -1); + begin + for I in Return_Bytes'Range loop + case Hex(Hex'First + 2*i) is + when '0' => Return_Bytes(i):=16#00#; + when '1' => Return_Bytes(i):=16#01#; + when '2' => Return_Bytes(i):=16#02#; + when '3' => Return_Bytes(i):=16#03#; + when '4' => Return_Bytes(i):=16#04#; + when '5' => Return_Bytes(i):=16#05#; + when '6' => Return_Bytes(i):=16#06#; + when '7' => Return_Bytes(i):=16#07#; + when '8' => Return_Bytes(i):=16#08#; + when '9' => Return_Bytes(i):=16#09#; + when 'A' => Return_Bytes(i):=16#0A#; + when 'B' => Return_Bytes(i):=16#0B#; + when 'C' => Return_Bytes(i):=16#0C#; + when 'D' => Return_Bytes(i):=16#0D#; + when 'E' => Return_Bytes(i):=16#0E#; + when 'F' => Return_Bytes(i):=16#0F#; + when others => null; + end case; + + case Hex(Hex'First + 2*i + 1) is + when '0' => Return_Bytes(i):= Return_Bytes(i) + 16#00#; + when '1' => Return_Bytes(i):= Return_Bytes(i) + 16#10#; + when '2' => Return_Bytes(i):= Return_Bytes(i) + 16#20#; + when '3' => Return_Bytes(i):= Return_Bytes(i) + 16#30#; + when '4' => Return_Bytes(i):= Return_Bytes(i) + 16#40#; + when '5' => Return_Bytes(i):= Return_Bytes(i) + 16#50#; + when '6' => Return_Bytes(i):= Return_Bytes(i) + 16#60#; + when '7' => Return_Bytes(i):= Return_Bytes(i) + 16#70#; + when '8' => Return_Bytes(i):= Return_Bytes(i) + 16#80#; + when '9' => Return_Bytes(i):= Return_Bytes(i) + 16#90#; + when 'A' => Return_Bytes(i):= Return_Bytes(i) + 16#A0#; + when 'B' => Return_Bytes(i):= Return_Bytes(i) + 16#B0#; + when 'C' => Return_Bytes(i):= Return_Bytes(i) + 16#C0#; + when 'D' => Return_Bytes(i):= Return_Bytes(i) + 16#D0#; + when 'E' => Return_Bytes(i):= Return_Bytes(i) + 16#E0#; + when 'F' => Return_Bytes(i):= Return_Bytes(i) + 16#F0#; + when others => null; + end case; + + end loop; + return Return_Bytes; + end Hex_To_Bytes; + + --------------------------------------------------------------------------- + + function Is_Zero(Byte_Array : Bytes) return Boolean is + begin + return Aux_Byte.Is_Zero(Byte_Array); + end Is_Zero; + + --------------------------------------------------------------------------- + + + function Is_Zero(Word_Array : Words) return Boolean is + begin + return Aux_Word.Is_Zero(Word_Array); + end Is_Zero; + + --------------------------------------------------------------------------- + + function Is_Zero(DWord_Array : Dwords) return Boolean is + begin + return Aux_DWord.Is_Zero(DWord_Array); + end Is_Zero; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + + function To_Bytes(Message : String) return Bytes is + B : Bytes(Message'Range); + begin + for I in Message'Range loop + B(I) := Character'Pos(Message(I)); + end loop; + return B; + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_String(ASCII : Bytes) return String is + S : String(1..ASCII'Length); + J : Integer:=1; + begin + for I in ASCII'Range loop + S(J) := Character'Val(ASCII(I)); + J:=J+1; + end loop; + return S; + end To_String; + + --------------------------------------------------------------------------- + + function Left_Part(Block : in Bytes) return Bytes is + begin + return Aux_Byte.Left_Part(Block); + end Left_Part; + + --------------------------------------------------------------------------- + + function Right_Part(Block : in Bytes) return Bytes is + begin + return Aux_Byte.Right_Part(Block); + end Right_Part; + + --------------------------------------------------------------------------- + + function To_Bytes(B : B_Block64) return Bytes is + begin + return Bytes(B); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(B : B_Block128) return Bytes is + begin + return Bytes(B); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(B : B_Block192) return Bytes is + + begin + return Bytes(B); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(B : B_Block256) return Bytes is + begin + return Bytes(B); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(W : W_Block160) return Bytes is + begin + return To_Bytes(Words(W)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(W : W_Block256) return Bytes is + begin + return To_Bytes(Words(W)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(W : W_Block512) return Bytes is + begin + return To_Bytes(Words(W)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(D : DW_Block256) return Bytes is + begin + return To_Bytes(DWords(D)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(D : DW_Block384) return Bytes is + begin + return To_Bytes(DWords(D)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(D : DW_Block512) return Bytes is + begin + return To_Bytes(DWords(D)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(D : DW_Block1024) return Bytes is + begin + return To_Bytes(DWords(D)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_Bytes(D : DW_Block8192) return Bytes is + begin + return To_Bytes(DWords(D)); + end To_Bytes; + + --------------------------------------------------------------------------- + + function To_B_Block64(B : Bytes) return B_Block64 is + begin + return B_Block64(B); + end To_B_Block64; + + --------------------------------------------------------------------------- + + function To_B_Block128(B : Bytes) return B_Block128 is + begin + return B_Block128(B); + end To_B_Block128; + + --------------------------------------------------------------------------- + + function To_B_Block192(B : Bytes) return B_Block192 is + begin + return B_Block192(B); + end To_B_Block192; + + --------------------------------------------------------------------------- + + function To_B_Block256(B : Bytes) return B_Block256 is + begin + return B_Block256(B); + end To_B_Block256; + + --------------------------------------------------------------------------- + + function To_W_Block160(B : Bytes) return W_Block160 is + begin + return W_Block160(To_Words(B)); + end To_W_Block160; + + --------------------------------------------------------------------------- + + function To_W_Block256(B : Bytes) return W_Block256 is + begin + return W_Block256(To_Words(B)); + end To_W_Block256; + + --------------------------------------------------------------------------- + + function To_W_Block512(B : Bytes) return W_Block512 is + begin + return W_Block512(To_Words(B)); + end To_W_Block512; + + --------------------------------------------------------------------------- + + function To_DW_Block256(B : Bytes) return DW_Block256 is + begin + return DW_Block256(To_DWords(B)); + end To_DW_Block256; + + --------------------------------------------------------------------------- + + function To_DW_Block384(B : Bytes) return DW_Block384 is + begin + return DW_Block384(To_DWords(B)); + end To_DW_Block384; + + --------------------------------------------------------------------------- + + function To_DW_Block512(B : Bytes) return DW_Block512 is + begin + return DW_Block512(To_DWords(B)); + end To_DW_Block512; + + --------------------------------------------------------------------------- + + function To_DW_Block1024(B : Bytes) return DW_Block1024 is + begin + return DW_Block1024(To_DWords(B)); + end To_DW_Block1024; + + --------------------------------------------------------------------------- + + function To_DW_Block8192(B : Bytes) return DW_Block8192 is + begin + return DW_Block8192(To_DWords(B)); + end To_DW_Block8192; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : W_Block160) return W_Block160 is + begin + return W_Block160(Words(Left) xor Words(Right)); + end "xor"; + --------------------------------------------------------------------------- + + function "xor"(Left, Right : W_Block256) return W_Block256 is + begin + return W_Block256(Words(Left) xor Words(Right)); + end "xor"; + --------------------------------------------------------------------------- + + function "xor"(Left, Right : W_Block512) return W_Block512 is + begin + return W_Block512(Words(Left) xor Words(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : DW_Block512) return DW_Block512 is + begin + return DW_Block512(DWords(Left) xor DWords(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : DW_Block1024) return DW_Block1024 is + begin + return DW_Block1024(DWords(Left) xor DWords(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : DW_Block8192) return DW_Block8192 is + begin + return DW_Block8192(DWords(Left) xor DWords(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : B_Block128) return B_Block128 is + begin + return B_Block128(Bytes(Left) xor Bytes(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "xor"(Left, Right : B_Block64) return B_Block64 is + begin + return B_Block64(Bytes(Left) xor Bytes(Right)); + end "xor"; + + --------------------------------------------------------------------------- + + function "+"(Left : B_Block128; Right : Byte) return B_Block128 is + begin + return B_Block128(Bytes(Left) + Right); + end "+"; + + --------------------------------------------------------------------------- + + function Shift_Left(Value : Bytes; Amount : Natural) return Bytes is + begin + return Aux_Byte.Shift_Left(Value,Amount); + end Shift_Left; + + --------------------------------------------------------------------------- + + function Shift_Left(Value : B_Block128; Amount :Natural) return B_Block128 is + begin + return B_Block128(Aux_Byte.Shift_Left(Bytes(Value),Amount)); + end Shift_Left; + + ---------------------------------------------------------------------------- + + function Shift_Right(Value : Bytes; Amount : Natural) return Bytes is + begin + return Aux_Byte.Shift_Right(Value,Amount); + end Shift_Right; + + --------------------------------------------------------------------------- + + function Shift_Right(Value : B_Block128; Amount :Natural)return B_Block128 is + begin + return B_Block128(Aux_Byte.Shift_Right(Bytes(Value),Amount)); + end Shift_Right; + + + + + end Crypto.Types; diff --git a/src/crypto-types.ads b/src/crypto-types.ads new file mode 100644 index 0000000..ebcd6dc --- /dev/null +++ b/src/crypto-types.ads @@ -0,0 +1,357 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + +package Crypto.Types is + + --------------------------------------------------------------------------- + ---------------------------TYPES------------------------------------------- + --------------------------------------------------------------------------- + + -- primary types; + + type Bit is mod 2; + for Bit'Size use 1; + + type Byte is mod 2 ** 8; + for Byte'Size use 8; + + type DByte is mod 2 ** 16; + for DByte'Size use 16; + + type TByte is mod 2 ** 24 with Size => 24; + + type Word is mod 2 ** 32; + for Word'Size use 32; + + type DWord is mod 2 ** 64; + for DWord'Size use 64; + + --package BIO is new Ada.Text_Io.Modular_IO (Byte); + --package WIO is new Ada.Text_Io.Modular_IO (Word); + --package DIO is new Ada.Text_Io.Modular_IO (DWord); + + -- Arrays of primary types + type Bits is array (Integer range <>) of Bit; + type Bytes is array (Integer range <>) of Byte; + type DBytes is array (Integer range <>) of DByte; + type Words is array (Integer range <>) of Word; + type DWords is array (Integer range <>) of DWord; + + subtype Byte_Word_Range is Natural range 0..3; + subtype Byte_DWord_Range is Natural range 0..7; + + subtype Byte_Word is Bytes (Byte_Word_Range); + subtype Byte_DWord is Bytes (Byte_DWord_Range); + + -- N : #bits + -- byte-blocks (B_BlockN): array of N/8 bytes + subtype B_Block32_Range is Natural range 0..3; + subtype B_Block48_Range is Natural range 0..5; + subtype B_Block56_Range is Natural range 0..6; + subtype B_Block64_Range is Natural range 0..7; + subtype B_Block128_Range is Natural range 0..15; + subtype B_Block160_Range is Natural range 0..19; + subtype B_Block192_Range is Natural range 0..23; + subtype B_Block256_Range is Natural range 0..31; + + type B_Block32 is array(B_Block32_Range) of Byte; + type B_Block48 is array(B_Block48_Range) of Byte; + type B_Block56 is array(B_Block56_Range) of Byte; + type B_Block64 is array(B_Block64_Range) of Byte; + type B_Block128 is array(B_Block128_Range) of Byte; + type B_Block160 is array(B_Block160_Range) of Byte; + type B_Block192 is array(B_Block192_Range) of Byte; + type B_Block256 is array(B_Block256_Range) of Byte; + + + -- word blocks (W_BlockN): array of N/32 Words + subtype W_Block128_Range is Natural range 0..3; + subtype W_Block160_Range is Natural range 0..4; + subtype W_Block192_Range is Natural range 0..5; + subtype W_Block256_Range is Natural range 0..7; + subtype W_Block512_Range is Natural range 0..15; + + type W_Block128 is array(W_Block128_Range) of Word; + type W_Block160 is array(W_Block160_Range) of Word; + type W_Block192 is array(W_Block192_Range) of Word; + type W_Block256 is array(W_Block256_Range) of Word; + type W_Block512 is array(W_Block512_Range) of Word; + + + -- double wordblocks (DW_BlockN): array of N/64 Words + subtype DW_Block128_Range is Natural range 0..1; + subtype DW_Block256_Range is Natural range 0..3; + subtype DW_Block384_Range is Natural range 0..5; + subtype DW_Block512_Range is Natural range 0..7; + subtype DW_Block1024_Range is Natural range 0..15; + subtype DW_Block8192_Range is Natural range 0..127; + + type DW_Block128 is array(DW_Block128_Range) of DWord; + type DW_Block256 is array(DW_Block256_Range) of DWord; + type DW_Block384 is array(DW_Block384_Range) of DWord; + type DW_Block512 is array(DW_Block512_Range) of DWord; + type DW_Block1024 is array(DW_Block1024_Range) of DWord; + type DW_Block8192 is array(DW_Block8192_Range) of DWord; + + + subtype Hex_Byte_Range is Natural range 1..2; + subtype Hex_Word_Range is Natural range 1..8; + subtype Hex_DWord_Range is Natural range 1..16; + + + subtype Hex_Byte is String (Hex_Byte_Range); + subtype Hex_Word is String (Hex_Word_Range); + subtype Hex_DWord is String (Hex_DWord_Range); + + subtype Message_Block_Length256 is Natural range 0 .. 32; + subtype Message_Block_Length512 is Natural range 0 .. 64; + subtype Message_Block_Length1024 is Natural range 0 .. 128; + + + + + + + + --------------------------------------------------------------------------- + ---------------------------FUNCTIONS--------------------------------------- + --------------------------------------------------------------------------- + + function Shift_Left (Value : Byte; Amount : Natural) return Byte; + function Shift_Right (Value : Byte; Amount : Natural) return Byte; + function Rotate_Left (Value : Byte; Amount : Natural) return Byte; + function Rotate_Right (Value : Byte; Amount : Natural) return Byte; + + function Shift_Left (Value : DByte; Amount : Natural) return DByte; + function Shift_Right (Value : DByte; Amount : Natural) return DByte; + function Rotate_Left (Value : DByte; Amount : Natural) return DByte; + function Rotate_Right (Value : DByte; Amount : Natural) return DByte; + + function Shift_Left (Value : Word; Amount : Natural) return Word; + function Shift_Right (Value : Word; Amount : Natural) return Word; + function Rotate_Left (Value : Word; Amount : Natural) return Word; + function Rotate_Right (Value : Word; Amount : Natural) return Word; + + function Shift_Left (Value : DWord; Amount : Natural) return DWord; + function Shift_Right (Value : DWord; Amount : Natural) return DWord; + function Rotate_Left (Value : DWord; Amount : Natural) return DWord; + function Rotate_Right (Value : DWord; Amount : Natural) return DWord; + + pragma Import (Intrinsic, Shift_Left); + pragma Import (Intrinsic, Shift_Right); + + function Shift_Left (Value : Bytes; Amount : Natural) return Bytes; + function Shift_Left (Value : B_Block128; Amount : Natural) return B_Block128; + function Shift_Right(Value : Bytes; Amount : Natural) return Bytes; + function Shift_Right(Value : B_Block128; Amount : Natural) return B_Block128; + + --Operations for Bytes + function "xor"(Left, Right : Bytes) return Bytes; + function "xor"(Left : Bytes; Right : Byte) return Bytes; + function "+"(Left : Bytes; Right : Byte) return Bytes; + function "+"(Left : Byte; Right : Bytes) return Bytes; + function "and"(Left, Right : Bytes) return Bytes; + + + -- Operations for Words + function "xor"(Left, Right : Words) return Words; + function "+"(Left : Words; Right : Word) return Words; + function "+"(Left : Word; Right : Words) return Words; + function "+"(Left : Words; Right : Byte) return Words; + + + -- Operations for DWords + function "xor"(Left, Right : DWords) return DWords; + function "+"(Left : DWords; Right : DWord) return DWords; + function "+"(Left : DWord; Right : DWords) return DWords; + function "+"(Left : DWords; Right : Byte) return DWords; + + -- Bytes to Word + function To_Word (A,B,C,D : Byte) return Word; + function To_Word (X : Byte_Word) return Word; + function R_To_Word (X : Byte_Word) return Word; -- reverse + function To_Words(Byte_Array : Bytes) return Words; + + -- Word to Bytes + function To_Bytes (X : Word) return Byte_Word; + function R_To_Bytes (X : Word) return Byte_Word; --reverse + function To_Bytes(Word_Array : Words) return Bytes; + + --Word = b_0 b_1 b2 b_3 + -- ByteX returns b_n + function Byte0 (W : Word) return Byte; + function Byte1 (W : Word) return Byte; + function Byte2 (W : Word) return Byte; + function Byte3 (W : Word) return Byte; + + -- Bytes to DWord + function To_DWord (X : Byte_DWord) return DWord; + function R_To_DWord (X : Byte_DWord) return DWord; + function To_DWords (Byte_Array : Bytes) return DWords; + + -- DWord to Bytes + function To_Bytes (X : DWord) return Byte_DWord; + function R_To_Bytes (X : DWord) return Byte_DWord; + function To_Bytes (DWord_Array : DWords) return Bytes; + + + --DWord = b_0 b_1 b2 b_3 b_4 b_5 b_6 b_7 + -- ByteX returns b_n + function Byte0 (D : DWord) return Byte; + function Byte1 (D : DWord) return Byte; + function Byte2 (D : DWord) return Byte; + function Byte3 (D : DWord) return Byte; + function Byte4 (D : DWord) return Byte; + function Byte5 (D : DWord) return Byte; + function Byte6 (D : DWord) return Byte; + function Byte7 (D : DWord) return Byte; + + -- To_Word + function To_Word (A,B,C,D : Character) return Word; + + -- String to Bytes + function To_Bytes(Message : String) return Bytes; + + -- Bytes to String + function To_String(ASCII : Bytes) return String; + + + -- To_Hex + function To_Hex(B : Byte) return Hex_Byte; + function To_Hex(W : Word) return Hex_Word; + function To_Hex(D : DWord) return Hex_DWord; + + -- To_Bytes + function Hex_To_Bytes(Hex : String) return Bytes; + + -- Is_Zero + -- returns only true if the "input array" X = (others => 0) + function Is_Zero(Byte_Array : Bytes) return Boolean; + function Is_Zero(Word_Array : Words) return Boolean; + function Is_Zero(DWord_Array : DWords) return Boolean; + + + -- Byte Blocks To Bytes. + -- Needed for generic packages to convert a specific byte block. + function To_Bytes(B : B_Block64) return Bytes; + function To_Bytes(B : B_Block128) return Bytes; + function To_Bytes(B : B_Block192) return Bytes; + function To_Bytes(B : B_Block256) return Bytes; + function To_Bytes(W : W_Block160) return Bytes; + function To_Bytes(W : W_Block256) return Bytes; + function To_Bytes(W : W_Block512) return Bytes; + function To_Bytes(D : DW_Block256) return Bytes; + function To_Bytes(D : DW_Block384) return Bytes; + function To_Bytes(D : DW_Block512) return Bytes; + function To_Bytes(D : DW_Block1024) return Bytes; + function To_Bytes(D : DW_Block8192) return Bytes; + + + -- Bytes To block of Bytes. + -- Needed for generic packages to convert a specific byte block. + function To_B_Block64(B : Bytes) return B_Block64; + function To_B_Block128(B : Bytes) return B_Block128; + function To_B_Block192(B : Bytes) return B_Block192; + function To_B_Block256(B : Bytes) return B_Block256; + + + -- Bytes To block of words. + -- Needed for generic packages to convert a specific byte block. + function To_W_Block160(B : Bytes) return W_Block160; + function To_W_Block256(B : Bytes) return W_Block256; + function To_W_Block512(B : Bytes) return W_Block512; + + + -- Bytes To block of double words. + -- Needed for generic packages to convert a specific byte block. + function To_DW_Block256(B : Bytes) return DW_Block256; + function To_DW_Block384(B : Bytes) return DW_Block384; + function To_DW_Block512(B : Bytes) return DW_Block512; + function To_DW_Block1024(B : Bytes) return DW_Block1024; + function To_DW_Block8192(B : Bytes) return DW_Block8192; + + -- Needed for generic packages to convert a specific byte block. + function "xor"(Left, Right : B_Block64) return B_Block64; + function "xor"(Left, Right : B_Block128) return B_Block128; + function "xor"(Left, Right : W_Block160) return W_Block160; + function "xor"(Left, Right : W_Block256) return W_Block256; + function "xor"(Left, Right : W_Block512) return W_Block512; + function "xor"(Left, Right : DW_Block512) return DW_Block512; + function "xor"(Left, Right : DW_Block1024) return DW_Block1024; + function "xor"(Left, Right : DW_Block8192) return DW_Block8192; + + function "+"(Left : B_Block128; Right : Byte) return B_Block128; + + + -- Splits byte array of length n into a left part of length + -- ceiling(n/2) and a right part of length floor(n/2). + function Left_Part(Block : in Bytes) return Bytes; + function Right_Part(Block : in Bytes) return Bytes; + + + + -- Nested generic package + generic + type T is mod <>; + type T_A is array (Integer range <>) of T; + with function Shift_Left (Value : T; Amount : Natural) return T is <>; + with function Shift_Right (Value : T; Amount : Natural) return T is <>; + + package Generic_Mod_Aux is + function "xor"(Left, Right : T_A) return T_A; + function "xor"(Left : T_A; Right : T) return T_A; + function "xor"(Left : T; Right : T_A) return T_A; + + function "and"(Left, Right : T_A) return T_A; + + function "+"(Left : T_A; Right : T) return T_A; + function "+"(Left : T; Right : T_A) return T_A; + + function Is_Zero(Item : T_A) return Boolean; + + function Left_Part (Block : in T_A) return T_A; + function Right_Part(Block : in T_A) return T_A; + + function Shift_Left(Value : T_A; Amount : Natural) return T_A; + function Shift_Right(Value : T_A; Amount : Natural) return T_A; + end Generic_Mod_Aux; + + + + --------------------------------------------------------------------------- + -------------------------------PRIVATE------------------------------------- + --------------------------------------------------------------------------- + +private + pragma Inline (To_B_Block128,To_B_Block192,To_B_Block256); + pragma Inline ("xor","+"); + pragma Inline (R_To_Bytes, To_Bytes); + pragma Inline (To_Word, Byte0, Byte1, Byte2, Byte3); + pragma Inline (Byte4, Byte5, Byte6, Byte7); + pragma Inline (To_DWord, R_To_DWord); + pragma Inline (Is_Zero); + pragma Inline (Left_Part, Right_Part); + pragma Import (Intrinsic, Rotate_Left); + pragma Import (Intrinsic, Rotate_Right); + + pragma Optimize(Time); +end Crypto.Types; diff --git a/src/crypto.ads b/src/crypto.ads new file mode 100644 index 0000000..2f0ed3c --- /dev/null +++ b/src/crypto.ads @@ -0,0 +1,25 @@ +-- This program is free software; you can redistribute it and/or +-- modify it under the terms of the GNU General Public License as +-- published by the Free Software Foundation; either version 2 of the +-- License, or (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- As a special exception, if other files instantiate generics from +-- this unit, or you link this unit with other files to produce an +-- executable, this unit does not by itself cause the resulting +-- executable to be covered by the GNU General Public License. This +-- exception does not however invalidate any other reasons why the +-- executable file might be covered by the GNU Public License. + + +package Crypto is +end Crypto; diff --git a/src/rationals.adb b/src/rationals.adb index 7ae321c..62fe9b9 100644 --- a/src/rationals.adb +++ b/src/rationals.adb @@ -7,12 +7,12 @@ package body Rationals is function Reduce - (Numerator, Denominator : in Integer) + (Numerator, Denominator : in Big_Unsigned) return Fraction is - A : Integer := Numerator; - B : Integer := Denominator; - Temp : Integer; + A : Big_Unsigned := Numerator; + B : Big_Unsigned := Denominator; + Temp : Big_Unsigned; begin -- Euclid's algorithm loop @@ -21,7 +21,8 @@ package body Rationals is B := Temp mod B; exit when B = 0; end loop; - return (Num => Numerator / A, Den => Denominator / A); + return (Num => Numerator / A, + Den => Denominator / A); end Reduce; @@ -42,7 +43,7 @@ package body Rationals is return Fraction is begin return Reduce - (Left.Num + Left.Den * Right, + (Left.Num + Left.Den * Utils.To_Big_Unsigned (Word (Right)), Left.Den); end "+"; @@ -52,7 +53,7 @@ package body Rationals is return Fraction is begin return Reduce - (Left * Right.Den + Right.Num, + (Utils.To_Big_Unsigned (Word (Left)) * Right.Den + Right.Num, Right.Den); end "+"; @@ -74,7 +75,7 @@ package body Rationals is return Fraction is begin return Reduce - (Left.Num - Left.Den * Right, + (Left.Num - Left.Den * Utils.To_Big_Unsigned (Word (Right)), Left.Den); end "-"; @@ -84,7 +85,7 @@ package body Rationals is return Fraction is begin return Reduce - (Left * Right.Den - Right.Num, + (Utils.To_Big_Unsigned (Word (Left)) * Right.Den - Right.Num, Right.Den); end "-"; @@ -116,8 +117,8 @@ package body Rationals is return Fraction is begin return Reduce - (Left.Num * Right, - Right); + (Left.Num * Utils.To_Big_Unsigned (Word (Right)), + Left.Den); end "*"; function "*" @@ -126,7 +127,7 @@ package body Rationals is return Fraction is begin return Reduce - (Left * Right.Num, + (Utils.To_Big_Unsigned (Word (Left)) * Right.Num, Right.Den); end "*"; @@ -149,7 +150,7 @@ package body Rationals is begin return Reduce (Left.Num, - Left.Den * Right); + Left.Den * Utils.To_Big_Unsigned (Word (Right))); end "/"; function "/" @@ -159,14 +160,14 @@ package body Rationals is begin return Reduce (Right.Num, - Left * Right.Den); + Utils.To_Big_Unsigned (Word (Left)) * Right.Den); end "/"; function "/" (Left, Right : in Integer) return Fraction is begin - return Reduce (Left, Right); + return Reduce (Utils.To_Big_Unsigned (Word (Left)), Utils.To_Big_Unsigned (Word (Right))); end "/"; @@ -185,7 +186,7 @@ package body Rationals is Right : in Integer) return Boolean is begin - return Left.Num = Right and Left.Den = 1; + return Left.Num = Utils.To_Big_Unsigned (Word (Right)) and Left.Den = 1; end "="; function "=" @@ -193,7 +194,7 @@ package body Rationals is Right : in Fraction) return Boolean is begin - return Left = Right.Num and Right.Den = 1; + return Utils.To_Big_Unsigned (Word (Left)) = Right.Num and Right.Den = 1; end "="; @@ -211,7 +212,7 @@ package body Rationals is Right : in Integer) return Boolean is begin - return Left.Num <= Left.Den * Right; + return Left.Num <= Left.Den * Utils.To_Big_Unsigned (Word (Right)); end "<="; function "<=" @@ -219,7 +220,7 @@ package body Rationals is Right : in Fraction) return Boolean is begin - return Left * Right.Den <= Right.Num; + return Utils.To_Big_Unsigned (Word (Left)) * Right.Den <= Right.Num; end "<="; @@ -237,7 +238,7 @@ package body Rationals is Right : in Integer) return Boolean is begin - return Left.Num < Left.Den * Right; + return Left.Num < Left.Den * Utils.To_Big_Unsigned (Word (Right)); end "<"; function "<" @@ -245,7 +246,7 @@ package body Rationals is Right : in Fraction) return Boolean is begin - return Left * Right.Den < Right.Num; + return Utils.To_Big_Unsigned (Word (Left)) * Right.Den < Right.Num; end "<"; @@ -263,7 +264,7 @@ package body Rationals is Right : in Integer) return Boolean is begin - return Left.Num >= Left.Den * Right; + return Left.Num >= Left.Den * Utils.To_Big_Unsigned (Word (Right)); end ">="; function ">=" @@ -271,7 +272,7 @@ package body Rationals is Right : in Fraction) return Boolean is begin - return Left * Right.Den >= Right.Num; + return Utils.To_Big_Unsigned (Word (Left)) * Right.Den >= Right.Num; end ">="; @@ -289,7 +290,7 @@ package body Rationals is Right : in Integer) return Boolean is begin - return Left.Num > Left.Den * Right; + return Left.Num > Left.Den * Utils.To_Big_Unsigned (Word (Right)); end ">"; function ">" @@ -297,7 +298,7 @@ package body Rationals is Right : in Fraction) return Boolean is begin - return Left * Right.Den > Right.Num; + return Utils.To_Big_Unsigned (Word (Left)) * Right.Den > Right.Num; end ">"; @@ -307,21 +308,21 @@ package body Rationals is (Item : in Fraction) return Integer is begin - return Item.Num; + return Integer (Utils.To_Words (Item.Num)(1)); end Numerator; function Denominator (Item : in Fraction) return Integer is begin - return Item.Den; + return Integer (Utils.To_Words (Item.Den)(1)); end Denominator; function Floor (Item : in Fraction) return Integer is begin - return Item.Num / Item.Den; + return Integer (Utils.To_Words (Item.Num / Item.Den)(0)); end Floor; function Ceiling @@ -329,9 +330,9 @@ package body Rationals is return Integer is begin if Item.Num mod Item.Den = 0 then - return Item.Num / Item.Den; + return Integer (Utils.To_Words (Item.Num / Item.Den)(1)); else - return 1 + Item.Num / Item.Den; + return 1 + Integer (Utils.To_Words (Item.Num / Item.Den)(1)); end if; end Ceiling; @@ -339,10 +340,10 @@ package body Rationals is (Item : in Fraction) return Integer is begin - if Item.Num mod Item.Den >= Standard."/" (Item.Den, 2) then - return 1 + Item.Num / Item.Den; + if Item.Num mod Item.Den >= Item.Den / 2 then + return 1 + Integer (Utils.To_Words (Item.Num / Item.Den)(1)); else - return Item.Num / Item.Den; + return Integer (Utils.To_Words (Item.Num / Item.Den)(1)); end if; end Round; @@ -351,13 +352,10 @@ package body Rationals is function Image (Item : in Fraction) - return String - is - use Ada.Strings; - use Ada.Strings.Fixed; + return String is begin - return Trim (Integer'Image (Item.Num), Left) & '/' & - Trim (Integer'Image (Item.Den), Left); + return Utils.To_String (Item.Num) & '/' & + Utils.To_String (Item.Den); end Image; function Value @@ -371,7 +369,7 @@ package body Rationals is S := Index (Item, "/"); A := Integer'Value (Item (Item'First .. S - 1)); B := Integer'Value (Item (S + 1 .. Item'Last)); - return Reduce (A, B); + return Reduce (Utils.To_Big_Unsigned (Word (A)), Utils.To_Big_Unsigned (Word (B))); end Value; diff --git a/src/rationals.ads b/src/rationals.ads index 03ac95e..dfa5897 100644 --- a/src/rationals.ads +++ b/src/rationals.ads @@ -1,5 +1,8 @@ +private with Crypto.Types.Big_Numbers; + + package Rationals is @@ -207,9 +210,14 @@ package Rationals is private + package Bignum is new Crypto.Types.Big_Numbers (Size => 128); + use Crypto.Types; + use Bignum; + + type Fraction is record - Num : Integer := 0; - Den : Integer := 1; + Num : Big_Unsigned := Big_Unsigned_Zero; + Den : Big_Unsigned := Big_Unsigned_One; end record; -- cgit