import rt 3.8.10
[freeside.git] / rt / bin / rt-mailgate
index e6f0d95..de0529d 100755 (executable)
-#!!!PERL!! -w
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+#                                          <sales@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 }}}
+=head1 NAME
+
+rt-mailgate - Mail interface to RT3.
+
+=cut
 
-# $Header: /home/cvs/cvsroot/freeside/rt/bin/rt-mailgate,v 1.1 2002-08-12 06:17:07 ivan Exp $
-# (c) 1996-2001 Jesse Vincent <jesse@fsck.com>
-# This software is redistributable under the terms of the GNU GPL
+use strict;
+use warnings;
 
+use Getopt::Long;
+use LWP::UserAgent;
+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+$DYNAMIC_FILE_UPLOAD = 1;
 
-package RT;
-use strict;
-use vars qw($VERSION $Handle $Nobody $SystemUser);
+use constant EX_TEMPFAIL => 75;
+use constant BUFFER_SIZE => 8192;
 
-$VERSION="!!RT_VERSION!!";
+my %opts;
+GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
 
+if ( $opts{'help'} ) {
+    require Pod::Usage;
+    import Pod::Usage;
+    pod2usage("RT Mail Gateway\n");
+    exit 1;    # Don't want to succeed if this is really an email!
+}
 
-use lib "!!RT_LIB_PATH!!";
-use lib "!!RT_ETC_PATH!!";
+unless ( $opts{'url'} ) {
+    print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
+    exit 1;
+}
 
-use RT::Interface::Email  qw(CleanEnv LoadConfig DBConnect
-                            GetCurrentUser
-                            GetMessageContent
-                            CheckForLoops 
-                            CheckForSuspiciousSender
-                            CheckForAutoGenerated 
-                            ParseMIMEEntityFromSTDIN
-                            ParseTicketId 
-                            MailError 
-                            ParseCcAddressesFromHead
-                            ParseSenderAddressFromHead 
-                            ParseErrorsToAddressFromHead
-                           );
+my $ua = new LWP::UserAgent;
+$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'};
 
-#Clean out all the nasties from the environment
-CleanEnv();
+my %args = (
+    SessionType => 'REST', # Surpress login box
+);
+foreach ( qw(queue action) ) {
+    $args{$_} = $opts{$_} if defined $opts{$_};
+};
 
-#Load etc/config.pm and drop privs
-LoadConfig();
+if ( ($opts{'extension'} || '') =~ /^(?:action|queue|ticket)$/i ) {
+    $args{ lc $opts{'extension'} } = $ENV{'EXTENSION'} || $opts{$opts{'extension'}};
+} elsif ( $opts{'extension'} && $ENV{'EXTENSION'} ) {
+    print STDERR "Value of the --extension argument is not action, queue or ticket"
+        .", but environment variable EXTENSION is also defined. The former is ignored.\n";
+}
 
-#Connect to the database and get RT::SystemUser and RT::Nobody loaded
-DBConnect();
+# add ENV{'EXTENSION'} as X-RT-MailExtension to the message header
+if ( my $value = ( $ENV{'EXTENSION'} || $opts{'extension'} ) ) {
+    # prepare value to avoid MIME format breakage
+    # strip trailing newline symbols
+    $value =~ s/(\r*\n)+$//;
+    # make a correct multiline header field,
+    # with tabs in the beginning of each line
+    $value =~ s/(\r*\n)/$1\t/g;
+    $opts{'headers'} .= "X-RT-Mail-Extension: $value\n";
+}
 
-#Drop setgid permissions
-RT::DropSetGIDPermissions();
+# Read the message in from STDIN
+my %message = write_down_message();
+unless( $message{'filename'} ) {
+    $args{'message'} = [
+        undef, '',
+        'Content-Type' => 'application/octet-stream',
+        Content => ${ $message{'content'} },
+    ];
+} else {
+    $args{'message'} = [
+        $message{'filename'}, '',
+        'Content-Type' => 'application/octet-stream',
+    ];
+}
 
-use RT::Ticket;
-use RT::Queue;
-use MIME::Parser;
-use File::Temp;
-use Mail::Address;
+my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
+print STDERR "$0: connecting to $full_url\n" if $opts{'debug'};
 
+$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 );
+my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' );
+check_failure($r);
 
