Natools

-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Exceptions;
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;
with Natools.S_Expressions.File_Readers;

with HMAC.Pinentry;

procedure HMAC.Main is

   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);

   package Options is
      type Id is
        (Base64_Output,
         Key_File,
         Lower_Hex_Output,
         Pinentry,
         Raw_Output,
         Upper_Hex_Output);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Encode_Output is not null access procedure

                 (Natools.S_Expressions.To_String
                    (Natools.S_Expressions.File_Readers.Reader
                       (Argument).Read));
            end if;
            Handler.Has_Key := True;
         when Options.Lower_Hex_Output =>
            Handler.Output := Lower_Hex_Output'Access;
         when Options.Pinentry =>
            begin
               Handler.Key := Ada.Strings.Unbounded.To_Unbounded_String
                 (Pinentry.Get_Key (Argument));
               Handler.Has_Key := True;
            exception
               when Ex : others =>
                  Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error,
                     "Unable to get PIN from """ & Argument & '"');
                  Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error,
                     "exception " & Ada.Exceptions.Exception_Name (Ex)
                     & ": " & Ada.Exceptions.Exception_Message (Ex));
            end;
         when Options.Raw_Output =>
            Handler.Output := Raw_Output'Access;
         when Options.Upper_Hex_Output =>
            Handler.Output := Upper_Hex_Output'Access;
      end case;
   end Option;

     ("key-file", 'f', Getopt.Required_Argument, Options.Key_File);
   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);

   if Pinentry.Is_Available then
      Opt_Config.Add_Option
        ("pinentry", 'p', Getopt.Required_Argument, Options.Pinentry);
   end if;

   Opt_Config.Process (Handler);

   if not Handler.Has_Key then
      Ada.Text_IO.Put_Line ("Usage:");
      Ada.Text_IO.Put_Line ("   "
        & Ada.Command_Line.Command_Name
        & " [-h | -H | -b | -r] key [message]");
      Ada.Text_IO.Put_Line ("   "
        & Ada.Command_Line.Command_Name
        & " [-h | -H | -b | -r] -f path/to/key/file [message]");

      if Pinentry.Is_Available then
         Ada.Text_IO.Put_Line ("   "
           & Ada.Command_Line.Command_Name
           & " [-h | -H | -b | -r] -p path/to/bin/pinentry [message]");
      end if;

   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);