* Re: Base64 encoding and decoding (preferably public domain)
2016-08-20 18:23 Base64 encoding and decoding (preferably public domain) john
2016-08-20 19:20 ` Dmitry A. Kazakov
2016-08-21 16:00 ` john
@ 2016-08-22 2:48 ` Shark8
2 siblings, 0 replies; 4+ messages in thread
From: Shark8 @ 2016-08-22 2:48 UTC (permalink / raw)
On Saturday, August 20, 2016 at 12:23:30 PM UTC-6, jo...@peppermind.com wrote:
> Hi!
>
> Does anybody happen to have a source package for Base64 encoding and decoding of in-memory strings?
>
> I'm writing a small package that I intend to release under an MIT license and therefore don't want to use any of the large libraries like Ada.utils or GNATcoll.
Pragma Ada_2012;
Pragma Assertion_Policy( Check );
With
Ada.Containers.Indefinite_Vectors,
Interfaces;
Package Base_64 is
Type Base_64_Character is
( 'A', 'B', 'C', 'D', 'E',
'F', 'G', 'H', 'I', 'J',
'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T',
'U', 'V', 'W', 'X', 'Y',
'Z', 'a', 'b', 'c', 'd',
'e', 'f', 'g', 'h', 'i',
'j', 'k', 'l', 'm', 'n',
'o', 'p', 'q', 'r', 's',
't', 'u', 'v', 'w', 'x',
'y', 'z', '0', '1', '2',
'3', '4', '5', '6', '7',
'8', '9', '+', '/', '='
) with Size => 8, Object_Size => 8;
Subtype Nonpad_Character is Base_64_Character range
Base_64_Character'First..Base_64_Character'Pred(Base_64_Character'Last);
type Base_64_String is Array(Positive range <>) of Base_64_Character
with Dynamic_Predicate =>
-- Base64 Strings always have a length that is a multiple of 4.
(Base_64_String'Length mod 4 = 0 or else raise Constraint_Error with "Illegal Base64 length:" & Natural'Image(Base_64_String'Length))
-- and then
-- -- Only the last two characters can be padding.
-- (for all Index in Base_64_String'First..Base_64_String'Last - 2 =>
-- Base_64_String(Index) in Nonpad_Character --or else raise Constraint_Error with "Malformed Base64 string."
-- )
and then
-- Pad characters must come at the end, if present.
(if Base_64_String'Length > 1 and then Base_64_String(Base_64_String'Last-1) = '=' then
(if Base_64_String(Base_64_String'Last) /= '=' then raise Constraint_Error with "Nonterminal pad character detected."
else True)
);
Function Encode( Data : String ) return Base_64_String;
Function Decode( Data : Base_64_String ) return String;
-- Converts a Base_64_String to a String.
-- NOTE: This does NOT entail decoding.
Function To_String( Data : Base_64_String ) return String;
Type Encoder is private;
Procedure Feed( State : in out Encoder; Data : Interfaces.Integer_8 );
Function Get_Data( State : in Encoder ) return Base_64_String;
Function Reset( State : in out Encoder) return Base_64_String;
Procedure Reset( State : in out Encoder; Data : Base_64_String );
Procedure Reset( State : in out Encoder );
Private
Package Internals is
----------------------
-- INTERNAL TYPES --
----------------------
Type Base_64_Chunk is array(Positive range 1..4) of Base_64_Character;
Type Internal_Count is range 1..3;
Type Internal_Character is new Nonpad_Character
with Size => 6;
Type Quad is record
A, B, C, D : Internal_Character;
end record
with Size => 24, Object_Size => 24, Pack; --, Bit_Order => System.Low_Order_First; --, alignment => 0, Pack,
For Quad use record at mod 8;
D at 0 range 0..5;
C at 0 range 6..11;
B at 0 range 12..17;
A at 0 range 18..23;
end record;
Type Tripple is record
A, B, C : Interfaces.Integer_8;
end record
with Size => 24, Object_Size => 24, Pack;--, Bit_Order => System.High_Order_First;
For Tripple use record at mod 8;
A at 2 range 0..7;
B at 1 range 0..7;
C at 0 range 0..7;
end record;
-------------------------
-- INTERNAL PACKAGES --
-------------------------
Package Internal_Data_Vector is new Ada.Containers.Indefinite_Vectors(
Index_Type => Positive,
Element_Type => Quad,
"=" => "="
);
--------------------------
-- INTERNAL FUNCTIONS --
--------------------------
Function Convert( Source : Quad ) return Tripple with Inline, Pure_Function;
Function Convert( Source : Tripple ) return Quad with Inline, Pure_Function;
Function Convert( Source : Base_64_Chunk) return Quad with Inline, Pure_Function;
Function Convert( Source : Quad) return Base_64_Chunk with Inline, Pure_Function;
End Internals;
Type Encoder is record -- new Ada.Finalization.Controlled with record
Result : Internals.Internal_Data_Vector.Vector;
B1, B2 : Interfaces.Integer_8:= Interfaces.Integer_8'First;
Current : Internals.Internal_Count := Internals.Internal_Count'First;
end record;
End Base_64;
-------------------------------
-------------------------------
Pragma Ada_2012;
Pragma Assertion_Policy( Check );
With
System,
Unchecked_Conversion;
Package Body Base_64 is
Package Body Internals is
Function Internal_Convert is new Unchecked_Conversion(
Source => Tripple,
Target => Quad
);
Function Internal_Convert is new Unchecked_Conversion(
Source => Quad,
Target => Tripple
);
Function Convert( Source : Quad ) return Tripple is
( Internal_Convert(Source) );
Function Convert( Source : Tripple ) return Quad is
( Internal_Convert(Source) );
Function Convert (Source : Base_64_Chunk) return Quad is
(if (for all C of Source => C in Nonpad_Character) then
( Internal_Character( Source(1) ),
Internal_Character( Source(2) ),
Internal_Character( Source(3) ),
Internal_Character( Source(4) )
) else raise Program_Error with "Cannot convert a chunk with padding."
);
Function Convert (Source : Quad) return Base_64_Chunk is
(Base_64_Character( Source.A ),
Base_64_Character( Source.B ),
Base_64_Character( Source.C ),
Base_64_Character( Source.D )
);
Function Internal_Convert is new Unchecked_Conversion(
Source => Interfaces.Integer_8,
Target => Character
);
end Internals;
Function Convert is new Unchecked_Conversion(
Source => Character,
Target => Interfaces.Integer_8
);
Function Convert is new Unchecked_Conversion(
Source => Interfaces.Integer_8,
Target => Character
);
Function Encode( Data : String ) return Base_64_String is
State : Encoder;
begin
for Item of Data loop
Feed( State, Convert(Item) );
end loop;
Return Get_Data( State );
end Encode;
Function Decode( Data : Base_64_String ) return String is
Local_Encoder : Encoder;
Chunk_Size : Constant := 3;
begin
if Data'Length not in Positive then
Return "";
end if;
Reset( Local_Encoder, Data );
Decode_Process:
Declare
Has_Pad : Constant Boolean := Data(Data'Last) not in Nonpad_Character;
Two_Pad : Constant Boolean := Data(Data'Last-1) not in Nonpad_Character;
Subtype Chunk_Range is Positive range 1 .. Data'Length/4
+ (if Has_Pad then -1 else 0);
Padding : Constant Natural := (
if Two_Pad then 1
elsif Has_Pad then 2
else 0
);
Result_Length : Constant Natural := Chunk_Range'Last*3 + Padding;
Begin
Return Result : String(1..Result_Length) := (others => '?') do
Handle_Nonpad_Characters:
For Index in Chunk_Range loop
declare
Use Internals;
Chunk_Start : Constant Positive := Positive'Succ(Natural'Pred(Index)*4);
Subtype Chunk is Positive range Chunk_Start..Chunk_Start+Chunk_Size;
Start : Constant Positive := Natural'Pred(Index)*Chunk_Size + Result'First;
Stop : Constant Positive := Start + Chunk_Size - 1;
Temp : Constant Base_64_Chunk := Base_64_Chunk(Data(Chunk));
Four : Quad renames Convert( Temp );
Three: Tripple renames Convert( Four );
begin
Result(Start..Stop):=
(Convert(Three.A),
Convert(Three.B),
Convert(Three.C)
);
end;
End Loop Handle_Nonpad_Characters;
if Has_Pad then
Handle_Padding:
Declare
Use Internals;
Tail : Base_64_String renames Data(Data'Last-3..Data'Last);
B64C : Constant Base_64_Chunk := Base_64_Chunk(Tail);
Q : Constant Quad :=
( Internal_Character( B64C(1) ),
Internal_Character( B64C(2) ),
(if Two_Pad then Internal_Character'First
else Internal_Character( B64C(3) )),
Internal_Character'First
);
Three : Tripple renames Convert( Q );
Begin
Result(Result'Last-1):= Convert(Three.A);
Result(Result'Last ):= Convert(Three.B);
End Handle_Padding;
end if;
End return;
End Decode_Process;
End Decode;
Function To_String( Data : Base_64_String ) return String is
Begin
Return Result : String( Data'Range ) do
for Index in Data'Range loop
declare
B64C : Base_64_Character renames Data(Index);
Pos : Constant Natural := Base_64_Character'Pos( B64C );
Image : String renames Base_64_Character'Image( Base_64_Character'Val(Pos) );
CI : Character renames Image(2);
begin
Result(Index):= CI;
end;
end loop;
End return;
End To_String;
-------
Procedure Feed( State : in out Encoder; Data : Interfaces.Integer_8 ) is
Use Internals;
begin
case State.Current is
when 1 =>
State.B1:= Data;
State.Current:= Internal_Count'Succ( State.Current );
when 2 =>
State.B2:= Data;
State.Current:= Internal_Count'Succ( State.Current );
when 3 =>
Process:
Declare
Three_Bytes : Constant Tripple := (State.B1, State.B2, Data);
Four_Chars : Quad renames Convert(Three_Bytes);
Begin
State.Result.Append( Four_Chars );
State.Current:= Internal_Count'First;
End Process;
end case;
End Feed;
Function Get_Data( State : in Encoder ) return Base_64_String is
Use Ada.Containers, Internals.Internal_Data_Vector, Internals;
Chunk_Size : Constant := Base_64_Chunk'Length;
Padding : Constant Natural := (if State.Current = 1 then 0 else 1);
Subtype Result_Range is Positive range 1..Natural(State.Result.Length);
Subtype Padded_Range is Positive range 1..(Result_Range'last+Padding)*Chunk_Size;
begin
Return Result : Base_64_String(Padded_Range) := (others => '=') do
Transpose_Result:
For Index in Result_Range loop
declare
Offset : Constant Natural := Chunk_Size*Natural'Pred(Index);
Start : Constant Positive:= Offset+1;
Stop : Constant Positive:= Positive'Pred(Start+Chunk_Size);
Temp : Base_64_Chunk renames Convert(State.Result(Index));
begin
Result(Start..Stop):= Base_64_String( Temp );
end;
End Loop Transpose_Result;
Handle_Tail:
declare
begin
case State.Current is
when 1 => null;
when others =>
declare
Three : Constant Tripple := (State.B1, State.B2, 0);
Four : Base_64_Chunk renames Convert(Convert(Three));
begin
Result(Padded_Range'Last-3):= Four(1);
Result(Padded_Range'Last-2):= Four(2);
if State.Current = 3 then
Result(Padded_Range'Last-1):= Four(3);
end if;
end;
end case;
End Handle_Tail;
end return;
end Get_Data;
Function Reset( State : in out Encoder) return Base_64_String is
Begin
Return Result : constant Base_64_String := Get_Data(State) do
Reset(State);
End return;
End Reset;
Procedure Reset( State : in out Encoder; Data : Base_64_String ) is
begin
Reset(State);
if Data'Length not in Positive then
Return;
else
Decode:
declare
Use Internals;
Has_Pad : Constant Boolean := Data(Data'Last) not in Nonpad_Character;
Two_Pad : Constant Boolean := Data(Data'Last-1) not in Nonpad_Character;
Data_Length : Constant Integer := Data'Length / 4 - (if Has_Pad then 1 else 0);
Subtype Chunk_Index is Positive range Data'First..Data_Length;
begin
Common_Portion:
For Index in Chunk_Index loop
declare
C : Constant Base_64_Chunk := Base_64_Chunk(Data(Index*4..Index*4+3));
Q : Quad renames Convert(C);
begin
State.Result.Append( Q );
end;
End Loop Common_Portion;
if Has_Pad then
Handle_Padding:
Declare
Tail : Base_64_String renames Data(Data'Last-3..Data'Last);
B64C : Constant Base_64_Chunk := Base_64_Chunk(Tail);
Q : Constant Quad :=
(
Internal_Character( B64C(1) ),
Internal_Character( B64C(2) ),
(if Two_Pad then Internal_Character'First
else Internal_Character( B64C(3) )),
Internal_Character'First
);
Three : Tripple renames Convert( Q );
Begin
State.B1 := Three.A;
if Two_Pad then
State.B2:= Three.B;
State.Current:= 3;
else
State.Current:= 2;
end if;
End Handle_Padding;
end if;
End Decode;
end if;
end Reset;
Procedure Reset( State : in out Encoder ) is
Begin
State.Result.Clear;
State.Current:= 1;
State.B1 := Interfaces.Integer_8'First;
State.B2 := Interfaces.Integer_8'First;
End Reset;
End Base_64;
^ permalink raw reply [flat|nested] 4+ messages in thread