Index: tools/hmac-main.adb ================================================================== --- tools/hmac-main.adb +++ tools/hmac-main.adb @@ -14,55 +14,160 @@ -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------ with Ada.Command_Line; with Ada.Streams; +with Ada.Strings.Unbounded; with Ada.Text_IO; with Ada.Text_IO.Text_Streams; +with Natools.Getopt_Long; with Natools.S_Expressions; with Natools.S_Expressions.Encodings; procedure HMAC.Main is -begin - case Ada.Command_Line.Argument_Count is - when 0 => - Ada.Text_IO.Put_Line ("Usage: " - & Ada.Command_Line.Command_Name - & " key [message]"); - - when 1 => - declare - Context : HMAC_Implementation.Context - := HMAC_Implementation.Create (Ada.Command_Line.Argument (1)); - Block : Ada.Streams.Stream_Element_Array (1 .. 64); - Last : Ada.Streams.Stream_Element_Offset; - Input : constant Ada.Text_IO.Text_Streams.Stream_Access - := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input); - begin - loop - Input.Read (Block, Last); - exit when Last not in Block'Range; - HMAC_Implementation.Update - (Context, Block (Block'First .. Last)); - end loop; - - Ada.Text_IO.Put_Line - (Natools.S_Expressions.To_String - (Natools.S_Expressions.Encodings.Encode_Hex - (HMAC_Implementation.Digest (Context), - Natools.S_Expressions.Encodings.Lower))); - end; - - when others => - for I in 2 .. Ada.Command_Line.Argument_Count loop - Ada.Text_IO.Put_Line - (Natools.S_Expressions.To_String - (Natools.S_Expressions.Encodings.Encode_Hex - (HMAC_Implementation.Digest - (Ada.Command_Line.Argument (1), - Natools.S_Expressions.To_Atom - (Ada.Command_Line.Argument (I))), - Natools.S_Expressions.Encodings.Lower))); - end loop; - end case; + + procedure Base64_Output (Digest : in Ada.Streams.Stream_Element_Array); + -- Output the given binary Digest in base-64 + + procedure Lower_Hex_Output (Digest : in Ada.Streams.Stream_Element_Array); + -- Output the given binary Digest in lower-case hexadecimal + + procedure Raw_Output (Digest : in Ada.Streams.Stream_Element_Array); + -- Output the given binary Direct directly + + procedure Upper_Hex_Output (Digest : in Ada.Streams.Stream_Element_Array); + -- Output the given binary Digest in upper-case hexadecimal + + + package Options is + type Id is + (Base64_Output, + Lower_Hex_Output, + Raw_Output, + Upper_Hex_Output); + end Options; + + package Getopt is new Natools.Getopt_Long (Options.Id); + + type Encode_Output is not null access procedure + (Digest : in Ada.Streams.Stream_Element_Array); + + type Callback is new Getopt.Handlers.Callback with record + Output : Encode_Output := Lower_Hex_Output'Access; + Key : Ada.Strings.Unbounded.Unbounded_String; + Has_Key : Boolean := False; + Done : Boolean := False; + end record; + + overriding procedure Option + (Handler : in out Callback; + Id : in Options.Id; + Argument : in String); + + overriding procedure Argument + (Handler : in out Callback; + Argument : in String); + + + overriding procedure Option + (Handler : in out Callback; + Id : in Options.Id; + Argument : in String) + is + pragma Unreferenced (Argument); + begin + case Id is + when Options.Base64_Output => + Handler.Output := Base64_Output'Access; + when Options.Lower_Hex_Output => + Handler.Output := Lower_Hex_Output'Access; + when Options.Raw_Output => + Handler.Output := Raw_Output'Access; + when Options.Upper_Hex_Output => + Handler.Output := Upper_Hex_Output'Access; + end case; + end Option; + + + overriding procedure Argument + (Handler : in out Callback; + Argument : in String) is + begin + if Handler.Has_Key then + Handler.Output (HMAC_Implementation.Digest + (Ada.Strings.Unbounded.To_String (Handler.Key), + Natools.S_Expressions.To_Atom (Argument))); + Handler.Done := True; + else + Handler.Key := Ada.Strings.Unbounded.To_Unbounded_String (Argument); + Handler.Has_Key := True; + end if; + end Argument; + + + procedure Base64_Output (Digest : in Ada.Streams.Stream_Element_Array) is + begin + Ada.Text_IO.Put_Line (Natools.S_Expressions.To_String + (Natools.S_Expressions.Encodings.Encode_Base64 (Digest))); + end Base64_Output; + + procedure Lower_Hex_Output (Digest : in Ada.Streams.Stream_Element_Array) is + begin + Ada.Text_IO.Put_Line (Natools.S_Expressions.To_String + (Natools.S_Expressions.Encodings.Encode_Hex + (Digest, Natools.S_Expressions.Encodings.Lower))); + end Lower_Hex_Output; + + procedure Raw_Output (Digest : in Ada.Streams.Stream_Element_Array) is + begin + Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Output).Write + (Digest); + end Raw_Output; + + procedure Upper_Hex_Output (Digest : in Ada.Streams.Stream_Element_Array) is + begin + Ada.Text_IO.Put_Line (Natools.S_Expressions.To_String + (Natools.S_Expressions.Encodings.Encode_Hex + (Digest, Natools.S_Expressions.Encodings.Upper))); + end Upper_Hex_Output; + + Opt_Config : Getopt.Configuration; + Handler : Callback; +begin + Opt_Config.Add_Option + ("base64", 'b', Getopt.No_Argument, Options.Base64_Output); + Opt_Config.Add_Option + ("lower-hex", 'h', Getopt.No_Argument, Options.Lower_Hex_Output); + Opt_Config.Add_Option + ("raw", 'r', Getopt.No_Argument, Options.Raw_Output); + Opt_Config.Add_Option + ("upper-hex", 'H', Getopt.No_Argument, Options.Upper_Hex_Output); + + Opt_Config.Process (Handler); + + if not Handler.Has_Key then + Ada.Text_IO.Put_Line ("Usage: " + & Ada.Command_Line.Command_Name + & "[-h | -H | -b | -r] key [message]"); + + elsif not Handler.Done then + declare + Context : HMAC_Implementation.Context + := HMAC_Implementation.Create + (Ada.Strings.Unbounded.To_String (Handler.Key)); + Block : Ada.Streams.Stream_Element_Array (1 .. 64); + Last : Ada.Streams.Stream_Element_Offset; + Input : constant Ada.Text_IO.Text_Streams.Stream_Access + := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input); + begin + loop + Input.Read (Block, Last); + exit when Last not in Block'Range; + HMAC_Implementation.Update + (Context, Block (Block'First .. Last)); + end loop; + + Handler.Output (HMAC_Implementation.Digest (Context)); + end; + end if; end HMAC.Main;