fix A/R report
[freeside.git] / rt / bin / rt-mailgate.in
index a37364f..43f57a8 100644 (file)
@@ -1,39 +1,41 @@
-#!@PERL@ -w
-# {{{ BEGIN BPS TAGGED BLOCK
-# 
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
 # COPYRIGHT:
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2016 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
 # 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 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.
 # 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
 # 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-# 
-# 
+# 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:
 # 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.)
 # (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
 # 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
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # 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
-
+#
+# END BPS TAGGED BLOCK }}}
 =head1 NAME
 
 =head1 NAME
 
-rt-mailgate - Mail interface to RT3.
-
-=begin testing
-
-use RT::I18N;
-
-# Make sure that when we call the mailgate wrong, it tempfails
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@");
-print MAIL <<EOF;
-From: root\@localhost
-To: rt\@example.com
-Subject: This is a test of new ticket creation
-
-Foob!
-EOF
-close (MAIL);
-
-# Check the return value
-is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay");
-
-
-# {{{ Test new ticket creation by root who is privileged and superuser
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate  --debug --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: root\@localhost
-To: rt\@example.com
-Subject: This is a test of new ticket creation
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-use RT::Tickets;
-my $tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $tick = $tickets->First();
-ok (UNIVERSAL::isa($tick,'RT::Ticket'));
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket");
-
-# }}}
-
-
-# {{{This is a test of new ticket creation as an unknown user
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist\@example.com
-To: rt\@example.com
-Subject: This is a test of new ticket creation as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-$tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
-$tick = $tickets->First();
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
-my $u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission");
-
-
-# }}}
-
-# {{{ now everybody can create tickets.  can a random unkown user create tickets?
-
-my $g = RT::Group->new($RT::SystemUser);
-$g->LoadSystemInternalGroup('Everyone');
-ok( $g->Id, "Found 'everybody'");
-
-my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-ok ($val, "Granted everybody the right to create tickets - $msg");
-
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist\@example.com
-To: rt\@example.com
-Subject: This is a test of new ticket creation as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-
-$tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
-$tick = $tickets->First();
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
-my $u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist@example.com');
-ok( $u->Id != 0, " user does not exist and was created by ticket submission");
-
-# }}}
-
-
-# {{{  can another random reply to a ticket without being granted privs? answer should be no.
-
-
-#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-#ok ($val, "Granted everybody the right to create tickets - $msg");
-#sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-2\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-2@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission");
-# }}}
-
-
-# {{{  can another random reply to a ticket after being granted privs? answer should be yes
-
-
-($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket');
-ok ($val, "Granted everybody the right to reply to  tickets - $msg");
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-2\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-2@example.com');
-ok( $u->Id != 0, " user exists and was created by ticket correspondence submission");
-
-# }}}
-
-# {{{  can another random comment on a ticket without being granted privs? answer should be no.
-
-
-#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-#ok ($val, "Granted everybody the right to create tickets - $msg");
-#sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-3\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-3@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
-
-# }}}
-# {{{  can another random reply to a ticket after being granted privs? answer should be yes
-
-
-($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket');
-ok ($val, "Granted everybody the right to reply to  tickets - $msg");
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-3\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-3@example.com');
-ok( $u->Id != 0, " user exists and was created by ticket comment submission");
-
-# }}}
+rt-mailgate - Mail interface to RT.
 
 
-# {{{ Testing preservation of binary attachments
-
-# Get a binary blob (Best Practical logo) 
-
-# Create a mime entity with an attachment
-
-use MIME::Entity;
-my $entity = MIME::Entity->build( From => 'root@localhost',
-                                 To => 'rt@localhost',
-                                Subject => 'binary attachment test',
-                                Data => ['This is a test of a binary attachment']);
-
-# currently in lib/t/autogen
-$entity->attach(Path => '@MASON_HTML_PATH@/NoAuth/images/spacer.gif', 
-                Type => 'image/gif',
-                Encoding => 'base64');
-
-# Create a ticket with a binary attachment
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-
-$entity->print(\*MAIL);
-
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-my $tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
- $tick = $tickets->First();
-ok (UNIVERSAL::isa($tick,'RT::Ticket'));
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id);
-
-my $file = `cat ../../../html/NoAuth/images/spacer.gif`;
-ok ($file, "Read in the logo image");
-
-
-        use Digest::MD5;
-warn "for the raw file the content is ".Digest::MD5::md5_base64($file);
-
-
-
-# Verify that the binary attachment is valid in the database
-my $attachments = RT::Attachments->new($RT::SystemUser);
-$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif');
-ok ($attachments->Count == 1, 'Found only one gif in the database');
-my $attachment = $attachments->First;
-ok($attachment->Id);
-my $acontent = $attachment->Content;
+=cut
 
 
-        warn "coming from the  database, the content is ".Digest::MD5::md5_base64($acontent);
+use strict;
+use warnings;
 
 
-is( $acontent, $file, 'The attachment isn\'t screwed up in the database.');
-# Log in as root
 use Getopt::Long;
 use Getopt::Long;
-use LWP::UserAgent;
 
 
+my $opts = { };
+GetOptions( $opts,   "queue=s", "action=s", "url=s",
+            "jar=s", "help",    "debug",    "extension=s",
+            "timeout=i", "verify-ssl!", "ca-file=s",
+          );
 
 
-# Grab the binary attachment via the web ui
-my $ua      = LWP::UserAgent->new();
+my $gateway = RT::Client::MailGateway->new();
 
 
-my $full_url = "http://localhost".$RT::WebPath."/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password";
-my $r = $ua->get( $full_url);
+$gateway->run($opts);
 
 
+package RT::Client::MailGateway;
 
 
-# Verify that the downloaded attachment is the same as what we uploaded.
-is($file, $r->content, 'The attachment isn\'t screwed up in download');
-
-
-
-# }}}
-
-# {{{ Simple I18N testing
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-                                                                         
-print MAIL <<EOF;
-From: root\@localhost
-To: rtemail\@example.com
-Subject: This is a test of I18N ticket creation
-Content-Type: text/plain; charset="utf-8"
-
-2 accented lines
-\303\242\303\252\303\256\303\264\303\273
-\303\241\303\251\303\255\303\263\303\272
-bye
-EOF
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-my $unitickets = RT::Tickets->new($RT::SystemUser);
-$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $unitick = $unitickets->First();
-ok (UNIVERSAL::isa($unitick,'RT::Ticket'));
-ok ($unitick->Id, "found ticket ".$unitick->Id);
-ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject);
-
-
-
-my $unistring = "\303\241\303\251\303\255\303\263\303\272";
-Encode::_utf8_on($unistring);
-is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content);
-ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
-# supposedly I18N fails on the second message sent in.
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
-                                                                         
-print MAIL <<EOF;
-From: root\@localhost
-To: rtemail\@example.com
-Subject: This is a test of I18N ticket creation
-Content-Type: text/plain; charset="utf-8"
-
-2 accented lines
-\303\242\303\252\303\256\303\264\303\273
-\303\241\303\251\303\255\303\263\303\272
-bye
-EOF
-close (MAIL);
-
-#Check the return value
-is ($? >> 8, 0, "The mail gateway exited normally. yay");
-
-my $tickets2 = RT::Tickets->new($RT::SystemUser);
-$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $tick2 = $tickets2->First();
-ok (UNIVERSAL::isa($tick2,'RT::Ticket'));
-ok ($tick2->Id, "found ticket ".$tick2->Id);
-ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket");
-
-
-
-my $unistring = "\303\241\303\251\303\255\303\263\303\272";
-Encode::_utf8_on($unistring);
-
-ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content);
-
-# }}}
+use LWP::UserAgent;
+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+use File::Temp qw(tempfile tempdir);
+$DYNAMIC_FILE_UPLOAD = 1;
 
 
+use constant EX_TEMPFAIL => 75;
+use constant BUFFER_SIZE => 8192;
 
 
-($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
-ok ($val, $msg);
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+    return $self;
+}
 
 
+sub run {
+    my $self = shift;
+    my $opts = shift;
 
 
+    if ( $opts->{running_in_test_harness} ) {
+        $self->{running_in_test_harness} = 1;
+    }
 
 
-=end testing
+    $self->validate_cli_flags($opts);
 
 
-=cut
+    my $ua          = $self->get_useragent($opts);
+    my $post_params = $self->setup_session($opts);
+    $self->upload_message( $ua => $post_params );
+    $self->exit_with_success();
+}
 
 
+sub exit_with_success {
+    my $self = shift;
+    if ( $self->{running_in_test_harness} ) {
+        return 1;
+    } else {
+        exit 0;
+    }
+}
 
 
-use strict;
-use Getopt::Long;
-use LWP::UserAgent;
+sub tempfail {
+    my $self = shift;
+    if ( $self->{running_in_test_harness} ) {
+        die "tempfail";
+    } else {
 
 
-use constant EX_TEMPFAIL => 75;
+        exit EX_TEMPFAIL;
+    }
+}
 
 
-my %opts;
-GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
+sub permfail {
+    my $self = shift;
+    if ( $self->{running_in_test_harness} ) {
+        die "permfail";
+    } else {
 
 
-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!
+        exit 1;
+    }
 }
 
 }
 
