-- Topal: GPG/GnuPG and Alpine/Pine integration
-- Copyright (C) 2001--2012  Phillip J. Brooke
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3 as
-- published by the Free Software Foundation.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Integer_Text_IO;
with Ada.Interrupts;
with Ada.Interrupts.Names;
with Ada.IO_Exceptions;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with Externals.Simple;
with Help;
with Version_ID;

package body Misc is

   -- Two subprograms to make writing strings easier.
   procedure Character_IO_Put (F : in Character_IO.File_Type;
                               S : in String) is
   begin
      for I in S'First..S'Last loop
         Character_IO.Write(F, S(I));
      end loop;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Character_IO_Put");
         raise;
   end Character_IO_Put;

   -- Two subprograms to make writing strings easier.
   procedure Character_IO_Put_Line (F : in Character_IO.File_Type;
                                    S : in String) is
   begin
      Character_IO_Put(F, S);
      Character_IO.Write(F, Ada.Characters.Latin_1.LF);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Character_IO_Put_Line");
         raise;
   end Character_IO_Put_Line;

   -- How to handle errors and debugging.
   procedure Error (The_Error : in String) is
   begin
      if Ada.Text_IO.Is_Open(Result_File) then
         Ada.Text_IO.Put_Line(Result_File,
                              "Topal: Fatal error: " & The_Error);
      end if;
      Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                           Do_SGR(Config.UBS_Opts(Colour_Important))
                             & "Topal: Fatal error: " & The_Error
                             & Reset_SGR);
      raise Panic with The_Error;
   end Error;

   procedure ErrorNE (The_Error : in String) is
   begin
      if Ada.Text_IO.Is_Open(Result_File) then
         Ada.Text_IO.Put_Line(Result_File,
                              "Topal: Error: " & The_Error);
      end if;
      Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                           "Topal: Error: " & The_Error);
   end ErrorNE;

   procedure Debug (Message : in String) is
   begin
      if Config.Boolean_Opts(Debug) then
         if Ada.Text_IO.Is_Open(Result_File) then
            Ada.Text_IO.Put_Line(Result_File,
                                 "Topal: Debug: " & Message);
         end if;
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Topal: Debug: " & Message);
      end if;
   end Debug;

   -- Strings to integers.

   function String_To_Integer (S : String) return Integer is
      use Ada.Integer_Text_IO;
      use Ada.IO_Exceptions;
      L : Positive;
      N : Integer;
   begin
      Get(S, N, L);
      return N;
   exception
      when Data_Error =>
         raise String_Not_Integer;
      when End_Error =>
         raise String_Not_Integer;
      when others =>
         Ada.Text_IO.Put_Line("*** Problem in String_To_Integer. ***");
         raise;
   end String_To_Integer;

   function String_To_Integer (S : UBS) return Integer is
   begin
      return String_To_Integer(ToStr(S));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.String_To_Integer (B)");
         raise;
   end String_To_Integer;
   
   -- Zero pad to a length.
   function Zero_Pad (S : String; L : Positive) return String is
   begin
      if S'Length >= L then
	 return S;
      else
	 return Ada.Strings.Fixed."*"(L - S'Length, '0') & S;
      end if;
   end Zero_Pad;
   
   -- Throw away leading blanks from a string.
   function Trim_Leading_Spaces (S : String) return String is
      use Ada.Strings.Fixed;
   begin
      if S'Length = 0 then
	 return S;
      else
	 return S(Ada.Strings.Fixed.Index_Non_Blank(S)..S'Last);
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Trim_Leading_Spaces");
         raise;
   end Trim_Leading_Spaces;
   
   function EqualCI (A, B : String) return Boolean is
      use Ada.Strings.Fixed, Ada.Strings.Maps.Constants;
   begin
      return Translate(A, Lower_Case_Map) = Translate(B, Lower_Case_Map);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.EqualCI (A)");
         raise;
   end EqualCI;
      
   function EqualCI (A, B : UBS) return Boolean is
   begin
      return EqualCI(ToStr(A), ToStr(B));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.EqualCI (B)");
         raise;
   end EqualCI;
      
   function EqualCI (A : String; B : UBS) return Boolean is
   begin
      return EqualCI(A, ToStr(B));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.EqualCI (C)");
         raise;
   end EqualCI;
      
   function EqualCI (A : UBS; B : String) return Boolean is
   begin
      return EqualCI(ToStr(A), B);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.EqualCI (D)");
         raise;
   end EqualCI;
      

   -- Create our own temporary file names.  To prevent collisions when
   --  the same Tail is used, we'll also insert a sequence number.
   Temp_File_Sequence_Number : Natural := 0;
   function Temp_File_Name (Tail                : String;
                            Use_Sequence_Number : Boolean := True) return String is
   begin
      -- If Topal_Directory doesn't exist, we'll create it.
      if not Externals.Simple.Test_D(ToStr(Topal_Directory)) then
         Externals.Simple.Mkdir_P(ToStr(Topal_Directory));
      end if;
      if Use_Sequence_Number then
         Temp_File_Sequence_Number := Temp_File_Sequence_Number + 1;
         return ToStr(Topal_Directory)
           & "/temp-"
           & Trim_Leading_Spaces(Integer'Image(Our_PID))
           & "-"
           & Zero_Pad(Trim_Leading_Spaces(Integer'Image(Temp_File_Sequence_Number)), 3)
           & "-"
           & Tail;
      else
         return ToStr(Topal_Directory)
           & "/temp-"
           & Trim_Leading_Spaces(Integer'Image(Our_PID))
           & "-"
           & Tail;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Temp_File_Name");
         raise;
   end Temp_File_Name;

   -- An `unbounded' Get_Line.
   function Unbounded_Get_Line (File : in Ada.Text_IO.File_Type)
                                return UBS is

      use Ada.Text_IO;

      function More_Input return UBS is
         Input : String (1 .. 1024);
         Last  : Natural;
         use type UBS;
      begin
         Get_Line(File, Input, Last);
         if Last < Input'Last then
            return ToUBS(Input(1..Last));
         else
            return ToUBS(Input(1..Last)) & More_Input;
         end if;
      end More_Input;

   begin
      return More_Input;
   exception
      when Ada.IO_Exceptions.End_Error =>
         -- Just let it through and let the caller sort it out.
         raise;
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Unbounded_Get_Line (A)");
         raise;
   end Unbounded_Get_Line;

   function Unbounded_Get_Line return UBS is
   begin
      return Unbounded_Get_Line(Ada.Text_IO.Standard_Input);
   exception
      when Ada.IO_Exceptions.End_Error =>
         -- Just let it through and let the caller sort it out.
         raise;
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Unbounded_Get_Line (B)");
         raise;
   end Unbounded_Get_Line;

   -- Eat and fold an entire file.
   function Read_Fold (File       : in String;
		       Include_LF : in Boolean := False) return UBS is
      F     : Ada.Text_IO.File_Type;
      U     : UBS                   := NullUBS;
      Do_LF : Boolean               := False;
   begin
      Debug("Opening file `" & File & "' for folded read into variable");
      Ada.Text_IO.Open(File => F,
                       Mode => Ada.Text_IO.In_File,
                       Name => File);
  Read_Loop:
      loop
         declare
            use type UBS;
         begin
            U := U & Unbounded_Get_Line(F);
	    -- End_Error might kick us out before appending the LF.
	    if Do_LF then
	       U := U & Ada.Characters.Latin_1.LF;
	       Do_LF := False;
	    end if;
	    if Include_LF then
	       Do_LF := True;
	    end if;
         exception
            when Ada.IO_Exceptions.End_Error => exit Read_Loop; -- Okay.
         end;
      end loop Read_Loop;
      Ada.Text_IO.Close(File => F);
      return U;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Read_Fold");
         raise;
   end Read_Fold;

   -- Open and close the result file.
   procedure Open_Result_File (Resultfile : in String) is
   begin
      Debug("Creating result file with name `" & Resultfile & "'");
      Ada.Text_IO.Create(File => Result_File,
                         Mode => Ada.Text_IO.Append_File,
                         Name => Resultfile);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Open_Result_File");
         raise;
   end Open_Result_File;

   procedure Close_Result_File is
   begin
      if Ada.Text_IO.Is_Open(Result_File) then
         Ada.Text_IO.Close(Result_File);
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Close_Result_File");
         raise;
   end Close_Result_File;

   procedure Disclaimer is
      use Ada.Text_IO;
   begin
      Put_Line(Do_SGR(Config.UBS_Opts(Colour_Banner))
                 & "Topal " & Version_ID.Release
                 & " (" & Version_ID.Build_Date & ")");
      Put_Line("Copyright (C) 2001--2012 Phillip J. Brooke"
                 & Reset_SGR);
      Help.Disclaimer;
      New_Line;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Disclaimer");
         raise;
   end Disclaimer;

   function Value_Nonempty (V : in UBS) return UBS is
   begin
      if ToStr(V) = "" then
         raise Need_Nonempty_String;
      end if;
      return V;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Value_Nonempty (A)");
         raise;
   end Value_Nonempty;

   function Value_Nonempty (V : UBS) return String is
   begin
      return ToStr(Value_Nonempty(V));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Value_Nonempty (B)");
         raise;
   end Value_Nonempty;

   -- Given a string, A, we want to split it up.  Really, we would
   -- like to properly honour bash-style quoting.
   -- At the moment, we'll simply do a space-separated run.
   -- Then added `stuffing'.  `"' will group things as an argument (i.e., stop the
   -- search).  `"' can be included literally by stuffing: `""'.
   function Split_Arguments (A : UBS) return UBS_Array is
      BA : UVV;
      AS : constant String := ToStr(A);

      -- Recurse:
      -- Given a string, extract one token from it.
      -- Then recurse with the rest of the string.
      procedure Grab_Next_Token (A : in String) is
         I        : Natural;
         No_More  : Boolean := False;
         T        : UBS;
         Quoted   : Boolean := False;
         use type UBS;
      begin
         Debug("Grab_Next_Token invoked with `"
               & A & "'");
         -- Only do this if we're actually been given something.
         if A'Length /= 0 then
            -- Find first non-blank.
            I := A'First;
        Start_Loop:
            loop
               if A(I) = ' ' then
                  -- Advance.
                  I := I + 1;
                  -- Check for termination without finding new token.
                  if I > A'Last then
                     No_More := True;
                     exit Start_Loop;
                  end if;
               else
                  -- Start of a new token.
                  exit Start_Loop;
               end if;
            end loop Start_Loop;
                if not No_More then
                   -- Copy character by character until we find a space (unless
                   -- we're quoted!).
               Copy_Loop:
                   loop
                      if I > A'Last then
                         exit Copy_Loop;
                      elsif (not Quoted) and then A(I) = ' ' then
                         I := I + 1;
                         -- Finished.
                         exit Copy_Loop;
                      elsif A(I) = '"' then
                         -- If the next character is a ", then copy just one.
                         -- Otherwise, toggle Quoted.
                         if I + 1 <= A'Last and then A(I + 1) = '"' then
                            -- Literal copy of ".
                            T := T & '"';
                            I := I + 2;
                         else
                            I := I + 1;
                            Quoted := not Quoted;
                         end if;
                      else
                         T := T & A(I);
                         I := I + 1;
                      end if;
                   end loop Copy_Loop;
                       -- Trap silliness.
                       if Quoted then
                          Error("Misc.Split_Arguments.Grab_Next_Token: String `" & A
                            & "' ended inside `""'.");
                       end if;
                       -- Finished.
                       BA.Append(T);
                       -- Recurse.
                       Grab_Next_Token(A(I .. A'Last));
                end if;
         end if;
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
              "Exception raised in Misc.Split_Arguments.Grab_Next_Token");
            raise;
      end Grab_Next_Token;

   begin
      Debug("Split_Arguments invoked with `"
        & AS
        & "'");
      BA := UVP.Empty_Vector;
      Grab_Next_Token(AS);
      declare
         RA : UBS_Array(0..Integer(BA.Length)-1);
      begin
         for I in 1 .. Integer(BA.Length) loop
            RA(I-1) := BA.Element(I);
         end loop;
         return RA;
      end;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
           "Exception raised in Misc.Split_Arguments");
         raise;
   end Split_Arguments;

   function Split_GPG_Colons (AS : String) return UBS_Array is
      CC : Natural;
      use Ada.Strings.Fixed;
   begin
      Debug("Split_GPG_Colons invoked with `"
        & AS
            & "'");
      -- Count the number of colons.
      CC := Count(AS, ":");
      declare
         RA   : UBS_Array(0..CC);
         L, R : Natural;
      begin
         L := AS'First;
         for I in 0 .. CC loop
            -- Find the next right point.
            -- If we're working on the last entry, we don't find a colon.
            if I = CC then
               R := AS'Last;
            else
               R := Index(AS(L..AS'Last), ":") - 1;
            end if;
            -- Copy the entry...
            RA(I) := ToUBS(AS(L..R));
            -- Update L.
            L := R + 2;
         end loop;
         return RA;
      end;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
           "Exception raised in Misc.Split_GPG_Colons");
         raise;
   end Split_GPG_Colons;
   
   function UPC (A, B : String) return UP is
   begin
      return UP'(ToUBS(A),ToUBS(B));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
           "Exception raised in Misc.UPC");
         raise;
   end UPC;

   function UPC (A, B : UBS) return UP is
   begin
      return UP'(A, B);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
           "Exception raised in Misc.UPC");
         raise;
   end UPC;

   -- Get the basename of a filename.
   function Basename (S : String) return String is
      -- Index of last (if any) `/'.
      I : Integer;
   begin
      I := Ada.Strings.Fixed.Index(Source  => S,
                                   Pattern => "/",
                                   Going   => Ada.Strings.Backward);
      if I = 0 then
         -- Already a basename.
         return S;
      else
         return S(I + 1 .. S'Last);
      end if;
   end Basename;

   -- Basename.
   function Command_Basename return String is
   begin
      return Basename(Ada.Command_Line.Command_Name);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Command_Line_Wrapper.Command_Basename");
         raise;
   end Command_Basename;

   -- Turn hexadecimal string into value.
   function Hex_Decode (S : in String) return Natural is
      V : Natural := 0;
   begin
      for I in S'Range loop
         V := V * 16;
         if S(I) in '0'..'9' then
            V := V + Character'Pos(S(I)) - Character'Pos('0');
         elsif S(I) in 'A' .. 'F' then
            V := V + Character'Pos(S(I)) - Character'Pos('A') + 10;
         elsif S(I) in 'a' .. 'f' then
            V := V + Character'Pos(S(I)) - Character'Pos('a') + 10;
         else
            raise Constraint_Error;
         end if;
      end loop;
      return V;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Hex_Decode");
         raise;
   end Hex_Decode;

   -- Have we got base64 or binary?
   -- Test if an SMIME input is likely to be base64 or binary.  We
   --  need this because we can't easily pass the correct
   --  content-transfer-encoding (yet).  If Pine receives from
   --  Thunderbird or Outlook (for example), we are given binary.  If
   --  it's Topal sending, then it's possibly base64.
   function Guess_SMIME_Encoding(Infile : String) return String is
      F : Character_IO.File_Type;
      C : Character;
      Limit : constant Positive := 1000;
      N : Natural := 0;
      AllB64 : Boolean := True;
      use Ada.Characters.Handling;
      use Character_IO;
   begin
      -- Open the file indicated by Infile.  Read the characters.  If
      --  any are outside the usual range for base64, return an empty
      --  string.  If all are in that range, return "--assume-base64".
      Open(File => F,
	   Mode => In_File,
	   Name => Infile);
  Read_Loop:
      loop
	 exit Read_Loop when End_Of_File(F);
	 Read(F, C);
	 N := N + 1;
	 if not (C = ' ' 
		   or else C = Ada.Characters.Latin_1.LF
		   or else C = Ada.Characters.Latin_1.CR
		   or else Is_Letter(C)
		   or else Is_Digit(C)
		   or else C = '+'
		   or else C = '/'
		   or else C = '=') then
	    AllB64 := False;
	    exit Read_Loop;
	 end if;
	 exit Read_Loop when N >= Limit;
      end loop Read_Loop;
      if AllB64 then
	 return "--assume-base64";
      else
	 return "";
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Guess_SMIME_Encoding");
         raise;
   end Guess_SMIME_Encoding;
   
   function UGA_Str (Signing : Boolean) return String is
      T : Positive;
   begin
      if Signing then T := 3; else T := 2; end if;
      if Config.Positive_Opts(Use_Agent) >= T then
         return "--use-agent";
      else
         return "--no-use-agent";
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.UGA_Str");
         raise;
   end UGA_Str;

   function Use_ANSI (S : String) return String is
   begin
      if Config.Boolean_Opts(ANSI_Terminal) then
         return S;
      else
         return "";
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Use_ANSI");
         raise;
   end Use_ANSI;

   function Do_SGR (S : String) return String is
   begin
      return Use_ANSI(ANSI_CSI & S & ANSI_SGR);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Do_SGR (A)");
         raise;
   end Do_SGR;

   function Do_SGR (U : UBS) return String is
   begin
      return Do_SGR(ToStr(U));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Do_SGR (B)");
         raise;
   end Do_SGR;

   function Reset_SGR return String is
   begin
      return Use_ANSI(ANSI_SGR_Reset);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Reset_SGR");
         raise;
   end Reset_SGR;

   -- Rewrite a prompt.
   function Rewrite_Menu_Prompt (S : String) return String is
      U : UBS;
      use type UBS;
   begin
      for I in S'Range loop
         if S(I) = '{' then
            U := U & Do_SGR(Config.UBS_Opts(Colour_Menu_Key)) & "[";
         elsif S(I) = '}' then
            U := U & "]" & Reset_SGR;
         else
            U := U & S(I);
         end if;
      end loop;
      return ToStr(U);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Rewrite_Menu_Prompt");
         raise;
   end Rewrite_Menu_Prompt;


   -- Handle signals.
   Default_Sigint_Handler : Ada.Interrupts.Parameterless_Handler;
   pragma Unreferenced(Default_Sigint_Handler);
   protected body Signal_Handlers is

      procedure Sigint_Handler is
      begin
         Ada.Text_IO.Put_Line("User interrupt!");
         Sigint_Pending_Flag := True;
         raise User_Interrupt;
      end Sigint_Handler;

      function Sigint_Pending return Boolean is
      begin
         return Sigint_Pending_Flag;
      end Sigint_Pending;

   end Signal_Handlers;

   procedure Set_Sigint_Handler is
   begin
      Ada.Interrupts.Attach_Handler(Signal_Handlers.Sigint_Handler'Access,
                                    Ada.Interrupts.Names.SIGINT);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Misc.Set_Sigint_Handler");
         raise;
   end Set_Sigint_Handler;

begin
   Default_Sigint_Handler := Ada.Interrupts.Current_Handler(Ada.Interrupts.Names.SIGINT);
end Misc;