Master to 4.2.8
[usit-rt.git] / lib / RT / Interface / Email / Auth / Crypt.pm
CommitLineData
af59614d
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
af59614d
MKG
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
13# This work is made available to you under the terms of Version 2 of
14# the GNU General Public License. A copy of that license should have
15# been provided with this software, but in any event can be snarfed
16# from www.gnu.org.
17#
18# This work is distributed in the hope that it will be useful, but
19# WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21# General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26# 02110-1301 or visit their web page on the internet at
27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
32# (The following paragraph is not intended to limit the rights granted
33# to you to modify and distribute this software under the terms of
34# the GNU General Public License and is only of importance to you if
35# you choose to contribute your changes and enhancements to the
36# community by submitting them to Best Practical Solutions, LLC.)
37#
38# By intentionally submitting any modifications, corrections or
39# derivatives to this work, or any other work intended for use with
40# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41# you are the copyright holder for those contributions and you grant
42# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43# royalty-free, perpetual, license to use, copy, create derivative
44# works based on those contributions, and sublicense and distribute
45# those contributions and any derivatives thereof.
46#
47# END BPS TAGGED BLOCK }}}
48
49package RT::Interface::Email::Auth::Crypt;
50
51use strict;
52use warnings;
53
54=head1 NAME
55
56RT::Interface::Email::Auth::Crypt - decrypting and verifying protected emails
57
58=head2 DESCRIPTION
59
60This mail plugin decrypts and verifies incoming emails. Supported
61encryption protocols are GnuPG and SMIME.
62
63This code is independant from code that encrypts/sign outgoing emails, so
64it's possible to decrypt data without bringing in encryption. To enable
65it put the module in the mail plugins list:
66
67 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filters...);
68
c33a4027
MKG
69C<Auth::Crypt> will not function without C<Auth::MailFrom> listed before
70it.
71
af59614d
MKG
72=head3 GnuPG
73
74To use the gnupg-secured mail gateway, you need to do the following:
75
76Set up a GnuPG key directory with a pubring containing only the keys
77you care about and specify the following in your SiteConfig.pm
78
79 Set(%GnuPGOptions, homedir => '/opt/rt4/var/data/GnuPG');
80
81Read also: L<RT::Crypt> and L<RT::Crypt::GnuPG>.
82
83=head3 SMIME
84
85To use the SMIME-secured mail gateway, you need to do the following:
86
87Set up a SMIME key directory with files containing keys for queues'
88addresses and specify the following in your SiteConfig.pm
89
90 Set(%SMIME,
91 Enable => 1,
92 OpenSSL => '/usr/bin/openssl',
93 Keyring => '/opt/rt4/var/data/smime',
94 CAPath => '/opt/rt4/var/data/smime/signing-ca.pem',
95 Passphrase => {
96 'queue.address@example.com' => 'passphrase',
97 '' => 'fallback',
98 },
99 );
100
101Read also: L<RT::Crypt> and L<RT::Crypt::SMIME>.
102
103=cut
104
105sub ApplyBeforeDecode { return 1 }
106
107use RT::Crypt;
108use RT::EmailParser ();
109
110sub GetCurrentUser {
111 my %args = (
112 Message => undef,
113 RawMessageRef => undef,
114 Queue => undef,
115 Actions => undef,
116 @_
117 );
118
119 # we clean all possible headers
120 my @headers =
121 qw(
122 X-RT-Incoming-Encryption
123 X-RT-Incoming-Signature X-RT-Privacy
124 X-RT-Sign X-RT-Encrypt
125 ),
126 map "X-RT-$_-Status", RT::Crypt->Protocols;
127 foreach my $p ( $args{'Message'}->parts_DFS ) {
128 $p->head->delete($_) for @headers;
129 }
130
131 my (@res) = RT::Crypt->VerifyDecrypt(
132 %args,
133 Entity => $args{'Message'},
134 );
135 if ( !@res ) {
136 if (RT->Config->Get('Crypt')->{'RejectOnUnencrypted'}) {
137 EmailErrorToSender(
138 %args,
139 Template => 'Error: unencrypted message',
140 Arguments => { Message => $args{'Message'} },
141 );
142 return (-1, 'rejected because the message is unencrypted with RejectOnUnencrypted enabled');
143 }
144 else {
145 $args{'Message'}->head->replace(
146 'X-RT-Incoming-Encryption' => 'Not encrypted'
147 );
148 }
149 return 1;
150 }
151
152 if ( grep {$_->{'exit_code'}} @res ) {
153 my @fail = grep {$_->{status}{Status} ne "DONE"}
154 map { my %ret = %{$_}; map {+{%ret, status => $_}} RT::Crypt->ParseStatus( Protocol => $_->{Protocol}, Status => $_->{status})}
155 @res;
156 for my $fail ( @fail ) {
157 $RT::Logger->warning("Failure during ".$fail->{Protocol}." ". lc($fail->{status}{Operation}) . ": ". $fail->{status}{Message});
158 }
159 my $reject = HandleErrors( Message => $args{'Message'}, Result => \@res );
160 return (0, 'rejected because of problems during decrypting and verifying')
161 if $reject;
162 }
163
164 # attach the original encrypted message
165 $args{'Message'}->attach(
166 Type => 'application/x-rt-original-message',
167 Disposition => 'inline',
168 Data => ${ $args{'RawMessageRef'} },
169 );
170
171 my @found;
172 my @check_protocols = RT::Crypt->EnabledOnIncoming;
173 foreach my $part ( $args{'Message'}->parts_DFS ) {
174 my $decrypted;
175
176 foreach my $protocol ( @check_protocols ) {
177 my @status = grep defined && length,
c33a4027 178 map Encode::decode( "UTF-8", $_), $part->head->get( "X-RT-$protocol-Status" );
af59614d
MKG
179 next unless @status;
180
181 push @found, $protocol;
182
183 for ( map RT::Crypt->ParseStatus( Protocol => $protocol, Status => "$_" ), @status ) {
184 if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) {
185 $decrypted = 1;
186 }
187 if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) {
188 $part->head->replace(
c33a4027 189 'X-RT-Incoming-Signature' => Encode::encode( "UTF-8", $_->{UserString} )
af59614d
MKG
190 );
191 }
192 }
193 }
194
195 $part->head->replace(
c33a4027 196 'X-RT-Incoming-Encryption' =>
af59614d
MKG
197 $decrypted ? 'Success' : 'Not encrypted'
198 );
199 }
200
201 my %seen;
c33a4027 202 $args{'Message'}->head->replace( 'X-RT-Privacy' => Encode::encode( "UTF-8", $_ ) )
af59614d
MKG
203 foreach grep !$seen{$_}++, @found;
204
205 return 1;
206}
207
208sub HandleErrors {
209 my %args = (
210 Message => undef,
211 Result => [],
212 @_
213 );
214
215 my $reject = 0;
216
217 my %sent_once = ();
218 foreach my $run ( @{ $args{'Result'} } ) {
219 my @status = RT::Crypt->ParseStatus( Protocol => $run->{'Protocol'}, Status => $run->{'status'} );
220 unless ( $sent_once{'NoPrivateKey'} ) {
221 unless ( CheckNoPrivateKey( Message => $args{'Message'}, Status => \@status ) ) {
222 $sent_once{'NoPrivateKey'}++;
223 $reject = 1 if RT->Config->Get('Crypt')->{'RejectOnMissingPrivateKey'};
224 }
225 }
226 unless ( $sent_once{'BadData'} ) {
227 unless ( CheckBadData( Message => $args{'Message'}, Status => \@status ) ) {
228 $sent_once{'BadData'}++;
229 $reject = 1 if RT->Config->Get('Crypt')->{'RejectOnBadData'};
230 }
231 }
232 }
233 return $reject;
234}
235
236sub CheckNoPrivateKey {
237 my %args = (Message => undef, Status => [], @_ );
238 my @status = @{ $args{'Status'} };
239
240 my @decrypts = grep $_->{'Operation'} eq 'Decrypt', @status;
241 return 1 unless @decrypts;
242 foreach my $action ( @decrypts ) {
243 # if at least one secrete key exist then it's another error
244 return 1 if
245 grep !$_->{'User'}{'SecretKeyMissing'},
246 @{ $action->{'EncryptedTo'} };
247 }
248
249 $RT::Logger->error("Couldn't decrypt a message: have no private key");
250
251 return EmailErrorToSender(
252 %args,
253 Template => 'Error: no private key',
254 Arguments => { Message => $args{'Message'} },
255 );
256}
257
258sub CheckBadData {
259 my %args = (Message => undef, Status => [], @_ );
260 my @bad_data_messages =
261 map $_->{'Message'},
262 grep $_->{'Status'} ne 'DONE' && $_->{'Operation'} eq 'Data',
263 @{ $args{'Status'} };
264 return 1 unless @bad_data_messages;
265
266 return EmailErrorToSender(
267 %args,
268 Template => 'Error: bad encrypted data',
269 Arguments => { Messages => [ @bad_data_messages ] },
270 );
271}
272
273sub EmailErrorToSender {
274 my %args = (@_);
275
276 $args{'Arguments'} ||= {};
277 $args{'Arguments'}{'TicketObj'} ||= $args{'Ticket'};
278
279 my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0];
280 my ($status) = RT::Interface::Email::SendEmailUsingTemplate(
281 To => $address,
282 Template => $args{'Template'},
283 Arguments => $args{'Arguments'},
284 InReplyTo => $args{'Message'},
285 );
286 unless ( $status ) {
287 $RT::Logger->error("Couldn't send '$args{'Template'}''");
288 }
289 return 0;
290}
291
292RT::Base->_ImportOverlays();
293
2941;