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_ch16_byte...   38                         Block_Len : in Keccak_Rate := Default_Byterate) is
eucrypt_ch16_byte...   39     BIn  : Bytestream( 0 .. Input'Length - 1 );
eucrypt_ch16_byte...   40     BOut : Bytestream( 0 .. Output'Length - 1 ); 
eucrypt_ch10_oaep...   41   begin
eucrypt_ch16_byte...   42     ToBytestream( 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_ch16_byte...   55     Block_Len : Keccak_Rate := Default_Byterate;
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_ch16_byte...   65   procedure ToString(B: in Bytestream; S: out String ) is
eucrypt_ch10_oaep...   66   begin
eucrypt_ch16_byte...   67     for I in 0..B'Length-1 loop
eucrypt_ch16_byte...   68       S(S'First + I) := Character'Val(B(B'First+I));
eucrypt_ch10_oaep...   69     end loop;
eucrypt_ch10_oaep...   70   end ToString;
eucrypt_ch10_oaep...   71 
eucrypt_ch16_byte...   72   procedure ToBytestream(S: in String; B: out Bytestream ) is
eucrypt_ch10_oaep...   73     V   : Unsigned_8;
eucrypt_ch10_oaep...   74     Pos : Natural;
eucrypt_ch10_oaep...   75   begin
eucrypt_ch16_byte...   76     for I in 0..S'Length -1 loop
eucrypt_ch16_byte...   77       B(B'First+I) := Character'Pos( S(S'First + I) );
eucrypt_ch10_oaep...   78     end loop;
eucrypt_ch16_byte...   79   end ToBytestream;
eucrypt_ch10_oaep...   80 
eucrypt_ch10_oaep...   81   -- padding & formatting of maximum 1960 bits of the given String 
eucrypt_ch10_oaep...   82   -- uses TMSR's OAEP schema:
eucrypt_ch10_oaep...   83   -- 1.format M00 as: [random octet][sz1][sz2]"TMSR-RSA"[random]*Message
eucrypt_ch10_oaep...   84   --    where sz1 and sz2 store the length of the message in bits
eucrypt_ch10_oaep...   85   --    the random octets before message are padding to make OAEP_LENGTH_OCTETS
eucrypt_ch10_oaep...   86   -- 2. R = OAEP_HALF_OCTETS random bits
eucrypt_ch10_oaep...   87   -- 3. X = M00 xor hash(R)
eucrypt_ch10_oaep...   88   -- 4. Y = R xor hash(X)
eucrypt_ch10_oaep...   89   -- 5. Result is X || Y 
eucrypt_ch10_oaep...   90   -- NB: the Entropy parameter should be random octets from which this method 
eucrypt_ch10_oaep...   91   -- will use as many as required for the OAEP encryption of given Msg
eucrypt_oaep_fix_...   92   -- NB: at MOST MAX_LEN_MSG octets of Msg! (Msg at most 1960 bits)
eucrypt_ch10_oaep...   93   procedure OAEP_Encrypt( Msg     : in String;
eucrypt_ch10_oaep...   94                           Entropy : in OAEP_Block;
eucrypt_ch10_oaep...   95                           Output  : out OAEP_Block) is
eucrypt_ch10_oaep...   96     M00    : OAEP_HALF;
eucrypt_ch10_oaep...   97     R      : OAEP_HALF;
eucrypt_ch10_oaep...   98     HashR  : OAEP_HALF;
eucrypt_ch10_oaep...   99     X      : OAEP_HALF;
eucrypt_ch10_oaep...  100     HashX  : OAEP_HALF;
eucrypt_ch10_oaep...  101     Y      : OAEP_HALF;
eucrypt_ch10_oaep...  102     MsgLen : Natural;
eucrypt_ch10_oaep...  103     PadLen : Natural;
eucrypt_ch10_oaep...  104   begin
eucrypt_ch10_oaep...  105     -- calculate maximum length of msg and needed amount of padding
eucrypt_oaep_fix_...  106     -- make sure also that only MAX_LEN_MSG octets at most are used from Msg
eucrypt_ch10_oaep...  107     MsgLen := Msg'Length;                          -- real msg length
eucrypt_oaep_fix_...  108     if MsgLen > MAX_LEN_MSG then
eucrypt_oaep_fix_...  109       MsgLen := MAX_LEN_MSG;  --only first MAX_LEN_MSG octets are considered
eucrypt_oaep_fix_...  110       PadLen := 0;            --no padding needed
eucrypt_ch10_oaep...  111     else
eucrypt_oaep_fix_...  112       PadLen := MAX_LEN_MSG - MsgLen; -- msg may be too short, add padding
eucrypt_ch10_oaep...  113     end if;
eucrypt_ch10_oaep...  114 
eucrypt_ch10_oaep...  115     -- step 1: header and format to obtain M00
eucrypt_ch10_oaep...  116       -- first octet is random bits
eucrypt_ch10_oaep...  117     M00( M00'First ) := Entropy( Entropy'First );
eucrypt_ch10_oaep...  118 
eucrypt_ch10_oaep...  119       -- next 2 octets hold the used length of Msg (number of octets)
eucrypt_fix_256       120     M00( M00'First + 2) := Character'Val( ( MsgLen * 8 ) mod 256 );
eucrypt_fix_256       121     M00( M00'First + 1) := Character'Val( ( (MsgLen * 8 ) / 256 ) mod 256 );
eucrypt_ch10_oaep...  122 
eucrypt_ch10_oaep...  123       -- next 8 octets are reserved for later use, currently "TMSR-RSA"
eucrypt_ch10_oaep...  124     M00( M00'First + 3 .. M00'First + 10 ) := TMSR;
eucrypt_ch10_oaep...  125 
eucrypt_ch10_oaep...  126       -- random bits for padding, if Msg is less than 245 octets
eucrypt_ch10_oaep...  127     for I in 1 .. PadLen loop
eucrypt_ch10_oaep...  128       M00( M00'First + 10 + I ) := Entropy( Entropy'First + I );
eucrypt_ch10_oaep...  129     end loop;
eucrypt_ch10_oaep...  130 
eucrypt_ch10_oaep...  131       -- the message itself
eucrypt_ch10_oaep...  132     M00( M00'Last - MsgLen + 1 .. M00'Last ) := 
eucrypt_ch10_oaep...  133                                Msg( Msg'First .. Msg'First + MsgLen - 1 );
eucrypt_ch10_oaep...  134 
eucrypt_ch10_oaep...  135     -- step 2: R = OAEP_HALF_OCTETS random octets
eucrypt_ch10_oaep...  136     -- can take LAST octets from given entropy as they are NOT used before
eucrypt_ch10_oaep...  137     -- (even if original message was empty, padding uses at most half - 10
eucrypt_ch10_oaep...  138     --   while entropy has full block length)
eucrypt_ch10_oaep...  139     R := Entropy( Entropy'Last - OAEP_HALF_OCTETS + 1 .. Entropy'Last );
eucrypt_ch10_oaep...  140 
eucrypt_ch10_oaep...  141     -- step 3: X = M00 xor hash(R)
eucrypt_ch10_oaep...  142     HashKeccak( R, HashR );
eucrypt_ch10_oaep...  143     XOR_Strings( M00, HashR, X );
eucrypt_ch10_oaep...  144 
eucrypt_ch10_oaep...  145     -- step 4: Y = R xor hash(X)
eucrypt_ch10_oaep...  146     HashKeccak( X, HashX );
eucrypt_ch10_oaep...  147     XOR_Strings( R, HashX, Y );
eucrypt_ch10_oaep...  148 
eucrypt_ch10_oaep...  149     -- step 5: Output is X || Y
eucrypt_ch10_oaep...  150     Output( Output'First .. Output'First + X'Length - 1 ) := X;
eucrypt_ch10_oaep...  151     Output( Output'Last - Y'Length + 1 .. Output'Last )   := Y;
eucrypt_ch10_oaep...  152     
eucrypt_ch10_oaep...  153   end OAEP_Encrypt;
eucrypt_ch10_oaep...  154 
eucrypt_ch12_wrap...  155   procedure OAEP_Encrypt_C( Msg       : in Interfaces.C.char_array;
eucrypt_ch12_wrap...  156                             MsgLen    : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  157                             Entropy   : in Interfaces.C.char_array;
eucrypt_ch12_wrap...  158                             EntLen    : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  159                             Encr      : out Interfaces.C.char_array;
eucrypt_ch12_wrap...  160                             EncrLen   : in Interfaces.C.size_t;
eucrypt_ch12_wrap...  161                             Success   : out Interfaces.C.Int) is
eucrypt_ch12_wrap...  162     AdaMsgLen  : Natural := Natural( MsgLen );
eucrypt_ch12_wrap...  163     AdaEntLen  : Natural := Natural( EntLen );
eucrypt_ch12_wrap...  164     AdaEncrLen : Natural := Natural( EncrLen );
eucrypt_ch12_wrap...  165     AdaMsg     : String( 1 .. AdaMsgLen );
eucrypt_ch12_wrap...  166     AdaEntBlock: OAEP_Block;
eucrypt_ch12_wrap...  167     AdaResult  : OAEP_Block := ( others => '0' );
eucrypt_ch12_wrap...  168   begin
eucrypt_ch12_wrap...  169     Success := 0;
eucrypt_ch12_wrap...  170     -- check there is enough entropy and enoug output space, fail otherwise
eucrypt_ch12_wrap...  171     if AdaEntLen /= AdaEntBlock'Length or AdaEncrLen < AdaResult'Length then
eucrypt_ch12_wrap...  172       return;
eucrypt_ch12_wrap...  173     end if;
eucrypt_ch12_wrap...  174     -- translate to Ada
eucrypt_ch12_wrap...  175       --Interfaces.C.To_Ada( Msg, AdaMsg, AdaMsgLen );
eucrypt_ch12_wrap...  176     Char_Array_To_String( Msg, AdaMsgLen, AdaMsg );
eucrypt_ch12_wrap...  177       --Interfaces.C.To_Ada( Entropy, AdaEntropy, AdaEntLen );
eucrypt_ch12_wrap...  178     Char_Array_To_String( Entropy, AdaEntLen, AdaEntBlock );
eucrypt_ch12_wrap...  179 
eucrypt_ch12_wrap...  180     -- call the actual oaep encrypt
eucrypt_ch12_wrap...  181     OAEP_Encrypt( AdaMsg, AdaEntBlock, AdaResult );
eucrypt_ch12_wrap...  182 
eucrypt_ch12_wrap...  183     -- translate back to C, set success flag and return 
eucrypt_ch12_wrap...  184        --Interfaces.C.To_C( AdaResult, CEncr, CEncrLen, False );
eucrypt_ch12_wrap...  185     -- EncrLen has already been tested to be at least AdaResult'Length
eucrypt_ch12_wrap...  186     String_To_Char_Array( AdaResult, AdaEncrLen, Encr );
eucrypt_ch12_wrap...  187     Success := 1;
eucrypt_ch12_wrap...  188 
eucrypt_ch12_wrap...  189   end OAEP_Encrypt_C;
eucrypt_ch12_wrap...  190 
eucrypt_ch12_wrap...  191   procedure oaep_decrypt_c( Encr    : in Interfaces.C.Char_Array;
eucrypt_ch12_wrap...  192                             EncrLen : in Interfaces.C.Int;
eucrypt_ch12_wrap...  193                             Decr    : out Interfaces.C.Char_Array;
eucrypt_ch12_wrap...  194                             DecrLen : in out Interfaces.C.Int;
eucrypt_ch12_wrap...  195                             Success : out Interfaces.C.Int) is
eucrypt_ch12_wrap...  196     AdaDecr    : OAEP_HALF := ( others => '0' );
eucrypt_ch12_wrap...  197     AdaEncr    : OAEP_Block:= ( others => '0' );
eucrypt_ch12_wrap...  198     AdaEncrLen : Natural := Natural( EncrLen );
eucrypt_ch12_wrap...  199     AdaDecrLen : Natural := 0;
eucrypt_ch12_wrap...  200     AdaFlag    : Boolean;
eucrypt_ch12_wrap...  201   begin
eucrypt_ch12_wrap...  202     -- check and set success flag/exit if needed
eucrypt_ch12_wrap...  203     Success := 0;
eucrypt_ch12_wrap...  204     if EncrLen /= OAEP_Block'Length then
eucrypt_ch12_wrap...  205       return;
eucrypt_ch12_wrap...  206     end if;
eucrypt_ch12_wrap...  207 
eucrypt_ch12_wrap...  208     -- translate to Ada: copy octet by octet as C.To_Ada is problematic
eucrypt_ch12_wrap...  209       -- Interfaces.C.To_Ada( Encr, AdaEncr, AdaEncrLen, False );
eucrypt_ch12_wrap...  210     Char_Array_To_String( Encr, AdaEncrLen, AdaEncr );
eucrypt_ch12_wrap...  211 
eucrypt_ch12_wrap...  212     -- actual decrypt
eucrypt_ch12_wrap...  213     OAEP_Decrypt( AdaEncr, AdaDecrLen, AdaDecr, AdaFlag );
eucrypt_ch12_wrap...  214 
eucrypt_ch12_wrap...  215     -- translate back to C
eucrypt_ch12_wrap...  216     AdaDecrLen := AdaDecrLen / 8;  -- from bits to octets
eucrypt_ch12_wrap...  217     if AdaFlag and 
eucrypt_ch12_wrap...  218        Natural( DecrLen ) >= AdaDecrLen and 
eucrypt_ch12_wrap...  219        AdaDecr'Length >= AdaDecrLen then
eucrypt_ch12_wrap...  220       Success := 1;
eucrypt_ch12_wrap...  221       DecrLen := Interfaces.C.Int( AdaDecrLen );
eucrypt_ch12_wrap...  222         -- Interfaces.C.To_C( AdaDecr, Decr, AdaDecrLen );
eucrypt_ch12_wrap...  223       String_To_Char_Array( AdaDecr, AdaDecrLen, Decr );
eucrypt_ch12_wrap...  224     end if;
eucrypt_ch12_wrap...  225   end oaep_decrypt_c;
eucrypt_ch12_wrap...  226 
eucrypt_ch10_oaep...  227   procedure OAEP_Decrypt( Encr    : in OAEP_Block;
eucrypt_ch10_oaep...  228                           Len     : out Natural;
eucrypt_ch10_oaep...  229                           Output  : out OAEP_HALF;
eucrypt_ch10_oaep...  230                           Success : out Boolean ) is
eucrypt_ch10_oaep...  231     X, Y, M, R   : OAEP_HALF;
eucrypt_ch10_oaep...  232     HashX, HashR : OAEP_HALF;
eucrypt_ch10_oaep...  233     LenOctets    : Natural;
eucrypt_ch10_oaep...  234   begin
eucrypt_ch10_oaep...  235     -- step 1: separate X and Y
eucrypt_ch10_oaep...  236     X := Encr( Encr'First .. Encr'First + X'Length - 1 );
eucrypt_ch10_oaep...  237     Y := Encr( Encr'Last - Y'Length + 1 .. Encr'Last );
eucrypt_ch10_oaep...  238 
eucrypt_ch10_oaep...  239     -- step 2: R = Y xor hash(X)
eucrypt_ch10_oaep...  240     HashKeccak( X, HashX );
eucrypt_ch10_oaep...  241     XOR_Strings( Y, HashX, R );
eucrypt_ch10_oaep...  242 
eucrypt_ch10_oaep...  243     -- step 3: M = X xor hash(R)
eucrypt_ch10_oaep...  244     HashKeccak( R, HashR );
eucrypt_ch10_oaep...  245     XOR_Strings( X, HashR, M );
eucrypt_ch10_oaep...  246 
eucrypt_ch10_oaep...  247     -- step 4: extract length and message
eucrypt_fix_256       248     Len := Character'Pos( M( M'First + 1 ) ) * 256 +
eucrypt_ch10_oaep...  249            Character'Pos( M( M'First + 2 ) );
eucrypt_ch10_oaep...  250     LenOctets := Len / 8; 
eucrypt_ch10_oaep...  251 
eucrypt_oaep_fix_...  252     if LenOctets > MAX_LEN_MSG or LenOctets < 0 then
eucrypt_ch10_oaep...  253       Success := False;  -- error, failed to retrieve message
eucrypt_ch10_oaep...  254     else
eucrypt_ch10_oaep...  255       Success := True;
eucrypt_ch10_oaep...  256       Output( Output'First .. Output'First + LenOctets - 1 ) := 
eucrypt_ch10_oaep...  257         M( M'Last - LenOctets + 1 .. M'Last );
eucrypt_ch10_oaep...  258     end if;
eucrypt_ch10_oaep...  259 
eucrypt_ch10_oaep...  260   end OAEP_Decrypt;
eucrypt_ch10_oaep...  261 
eucrypt_ch10_oaep...  262   -- helper method, xor on strings
eucrypt_ch10_oaep...  263   -- NB: only Output'Length bits will be considered from S1 and S2
eucrypt_ch10_oaep...  264   -- NB: caller is responsible for S1 and S2 being long enough!
eucrypt_ch10_oaep...  265   procedure XOR_Strings( S1: in String; S2: in String; Output: out String ) is
eucrypt_ch10_oaep...  266     V1, V2: Unsigned_8;
eucrypt_ch10_oaep...  267   begin
eucrypt_ch10_oaep...  268     for I in Output'Range loop
eucrypt_ch10_oaep...  269       V1 := Character'Pos( S1( I ) );
eucrypt_ch10_oaep...  270       V2 := Character'Pos( S2( I ) );
eucrypt_ch10_oaep...  271       Output( I ) := Character'Val( V1 xor V2 );
eucrypt_ch10_oaep...  272     end loop;
eucrypt_ch10_oaep...  273   end XOR_Strings;
eucrypt_ch10_oaep...  274 
eucrypt_ch10_oaep...  275 
eucrypt_ch10_oaep...  276 end SMG_OAEP;