raw
eucrypt_ch10_oaep...    1 -- S.MG, 2018
eucrypt_ch10_oaep...    2 
eucrypt_ch10_oaep...    3 package body SMG_OAEP is
eucrypt_ch10_oaep...    4 
eucrypt_ch12_wrap...    5   -- This copies first Len characters from A to the first Len positions in S
eucrypt_ch12_wrap...    6   -- NB: this does NOT allocate /check memory!
eucrypt_ch12_wrap...    7   -- Caller has to ensure that:
eucrypt_ch12_wrap...    8   --    S has space for at least Len characters
eucrypt_ch12_wrap...    9   --    A has at least Len characters
eucrypt_ch12_wrap...   10   procedure Char_Array_To_String( A   : in Interfaces.C.char_array;
eucrypt_ch12_wrap...   11                                   Len : in Natural;
eucrypt_ch12_wrap...   12                                   S   : out String) is
eucrypt_ch12_wrap...   13   begin
eucrypt_ch12_wrap...   14     for Index in 0 .. Len - 1 loop
eucrypt_ch12_wrap...   15       S( S'First + Index ) := Character( A( Interfaces.C.size_t( Index )));
eucrypt_ch12_wrap...   16     end loop;
eucrypt_ch12_wrap...   17   end Char_Array_To_String;
eucrypt_ch12_wrap...   18 
eucrypt_ch12_wrap...   19   -- This copies first Len characters from S to the first Len positions in A
eucrypt_ch12_wrap...   20   -- NB: there are NO checks or memory allocations here!
eucrypt_ch12_wrap...   21   -- Caller has to make sure that:
eucrypt_ch12_wrap...   22   --   S'Length >= Len
eucrypt_ch12_wrap...   23   --   A has allocated space for at least Len characters
eucrypt_ch12_wrap...   24   procedure String_To_Char_Array( S   : in String;
eucrypt_ch12_wrap...   25                                   Len : in Natural;
eucrypt_ch12_wrap...   26                                   A   : out Interfaces.C.char_array) is
eucrypt_ch12_wrap...   27     C : Character;
eucrypt_ch12_wrap...   28   begin
eucrypt_ch12_wrap...   29     for Index in 0 .. Len - 1 loop
eucrypt_ch12_wrap...   30       C := S( S'First + Index );
eucrypt_ch12_wrap...   31       A( Interfaces.C.size_t( Index )) := Interfaces.C.Char( C );
eucrypt_ch12_wrap...   32     end loop;
eucrypt_ch12_wrap...   33   end String_To_Char_Array;
eucrypt_ch12_wrap...   34 
eucrypt_ch12_wrap...   35 
eucrypt_ch10_oaep...   36   procedure HashKeccak( Input     : in String;
eucrypt_ch10_oaep...   37                         Output    : out String;
eucrypt_ch10_oaep...   38                         Block_Len : in Keccak_Rate := Default_Bitrate) is
eucrypt_ch10_oaep...   39     BIn  : Bitstream( 0 .. Input'Length * 8 - 1 );
eucrypt_ch10_oaep...   40     BOut : Bitstream( 0 .. Output'Length * 8 - 1 ); 
eucrypt_ch10_oaep...   41   begin
eucrypt_ch10_oaep...   42     ToBitstream( Input, BIn);
eucrypt_ch10_oaep...   43     Sponge( BIn, BOut, Block_Len);
eucrypt_ch10_oaep...   44     ToString( BOut, Output );
eucrypt_ch10_oaep...   45   end HashKeccak;
eucrypt_ch10_oaep...   46 
eucrypt_ch12_wrap...   47   procedure Hash( Input     : in Interfaces.C.Char_Array;
eucrypt_ch12_wrap...   48                   LenIn     : in Interfaces.C.size_t;
eucrypt_ch12_wrap...   49                   LenOut    : in Interfaces.C.size_t;
eucrypt_ch12_wrap...   50                   Output    : out Interfaces.C.Char_Array) is
eucrypt_ch12_wrap...   51     AdaLenIn  : Natural := Natural( LenIn );
eucrypt_ch12_wrap...   52     AdaLenOut : Natural := Natural( LenOut );
eucrypt_ch12_wrap...   53     InStr     : String( 1 .. AdaLenIn )  := (others => '0'); 
eucrypt_ch12_wrap...   54     OutStr    : String( 1 .. AdaLenOut ) := (others => '0');
eucrypt_ch12_wrap...   55     Block_Len : Keccak_Rate := Default_Bitrate;
eucrypt_ch12_wrap...   56   begin
eucrypt_ch12_wrap...   57 --    Interfaces.C.To_Ada( Input, InStr, AdaLenIn );
eucrypt_ch12_wrap...   58     Char_Array_To_String( Input, AdaLenIn, InStr );
eucrypt_ch12_wrap...   59     HashKeccak( InStr, OutStr, Block_Len );
eucrypt_ch12_wrap...   60     String_To_Char_Array( OutStr, AdaLenOut, Output );
eucrypt_ch12_wrap...   61 --    Interfaces.C.To_C( OutStr, COut, CCount );
eucrypt_ch10_oaep...   62   end Hash;
eucrypt_ch10_oaep...   63 
eucrypt_ch10_oaep...   64   -- conversion between types
eucrypt_ch10_oaep...   65   procedure ToString(B: in Bitstream; S: out String ) is
eucrypt_ch10_oaep...   66     N   : Natural;
eucrypt_ch10_oaep...   67     Pos : Natural;
eucrypt_ch10_oaep...   68   begin
eucrypt_ch10_oaep...   69     Pos := B'First;
eucrypt_ch10_oaep...   70     for I in S'Range loop
eucrypt_ch10_oaep...   71       N := Natural( B( Pos     ) ) +
eucrypt_ch10_oaep...   72            Natural( B( Pos + 1 ) ) * 2 +
eucrypt_ch10_oaep...   73            Natural( B( Pos + 2 ) ) * 4 +
eucrypt_ch10_oaep...   74            Natural( B( Pos + 3 ) ) * 8 +
eucrypt_ch10_oaep...   75            Natural( B( Pos + 4 ) ) * 16 +
eucrypt_ch10_oaep...   76            Natural( B( Pos + 5 ) ) * 32 +
eucrypt_ch10_oaep...   77            Natural( B( Pos + 6 ) ) * 64 +
eucrypt_ch10_oaep...   78            Natural( B( Pos + 7 ) ) * 128;
eucrypt_ch10_oaep...   79       Pos := Pos + 8;
eucrypt_ch10_oaep...   80       S( I ) := Character'Val( N );
eucrypt_ch10_oaep...   81     end loop;
eucrypt_ch10_oaep...   82   end ToString;
eucrypt_ch10_oaep...   83 
eucrypt_ch10_oaep...   84   procedure ToBitstream(S: in String; B: out Bitstream ) is
eucrypt_ch10_oaep...   85     V   : Unsigned_8;
eucrypt_ch10_oaep...   86     Pos : Natural;
eucrypt_ch10_oaep...   87   begin
eucrypt_ch10_oaep...   88     Pos := B'First;
eucrypt_ch10_oaep...   89     for C of S loop
eucrypt_ch10_oaep...   90       V := Character'Pos( C );
eucrypt_ch10_oaep...   91       B( Pos     ) := Bit( V and 1 );
eucrypt_ch10_oaep...   92       B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 );
eucrypt_ch10_oaep...   93       B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 );
eucrypt_ch10_oaep...   94       B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 );
eucrypt_ch10_oaep...   95       B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 );
eucrypt_ch10_oaep...   96       B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 );
eucrypt_ch10_oaep...   97       B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 );
eucrypt_ch10_oaep...   98       B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 );
eucrypt_ch10_oaep...   99 
eucrypt_ch10_oaep...  100       Pos := Pos + 8;
eucrypt_ch10_oaep...  101     end loop;
eucrypt_ch10_oaep...  102   end ToBitstream;
eucrypt_ch10_oaep...  103 
eucrypt_ch10_oaep...  104   -- padding & formatting of maximum 1960 bits of the given String 
eucrypt_ch10_oaep...  105   -- uses TMSR's OAEP schema:
eucrypt_ch10_oaep...  106   -- 1.format M00 as: [random octet][sz1][sz2]"TMSR-RSA"[random]*Message
eucrypt_ch10_oaep...  107   --    where sz1 and sz2 store the length of the message in bits
eucrypt_ch10_oaep...  108   --    the random octets before message are padding to make OAEP_LENGTH_OCTETS
eucrypt_ch10_oaep...  109   -- 2. R = OAEP_HALF_OCTETS random bits
eucrypt_ch10_oaep...  110   -- 3. X = M00 xor hash(R)
eucrypt_ch10_oaep...  111   -- 4. Y = R xor hash(X)
eucrypt_ch10_oaep...  112   -- 5. Result is X || Y 
eucrypt_ch10_oaep...  113   -- NB: the Entropy parameter should be random octets from which this method 
eucrypt_ch10_oaep...  114   -- will use as many as required for the OAEP encryption of given Msg
eucrypt_oaep_fix_...  115   -- NB: at MOST MAX_LEN_MSG octets of Msg! (Msg at most 1960 bits)
eucrypt_ch10_oaep...  116   procedure OAEP_Encrypt( Msg     : in String;
eucrypt_ch10_oaep...  117                           Entropy : in OAEP_Block;
eucrypt_ch10_oaep...  118                           Output  : out OAEP_Block) is
eucrypt_ch10_oaep...  119     M00    : OAEP_HALF;
eucrypt_ch10_oaep...  120     R      : OAEP_HALF;
eucrypt_ch10_oaep...  121     HashR  : OAEP_HALF;
eucrypt_ch10_oaep...  122     X      : OAEP_HALF;
eucrypt_ch10_oaep...  123     HashX  : OAEP_HALF;
eucrypt_ch10_oaep...  124     Y      : OAEP_HALF;
eucrypt_ch10_oaep...  125     MsgLen : Natural;
eucrypt_ch10_oaep...  126     PadLen : Natural;
eucrypt_ch10_oaep...  127   begin
eucrypt_ch10_oaep...  128     -- calculate maximum length of msg and needed amount of padding
eucrypt_oaep_fix_...  129     -- make sure also that only MAX_LEN_MSG octets at most are used from Msg
eucrypt_ch10_oaep...  130     MsgLen := Msg'Length;                          -- real msg length
eucrypt_oaep_fix_...  131     if MsgLen > MAX_LEN_MSG then
eucrypt_oaep_fix_...  132       MsgLen := MAX_LEN_MSG;  --only first MAX_LEN_MSG octets are considered
eucrypt_oaep_fix_...  133       PadLen := 0;            --no padding needed
eucrypt_ch10_oaep...  134     else
eucrypt_oaep_fix_...  135       PadLen := MAX_LEN_MSG - MsgLen; -- msg may be too short, add padding
eucrypt_ch10_oaep...  136     end if;
eucrypt_ch10_oaep...  137 
eucrypt_ch10_oaep...  138     -- step 1: header and format to obtain M00
eucrypt_ch10_oaep...  139       -- first octet is random bits
eucrypt_ch10_oaep...  140     M00( M00'First ) := Entropy( Entropy'First );
eucrypt_ch10_oaep...  141 
eucrypt_ch10_oaep...  142       -- next 2 octets hold the used length of Msg (number of octets)
eucrypt_ch10_oaep...  143     M00( M00'First + 2) := Character'Val( ( MsgLen * 8 ) mod 255 );
eucrypt_ch10_oaep...  144     M00( M00'First + 1) := Character'Val( ( (MsgLen * 8 ) / 255 ) mod 255 );
eucrypt_ch10_oaep...  145 
eucrypt_ch10_oaep...  146       -- next 8 octets are reserved for later use, currently "TMSR-RSA"
eucrypt_ch10_oaep...  147     M00( M00'First + 3 .. M00'First + 10 ) := TMSR;
eucrypt_ch10_oaep...  148 
eucrypt_ch10_oaep...  149       -- random bits for padding, if Msg is less than 245 octets
eucrypt_ch10_oaep...  150     for I in 1 .. PadLen loop
eucrypt_ch10_oaep...  151       M00( M00'First + 10 + I ) := Entropy( Entropy'First + I );
eucrypt_ch10_oaep...  152     end loop;
eucrypt_ch10_oaep...  153 
eucrypt_ch10_oaep...  154       -- the message itself
eucrypt_ch10_oaep...  155     M00( M00'Last - MsgLen + 1 .. M00'Last ) := 
eucrypt_ch10_oaep...  156                                Msg( Msg'First .. Msg'First + MsgLen - 1 );
eucrypt_ch10_oaep...  157 
eucrypt_ch10_oaep...  158     -- step 2: R = OAEP_HALF_OCTETS random octets
eucrypt_ch10_oaep...  159     -- can take LAST octets from given entropy as they are NOT used before
eucrypt_ch10_oaep...  160     -- (even if original message was empty, padding uses at most half - 10
eucrypt_ch10_oaep...  161     --   while entropy has full block length)
eucrypt_ch10_oaep...  162     R := Entropy( Entropy'Last - OAEP_HALF_OCTETS + 1 .. Entropy'Last );
eucrypt_ch10_oaep...  163 
eucrypt_ch10_oaep...  164     -- step 3: X = M00 xor hash(R)
eucrypt_ch10_oaep...  165     HashKeccak( R, HashR );
eucrypt_ch10_oaep...  166     XOR_Strings( M00, HashR, X );
eucrypt_ch10_oaep...  167 
eucrypt_ch10_oaep...  168     -- step 4: Y = R xor hash(X)
eucrypt_ch10_oaep...  169     HashKeccak( X, HashX );
eucrypt_ch10_oaep...  170     XOR_Strings( R, HashX, Y );
eucrypt_ch10_oaep...  171 
eucrypt_ch10_oaep...  172     -- step 5: Output is X || Y
eucrypt_ch10_oaep...  173     Output( Output'First .. Output'First + X'Length - 1 ) := X;
eucrypt_ch10_oaep...  174     Output( Output'Last - Y'Length + 1 .. Output'Last )   := Y;
eucrypt_ch10_oaep...  175     
eucrypt_ch10_oaep...  176   end OAEP_Encrypt;
eucrypt_ch10_oaep...  177 
eucrypt_ch12_wrap...  178   procedure OAEP_Encrypt_C( Msg       : in Interfaces.C.char_array;
eucrypt_ch12_wrap...  179                             MsgLen    : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  180                             Entropy   : in Interfaces.C.char_array;
eucrypt_ch12_wrap...  181                             EntLen    : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  182                             Encr      : out Interfaces.C.char_array;
eucrypt_ch12_wrap...  183                             EncrLen   : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  184                             Success   : out Interfaces.C.Int) is
eucrypt_ch12_wrap...  185     AdaMsgLen  : Natural := Natural( MsgLen );
eucrypt_ch12_wrap...  186     AdaEntLen  : Natural := Natural( EntLen );
eucrypt_ch12_wrap...  187     AdaEncrLen : Natural := Natural( EncrLen );
eucrypt_ch12_wrap...  188     AdaMsg     : String( 1 .. AdaMsgLen );
eucrypt_ch12_wrap...  189     AdaEntBlock: OAEP_Block;
eucrypt_ch12_wrap...  190     AdaResult  : OAEP_Block := ( others => '0' );
eucrypt_ch12_wrap...  191   begin
eucrypt_ch12_wrap...  192     Success := 0;
eucrypt_ch12_wrap...  193     -- check there is enough entropy and enoug output space, fail otherwise
eucrypt_ch12_wrap...  194     if AdaEntLen /= AdaEntBlock'Length or AdaEncrLen < AdaResult'Length then
eucrypt_ch12_wrap...  195       return;
eucrypt_ch12_wrap...  196     end if;
eucrypt_ch12_wrap...  197     -- translate to Ada
eucrypt_ch12_wrap...  198       --Interfaces.C.To_Ada( Msg, AdaMsg, AdaMsgLen );
eucrypt_ch12_wrap...  199     Char_Array_To_String( Msg, AdaMsgLen, AdaMsg );
eucrypt_ch12_wrap...  200       --Interfaces.C.To_Ada( Entropy, AdaEntropy, AdaEntLen );
eucrypt_ch12_wrap...  201     Char_Array_To_String( Entropy, AdaEntLen, AdaEntBlock );
eucrypt_ch12_wrap...  202 
eucrypt_ch12_wrap...  203     -- call the actual oaep encrypt
eucrypt_ch12_wrap...  204     OAEP_Encrypt( AdaMsg, AdaEntBlock, AdaResult );
eucrypt_ch12_wrap...  205 
eucrypt_ch12_wrap...  206     -- translate back to C, set success flag and return 
eucrypt_ch12_wrap...  207        --Interfaces.C.To_C( AdaResult, CEncr, CEncrLen, False );
eucrypt_ch12_wrap...  208     -- EncrLen has already been tested to be at least AdaResult'Length
eucrypt_ch12_wrap...  209     String_To_Char_Array( AdaResult, AdaEncrLen, Encr );
eucrypt_ch12_wrap...  210     Success := 1;
eucrypt_ch12_wrap...  211 
eucrypt_ch12_wrap...  212   end OAEP_Encrypt_C;
eucrypt_ch12_wrap...  213 
eucrypt_ch12_wrap...  214   procedure oaep_decrypt_c( Encr    : in Interfaces.C.Char_Array;
eucrypt_ch12_wrap...  215                             EncrLen : in Interfaces.C.Int;
eucrypt_ch12_wrap...  216                             Decr    : out Interfaces.C.Char_Array;
eucrypt_ch12_wrap...  217                             DecrLen : in out Interfaces.C.Int;
eucrypt_ch12_wrap...  218                             Success : out Interfaces.C.Int) is
eucrypt_ch12_wrap...  219     AdaDecr    : OAEP_HALF := ( others => '0' );
eucrypt_ch12_wrap...  220     AdaEncr    : OAEP_Block:= ( others => '0' );
eucrypt_ch12_wrap...  221     AdaEncrLen : Natural := Natural( EncrLen );
eucrypt_ch12_wrap...  222     AdaDecrLen : Natural := 0;
eucrypt_ch12_wrap...  223     AdaFlag    : Boolean;
eucrypt_ch12_wrap...  224   begin
eucrypt_ch12_wrap...  225     -- check and set success flag/exit if needed
eucrypt_ch12_wrap...  226     Success := 0;
eucrypt_ch12_wrap...  227     if EncrLen /= OAEP_Block'Length then
eucrypt_ch12_wrap...  228       return;
eucrypt_ch12_wrap...  229     end if;
eucrypt_ch12_wrap...  230 
eucrypt_ch12_wrap...  231     -- translate to Ada: copy octet by octet as C.To_Ada is problematic
eucrypt_ch12_wrap...  232       -- Interfaces.C.To_Ada( Encr, AdaEncr, AdaEncrLen, False );
eucrypt_ch12_wrap...  233     Char_Array_To_String( Encr, AdaEncrLen, AdaEncr );
eucrypt_ch12_wrap...  234 
eucrypt_ch12_wrap...  235     -- actual decrypt
eucrypt_ch12_wrap...  236     OAEP_Decrypt( AdaEncr, AdaDecrLen, AdaDecr, AdaFlag );
eucrypt_ch12_wrap...  237 
eucrypt_ch12_wrap...  238     -- translate back to C
eucrypt_ch12_wrap...  239     AdaDecrLen := AdaDecrLen / 8;  -- from bits to octets
eucrypt_ch12_wrap...  240     if AdaFlag and 
eucrypt_ch12_wrap...  241        Natural( DecrLen ) >= AdaDecrLen and 
eucrypt_ch12_wrap...  242        AdaDecr'Length >= AdaDecrLen then
eucrypt_ch12_wrap...  243       Success := 1;
eucrypt_ch12_wrap...  244       DecrLen := Interfaces.C.Int( AdaDecrLen );
eucrypt_ch12_wrap...  245         -- Interfaces.C.To_C( AdaDecr, Decr, AdaDecrLen );
eucrypt_ch12_wrap...  246       String_To_Char_Array( AdaDecr, AdaDecrLen, Decr );
eucrypt_ch12_wrap...  247     end if;
eucrypt_ch12_wrap...  248   end oaep_decrypt_c;
eucrypt_ch12_wrap...  249 
eucrypt_ch10_oaep...  250   procedure OAEP_Decrypt( Encr    : in OAEP_Block;
eucrypt_ch10_oaep...  251                           Len     : out Natural;
eucrypt_ch10_oaep...  252                           Output  : out OAEP_HALF;
eucrypt_ch10_oaep...  253                           Success : out Boolean ) is
eucrypt_ch10_oaep...  254     X, Y, M, R   : OAEP_HALF;
eucrypt_ch10_oaep...  255     HashX, HashR : OAEP_HALF;
eucrypt_ch10_oaep...  256     LenOctets    : Natural;
eucrypt_ch10_oaep...  257   begin
eucrypt_ch10_oaep...  258     -- step 1: separate X and Y
eucrypt_ch10_oaep...  259     X := Encr( Encr'First .. Encr'First + X'Length - 1 );
eucrypt_ch10_oaep...  260     Y := Encr( Encr'Last - Y'Length + 1 .. Encr'Last );
eucrypt_ch10_oaep...  261 
eucrypt_ch10_oaep...  262     -- step 2: R = Y xor hash(X)
eucrypt_ch10_oaep...  263     HashKeccak( X, HashX );
eucrypt_ch10_oaep...  264     XOR_Strings( Y, HashX, R );
eucrypt_ch10_oaep...  265 
eucrypt_ch10_oaep...  266     -- step 3: M = X xor hash(R)
eucrypt_ch10_oaep...  267     HashKeccak( R, HashR );
eucrypt_ch10_oaep...  268     XOR_Strings( X, HashR, M );
eucrypt_ch10_oaep...  269 
eucrypt_ch10_oaep...  270     -- step 4: extract length and message
eucrypt_ch10_oaep...  271     Len := Character'Pos( M( M'First + 1 ) ) * 255 +
eucrypt_ch10_oaep...  272            Character'Pos( M( M'First + 2 ) );
eucrypt_ch10_oaep...  273     LenOctets := Len / 8; 
eucrypt_ch10_oaep...  274 
eucrypt_oaep_fix_...  275     if LenOctets > MAX_LEN_MSG or LenOctets < 0 then
eucrypt_ch10_oaep...  276       Success := False;  -- error, failed to retrieve message
eucrypt_ch10_oaep...  277     else
eucrypt_ch10_oaep...  278       Success := True;
eucrypt_ch10_oaep...  279       Output( Output'First .. Output'First + LenOctets - 1 ) := 
eucrypt_ch10_oaep...  280         M( M'Last - LenOctets + 1 .. M'Last );
eucrypt_ch10_oaep...  281     end if;
eucrypt_ch10_oaep...  282 
eucrypt_ch10_oaep...  283   end OAEP_Decrypt;
eucrypt_ch10_oaep...  284 
eucrypt_ch10_oaep...  285   -- helper method, xor on strings
eucrypt_ch10_oaep...  286   -- NB: only Output'Length bits will be considered from S1 and S2
eucrypt_ch10_oaep...  287   -- NB: caller is responsible for S1 and S2 being long enough!
eucrypt_ch10_oaep...  288   procedure XOR_Strings( S1: in String; S2: in String; Output: out String ) is
eucrypt_ch10_oaep...  289     V1, V2: Unsigned_8;
eucrypt_ch10_oaep...  290   begin
eucrypt_ch10_oaep...  291     for I in Output'Range loop
eucrypt_ch10_oaep...  292       V1 := Character'Pos( S1( I ) );
eucrypt_ch10_oaep...  293       V2 := Character'Pos( S2( I ) );
eucrypt_ch10_oaep...  294       Output( I ) := Character'Val( V1 xor V2 );
eucrypt_ch10_oaep...  295     end loop;
eucrypt_ch10_oaep...  296   end XOR_Strings;
eucrypt_ch10_oaep...  297 
eucrypt_ch10_oaep...  298 
eucrypt_ch10_oaep...  299 end SMG_OAEP;