-#Set some sensible defaults 
-my $Queue = 1;
-my $time = time;
-my $Action = "correspond";  
+my $content = $r->content;
+print STDERR $content ."\n" if $opts{'debug'};
 
-my ($Verbose, $ReturnTid, $Debug);
-my ($From, $TicketId, $Subject,$SquelchReplies);
+if ( $content !~ /^(ok|not ok)/ ) {
 
-# using --owner-from-extension, this will let you set ticket owner on create
-my $AssignTicketTo = undef;
-my ($status, $msg);
+    # It's not the server's fault if the mail is bogus. We just want to know that
+    # *something* came out of the server.
+    print STDERR <<EOF;
+RT server error.
 
-# {{{ parse commandline 
+The RT server which handled your email did not behave as expected. It
+said:
 
-while (my $flag = shift @ARGV) {
-    if (($flag eq '-v') or ($flag eq '--verbose')) {
-       $Verbose = 1;
-    }
-    if (($flag eq '-t') or ($flag eq '--ticketid')) {
-       $ReturnTid = 1;
-    }
-    
-    if (($flag eq '-d') or ($flag eq '--debug')) {
-       $RT::Logger->debug("Debug mode enabled\n");
-       $Debug = 1;
-      }
-    
-    if (($flag eq '-q') or ($flag eq '--queue')) {
-       $Queue = shift @ARGV;
-    } 
-    if ($flag eq '--ticket-id-from-extension') {
-       $TicketId = $ENV{'EXTENSION'};
-    }
-    if ($flag eq '--queue-from-extension') {
-       $Queue = $ENV{'EXTENSION'};
-    }
-    if ($flag eq '--owner-from-extension') {
-        $AssignTicketTo = $ENV{'EXTENSION'};
+$content
+EOF
+
+    exit EX_TEMPFAIL;
+}
+
+exit;
+
+END {
+    unlink $message{'filename'} if $message{'filename'};
+}
+
+
+sub check_failure {
+    my $r = shift;
+    return if $r->is_success;
+
+    # This ordinarily oughtn't to be able to happen, suggests a bug in RT.
+    # So only load these heavy modules when they're needed.
+    require HTML::TreeBuilder;
+    require HTML::FormatText;
+
+    my $error = $r->error_as_HTML;
+    my $tree  = HTML::TreeBuilder->new->parse( $error );
+    $tree->eof;
+
+    # It'll be a cold day in hell before RT sends out bounces in HTML
+    my $formatter = HTML::FormatText->new(
+        leftmargin  => 0,
+        rightmargin => 50,
+    );
+    print STDERR $formatter->format( $tree );
+    print STDERR "\n$0: undefined server error\n" if $opts{'debug'};
+    exit EX_TEMPFAIL;
+}
+
+sub write_down_message {
+    use File::Temp qw(tempfile);
+
+    local $@;
+    my ($fh, $filename) = eval { tempfile() };
+    if ( !$fh || $@ ) {
+        print STDERR "$0: Couldn't create temp file, using memory\n";
+        print STDERR "error: $@\n" if $@;
+
+        my $message = \do { local (@ARGV, $/); <STDIN> };
+        unless ( $$message =~ /\S/ ) {
+            print STDERR "$0: no message passed on STDIN\n";
+            exit 0;
+        }
+        $$message = $opts{'headers'} . $$message if $opts{'headers'};
+        return ( content => $message );
     }
 
-    if (($flag eq '-a') or ($flag eq '--action')) {
-         $Action = shift @ARGV;
-    } 
-    
+    binmode $fh;
+    binmode \*STDIN;
     
+    print $fh $opts{'headers'} if $opts{'headers'};
+
+    my $buf; my $empty = 1;
+    while(1) {
+        my $status = read \*STDIN, $buf, BUFFER_SIZE;
+        unless ( defined $status ) {
+            print STDERR "$0: couldn't read message: $!\n";
+            exit EX_TEMPFAIL;
+        } elsif ( !$status ) {
+            last;
+        }
+        $empty = 0 if $buf =~ /\S/;
+        print $fh $buf;
+    };
+    close $fh;
+
+    if ( $empty ) {
+        print STDERR "$0: no message passed on STDIN\n";
+        exit 0;
+    }
+    print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'};
+    return (filename => $filename);
 }
 
-# }}}
 
-# get the current mime entity from stdin
-my ($entity, $head) = ParseMIMEEntityFromSTDIN();
+=head1 SYNOPSIS
 
-#Get someone to send runtime errors to;
-my $ErrorsTo = ParseErrorsToAddressFromHead($head);
+    rt-mailgate --help : this text
 
-#Get us a current user object.
-my $CurrentUser = GetCurrentUser($head, $entity, $ErrorsTo);
+Usual invocation (from MTA):
 
-# We've already performed a warning and sent the mail off to somewhere safe ($RTOwner).
-#  this is _exceedingly_ unlikely but we don't want to keep going if we don't have a current user
+    rt-mailgate --action (correspond|comment|...) --queue queuename
+                --url http://your.rt.server/
+                [ --debug ]
+                [ --extension (queue|action|ticket) ]
+                [ --timeout seconds ]
 
-unless ($CurrentUser->Id) {
-       exit(1);
-}
 
-my $MessageId = $head->get('Message-Id') || 
-  "<no-message-id-".time.rand(2000)."\@.$RT::Organization>";
 
-#Pull apart the subject line
-$Subject = $head->get('Subject') || "[no subject]";
-chomp $Subject;
+=head1 OPTIONS
 
-# Get the ticket ID unless it's already set
-$TicketId = ParseTicketId($Subject) unless ($TicketId);
+=over 3
 
-#Set up a queue object
-my $QueueObj = RT::Queue->new($CurrentUser);
-$QueueObj->Load($Queue);
-unless ($QueueObj->id ) {
+=item C<--action>
 
-  MailError(To => $RT::OwnerEmail,
-                  Subject => "RT Bounce: $Subject",
-                  Explanation => "RT couldn't find the queue: $Queue",
-                  MIMEObj => $entity);
+Specifies what happens to email sent to this alias.  The avaliable
+basic actions are: C<correspond>, C<comment>.
 
-}
 
-# {{{ Lets check for mail loops of various sorts.
+If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>,
+C<take> and C<resolve> are also available.  You can execute two or more
+actions on a single message using a C<-> separated list.  RT will execute
+the actions in the listed order.  For example you can use C<take-comment>,
+C<correspond-resolve> or C<take-comment-resolve> as actions.
 
-my $IsAutoGenerated = CheckForAutoGenerated($head);
+Note that C<take> and C<resolve> actions ignore message text if used
+alone.  Include a  C<comment> or C<correspond> action if you want RT
+to record the incoming message.
 
-my $IsSuspiciousSender = CheckForSuspiciousSender($head);
+The default action is C<correspond>.
 
-my $IsALoop = CheckForLoops($head);
+=item C<--queue>
 
+This flag determines which queue this alias should create a ticket in if no ticket identifier
+is found.
 
-#If the message is autogenerated, we need to know, so we can not 
-# send mail to the sender
-if ($IsSuspiciousSender || $IsAutoGenerated || $IsALoop) {
-    $SquelchReplies = 1;
+=item C<--url>
 
-    $ErrorsTo = $RT::OwnerEmail;
-    
-    #TODO: Is what we want to do here really 
-    #  "Make the requestor cease to get mail from RT"?
-    # This might wreak havoc with vacation-mailing users.
-    # Maybe have a "disabled for bouncing" state that gets
-    # turned off when we get a legit incoming message
+This flag tells the mail gateway where it can find your RT server. You should 
+probably use the same URL that users use to log into RT.
 
-}
 
+=item C<--extension> OPTIONAL
 
-# {{{ Warn someone  if it's a loop
+Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
+and present "foo" in the environment variable $EXTENSION. By specifying
+the value "queue" for this parameter, the queue this message should be
+submitted to will be set to the value of $EXTENSION. By specifying
+"ticket", $EXTENSION will be interpreted as the id of the ticket this message
+is related to.  "action" will allow the user to specify either "comment" or
+"correspond" in the address extension.
 
-# Warn someone if it's a loop, before we drop it on the ground
-if ($IsALoop) {
-    $RT::Logger->crit("RT Received 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 => $entity);
-       
-       #Do we actually want to store it?
-       exit unless ($RT::StoreLoops);
-    }
-}
+=item C<--debug> OPTIONAL
 
-# }}}
+Print debugging output to standard error
 
 
-   #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')
-    }
+=item C<--timeout> OPTIONAL
 
+Configure the timeout for posting the message to the web server.  The
+default timeout is 3 minutes (180 seconds).
 
-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);
-}
+=head1 DESCRIPTION
 