-for (qw(url)) {
-    die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
+sub validate_cli_flags {
+    my $self = shift;
+    my $opts = shift;
+    if ( $opts->{'help'} ) {
+        require Pod::Usage;
+        Pod::Usage::pod2usage( { verbose => 2 } );
+        return $self->permfail()
+            ;    # Don't want to succeed if this is really an email!
+    }
+
+    unless ( $opts->{'url'} ) {
+        print STDERR
+            "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
+        return $self->permfail();
+    }
+
+    $opts->{"verify-ssl"} = 1 unless defined $opts->{"verify-ssl"};
 }
 
 }
 
-undef $/;
-my $ua      = LWP::UserAgent->new();
-$ua->cookie_jar( { file => $opts{jar} } );
+sub get_useragent {
+    my $self = shift;
+    my $opts = shift;
+    my $ua   = LWP::UserAgent->new();
+    $ua->agent("rt-mailgate/@RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.@RT_VERSION_PATCH@ ");
+    $ua->cookie_jar( { file => $opts->{'jar'} } ) if $opts->{'jar'};
 
 
-my %args = (
-    queue   => $opts{queue},
-    action  => $opts{action},
-    SessionType => 'REST',    # Surpress login box
-);
+    $ua->ssl_opts( verify_hostname => $opts->{'verify-ssl'} );
+    $ua->ssl_opts( SSL_ca_file => $opts->{'ca-file'} )
+        if $opts->{'ca-file'};
 
 
-# Read the message in from STDIN
-$args{'message'} = <>;
-
-unless ( $args{message} =~ /\S/ ) {
-    print STDERR "$0: no message passed on STDIN!\n";
-    exit 0;
+    return $ua;
 }
 
 }
 
