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;