diff options
Diffstat (limited to 'rt/lib/RT/Interface/Email.pm')
| -rwxr-xr-x | rt/lib/RT/Interface/Email.pm | 683 | 
1 files changed, 308 insertions, 375 deletions
| diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index 7eec0502f..e95436091 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -1,58 +1,41 @@ -# BEGIN LICENSE BLOCK -#  -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -#  -# (Except where explictly superceded by other copyright notices) -#  -# 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. -#  -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -#  -#  -# END LICENSE BLOCK +# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Email.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $ +# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com> +  package RT::Interface::Email;  use strict;  use Mail::Address;  use MIME::Entity; -use RT::EmailParser; -  BEGIN {      use Exporter ();      use vars qw ($VERSION  @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);      # set the version for version checking -    $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker +    $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker      @ISA         = qw(Exporter);      # your exported package globals go here,      # as well as any optionally exported functions -    @EXPORT_OK   = qw( -              &CreateUser +    @EXPORT_OK   = qw(&CleanEnv  +		      &LoadConfig  +		      &DBConnect  +		      &GetCurrentUser  		      &GetMessageContent  		      &CheckForLoops   		      &CheckForSuspiciousSender  		      &CheckForAutoGenerated  +		      &ParseMIMEEntityFromSTDIN +		      &ParseTicketId   		      &MailError   		      &ParseCcAddressesFromHead  		      &ParseSenderAddressFromHead  -		      &ParseErrorsToAddressFromHead -                      &ParseAddressFromHeader -              &Gateway); +   		      &ParseErrorsToAddressFromHead +              &ParseAddressFromHeader + +		      &debug);  }  =head1 NAME @@ -64,13 +47,28 @@ BEGIN {    use lib "!!RT_LIB_PATH!!";    use lib "!!RT_ETC_PATH!!"; -  use RT::Interface::Email  qw(Gateway CreateUser); +  use RT::Interface::Email  qw(CleanEnv LoadConfig DBConnect  +			      ); + +  #Clean out all the nasties from the environment +  CleanEnv(); + +  #Load etc/config.pm and drop privs +  LoadConfig(); + +  #Connect to the database and get RT::SystemUser and RT::Nobody loaded +  DBConnect(); + + +  #Get the current user all loaded +  my $CurrentUser = GetCurrentUser();  =head1 DESCRIPTION  =begin testing +ok(require RT::TestHarness);  ok(require RT::Interface::Email);  =end testing @@ -81,6 +79,71 @@ ok(require RT::Interface::Email);  =cut +=head2 CleanEnv + +Removes some of the nastiest nasties from the user\'s environment. + +=cut + +sub CleanEnv { +    $ENV{'PATH'} = '/bin:/usr/bin';    # or whatever you need +    $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'}; +    $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'}; +    $ENV{'ENV'} = '' if defined $ENV{'ENV'}; +    $ENV{'IFS'} = '' if defined $ENV{'IFS'}; +} + + + +=head2 LoadConfig + +Loads RT's config file and then drops setgid privileges. + +=cut + +sub LoadConfig { +     +    #This drags in  RT's config.pm +    use config; +     +}	 + + + +=head2 DBConnect + +  Calls RT::Init, which creates a database connection and then creates $RT::Nobody +  and $RT::SystemUser + +=cut + + +sub DBConnect { +    use RT; +    RT::Init(); +} + + + +# {{{ sub debug + +sub debug { +    my $val = shift; +    my ($debug); +    if ($val) { +	$RT::Logger->debug($val."\n"); +	if ($debug) { +	    print STDERR "$val\n"; +	} +    } +    if ($debug) { +	return(1); +    }	 +} + +# }}} + +  # {{{ sub CheckForLoops   sub CheckForLoops  { @@ -144,6 +207,82 @@ sub CheckForAutoGenerated {  # }}} +# {{{ sub ParseMIMEEntityFromSTDIN + +sub ParseMIMEEntityFromSTDIN { + +    # Create a new parser object: +     +    my $parser = new MIME::Parser; +     +    # {{{ Config $parser to store large attacments in temp dir + +    ## TODO: Does it make sense storing to disk at all?  After all, we +    ## need to put each msg as an in-core scalar before saving it to +    ## the database, don't we? + +    ## At the same time, we should make sure that we nuke attachments  +    ## Over max size and return them + +    ## TODO: Remove the temp dir when we don't need it any more. + +    my $AttachmentDir = File::Temp::tempdir (TMPDIR => 1, CLEANUP => 1); +     +    # Set up output directory for files: +    $parser->output_dir("$AttachmentDir"); +   +    #If someone includes a message, don't extract it +    $parser->extract_nested_messages(0); + +    +    # Set up the prefix for files with auto-generated names: +    $parser->output_prefix("part"); + +    # If content length is <= 20000 bytes, store each msg as in-core scalar; +    # Else, write to a disk file (the default action): +   +    $parser->output_to_core(20000); + +    # }}} (temporary directory) + +    #Ok. now that we're set up, let's get the stdin. +    my $entity; +    unless ($entity = $parser->read(\*STDIN)) { +	die "couldn't parse MIME stream"; +    } +    #Now we've got a parsed mime object.  +     +    # Get the head, a MIME::Head: +    my $head = $entity->head; +    + +    # Unfold headers that are have embedded newlines +    $head->unfold;  +     +    # TODO - information about the charset is lost here! +    $head->decode; + +    return ($entity, $head); + +} +# }}} + +# {{{ sub ParseTicketId  + +sub ParseTicketId { +    my $Subject = shift; +    my ($Id); +     +    if ($Subject =~ s/\[$RT::rtname \#(\d+)\]//i) { +	$Id = $1; +	$RT::Logger->debug("Found a ticket ID. It's $Id"); +	return($Id); +    } +    else { +	return(undef); +    } +} +# }}}  # {{{ sub MailError   sub MailError { @@ -174,8 +313,8 @@ sub MailError {      if ($mimeobj) {          $mimeobj->sync_headers();          $entity->add_part($mimeobj); -    } -     +    }  +      if ($RT::MailCommand eq 'sendmailpipe') {          open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);          print MAIL $entity->as_string; @@ -188,66 +327,144 @@ sub MailError {  # }}} -# {{{ Create User +# {{{ sub GetCurrentUser  + +sub GetCurrentUser  { +    my $head = shift; +    my $entity = shift; +    my $ErrorsTo = shift; -sub CreateUser { -    my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_; -    my $NewUser = RT::User->new($RT::SystemUser); +    my %UserInfo = (); -    # This data is tainted by some Very Broken mailers. -    # (Sometimes they send raw ISO 8859-1 data here. fear that. -    require Encode; -    $Username = Encode::encode(utf8 => $Username, Encode::FB_PERLQQ()) if defined $Username; -    $Name = Encode::encode(utf8 => $Name, Encode::FB_PERLQQ()) if defined $Name; -     -    my ($Val, $Message) =  -      $NewUser->Create(Name => ($Username || $Address), -                       EmailAddress => $Address, -                       RealName => $Name, -                       Password => undef, -                       Privileged => 0, -                       Comments => 'Autocreated on ticket submission' -                      ); +    #Suck the address of the sender out of the header +    my ($Address, $Name) = ParseSenderAddressFromHead($head); -    unless ($Val) { -         -        # Deal with the race condition of two account creations at once -        # -        if ($Username) { -            $NewUser->LoadByName($Username); -        } -         -        unless ($NewUser->Id) { -            $NewUser->LoadByEmail($Address); -        } -         -        unless ($NewUser->Id) {   -            MailError( To => $ErrorsTo, -                       Subject => "User could not be created", -                       Explanation => "User creation failed in mailgateway: $Message", -                       MIMEObj => $entity, -                       LogLevel => 'crit' -                     ); -        } +    #This will apply local address canonicalization rules +    $Address = RT::CanonicalizeAddress($Address); +   +    #If desired, synchronize with an external database + +    my $UserFoundInExternalDatabase = 0; + +    # Username is the 'Name' attribute of the user that RT uses for things +    # like authentication +    my $Username = undef; +    if ($RT::LookupSenderInExternalDatabase) { +	($UserFoundInExternalDatabase, %UserInfo) =  +	  RT::LookupExternalUserInfo($Address, $Name); +    +       $Address = $UserInfo{'EmailAddress'}; +       $Username = $UserInfo{'Name'};       } - -    #Load the new user object +          my $CurrentUser = RT::CurrentUser->new(); -    $CurrentUser->LoadByEmail($Address); - -    unless ($CurrentUser->id) { -            $RT::Logger->warning("Couldn't load user '$Address'.".  "giving up"); -                MailError( To => $ErrorsTo, -                           Subject => "User could not be loaded", -                           Explanation => "User  '$Address' could not be loaded in the mail gateway", -                           MIMEObj => $entity, -                           LogLevel => 'crit' -                     ); -    } +     +    # First try looking up by a username, if we got one from the external +    # db lookup. Next, try looking up by email address. Failing that, +    # try looking up by users who have this user's email address as their +    # username. + +    if ($Username) { +	$CurrentUser->LoadByName($Username); +    }	 +     +    unless ($CurrentUser->Id) { +	$CurrentUser->LoadByEmail($Address); +    }	 -    return $CurrentUser; +    #If we can't get it by email address, try by name.   +    unless ($CurrentUser->Id) { +	$CurrentUser->LoadByName($Address); +    } +     +     +    unless ($CurrentUser->Id) { +        #If we couldn't load a user, determine whether to create a user + +        # {{{ If we require an incoming address to be found in the external +	# user database, reject the incoming message appropriately +        if ( $RT::LookupSenderInExternalDatabase && +	     $RT::SenderMustExistInExternalDatabase &&  +	     !$UserFoundInExternalDatabase) { +	     +	    my $Message = "Sender's email address was not found in the user database."; + +	    # {{{  This code useful only if you've defined an AutoRejectRequest template +	     +	    require RT::Template; +	    my $template = new RT::Template($RT::Nobody); +	    $template->Load('AutoRejectRequest'); +	    $Message = $template->Content || $Message; +	     +	    # }}} +	     +	    MailError( To => $ErrorsTo, +		       Subject => "Ticket Creation failed: user could not be created", +		       Explanation => $Message, +		       MIMEObj => $entity, +		       LogLevel => 'notice' +		     ); + +	    return($CurrentUser); + +	}  +	# }}} +	 +	else { +	    my $NewUser = RT::User->new($RT::SystemUser); +	     +	    my ($Val, $Message) =  +	      $NewUser->Create(Name => ($Username || $Address), +			       EmailAddress => $Address, +			       RealName => "$Name", +			       Password => undef, +			       Privileged => 0, +			       Comments => 'Autocreated on ticket submission' +			      ); +	     +	    unless ($Val) { +		 +		# Deal with the race condition of two account creations at once +		# +           	if ($Username) { +		    $NewUser->LoadByName($Username); +		} +		 +		unless ($NewUser->Id) { +	            $NewUser->LoadByEmail($Address); +		} +		 +		unless ($NewUser->Id) {   +		    MailError( To => $ErrorsTo, +			       Subject => "User could not be created", +			       Explanation => "User creation failed in mailgateway: $Message", +			       MIMEObj => $entity, +			       LogLevel => 'crit' +			     ); +		} +	    } +	} +	 +	#Load the new user object +	$CurrentUser->LoadByEmail($Address); +	 +	unless ($CurrentUser->id) { +	    $RT::Logger->warning("Couldn't load user '$Address'.".  "giving up"); +		MailError( To => $ErrorsTo, +			   Subject => "User could not be loaded", +			   Explanation => "User  '$Address' could not be loaded in the mail gateway", +			   MIMEObj => $entity, +			   LogLevel => 'crit' +			 ); +	     +	} +    } +     +    return ($CurrentUser); +      } -# }}}	     +# }}} +  # {{{ ParseCcAddressesFromHead   =head2 ParseCcAddressesFromHead HASHREF @@ -272,11 +489,11 @@ sub ParseCcAddressesFromHead {      foreach my $AddrObj (@ToObjs, @CcObjs) {  	my $Address = $AddrObj->address; -	$Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($Address); +	$Address = RT::CanonicalizeAddress($Address);   	next if ($args{'CurrentUser'}->EmailAddress =~ /^$Address$/i);  	next if ($args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i);  	next if ($args{'QueueObj'}->CommentAddress =~ /^$Address$/i); -	next if (RT::EmailParser::IsRTAddress(undef, $Address)); +	next if (RT::IsRTAddress($Address));  	push (@Addresses, $Address);      } @@ -351,7 +568,8 @@ sub ParseAddressFromHeader{      }      my $Name =  ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address); -     + +      #Lets take the from and load a user object.      my $Address = $AddrObj->address; @@ -360,289 +578,4 @@ sub ParseAddressFromHeader{  # }}} - -=head2 Gateway - -This performs all the "guts" of the mail rt-mailgate program, and is -designed to be called from the web interface with a message, user -object, and so on. - -=cut - -sub Gateway { -    my %args = ( message => undef, -                 queue   => 1, -                 action  => 'correspond', -                 ticket  => undef, -                 @_ ); - -    # Validate the action -    unless ( $args{'action'} =~ /^(comment|correspond|action)$/ ) { - -        # Can't safely loc this. What object do we loc around? -        return ( 0, "Invalid 'action' parameter", undef ); -    } - -    my $parser = RT::EmailParser->new(); -    $parser->ParseMIMEEntityFromScalar( $args{'message'} ); - -    my $Message = $parser->Entity(); -    my $head = $Message->head; - -    my ( $CurrentUser, $AuthStat, $status, $error ); - -    my $ErrorsTo = ParseErrorsToAddressFromHead($head); - -    my $MessageId = $head->get('Message-Id') -      || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>"; - -    #Pull apart the subject line -    my $Subject = $head->get('Subject') || ''; -    chomp $Subject; - - -    $args{'ticket'} ||= $parser->ParseTicketId($Subject); - -    my $SystemTicket; -    if ($args{'ticket'} ) { -        $SystemTicket = RT::Ticket->new($RT::SystemUser); -        $SystemTicket->Load($args{'ticket'}); -    } - -    #Set up a queue object -    my $SystemQueueObj = RT::Queue->new($RT::SystemUser); -    $SystemQueueObj->Load( $args{'queue'} ); - - -    # We can safely have no queue of we have a known-good ticket -    unless ( $args{'ticket'} || $SystemQueueObj->id ) { -        MailError( -                 To          => $RT::OwnerEmail, -                 Subject     => "RT Bounce: $Subject", -                 Explanation => "RT couldn't find the queue: " . $args{'queue'}, -                 MIMEObj     => $Message ); -        return ( 0, "RT couldn't find the queue: " . $args{'queue'}, undef ); -    } - -    # Authentication Level -    # -1 - Get out.  this user has been explicitly declined  -    # 0 - User may not do anything (Not used at the moment) -    # 1 - Normal user -    # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate - -    push @RT::MailPlugins, "Auth::MailFrom"   unless @RT::MailPlugins; -    # Since this needs loading, no matter what - -    for (@RT::MailPlugins) { -        my $Code; -        my $NewAuthStat; -        if ( ref($_) eq "CODE" ) { -            $Code = $_; -        } -        else { -            $_ = "RT::Interface::Email::$_" unless /^RT::Interface::Email::/; -            eval "require $_;"; -            if ($@) { -                die ("Couldn't load module $_: $@"); -                next; -            } -            no strict 'refs'; -            if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) { -                die ("No GetCurrentUser code found in $_ module"); -                next; -            } -        } - -        ( $CurrentUser, $NewAuthStat ) = $Code->( Message     => $Message, -                                                  CurrentUser => $CurrentUser, -                                                  AuthLevel   => $AuthStat, -                                                  Action => $args{'action'}, -                                                  Ticket => $SystemTicket, -                                                  Queue  => $SystemQueueObj ); - -        # You get the highest level of authentication you were assigned. -        last if $AuthStat == -1; -        $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat; -    } - -    # {{{ If authentication fails and no new user was created, get out. -    if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) { - -        # If the plugins refused to create one, they lose. -        MailError( -            Subject     => "Could not load a valid user", -            Explanation => <<EOT, -RT could not load a valid user, and RT's configuration does not allow -for the creation of a new user for your email. - -Your RT administrator needs to grant 'Everyone' the right 'CreateTicket' -for this queue. - -EOT -            MIMEObj  => $Message, -            LogLevel => 'error' ) -          unless $AuthStat == -1; -        return ( 0, "Could not load a valid user", undef ); -    } - -    # }}} - -    # {{{ Lets check for mail loops of various sorts. -    my $IsAutoGenerated = CheckForAutoGenerated($head); - -    my $IsSuspiciousSender = CheckForSuspiciousSender($head); - -    my $IsALoop = CheckForLoops($head); - -    my $SquelchReplies = 0; - -    #If the message is autogenerated, we need to know, so we can not -    # send mail to the sender -    if ( $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) { -        $SquelchReplies = 1; -        $ErrorsTo       = $RT::OwnerEmail; -    } - -    # }}} - -    # {{{ Drop it if it's disallowed -    if ( $AuthStat == 0 ) { -        MailError( -             To          => $ErrorsTo, -             Subject     => "Permission Denied", -             Explanation => "You do not have permission to communicate with RT", -             MIMEObj     => $Message ); -    } - -    # }}} -    # {{{ Warn someone  if it's a loop - -    # Warn someone if it's a loop, before we drop it on the ground -    if ($IsALoop) { -        $RT::Logger->crit("RT Recieved mail ($MessageId) from itself."); - -        #Should we mail it to RTOwner? -        if ($RT::LoopsToRTOwner) { -            MailError( To          => $RT::OwnerEmail, -                       Subject     => "RT Bounce: $Subject", -                       Explanation => "RT thinks this message may be a bounce", -                       MIMEObj     => $Message ); - -            #Do we actually want to store it? -            return ( 0, "Message Bounced", undef ) unless ($RT::StoreLoops); -        } -    } - -    # }}} - -    # {{{ Squelch replies if necessary -    # Don't let the user stuff the RT-Squelch-Replies-To header. -    if ( $head->get('RT-Squelch-Replies-To') ) { -        $head->add( 'RT-Relocated-Squelch-Replies-To', -                    $head->get('RT-Squelch-Replies-To') ); -        $head->delete('RT-Squelch-Replies-To'); -    } - -    if ($SquelchReplies) { -        ## TODO: This is a hack.  It should be some other way to -        ## indicate that the transaction should be "silent". - -        my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); -        $head->add( 'RT-Squelch-Replies-To', $Sender ); -    } - -    # }}} - -    my $Ticket = RT::Ticket->new($CurrentUser); - -    # {{{ If we don't have a ticket Id, we're creating a new ticket -    if ( !$args{'ticket'} ) { - -        # {{{ Create a new ticket - -        my @Cc; -        my @Requestors = ( $CurrentUser->id ); - -        if ($RT::ParseNewMessageForTicketCcs) { -            @Cc = ParseCcAddressesFromHead( Head        => $head, -                                            CurrentUser => $CurrentUser, -                                            QueueObj    => $SystemQueueObj ); -        } - -        my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( -                                                      Queue     => $SystemQueueObj->Id, -                                                      Subject   => $Subject, -                                                      Requestor => \@Requestors, -                                                      Cc        => \@Cc, -                                                      MIMEObj   => $Message ); -        if ( $id == 0 ) { -            MailError( To          => $ErrorsTo, -                       Subject     => "Ticket creation failed", -                       Explanation => $ErrStr, -                       MIMEObj     => $Message ); -            $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr "); -            return ( 0, "Ticket creation failed", $Ticket ); -        } - -        # }}} -    } - -    # }}} - -    #   If the action is comment, add a comment. -    elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) { -        $Ticket->Load($args{'ticket'}); -        unless ( $Ticket->Id ) { -            my $message = "Could not find a ticket with id ".$args{'ticket'}; -            MailError( To          => $ErrorsTo, -                     Subject     => "Message not recorded", -                     Explanation => $message, -                     MIMEObj     => $Message ); - -            return ( 0, $message); -        } - -        my ( $status, $msg ); -        if ( $args{'action'} =~ /^correspond$/ ) { -            ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message ); -        } -        else { -            ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message ); -        } -        unless ($status) { - -            #Warn the sender that we couldn't actually submit the comment. -            MailError( To          => $ErrorsTo, -                       Subject     => "Message not recorded", -                       Explanation => $msg, -                       MIMEObj     => $Message ); -            return ( 0, "Message not recorded", $Ticket ); -        } -    } - -    else { - -        #Return mail to the sender with an error -        MailError( To          => $ErrorsTo, -                   Subject     => "RT Configuration error", -                   Explanation => "'" -                     . $args{'action'} -                     . "' not a recognized action." -                     . " Your RT administrator has misconfigured " -                     . "the mail aliases which invoke RT", -                   MIMEObj => $Message ); -        $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" ); -        return ( 0, "Configuration error: " . $args{'action'} . " not a recognized action", $Ticket ); - -    } - - -return ( 1, "Success", $Ticket ); -} - -eval "require RT::Interface::Email_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm}); -eval "require RT::Interface::Email_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm}); -  1; | 
