merging 3.8.7!!!

[freeside.git] / rt / bin / rt-mailgate

diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate
index 8db26db..d9e85a7 100755 (executable)
--- a/rt/bin/rt-mailgate
+++ b/rt/bin/rt-mailgate
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:

-#  
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC

 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)


@@ -52,30 +52,34 @@ rt-mailgate - Mail interface to RT3.
 
 =cut
 
 
 =cut
 

-

 use strict;
 use warnings;
 use strict;
 use warnings;

+

 use Getopt::Long;
 use LWP::UserAgent;
 use Getopt::Long;
 use LWP::UserAgent;

+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+$DYNAMIC_FILE_UPLOAD = 1;

 
 use constant EX_TEMPFAIL => 75;
 
 use constant EX_TEMPFAIL => 75;

+use constant BUFFER_SIZE => 8192;

 
 my %opts;
 GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
 
 
 my %opts;
 GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
 

-if ( $opts{help} ) {
+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!
 }
 
     require Pod::Usage;
     import Pod::Usage;
     pod2usage("RT Mail Gateway\n");
     exit 1;    # Don't want to succeed if this is really an email!
 }
 

-for (qw(url)) {
-    die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
+unless ( $opts{'url'} ) {
+    print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
+    exit 1;

 }
 
 }
 

-my $ua      = LWP::UserAgent->new();
-$ua->cookie_jar( { file => $opts{jar} } );
+my $ua = new LWP::UserAgent;
+$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'};

 
 my %args = (
     SessionType => 'REST', # Surpress login box
 
 my %args = (
     SessionType => 'REST', # Surpress login box


@@ -84,37 +88,54 @@ foreach ( qw(queue action) ) {
     $args{$_} = $opts{$_} if defined $opts{$_};
 };
 
     $args{$_} = $opts{$_} if defined $opts{$_};
 };
 

-# Read the message in from STDIN
-$args{'message'} = do { local (@ARGV, $/); <> };
-
-unless ( $args{message} =~ /\S/ ) {
-    print STDERR "$0: no message passed on STDIN!\n";
-    exit 0;
+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";

 }
 
 }
 

-if ($opts{'extension'}) {
-        $args{$opts{'extension'}} = $ENV{'EXTENSION'};
+# 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";

 }
 
 }
 

-# Set up cookie here.
+# 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',
+    ];
+}

 
 my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
 
 my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";

-warn "Connecting to $full_url" if $opts{'debug'};
+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} );
+$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 );
+my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' );

 check_failure($r);
 
 my $content = $r->content;
 check_failure($r);
 
 my $content = $r->content;

-warn $content if ($opts{debug});
+print STDERR $content ."\n" if $opts{'debug'};

 
 if ( $content !~ /^(ok|not ok)/ ) {
 
     # It's not the server's fault if the mail is bogus. We just want to know that
     # *something* came out of the server.
 
 if ( $content !~ /^(ok|not ok)/ ) {
 
     # It's not the server's fault if the mail is bogus. We just want to know that
     # *something* came out of the server.

-    warn <<EOF;
+    print STDERR <<EOF;

 RT server error.
 
 The RT server which handled your email did not behave as expected. It
 RT server error.
 
 The RT server which handled your email did not behave as expected. It


@@ -123,16 +144,19 @@ said:
 $content
 EOF
 
 $content
 EOF
 

-exit EX_TEMPFAIL;
-
+    exit EX_TEMPFAIL;

 }
 
 exit;
 
 }
 
 exit;
 

+END {
+    unlink $message{'filename'} if $message{'filename'};
+}
+

 
 sub check_failure {
     my $r = shift;
 
 sub check_failure {
     my $r = shift;

-    return if $r->is_success();
+    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.
 
     # This ordinarily oughtn't to be able to happen, suggests a bug in RT.
     # So only load these heavy modules when they're needed.


@@ -140,17 +164,64 @@ sub check_failure {
     require HTML::FormatText;
 
     my $error = $r->error_as_HTML;
     require HTML::FormatText;
 
     my $error = $r->error_as_HTML;

-    my $tree  = HTML::TreeBuilder->new->parse($error);
+    my $tree  = HTML::TreeBuilder->new->parse( $error );

     $tree->eof;
 
     # It'll be a cold day in hell before RT sends out bounces in HTML
     $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 );
-    warn $formatter->format($tree);
-    warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
+    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;
 }
 
     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, $/); <> };
+        unless ( $$message =~ /\S/ ) {
+            print STDERR "$0: no message passed on STDIN\n";
+            exit 0;
+        }
+        $$message = $opts{'headers'} . $$message if $opts{'headers'};
+        return ( content => $message );
+    }
+
+    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);
+}
+

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 


@@ -166,8 +237,6 @@ Usual invocation (from MTA):
 
 
 
 
 
 

-See C<man rt-mailgate> for more.
-

 =head1 OPTIONS
 
 =over 3
 =head1 OPTIONS
 
 =over 3


@@ -178,7 +247,7 @@ Specifies what happens to email sent to this alias.  The avaliable
 basic actions are: C<correspond>, C<comment>.
 
 
 basic actions are: C<correspond>, C<comment>.
 
 

-If you've set the RT configuration variable B<$RT::UnsafeEmailCommands>,
+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<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>,


@@ -259,13 +328,13 @@ 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.
 
 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<@RT::MailPlugins> to be a list of plugins. The
+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:
 
 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:
 

-    @RT::MailPlugins = (
+    Set( @MailPlugins =>

         "Filter::SpamAssassin",
         "Auth::LDAP",
         # ...
         "Filter::SpamAssassin",
         "Auth::LDAP",
         # ...


@@ -273,12 +342,12 @@ can list them here and they will be called in order:
 
 See the documentation for any additional plugins you have.
 
 
 See the documentation for any additional plugins you have.
 

-You may also put Perl subroutines into the C<@RT::MailPlugins> array, if
+You may also put Perl subroutines into the C<@MailPlugins> array, if

 they behave as described below.
 
 =head1 WRITING PLUGINS
 
 they behave as described below.
 
 =head1 WRITING PLUGINS
 

-What's actually going on in the above is that C<@RT::MailPlugins> is a
+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
 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


@@ -319,5 +388,22 @@ 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.
 
 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
 
 =cut