-- 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 . separate(Sending) procedure Encrypt (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Send_Keys : in Keys.Key_List; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV) is Out_File : constant String := Temp_File_Name("out"); SFD_File : constant String := Temp_File_Name("sfd"); -- PCT = Prepend content-type. begin if Mime then begin Ada.Text_IO.New_Line(3); if Mime_Selection = Multipart or Mime_Selection = SMIME then declare PCT : constant String := Temp_File_Name("pct"); begin Echo_Out("Content-Type: " & The_Content_Type(Hdrfile, Actual_Send), PCT); Echo_Append("", PCT); Cat_Append(Tmpfile, PCT); Mv_F(PCT, Tmpfile); -- Call out to attachments in case we have to modify Tmpfile. Attachments.Replace_Tmpfile(Tmpfile, AL); end; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (MIME block 1)"); raise; end; end if; begin if Mime_Selection = SMIME then -- Run GPG. Externals.GPG.GPGSM_Wrap_Encrypt(Out_File, SFD_File, Tmpfile, Send_Keys); else -- Run GPG. Externals.GPG.GPG_Wrap(" --armor --encrypt " & " " & " --output " & Out_File & " " & Keys.Processed_Recipient_List(Send_Keys) & " " & Tmpfile, Out_File, SFD_File); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (GPG block)"); raise; end; begin if Selection = EncryptPO then -- Rename the file appropriately. Mv_F(Out_File, Tmpfile & ".asc"); elsif Mime_Selection /= SMIME then -- See later coments in S/MIME bit. Really, we'd like to -- just send Out_File as Tmpfile for that case, too, but we -- need to wrap it as a multipart/mixed file. Mv_F(Out_File, Tmpfile); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (mv block)"); raise; end; if Mime then begin case Mime_Selection is when InlinePlain => -- Inline plain text Echo_Out("Content-Type: text/plain", Mimefile); New_Headers.Append(ToUBS("Content-Type: text/plain")); when AppPGP => -- application/pgp Echo_Out_N("Content-Type: application/pgp; format=text; x-action=encrypt ", Mimefile); New_Headers.Append(ToUBS("Content-Type: application/pgp; format=text; x-action=encrypt ")); when Multipart => -- RFC2015 multipart -- This is the nasty one. declare Blk1 : constant String := Temp_File_Name("mp1"); Blk2 : constant String := Temp_File_Name("mp2"); MC : constant String := Temp_File_Name("mc"); begin -- We first create the two blocks. -- The first block is easy: Echo_Out("Content-Type: application/pgp-encrypted", Blk1); Echo_Append("", Blk1); Echo_Append("Version: 1", Blk1); -- The second block starts with a -- content-type, then is the tmpfile we've -- put together. Echo_Out("Content-Type: application/octet-stream", Blk2); Echo_Append("Content-Disposition: attachment; filename=""message.asc""", Blk2); Echo_Append("", Blk2); Cat_Append(Tmpfile, Blk2); -- Now we put them together. Externals.Mail.Mimeconstruct2(Part1_Filename => Blk1, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/encrypted; protocol=""application/pgp-encrypted""", Prolog => "This is an OpenPGP/MIME encrypted message (RFC2440, RFC3156)."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; when MultipartEncap => Error("Menu should not have allowed MultipartEncap here"); when SMIME => -- At this point, we've got Out_File. We want it to be -- CTE b64 and "Content-Type: application/pkcs7-mime; -- smime-type=enveloped-data; name=""smime.p7m". -- So we produce a single multipart mixed blob instead. declare MM : constant String := Temp_File_Name("mm"); MM2 : constant String := Temp_File_Name("mm2"); begin if Actual_Send then New_Headers.Append(ToUBS("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""")); New_Headers.Append(ToUBS("Content-Transfer-Encoding: base64")); New_Headers.Append(ToUBS("Content-Disposition: attachment; filename=""smime.p7m""")); New_Headers.Append(ToUBS("Content-Description: S/MIME cryptographically encrypted message")); Externals.Simple.Mv_F(Out_File, Tmpfile); else Echo_Out("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""", MM); Echo_Append("Content-Transfer-Encoding: base64", MM); Echo_Append("Content-Disposition: attachment; filename=""smime.p7m""", MM); Echo_Append("Content-Description: S/MIME cryptographically encrypted message", MM); Echo_Append("", MM); Cat_Append(Out_File, MM); Mail.Mimeconstruct_Mixed(UBS_Array'(1 => ToUBS(MM)), MM2); Mail.Extract_Content_Type_From_Header(MM2, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MM2, Tmpfile); end if; end; end case; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (MIME block 2)"); raise; end; end if; if not Actual_Send then Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt"); raise; end Encrypt;