Upgrade to 4.0.8 with modification of ExternalAuth.
[usit-rt.git] / lib / RT / Interface / Email / Auth / GnuPG.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
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::GnuPG;
50
51use strict;
52use warnings;
53
54=head2 GetCurrentUser
55
56To use the gnupg-secured mail gateway, you need to do the following:
57
58Set up a GnuPG key directory with a pubring containing only the keys
59you care about and specify the following in your SiteConfig.pm
60
61 Set(%GnuPGOptions, homedir => '/opt/rt4/var/data/GnuPG');
62 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
63
64=cut
65
66sub ApplyBeforeDecode { return 1 }
67
68use RT::Crypt::GnuPG;
69use RT::EmailParser ();
70
71sub GetCurrentUser {
72 my %args = (
73 Message => undef,
74 RawMessageRef => undef,
75 @_
76 );
77
78 foreach my $p ( $args{'Message'}->parts_DFS ) {
79 $p->head->delete($_) for qw(
86404187 80 X-RT-GnuPG-Status X-RT-Incoming-Encryption
84fb5b46 81 X-RT-Incoming-Signature X-RT-Privacy
86404187 82 X-RT-Sign X-RT-Encrypt
84fb5b46
MKG
83 );
84 }
85
86 my $msg = $args{'Message'}->dup;
87
88 my ($status, @res) = VerifyDecrypt(
89 Entity => $args{'Message'}, AddStatus => 1,
90 );
91 if ( $status && !@res ) {
92 $args{'Message'}->head->replace(
93 'X-RT-Incoming-Encryption' => 'Not encrypted'
94 );
95
96 return 1;
97 }
98
99 # FIXME: Check if the message is encrypted to the address of
100 # _this_ queue. send rejecting mail otherwise.
101
102 unless ( $status ) {
103 $RT::Logger->error("Had a problem during decrypting and verifying");
104 my $reject = HandleErrors( Message => $args{'Message'}, Result => \@res );
105 return (0, 'rejected because of problems during decrypting and verifying')
106 if $reject;
107 }
108
109 # attach the original encrypted message
110 $args{'Message'}->attach(
111 Type => 'application/x-rt-original-message',
112 Disposition => 'inline',
113 Data => ${ $args{'RawMessageRef'} },
114 );
115
116 $args{'Message'}->head->replace( 'X-RT-Privacy' => 'PGP' );
117
118 foreach my $part ( $args{'Message'}->parts_DFS ) {
119 my $decrypted;
120
121 my $status = $part->head->get( 'X-RT-GnuPG-Status' );
122 if ( $status ) {
123 for ( RT::Crypt::GnuPG::ParseStatus( $status ) ) {
124 if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) {
125 $decrypted = 1;
126 }
127 if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) {
128 $part->head->replace(
129 'X-RT-Incoming-Signature' => $_->{UserString}
130 );
131 }
132 }
133 }
134
135 $part->head->replace(
136 'X-RT-Incoming-Encryption' =>
137 $decrypted ? 'Success' : 'Not encrypted'
138 );
139 }
140
141 return 1;
142}
143
144sub HandleErrors {
145 my %args = (
146 Message => undef,
147 Result => [],
148 @_
149 );
150
151 my $reject = 0;
152
153 my %sent_once = ();
154 foreach my $run ( @{ $args{'Result'} } ) {
155 my @status = RT::Crypt::GnuPG::ParseStatus( $run->{'status'} );
156 unless ( $sent_once{'NoPrivateKey'} ) {
157 unless ( CheckNoPrivateKey( Message => $args{'Message'}, Status => \@status ) ) {
158 $sent_once{'NoPrivateKey'}++;
159 $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnMissingPrivateKey'};
160 }
161 }
162 unless ( $sent_once{'BadData'} ) {
163 unless ( CheckBadData( Message => $args{'Message'}, Status => \@status ) ) {
164 $sent_once{'BadData'}++;
165 $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnBadData'};
166 }
167 }
168 }
169 return $reject;
170}
171
172sub CheckNoPrivateKey {
173 my %args = (Message => undef, Status => [], @_ );
174 my @status = @{ $args{'Status'} };
175
176 my @decrypts = grep $_->{'Operation'} eq 'Decrypt', @status;
177 return 1 unless @decrypts;
178 foreach my $action ( @decrypts ) {
179 # if at least one secrete key exist then it's another error
180 return 1 if
181 grep !$_->{'User'}{'SecretKeyMissing'},
182 @{ $action->{'EncryptedTo'} };
183 }
184
185 $RT::Logger->error("Couldn't decrypt a message: have no private key");
186
187 my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0];
188 my ($status) = RT::Interface::Email::SendEmailUsingTemplate(
189 To => $address,
190 Template => 'Error: no private key',
191 Arguments => {
192 Message => $args{'Message'},
193 TicketObj => $args{'Ticket'},
194 },
195 InReplyTo => $args{'Message'},
196 );
197 unless ( $status ) {
198 $RT::Logger->error("Couldn't send 'Error: no private key'");
199 }
200 return 0;
201}
202
203sub CheckBadData {
204 my %args = (Message => undef, Status => [], @_ );
205 my @bad_data_messages =
206 map $_->{'Message'},
207 grep $_->{'Status'} ne 'DONE' && $_->{'Operation'} eq 'Data',
208 @{ $args{'Status'} };
209 return 1 unless @bad_data_messages;
210
211 $RT::Logger->error("Couldn't process a message: ". join ', ', @bad_data_messages );
212
213 my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0];
214 my ($status) = RT::Interface::Email::SendEmailUsingTemplate(
215 To => $address,
216 Template => 'Error: bad GnuPG data',
217 Arguments => {
218 Messages => [ @bad_data_messages ],
219 TicketObj => $args{'Ticket'},
220 },
221 InReplyTo => $args{'Message'},
222 );
223 unless ( $status ) {
224 $RT::Logger->error("Couldn't send 'Error: bad GnuPG data'");
225 }
226 return 0;
227}
228
229sub VerifyDecrypt {
230 my %args = (
231 Entity => undef,
232 @_
233 );
234
235 my @res = RT::Crypt::GnuPG::VerifyDecrypt( %args );
236 unless ( @res ) {
237 $RT::Logger->debug("No more encrypted/signed parts");
238 return 1;
239 }
240
241 $RT::Logger->debug('Found GnuPG protected parts');
242
243 # return on any error
244 if ( grep $_->{'exit_code'}, @res ) {
245 $RT::Logger->debug("Error during verify/decrypt operation");
246 return (0, @res);
247 }
248
249 # nesting
250 my ($status, @nested) = VerifyDecrypt( %args );
251 return $status, @res, @nested;
252}
253
254RT::Base->_ImportOverlays();
255
2561;
257