-- 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.Latin_1;
with Ada.IO_Exceptions;
with Ada.Numerics.Discrete_Random;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Externals.Mail;
with Externals.Simple;
with Menus;                        use Menus;
with Misc;                         use Misc;

package body Externals.Mail is

   -- We need to figure out what the boundary is.  We don't trust Pine
   --  and the shell to get it for us, so we'll use this heuristic.
   --  Open Infile, read it in a line at a time.  If a line has the
   --  form `--(some characters)--' then save it.  The *last* one is
   --  assumed to be the correct boundary.  Then we just have to slice
   --  off the leading and trailiing `--'.
   function Find_Mime_Boundary (Infile : String) return UBS is
      BF : Ada.Text_IO.File_Type;
      L2 : UBS; -- the line we've read in.
      PB : UBS; -- possible boundary
   begin
      Debug("+Externals.Mail.Find_Mime_Boundary");
      Ada.Text_IO.Open(File => BF,
                       Mode => Ada.Text_IO.In_File,
                       Name => Infile);
  Boundary_Loop:
      loop
         begin
            L2 := Unbounded_Get_Line(BF);
            declare
               L2S : constant String := ToStr(L2);
            begin
               Debug("Considering: " & L2S);
               if L2S'Length > 4 then
                  if L2S(1..2) = "--"
                 and L2S(L2S'Last-1..L2S'Last) = "--" then
                     -- This is a possible boundary.
                     PB := ToUBS(L2S(3..L2S'Last-2));
                     Debug("Possible boundary: " & ToStr(PB));
                  end if;
               end if;
            end;
         exception
            when Ada.IO_Exceptions.End_Error =>
               exit Boundary_Loop; -- Ignore.
         end;
      end loop Boundary_Loop;
      Ada.Text_IO.Close(BF);
      Debug("-Externals.Mail.Find_Mime_Boundary");
      return PB;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Find_Mime_Boundary");
         raise;
   end Find_Mime_Boundary;

   -- I should really generalise this to n part MIME....
   procedure Split_Two_Parts (Infile   : in String;
                              Part_One : in String;
                              Part_Two : in String;
                              Boundary : in UBS) is
      Infile_F   : Ada.Text_IO.File_Type;
      Part_One_F : Character_IO.File_Type;
      Part_Two_F : Character_IO.File_Type;
      L1         : UBS;
      L2         : UBS;
      BS         : constant String := ToStr(Boundary);
   begin
      -- Open files....
      begin
         Ada.Text_IO.Open(File => Infile_F,
                          Mode => Ada.Text_IO.In_File,
                          Name => Infile);
         Character_IO.Create(File => Part_One_F,
                            Mode => Character_IO.Out_File,
                            Name => Part_One);
         Character_IO.Create(File => Part_Two_F,
                            Mode => Character_IO.Out_File,
                            Name => Part_Two);
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Split_Two_Parts (Opening files)");
            raise;
      end;
      -- Get the two parts.  The first part, we want to include the MIME
      -- headers, but not the boundaries nor the blank line before the next
      -- part.
      -- So, first, we walk through infile looking for the boundary.
      begin
     Find_First_Boundary:
         loop
            L2 := Unbounded_Get_Line(Infile_F);
            declare
               L2S : constant String := ToStr(L2);
            begin
               exit Find_First_Boundary when L2S = "--" & BS;
            end;
         end loop Find_First_Boundary;
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Split_Two_Parts (Find_First_Boundary)");
            raise;
      end;
      -- Now, walk through infile, copying complete lines to Part_One
      -- until we find a blank line - boundary pair.
      begin
         L1 := Unbounded_Get_Line(Infile_F);
     Find_Second_Boundary:
         loop
            L2 := Unbounded_Get_Line(Infile_F);
            declare
               L1S : constant String := ToStr(L1);
               L2S : constant String := ToStr(L2);
            begin
               exit Find_Second_Boundary
                  when L1S'Length = 0 and L2S = "--" & BS;
               -- Trap case where data ends without newline.
               if L2S = "--" & BS then
                  Character_IO_Put(Part_One_F, L1S);
                  exit Find_Second_Boundary;
               end if;
               Character_IO_Put_Line(Part_One_F, L1S);
            end;
            L1 := L2;
         end loop Find_Second_Boundary;
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Split_Two_Parts (Find_Second_Boundary)");
            raise;
      end;
      -- Continue through infile, copying complete lines to Part_Two,
      -- until we find another blank_line - boundary pair.
      begin
         L1 := Unbounded_Get_Line(Infile_F);
     Find_Third_Boundary:
         loop
            L2 := Unbounded_Get_Line(Infile_F);
            declare
               L1S : constant String := ToStr(L1);
               L2S : constant String := ToStr(L2);
            begin
               exit Find_Third_Boundary
                  when L1S'Length = 0 and L2S = "--" & BS & "--";
               -- Trap case where data ends without newline.
               if L2S = "--" & BS & "--" then
                  Character_IO_Put(Part_Two_F, L1S);
                  exit Find_Third_Boundary;
               end if;
               Character_IO_Put_Line(Part_Two_F, L1S);
            end;
            L1 := L2;
         end loop Find_Third_Boundary;
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Split_Two_Parts (Find_Third_Boundary)");
            raise;
      end;
      -- Close files.
      begin
         Ada.Text_IO.Close(Infile_F);
         Character_IO.Close(Part_One_F);
         Character_IO.Close(Part_Two_F);
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Split_Two_Parts (Closing files)");
            raise;
      end;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Split_Two_Parts");
         raise;
   end Split_Two_Parts;

   procedure Get_First_Part (-- Input file.
			     Infile : in String;
			     -- Outputs:
			     -- 1. Prolog (file).
			     Prolog : in String;
			     -- 2. Boundary detected (including leading --).
			     Boundary : out UBS;
			     -- 3. Part header (file).
			     Part_Hdr : in String;
			     -- 4. Part body (file).  Neither 3 nor 4 includes the blank line separator.
			     Part_Body : in String;
			     -- 5. Rest of file (including boundary between 4 and this) (file).
			     Remainder : in String
			    ) is
      -- We're expecting a file from DTBL output.
      -- This is the body of a Pine multipart/mixed.
      -- We can get the first boundary line by searching for the first -- prefixed line.
      Infile_F   : Ada.Text_IO.File_Type;
      Out_F1     : Character_IO.File_Type;
      Out_F3     : Character_IO.File_Type;
      Out_F4     : Character_IO.File_Type;
      Out_F5     : Character_IO.File_Type;
      L          : UBS;
   begin
      -- Open files....
      begin
         Ada.Text_IO.Open(File => Infile_F,
                          Mode => Ada.Text_IO.In_File,
                          Name => Infile);
         Character_IO.Create(File => Out_F1,
                            Mode => Character_IO.Out_File,
                            Name => Prolog);
         Character_IO.Create(File => Out_F3,
                            Mode => Character_IO.Out_File,
                            Name => Part_Hdr);
         Character_IO.Create(File => Out_F4,
                            Mode => Character_IO.Out_File,
                            Name => Part_Body);
         Character_IO.Create(File => Out_F5,
                            Mode => Character_IO.Out_File,
                            Name => Remainder);
      exception
         when others =>
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                                 "Exception raised in Externals.Mail.Get_First_Part (Opening files)");
            raise;
      end;
  Find_Boundary:
      loop
	 L := Unbounded_Get_Line(Infile_F);
	 declare
	    L2 : constant String := ToStr(L);
	 begin
	    if L2'Length > 2
	      and then L2(1..2) = "--" then
	       Boundary := L;
	       exit Find_Boundary;
	    end if;
	    -- Otherwise, it's part of the prolog.
	    Character_IO_Put_Line(Out_F1, ToStr(L));
	 end;
      end loop Find_Boundary;
      -- Write out the boundary we just read to the end of the prolog.
      Character_IO_Put_Line(Out_F1, ToStr(L));
      Character_IO.Close(Out_F1);
      -- We've now got the boundary.  Find a blank line.
  Find_Blank_Line:
      loop
	 L := Unbounded_Get_Line(Infile_F);
	 declare
	    L2 : constant String := ToStr(L);
	 begin
	    exit when L2'Length = 0;
	    -- Otherwise, it's part of the part header.
	    Character_IO_Put_Line(Out_F3, ToStr(L));
	 end;
      end loop Find_Blank_Line;
      Character_IO.Close(Out_F3);
      -- Now we've got a blank line.  Everything up to the next
      --  boundary is the part body.
  Find_Next_Boundary:
      loop
	 L := Unbounded_Get_Line(Infile_F);
	 declare
	    L2 : constant String := ToStr(L);
	 begin
	    exit when L2 = ToStr(Boundary);
	    -- Otherwise, it's part of the part header.
	    Character_IO_Put_Line(Out_F4, ToStr(L));
	 end;
      end loop Find_Next_Boundary;
      Character_IO.Close(Out_F4);
      -- Write out the boundary we just read, and then the rest of the file.
      Character_IO_Put_Line(Out_F5, ToStr(L));
  Eat_Remainder:
      loop
	 exit when Ada.Text_IO.End_Of_File(Infile_F);
	 L := Unbounded_Get_Line(Infile_F);
	 Character_IO_Put_Line(Out_F5, ToStr(L));
      end loop Eat_Remainder;
      -- Done, close the last files.
      Character_IO.Close(Out_F5);
      Ada.Text_IO.Close(Infile_F);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Get_First_Part");
         raise;
   end Get_First_Part;      
   
   
   procedure Extract_Content_Type_From_Header (Email_Filename  : in String;
                                               Target_Filename : in String;
                                               Ignore_Missing  : in Boolean := False;
                                               Substitute      : in Boolean := False) is
      E1, E2 : Integer;
   begin
      ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)),
                      UBS_Array'(0 => ToUBS("sed"),
                                 1 => ToUBS("1,/^[:space:]*$/ ! d")),
                      E1,
                      Value_Nonempty(Config.Binary(Grep)),
                      UBS_Array'(0 => ToUBS("grep"),
                                 1 => ToUBS("-i"),
                                 2 => ToUBS("content-type: ")),
                      E2,
                      Source => Email_Filename,
                      Target => Target_Filename);
      if E1 /= 0 then
         Error("Problem with sed! (ff2a)");
      elsif E2 /= 0 and (not Ignore_Missing) then
         Error("Problem with grep! (ff2b)");
      end if;
      if E2 /= 0 and Substitute then
         -- Write the default into Target_Filename.
         Externals.Simple.Echo_Out("Content-Type: Text/Plain; Charset=US-ASCII", Target_Filename);
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Extract_Content_Type_From_Header (Email_Filename=" & Email_Filename & ", Target_Filename=" & Target_Filename & ")");
         raise;
   end Extract_Content_Type_From_Header;

    procedure Extract_Content_Transfer_Encoding_From_Header (Email_Filename  : in String;
                                               Target_Filename : in String;
                                               Ignore_Missing  : in Boolean := False;
                                               Substitute      : in Boolean := False) is
      E1, E2 : Integer;
   begin
      ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)),
                      UBS_Array'(0 => ToUBS("sed"),
                                 1 => ToUBS("1,/^[:space:]*$/ ! d")),
                      E1,
                      Value_Nonempty(Config.Binary(Grep)),
                      UBS_Array'(0 => ToUBS("grep"),
                                 1 => ToUBS("-i"),
                                 2 => ToUBS("content-transfer-encoding: ")),
                      E2,
                      Source => Email_Filename,
                      Target => Target_Filename);
      if E1 /= 0 then
         Error("Problem with sed! (ff2aa)");
      elsif E2 /= 0 and (not Ignore_Missing) then
         Error("Problem with grep! (ff2ba)");
      end if;
      if E2 /= 0 and Substitute then
         -- Write the default into Target_Filename.
         Externals.Simple.Echo_Out("Content-Transfer-Encoding: 7BIT", Target_Filename);
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Extract_Content_Transfer_Encoding_From_Header");
         raise;
   end Extract_Content_Transfer_Encoding_From_Header;

   -- Get the header from a header-body mail into a file.
   procedure Extract_Header (Email_Filename  : in String;
                             Target_Filename : in String) is
   begin
      if ForkExec_InOut(Value_Nonempty(Config.Binary(Sed)),
                        UBS_Array'(0 => ToUBS("sed"),
                                   1 => ToUBS("-e"),
                                   2 => ToUBS("1,/^[:space:]*$/ ! d"),
                                   3 => ToUBS("-e"),
                                   4 => ToUBS("/^[:space:]*$/ d")),
                        Source => Email_Filename,
                        Target => Target_Filename) /= 0 then
         Error("sed failed! (ff11)");
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Extract_Header");
         raise;
   end Extract_Header;

   -- Get the body from a header-body mail into a file.
   procedure Extract_Body (Email_Filename  : in String;
                           Target_Filename : in String) is
      E1, E2 : Integer;
   begin
      ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)),
                      UBS_Array'(0 => ToUBS("sed"),
                                 1 => ToUBS("-e"),
                                 2 => ToUBS("/^[:space:]*$/,$ ! d")),
                      E1,
                      Value_Nonempty(Config.Binary(Sed)),
                      UBS_Array'(0 => ToUBS("sed"),
                                 1 => ToUBS("-e"),
                                 2 => ToUBS("1,1 { /^[:space:]*$/ d ; }")),
                      E2,
                      Source => Email_Filename,
                      Target => Target_Filename);
      if E1 /= 0 then
         Error("sed failed! (ff3)");
      elsif E2 /= 0 then
         Error("sed failed! (ff13)");
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Extract_Body");
         raise;
   end Extract_Body;

   procedure Delete_Trailing_Blank_Lines (Infile  : in String;
                                          Outfile : in String) is
   begin
      if ForkExec_InOut(Value_Nonempty(Config.Binary(Sed)),
                        UBS_Array'(0 => ToUBS("sed"),
                                   1 => ToUBS("-e"),
                                   2 => ToUBS(":a"),
                                   3 => ToUBS("-e"),
                                   4 => ToUBS("/^\n*$/{$d;N;};/\n$/ba")),
                        Source => Infile,
                        Target => Outfile) /= 0 then
         Error("sed failed! (ff5)");
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Delete_Trailing_Blank_Lines");
         raise;
   end Delete_Trailing_Blank_Lines;
   
   -- A temporary file that we'll re-use for cleaning email addresses.
   Clean_Email_Tempfile : UBS;
   procedure Clean_Email_Address (F : in String) is
      use Ada.Strings.Unbounded;
      E1, E2 : Integer;
   begin
      if Clean_Email_Tempfile = Null_Unbounded_String then
	 Clean_Email_Tempfile := ToUBS(Temp_File_Name("cleane"));
      end if;
      ForkExec2_InOut(Misc.Value_Nonempty(Config.Binary(Sed)),
		      UBS_Array'(0 => ToUBS("sed"),
				 1 => ToUBS("s/""[^""]*""//g; s/,/\n/g")),
		      E1,
		      Misc.Value_Nonempty(Config.Binary(Sed)),
		      UBS_Array'(0 => ToUBS("sed"),
				 1 => ToUBS("s/^.*<//; s/>.*$//; s/ *//g; s/,/\n/g")),
		      E2,
		      F,
		      ToStr(Clean_Email_Tempfile));
      Externals.Simple.Mv_F(ToStr(Clean_Email_Tempfile), F);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Clean_Email_address (procedure)");
         raise;
   end Clean_Email_Address;

   function Clean_Email_Address (E : in String) return String is
      L, R : Natural;
      use Ada.Strings.Fixed;
   begin
      L := Index(E, "<");
      R := Index(E, ">");
      if L = 0 then 
	 L := E'First; 
      else
	 L := L + 1;
      end if;
      if R = 0 then 
	 R := E'Last; 
      else
	 R := R - 1;
      end if;
      return E(L..R);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Clean_Email_address (function)");
         raise;
   end Clean_Email_Address;
   
   procedure Formail_Concat_Extract_InOut (Header : in String;
                                           Source : in String;
                                           Target : in String) is
      E : Integer;
      pragma Unreferenced(E);
   begin
      E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)),
                          UBS_Array'(0 => ToUBS("formail"),
                                     1 => ToUBS("-c"),
                                     2 => ToUBS("-x"),
                                     3 => ToUBS(Header)),
                          Source => Source,
                          Target => Target);
      -- Ignore the return code of formail.  It seems to return 1 a
      -- lot, and I can't find any documentation telling me what it
      -- _should_ return.
   end Formail_Concat_Extract_InOut;

   procedure Formail_Extract_InOut (Header : in String;
                                           Source : in String;
                                           Target : in String) is
      E : Integer;
      pragma Unreferenced(E);
   begin
      E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)),
                          UBS_Array'(0 => ToUBS("formail"),
                                     1 => ToUBS("-x"),
                                     2 => ToUBS(Header)),
                          Source => Source,
                          Target => Target);
      -- Ignore the return code of formail.  It seems to return 1 a
      -- lot, and I can't find any documentation telling me what it
      -- _should_ return.
   end Formail_Extract_InOut;

   procedure Formail_Drop_InOut (Header : in UBS_Array;
                                 Source : in String;
                                 Target : in String) is
      F : UBS_Array(0..(2*Header'Length)+1);
      E : Integer;
      pragma Unreferenced(E);
   begin
      F(0) := ToUBS("formail");
      F(1) := ToUBS("-f"); -- Don't add mbox From line at start.
      for I in 1..Header'Length loop
         F(2*I) := ToUBS("-I");
         F((2*I)+1) := Header(I+Header'First-1);
      end loop;
      E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)),
                          F,
                          Source => Source,
                          Target => Target);
      -- Ignore the return code of formail.  It seems to return 1 a
      -- lot, and I can't find any documentation telling me what it
      -- _should_ return.
   end Formail_Drop_InOut;

   procedure Formail_Action_InOut (Source : in String;
                                   Target : in String;
                                   Action : in String) is
      E : Integer;
      pragma Unreferenced(E);
   begin
      E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)),
                          ToUBS("formail -s " & Action),
                          Source => Source,
                          Target => Target);
      -- Ignore the return code of formail.  It seems to return 1 a
      -- lot, and I can't find any documentation telling me what it
      -- _should_ return.
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Formail_Action_InOut");
         raise;
   end Formail_Action_InOut;

   procedure Formail_Replace_Header_InOut (Source : in String;
					   Target : in String;
					   Header : in String) is
      E : Integer;
      pragma Unreferenced(E);
   begin
      E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)),
                          UBS_Array'(0 => ToUBS("formail"),
				     1 => ToUBS("-f"),
				     2 => ToUBS("-I"),
				     3 => ToUBS(Header)),
                          Source => Source,
                          Target => Target);
      -- Ignore the return code of formail.  It seems to return 1 a
      -- lot, and I can't find any documentation telling me what it
      -- _should_ return.
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Formail_Replace_Header_InOut");
         raise;
   end Formail_Replace_Header_InOut;

   -- A temporary file that we'll re-use for formail_action.
   Formail_Replace_Header_Tempfile : UBS;
   procedure Formail_Replace_Header (File   : in String;
				     Header : in String) is
      use Ada.Strings.Unbounded;
   begin
      if Formail_Replace_Header_Tempfile = Null_Unbounded_String then
	 Formail_Replace_Header_Tempfile := ToUBS(Temp_File_Name("fa"));
      end if;
      Formail_Replace_Header_InOut(File, 
				   ToStr(Formail_Replace_Header_Tempfile),
				   Header);
      Externals.Simple.Cat_Out(ToStr(Formail_Replace_Header_Tempfile), File);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Formail_Replace_Header");
         raise;
   end Formail_Replace_Header;

   subtype Upper_Letters is Character range 'A'..'Z';

   package Random_Letters
   is new Ada.Numerics.Discrete_Random(Upper_Letters);

   Random_Letters_Generator : Random_Letters.Generator;

   function Get_Boundary return String is
      U : UBS;
      use type UBS;
   begin
      U := ToUBS("MIME_CONTENT_BREAK_"
                 & "=_");
      -- Add some random stuff.
      for I in 1..31 loop
         U := U & Random_Letters.Random(Random_Letters_Generator);
      end loop;
      return ToStr(U);
   end Get_Boundary;

   procedure Mimeconstruct2 (Part1_Filename  : in String;
                             Part2_Filename  : in String;
                             Output_Filename : in String;
                             Content_Type    : in String;
                             Prolog          : in String := "") is
   begin
      if Prolog'Length > 0 then
         if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)),
                         UBS_Array'(0 => ToUBS("mime-tool"),
                                    1 => ToUBS("-P"),
                                    2 => ToUBS(Prolog),
                                    3 => ToUBS("-B"),
                                    4 => ToUBS(Get_Boundary),
                                    5 => ToUBS("-O"),
                                    6 => ToUBS(Content_Type),
                                    7 => ToUBS("-o"),
                                    8 => ToUBS("-p"),
                                    9 => ToUBS(Part1_Filename),
                                    10 => ToUBS("-o"),
                                    11 => ToUBS("-p"),
                                    12 => ToUBS(Part2_Filename)),
                         Output_Filename) /= 0 then
            Error("mime-tool failed. (mff1a)");
         end if;
      else
         if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)),
                         UBS_Array'(0 => ToUBS("mime-tool"),
                                    1 => ToUBS("-B"),
                                    2 => ToUBS(Get_Boundary),
                                    3 => ToUBS("-O"),
                                    4 => ToUBS(Content_Type),
                                    5 => ToUBS("-o"),
                                    6 => ToUBS("-p"),
                                    7 => ToUBS(Part1_Filename),
                                    8 => ToUBS("-o"),
                                    9 => ToUBS("-p"),
                                    10 => ToUBS(Part2_Filename)),
                         Output_Filename) /= 0 then
            Error("mime-tool failed. (mff1b)");
         end if;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Mimeconstruct2");
         raise;
   end Mimeconstruct2;

   Disposition_String : constant array (Dispositions) of String(1..2)
     := (None       => "-o",  -- No disposition line.
         Inline     => "-i",  -- Use inline.
         Attachment => "-0"); -- No-op -- the default is attachment.


   procedure Mimeconstruct_Subpart (Infile          : in String;
                                    Outfile         : in String;
                                    Content_Type    : in String;
                                    Dos2UnixU       : in Boolean;
                                    Use_Encoding    : in Boolean;
                                    Disposition     : in Dispositions := None;
                                    Encoding        : in String := "";
                                    Attachment_Name : in String := "") is
      Encode   : String(1..2);
      MC : UBS_Array(0..9);
   begin
      MC(0) := ToUBS("mime-tool");
      MC(1) := ToUBS("-s");
      -- Figure out which encoding to use.
      if Use_Encoding then
         if Encoding = "base64" then
            Encode := "-x";
         elsif Encoding = "quoted-printable" then
            Encode := "-q";
         elsif Encoding = "7bit" then
            Encode := "-7";
         elsif Encoding = "8bit" then
            Encode := "-8";
         else
            Encode := "-x";
         end if;
         MC(2) := ToUBS(Encode);
         MC(3) := ToUBS("-0");
      else
         -- No encoding requested, so we'll set it to binary and omit
         --  the content-transfer-encoding.
         MC(2) := ToUBS("-b");
         MC(3) := ToUBS("-m");
      end if;
      if Config.Boolean_Opts(Omit_Inline_Disposition_Header)
        and Disposition = Inline then
         -- Override it to None.
         MC(4) := ToUBS(Disposition_String(None));
      else
         MC(4) := ToUBS(Disposition_String(Disposition));
      end if;
      if Disposition = None
        or (Config.Boolean_Opts(Omit_Inline_Disposition_Header)
              and Disposition = Inline) then
         -- Some no-ops: we weren't going to show a name.
         MC(5) := ToUBS("-0");
         MC(6) := ToUBS("-0");
      else
         if Attachment_Name'Length > 0 then
            -- Should we use this attachment name?
            if Disposition = Inline
              and Config.Boolean_Opts(Omit_Inline_Disposition_Name) then
               -- We don't want the name.
               MC(5) := ToUBS("-N");
               MC(6) := ToUBS("-0");
            else
               -- Use this name.
               MC(5) := ToUBS("-n");
               MC(6) := ToUBS(Attachment_Name);
            end if;
         else
            -- We don't have an attachment name. Let mime-tool sort it out.
            MC(5) := ToUBS("-0");
            MC(6) := ToUBS("-0");
         end if;
      end if;
      -- The content-type and the file.
      MC(7) := ToUBS("-c");
      MC(8) := ToUBS(Content_Type);
      MC(9) := ToUBS(Infile);
      -- Now actually construct the MIME subpart.
      if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)),
                      MC,
                      Outfile) /= 0 then
         Error("mime-tool failed. (mff3)");
      end if;
      -- Do we need to convert the file with dos2unix?
      if Dos2UnixU then
         Externals.Simple.Dos2Unix_U(Outfile);
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Mimeconstruct_Subpart");
         raise;
   end Mimeconstruct_Subpart;

   -- Construct an entire multipart/mixed email.
   procedure Mimeconstruct_Mixed (Filenames : in UBS_Array;
                                  Outfile   : in String) is
      -- Arg array size is ( 3*num-filenames ) +5, but starting at 0.
      A : UBS_Array(0 .. (3 * Filenames'Length)+4);
   begin
        A(0) := ToUBS("mime-tool");
        A(1) := ToUBS("-B");
        A(2) := ToUBS(Get_Boundary);
        A(3) := ToUBS("-O");
        A(4) := ToUBS("multipart/mixed");
        for I in 1..Filenames'Length loop
           -- First one should be 5.
           A((3*I)+2) := ToUBS("-o");
           A((3*I)+3) := ToUBS("-p");
           A((3*I)+4) := Filenames(I+Filenames'First-1);
        end loop;
        if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)),
                        A,
                        Outfile) /= 0 then
         Error("mime-tool failed. (mff2)");
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Mimeconstruct_Mixed");
         raise;
   end Mimeconstruct_Mixed;


   -- From RFC2045: (A good strategy is to choose a boundary that includes
   -- a character sequence such as "=_" which can never appear in a
   -- quoted-printable body.  See the definition of multipart messages in
   -- RFC 2046.)

   -- Because we might build multiple parts, we'll use a boundary of
   --     MIME_CONTENT_BREAK_=_(partno)=_(random stuff)
   -- where partno is a per-topal-run counter.  (Later: removed partno)

   -- Note that mime-tool actually uses --=_%s_= as the boundary.

   -- We don't currently check for boundary collisions in the data.
   --  We should.

   -- Then we call out to our patched version of mime-tool


   -- View a MIME file.
   procedure View_MIME (F       : in String;
                        Decrypt : in Boolean) is
      Chosen  : Positive;
      MTF     : constant String := Temp_File_Name("vmmt");
      MTFE    : constant String := Temp_File_Name("vmmte");
      MT, MTE : UBS;
      NC      : Boolean         := False;
      NTFE    : Boolean         := False;
      CT      : UBS;
      CTE     : UBS;
      Dummy   : Integer;
      F2      : constant String := Temp_File_Name("f2");
      pragma Unreferenced(Dummy);
   begin
      -- Find out the type of MIME file.
      Externals.Mail.Extract_Content_Type_From_Header(F, MTF, Ignore_Missing => True);
      MT := Read_Fold(MTF);
      Externals.Mail.Extract_Content_Transfer_Encoding_From_Header(F, MTFE, Ignore_Missing => True);
      MTE := Read_Fold(MTFE);
      Ada.Text_IO.New_Line(5);
      declare
         MTFS  : constant String := ToStr(MT);
         MTFES : constant String := ToStr(MTE);
         I, I2 : Integer;
         J, J2 : Integer;
      begin
         I := Ada.Strings.Fixed.Index(MTFS, ": ");
         if I = 0 then
            I := MTFS'First;
            NC := True;
         else
            I := I + 2;
         end if;
         I2 := Ada.Strings.Fixed.Index(MTFS, ";");
         if I2 = 0 then
            I2 := MTFS'Last;
         else
            I2 := I2 - 1;
         end if;
         J := Ada.Strings.Fixed.Index(MTFES, ": ");
         if J = 0 then
            J := MTFES'First;
            NTFE := True;
         else
            J := J + 2;
         end if;
         J2 := Ada.Strings.Fixed.Index(MTFES, ";");
         if J2 = 0 then
            J2 := MTFES'Last;
         else
            J2 := J2 - 1;
         end if;
         if NC then
            Ada.Text_IO.Put_Line("About to view an attachment with "
                                   & Do_SGR(Config.UBS_Opts(Colour_Info))
                                   & "no content type"
                                   & Reset_SGR);
            CT := ToUBS("text/plain");
         else
            Ada.Text_IO.Put_Line("About to view an attachment with "
                                   & "content type `"
                                   & Do_SGR(Config.UBS_Opts(Colour_Info))
                                   & MTFS(I..I2)
                                   & Reset_SGR
                                   & "'");
            CT := ToUBS(MTFS(I..I2));
         end if;
         if NTFE then
            Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info))
                                   & "No content transfer encoding"
                                   & Reset_SGR);
            CTE := ToUBS("7bit");
         else
            CTE := ToUBS(Ada.Strings.Fixed.Translate(MTFES(J..J2),
                                                     Ada.Strings.Maps.Constants.Lower_Case_Map));
            Ada.Text_IO.Put_Line("Content transfer encoding is `"
                                   & Do_SGR(Config.UBS_Opts(Colour_Info))
                                   & ToStr(CTE)
                                   & Reset_SGR
                                   & "'");
         end if;
      end;
      -- Do we have to ask which viewer...?
      -- We'll short circuit this in the case of application/(x-)pkcs7-mime and smime-type.  This information would get lost in the call.
      if Ada.Strings.Fixed.Index(Ada.Strings.Fixed.Translate(ToStr(MT),
							     Ada.Strings.Maps.Constants.Lower_Case_Map),
				 "smime-type=signed-data") /= 0 then
	 Chosen := 99;
      elsif Decrypt then
         Chosen := Config.Positive_Opts(MIME_Viewer_Decrypt);
      else
         Chosen := Config.Positive_Opts(MIME_Viewer_Verify);
      end if;
      if Chosen = 1 then
         -- Ask what we should do.
         Chosen := MV_Values(MIME_Viewer_Menu2);
      end if;
      -- Actually execute the chosen viewer method.
      case Chosen is
         when 2 => -- Metamail
            Ada.Text_IO.Put_Line("Viewing attachment with metamail...");
            if ForkExec(Misc.Value_Nonempty(Config.Binary(Metamail)),
                        UBS_Array'(0 => ToUBS("metamail"),
                                   1 => ToUBS(F))) /= 0 then
               Misc.ErrorNE("metamail failed! (ff5)");
            end if;
         when 3 => -- run-mailcap
                   -- FIXME: Deal with multipart nicely.
            declare
               B  : constant String := Temp_File_Name("vmb");
               B2 : constant String := Temp_File_Name("vmb2");
               use type UBS;
            begin
               if NC then
                  Ada.Text_IO.Put_Line("Hoping that this is text/plain (no content-type!)");
               end if;
               -- Handle the transfer encoding!  If it's QP or base64,
               --  decode it!
               Externals.Mail.Extract_Body(F, B);
               if ToStr(CTE) = "quoted-printable" then
                  QP_Decode(B, B2);
                  Externals.Simple.Cat_Out(B2, B);
               elsif ToStr(CTE) = "base64" then
                  Base64_Decode(B, B2);
                  Externals.Simple.Cat_Out(B2, B);
               end if;
               Ada.Text_IO.Put_Line("Viewing attachment with run-mailcap...");
               if ForkExec(Misc.Value_Nonempty(Config.Binary(Runmailcap)),
                           UBS_Array'(0 => ToUBS("run-mailcap"),
                                      1 => CT & ToUBS(":" & B))) /= 0 then
                  Misc.ErrorNE("run-mailcap failed! (ff5)");
               end if;
            end;
         when 4 => -- Save
                   -- Write out the file to a well-known place.
            declare
               VMF : constant String := ToStr(Topal_Directory) & "/viewmime";
            begin
               Externals.Simple.Echo_Append_N("From MAILER-DAEMON ", VMF);
               Externals.Simple.Date_1_Append("+%a %b %e %H:%M:%S %Y", VMF);
               Externals.Simple.Echo_Append("From: Topal-MIME-view", VMF);
               Externals.Simple.Echo_Append_N("Date: ", VMF);
               Externals.Simple.Date_1_Append("--rfc-2822", VMF);
               Externals.Simple.Echo_Append("MIME-Version: 1.0", VMF);
               Externals.Simple.Cat_Append(F, VMF);
               Ada.Text_IO.Put_Line("Appended email to mbox "
                                    & VMF);
            end;
         when 5 => -- Skip
            Ada.Text_IO.Put_Line("Skipping attachment...");
	 when 99 => -- Invoke topal on this attachment.
	    Ada.Text_IO.Put_Line("Should run Topal on this one.");
	    Externals.Mail.Extract_Body(F, F2);
	    Dummy := Externals.Simple.System("topal -mime "
					       & F2
					       & " ""application/x-pkcs7-mime; smime-type=signed-data""");
         when others =>
            Misc.ErrorNE("Bogus value in Externals.Mail.View_MIME");
      end case;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.View_MIME");
         raise;
   end View_MIME;

   -- Base 64 decode from infile to outfile.
   -- Uses openssl internally.
   procedure Base64_Decode (Infile, Outfile : in String) is
      Dummy : Integer;
      pragma Unreferenced(Dummy);
   begin
      Dummy := ForkExec(Value_Nonempty(Config.Binary(Openssl)),
                        UBS_Array'(0 => ToUBS("openssl"),
                                   1 => ToUBS("base64"),
                                   2 => ToUBS("-d"),
                                   3 => ToUBS("-in"),
                                   4 => ToUBS(Infile),
                                   5 => ToUBS("-out"),
                                   6 => ToUBS(Outfile)));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Base64_Decode");
         raise;
   end Base64_Decode;

   -- Quoted-printable decode from infile to outfile.
   procedure QP_Decode (Infile, Outfile : in String) is
      InF  : Ada.Text_IO.File_Type;
      OutF : Character_IO.File_Type;
   begin
      -- Read, character by character, until end-of-line.
      Ada.Text_IO.Open(File => InF,
                       Mode => Ada.Text_IO.In_File,
                       Name => Infile);
      Character_IO.Create(File => OutF,
                          Mode => Character_IO.Out_File,
                          Name => Outfile);
  Decode_Loop:
      loop
         begin
            -- Simple copy.
            declare
               U       : constant UBS := Unbounded_Get_Line(InF);
               S       : constant String := ToStr(U);
               I       : Integer;
               H       : Integer;
               Need_NL : Boolean := True;
            begin
               -- Walk through S.
               -- If we see `=', then
               --  (i) it's at the end of a line: it's a soft line break, so don't output even a newline.
               --  (ii) it should be followed by two hex characters.  decode and print.
               I := S'First;
           Char_Loop:
               while I <= S'Last loop
                  if S(I) = '=' then
                     if I = S'Last then
                        -- Soft line break.
                        Need_NL := False;
                        exit Char_Loop;
                     elsif I+2 > S'Last then
                        -- Overrunning the end of a line?  Just print it.
                        Character_IO_Put(OutF, S(I..S'Last));
                        I := S'Last + 1;
                     else
                        -- Decode.
                        begin
                           H := Hex_Decode(S(I+1..I+2));
                           Character_IO.Write(OutF, Character'Val(H));
                           I := I + 3;
                        exception
                           when Constraint_Error =>
                              -- Not hex?  Ignoring it.
                              Character_IO.Write(OutF, S(I));
                              I := I + 1;
                        end;
                     end if;
                  else
                     Character_IO.Write(OutF, S(I));
                     I := I + 1;
                  end if;
               end loop Char_Loop;
               if Need_NL then
                  Character_IO.Write(OutF, Ada.Characters.Latin_1.LF);
               end if;
            end;
         exception
            when Ada.IO_Exceptions.End_Error =>
               exit Decode_Loop;
         end;
      end loop Decode_Loop;
      Ada.Text_IO.Close(File => InF);
      Character_IO.Close(File => OutF);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.QP_Decode");
         raise;
   end QP_Decode;


   -- Return SHA1 hash of infile.
   -- Uses openssl internally.
   function Hash_SHA1 (Infile : in String) return String is
      Dummy : Integer;
      pragma Unreferenced(Dummy);
      F     : constant String := Temp_File_Name("sha1");
   begin
      Dummy := ForkExec_InOut(Value_Nonempty(Config.Binary(Openssl)),
			      UBS_Array'(0 => ToUBS("openssl"),
					 1 => ToUBS("sha1")),
			      Infile,
			      F);
      return ToStr(Read_Fold(F));
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Hash_SHA1");
         raise;
   end Hash_SHA1;

   procedure Replace_Message_ID(Hdrfile  : in String;
				Alt_Sign : in String;
			        Encrypt_Message_ID : in Boolean;
			        Encrypt_Key : in String) is
      F  : constant String := Temp_File_Name("rmid");
      E1 : constant String := Temp_File_Name("emid1");
      E2 : constant String := Temp_File_Name("emid2");
      E3 : constant String := Temp_File_Name("emid3");
      EM : UBS;
      R  : String(1..8);
      ORV : Integer;
   begin
      if Encrypt_Message_ID then
	 -- Copy the message-id.
	 Externals.Mail.Formail_Concat_Extract_InOut("Message-ID:",
						     Hdrfile, 
						     E1);
	 -- Make cryptogram.
	 EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1))));
	 Externals.Simple.Echo_Out(ToStr(EM), E2);
	 ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					  & " enc -e -des3 -pass pass:"
					  & Encrypt_Key
					    & " -a -A -in "
					  & E2
					  & " -out "
					  & E3);
	 if ORV = 0 then
	    -- Only write it on success.
	    Externals.Simple.Echo_Append("X-Topal-Message-ID: " & Trim_Leading_Spaces(ToStr(Read_Fold(E3))), Hdrfile);
	 end if;
      end if;
      -- Munge and randomize the Message-ID (using sed).
      for I in R'Range loop
	 R(I) := Random_Letters.Random(Random_Letters_Generator);
      end loop;
      Externals.Simple.Sed_InOut("s/^\(Message-ID: \)<\([aA]l\)\?[pP]ine\....\..\...\.\(.*\)@\(.*\)>$/\1<\3." & R & "%" & Alt_Sign & ">/", Hdrfile, F);
      Externals.Simple.Cat_Out(F, Hdrfile);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Replace_Message_ID");
         raise;
   end Replace_Message_ID;

   procedure Replace_Content_IDs(Tmpfile  : in String;
				 Alt_Sign : in String) is
      F : constant String := Temp_File_Name("rcid");
   begin
      Externals.Simple.Sed_InOut("s/^\(Content-ID: \)<\([aA]l\)\?[pP]ine\....\..\...\.\(.*\)@\(.*\)>$/\1<\3%" & Alt_Sign & ">/", Tmpfile, F);
      Externals.Simple.Cat_Out(F, Tmpfile);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Replace_Content_IDs");
         raise;
   end Replace_Content_IDs;
   
   -- Calculate a token for an X-Topal-Send-Token header.
   function Calculate_Send_Token(Hdrfile        : in String;
				 Per_User_Token : in String) return String is
      F_Name   : constant String := Temp_File_Name("stf");
      M_Name   : constant String := Temp_File_Name("stm");
      H_Name   : constant String := Temp_File_Name("sth");
      Token    : UBS;
      use type UBS;
   begin
      -- Extract the From and Message-ID lines.
      Externals.Mail.Formail_Concat_Extract_InOut("From: ",
						  Hdrfile, 
						  F_Name);
      Externals.Mail.Formail_Concat_Extract_InOut("Message-ID: ",
						  Hdrfile, 
						  M_Name);
      -- Concatenate them with the token.
      Token := ToUBS(Per_User_Token)
	& ':'
	& Read_Fold(F_Name)
	& ':'
	& Read_Fold(M_Name);
      -- SHA1.
      -- Add the new header, X-Topal-Send-Token
      Externals.Simple.Echo_Out(ToStr(Token), H_Name);
      -- Return it.
      return Hash_SHA1(H_Name);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Calculate_Send_Token");
         raise;
   end Calculate_Send_Token;
      
   procedure Check_Send_Token(Per_User_Token : in String) is
      In_F    : constant String := Temp_File_Name("in");
      T_Name1 : constant String := Temp_File_Name("token1");
      T_Name2 : constant String := Temp_File_Name("token2");
      T_Name3 : constant String := Temp_File_Name("token3");
      T_Name4 : constant String := Temp_File_Name("token4");
      Token   : UBS;
   begin
      Externals.Simple.Cat_Stdin_Out(In_F);
      -- The token should be this:
      Token := ToUBS(Calculate_Send_Token(In_F, Per_User_Token));
      -- Get the current token.
      Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Send-Token:",
						  In_F, 
						  T_Name1);
      -- Do they match?
      if Trim_Leading_Spaces(ToStr(Read_Fold(T_Name1))) = ToStr(Token) then
	 Formail_Replace_Header(In_F, "X-Topal-Check-Send-Token: yes");
      else
	 Formail_Replace_Header(In_F, "X-Topal-Check-Send-Token: no");
      end if;
      -- Also, if an X-Topal-Message-ID is present, then see if we can
      --  calculate it as X-Topal-Original_Message-ID.
      Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Message-ID:",
						  In_F, 
						  T_Name2);
      -- FIXME: Of course, another way to do this would be to record the original and altered message-ids….
      -- Trim the leading space….
      declare
	 MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name2)));
	 D1 : constant String := Temp_File_Name("dmid1");
	 D2 : constant String := Temp_File_Name("dmid2");
	 ORV : Integer;
      begin
	 -- So we now have the string.
	 -- If it's non-empty, we'll assume it's worth decrypting.
	 if MID'Length > 0 then
	    Externals.Simple.Echo_Out(MID, D1);
	    ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					     & " enc -d -des3 -pass pass:"
					     & Per_User_Token
					     & " -a -A -in "
					     & D1
					     & " -out "
					     & D2);
	    if ORV = 0 then
	       -- Success, we'll write a new header.
	       Formail_Replace_Header(In_F,
				      "X-Topal-Original-Message-ID: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2))));
	    end if;
	 end if;
      end;
      -- Also, if an X-Topal-Fcce is present, then see if we can
      --  calculate it as X-Topal-Fcc.
      Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Fcce:",
						  In_F, 
						  T_Name3);
      -- Trim the leading space….
      declare
	 MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name3)));
	 D1 : constant String := Temp_File_Name("dmid1");
	 D2 : constant String := Temp_File_Name("dmid2");
	 ORV : Integer;
      begin
	 -- So we now have the string.
	 -- If it's non-empty, we'll assume it's worth decrypting.
	 if MID'Length > 0 then
	    Externals.Simple.Echo_Out(MID, D1);
	    ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					     & " enc -d -des3 -pass pass:"
					     & Per_User_Token
					     & " -a -A -in "
					     & D1
					     & " -out "
					     & D2);
	    if ORV = 0 then
	       -- Success, we'll write a new header.
	       Formail_Replace_Header(In_F,
				      "X-Topal-Fcc: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2))));
	    end if;
	 end if;
      end;
      -- Also, if an X-Topal-Bcce is present, then see if we can
      --  calculate it as X-Topal-Bcc.
      Externals.Mail.Formail_Extract_InOut("X-Topal-Bcce:",
					   In_F, 
					   T_Name4);
      -- Trim the leading space….
      declare
	 MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name4, Include_LF => True)));
	 D1 : constant String := Temp_File_Name("dmid1");
	 D2 : constant String := Temp_File_Name("dmid2");
	 ORV : Integer;
      begin
	 -- So we now have the string.
	 -- If it's non-empty, we'll assume it's worth decrypting.
	 if MID'Length > 0 then
	    Externals.Simple.Sed_InOut("s/^ //", T_Name4, D1);
	    ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					     & " enc -d -des3 -pass pass:"
					     & Per_User_Token
					     & " -a -in "
					     & D1
					     & " -out "
					     & D2);
	    if ORV = 0 then
	       -- Success, we'll write a new header.
	       Formail_Replace_Header(In_F,
				      "X-Topal-Bcc: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2, Include_LF => True))));
	    end if;
	 end if;
      end;
      -- Finally, write out the file (we're a filter!).
      Externals.Simple.Cat(In_F);
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Check_Send_Token");
         raise;
   end Check_Send_Token;
   
   procedure Replace_Fcc(Hdrfile     : in String;
		     Encrypt_Key : in String) is
      E1 : constant String := Temp_File_Name("efcc1");
      E2 : constant String := Temp_File_Name("efcc2");
      E3 : constant String := Temp_File_Name("efcc3");
      E4 : constant String := Temp_File_Name("efcc4");
      EM : UBS;
      ORV : Integer;
   begin
      -- Copy X-Topal-Fcc.
      Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Fcc:",
						  Hdrfile, 
						  E1);
      -- Make cryptogram.
      EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1))));
      if Ada.Strings.Unbounded.Length(EM) > 0 then
	 -- Non-empty.
	 Externals.Simple.Echo_Out(ToStr(EM), E2);
	 ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					  & " enc -e -des3 -pass pass:"
					  & Encrypt_Key
					  & " -a -A -in "
					  & E2
					  & " -out "
					  & E3);
	 if ORV = 0 then
	    -- Only write it on success.
	    Externals.Simple.Echo_Append_N("X-Topal-Fcce: " & Trim_Leading_Spaces(ToStr(Read_Fold(E3))), Hdrfile);
	    -- Remove the old header.
	    Formail_Drop_InOut(UBS_Array'(1 => ToUBS("X-Topal-Fcc:")),
			       Hdrfile,
			       E4);
	    -- This seems to leave a trailing blank line often.  We
	    --  need to remove it.
	    Externals.Simple.Rm_File(Hdrfile);
	    Delete_Trailing_Blank_Lines(E4, Hdrfile);
	 end if;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Replace_Fcc");
         raise;
   end Replace_Fcc;

   
   procedure Add_Bcc(Hdrfile     : in String;
		     Encrypt_Key : in String) is
      E1 : constant String := Temp_File_Name("ebcc1");
      E2 : constant String := Temp_File_Name("ebcc2");
      E3 : constant String := Temp_File_Name("ebcc3");
      E4 : constant String := Temp_File_Name("ebcc4");
      EM : UBS;
      ORV : Integer;
   begin
      -- Copy Bcc.
      Externals.Mail.Formail_Concat_Extract_InOut("Bcc:",
						  Hdrfile, 
						  E1);
      -- Make cryptogram.
      EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1))));
      if Ada.Strings.Unbounded.Length(EM) > 0 then
	 -- Non-empty.
	 Externals.Simple.Echo_Out(ToStr(EM), E2);
	 ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl)))
					  & " enc -e -des3 -pass pass:"
					  & Encrypt_Key
					  -- Note that we allow folding!
					  -- No -A!
					  & " -a -in "
					  & E2
					  & " -out "
					  & E3);
	 if ORV = 0 then
	    -- Only write it on success.
	    Externals.Simple.Echo_Append_N("X-Topal-Bcce: ", Hdrfile);
	    -- Prefix each line other than the first with a space.
	    Externals.Simple.Sed_InOut("1! s/^/ /", E3, E4);
	    Externals.Simple.Cat_Append(E4, Hdrfile);
	    -- Mustn't remove Bcc!
	 end if;
      end if;
   exception
      when others =>
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
                              "Exception raised in Externals.Mail.Add_Bcc");
         raise;
   end Add_Bcc;

begin
   Random_Letters.Reset(Random_Letters_Generator);
end Externals.Mail;