← Back to branch summary

~ubuntu-branches/ubuntu/precise/topal/precise

« back to all changes in this revision

Viewing changes to sending-encrypt.adb

  • Committer: Bazaar Package Importer
  • Author(s): Phil Brooke
  • Date: 2011-07-04 12:25:03 UTC
  • mfrom: (1.2.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20110704122503-sxyon0imhkllayz2
Tags: 74-1
* New upstream release.
* Bump standards-version to 3.9.2.
* Upstream documentation changes:
   * No longer need weblint.
   * Uses some texlive packages instead.
   * Remove LaTeX aux files in clean target.
   * Updated debian/docs.
   * Rename and convert Changelog.html to text.
* Added build-arch and build-indep targets.

Show diffs side-by-side

added added

removed removed

Lines of Context:
sending-encrypt.adb
 
1
-- Topal: GPG/GnuPG and Alpine/Pine integration
 
2
-- Copyright (C) 2001--2011  Phillip J. Brooke
 
3
--
 
4
-- This program is free software: you can redistribute it and/or modify
 
5
-- it under the terms of the GNU General Public License version 3 as
 
6
-- published by the Free Software Foundation.
 
7
--
 
8
-- This program is distributed in the hope that it will be useful,
 
9
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
-- GNU General Public License for more details.
 
12
--
 
13
-- You should have received a copy of the GNU General Public License
 
14
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
15
 
 
16
separate(Sending)
 
17
procedure Encrypt (Tmpfile   : in String;
 
18
                   Non_Pine  : in Boolean;
 
19
                   Mime      : in Boolean;
 
20
                   Mimefile  : in String;
 
21
                   Send_Keys : in Keys.Key_List;
 
22
                   Selection : in Send_Modes;
 
23
                   Mime_Selection : in MIME_Modes;
 
24
                   AL        : in Attachments.Attachment_List;
 
25
                   Hdrfile   : in String;
 
26
                   Recipients : in UBS_Array;
 
27
                   Actual_Send : in Boolean;
 
28
                   New_Headers : out UVV) is
 
29
   Out_File       : constant String := Temp_File_Name("out");
 
30
   SFD_File       : constant String := Temp_File_Name("sfd");
 
31
   -- PCT = Prepend content-type.
 
32
begin
 
33
   if Mime then
 
34
      begin
 
35
         Ada.Text_IO.New_Line(3);
 
36
         if Mime_Selection = Multipart 
 
37
           or Mime_Selection = SMIME then
 
38
            declare
 
39
               PCT : constant String := Temp_File_Name("pct");
 
40
            begin
 
41
               Echo_Out("Content-Type: " & The_Content_Type(Hdrfile, Actual_Send), PCT);
 
42
               Echo_Append("", PCT);
 
43
               Cat_Append(Tmpfile, PCT);
 
44
               Mv_F(PCT, Tmpfile);
 
45
               -- Call out to attachments in case we have to modify Tmpfile.
 
46
               Attachments.Replace_Tmpfile(Tmpfile, AL);
 
47
            end;
 
48
         end if;
 
49
      exception
 
50
         when others =>
 
51
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
52
                                 "Exception raised in Sending.Encrypt (MIME block 1)");
 
53
            raise;
 
54
      end;
 
55
   end if;
 
56
 
 
57
   begin
 
58
      if Mime_Selection = SMIME then
 
59
         -- Run GPG.
 
60
         Externals.GPG.GPGSM_Wrap_Encrypt(Out_File,
 
61
                                          SFD_File,
 
62
                                          Tmpfile,
 
63
                                          Send_Keys);
 
64
      else
 
65
         -- Run GPG.
 
66
         Externals.GPG.GPG_Wrap(" --armor --encrypt "
 
67
                                  & " "
 
68
                                  & " --output "
 
69
                                  & Out_File
 
70
                                  & " "
 
71
                                  & Keys.Processed_Recipient_List(Send_Keys)
 
72
                                  & " "
 
73
                                  & Tmpfile,
 
74
                                Out_File,
 
75
                                SFD_File);
 
76
      end if;
 
77
   exception
 
78
      when others =>
 
79
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
80
                              "Exception raised in Sending.Encrypt (GPG block)");
 
81
         raise;
 
82
   end;
 
83
 
 
84
   begin
 
85
      if Selection = EncryptPO then
 
86
         -- Rename the file appropriately.
 
87
         Mv_F(Out_File, Tmpfile & ".asc");
 
88
      elsif Mime_Selection /= SMIME then
 
89
         -- See later coments in S/MIME bit.  Really, we'd like to
 
90
         --  just send Out_File as Tmpfile for that case, too, but we
 
91
         --  need to wrap it as a multipart/mixed file.
 
92
         Mv_F(Out_File, Tmpfile);
 
93
      end if;
 
94
   exception
 
95
      when others =>
 
96
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
97
                              "Exception raised in Sending.Encrypt (mv block)");
 
98
         raise;
 
99
   end;
 
100
 
 
101
   if Mime then
 
102
      begin
 