-# }}}
+The RT mail gateway is the primary mechanism for communicating with RT
+via email. This program simply directs the email to the RT web server,
+which handles filing correspondence and sending out any required mail.
+It is designed to be run as part of the mail delivery process, either
+called directly by the MTA or C<procmail>, or in a F<.forward> or
+equivalent.
 
+=head1 SETUP
 
-# {{{ If we require that the sender be found in an external DB and they're not
-# forward this message to RTOwner
+Much of the set up of the mail gateway depends on your MTA and mail
+routing configuration. However, you will need first of all to create an
+RT user for the mail gateway and assign it a password; this helps to
+ensure that mail coming into the web server did originate from the
+gateway.
 
+Next, you need to route mail to C<rt-mailgate> for the queues you're
+monitoring. For instance, if you're using F</etc/aliases> and you have a
+"bugs" queue, you will want something like this:
 
+    bugs:         "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond
+              --url http://rt.mycorp.com/"
 
-if ($RT::LookupSenderInExternalDatabase && 
-    $RT::SenderMustExistInExternalDatabase )  {
+    bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment
+              --url http://rt.mycorp.com/"
 
-    MailError(To => $RT::OwnerEmail,
-             Subject => "RT Bounce: $Subject",
-             Explanation => "RT couldn't find requestor via its external database lookup",
-             MIMEObj => $entity);
-    
-}
+Note that you don't have to run your RT server on your mail server, as
+the mail gateway will happily relay to a different machine.
 
