diff options
Diffstat (limited to 'rt/lib/RT/Interface/Email/Auth/GnuPG.pm')
| -rwxr-xr-x | rt/lib/RT/Interface/Email/Auth/GnuPG.pm | 263 |
1 files changed, 263 insertions, 0 deletions
diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm new file mode 100755 index 000000000..f0fe2c917 --- /dev/null +++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm @@ -0,0 +1,263 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work 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, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Interface::Email::Auth::GnuPG; + +use strict; +use warnings; + +=head2 GetCurrentUser + +To use the gnupg-secured mail gateway, you need to do the following: + +Set up a GnuPG key directory with a pubring containing only the keys +you care about and specify the following in your SiteConfig.pm + + Set(%GnuPGOptions, homedir => '/opt/rt3/var/data/GnuPG'); + Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...); + +=cut + +sub ApplyBeforeDecode { return 1 } + +use RT::Crypt::GnuPG; +use RT::EmailParser (); + +sub GetCurrentUser { + my %args = ( + Message => undef, + RawMessageRef => undef, + @_ + ); + + foreach my $p ( $args{'Message'}->parts_DFS ) { + $p->head->delete($_) for qw( + X-RT-GnuPG-Status X-RT-Incoming-Encrypton + X-RT-Incoming-Signature X-RT-Privacy + ); + } + + my $msg = $args{'Message'}->dup; + + my ($status, @res) = VerifyDecrypt( + Entity => $args{'Message'}, AddStatus => 1, + ); + if ( $status && !@res ) { + $args{'Message'}->head->add( + 'X-RT-Incoming-Encryption' => 'Not encrypted' + ); + + return 1; + } + + # FIXME: Check if the message is encrypted to the address of + # _this_ queue. send rejecting mail otherwise. + + unless ( $status ) { + $RT::Logger->error("Had a problem during decrypting and verifying"); + my $reject = HandleErrors( Message => $args{'Message'}, Result => \@res ); + return (0, 'rejected because of problems during decrypting and verifying') + if $reject; + } + + # attach the original encrypted message + $args{'Message'}->attach( + Type => 'application/x-rt-original-message', + Disposition => 'inline', + Data => ${ $args{'RawMessageRef'} }, + ); + + $args{'Message'}->head->add( 'X-RT-Privacy' => 'PGP' ); + + foreach my $part ( $args{'Message'}->parts_DFS ) { + my $decrypted; + + my $status = $part->head->get( 'X-RT-GnuPG-Status' ); + if ( $status ) { + for ( RT::Crypt::GnuPG::ParseStatus( $status ) ) { + if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) { + $decrypted = 1; + } + if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) { + $part->head->add( + 'X-RT-Incoming-Signature' => $_->{UserString} + ); + } + } + } + + $part->head->add( + 'X-RT-Incoming-Encryption' => + $decrypted ? 'Success' : 'Not encrypted' + ); + } + + return 1; +} + +sub HandleErrors { + my %args = ( + Message => undef, + Result => [], + @_ + ); + + my $reject = 0; + + my %sent_once = (); + foreach my $run ( @{ $args{'Result'} } ) { + my @status = RT::Crypt::GnuPG::ParseStatus( $run->{'status'} ); + unless ( $sent_once{'NoPrivateKey'} ) { + unless ( CheckNoPrivateKey( Message => $args{'Message'}, Status => \@status ) ) { + $sent_once{'NoPrivateKey'}++; + $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnMissingPrivateKey'}; + } + } + unless ( $sent_once{'BadData'} ) { + unless ( CheckBadData( Message => $args{'Message'}, Status => \@status ) ) { + $sent_once{'BadData'}++; + $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnBadData'}; + } + } + } + return $reject; +} + +sub CheckNoPrivateKey { + my %args = (Message => undef, Status => [], @_ ); + my @status = @{ $args{'Status'} }; + + my @decrypts = grep $_->{'Operation'} eq 'Decrypt', @status; + return 1 unless @decrypts; + foreach my $action ( @decrypts ) { + # if at least one secrete key exist then it's another error + return 1 if + grep !$_->{'User'}{'SecretKeyMissing'}, + @{ $action->{'EncryptedTo'} }; + } + + $RT::Logger->error("Couldn't decrypt a message: have no private key"); + + my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0]; + my ($status) = RT::Interface::Email::SendEmailUsingTemplate( + To => $address, + Template => 'Error: no private key', + Arguments => { + Message => $args{'Message'}, + TicketObj => $args{'Ticket'}, + }, + InReplyTo => $args{'Message'}, + ); + unless ( $status ) { + $RT::Logger->error("Couldn't send 'Error: no private key'"); + } + return 0; +} + +sub CheckBadData { + my %args = (Message => undef, Status => [], @_ ); + my @bad_data_messages = + map $_->{'Message'}, + grep $_->{'Status'} ne 'DONE' && $_->{'Operation'} eq 'Data', + @{ $args{'Status'} }; + return 1 unless @bad_data_messages; + + $RT::Logger->error("Couldn't process a message: ". join ', ', @bad_data_messages ); + + my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0]; + my ($status) = RT::Interface::Email::SendEmailUsingTemplate( + To => $address, + Template => 'Error: bad GnuPG data', + Arguments => { + Messages => [ @bad_data_messages ], + TicketObj => $args{'Ticket'}, + }, + InReplyTo => $args{'Message'}, + ); + unless ( $status ) { + $RT::Logger->error("Couldn't send 'Error: bad GnuPG data'"); + } + return 0; +} + +sub VerifyDecrypt { + my %args = ( + Entity => undef, + @_ + ); + + my @res = RT::Crypt::GnuPG::VerifyDecrypt( %args ); + unless ( @res ) { + $RT::Logger->debug("No more encrypted/signed parts"); + return 1; + } + + $RT::Logger->debug('Found GnuPG protected parts'); + + # return on any error + if ( grep $_->{'exit_code'}, @res ) { + $RT::Logger->debug("Error during verify/decrypt operation"); + return (0, @res); + } + + # nesting + my ($status, @nested) = VerifyDecrypt( %args ); + return $status, @res, @nested; +} + +eval "require RT::Interface::Email::Auth::GnuPG_Vendor"; +die $@ + if ( $@ + && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/GnuPG_Vendor.pm} ); +eval "require RT::Interface::Email::Auth::GnuPG_Local"; +die $@ + if ( $@ + && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/GnuPG_Local.pm} ); + +1; + |