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.

7 files changed, 68 insertions, 33 deletions

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);