103
         case Mime_Selection is
 
104
            when InlinePlain => -- Inline plain text
 
105
               Echo_Out("Content-Type: text/plain",
 
106
                        Mimefile);
 
107
               New_Headers.Append(ToUBS("Content-Type: text/plain"));
 
108
            when AppPGP => -- application/pgp
 
109
               Echo_Out_N("Content-Type: application/pgp; format=text; x-action=encrypt ",
 
110
                          Mimefile);
 
111
               New_Headers.Append(ToUBS("Content-Type: application/pgp; format=text; x-action=encrypt "));
 
112
            when Multipart => -- RFC2015 multipart
 
113
                              -- This is the nasty one.
 
114
               declare
 
115
                  Blk1   : constant String := Temp_File_Name("mp1");
 
116
                  Blk2   : constant String := Temp_File_Name("mp2");
 
117
                  MC     : constant String := Temp_File_Name("mc");
 
118
               begin
 
119
                  -- We first create the two blocks.
 
120
                  -- The first block is easy:
 
121
                  Echo_Out("Content-Type: application/pgp-encrypted",
 
122
                           Blk1);
 
123
                  Echo_Append("", Blk1);
 
124
                  Echo_Append("Version: 1", Blk1);
 
125
                  -- The second block starts with a
 
126
                  -- content-type, then is the tmpfile we've
 
127
                  -- put together.
 
128
                  Echo_Out("Content-Type: application/octet-stream",
 
129
                           Blk2);
 
130
                  Echo_Append("Content-Disposition: attachment; filename=""message.asc""", Blk2);
 
131
                  Echo_Append("", Blk2);
 
132
                  Cat_Append(Tmpfile, Blk2);
 
133
                  -- Now we put them together.
 
134
                  Externals.Mail.Mimeconstruct2(Part1_Filename  => Blk1,
 
135
                                                Part2_Filename  => Blk2,
 
136
                                                Output_Filename => MC,
 
137
                                                Content_Type    => "multipart/encrypted; protocol=""application/pgp-encrypted""",
 
138
                                                Prolog          => "This is an OpenPGP/MIME encrypted message (RFC2440, RFC3156).");
 
139
                  -- Now we need to split these up.
 
140
                  Mail.Extract_Content_Type_From_Header(MC, Mimefile);
 
141
                  New_Headers.Append(Read_Fold(Mimefile));
 
142
                  Mail.Extract_Body(MC, Tmpfile);
 
143
               end;
 
144
            when MultipartEncap =>
 
145
               Error("Menu should not have allowed MultipartEncap here");
 
146
            when SMIME =>
 
147
               -- At this point, we've got Out_File.  We want it to be
 
148
               --  CTE b64 and "Content-Type: application/pkcs7-mime;
 
149
               --  smime-type=enveloped-data; name=""smime.p7m".
 
150
               -- So we produce a single multipart mixed blob instead.
 
151
               declare
 
152
                  MM   : constant String := Temp_File_Name("mm");
 
153
                  MM2  : constant String := Temp_File_Name("mm2");
 
154
               begin
 
155
                  if Actual_Send then
 
156
                     New_Headers.Append(ToUBS("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m"""));
 
157
                     New_Headers.Append(ToUBS("Content-Transfer-Encoding: base64"));
 
158
                     New_Headers.Append(ToUBS("Content-Disposition: attachment; filename=""smime.p7m"""));
 
159
                     New_Headers.Append(ToUBS("Content-Description: S/MIME cryptographically encrypted message"));
 
160
                     Externals.Simple.Mv_F(Out_File, Tmpfile);
 
161
                  else
 
162
                     Echo_Out("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""",
 
163
                              MM);
 
164
                     Echo_Append("Content-Transfer-Encoding: base64",
 
165
                                 MM);
 
166
                     Echo_Append("Content-Disposition: attachment; filename=""smime.p7m""",
 
167
                                 MM);
 
168
                     Echo_Append("Content-Description: S/MIME cryptographically encrypted message",
 
169
                                 MM);
 
170
                     Echo_Append("", MM);
 
171
                     Cat_Append(Out_File, MM);
 
172
                     Mail.Mimeconstruct_Mixed(UBS_Array'(1 => ToUBS(MM)),
 
173
                                              MM2);
 
174
                     Mail.Extract_Content_Type_From_Header(MM2, Mimefile);
 
175
                     New_Headers.Append(Read_Fold(Mimefile));
 
176
                     Mail.Extract_Body(MM2, Tmpfile);
 
177
                  end if;
 
178
               end;
 
179
         end case;
 
180
      exception
 
181
         when others =>
 
182
            Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
183
                                 "Exception raised in Sending.Encrypt (MIME block 2)");
 
184
            raise;
 
185
      end;
 
186
   end if;
 
187
   
 
188
   if not Actual_Send then
 
189
      Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients);
 
190
   end if;
 
191
 
 
192
exception
 
193
   when others =>
 
194
      Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
 
195
                           "Exception raised in Sending.Encrypt");
 
196
      raise;
 
197
end Encrypt;
 
198