Better handle replies to bounce addresses.

Auto unsubscribe alert bounces, forward on report bounces and alert
replies to support, and send through to report creator non-bounce
replies to their report (for systems that ignore both the From and
Reply-To headers).

Also forward any totally unparsed bounce to support to possibly then
adjust this bounce handling.

10 files changed, 247 insertions, 67 deletions

diff --git a/bin/handlemail b/bin/handlemail
index 597d08a5d..e91a8a3a0 100755
--- a/bin/handlemail
+++ b/bin/handlemail
@@ -3,15 +3,10 @@
 # handlemail:
 # Handle an individual incoming mail message.
 #
-# This script should be invoked through the .forward mechanism. It processes
-# replies to non-reply emails and auto-replies accordingly. Could deal with
-# bounces at some point too.
+# This script should be invoked through the .forward mechanism. It
+# processes bounce messages and replies and deals with them accordingly.
 #
-# Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved.
-# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
-#
-
-my $rcsid = ''; $rcsid .= '$Id: handlemail,v 1.2 2009-02-11 11:04:48 matthew Exp $';
+# Copyright (c) 2016 UK Citizens Online Democracy. All rights reserved.
 
 use strict;
 use warnings;
@@ -25,45 +20,175 @@ BEGIN {
 }
 
 use FixMyStreet;
+use FixMyStreet::DB;
+use FixMyStreet::Email;
 use mySociety::Email;
 use mySociety::EmailUtil;
 use mySociety::HandleMail;
-use mySociety::SystemMisc;
+use mySociety::SystemMisc qw(print_log);
 
 # Don't print diagnostics to standard error, as this can result in bounce
 # messages being generated (only in response to non-bounce input, obviously).
 mySociety::SystemMisc::log_to_stderr(0);
 
 my %data = mySociety::HandleMail::get_message();
+my @lines = @{$data{lines}};
+my $token = get_envelope_token();
+my $verp = $token !~ /DO-NOT-REPLY/i;
+my ($type, $object) = get_object_from_token();
 
 if ($data{is_bounce_message}) {
-    #my $a = mySociety::HandleMail::get_bounce_recipient($data{message});
-    #my $token = mySociety::HandleMail::get_token($a,
-    #    'fms-', FixMyStreet->config('EMAILDOMAIN')
-    #);
-    #exit(0) if $token eq 'DO-NOT-REPLY'; # A bounce we don't care about
-    exit(0); # drop all other bounces currently
+    if ($object) {
+        handle_bounce_to_verp_address();
+    } else {
+        print_log('info', "bounce received for don't-care email");
+    }
+} else {
+    # This is not a bounce message. If it's to a VERP address, pass it on to
+    # the message sender; otherwise send an auto-reply
+    if ($object) {
+        handle_non_bounce_to_verp_address();
+    } else {
+        handle_non_bounce_to_null_address();
+    }
 }
 