-# }}}
+=head1 CUSTOMIZATION
 
-# {{{ elsif we don't have a ticket Id, we're creating a new ticket
+By default, the mail gateway will accept mail from anyone. However,
+there are situations in which you will want to authenticate users
+before allowing them to communicate with the system. You can do this
+via a plug-in mechanism in the RT configuration.
 
+You can set the array C<@MailPlugins> to be a list of plugins. The
+default plugin, if this is not given, is C<Auth::MailFrom> - that is,
+authentication of the person is done based on the C<From> header of the
+email. If you have additional filters or authentication mechanisms, you
+can list them here and they will be called in order:
 
+    Set( @MailPlugins =>
+        "Filter::SpamAssassin",
+        "Auth::LDAP",
+        # ...
+    );
 
-elsif (!defined($TicketId)) {
-    
-    # {{{ Create a new ticket
-    if ($Action =~ /correspond/) {
-       
-       #    open a new ticket 
-       my @Requestors = ($CurrentUser->id);
-       
-       my @Cc;
-       if ($RT::ParseNewMessageForTicketCcs) {
-               @Cc = ParseCcAddressesFromHead(Head => $head, 
-                                       CurrentUser => $CurrentUser,
-                                       QueueObj => $QueueObj );
-       }
-
-       my $Ticket = new RT::Ticket($CurrentUser);
-       my ($id, $Transaction, $ErrStr) = 
-         $Ticket->Create ( Queue => $Queue,
-                           Subject => $Subject,
-                            Owner => $AssignTicketTo,
-                           Requestor => \@Requestors,
-                           Cc => \@Cc,
-                           MIMEObj => $entity
-                         );
-       if ($id == 0 ) {
-           MailError( To => $ErrorsTo,
-                      Subject => "Ticket creation failed",
-                      Explanation => $ErrStr,
-                      MIMEObj => $entity
-                    );
-           $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
-       }       
-    }
+See the documentation for any additional plugins you have.
 
-    # }}}
-    
-    else {
-       #TODO Return an error message
-       MailError( To => $ErrorsTo,
-                  Subject => "No ticket id specified",
-                  Explanation => "$Action aliases require a TicketId to work on",
-                  MIMEObj => $entity
-                );
-       
-       $RT::Logger->crit("$Action aliases require a TicketId to work on ".
-                         "(from ".$CurrentUser->UserObj->EmailAddress.") ".
-                         $MessageId);
-    }
-}
+You may also put Perl subroutines into the C<@MailPlugins> array, if
+they behave as described below.
 
