From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM autolearn=unavailable autolearn_force=no version=3.4.4 X-Received: by 10.176.64.225 with SMTP id i88mr14646959uad.5.1471834126126; Sun, 21 Aug 2016 19:48:46 -0700 (PDT) X-Received: by 10.157.45.97 with SMTP id v88mr1042770ota.4.1471834126075; Sun, 21 Aug 2016 19:48:46 -0700 (PDT) Path: eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!news.eternal-september.org!feeder.eternal-september.org!news.glorb.com!c52no10154577qte.1!news-out.google.com!d130ni42829ith.0!nntp.google.com!f6no11888809ith.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail Newsgroups: comp.lang.ada Date: Sun, 21 Aug 2016 19:48:45 -0700 (PDT) In-Reply-To: <5444b6b1-f1a6-40c5-9946-1c836987df7d@googlegroups.com> Complaints-To: groups-abuse@google.com Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=174.28.146.45; posting-account=lJ3JNwoAAAAQfH3VV9vttJLkThaxtTfC NNTP-Posting-Host: 174.28.146.45 References: <5444b6b1-f1a6-40c5-9946-1c836987df7d@googlegroups.com> User-Agent: G2/1.0 MIME-Version: 1.0 Message-ID: Subject: Re: Base64 encoding and decoding (preferably public domain) From: Shark8 Injection-Date: Mon, 22 Aug 2016 02:48:46 +0000 Content-Type: text/plain; charset=UTF-8 Xref: news.eternal-september.org comp.lang.ada:31492 Date: 2016-08-21T19:48:45-07:00 List-Id: 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;