-- SHA1 - Provide an idealized interface to the US Secure Hash Algorithm 1 function.
-- Copyright (C) 2019 Prince Trippy programmer@verisimilitudes.net .
-- This program is free software: you can redistribute it and/or modify it under the terms of the
-- GNU Affero General Public License version 3 as published by the Free Software Foundation.
-- This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- See the GNU Affero General Public License for more details.
-- You should have received a copy of the GNU Affero General Public License along with this program.
-- If not, see <http://www.gnu.org/licenses/>.
with Interfaces; -- I can always trivially define this rotation function myself were I ever needing.
package body SHA1 is
function Rotate (Value : Word; Amount : Natural) return Word is
begin
return Word(Interfaces.Rotate_Left(Interfaces.Unsigned_32(Value), Amount));
end Rotate;
function K (T : Cycle) return Word is
begin -- Perhaps I'll just make this an array; would it be as size efficient though, I do wonder.
case T is
when 0 .. 19 => return 16#5A827999#;
when 20 .. 39 => return 16#6ED9EBA1#;
when 40 .. 59 => return 16#8F1BBCDC#;
when 60 .. 79 => return 16#CA62C1D6#;
end case;
end K;
function F (T : Cycle; B, C, D : Word) return Word is
begin
case T is
when 0 .. 19 => return (B and C) or (D and not B);
when 40 .. 59 => return (B and C) or (B and D) or (C and D);
when 20 .. 39 | 60 .. 79 => return B xor C xor D;
end case;
end F;
procedure Pad (Primary : in out Word_Block;
Auxiliary : out Word_Block;
Bit_Length : in Natural;
Overflow : out Boolean) is
procedure Place (Data : in out Word_Block) is
begin -- I'm paying care here to ensure bit lengths greater than that 2**64 limit are ignored.
Data(15) := Word((Bit_Length / 2**16) / 2**16) and 2**32-1;
Data(16) := Word(Bit_Length) and 2**32-1;
end Place;
procedure Term (Data : in out Word_Block) is
L : Positive := ((Bit_Length / 2**5) mod 16) + 1;
M : Natural := Bit_Length mod 2**5;
begin -- This unnecessarily writes zeroes to the final two words of Primary in some instances.
Data(L) := (Data(L) and ((2**(32-M)-1) xor (2**32-1))) or 2**(31-M);
Data(Positive'Succ(L) .. Data'Last) := (others => 0);
end Term;
begin -- I'd figure this implementation should be improved, but I can do so later, unlike design.
if Bit_Length = 0 then -- This is a rather unfortunate edge case I noticed under a new review.
Overflow := False; Term(Primary); Place(Primary); return; -- Perhaps I could parameterize.
end if; -- There must be sixty-five bits available for that ending bit and the message length.
case Bit_Length mod 512 is -- Why use others when I can quite easily cover all possible cases?
when 0 => Auxiliary := (1 => 2**31, 2 .. 14 => 0, 15 .. 16 => <>);
when 448 .. 511 => Auxiliary := (1 .. 14 => 0, 15 .. 16 => <>); Term(Primary);
when 1 .. 447 => Overflow := False; Term(Primary); Place(Primary); return; -- Usual one.
when others => null; -- This should be entirely unnecessary, so why must I list it now?
end case;
Overflow := True;
Place(Auxiliary);
end Pad;
procedure Hash (State : in out Status; Data : in Word_Block) is
A, B, C, D, E, Temporary : Word;
W : array (Cycle) of Word;
-- W : array (Cycle) of Word := (0 .. 15 => Data(1 .. 16), others => <>);
begin
for I in Cycle range Cycle'First .. 15 loop
W(I) := Data(Positive(I+1));
end loop;
for I in Cycle range 16 .. Cycle'Last loop
W(I) := Rotate(Amount => 1, Value => (W(I-3) xor W(I-8) xor W(I-14) xor W(I-16)));
end loop;
A := State.H0;
B := State.H1;
C := State.H2;
D := State.H3;
E := State.H4;
for I in Cycle'Range loop
Temporary := Rotate(A, 5) + F(I, B, C, D) + E + W(I) + K(I);
E := D; D := C;
C := Rotate(B, 30);
B := A; A := Temporary;
end loop;
State.H0 := State.H0 + A;
State.H1 := State.H1 + B;
State.H2 := State.H2 + C;
State.H3 := State.H3 + D;
State.H4 := State.H4 + E;
end Hash;
function Hash (State : Status; Data : Word_Block) return Status is
S : Status := State;
begin
Hash(S, Data);
return S;
end Hash;
function Hash (Data : Word_Array) return Digest is -- ; Bit_Length:Natural:= Word_Array'Length*32
S : Status := Initial_Status;
B, Two : Word_Block;
Needed : Boolean;
begin
declare
I : Positive := 1;
begin
loop
exit when Data'Length < I + 16; -- Exit when all but the last block have been processed.
B := Data(I .. I + 15);
I := I + 16;
Hash(S, B);
end loop;
if Data'Length mod 16 = 0 then -- Surely I can write that much better once I sleep on this.
B(1 .. 16) := Data(I .. Data'Last);
else
B(1 .. Data'Last mod 16) := Data(I .. Data'Last);
end if;
end;
Pad(Primary => B, Auxiliary => Two, Bit_Length => Data'Length * 32, Overflow => Needed);
Hash(S, B); -- The bit-length for this procedure will always be a multiple of thirty-two.
if Needed then -- Using this two-block approach for padding results in the simplest program.
Hash(S, Two); -- Isn't this a nice little function?
end if;
return To_Digest(S);
end Hash;
function To_Digest (State : Status) return Digest is
begin
return Digest(State);
end To_Digest;
function To_String (Datum : Digest) return String is
S : String (1 .. 40);
O : constant Octet_Array := To_Octets(Datum);
H : constant array (Octet range 0 .. 15) of Character := "0123456789ABCDEF";
begin
for I in O'Range loop
S(I*2-1) := H(O(I) / 16);
S(I*2) := H(O(I) mod 16);
end loop;
return S;
end To_String;
function To_Bits (Datum : Digest) return Bit_Array is
B : Bit_Array (1 .. 160);
W : constant Word_Array := To_Words(Datum);
begin
for I in W'Range loop
for J in 0 .. 31 loop
B(J+1+(32*(I-1))) := Bit((W(I) / 2**(31 - J)) mod 2);
end loop;
end loop;
return B;
end To_Bits;
function To_Octets (Datum : Digest) return Octet_Array is
O : Octet_Array (1 .. 20);
W : constant Word_Array := To_Words(Datum);
begin
for I in W'Range loop
O(I*4-3) := Octet(W(I) / 2**24);
O(I*4-2) := Octet(W(I) / 2**16 mod 256);
O(I*4-1) := Octet(W(I) / 2**8 mod 256);
O(I*4) := Octet(W(I) mod 256);
end loop;
return O;
end To_Octets;
function To_Words (Datum : Digest) return Word_Array is
begin
return (Datum.H0, Datum.H1, Datum.H2, Datum.H3, Datum.H4);
end To_Words;
end SHA1;