Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Mailer.pm
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Mailer.pm

added on local at 2026-07-01 15:02:53

Added
+576
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to e038cb29f424
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::ContactForge::Mailer;
2#======================================================================
3# ContactForge -- email transport.
4#
5# Two distinct send paths:
6#
7# send() / send_template()
8# PLATFORM emails (welcome, password reset, billing receipts,
9# admin alerts). Routed through the platform's own SMTP creds
10# in Config::smtp_host / smtp_user / smtp_pass with local
11# sendmail fallback. This is OUR reputation.
12#
13# send_bulk(user_id => ..., to => ..., ...)
14# TENANT-driven bulk sends (campaigns, drip sequences). Looked up
15# per-user from MODS::ContactForge::EmailProviders -- they bring
16# their OWN SMTP account (SES / Postmark / SendGrid / Mailgun /
17# custom). Their reputation, their bill, their spam liability.
18# Never falls back to local sendmail -- if they have no provider
19# configured, the send fails closed with a clear error.
20#======================================================================
21
22use strict;
23use warnings;
24
25use MODS::ContactForge::Config;
26use MODS::ContactForge::EmailProviders;
27
28my $config = MODS::ContactForge::Config->new;
29
30# Vars that are allowed to contain URLs unchanged. Everything else passed
31# in vars{} gets URL-stripped + length-capped before substitution so an
32# attacker can't smuggle a payload through display_name / company_name
33# / inviter_name / etc.
34my %URL_ALLOWED = map { $_ => 1 } qw(
35 unsubscribe_url billing_url dashboard_url action_url
36 invite_url accept_url reset_url login_url logout_url
37 verify_url support_url abuse_url
38);
39
40# Slugs that bypass the account-age gate. Without these, a brand-new
41# signup couldn't verify their own email or reset their password.
42my %AGE_GATE_BYPASS = map { $_ => 1 } qw(
43 password_reset email_verify verify_email welcome
44);
45
46sub _setting {
47 my ($key, $default) = @_;
48 my $v = $config->settings($key);
49 return (defined $v && $v ne '') ? $v : $default;
50}
51
52sub new {
53 my ($class) = @_;
54 return bless({}, $class);
55}
56
57# send(to => '...', subject => '...', body_text => '...', body_html => '...')
58sub send {
59 my ($self, %a) = @_;
60 my $to = $a{to} || return 0;
61 my $subject = $a{subject} || '(no subject)';
62 my $body = $a{body_html} || $a{body_text} || '';
63 my $is_html = exists $a{body_html} ? 1 : 0;
64 my $from = $config->settings('from_email') || 'noreply@crm.3dshawn.com';
65 my $brand = $config->settings('brand_name') || 'ContactForge';
66 my $from_h = qq~"$brand" <$from>~;
67
68 # Try SMTP
69 my $smtp_host = $config->settings('smtp_host') || '';
70 my $bounce = 0;
71 if ($smtp_host) {
72 if (_send_smtp($smtp_host, $config->settings('smtp_port') || 587,
73 $config->settings('smtp_user') || '',
74 $config->settings('smtp_pass') || '',
75 $from_h, $to, $subject, $body, $is_html, \$bounce)) {
76 _log("smtp ok", $to, $subject);
77 return 1;
78 }
79 _log($bounce ? "smtp bounce" : "smtp fail", $to, $subject);
80 $self->{_last_bounce} = $bounce;
81 return 0 if $bounce; # don't fall back to sendmail for known bounces
82 }
83
84 # Try local sendmail
85 if (_send_sendmail($from_h, $to, $subject, $body, $is_html)) {
86 _log("sendmail ok", $to, $subject);
87 return 1;
88 }
89 _log("all fail", $to, $subject);
90 return 0;
91}
92
93sub _send_smtp {
94 my ($host, $port, $user, $pass, $from_h, $to, $subject, $body, $is_html, $bounce_ref) = @_;
95 $$bounce_ref = 0 if ref $bounce_ref;
96 return 0 unless eval { require Net::SMTP; 1 };
97 my $smtp = eval { Net::SMTP->new($host, Port => $port, Timeout => 15, Hello => 'crm.3dshawn.com') };
98 return 0 unless $smtp;
99 if ($user && $pass) {
100 eval { $smtp->auth($user, $pass) } or do { $smtp->quit; return 0; };
101 }
102 my ($from_addr) = ($from_h =~ /<(.+?)>/); $from_addr ||= $from_h;
103 eval { $smtp->mail($from_addr) } or do { $smtp->quit; return 0; };
104 my $rcpt_ok = eval { $smtp->to($to) };
105 unless ($rcpt_ok) {
106 my $code = eval { $smtp->code() } || 0;
107 my $msg = eval { $smtp->message() } || '';
108 $$bounce_ref = 1 if ref($bounce_ref) && ($code >= 500
109 || $msg =~ /no such user|user unknown|recipient.*reject|invalid.*recipient|mailbox.*not.*found/i);
110 $smtp->quit; return 0;
111 }
112 $smtp->data();
113 $smtp->datasend("From: $from_h\n");
114 $smtp->datasend("To: $to\n");
115 $smtp->datasend("Subject: $subject\n");
116 $smtp->datasend("MIME-Version: 1.0\n");
117 $smtp->datasend("Content-Type: " . ($is_html ? 'text/html' : 'text/plain') . "; charset=utf-8\n\n");
118 $smtp->datasend($body);
119 $smtp->datasend("\n");
120 $smtp->dataend();
121 $smtp->quit;
122 return 1;
123}
124
125sub _send_sendmail {
126 my ($from_h, $to, $subject, $body, $is_html) = @_;
127 my $sendmail = -x '/usr/sbin/sendmail' ? '/usr/sbin/sendmail'
128 : -x '/usr/bin/sendmail' ? '/usr/bin/sendmail' : '';
129 return 0 unless $sendmail;
130 open(my $fh, "|$sendmail -t -i") or return 0;
131 my ($from_addr) = ($from_h =~ /<(.+?)>/); $from_addr ||= $from_h;
132 print $fh "From: $from_h\n";
133 print $fh "To: $to\n";
134 print $fh "Subject: $subject\n";
135 print $fh "MIME-Version: 1.0\n";
136 print $fh "Content-Type: " . ($is_html ? 'text/html' : 'text/plain') . "; charset=utf-8\n\n";
137 print $fh $body;
138 print $fh "\n";
139 close $fh;
140 return $? == 0 ? 1 : 0;
141}
142
143sub _log {
144 my ($status, $to, $subject) = @_;
145 my $path = $config->settings('uploads_dir') || '/tmp';
146 $path .= '/_mail.log';
147 if (open(my $fh, '>>', $path)) {
148 print $fh scalar(localtime), "\t", $status, "\t", $to, "\t", $subject, "\n";
149 close $fh;
150 }
151}
152
153# ---------------------------------------------------------------------
154# send_bulk(user_id => N, to => '...', subject => '...',
155# body_html => '...', body_text => '...', reply_to => '...')
156#
157# Tenant-driven campaign send. Routes through the user's own SMTP
158# provider in email_providers. Never falls back to local sendmail --
159# returns (0, error_message) if the tenant has nothing configured.
160#
161# Side effects on success: bumps last_send_at + monthly_send_count.
162# Side effects on bounce: bumps bounce_count.
163# Caller is responsible for higher-level send-quota enforcement (the
164# pricing-tier's emails_included cap). This method does not throttle.
165# ---------------------------------------------------------------------
166sub send_bulk {
167 my ($self, %a) = @_;
168 my $user_id = ($a{user_id} || 0) + 0;
169 my $to = $a{to} || '';
170 my $subject = $a{subject} || '(no subject)';
171 my $body = $a{body_html} || $a{body_text} || '';
172 my $is_html = exists $a{body_html} ? 1 : 0;
173
174 return (0, 'user_id required for send_bulk') unless $user_id;
175 return (0, 'recipient required') unless $to =~ /\@/;
176
177 require MODS::DBConnect;
178 my $cfg = MODS::ContactForge::Config->new;
179 my $DB = $cfg->settings('database_name');
180 my $db = MODS::DBConnect->new;
181 my $dbh = eval { $db->db_connect() };
182 return (0, 'db connect failed') unless $dbh;
183
184 my $eps = MODS::ContactForge::EmailProviders->new;
185 my $p = $eps->active_for_user($db, $dbh, $DB, $user_id);
186 unless ($p) {
187 eval { $db->db_disconnect($dbh) };
188 return (0, 'No SMTP provider connected. Visit Settings -> Email Provider to connect SES / Postmark / SendGrid / Mailgun / custom SMTP.');
189 }
190 if ($p->{paused_at}) {
191 eval { $db->db_disconnect($dbh) };
192 return (0, "SMTP provider paused: " . ($p->{paused_reason} || 'manual pause'));
193 }
194
195 # Honor the per-row reply_to but let the caller override.
196 $p->{reply_to} = $a{reply_to} if defined $a{reply_to};
197
198 my ($ok, $msg) = MODS::ContactForge::EmailProviders::_net_smtp_send(
199 $p, $to, $subject, $body, $is_html
200 );
201
202 if ($ok) {
203 $eps->record_send($db, $dbh, $DB, $p->{id});
204 _log("bulk ok", $to, $subject);
205 } else {
206 # Treat 5xx-style messages as bounces; everything else just fails.
207 if ($msg =~ /no such user|user unknown|mailbox.*not.*found|recipient.*reject|RCPT TO/i) {
208 $eps->record_bounce($db, $dbh, $DB, $p->{id});
209 }
210 _log("bulk fail: $msg", $to, $subject);
211 }
212 eval { $db->db_disconnect($dbh) };
213 return ($ok, $msg);
214}
215
216# ---------------------------------------------------------------------
217# send_template(slug => '...', user_id => N, vars => {...})
218#
219# Look up an editable template by slug, fill {{vars}}, append the
220# unsubscribe footer (lifecycle/product/marketing only -- transactional
221# is forced through), respect user_email_preferences, log to
222# email_sends_log, and hand the rendered HTML to send().
223#
224# Returns 1 on send, 0 on suppressed/failed. Always logs to email_sends_log.
225# ---------------------------------------------------------------------
226sub send_template {
227 my ($self, %a) = @_;
228 my $slug = $a{slug} or return 0;
229 my $user_id = $a{user_id} + 0;
230 my $vars = $a{vars} || {};
231 my $to_override = $a{to}; # optional override (e.g., admin "send test")
232
233 require MODS::DBConnect;
234 require MODS::ContactForge::Config;
235 my $cfg = MODS::ContactForge::Config->new;
236 my $DB = $cfg->settings('database_name');
237 my $db = MODS::DBConnect->new;
238 my $dbh = eval { $db->db_connect() };
239 return 0 unless $dbh;
240
241 # 1. Load template
242 my $slug_q = $slug; $slug_q =~ s/'/''/g;
243 my $tpl = $db->db_readwrite($dbh, qq~
244 SELECT id, slug, category, subject, body_html, is_active
245 FROM `${DB}`.email_templates WHERE slug='$slug_q' LIMIT 1
246 ~, $0, __LINE__);
247 unless ($tpl && $tpl->{id} && $tpl->{is_active}) {
248 $self->_log_send($db, $dbh, $DB, $user_id, undef, $slug, '', '(no template)', 'failed', 'template missing or inactive');
249 eval { $db->db_disconnect($dbh) };
250 return 0;
251 }
252
253 # 2. Resolve recipient + load user info
254 my $to_email = $to_override;
255 my $user;
256 if ($user_id) {
257 $user = $db->db_readwrite($dbh, qq~
258 SELECT id, email, display_name, company_id FROM `${DB}`.users WHERE id='$user_id' LIMIT 1
259 ~, $0, __LINE__);
260 $to_email ||= $user->{email} if $user;
261 }
262 unless ($to_email) {
263 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, '', $tpl->{subject}, 'failed', 'no recipient');
264 eval { $db->db_disconnect($dbh) };
265 return 0;
266 }
267
268 # 3. Check user prefs (transactional bypasses)
269 if ($user_id && $tpl->{category} ne 'transactional') {
270 my $pref = $db->db_readwrite($dbh, qq~
271 SELECT is_subscribed FROM `${DB}`.user_email_preferences
272 WHERE user_id='$user_id' AND category='$tpl->{category}' LIMIT 1
273 ~, $0, __LINE__);
274 # Default-on for lifecycle, default-off for product+marketing
275 my $default_on = ($tpl->{category} eq 'lifecycle') ? 1 : 0;
276 my $sub = (defined $pref->{is_subscribed}) ? ($pref->{is_subscribed} ? 1 : 0) : $default_on;
277 unless ($sub) {
278 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, $to_email, $tpl->{subject}, 'suppressed_pref', "category=$tpl->{category}");
279 eval { $db->db_disconnect($dbh) };
280 return 0;
281 }
282 }
283
284 # 4. Auto-fill standard vars + ensure unsubscribe URL exists
285 $vars->{display_name} //= ($user && $user->{display_name}) || '';
286 $vars->{first_name} //= (split /\s+/, $vars->{display_name})[0] || '';
287 $vars->{billing_url} //= 'https://crm.3dshawn.com/billing.cgi';
288 $vars->{dashboard_url} //= 'https://crm.3dshawn.com/dashboard.cgi';
289 $vars->{unsubscribe_url} //= $self->_unsubscribe_url($db, $dbh, $DB, $user_id);
290 $vars->{abuse_url} //= $self->_abuse_url($db, $dbh, $DB, $user_id, $slug);
291
292 # 4b. Sanitize every var that's NOT a URL whitelist field. Closes the
293 # "inviter_name = 'Free Bitcoin https://evil.tld'" payload-injection
294 # vector — fixed template body can still carry a URL-bearing display
295 # name into the recipient's inbox.
296 foreach my $k (keys %$vars) {
297 next if $URL_ALLOWED{$k};
298 $vars->{$k} = _sanitize_display_var($vars->{$k});
299 }
300
301 # 4c. Rate limit BEFORE rendering and sending. Hits both the team-invite
302 # flow and the admin "send test" flow at this single chokepoint.
303 my ($ok_rl, $rl_reason) = $self->_rate_limit_check($db, $dbh, $DB, $user_id, $slug, $to_email);
304 unless ($ok_rl) {
305 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, $to_email, $tpl->{subject},
306 'suppressed_rate', $rl_reason);
307 eval { $db->db_disconnect($dbh) };
308 return 0;
309 }
310
311 # 5. Render: {{var}} substitution
312 my $subject = _render_vars($tpl->{subject}, $vars);
313 my $body = _render_vars($tpl->{body_html}, $vars);
314
315 # 6. Append footer (lifecycle/product/marketing -- not transactional)
316 if ($tpl->{category} ne 'transactional') {
317 $body .= qq~
318<hr style="border:0;border-top:1px solid #e5e7eb;margin:32px 0 16px">
319<p style="color:#94a3b8;font-size:11px;text-align:center;line-height:1.5">
320You're receiving this because you have a ContactForge account.<br>
321<a href="$vars->{unsubscribe_url}" style="color:#94a3b8">Manage email preferences</a> &middot;
322<a href="$vars->{unsubscribe_url}&unsub_all=1" style="color:#94a3b8">Unsubscribe all</a> &middot;
323<a href="$vars->{abuse_url}" style="color:#94a3b8">Report this email as abuse</a>
324</p>~;
325 } else {
326 # Transactional gets a slimmer abuse-only footer (no unsubscribe -- legal)
327 $body .= qq~
328<hr style="border:0;border-top:1px solid #e5e7eb;margin:24px 0 12px">
329<p style="color:#94a3b8;font-size:11px;text-align:center;line-height:1.5">
330Didn't expect this email? <a href="$vars->{abuse_url}" style="color:#94a3b8">Report as abuse</a>
331</p>~;
332 }
333
334 eval { $db->db_disconnect($dbh) };
335
336 # 7. Send via the existing send() path
337 $self->{_last_bounce} = 0;
338 my $ok = $self->send(
339 to => $to_email,
340 subject => $subject,
341 body_html => $body,
342 );
343 my $bounced = $self->{_last_bounce} ? 1 : 0;
344
345 # 8. Log + post-bounce suspension
346 my $db2 = MODS::DBConnect->new;
347 my $dbh2 = eval { $db2->db_connect() };
348 if ($dbh2) {
349 my $status = $ok ? 'sent' : ($bounced ? 'bounced' : 'failed');
350 my $reason = $ok ? '' : ($bounced ? 'recipient rejected (5xx)' : 'mailer send returned false');
351 $self->_log_send($db2, $dbh2, $DB, $user_id, $tpl->{id}, $slug, $to_email, $subject,
352 $status, $reason);
353 if ($bounced) {
354 $self->_check_bounce_suspension($db2, $dbh2, $DB, $user_id);
355 }
356 eval { $db2->db_disconnect($dbh2) };
357 }
358 return $ok;
359}
360
361sub _render_vars {
362 my ($s, $vars) = @_;
363 return '' unless defined $s;
364 foreach my $k (keys %$vars) {
365 my $v = $vars->{$k}; $v = '' unless defined $v;
366 $s =~ s/\{\{\s*\Q$k\E\s*\}\}/$v/g;
367 }
368 return $s;
369}
370
371sub _unsubscribe_url {
372 my ($self, $db, $dbh, $DB, $user_id) = @_;
373 return 'https://crm.3dshawn.com/unsubscribe.cgi' unless $user_id;
374
375 # Reuse existing token if present; mint otherwise.
376 my $r = $db->db_readwrite($dbh, qq~
377 SELECT token FROM `${DB}`.email_unsubscribe_tokens
378 WHERE user_id='$user_id' ORDER BY id DESC LIMIT 1
379 ~, $0, __LINE__);
380 my $tok = ($r && $r->{token}) ? $r->{token} : '';
381 unless ($tok) {
382 my @c = ('a'..'z','A'..'Z',0..9);
383 $tok = join('', map { $c[ int(rand(@c)) ] } 1..48);
384 $db->db_readwrite($dbh, qq~
385 INSERT INTO `${DB}`.email_unsubscribe_tokens (user_id, token) VALUES ('$user_id', '$tok')
386 ~, $0, __LINE__);
387 }
388 return "https://crm.3dshawn.com/unsubscribe.cgi?t=$tok";
389}
390
391sub _abuse_url {
392 my ($self, $db, $dbh, $DB, $user_id, $slug) = @_;
393 # No user_id (e.g., admin-test): use a generic abuse landing
394 return 'https://crm.3dshawn.com/report_abuse.cgi' unless $user_id;
395
396 # Token doubles as the inviter pointer; one per (user_id, slug) is fine
397 my $slug_q = $slug || ''; $slug_q =~ s/'/''/g;
398 my $u_q = $user_id + 0;
399 my $r = $db->db_readwrite($dbh, qq~
400 SELECT token FROM `${DB}`.email_unsubscribe_tokens
401 WHERE user_id='$u_q' ORDER BY id DESC LIMIT 1
402 ~, $0, __LINE__);
403 my $tok = ($r && $r->{token}) ? $r->{token} : '';
404 unless ($tok) {
405 my @c = ('a'..'z','A'..'Z',0..9);
406 $tok = join('', map { $c[ int(rand(@c)) ] } 1..48);
407 $db->db_readwrite($dbh, qq~
408 INSERT INTO `${DB}`.email_unsubscribe_tokens (user_id, token) VALUES ('$u_q', '$tok')
409 ~, $0, __LINE__);
410 }
411 return "https://crm.3dshawn.com/report_abuse.cgi?t=$tok&s=$slug_q";
412}
413
414sub _sanitize_display_var {
415 my ($v) = @_;
416 return '' unless defined $v;
417 $v =~ s/[\r\n\t]+/ /g;
418 $v =~ s/[<>]//g;
419 $v =~ s{https?://\S+}{[link removed]}gi;
420 $v =~ s{(?<![\w.])www\.\S+}{[link removed]}gi;
421 $v =~ s{(?<![\w.])\b[a-z0-9-]{2,}\.(?:com|net|org|io|co|me|biz|info|us|xyz|click|link|ru|cn|tk|ml|ga|cf|gq|top|win|loan|trade|app|dev)\b}{[link removed]}gi;
422 $v =~ s/^\s+|\s+$//g;
423 $v = substr($v, 0, 80) if length($v) > 80;
424 return $v;
425}
426
427sub _rate_limit_check {
428 my ($self, $db, $dbh, $DB, $user_id, $slug, $to_email) = @_;
429 return (1, '') unless $user_id;
430 my $u_q = $user_id + 0;
431
432 my $hourly_cap = _setting('email_rate_hourly_cap', 20) + 0;
433 my $daily_cap = _setting('email_rate_daily_cap', 100) + 0;
434 my $dedupe_hours = _setting('email_dedupe_window_hours', 24) + 0;
435 my $age_min_h = _setting('email_account_age_min_hours', 1) + 0;
436
437 # 1. Active suspension (set by bounce / abuse triggers)
438 my $u = $db->db_readwrite($dbh, qq~
439 SELECT email_suspended_until, email_suspended_reason, created_at
440 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
441 ~, $0, __LINE__);
442 if ($u && $u->{email_suspended_until}) {
443 my $still = $db->db_readwrite($dbh, qq~
444 SELECT (email_suspended_until > NOW()) AS still
445 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
446 ~, $0, __LINE__);
447 if ($still && $still->{still}) {
448 return (0, "inviter suspended until $u->{email_suspended_until} ($u->{email_suspended_reason})");
449 }
450 }
451
452 # 2. Account-age gate (skip for password reset / verify / welcome)
453 if ($u && $u->{created_at} && !$AGE_GATE_BYPASS{$slug || ''}) {
454 my $age = $db->db_readwrite($dbh, qq~
455 SELECT TIMESTAMPDIFF(HOUR, created_at, NOW()) AS h
456 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
457 ~, $0, __LINE__);
458 if ($age && defined $age->{h} && $age->{h} < $age_min_h) {
459 return (0, "account too new ($age->{h}h < $age_min_h h)");
460 }
461 }
462
463 # 3. Hourly burst
464 my $hr = $db->db_readwrite($dbh, qq~
465 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
466 WHERE user_id='$u_q' AND status='sent'
467 AND sent_at > DATE_SUB(NOW(), INTERVAL 1 HOUR)
468 ~, $0, __LINE__);
469 return (0, "hourly burst cap ($hourly_cap)") if ($hr && ($hr->{n} || 0) >= $hourly_cap);
470
471 # 4. Daily cap
472 my $dy = $db->db_readwrite($dbh, qq~
473 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
474 WHERE user_id='$u_q' AND status='sent'
475 AND sent_at > DATE_SUB(NOW(), INTERVAL 24 HOUR)
476 ~, $0, __LINE__);
477 return (0, "daily cap ($daily_cap)") if ($dy && ($dy->{n} || 0) >= $daily_cap);
478
479 # 5. Duplicate to same recipient + same template
480 my $to_q = $to_email; $to_q =~ s/'/''/g;
481 my $slug_q = $slug; $slug_q =~ s/'/''/g;
482 my $dp = $db->db_readwrite($dbh, qq~
483 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
484 WHERE user_id='$u_q' AND template_slug='$slug_q' AND to_email='$to_q'
485 AND status='sent' AND sent_at > DATE_SUB(NOW(), INTERVAL $dedupe_hours HOUR)
486 ~, $0, __LINE__);
487 return (0, "duplicate send within ${dedupe_hours}h") if ($dp && ($dp->{n} || 0) >= 1);
488
489 return (1, '');
490}
491
492# Called from _send_smtp when the RCPT TO line returns 5xx.
493# Bumps inviter's bounce count; if rate exceeds threshold AND volume is
494# meaningful, set email_suspended_until = NOW() + N days.
495sub _check_bounce_suspension {
496 my ($self, $db, $dbh, $DB, $user_id) = @_;
497 return unless $user_id;
498 my $u_q = $user_id + 0;
499
500 my $pct_thresh = _setting('email_bounce_suspend_pct', 10) + 0;
501 my $min_vol = _setting('email_bounce_min_volume', 20) + 0;
502 my $susp_days = _setting('email_suspend_days', 7) + 0;
503
504 my $r = $db->db_readwrite($dbh, qq~
505 SELECT
506 SUM(CASE WHEN status='bounced' THEN 1 ELSE 0 END) AS bounces,
507 SUM(CASE WHEN status IN ('sent','bounced') THEN 1 ELSE 0 END) AS total
508 FROM `${DB}`.email_sends_log
509 WHERE user_id='$u_q'
510 AND created_at > DATE_SUB(NOW(), INTERVAL 7 DAY)
511 ~, $0, __LINE__);
512 return unless $r;
513 my $b = ($r->{bounces} || 0) + 0;
514 my $t = ($r->{total} || 0) + 0;
515 return if $t < $min_vol;
516 my $pct = ($b * 100) / $t;
517 return if $pct < $pct_thresh;
518
519 my $reason = sprintf("bounce rate %.1f%% (%d/%d) >= %d%%", $pct, $b, $t, $pct_thresh);
520 $reason =~ s/'/''/g;
521 $db->db_readwrite($dbh, qq~
522 UPDATE `${DB}`.users
523 SET email_suspended_until = DATE_ADD(NOW(), INTERVAL $susp_days DAY),
524 email_suspended_reason = '$reason'
525 WHERE id='$u_q'
526 ~, $0, __LINE__);
527}
528
529# Called from report_abuse.cgi after an abuse report is logged.
530sub abuse_suspend_check {
531 my ($self, $db, $dbh, $DB, $inviter_user_id) = @_;
532 return unless $inviter_user_id;
533 my $u_q = $inviter_user_id + 0;
534
535 my $thresh = _setting('email_abuse_suspend_threshold', 1) + 0;
536 my $susp_days = _setting('email_suspend_days', 7) + 0;
537
538 my $r = $db->db_readwrite($dbh, qq~
539 SELECT COUNT(*) AS n FROM `${DB}`.email_abuse_reports
540 WHERE inviter_user_id='$u_q'
541 AND reported_at > DATE_SUB(NOW(), INTERVAL 30 DAY)
542 ~, $0, __LINE__);
543 return unless $r && ($r->{n} || 0) >= $thresh;
544
545 my $reason = sprintf("abuse reports: %d in 30d (threshold %d)", $r->{n}, $thresh);
546 $reason =~ s/'/''/g;
547 $db->db_readwrite($dbh, qq~
548 UPDATE `${DB}`.users
549 SET email_suspended_until = DATE_ADD(NOW(), INTERVAL $susp_days DAY),
550 email_suspended_reason = '$reason'
551 WHERE id='$u_q'
552 ~, $0, __LINE__);
553}
554
555sub _log_send {
556 my ($self, $db, $dbh, $DB, $user_id, $template_id, $slug, $to, $subject, $status, $reason) = @_;
557 my $uid_sql = $user_id ? "'$user_id'" : 'NULL';
558 my $tid_sql = $template_id ? "'$template_id'" : 'NULL';
559 my $slug_q = $slug; $slug_q =~ s/'/''/g;
560 my $to_q = $to; $to_q =~ s/'/''/g;
561 my $subj_q = substr($subject, 0, 250); $subj_q =~ s/'/''/g;
562 my $st = $status; $st =~ s/[^a-z_]//g;
563 my $rsn_q = substr($reason || '', 0, 500); $rsn_q =~ s/'/''/g;
564 my $sent_at_sql = ($status eq 'sent') ? 'NOW()' : 'NULL';
565
566 eval {
567 $db->db_readwrite($dbh, qq~
568 INSERT INTO `${DB}`.email_sends_log
569 (user_id, template_id, template_slug, to_email, subject, status, failure_reason, sent_at)
570 VALUES
571 ($uid_sql, $tid_sql, '$slug_q', '$to_q', '$subj_q', '$st', '$rsn_q', $sent_at_sql)
572 ~, $0, __LINE__);
573 };
574}
575
5761;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help