-if ($opts{'extension'}) {
-        $args{$opts{'extension'}} = $ENV{'EXTENSION'};
+sub setup_session {
+    my $self = shift;
+    my $opts = shift;
+    my %post_params;
+    foreach (qw(queue action)) {
+        $post_params{$_} = $opts->{$_} if defined $opts->{$_};
+    }
+
+    if ( ( $opts->{'extension'} || '' ) =~ /^(?:action|queue|ticket)$/i ) {
+        $post_params{ 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";
+    }
+
+    # 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";
+    }
+
+    # Read the message in from STDIN
+    # _raw_message is used for testing
+    my $message = $opts->{'_raw_message'} || $self->slurp_message();
+    unless ( $message->{'filename'} ) {
+        $post_params{'message'} = [
+                                 undef, '',
+                                 'Content-Type' => 'application/octet-stream',
+                                 Content        => ${ $message->{'content'} },
+        ];
+    } else {
+        $post_params{'message'} = [
+                                 $message->{'filename'}, '',
+                                 'Content-Type' => 'application/octet-stream',
+        ];
+    }
+
+    return \%post_params;
 }
 
 }
 
-# Set up cookie here.
-
-my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-warn "Connecting to $full_url" if $opts{'debug'};
+sub upload_message {
+    my $self        = shift;
+    my $ua          = shift;
+    my $post_params = shift;
+    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, $post_params, Content_Type => 'form-data' );
 
 
+    # Follow 3 redirects
+    my $n = 0;
+    while ($n++ < 3 and $r->is_redirect) {
+        $full_url = $r->header( "Location" );
+        $r = $ua->post( $full_url, $post_params, Content_Type => 'form-data' );
+    }
 
 
-$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180);
-my $r = $ua->post( $full_url, {%args} );
-check_failure($r);
+    $self->check_failure($r);
 
 
-my $content = $r->content;
-warn $content if ($opts{debug});
+    my $content = $r->content;
+    print STDERR $content . "\n" if $opts->{'debug'};
 
 
-if ( $content !~ /^(ok|not ok)/ ) {
+    return 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;
+ # 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.
 
 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
@@ -494,34 +245,68 @@ said:
 $content
 EOF
 
 $content
 EOF
 
-exit EX_TEMPFAIL;
-
+    return $self->tempfail();
 }
 
 }
 
-exit;
-
-
 sub check_failure {
 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 );
-    warn $formatter->format($tree);
-    warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
-    exit EX_TEMPFAIL;
+    my $self = shift;
+    my $r    = shift;
+    return if $r->is_success;
+
+    print STDERR "HTTP request failed: @{[ $r->status_line ]}. "
+                ."Your webserver logs may have more information or there may be a network problem.\n";
+    print STDERR "\n$0: undefined server error\n" if $opts->{'debug'};
+    return $self->tempfail();
 }
 
 }
 
