mirror of https://github.com/Componolit/jwx
268 lines
9.2 KiB
Ada
268 lines
9.2 KiB
Ada
--
|
|
-- @summary BASE64 decoding (RFC4648)
|
|
-- @author Alexander Senier
|
|
-- @date 2018-05-12
|
|
--
|
|
-- Copyright (C) 2018 Componolit GmbH
|
|
--
|
|
-- This file is part of JWX, which is distributed under the terms of the
|
|
-- GNU Affero General Public License version 3.
|
|
--
|
|
|
|
package body JWX.Base64
|
|
with SPARK_Mode
|
|
is
|
|
|
|
function Alpha_To_Value_Default (Alpha : Character) return Natural is
|
|
(case Alpha is
|
|
when 'A' => 0, when 'B' => 1, when 'C' => 2, when 'D' => 3,
|
|
when 'E' => 4, when 'F' => 5, when 'G' => 6, when 'H' => 7,
|
|
when 'I' => 8, when 'J' => 9, when 'K' => 10, when 'L' => 11,
|
|
when 'M' => 12, when 'N' => 13, when 'O' => 14, when 'P' => 15,
|
|
when 'Q' => 16, when 'R' => 17, when 'S' => 18, when 'T' => 19,
|
|
when 'U' => 20, when 'V' => 21, when 'W' => 22, when 'X' => 23,
|
|
when 'Y' => 24, when 'Z' => 25, when 'a' => 26, when 'b' => 27,
|
|
when 'c' => 28, when 'd' => 29, when 'e' => 30, when 'f' => 31,
|
|
when 'g' => 32, when 'h' => 33, when 'i' => 34, when 'j' => 35,
|
|
when 'k' => 36, when 'l' => 37, when 'm' => 38, when 'n' => 39,
|
|
when 'o' => 40, when 'p' => 41, when 'q' => 42, when 'r' => 43,
|
|
when 's' => 44, when 't' => 45, when 'u' => 46, when 'v' => 47,
|
|
when 'w' => 48, when 'x' => 49, when 'y' => 50, when 'z' => 51,
|
|
when '0' => 52, when '1' => 53, when '2' => 54, when '3' => 55,
|
|
when '4' => 56, when '5' => 57, when '6' => 58, when '7' => 59,
|
|
when '8' => 60, when '9' => 61, when '+' => 62, when '/' => 63,
|
|
when others => Natural'Last);
|
|
|
|
function Is_Valid_Default (Alpha : Character) return Boolean is
|
|
(Alpha_To_Value_Default (Alpha) <= 63);
|
|
|
|
function Alpha_To_Value_Url (Alpha : Character) return Natural is
|
|
(case Alpha is
|
|
when 'A' => 0, when 'B' => 1, when 'C' => 2, when 'D' => 3,
|
|
when 'E' => 4, when 'F' => 5, when 'G' => 6, when 'H' => 7,
|
|
when 'I' => 8, when 'J' => 9, when 'K' => 10, when 'L' => 11,
|
|
when 'M' => 12, when 'N' => 13, when 'O' => 14, when 'P' => 15,
|
|
when 'Q' => 16, when 'R' => 17, when 'S' => 18, when 'T' => 19,
|
|
when 'U' => 20, when 'V' => 21, when 'W' => 22, when 'X' => 23,
|
|
when 'Y' => 24, when 'Z' => 25, when 'a' => 26, when 'b' => 27,
|
|
when 'c' => 28, when 'd' => 29, when 'e' => 30, when 'f' => 31,
|
|
when 'g' => 32, when 'h' => 33, when 'i' => 34, when 'j' => 35,
|
|
when 'k' => 36, when 'l' => 37, when 'm' => 38, when 'n' => 39,
|
|
when 'o' => 40, when 'p' => 41, when 'q' => 42, when 'r' => 43,
|
|
when 's' => 44, when 't' => 45, when 'u' => 46, when 'v' => 47,
|
|
when 'w' => 48, when 'x' => 49, when 'y' => 50, when 'z' => 51,
|
|
when '0' => 52, when '1' => 53, when '2' => 54, when '3' => 55,
|
|
when '4' => 56, when '5' => 57, when '6' => 58, when '7' => 59,
|
|
when '8' => 60, when '9' => 61, when '-' => 62, when '_' => 63,
|
|
when others => Natural'Last);
|
|
|
|
function Is_Valid_Url (Alpha : Character) return Boolean is
|
|
(Alpha_To_Value_Url (Alpha) <= 63);
|
|
|
|
type UInt6_Block is array (Natural range 1 .. 4) of UInt6
|
|
with Pack, Size => 24;
|
|
|
|
subtype Byte_Array_Block is JWX.Byte_Array (1 .. 3);
|
|
|
|
---------------
|
|
-- Mask_Mult --
|
|
---------------
|
|
|
|
function Mask_Mult (Data : UInt6;
|
|
Mask : Byte;
|
|
Mult : Byte) return Byte;
|
|
-- Multiply and mask
|
|
|
|
function Mask_Mult (Data : UInt6;
|
|
Mask : Byte;
|
|
Mult : Byte) return Byte
|
|
is
|
|
begin
|
|
return (Byte (Data) and Mask) * Mult;
|
|
end Mask_Mult;
|
|
|
|
--------------
|
|
-- Mask_Div --
|
|
--------------
|
|
|
|
function Mask_Div (Data : UInt6;
|
|
Mask : Byte;
|
|
Div : Byte) return Byte
|
|
with
|
|
Pre => Div > 0;
|
|
-- Multiply and divide
|
|
|
|
function Mask_Div (Data : UInt6;
|
|
Mask : Byte;
|
|
Div : Byte) return Byte
|
|
is
|
|
begin
|
|
return (Byte (Data) and Mask) / Div;
|
|
end Mask_Div;
|
|
|
|
--------------------
|
|
-- UInt6_To_Bytes --
|
|
--------------------
|
|
|
|
function UInt6_To_Bytes (Data : UInt6_Block) return Byte_Array_Block;
|
|
-- Convert a block of 4 six byte numbers into a block of 3 eight byte
|
|
-- numbers
|
|
|
|
function UInt6_To_Bytes (Data : UInt6_Block) return Byte_Array_Block
|
|
is
|
|
begin
|
|
return
|
|
(1 => Mask_Mult (Data (1), 16#3f#, 4) or Mask_Div (Data (2), 16#30#, 16),
|
|
2 => Mask_Mult (Data (2), 16#0f#, 16) or Mask_Div (Data (3), 16#3C#, 4),
|
|
3 => Mask_Mult (Data (3), 16#03#, 64) or Mask_Div (Data (4), 16#ff#, 1));
|
|
end UInt6_To_Bytes;
|
|
|
|
----------------
|
|
-- Decode_Gen --
|
|
----------------
|
|
|
|
generic
|
|
with function Alpha_To_Value (Alpha : Character) return Natural;
|
|
with function Is_Valid (Alpha : Character) return Boolean;
|
|
procedure Decode_Gen
|
|
(Encoded : String;
|
|
Len : out Natural;
|
|
Result : out JWX.Byte_Array)
|
|
with
|
|
Pre =>
|
|
((Encoded'Length > 0
|
|
and Encoded'Length < Natural'Last / 9
|
|
and Encoded'Last < Natural'Last - 4
|
|
and Result'Length >= 3 * ((Encoded'Length + 3) / 4)))
|
|
and then Result'First < Natural'Last - 9 * Encoded'Length / 12 - 3,
|
|
Post => Len <= Result'Length;
|
|
|
|
procedure Decode_Gen
|
|
(Encoded : String;
|
|
Len : out Natural;
|
|
Result : out JWX.Byte_Array)
|
|
is
|
|
B0, B1, B2, B3 : UInt6;
|
|
B0_Pos, B1_Pos, B2_Pos, B3_Pos : Natural;
|
|
|
|
Last_Input_Block_Offset : constant Integer := (Encoded'Length + 3) / 4 - 1;
|
|
Last_Output_Block_Start : constant Integer := Result'First + (3 * Last_Input_Block_Offset);
|
|
Num_Last_Block_Bytes : constant Integer := (Encoded'Length - 1) mod 4 + 1;
|
|
Num_Last_Block_Out_Bytes : Integer;
|
|
Last_Block : Byte_Array_Block;
|
|
begin
|
|
Len := 0;
|
|
Result := (others => 0);
|
|
|
|
-- Loop over all but the last block
|
|
for I in Integer range 0 .. Last_Input_Block_Offset - 1
|
|
loop
|
|
if not Is_Valid (Encoded (Encoded'First + 4 * I + 0)) or
|
|
not Is_Valid (Encoded (Encoded'First + 4 * I + 1)) or
|
|
not Is_Valid (Encoded (Encoded'First + 4 * I + 2)) or
|
|
not Is_Valid (Encoded (Encoded'First + 4 * I + 3))
|
|
then
|
|
return;
|
|
end if;
|
|
|
|
B0 := UInt6 (Alpha_To_Value (Encoded (Encoded'First + 4 * I + 0)));
|
|
B1 := UInt6 (Alpha_To_Value (Encoded (Encoded'First + 4 * I + 1)));
|
|
B2 := UInt6 (Alpha_To_Value (Encoded (Encoded'First + 4 * I + 2)));
|
|
B3 := UInt6 (Alpha_To_Value (Encoded (Encoded'First + 4 * I + 3)));
|
|
|
|
Result (Result'First + 3 * I .. Result'First + 3 * I + 2) :=
|
|
UInt6_To_Bytes ((B0, B1, B2, B3));
|
|
end loop;
|
|
|
|
if Num_Last_Block_Bytes < 2
|
|
then
|
|
return;
|
|
end if;
|
|
|
|
pragma Assert (Num_Last_Block_Bytes < 5);
|
|
pragma Assert (Encoded'Last < Natural'Last - 4);
|
|
|
|
B0_Pos := Encoded'Last - Num_Last_Block_Bytes + 1;
|
|
B1_Pos := Encoded'Last - Num_Last_Block_Bytes + 2;
|
|
B2_Pos := Encoded'Last - Num_Last_Block_Bytes + 3;
|
|
B3_Pos := Encoded'Last - Num_Last_Block_Bytes + 4;
|
|
|
|
pragma Assert (B1_Pos in Encoded'Range);
|
|
|
|
if not Is_Valid (Encoded (B0_Pos)) or
|
|
not Is_Valid (Encoded (B1_Pos))
|
|
then
|
|
return;
|
|
end if;
|
|
|
|
Num_Last_Block_Out_Bytes := 1;
|
|
B0 := UInt6 (Alpha_To_Value (Encoded (B0_Pos)));
|
|
B1 := UInt6 (Alpha_To_Value (Encoded (B1_Pos)));
|
|
B2 := 0;
|
|
B3 := 0;
|
|
|
|
if Num_Last_Block_Bytes > 2
|
|
then
|
|
if Is_Valid (Encoded (B2_Pos))
|
|
then
|
|
Num_Last_Block_Out_Bytes := 2;
|
|
B2 := UInt6 (Alpha_To_Value ((Encoded (B2_Pos))));
|
|
elsif Encoded (B2_Pos) /= '='
|
|
then
|
|
return;
|
|
end if;
|
|
end if;
|
|
|
|
if Num_Last_Block_Bytes > 3
|
|
then
|
|
if Is_Valid (Encoded (B3_Pos))
|
|
then
|
|
Num_Last_Block_Out_Bytes := 3;
|
|
B3 := UInt6 (Alpha_To_Value ((Encoded (B3_Pos))));
|
|
elsif Encoded (B3_Pos) /= '='
|
|
then
|
|
return;
|
|
end if;
|
|
end if;
|
|
|
|
Last_Block := UInt6_To_Bytes ((B0, B1, B2, B3));
|
|
|
|
-- Padding bits shall be 0
|
|
if Num_Last_Block_Out_Bytes < 3 and Last_Block (3) /= 0 then
|
|
return;
|
|
end if;
|
|
|
|
-- Padding bits shall be 0
|
|
if Num_Last_Block_Out_Bytes < 2 and Last_Block (2) /= 0 then
|
|
return;
|
|
end if;
|
|
|
|
Result (Last_Output_Block_Start .. Last_Output_Block_Start + (Num_Last_Block_Out_Bytes - 1)) :=
|
|
Last_Block (1 .. Num_Last_Block_Out_Bytes);
|
|
Len := (3 * Last_Input_Block_Offset) + Num_Last_Block_Out_Bytes;
|
|
end Decode_Gen;
|
|
|
|
------------
|
|
-- Decode --
|
|
------------
|
|
|
|
procedure Decode_Default_Inst is new Decode_Gen (Alpha_To_Value_Default, Is_Valid_Default);
|
|
|
|
procedure Decode
|
|
(Encoded : String;
|
|
Len : out Natural;
|
|
Result : out JWX.Byte_Array) renames Decode_Default_Inst;
|
|
|
|
----------------
|
|
-- Decode_Url --
|
|
----------------
|
|
|
|
procedure Decode_Url_Inst is new Decode_Gen (Alpha_To_Value_Url, Is_Valid_Url);
|
|
|
|
procedure Decode_Url
|
|
(Encoded : String;
|
|
Len : out Natural;
|
|
Result : out JWX.Byte_Array) renames Decode_Url_Inst;
|
|
|
|
end JWX.Base64;
|