-# Not a bounce, send an automatic response
-my $template = 'reply-autoresponse';
-my $fp = FixMyStreet->path_to("templates", "email", "default", $template)->open or exit 75;
-$template = join('', <$fp>);
-$fp->close;
-
-# We generate this as a bounce.
-my $mail = mySociety::Email::construct_email({
-    From => [ FixMyStreet->config('CONTACT_EMAIL'), 'FixMyStreet' ],
-    To => $data{return_path},
-    _template_ => $template,
-    _parameters_ => { },
-    _line_indent => '',
-});
-
-if (mySociety::EmailUtil::EMAIL_SUCCESS
-        != mySociety::EmailUtil::send_email($mail, '<>', $data{return_path})) {
-    exit(75);
+exit(0);
+
+# ---
+
+sub get_envelope_token {
+    my $m = $data{message};
+
+    # If we have a special suffix header for the local part suffix, use that.
+    # This is set by our exim so we have access to it through the domain name
+    # forwarding and routers.
+    my $suffix = $m->head()->get("X-Delivered-Suffix");
+    if ($suffix) {
+        chomp $suffix;
+        return substr($suffix, 1);
+    }
+
+    # Otherwise, fall back to To header
+    my $a = mySociety::HandleMail::get_bounce_recipient($m);
+
+    my $token = mySociety::HandleMail::get_token($a,
+        'fms-', FixMyStreet->config('EMAIL_DOMAIN')
+    );
+    exit 0 unless $token; # Don't care unless we have a token
+
+    return $token;
 }
 
-exit(0);
+sub get_object_from_token {
+    return unless $verp;
+
+    my ($type, $id) = FixMyStreet::Email::check_verp_token($token);
+    exit 0 unless $type;
+
+    my $rs;
+    if ($type eq 'report') {
+        $rs = FixMyStreet::DB->resultset('Problem');
+    } elsif ($type eq 'alert') {
+        $rs = FixMyStreet::DB->resultset('Alert');
+    }
 
+    my $object = $rs->find({ id => $id });
+    exit(0) unless $object;
+
+    return ($type, $object);
+}
+
+sub handle_permanent_bounce {
+    if ($type eq 'alert') {
+        print_log('info', "Received bounce for alert " . $object->id . ", unsubscribing");
+        $object->disable();
+    } elsif ($type eq 'report') {
+        print_log('info', "Received bounce for report " . $object->id . ", forwarding to support");
+        forward_on_to(FixMyStreet->config('CONTACT_EMAIL'));
+    }
+}
+
+sub is_out_of_office {
+    my (%attributes) = @_;
+    return 1 if $attributes{problem} && $attributes{problem} == mySociety::HandleMail::ERR_OUT_OF_OFFICE;
+    my $subject = $data{message}->head()->get("Subject");
+    return 1 if $subject =~ /Auto(matic|mated)?[ -]?(reply|response|responder)|Thank you for (your email|contacting)|Thank_you_for_your_email|Out of Office|This office is closed until|^Re: (Problem Report|New updates)|^Auto: |^E-Mail Response$|^Message Received:|have received your email|Acknowledgement of your email/i;
+    return 0;
+}
+
+sub handle_bounce_to_verp_address {
+    my %attributes = mySociety::HandleMail::parse_bounce(\@lines);
+    my $info = '';
+    if ($attributes{is_dsn}) {
+        # If permanent failure, but not mailbox full
+        return handle_permanent_bounce() if $attributes{status} =~ /^5\./ && $attributes{status} ne '5.2.2';
+        $info = ", Status $attributes{status}";
+    } elsif ($attributes{problem}) {
+        my $err_type = mySociety::HandleMail::error_type($attributes{problem});
+        return handle_permanent_bounce() if $err_type == mySociety::HandleMail::ERR_TYPE_PERMANENT;
+        $info = ", Bounce type $attributes{problem}";
+    }
+
+    # Check if the Subject looks like an auto-reply rather than a delivery bounce.
+    # If so, treat as if it were a normal email
+    if (is_out_of_office(%attributes)) {
+        print_log('info', "Treating bounce for $type " . $object->id . " as auto-reply to sender");
+        handle_non_bounce_to_verp_address();
+    } elsif (!$info) {
+        print_log('info', "Unparsed bounce received for $type " . $object->id . ", forwarding to support");
+        forward_on_to(FixMyStreet->config('CONTACT_EMAIL'));
+    } else {
+        print_log('info', "Ignoring bounce received for $type " . $object->id . $info);
+    }
+}
+
+sub handle_non_bounce_to_verp_address {
+    if ($type eq 'alert' && !is_out_of_office()) {
+        print_log('info', "Received non-bounce for alert " . $object->id . ", forwarding to support");
+        forward_on_to(FixMyStreet->config('CONTACT_EMAIL'));
+    } elsif ($type eq 'report') {
+        print_log('info', "Received non-bounce for report " . $object->id . ", forwarding to report creator");
+        forward_on_to($object->user->email);
+    }
+}
+
+sub handle_non_bounce_to_null_address {
+    # Don't send a reply to out of office replies...
+    if (is_out_of_office()) {
+        print_log('info', "Received non-bounce auto-reply to null address, ignoring");
+        return;
+    }
+
+    # Send an automatic response
+    print_log('info', "Received non-bounce to null address, auto-replying");
+    my $template = 'reply-autoresponse';
+    my $fp = FixMyStreet->path_to("templates", "email", "default", $template)->open or exit 75;
+    $template = join('', <$fp>);
+    $fp->close;
+
+    # We generate this as a bounce.
+    my $mail = mySociety::Email::construct_email({
+        From => [ FixMyStreet->config('CONTACT_EMAIL'), 'FixMyStreet' ],
+        To => $data{return_path},
+        _template_ => $template,
+        _parameters_ => { },
+        _line_indent => '',
+    });
+    send_mail($mail, '<>', $data{return_path});
+}
+
+sub forward_on_to {
+    my $recipient = shift;
+    my $text = join("\n", @lines) . "\n";
+    my $sender = $data{return_path} || '<>';
+    send_mail($text, $sender, $recipient);
+}
+
+sub send_mail {
+    my ($text, $sender, $recipient) = @_;
+    if (mySociety::EmailUtil::EMAIL_SUCCESS
+            != mySociety::EmailUtil::send_email($text, $sender, $recipient)) {
+        exit(75);
+    }
+}
diff --git a/commonlib b/commonlib
-Subproject b8516ca3642716852e479f9c0889d267e339b26
+Subproject 4d1ca3580a9eebc56e2e4ef800fdb45a8e2e397
diff --git a/perllib/FixMyStreet/Email.pm b/perllib/FixMyStreet/Email.pm
index e81067da1..1787c32da 100644
--- a/perllib/FixMyStreet/Email.pm
+++ b/perllib/FixMyStreet/Email.pm
@@ -2,11 +2,13 @@ package FixMyStreet::Email;
 
 use Encode;
 use Template;
+use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
 use mySociety::Email;
 use mySociety::Locale;
 use mySociety::Random qw(random_bytes);
 use Utils::Email;
 use FixMyStreet;
+use FixMyStreet::DB;
 use FixMyStreet::EmailSend;
 
 sub test_dmarc {
@@ -15,6 +17,33 @@ sub test_dmarc {
     return Utils::Email::test_dmarc($email);
 }
 
+sub hash_from_id {
+    my ($type, $id) = @_;
+    my $secret = FixMyStreet::DB->resultset('Secret')->get;
+    # Make sure the ID is stringified, a number is treated differently
+    return substr(hmac_sha1_hex("$type-$id", $secret), 0, 8);
+}
+
+sub generate_verp_token {
+    my ($type, $id) = @_;
+    my $hash = hash_from_id($type, $id);
+    return "$type-$id-$hash";
+}
+
+sub check_verp_token {
+    my ($token) = @_;
+    $token = lc($token);
+    $token =~ s#[./_]##g;
+
+    my ($type, $id, $hash) = $token =~ /(report|alert)-([a-z0-9]+)-([a-z0-9]+)/;
+    return unless $type;
+
+    $hash =~ tr/lo/10/;
+    return unless hash_from_id($type, $id) eq $hash;
+
+    return ($type, $id);
+}
+
 sub is_abuser {
     my ($schema, $to) = @_;
 
@@ -87,11 +116,7 @@ sub send_cron {
         print $email;
         return 1; # Failure
     } else {
-        my %model_args;
-        if (!FixMyStreet->test_mode && $env_from eq FixMyStreet->config('CONTACT_EMAIL')) {
-            $model_args{mailer} = 'FixMyStreet::EmailSend::ContactEmail';
-        }
-        my $result = FixMyStreet::EmailSend->new(\%model_args)->send($email);
+        my $result = FixMyStreet::EmailSend->new({ env_from => $env_from })->send($email);
         return $result ? 0 : 1;
     }
 }
diff --git a/perllib/FixMyStreet/EmailSend.pm b/perllib/FixMyStreet/EmailSend.pm
index 1c6e2cf7a..09f434931 100644
--- a/perllib/FixMyStreet/EmailSend.pm
+++ b/perllib/FixMyStreet/EmailSend.pm
@@ -55,7 +55,7 @@ if ( FixMyStreet->test_mode ) {
     push @$mailer_args, username => $username, password => $password
         if $username && $password;
     $args = {
-        mailer      => 'FixMyStreet::EmailSend::DoNotReply',
+        mailer      => 'FixMyStreet::EmailSend::Variable',
         mailer_args => $mailer_args,
     };
 } else {
@@ -67,5 +67,12 @@ sub new {
     my ($cls, $hash) = @_;
     $hash ||= {};
     my %args = ( %$args, %$hash );
+
+    my $sender = delete($args{env_from});
+    if ($sender) {
+        $args{mailer_args} = [ @{$args{mailer_args}} ] if $args{mailer_args};
+        push @{$args{mailer_args}}, env_from => $sender;
+    }
+
     return Email::Send->new(\%args);
 }
diff --git a/perllib/FixMyStreet/EmailSend/ContactEmail.pm b/perllib/FixMyStreet/EmailSend/ContactEmail.pm
deleted file mode 100644
index 28bcc983b..000000000
--- a/perllib/FixMyStreet/EmailSend/ContactEmail.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package FixMyStreet::EmailSend::ContactEmail;
-use base Email::Send::SMTP;
-
-sub get_env_sender {
-    my $sender = FixMyStreet->config('CONTACT_EMAIL');
-    return $sender;
-}
-
-1;
diff --git a/perllib/FixMyStreet/EmailSend/DoNotReply.pm b/perllib/FixMyStreet/EmailSend/DoNotReply.pm
deleted file mode 100644
index d1368f00f..000000000
--- a/perllib/FixMyStreet/EmailSend/DoNotReply.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package FixMyStreet::EmailSend::DoNotReply;
-use base Email::Send::SMTP;
-
-sub get_env_sender {
-    my $sender = FixMyStreet->config('DO_NOT_REPLY_EMAIL');
-    return $sender;
-}
-
-1;
diff --git a/perllib/FixMyStreet/EmailSend/Variable.pm b/perllib/FixMyStreet/EmailSend/Variable.pm
new file mode 100644
index 000000000..4ba56dd41
--- /dev/null
+++ b/perllib/FixMyStreet/EmailSend/Variable.pm
@@ -0,0 +1,17 @@
+package FixMyStreet::EmailSend::Variable;
+use base Email::Send::SMTP;
+use FixMyStreet;
+
+my $sender;
+
+sub send {
+    my ($class, $message, %args) = @_;
+    $sender = delete($args{env_from}) || FixMyStreet->config('DO_NOT_REPLY_EMAIL');
+    $class->SUPER::send($message, %args);
+}
+
+sub get_env_sender {
+    $sender;
+}
+
+1;
diff --git a/perllib/FixMyStreet/Script/Alerts.pm b/perllib/FixMyStreet/Script/Alerts.pm
index fea897a24..e799a5446 100644
--- a/perllib/FixMyStreet/Script/Alerts.pm
+++ b/perllib/FixMyStreet/Script/Alerts.pm
@@ -250,6 +250,11 @@ sub _send_aggregated_alert_email(%) {
 
     my $template = FixMyStreet->get_email_template($cobrand->moniker, $data{lang}, "$data{template}.txt");
 
+    my $sender = sprintf('<fms-%s@%s>',
+        FixMyStreet::Email::generate_verp_token('alert', $data{alert_id}),
+        FixMyStreet->config('EMAIL_DOMAIN')
+    );
+
     my $result = FixMyStreet::Email::send_cron(
         $data{schema},
         {
@@ -257,7 +262,7 @@ sub _send_aggregated_alert_email(%) {
             _parameters_ => \%data,
             To => $data{alert_email},
         },
-        undef,
+        $sender,
         0,
         $cobrand,
         $data{lang}
diff --git a/perllib/FixMyStreet/SendReport/Email.pm b/perllib/FixMyStreet/SendReport/Email.pm
index 4d2c8bb17..7e5c10469 100644
--- a/perllib/FixMyStreet/SendReport/Email.pm
+++ b/perllib/FixMyStreet/SendReport/Email.pm
@@ -98,18 +98,17 @@ sub send {
 
     $params->{Bcc} = $self->bcc if @{$self->bcc};
 
+    my $sender = sprintf('<fms-%s@%s>',
+        FixMyStreet::Email::generate_verp_token('report', $row->id),
+        FixMyStreet->config('EMAIL_DOMAIN')
+    );
+
     if (FixMyStreet::Email::test_dmarc($params->{From}[0])) {
         $params->{'Reply-To'} = [ $params->{From} ];
-        $params->{From} = [ FixMyStreet->config('CONTACT_EMAIL'), $params->{From}[1] ];
+        $params->{From} = [ $sender, $params->{From}[1] ];
     }
 
-    my $result = FixMyStreet::Email::send_cron(
-        $row->result_source->schema,
-        $params,
-        FixMyStreet->config('CONTACT_EMAIL'),
-        $nomail,
-        $cobrand
-    );
+    my $result = FixMyStreet::Email::send_cron($row->result_source->schema, $params, $sender, $nomail, $cobrand);
 
     unless ($result) {
         $self->success(1);
diff --git a/t/email.t b/t/email.t
new file mode 100644
index 000000000..40a650da5
--- /dev/null
+++ b/t/email.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+
+use Test::More;
+use FixMyStreet::Email;
+
+my $secret = FixMyStreet::DB->resultset('Secret')->update({
+    secret => 'abcdef123456' });
+
+my $hash = FixMyStreet::Email::hash_from_id("report", 123);
+is $hash, '8fb274c6', 'Hash generation okay';
+
+my $token = FixMyStreet::Email::generate_verp_token("report", 123);
+is $token, "report-123-8fb274c6", 'Token generation okay';
+
+my ($type, $id) = FixMyStreet::Email::check_verp_token($token);
+is $type, "report", 'Correct type from token';
+is $id, 123, 'Correct ID from token';
+
+done_testing();