+sub slurp_message {
+    my $self = shift;
+
+    local $@;
+
+    my %message;
+    my ( $fh, $filename )
+        = eval { tempfile( DIR => tempdir( CLEANUP => 1 ) ) };
+    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";
+            $self->exit_with_success;
+        }
+        $$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";
+            return $self->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";
+        $self->exit_with_success;
+    }
+    print STDERR "$0: temp file is '$filename'\n" if $opts->{'debug'};
+    return ( { filename => $filename } );
+}
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
@@ -529,7 +314,7 @@ sub check_failure {
 
 Usual invocation (from MTA):
 
 
 Usual invocation (from MTA):
 
-    rt-mailgate --action (correspond|comment) --queue queuename
+    rt-mailgate --action (correspond|comment|...) --queue queuename
                 --url http://your.rt.server/
                 [ --debug ]
                 [ --extension (queue|action|ticket) ]
                 --url http://your.rt.server/
                 [ --debug ]
                 [ --extension (queue|action|ticket) ]
@@ -537,24 +322,57 @@ Usual invocation (from MTA):
 
 
 
 
 
 
-See C<man rt-mailgate> for more.
-
 =head1 OPTIONS
 
 =over 3
 
 =item C<--action>
 
 =head1 OPTIONS
 
 =over 3
 
 =item C<--action>
 
-Specifies whether this is a correspondence or comment address.
+Specifies what happens to email sent to this alias.  The avaliable
+basic actions are: C<correspond>, C<comment>.
+
+
+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.
+
+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.
+
+The default action is C<correspond>.
 
 =item C<--queue>
 
 
 =item C<--queue>
 
-Reflects which queue this address handles.
+This flag determines which queue this alias should create a ticket in if no ticket identifier
+is found.
 
 =item C<--url>
 
 
 =item C<--url>
 
-The location of the web server for your RT instance.
+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.  
+
+If you have a self-signed SSL certificate, you may also need to pass
+C<--ca-file> or C<--no-verify-ssl>, below.
+
+=item C<--ca-file> I<path>
 
 
+Specifies the path to the public SSL certificate for the certificate
+authority that should be used to verify the website's SSL certificate.
+If your webserver uses a self-signed certificate, you should
+preferentially use this option over C<--no-verify-ssl>, as it will
+ensure that the self-signed certificate that the mailgate is seeing the
+I<right> self-signed certificate.
+
+=item C<--no-verify-ssl>
+
+This flag tells the mail gateway to trust all SSL certificates,
+regardless of if their hostname matches the certificate, and regardless
+of CA.  This is required if you have a self-signed certificate, or some
+other certificate which is not traceable back to an certificate your
+system ultimitely trusts.
 
 =item C<--extension> OPTIONAL
 
 
 =item C<--extension> OPTIONAL
 
@@ -576,6 +394,8 @@ Print debugging output to standard error
 Configure the timeout for posting the message to the web server.  The
 default timeout is 3 minutes (180 seconds).
 
 Configure the timeout for posting the message to the web server.  The
 default timeout is 3 minutes (180 seconds).
 
+=back
+
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
@@ -589,19 +409,16 @@ equivalent.
 =head1 SETUP
 
 Much of the set up of the mail gateway depends on your MTA and mail
 =head1 SETUP
 
 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.
+routing configuration.
 
 
-Next, you need to route mail to C<rt-mailgate> for the queues you're
+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:
 
 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
+    bugs:         "|@RT_BIN_PATH_R@/rt-mailgate --queue bugs --action correspond
               --url http://rt.mycorp.com/"
 
               --url http://rt.mycorp.com/"
 
-    bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment
+    bugs-comment: "|@RT_BIN_PATH_R@/rt-mailgate --queue bugs --action comment
               --url http://rt.mycorp.com/"
 
 Note that you don't have to run your RT server on your mail server, as
               --url http://rt.mycorp.com/"
 
 Note that you don't have to run your RT server on your mail server, as
@@ -614,13 +431,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",
         # ...
@@ -628,12 +445,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
@@ -644,6 +461,7 @@ several parameters:
 =item Message
 
 A C<MIME::Entity> object representing the email
 =item Message
 
 A C<MIME::Entity> object representing the email
+
 =item CurrentUser
 
 An C<RT::CurrentUser> object
 =item CurrentUser
 
 An C<RT::CurrentUser> object
@@ -664,7 +482,7 @@ If we don't already have a ticket id, we need to know which queue we're talking
 
 The action being performed. At the moment, it's one of "comment" or "correspond"
 
 
 The action being performed. At the moment, it's one of "comment" or "correspond"
 
-=back 4
+=back
 
 It returns two values, the new C<RT::CurrentUser> object, and the new
 authentication level. The authentication level can be zero, not allowed
 
 It returns two values, the new C<RT::CurrentUser> object, and the new
 authentication level. The authentication level can be zero, not allowed
@@ -673,5 +491,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
+
 =cut
 
 =cut