-- S.MG, 2018 package body SMG_OAEP is -- This copies first Len characters from A to the first Len positions in S -- NB: this does NOT allocate /check memory! -- Caller has to ensure that: -- S has space for at least Len characters -- A has at least Len characters procedure Char_Array_To_String( A : in Interfaces.C.char_array; Len : in Natural; S : out String) is begin for Index in 0 .. Len - 1 loop S( S'First + Index ) := Character( A( Interfaces.C.size_t( Index ))); end loop; end Char_Array_To_String; -- This copies first Len characters from S to the first Len positions in A -- NB: there are NO checks or memory allocations here! -- Caller has to make sure that: -- S'Length >= Len -- A has allocated space for at least Len characters procedure String_To_Char_Array( S : in String; Len : in Natural; A : out Interfaces.C.char_array) is C : Character; begin for Index in 0 .. Len - 1 loop C := S( S'First + Index ); A( Interfaces.C.size_t( Index )) := Interfaces.C.Char( C ); end loop; end String_To_Char_Array; procedure HashKeccak( Input : in String; Output : out String; Block_Len : in Keccak_Rate := Default_Bitrate) is BIn : Bitstream( 0 .. Input'Length * 8 - 1 ); BOut : Bitstream( 0 .. Output'Length * 8 - 1 ); begin ToBitstream( Input, BIn); Sponge( BIn, BOut, Block_Len); ToString( BOut, Output ); end HashKeccak; procedure Hash( Input : in Interfaces.C.Char_Array; LenIn : in Interfaces.C.size_t; LenOut : in Interfaces.C.size_t; Output : out Interfaces.C.Char_Array) is AdaLenIn : Natural := Natural( LenIn ); AdaLenOut : Natural := Natural( LenOut ); InStr : String( 1 .. AdaLenIn ) := (others => '0'); OutStr : String( 1 .. AdaLenOut ) := (others => '0'); Block_Len : Keccak_Rate := Default_Bitrate; begin -- Interfaces.C.To_Ada( Input, InStr, AdaLenIn ); Char_Array_To_String( Input, AdaLenIn, InStr ); HashKeccak( InStr, OutStr, Block_Len ); String_To_Char_Array( OutStr, AdaLenOut, Output ); -- Interfaces.C.To_C( OutStr, COut, CCount ); end Hash; -- conversion between types procedure ToString(B: in Bitstream; S: out String ) is N : Natural; Pos : Natural; begin Pos := B'First; for I in S'Range loop N := Natural( B( Pos ) ) + Natural( B( Pos + 1 ) ) * 2 + Natural( B( Pos + 2 ) ) * 4 + Natural( B( Pos + 3 ) ) * 8 + Natural( B( Pos + 4 ) ) * 16 + Natural( B( Pos + 5 ) ) * 32 + Natural( B( Pos + 6 ) ) * 64 + Natural( B( Pos + 7 ) ) * 128; Pos := Pos + 8; S( I ) := Character'Val( N ); end loop; end ToString; procedure ToBitstream(S: in String; B: out Bitstream ) is V : Unsigned_8; Pos : Natural; begin Pos := B'First; for C of S loop V := Character'Pos( C ); B( Pos ) := Bit( V and 1 ); B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 ); B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 ); B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 ); B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 ); B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 ); B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 ); B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 ); Pos := Pos + 8; end loop; end ToBitstream; -- padding & formatting of maximum 1960 bits of the given String -- uses TMSR's OAEP schema: -- 1.format M00 as: [random octet][sz1][sz2]"TMSR-RSA"[random]*Message -- where sz1 and sz2 store the length of the message in bits -- the random octets before message are padding to make OAEP_LENGTH_OCTETS -- 2. R = OAEP_HALF_OCTETS random bits -- 3. X = M00 xor hash(R) -- 4. Y = R xor hash(X) -- 5. Result is X || Y -- NB: the Entropy parameter should be random octets from which this method -- will use as many as required for the OAEP encryption of given Msg -- NB: at MOST MAX_LEN_MSG octets of Msg! (Msg at most 1960 bits) procedure OAEP_Encrypt( Msg : in String; Entropy : in OAEP_Block; Output : out OAEP_Block) is M00 : OAEP_HALF; R : OAEP_HALF; HashR : OAEP_HALF; X : OAEP_HALF; HashX : OAEP_HALF; Y : OAEP_HALF; MsgLen : Natural; PadLen : Natural; begin -- calculate maximum length of msg and needed amount of padding -- make sure also that only MAX_LEN_MSG octets at most are used from Msg MsgLen := Msg'Length; -- real msg length if MsgLen > MAX_LEN_MSG then MsgLen := MAX_LEN_MSG; --only first MAX_LEN_MSG octets are considered PadLen := 0; --no padding needed else PadLen := MAX_LEN_MSG - MsgLen; -- msg may be too short, add padding end if; -- step 1: header and format to obtain M00 -- first octet is random bits M00( M00'First ) := Entropy( Entropy'First ); -- next 2 octets hold the used length of Msg (number of octets) M00( M00'First + 2) := Character'Val( ( MsgLen * 8 ) mod 255 ); M00( M00'First + 1) := Character'Val( ( (MsgLen * 8 ) / 255 ) mod 255 ); -- next 8 octets are reserved for later use, currently "TMSR-RSA" M00( M00'First + 3 .. M00'First + 10 ) := TMSR; -- random bits for padding, if Msg is less than 245 octets for I in 1 .. PadLen loop M00( M00'First + 10 + I ) := Entropy( Entropy'First + I ); end loop; -- the message itself M00( M00'Last - MsgLen + 1 .. M00'Last ) := Msg( Msg'First .. Msg'First + MsgLen - 1 ); -- step 2: R = OAEP_HALF_OCTETS random octets -- can take LAST octets from given entropy as they are NOT used before -- (even if original message was empty, padding uses at most half - 10 -- while entropy has full block length) R := Entropy( Entropy'Last - OAEP_HALF_OCTETS + 1 .. Entropy'Last ); -- step 3: X = M00 xor hash(R) HashKeccak( R, HashR ); XOR_Strings( M00, HashR, X ); -- step 4: Y = R xor hash(X) HashKeccak( X, HashX ); XOR_Strings( R, HashX, Y ); -- step 5: Output is X || Y Output( Output'First .. Output'First + X'Length - 1 ) := X; Output( Output'Last - Y'Length + 1 .. Output'Last ) := Y; end OAEP_Encrypt; procedure OAEP_Encrypt_C( Msg : in Interfaces.C.char_array; MsgLen : in Interfaces.C.size_t; Entropy : in Interfaces.C.char_array; EntLen : in Interfaces.C.size_t; Encr : out Interfaces.C.char_array; EncrLen : in Interfaces.C.size_t; Success : out Interfaces.C.Int) is AdaMsgLen : Natural := Natural( MsgLen ); AdaEntLen : Natural := Natural( EntLen ); AdaEncrLen : Natural := Natural( EncrLen ); AdaMsg : String( 1 .. AdaMsgLen ); AdaEntBlock: OAEP_Block; AdaResult : OAEP_Block := ( others => '0' ); begin Success := 0; -- check there is enough entropy and enoug output space, fail otherwise if AdaEntLen /= AdaEntBlock'Length or AdaEncrLen < AdaResult'Length then return; end if; -- translate to Ada --Interfaces.C.To_Ada( Msg, AdaMsg, AdaMsgLen ); Char_Array_To_String( Msg, AdaMsgLen, AdaMsg ); --Interfaces.C.To_Ada( Entropy, AdaEntropy, AdaEntLen ); Char_Array_To_String( Entropy, AdaEntLen, AdaEntBlock ); -- call the actual oaep encrypt OAEP_Encrypt( AdaMsg, AdaEntBlock, AdaResult ); -- translate back to C, set success flag and return --Interfaces.C.To_C( AdaResult, CEncr, CEncrLen, False ); -- EncrLen has already been tested to be at least AdaResult'Length String_To_Char_Array( AdaResult, AdaEncrLen, Encr ); Success := 1; end OAEP_Encrypt_C; procedure oaep_decrypt_c( Encr : in Interfaces.C.Char_Array; EncrLen : in Interfaces.C.Int; Decr : out Interfaces.C.Char_Array; DecrLen : in out Interfaces.C.Int; Success : out Interfaces.C.Int) is AdaDecr : OAEP_HALF := ( others => '0' ); AdaEncr : OAEP_Block:= ( others => '0' ); AdaEncrLen : Natural := Natural( EncrLen ); AdaDecrLen : Natural := 0; AdaFlag : Boolean; begin -- check and set success flag/exit if needed Success := 0; if EncrLen /= OAEP_Block'Length then return; end if; -- translate to Ada: copy octet by octet as C.To_Ada is problematic -- Interfaces.C.To_Ada( Encr, AdaEncr, AdaEncrLen, False ); Char_Array_To_String( Encr, AdaEncrLen, AdaEncr ); -- actual decrypt OAEP_Decrypt( AdaEncr, AdaDecrLen, AdaDecr, AdaFlag ); -- translate back to C AdaDecrLen := AdaDecrLen / 8; -- from bits to octets if AdaFlag and Natural( DecrLen ) >= AdaDecrLen and AdaDecr'Length >= AdaDecrLen then Success := 1; DecrLen := Interfaces.C.Int( AdaDecrLen ); -- Interfaces.C.To_C( AdaDecr, Decr, AdaDecrLen ); String_To_Char_Array( AdaDecr, AdaDecrLen, Decr ); end if; end oaep_decrypt_c; procedure OAEP_Decrypt( Encr : in OAEP_Block; Len : out Natural; Output : out OAEP_HALF; Success : out Boolean ) is X, Y, M, R : OAEP_HALF; HashX, HashR : OAEP_HALF; LenOctets : Natural; begin -- step 1: separate X and Y X := Encr( Encr'First .. Encr'First + X'Length - 1 ); Y := Encr( Encr'Last - Y'Length + 1 .. Encr'Last ); -- step 2: R = Y xor hash(X) HashKeccak( X, HashX ); XOR_Strings( Y, HashX, R ); -- step 3: M = X xor hash(R) HashKeccak( R, HashR ); XOR_Strings( X, HashR, M ); -- step 4: extract length and message Len := Character'Pos( M( M'First + 1 ) ) * 255 + Character'Pos( M( M'First + 2 ) ); LenOctets := Len / 8; if LenOctets > MAX_LEN_MSG or LenOctets < 0 then Success := False; -- error, failed to retrieve message else Success := True; Output( Output'First .. Output'First + LenOctets - 1 ) := M( M'Last - LenOctets + 1 .. M'Last ); end if; end OAEP_Decrypt; -- helper method, xor on strings -- NB: only Output'Length bits will be considered from S1 and S2 -- NB: caller is responsible for S1 and S2 being long enough! procedure XOR_Strings( S1: in String; S2: in String; Output: out String ) is V1, V2: Unsigned_8; begin for I in Output'Range loop V1 := Character'Pos( S1( I ) ); V2 := Character'Pos( S2( I ) ); Output( I ) := Character'Val( V1 xor V2 ); end loop; end XOR_Strings; end SMG_OAEP;