1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
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 {
my $email = shift;
return if FixMyStreet->test_mode;
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) = @_;
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 $result = FixMyStreet::EmailSend->new({ env_from => $env_from })->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;
|
