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