raw
keccak                  1  -- S.MG, 2018
keccak 2 with System; use System; -- for Bit_Order
keccak 3
keccak 4 package body SMG_Keccak is
keccak 5
keccak 6 -- public function, sponge
keccak 7 procedure Sponge( Input : in Bitstream;
keccak 8 Output : out Bitstream;
keccak 9 Block_Len : in Keccak_Rate := Default_Bitrate ) is
keccak 10 Internal : State := (others => (others => 0));
keccak 11 begin
keccak 12 --absorb input into sponge in a loop on available blocks, including padding
keccak 13 declare
keccak 14 -- number of input blocks after padding (between 2 and block_len bits pad)
keccak 15 Padded_Blocks : constant Positive := 1 + (Input'Length + 1) / Block_Len;
keccak 16 Padded : Bitstream ( 1 .. Padded_Blocks * Block_Len );
keccak 17 Block : Bitstream ( 1 .. Block_Len );
keccak 18 begin
keccak 19 -- initialise Padded with 0 everywhere
keccak 20 Padded := ( others => 0 );
keccak 21 -- copy and pad input with rule 10*1
keccak 22 Padded( Padded'First .. Padded'First + Input'Length - 1 ) := Input;
keccak 23 Padded( Padded'First + Input'Length ) := 1;
keccak 24 Padded( Padded'Last ) := 1;
keccak 25
keccak 26 -- loop through padded input and absorb block by block into sponge
keccak 27 -- padded input IS a multiple of blocks, so no stray bits left
keccak 28 for B in 0 .. Padded_Blocks - 1 loop
keccak 29 -- first get the current block to absorb
keccak 30 Block := Padded( Padded'First + B * Block_Len ..
keccak 31 Padded'First + (B+1) * Block_Len - 1 );
keccak 32 AbsorbBlock( Block, Internal );
keccak 33 -- scramble state with Keccak function
keccak 34 Internal := Keccak_Function( Internal );
keccak 35
keccak 36 end loop; -- end absorb loop for blocks
keccak 37 end; -- end absorb stage
keccak 38
keccak 39 --squeeze required bits from sponge in a loop as needed
keccak 40 declare
keccak 41 -- full blocks per output
keccak 42 BPO : constant Natural := Output'Length / Block_Len;
keccak 43 -- stray bits per output
keccak 44 SPO : constant Natural := Output'Length mod Block_Len;
keccak 45 Block : Bitstream( 1 .. Block_Len );
keccak 46 begin
keccak 47 -- squeeze block by block (if at least one full block is needed)
keccak 48 for I in 0 .. BPO - 1 loop
keccak 49 SqueezeBlock( Block, Internal );
keccak 50 Output( Output'First + I * Block_Len ..
keccak 51 Output'First + (I + 1) * Block_Len -1) := Block;
keccak 52
keccak 53 -- scramble state
keccak 54 Internal := Keccak_Function( Internal );
keccak 55 end loop; -- end squeezing full blocks
keccak 56
keccak 57 -- squeeze any partial block needed (stray bits)
keccak 58 if SPO > 0 then
keccak 59 SqueezeBlock( Block, Internal );
keccak 60 Output( Output'Last - SPO + 1 .. Output'Last ) :=
keccak 61 Block( Block'First .. Block'First + SPO - 1 );
keccak 62 end if; -- end squeezing partial last block (stray bits)
keccak 63
keccak 64 end; -- end squeeze stage
keccak 65 end Sponge;
keccak 66
vdiff_keccak 67 -- public interface, state based Sponge
vdiff_keccak 68 procedure KeccakBegin(Ctx : in out Keccak_Context) is
vdiff_keccak 69 begin
vdiff_keccak 70 Ctx.Internal := (others => (others => 0));
vdiff_keccak 71 Ctx.Block := (others => 0);
vdiff_keccak 72 Ctx.Pos := Ctx.Block'First;
vdiff_keccak 73 end;
vdiff_keccak 74
vdiff_keccak 75 procedure KeccakHash(Ctx : in out Keccak_Context;
vdiff_keccak 76 Input : Bitstream) is
vdiff_keccak 77 I0 : Natural;
vdiff_keccak 78 I1 : Natural;
vdiff_keccak 79 B0 : Natural;
vdiff_keccak 80 B1 : Natural;
vdiff_keccak 81 begin
vdiff_keccak 82 I0 := Input'First;
vdiff_keccak 83 <<Block_Process_Loop>>
vdiff_keccak 84 I1 := Input'Last;
vdiff_keccak 85 B0 := Ctx.Pos;
vdiff_keccak 86 B1 := B0 + (I1-I0);
vdiff_keccak 87
vdiff_keccak 88 if B1>Ctx.Block'Last then
vdiff_keccak 89 B1 := Ctx.Block'Last;
vdiff_keccak 90 I1 := I0 + (B1-B0);
vdiff_keccak 91 end if;
vdiff_keccak 92 Ctx.Block(B0..B1) := Input(I0..I1);
vdiff_keccak 93 Ctx.Pos := B1 + 1;
vdiff_keccak 94 -- we've filled up the buffer
vdiff_keccak 95 if Ctx.Pos > Ctx.Block'Last then
vdiff_keccak 96 AbsorbBlock(Ctx.Block, Ctx.Internal);
vdiff_keccak 97 Ctx.Internal := Keccak_Function(Ctx.Internal);
vdiff_keccak 98 Ctx.Pos := Ctx.Block'First;
vdiff_keccak 99 end if;
vdiff_keccak 100 -- we haven't processed entire input block, loop
vdiff_keccak 101 if I1 < Input'Last then
vdiff_keccak 102 I0 := I1 + 1;
vdiff_keccak 103 goto Block_Process_Loop;
vdiff_keccak 104 end if;
vdiff_keccak 105 end;
vdiff_keccak 106
vdiff_keccak 107 procedure KeccakEnd(Ctx : in out Keccak_Context;
vdiff_keccak 108 Output : out Bitstream) is
vdiff_keccak 109 BlocksPerOutput : constant Natural := Output'Length / Ctx.Block_Len;
vdiff_keccak 110 StrayPerOutput : constant Natural := Output'Length mod Ctx.Block_Len;
vdiff_keccak 111 Block : Bitstream(1 .. Ctx.Block_Len);
vdiff_keccak 112 Need : Natural;
vdiff_keccak 113 begin
vdiff_keccak 114 if Ctx.Pos /= 0 then -- needs padding
vdiff_keccak 115 Block := (others => 0);
vdiff_keccak 116 Need := Ctx.Block'Last - Ctx.Pos;
vdiff_keccak 117 Block(Block'First) := 1;
vdiff_keccak 118 Block(Block'First+Need) := 1;
vdiff_keccak 119 KeccakHash(Ctx, Block(1..Need+1));
vdiff_keccak 120 end if;
vdiff_keccak 121
vdiff_keccak 122 -- squeez bits
vdiff_keccak 123 for I in 0 .. BlocksPerOutput - 1 loop
vdiff_keccak 124 SqueezeBlock(Block, Ctx.Internal);
vdiff_keccak 125 Output(Output'First + I * Ctx.Block_Len ..
vdiff_keccak 126 Output'First + (I + 1) * Ctx.Block_Len -1) := Block;
vdiff_keccak 127 Ctx.Internal := Keccak_Function(Ctx.Internal);
vdiff_keccak 128 end loop;
vdiff_keccak 129 if StrayPerOutput > 0 then
vdiff_keccak 130 SqueezeBlock(Block, Ctx.Internal);
vdiff_keccak 131 Output(Output'Last - StrayPerOutput + 1 .. Output'Last) :=
vdiff_keccak 132 Block(Block'First .. Block'First + StrayPerOutput - 1);
vdiff_keccak 133 end if;
vdiff_keccak 134 end;
vdiff_keccak 135
keccak 136 -- convert from a bitstream of ZWord size to an actual ZWord number
keccak 137 function BitsToWord( BWord: in Bitword ) return ZWord is
keccak 138 W : ZWord;
keccak 139 Bits: Bitword;
keccak 140 begin
keccak 141 -- just copy octets if machine is little endian
keccak 142 -- flip octets if machine is big endian
keccak 143 if Default_Bit_Order = Low_Order_First then
keccak 144 Bits := BWord;
keccak 145 else
keccak 146 Bits := FlipOctets( BWord );
keccak 147 end if;
keccak 148 -- actual bits to word conversion
keccak 149 W := 0;
keccak 150 -- LSB bit order (inside octet) as per Keccak spec
keccak 151 for I in reverse Bitword'Range loop
keccak 152 W := Shift_Left( W, 1 ) + ZWord( Bits( I ) );
keccak 153 end loop;
keccak 154 return W;
keccak 155 end BitsToWord;
keccak 156
keccak 157 -- convert from a ZWord (lane of state) to a bitstream of ZWord size
keccak 158 function WordToBits( Word: in ZWord ) return Bitword is
keccak 159 Bits: Bitword := (others => 0);
keccak 160 W: ZWord;
keccak 161 begin
keccak 162 W := Word;
keccak 163 for I in Bitword'Range loop
keccak 164 Bits( I ) := Bit( W mod 2 );
keccak 165 W := Shift_Right( W, 1 );
keccak 166 end loop;
keccak 167
keccak 168 -- flip octets if machine is big endian
keccak 169 if Default_Bit_Order = High_Order_First then
keccak 170 Bits := FlipOctets( Bits );
keccak 171 end if;
keccak 172
keccak 173 return Bits;
keccak 174 end WordToBits;
keccak 175
keccak 176 -- flip given octets (i.e. groups of 8 bits)
keccak 177 function FlipOctets( BWord : in Bitword ) return Bitword is
keccak 178 Bits : Bitword;
keccak 179 begin
keccak 180 -- copy groups of 8 octets changing their order in the array
keccak 181 -- i.e. 1st octet in BWord becomes last octet in Bits and so on
keccak 182 for I in 0 .. ( Bitword'Length / 8 - 1 ) loop
keccak 183 Bits ( Bits'First + I * 8 .. Bits'First + I * 8 + 7 ) :=
keccak 184 BWord( BWord'Last - I * 8 - 7 .. BWord'Last - I * 8);
keccak 185 end loop;
keccak 186 return Bits;
keccak 187 end FlipOctets;
keccak 188
keccak 189 -- helper procedures for sponge absorb/squeeze
keccak 190
keccak 191 -- NO scramble here, this will absorb ALL given block, make sure it fits!
keccak 192 procedure AbsorbBlock( Block: in Bitstream; S: in out State ) is
keccak 193 WPB: constant Natural := Block'Length / Z_Length; -- words per block
keccak 194 SBB: constant Natural := Block'Length mod Z_Length; -- stray bits
keccak 195 FromPos, ToPos : Natural;
keccak 196 X, Y : XYCoord;
keccak 197 Word : ZWord;
keccak 198 BWord : Bitword;
keccak 199 begin
keccak 200 -- xor current block into first Block'Length bits of state
keccak 201 -- a block can consist in more than one word
keccak 202 X := 0;
keccak 203 Y := 0;
keccak 204 for I in 0..WPB-1 loop
keccak 205 FromPos := Block'First + I * Z_Length;
keccak 206 ToPos := FromPos + Z_Length - 1;
keccak 207 Word := BitsToWord( Block( FromPos .. ToPos ) );
keccak 208 S( X, Y ) := S( X, Y ) xor Word;
keccak 209 -- move on to next word in state
keccak 210 X := X + 1;
keccak 211 if X = 0 then
keccak 212 Y := Y + 1;
keccak 213 end if;
keccak 214 end loop;
keccak 215 -- absorb also any remaining bits from block
keccak 216 if SBB > 0 then
keccak 217 ToPos := Block'Last;
keccak 218 FromPos := ToPos - SBB + 1;
keccak 219 BWord := (others => 0);
keccak 220 BWord(Bitword'First .. Bitword'First + SBB - 1) := Block(ToPos..FromPos);
keccak 221 Word := BitsToWord( BWord );
keccak 222 S( X, Y ) := S( X, Y ) xor Word;
keccak 223 end if;
keccak 224 end AbsorbBlock;
keccak 225
keccak 226 -- NO scramble here, this will squeeze Block'Length bits out of *same* state S
keccak 227 procedure SqueezeBlock( Block: out Bitstream; S: in State) is
keccak 228 X, Y : XYCoord;
keccak 229 BWord : Bitword;
keccak 230 FromPos : Natural;
keccak 231 Len : Natural;
keccak 232 begin
keccak 233 X := 0;
keccak 234 Y := 0;
keccak 235 FromPos := Block'First;
keccak 236
keccak 237 while FromPos <= Block'Last loop
keccak 238 BWord := WordToBits( S(X, Y) );
keccak 239
keccak 240 X := X + 1;
keccak 241 if X = 0 then
keccak 242 Y := Y + 1;
keccak 243 end if;
keccak 244
keccak 245 -- copy full word if it fits or
keccak 246 -- only as many bits as are still needed to fill the block
keccak 247 Len := Block'Last - FromPos + 1;
keccak 248 if Len > Z_Length then
keccak 249 Len := Z_Length;
keccak 250 end if;
keccak 251
keccak 252 Block(FromPos..FromPos+Len-1) := BWord(BWord'First..BWord'First+Len-1);
keccak 253 FromPos := FromPos + Len;
keccak 254 end loop;
keccak 255 end SqueezeBlock;
keccak 256
keccak 257
keccak 258 -- private, internal transformations
keccak 259 function Theta(Input : in State) return State is
keccak 260 Output : State;
keccak 261 C : Plane;
keccak 262 W : ZWord;
keccak 263 begin
keccak 264 for X in XYCoord loop
keccak 265 C(X) := Input(X, 0);
keccak 266 for Y in 1..XYCoord'Last loop
keccak 267 C(X) := C(X) xor Input(X, Y);
keccak 268 end loop;
keccak 269 end loop;
keccak 270
keccak 271 for X in XYCoord loop
keccak 272 W := C(X-1) xor Rotate_Left(C(X+1), 1);
keccak 273 for Y in XYCoord loop
keccak 274 Output(X,Y) := Input(X,Y) xor W;
keccak 275 end loop;
keccak 276 end loop;
keccak 277
keccak 278 return Output;
keccak 279 end Theta;
keccak 280
keccak 281 function Rho(Input : in State) return State is
keccak 282 Output : State;
keccak 283 X, Y, Old_Y : XYCoord;
keccak 284 begin
keccak 285 Output(0,0) := Input(0,0);
keccak 286 X := 1;
keccak 287 Y := 0;
keccak 288
keccak 289 for T in 0..23 loop
keccak 290 Output(X, Y) := Rotate_Left(Input(X,Y), ((T+1)*(T+2)/2) mod Z_Length);
keccak 291 Old_Y := Y;
keccak 292 Y := 2*X + 3*Y;
keccak 293 X := Old_Y;
keccak 294 end loop;
keccak 295 return Output;
keccak 296 end rho;
keccak 297
keccak 298 function Pi(Input : in State) return State is
keccak 299 Output: State;
keccak 300 begin
keccak 301 for X in XYCoord loop
keccak 302 for Y in XYCoord loop
keccak 303 Output(Y, 2*X + 3*Y) := Input(X, Y);
keccak 304 end loop;
keccak 305 end loop;
keccak 306 return Output;
keccak 307 end pi;
keccak 308
keccak 309 function Chi(Input : in State) return State is
keccak 310 Output: State;
keccak 311 begin
keccak 312 for Y in XYCoord loop
keccak 313 for X in XYCoord loop
keccak 314 Output(X, Y) := Input(X, Y) xor
keccak 315 ( (not Input(X + 1, Y)) and Input(X + 2, Y) );
keccak 316 end loop;
keccak 317 end loop;
keccak 318 return Output;
keccak 319 end chi;
keccak 320
keccak 321 function Iota(Round_Const : in ZWord; Input : in State) return State is
keccak 322 Output: State;
keccak 323 begin
keccak 324 Output := Input;
keccak 325 Output(0,0) := Input(0,0) xor Round_Const;
keccak 326 return Output;
keccak 327 end iota;
keccak 328
keccak 329 function Keccak_Function(Input: in State) return State is
keccak 330 Output: State;
keccak 331 begin
keccak 332 Output := Input;
keccak 333 for I in Round_Index loop
keccak 334 Output := Iota(RC(I), Chi(Pi(Rho(Theta(Output)))));
keccak 335 end loop;
keccak 336
keccak 337 return Output;
keccak 338 end Keccak_Function;
keccak 339
keccak 340 end SMG_Keccak;