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