diff options
author | Jed Barber <jjbarber@y7mail.com> | 2017-02-13 13:21:17 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2017-02-13 13:21:17 +1100 |
commit | ea99441e0da927e5a40cf21311265c7e22974f12 (patch) | |
tree | f824f30ab5f475f0f9b5e8a619a36dc81ea83284 | |
parent | 835c2dffc539e277812925469c82662482e1bbc5 (diff) |
Preference dedupe removed, bignum library obtained from internet (will be replaced later)
-rw-r--r-- | notes.txt | 11 | ||||
-rw-r--r-- | readme.txt | 6 | ||||
-rw-r--r-- | src/bundles.adb | 28 | ||||
-rw-r--r-- | src/bundles.ads | 13 | ||||
-rw-r--r-- | src/candidates-containers.ads | 2 | ||||
-rw-r--r-- | src/crypto-asymmetric-prime_tables.ads | 193 | ||||
-rw-r--r-- | src/crypto-asymmetric.ads | 32 | ||||
-rw-r--r-- | src/crypto-types-big_numbers-binfield_utils.adb | 319 | ||||
-rw-r--r-- | src/crypto-types-big_numbers-mod_utils.adb | 741 | ||||
-rw-r--r-- | src/crypto-types-big_numbers-utils.adb | 704 | ||||
-rw-r--r-- | src/crypto-types-big_numbers.adb | 921 | ||||
-rw-r--r-- | src/crypto-types-big_numbers.ads | 399 | ||||
-rw-r--r-- | src/crypto-types-random.adb | 72 | ||||
-rw-r--r-- | src/crypto-types-random.ads | 41 | ||||
-rw-r--r-- | src/crypto-types-random_source-file.adb | 144 | ||||
-rw-r--r-- | src/crypto-types-random_source-file.ads | 50 | ||||
-rw-r--r-- | src/crypto-types-random_source.adb | 55 | ||||
-rw-r--r-- | src/crypto-types-random_source.ads | 27 | ||||
-rw-r--r-- | src/crypto-types.adb | 944 | ||||
-rw-r--r-- | src/crypto-types.ads | 357 | ||||
-rw-r--r-- | src/crypto.ads | 25 | ||||
-rw-r--r-- | src/rationals.adb | 78 | ||||
-rw-r--r-- | src/rationals.ads | 12 |
23 files changed, 5100 insertions, 74 deletions
@@ -1,5 +1,12 @@ +notes +----- + +preference deduplication isn't worth it unless there exists some linear dedupe algorithm + + + future direction ---------------- @@ -9,7 +16,7 @@ util to list paper ids that fit specific criteria to doublecheck potential error add proper tiebreaker handling -more counters/parsers/options to handle state elections, general stv data +more parsers/options to handle state elections, general stv data multithreaded operation? @@ -18,4 +25,6 @@ are they correct now? it's a bit murky with how the AEC records transfers in DOP does the AEC use truncated values or exact ratios for transfer values? does the AEC check for candidates having quota when transfers are only partially done? +REPLACE CRYPTO BIGNUM PACKAGES WITH OWN IMPLEMENTATION + @@ -42,3 +42,9 @@ elect candidates. On the other hand, the AEC program is also a lot more verbose on the distribution of preferences, and doesn't do bulk exclusions. + +Support for bignums (all source files from the 'crypto' package) was obtained from + + https://github.com/cforler/Ada-Crypto-Library + + 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; |