- C1A09DF1A356CC9042207A12DE9290C85B22A734499661486D419E44B3B22551F87EAA0F6EB2173F771E31CBB078471D3B6650B76434EA9FFBDE1A8D4AFB2814+ 79F6DFDD33D7D501D26723D68A2266256F4244EF725BACC13F93F3C353C2B4CE03A866B1C53CFC760C65EF2CC27AB500924AF770F58C5624CB601D0BFCDE6B0Eeucrypt/smg_keccak/smg_keccak.adb(1 . 30)(1 . 32)
13 -- S.MG, 2018
14 with System; use System; -- for Bit_Order
15 with Interfaces; use Interfaces;
16
17 package body SMG_Keccak is
18
19 -- public function, sponge
20 procedure Sponge( Input : in Bitstream;
21 Output : out Bitstream;
22 Block_Len : in Keccak_Rate := Default_Bitrate ) is
23 procedure Sponge( Input : in Bytestream;
24 Output : out Bytestream;
25 Block_Len : in Keccak_Rate := Default_Byterate ) is
26 Internal : State := (others => (others => 0));
27 begin
28 --absorb input into sponge in a loop on available blocks, including padding
29 declare
30 -- number of input blocks after padding (between 2 and block_len bits pad)
31 Padded_Blocks : constant Positive := 1 + (Input'Length + 1) / Block_Len;
32 Padded : Bitstream ( 1 .. Padded_Blocks * Block_Len );
33 Block : Bitstream ( 1 .. Block_Len );
34 -- number of input blocks after padding (pad between 1 and block_len)
35 Padded_Blocks : constant Positive := 1 + Input'Length / Block_Len;
36 Padded : Bytestream ( 1 .. Padded_Blocks * Block_Len );
37 Block : Bytestream ( 1 .. Block_Len );
38 begin
39 -- initialise Padded with 0 everywhere
40 Padded := ( others => 0 );
41 -- copy and pad input with rule 10*1
42 Padded( Padded'First .. Padded'First + Input'Length - 1 ) := Input;
43 -- padding is 10*1 so start and end with an 1 but LSB order hence 16#80#
44 Padded( Padded'First + Input'Length ) := 1;
45 Padded( Padded'Last ) := 1;
46 Padded( Padded'Last ) := Padded( Padded'Last ) + 16#80#;
47
48 -- loop through padded input and absorb block by block into sponge
49 -- padded input IS a multiple of blocks, so no stray bits left
50 -- padded input IS a multiple of blocks, so no stray octets left
51 for B in 0 .. Padded_Blocks - 1 loop
52 -- first get the current block to absorb
53 Block := Padded( Padded'First + B * Block_Len ..
(36 . 13)(38 . 13)
55 end loop; -- end absorb loop for blocks
56 end; -- end absorb stage
57
58 --squeeze required bits from sponge in a loop as needed
59 --squeeze required octets from sponge in a loop as needed
60 declare
61 -- full blocks per output
62 BPO : constant Natural := Output'Length / Block_Len;
63 -- stray bits per output
64 -- stray octets per output
65 SPO : constant Natural := Output'Length mod Block_Len;
66 Block : Bitstream( 1 .. Block_Len );
67 Block : Bytestream( 1 .. Block_Len );
68 begin
69 -- squeeze block by block (if at least one full block is needed)
70 for I in 0 .. BPO - 1 loop
(54 . 88)(56 . 90)
72 Internal := Keccak_Function( Internal );
73 end loop; -- end squeezing full blocks
74
75 -- squeeze any partial block needed (stray bits)
76 -- squeeze any partial block needed (stray octets)
77 if SPO > 0 then
78 SqueezeBlock( Block, Internal );
79 Output( Output'Last - SPO + 1 .. Output'Last ) :=
80 Block( Block'First .. Block'First + SPO - 1 );
81 end if; -- end squeezing partial last block (stray bits)
82 end if; -- end squeezing partial last block (stray octets)
83
84 end; -- end squeeze stage
85 end Sponge;
86
87 -- convert from a bitstream of ZWord size to an actual ZWord number
88 function BitsToWord( BWord: in Bitword ) return ZWord is
89 -- convert from a bytestream of ZWord/8 size to an actual ZWord number
90 -- NB: this will FLIP bits on big endian because keccak expects input LSB
91 -- NOT exact opposite of WordToBytes
92 function BytesToWordLE( BWord: in Byteword ) return ZWord is
93 W : ZWord;
94 Bits: Bitword;
95 B : Byteword;
96 begin
97 -- just copy octets if machine is little endian
98 -- flip octets if machine is big endian
99 -- flip octets AND bits if machine is big endian
100 if Default_Bit_Order = Low_Order_First then
101 Bits := BWord;
102 B := BWord;
103 else
104 Bits := FlipOctets( BWord );
105 B := FlipOctets( BWord );
106 for I in B'First..B'Last loop
107 B(I) := Reverse_Table(Natural(B(I)));
108 end loop;
109 end if;
110 -- actual bits to word conversion
111 W := 0;
112 -- LSB bit order (inside octet) as per Keccak spec
113 for I in reverse Bitword'Range loop
114 W := Shift_Left( W, 1 ) + ZWord( Bits( I ) );
115 end loop;
116 -- actual bytes to word conversion
117 W := Cast(B);
118 return W;
119 end BitsToWord;
120 end BytesToWordLE;
121
122 -- convert from a ZWord (lane of state) to a bitstream of ZWord size
123 function WordToBits( Word: in ZWord ) return Bitword is
124 Bits: Bitword := (others => 0);
125 W: ZWord;
126 begin
127 W := Word;
128 for I in Bitword'Range loop
129 Bits( I ) := Bit( W mod 2 );
130 W := Shift_Right( W, 1 );
131 end loop;
132 -- convert from a ZWord (lane of state) to a bytestream of ZWord size
133 -- NOT exact oppositve of BytesToWordLE
134 -- Keccak sponge spits out MSB so bits are flipped on LITTLE Endian iron.
135 function WordToBytesBE( Word: in ZWord ) return Byteword is
136 B: Byteword;
137 begin
138 B := Cast( Word );
139
140 -- flip octets if machine is big endian
141 if Default_Bit_Order = High_Order_First then
142 Bits := FlipOctets( Bits );
143 B := FlipOctets( B );
144 else
145 -- onth flip bits if machine is little endian....
146 for I in B'First..B'Last loop
147 B(I) := Reverse_Table(Natural(B(I)));
148 end loop;
149 end if;
150
151 return Bits;
152 end WordToBits;
153 return B;
154 end WordToBytesBE;
155
156 -- flip given octets (i.e. groups of 8 bits)
157 function FlipOctets( BWord : in Bitword ) return Bitword is
158 Bits : Bitword;
159 function FlipOctets( BWord : in Byteword ) return Byteword is
160 B : Byteword;
161 begin
162 -- copy groups of 8 octets changing their order in the array
163 -- i.e. 1st octet in BWord becomes last octet in Bits and so on
164 for I in 0 .. ( Bitword'Length / 8 - 1 ) loop
165 Bits ( Bits'First + I * 8 .. Bits'First + I * 8 + 7 ) :=
166 BWord( BWord'Last - I * 8 - 7 .. BWord'Last - I * 8);
167 -- copy octets changing their order in the array
168 -- i.e. 1st octet in BWord becomes last octet in B and so on
169 for I in 0 .. BWord'Length-1 loop
170 B(B'First + I) := BWord(BWord'Last-I);
171 end loop;
172 return Bits;
173 return B;
174 end FlipOctets;
175
176 -- helper procedures for sponge absorb/squeeze
177
178 -- NO scramble here, this will absorb ALL given block, make sure it fits!
179 procedure AbsorbBlock( Block: in Bitstream; S: in out State ) is
180 WPB: constant Natural := Block'Length / Z_Length; -- words per block
181 SBB: constant Natural := Block'Length mod Z_Length; -- stray bits
182 procedure AbsorbBlock( Block: in Bytestream; S: in out State ) is
183 WPB: constant Natural := Block'Length / Byteword'Length; -- words per block
184 SBB: constant Natural := Block'Length mod Byteword'Length; -- stray octets
185 FromPos, ToPos : Natural;
186 X, Y : XYCoord;
187 Word : ZWord;
188 BWord : Bitword;
189 BWord : Byteword;
190 begin
191 -- xor current block into first Block'Length bits of state
192 -- xor current block into first Block'Length octets of state
193 -- a block can consist in more than one word
194 X := 0;
195 Y := 0;
196 for I in 0..WPB-1 loop
197 FromPos := Block'First + I * Z_Length;
198 ToPos := FromPos + Z_Length - 1;
199 Word := BitsToWord( Block( FromPos .. ToPos ) );
200 FromPos := Block'First + I * Byteword'Length;
201 ToPos := FromPos + Byteword'Length - 1;
202 Word := BytesToWordLE( Block( FromPos .. ToPos ) );
203 S( X, Y ) := S( X, Y ) xor Word;
204 -- move on to next word in state
205 X := X + 1;
(143 . 21)(147 . 21)
207 Y := Y + 1;
208 end if;
209 end loop;
210 -- absorb also any remaining bits from block
211 -- absorb also any remaining bytes from block
212 if SBB > 0 then
213 ToPos := Block'Last;
214 FromPos := ToPos - SBB + 1;
215 BWord := (others => 0);
216 BWord(Bitword'First .. Bitword'First + SBB - 1) := Block(FromPos..ToPos);
217 Word := BitsToWord( BWord );
218 BWord(Byteword'First .. Byteword'First + SBB - 1) := Block(FromPos..ToPos);
219 Word := BytesToWordLE( BWord );
220 S( X, Y ) := S( X, Y ) xor Word;
221 end if;
222 end AbsorbBlock;
223
224 -- NO scramble here, this will squeeze Block'Length bits out of *same* state S
225 procedure SqueezeBlock( Block: out Bitstream; S: in State) is
226 procedure SqueezeBlock( Block: out Bytestream; S: in State) is
227 X, Y : XYCoord;
228 BWord : Bitword;
229 BWord : Byteword;
230 FromPos : Natural;
231 Len : Natural;
232 begin
(166 . 7)(170 . 7)
234 FromPos := Block'First;
235
236 while FromPos <= Block'Last loop
237 BWord := WordToBits( S(X, Y) );
238 BWord := WordToBytesBE( S(X, Y) );
239
240 X := X + 1;
241 if X = 0 then
(174 . 10)(178 . 10)
243 end if;
244
245 -- copy full word if it fits or
246 -- only as many bits as are still needed to fill the block
247 -- only as many bytes as are still needed to fill the block
248 Len := Block'Last - FromPos + 1;
249 if Len > Z_Length then
250 Len := Z_Length;
251 if Len > BWord'Length then
252 Len := BWord'Length;
253 end if;
254
255 Block(FromPos..FromPos+Len-1) := BWord(BWord'First..BWord'First+Len-1);