-# }}}
+=head1 WRITING PLUGINS
 
-# {{{ If we've got a ticket ID, update the ticket
+What's actually going on in the above is that C<@MailPlugins> is a
+list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
+to form a package name, and then C<use>'s this module. The module is
+expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
+several parameters:
 
-else {
-    
-    #   If the action is comment, add a comment.
-    if ($Action =~ /comment/i){
-       
-       my $Ticket = new RT::Ticket($CurrentUser);
-       $Ticket->Load($TicketId);
-       unless ($Ticket->Id) {
-           MailError( To => $ErrorsTo,
-                      Subject => "Comment not recorded",
-                      Explanation => "Could not find a ticket with id $TicketId",
-                      MIMEObj => $entity
-                    );
-           #Return an error message saying that Ticket "#foo" wasn't found.
-       }
-       
-       ($status, $msg) = $Ticket->Comment(MIMEObj=>$entity);
-       unless ($status) {
-           #Warn the sender that we couldn't actually submit the comment.
-           MailError( To => $ErrorsTo,
-                      Subject => "Comment not recorded",
-                      Explanation => $msg,
-                      MIMEObj => $entity
-                    );
-       }       
-    }
+=over 4
 
-    # If the message is correspondence, add it to the ticket
-    elsif ($Action =~ /correspond/i) {
-       my $Ticket = RT::Ticket->new($CurrentUser);
-       $Ticket->Load($TicketId);
-       
-       #TODO: Check for error conditions
-       ($status, $msg) = $Ticket->Correspond(MIMEObj => $entity);
-       unless ($status) {
-
-           #Return mail to the sender with an error
-           MailError( To => $ErrorsTo,
-                      Subject => "Correspondence not recorded",
-                      Explanation => $msg,
-                      MIMEObj => $entity
-                    );
-       }
-    }
+=item Message
 
-    else {
-       #Return mail to the sender with an error
-           MailError( To => $ErrorsTo,
-                      Subject => "RT Configuration error",
-                      Explanation => "'$Action' not a recognized action.".
-                                     " Your RT administrator has misconfigured ".
-                                     "the mail aliases which invoke RT" ,
-                      MIMEObj => $entity
-                    );
-
-       $RT::Logger->crit("$Action type unknown for $MessageId");
-       
-    }
-    
-}
+A C<MIME::Entity> object representing the email
 
-# }}}
+=item CurrentUser
 
-$RT::Handle->Disconnect();
+An C<RT::CurrentUser> object
 
+=item AuthStat
 
-# Everything below this line is a helper sub. most of them will eventually
-# move to Interface::Email
+The authentication level returned from the previous plugin.
 
-#When we call die, trap it and log->crit with the value of the die.
-$SIG{__DIE__}  = sub {
-    unless ($^S || !defined $^S ) {
-        $RT::Logger->crit("$_[0]");
-       MailError( To => $ErrorsTo,  
-                  Bcc => $RT::OwnerEmail,
-                  Subject => "RT Critical error. Message not recorded!",
-                  Explanation => "$_[0]",
-                  MIMEObj => $entity
-                );
-       exit(-1);
-    }
-    else {
-        #Get out of here if we're in an eval
-        die $_[0];
-    }
-};
+=item Ticket [OPTIONAL]
+
+The ticket under discussion
+
+=item Queue [OPTIONAL]
+
+If we don't already have a ticket id, we need to know which queue we're talking about
+
+=item Action
+
+The action being performed. At the moment, it's one of "comment" or "correspond"
+
+=back 4
+
+It returns two values, the new C<RT::CurrentUser> object, and the new
+authentication level. The authentication level can be zero, not allowed
+to communicate with RT at all, (a "permission denied" error is mailed to
+the correspondent) or one, which is the normal mode of operation.
+Additionally, if C<-1> is returned, then the processing of the plug-ins
+stops immediately and the message is ignored.
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item EXTENSION
+
+Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
+and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value
+of this variable to message in the C<X-RT-Mail-Extension> field of the message
+header.
+
+See also C<--extension> option. Note that value of the environment variable is
+always added to the message header when it's not empty even if C<--extension>
+option is not provided.
 
+=back 4
 
+=cut
 
-1;