package body Keccak_C is -- helper functions 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; 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; -- C interface procedure C_Get_Size(Size: out Interfaces.C.size_t) is begin Size := C_Context'Size / 8; end C_Get_Size; function C_Begin return C_Context_Access is Result : C_Context_Access; begin Result := new C_Context; KeccakBegin(Result.all); return Result; end C_Begin; procedure C_Hash(Ctx: in C_Context_Access; Input: Interfaces.C.Char_Array; Len: Interfaces.C.Size_T) is L: Natural := Natural(Len); S: String(1..L); B: Bitstream(1..S'Length*8); begin Interfaces.C.To_Ada(Input, S, L, Trim_Nul => False); ToBitstream(S, B); KeccakHash(Ctx.all, B); end C_Hash; procedure C_End(Ctx: C_Context_Access; Output: out Interfaces.C.Char_Array; Len: Interfaces.C.Size_T) is L: Natural := Natural(Len); S: String(1..L); B: Bitstream(1..S'Length*8); Count: Interfaces.C.Size_T; begin KeccakEnd(Ctx.all, B); ToString(B, S); Interfaces.C.To_C(S, Output(0..Len), Count, Append_Nul => False); -- Len = Count end C_End; procedure C_Context_Deallocate is new Ada.Unchecked_Deallocation (C_Context, C_Context_Access); procedure C_Deallocate(Ctx: in out C_Context_Access) is begin C_Context_Deallocate(Ctx); end C_Deallocate; end Keccak_C;