aboutsummaryrefslogtreecommitdiffstats
path: root/perllib
diff options
context:
space:
mode:
Diffstat (limited to 'perllib')
-rw-r--r--perllib/FixMyStreet/App.pm125
-rw-r--r--perllib/FixMyStreet/App/Model/EmailSend.pm55
-rw-r--r--perllib/FixMyStreet/DB/ResultSet/AlertType.pm21
-rw-r--r--perllib/FixMyStreet/DB/ResultSet/Problem.pm4
-rw-r--r--perllib/FixMyStreet/DB/ResultSet/Questionnaire.pm5
-rw-r--r--perllib/FixMyStreet/Email.pm124
-rw-r--r--perllib/FixMyStreet/EmailSend.pm70
-rw-r--r--perllib/FixMyStreet/SendReport/Email.pm3
8 files changed, 225 insertions, 182 deletions
diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm
index c9286b177..e4c113ea1 100644
--- a/perllib/FixMyStreet/App.pm
+++ b/perllib/FixMyStreet/App.pm
@@ -2,9 +2,6 @@ package FixMyStreet::App;
use Moose;
use namespace::autoclean;
-# Should move away from Email::Send, but until then:
-$Return::Value::NO_CLUCK = 1;
-
use Catalyst::Runtime 5.80;
use FixMyStreet;
use FixMyStreet::Cobrand;
@@ -12,6 +9,7 @@ use Memcached;
use mySociety::Email;
use mySociety::Random qw(random_bytes);
use FixMyStreet::Map;
+use FixMyStreet::Email;
use Utils;
use Path::Class;
@@ -319,7 +317,7 @@ sub send_email {
]
};
- return if $c->is_abuser($vars->{to});
+ return if FixMyStreet::Email::is_abuser($c->model('DB')->schema, $vars->{to});
# render the template
my $content = $c->view('Email')->render( $c, $template, $vars );
@@ -347,7 +345,7 @@ sub send_email {
) };
if (my $attachments = $extra_stash_values->{attachments}) {
- $email_text = munge_attachments($email_text, $attachments);
+ $email_text = FixMyStreet::Email::munge_attachments($email_text, $attachments);
}
# send the email
@@ -356,107 +354,6 @@ sub send_email {
return $email;
}
-sub send_email_cron {
- my ( $c, $params, $env_from, $nomail, $cobrand, $lang_code ) = @_;
-
- my $sender = $c->config->{DO_NOT_REPLY_EMAIL};
- $env_from ||= $sender;
- if (!$params->{From}) {
- my $sender_name = $cobrand->contact_name;
- $params->{From} = [ $sender, _($sender_name) ];
- }
-
- return 1 if $c->is_abuser($params->{To});
-
- $params->{'Message-ID'} = sprintf('<fms-cron-%s-%s@%s>', time(),
- unpack('h*', random_bytes(5, 1)), FixMyStreet->config('EMAIL_DOMAIN')
- );
-
- # This is all to set the path for the templates processor so we can override
- # signature and site names in emails using templates in the old style emails.
- # It's a bit involved as not everywhere we use it knows about the cobrand so
- # we can't assume there will be one.
- my $include_path = FixMyStreet->path_to( 'templates', 'email', 'default' )->stringify;
- if ( $cobrand ) {
- $include_path =
- FixMyStreet->path_to( 'templates', 'email', $cobrand->moniker )->stringify . ':'
- . $include_path;
- if ( $lang_code ) {
- $include_path =
- FixMyStreet->path_to( 'templates', 'email', $cobrand->moniker, $lang_code )->stringify . ':'
- . $include_path;
- }
- }
- my $tt = Template->new({
- INCLUDE_PATH => $include_path
- });
- my ($sig, $site_name);
- $tt->process( 'signature.txt', $params, \$sig );
- $sig = Encode::decode('utf8', $sig);
- $params->{_parameters_}->{signature} = $sig;
-
- $tt->process( 'site-name.txt', $params, \$site_name );
- $site_name = Utils::trim_text(Encode::decode('utf8', $site_name));
- $params->{_parameters_}->{site_name} = $site_name;
-
- $params->{_line_indent} = '';
- my $attachments = delete $params->{attachments};
-
- my $email = mySociety::Locale::in_gb_locale { mySociety::Email::construct_email($params) };
-
- $email = munge_attachments($email, $attachments) if $attachments;
-
- if ($nomail) {
- 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 = $c->model('EmailSend', %model_args)->send($email);
- return $result ? 0 : 1;
- }
-}
-
-sub munge_attachments {
- my ($message, $attachments) = @_;
- # $attachments should be an array_ref of things that can be parsed to Email::MIME,
- # for example
- # [
- # body => $binary_data,
- # attributes => {
- # content_type => 'image/jpeg',
- # encoding => 'base64',
- # filename => '1234.1.jpeg',
- # name => '1234.1.jpeg',
- # },
- # ...
- # ]
- #
- # XXX: mySociety::Email::construct_email isn't using a MIME library and
- # requires more analysis to refactor, so for now, we'll simply parse the
- # generated MIME and add attachments.
- #
- # (Yes, this means that the email is constructed by Email::Simple, munged
- # manually by custom code, turned back into Email::Simple, and then munged
- # with Email::MIME. What's your point?)
-
- require Email::MIME;
- my $mime = Email::MIME->new($message);
- $mime->parts_add([ map { Email::MIME->create(%$_)} @$attachments ]);
- my $data = $mime->as_string;
-
- # unsure why Email::MIME adds \r\n. Possibly mail client should handle
- # gracefully, BUT perhaps as the segment constructed by
- # mySociety::Email::construct_email strips to \n, they seem not to.
- # So we re-run the same regexp here to the added part.
- $data =~ s/\r\n/\n/gs;
-
- return $data;
-}
-
-
=head2 uri_with
$uri = $c->uri_with( ... );
@@ -571,22 +468,6 @@ sub get_photo_params {
return $photo;
}
-sub is_abuser {
- my ($c, $to) = @_;
- my $email;
- if (ref($to) eq 'ARRAY') {
- if (ref($to->[0]) eq 'ARRAY') {
- $email = $to->[0][0];
- } else {
- $email = $to->[0];
- }
- } else {
- $email = $to;
- }
- my ($domain) = $email =~ m{ @ (.*) \z }x;
- return $c->model('DB::Abuse')->search( { email => [ $email, $domain ] } )->first;
-}
-
=head2 get_param
$param = $c->get_param('name');
diff --git a/perllib/FixMyStreet/App/Model/EmailSend.pm b/perllib/FixMyStreet/App/Model/EmailSend.pm
index 475026267..93751d4a6 100644
--- a/perllib/FixMyStreet/App/Model/EmailSend.pm
+++ b/perllib/FixMyStreet/App/Model/EmailSend.pm
@@ -4,67 +4,16 @@ use base 'Catalyst::Model::Factory';
use strict;
use warnings;
-use FixMyStreet;
-use Email::Send;
-
=head1 NAME
FixMyStreet::App::Model::EmailSend
=head1 DESCRIPTION
-Thin wrapper around Email::Send - configuring it correctly acording to our config.
-
-If the config value 'SMTP_SMARTHOST' is set then email is routed via SMTP to
-that. Otherwise it is sent using a 'sendmail' like binary on the local system.
-
-And finally if if FixMyStreet->test_mode returns true then emails are not sent
-at all but are stored in memory for the test suite to inspect (using
-Email::Send::Test).
+Catalyst Model wrapper around FixMyStreet::EmailSend
=cut
-my $args = undef;
-
-if ( FixMyStreet->test_mode ) {
-
- # Email::Send::Test
- $args = { mailer => 'Test', };
-}
-elsif ( my $smtp_host = FixMyStreet->config('SMTP_SMARTHOST') ) {
-
- # Email::Send::SMTP
- my $type = FixMyStreet->config('SMTP_TYPE') || '';
- my $port = FixMyStreet->config('SMTP_PORT') || '';
- my $username = FixMyStreet->config('SMTP_USERNAME') || '';
- my $password = FixMyStreet->config('SMTP_PASSWORD') || '';
-
- unless ($port) {
- $port = 25;
- $port = 465 if $type eq 'ssl';
- $port = 587 if $type eq 'tls';
- }
-
- my $mailer_args = [
- Host => $smtp_host,
- Port => $port,
- ];
- push @$mailer_args, ssl => 1 if $type eq 'ssl';
- push @$mailer_args, tls => 1 if $type eq 'tls';
- push @$mailer_args, username => $username, password => $password
- if $username && $password;
- $args = {
- mailer => 'FixMyStreet::EmailSend::DoNotReply',
- mailer_args => $mailer_args,
- };
-}
-else {
-
- # Email::Send::Sendmail
- $args = { mailer => 'Sendmail' };
-}
-
__PACKAGE__->config(
- class => 'Email::Send',
- args => $args,
+ class => 'FixMyStreet::EmailSend',
);
diff --git a/perllib/FixMyStreet/DB/ResultSet/AlertType.pm b/perllib/FixMyStreet/DB/ResultSet/AlertType.pm
index 25c727e25..114f79c6e 100644
--- a/perllib/FixMyStreet/DB/ResultSet/AlertType.pm
+++ b/perllib/FixMyStreet/DB/ResultSet/AlertType.pm
@@ -11,11 +11,14 @@ use mySociety::MaPit;
use IO::String;
use RABX;
+use FixMyStreet::Email;
+
# Child must have confirmed, id, email, state(!) columns
# If parent/child, child table must also have name and text
# and foreign key to parent must be PARENT_id
sub email_alerts ($) {
my ( $rs ) = @_;
+ my $schema = $rs->result_source->schema;
my $q = $rs->search( { ref => { -not_like => '%local_problems%' } } );
while (my $alert_type = $q->next) {
@@ -55,7 +58,7 @@ sub email_alerts ($) {
$query = dbh()->prepare($query);
$query->execute();
my $last_alert_id;
- my %data = ( template => $alert_type->template, data => '' );
+ my %data = ( template => $alert_type->template, data => '', schema => $schema );
while (my $row = $query->fetchrow_hashref) {
my $cobrand = FixMyStreet::Cobrand->get_class_for_moniker($row->{alert_cobrand})->new();
@@ -76,7 +79,7 @@ sub email_alerts ($) {
} );
if ($last_alert_id && $last_alert_id != $row->{alert_id}) {
_send_aggregated_alert_email(%data);
- %data = ( template => $alert_type->template, data => '' );
+ %data = ( template => $alert_type->template, data => '', schema => $schema );
}
# create problem status message for the templates
@@ -173,7 +176,16 @@ sub email_alerts ($) {
sprintf("%f", int($d*10+0.5)/10);
};
my $states = "'" . join( "', '", FixMyStreet::DB::Result::Problem::visible_states() ) . "'";
- my %data = ( template => $template, data => '', alert_id => $alert->id, alert_email => $alert->user->email, lang => $alert->lang, cobrand => $alert->cobrand, cobrand_data => $alert->cobrand_data );
+ my %data = (
+ template => $template,
+ data => '',
+ alert_id => $alert->id,
+ alert_email => $alert->user->email,
+ lang => $alert->lang,
+ cobrand => $alert->cobrand,
+ cobrand_data => $alert->cobrand_data,
+ schema => $schema,
+ );
my $q = "select problem.id, problem.bodies_str, problem.postcode, problem.geocode, problem.title from problem_find_nearby(?, ?, ?) as nearby, problem, users
where nearby.problem_id = problem.id
and problem.user_id = users.id
@@ -233,7 +245,8 @@ sub _send_aggregated_alert_email(%) {
my $template = FixMyStreet->get_email_template($cobrand->moniker, $data{lang}, "$data{template}.txt");
- my $result = FixMyStreet::App->send_email_cron(
+ my $result = FixMyStreet::Email::send_cron(
+ $data{schema},
{
_template_ => $template,
_parameters_ => \%data,
diff --git a/perllib/FixMyStreet/DB/ResultSet/Problem.pm b/perllib/FixMyStreet/DB/ResultSet/Problem.pm
index e9f5d0f8e..0c2811b7b 100644
--- a/perllib/FixMyStreet/DB/ResultSet/Problem.pm
+++ b/perllib/FixMyStreet/DB/ResultSet/Problem.pm
@@ -11,6 +11,7 @@ use mySociety::Config;
use mySociety::MaPit;
use FixMyStreet::App;
+use FixMyStreet::Email;
use FixMyStreet::SendReport;
my $site_key;
@@ -513,7 +514,8 @@ sub _send_report_sent_email {
my $template = FixMyStreet->get_email_template($row->cobrand, $row->lang, 'confirm_report_sent.txt');
- FixMyStreet::App->send_email_cron(
+ FixMyStreet::Email::send_cron(
+ $row->result_source->schema,
{
_template_ => $template,
_parameters_ => $h,
diff --git a/perllib/FixMyStreet/DB/ResultSet/Questionnaire.pm b/perllib/FixMyStreet/DB/ResultSet/Questionnaire.pm
index bf1c68c49..f9d32f2c1 100644
--- a/perllib/FixMyStreet/DB/ResultSet/Questionnaire.pm
+++ b/perllib/FixMyStreet/DB/ResultSet/Questionnaire.pm
@@ -6,6 +6,8 @@ use warnings;
use Encode;
use Utils;
+use FixMyStreet::Email;
+
sub send_questionnaires {
my ( $rs, $params ) = @_;
$rs->send_questionnaires_period( '4 weeks', $params );
@@ -89,7 +91,8 @@ sub send_questionnaires_period {
. $row->user->email . "\n"
if $params->{verbose};
- my $result = FixMyStreet::App->send_email_cron(
+ my $result = FixMyStreet::Email::send_cron(
+ $rs->result_source->schema,
{
_template_ => $template,
_parameters_ => \%h,
diff --git a/perllib/FixMyStreet/Email.pm b/perllib/FixMyStreet/Email.pm
index 4a2784787..a65a5e340 100644
--- a/perllib/FixMyStreet/Email.pm
+++ b/perllib/FixMyStreet/Email.pm
@@ -1,7 +1,13 @@
package FixMyStreet::Email;
+use Encode;
+use Template;
+use mySociety::Email;
+use mySociety::Locale;
+use mySociety::Random qw(random_bytes);
use Utils::Email;
use FixMyStreet;
+use FixMyStreet::EmailSend;
sub test_dmarc {
my $email = shift;
@@ -9,4 +15,122 @@ sub test_dmarc {
return Utils::Email::test_dmarc($email);
}
+sub is_abuser {
+ my ($schema, $to) = @_;
+
+ my $email;
+ if (ref($to) eq 'ARRAY') {
+ if (ref($to->[0]) eq 'ARRAY') {
+ $email = $to->[0][0];
+ } else {
+ $email = $to->[0];
+ }
+ } else {
+ $email = $to;
+ }
+
+ my ($domain) = $email =~ m{ @ (.*) \z }x;
+ return $schema->resultset('Abuse')->search( { email => [ $email, $domain ] } )->first;
+}
+
+sub send_cron {
+ my ( $schema, $params, $env_from, $nomail, $cobrand, $lang_code ) = @_;
+
+ my $sender = FixMyStreet->config('DO_NOT_REPLY_EMAIL');
+ $env_from ||= $sender;
+ if (!$params->{From}) {
+ my $sender_name = $cobrand->contact_name;
+ $params->{From} = [ $sender, _($sender_name) ];
+ }
+
+ return 1 if is_abuser($schema, $params->{To});
+
+ $params->{'Message-ID'} = sprintf('<fms-cron-%s-%s@%s>', time(),
+ unpack('h*', random_bytes(5, 1)), FixMyStreet->config('EMAIL_DOMAIN')
+ );
+
+ # This is all to set the path for the templates processor so we can override
+ # signature and site names in emails using templates in the old style emails.
+ # It's a bit involved as not everywhere we use it knows about the cobrand so
+ # we can't assume there will be one.
+ my $include_path = FixMyStreet->path_to( 'templates', 'email', 'default' )->stringify;
+ if ( $cobrand ) {
+ $include_path =
+ FixMyStreet->path_to( 'templates', 'email', $cobrand->moniker )->stringify . ':'
+ . $include_path;
+ if ( $lang_code ) {
+ $include_path =
+ FixMyStreet->path_to( 'templates', 'email', $cobrand->moniker, $lang_code )->stringify . ':'
+ . $include_path;
+ }
+ }
+ my $tt = Template->new({
+ INCLUDE_PATH => $include_path
+ });
+ my ($sig, $site_name);
+ $tt->process( 'signature.txt', $params, \$sig );
+ $sig = Encode::decode('utf8', $sig);
+ $params->{_parameters_}->{signature} = $sig;
+
+ $tt->process( 'site-name.txt', $params, \$site_name );
+ $site_name = Utils::trim_text(Encode::decode('utf8', $site_name));
+ $params->{_parameters_}->{site_name} = $site_name;
+
+ $params->{_line_indent} = '';
+ my $attachments = delete $params->{attachments};
+
+ my $email = mySociety::Locale::in_gb_locale { mySociety::Email::construct_email($params) };
+
+ $email = munge_attachments($email, $attachments) if $attachments;
+
+ if ($nomail) {
+ 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);
+ return $result ? 0 : 1;
+ }
+}
+
+sub munge_attachments {
+ my ($message, $attachments) = @_;
+ # $attachments should be an array_ref of things that can be parsed to Email::MIME,
+ # for example
+ # [
+ # body => $binary_data,
+ # attributes => {
+ # content_type => 'image/jpeg',
+ # encoding => 'base64',
+ # filename => '1234.1.jpeg',
+ # name => '1234.1.jpeg',
+ # },
+ # ...
+ # ]
+ #
+ # XXX: mySociety::Email::construct_email isn't using a MIME library and
+ # requires more analysis to refactor, so for now, we'll simply parse the
+ # generated MIME and add attachments.
+ #
+ # (Yes, this means that the email is constructed by Email::Simple, munged
+ # manually by custom code, turned back into Email::Simple, and then munged
+ # with Email::MIME. What's your point?)
+
+ require Email::MIME;
+ my $mime = Email::MIME->new($message);
+ $mime->parts_add([ map { Email::MIME->create(%$_)} @$attachments ]);
+ my $data = $mime->as_string;
+
+ # unsure why Email::MIME adds \r\n. Possibly mail client should handle
+ # gracefully, BUT perhaps as the segment constructed by
+ # mySociety::Email::construct_email strips to \n, they seem not to.
+ # So we re-run the same regexp here to the added part.
+ $data =~ s/\r\n/\n/gs;
+
+ return $data;
+}
+
1;
diff --git a/perllib/FixMyStreet/EmailSend.pm b/perllib/FixMyStreet/EmailSend.pm
new file mode 100644
index 000000000..29c93b2d6
--- /dev/null
+++ b/perllib/FixMyStreet/EmailSend.pm
@@ -0,0 +1,70 @@
+package FixMyStreet::EmailSend;
+
+use strict;
+use warnings;
+
+BEGIN {
+ # Should move away from Email::Send, but until then:
+ $Return::Value::NO_CLUCK = 1;
+}
+
+use FixMyStreet;
+use Email::Send;
+
+=head1 NAME
+
+FixMyStreet::EmailSend
+
+=head1 DESCRIPTION
+
+Thin wrapper around Email::Send - configuring it correctly according to our config.
+
+If the config value 'SMTP_SMARTHOST' is set then email is routed via SMTP to
+that. Otherwise it is sent using a 'sendmail' like binary on the local system.
+
+And finally if if FixMyStreet->test_mode returns true then emails are not sent
+at all but are stored in memory for the test suite to inspect (using
+Email::Send::Test).
+
+=cut
+
+my $args = undef;
+
+if ( FixMyStreet->test_mode ) {
+ # Email::Send::Test
+ $args = { mailer => 'Test', };
+} elsif ( my $smtp_host = FixMyStreet->config('SMTP_SMARTHOST') ) {
+ # Email::Send::SMTP
+ my $type = FixMyStreet->config('SMTP_TYPE') || '';
+ my $port = FixMyStreet->config('SMTP_PORT') || '';
+ my $username = FixMyStreet->config('SMTP_USERNAME') || '';
+ my $password = FixMyStreet->config('SMTP_PASSWORD') || '';
+
+ unless ($port) {
+ $port = 25;
+ $port = 465 if $type eq 'ssl';
+ $port = 587 if $type eq 'tls';
+ }
+
+ my $mailer_args = [
+ Host => $smtp_host,
+ Port => $port,
+ ];
+ push @$mailer_args, ssl => 1 if $type eq 'ssl';
+ push @$mailer_args, tls => 1 if $type eq 'tls';
+ push @$mailer_args, username => $username, password => $password
+ if $username && $password;
+ $args = {
+ mailer => 'FixMyStreet::EmailSend::DoNotReply',
+ mailer_args => $mailer_args,
+ };
+} else {
+ # Email::Send::Sendmail
+ $args = { mailer => 'Sendmail' };
+}
+
+sub new {
+ my ($cls, %hash) = @_;
+ my %args = ( %$args, %hash );
+ return Email::Send->new(\%args);
+}
diff --git a/perllib/FixMyStreet/SendReport/Email.pm b/perllib/FixMyStreet/SendReport/Email.pm
index bac408510..95c460006 100644
--- a/perllib/FixMyStreet/SendReport/Email.pm
+++ b/perllib/FixMyStreet/SendReport/Email.pm
@@ -105,7 +105,8 @@ sub send {
$params->{From} = [ mySociety::Config::get('CONTACT_EMAIL'), $params->{From}[1] ];
}
- my $result = $app->send_email_cron(
+ my $result = FixMyStreet::Email::send_cron(
+ $row->result_source->schema,
$params,
mySociety::Config::get('CONTACT_EMAIL'),
$nomail,
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-26 18:13:00 +0000