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

O Operator
Diff

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

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

Added
+0
lines
Removed
-0
lines
Context
576
unchanged
Blobs
from e038cb29f424
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.
11package MODS::ContactForge::Mailer;
22#======================================================================
33# ContactForge -- email transport.
44#
55# Two distinct send paths:
66#
77# send() / send_template()
88# PLATFORM emails (welcome, password reset, billing receipts,
99# admin alerts). Routed through the platform's own SMTP creds
1010# in Config::smtp_host / smtp_user / smtp_pass with local
1111# sendmail fallback. This is OUR reputation.
1212#
1313# send_bulk(user_id => ..., to => ..., ...)
1414# TENANT-driven bulk sends (campaigns, drip sequences). Looked up
1515# per-user from MODS::ContactForge::EmailProviders -- they bring
1616# their OWN SMTP account (SES / Postmark / SendGrid / Mailgun /
1717# custom). Their reputation, their bill, their spam liability.
1818# Never falls back to local sendmail -- if they have no provider
1919# configured, the send fails closed with a clear error.
2020#======================================================================
2121
2222use strict;
2323use warnings;
2424
2525use MODS::ContactForge::Config;
2626use MODS::ContactForge::EmailProviders;
2727
2828my $config = MODS::ContactForge::Config->new;
2929
3030# Vars that are allowed to contain URLs unchanged. Everything else passed
3131# in vars{} gets URL-stripped + length-capped before substitution so an
3232# attacker can't smuggle a payload through display_name / company_name
3333# / inviter_name / etc.
3434my %URL_ALLOWED = map { $_ => 1 } qw(
3535 unsubscribe_url billing_url dashboard_url action_url
3636 invite_url accept_url reset_url login_url logout_url
3737 verify_url support_url abuse_url
3838);
3939
4040# Slugs that bypass the account-age gate. Without these, a brand-new
4141# signup couldn't verify their own email or reset their password.
4242my %AGE_GATE_BYPASS = map { $_ => 1 } qw(
4343 password_reset email_verify verify_email welcome
4444);
4545
4646sub _setting {
4747 my ($key, $default) = @_;
4848 my $v = $config->settings($key);
4949 return (defined $v && $v ne '') ? $v : $default;
5050}
5151
5252sub new {
5353 my ($class) = @_;
5454 return bless({}, $class);
5555}
5656
5757# send(to => '...', subject => '...', body_text => '...', body_html => '...')
5858sub send {
5959 my ($self, %a) = @_;
6060 my $to = $a{to} || return 0;
6161 my $subject = $a{subject} || '(no subject)';
6262 my $body = $a{body_html} || $a{body_text} || '';
6363 my $is_html = exists $a{body_html} ? 1 : 0;
6464 my $from = $config->settings('from_email') || 'noreply@crm.3dshawn.com';
6565 my $brand = $config->settings('brand_name') || 'ContactForge';
6666 my $from_h = qq~"$brand" <$from>~;
6767
6868 # Try SMTP
6969 my $smtp_host = $config->settings('smtp_host') || '';
7070 my $bounce = 0;
7171 if ($smtp_host) {
7272 if (_send_smtp($smtp_host, $config->settings('smtp_port') || 587,
7373 $config->settings('smtp_user') || '',
7474 $config->settings('smtp_pass') || '',
7575 $from_h, $to, $subject, $body, $is_html, \$bounce)) {
7676 _log("smtp ok", $to, $subject);
7777 return 1;
7878 }
7979 _log($bounce ? "smtp bounce" : "smtp fail", $to, $subject);
8080 $self->{_last_bounce} = $bounce;
8181 return 0 if $bounce; # don't fall back to sendmail for known bounces
8282 }
8383
8484 # Try local sendmail
8585 if (_send_sendmail($from_h, $to, $subject, $body, $is_html)) {
8686 _log("sendmail ok", $to, $subject);
8787 return 1;
8888 }
8989 _log("all fail", $to, $subject);
9090 return 0;
9191}
9292
9393sub _send_smtp {
9494 my ($host, $port, $user, $pass, $from_h, $to, $subject, $body, $is_html, $bounce_ref) = @_;
9595 $$bounce_ref = 0 if ref $bounce_ref;
9696 return 0 unless eval { require Net::SMTP; 1 };
9797 my $smtp = eval { Net::SMTP->new($host, Port => $port, Timeout => 15, Hello => 'crm.3dshawn.com') };
9898 return 0 unless $smtp;
9999 if ($user && $pass) {
100100 eval { $smtp->auth($user, $pass) } or do { $smtp->quit; return 0; };
101101 }
102102 my ($from_addr) = ($from_h =~ /<(.+?)>/); $from_addr ||= $from_h;
103103 eval { $smtp->mail($from_addr) } or do { $smtp->quit; return 0; };
104104 my $rcpt_ok = eval { $smtp->to($to) };
105105 unless ($rcpt_ok) {
106106 my $code = eval { $smtp->code() } || 0;
107107 my $msg = eval { $smtp->message() } || '';
108108 $$bounce_ref = 1 if ref($bounce_ref) && ($code >= 500
109109 || $msg =~ /no such user|user unknown|recipient.*reject|invalid.*recipient|mailbox.*not.*found/i);
110110 $smtp->quit; return 0;
111111 }
112112 $smtp->data();
113113 $smtp->datasend("From: $from_h\n");
114114 $smtp->datasend("To: $to\n");
115115 $smtp->datasend("Subject: $subject\n");
116116 $smtp->datasend("MIME-Version: 1.0\n");
117117 $smtp->datasend("Content-Type: " . ($is_html ? 'text/html' : 'text/plain') . "; charset=utf-8\n\n");
118118 $smtp->datasend($body);
119119 $smtp->datasend("\n");
120120 $smtp->dataend();
121121 $smtp->quit;
122122 return 1;
123123}
124124
125125sub _send_sendmail {
126126 my ($from_h, $to, $subject, $body, $is_html) = @_;
127127 my $sendmail = -x '/usr/sbin/sendmail' ? '/usr/sbin/sendmail'
128128 : -x '/usr/bin/sendmail' ? '/usr/bin/sendmail' : '';
129129 return 0 unless $sendmail;
130130 open(my $fh, "|$sendmail -t -i") or return 0;
131131 my ($from_addr) = ($from_h =~ /<(.+?)>/); $from_addr ||= $from_h;
132132 print $fh "From: $from_h\n";
133133 print $fh "To: $to\n";
134134 print $fh "Subject: $subject\n";
135135 print $fh "MIME-Version: 1.0\n";
136136 print $fh "Content-Type: " . ($is_html ? 'text/html' : 'text/plain') . "; charset=utf-8\n\n";
137137 print $fh $body;
138138 print $fh "\n";
139139 close $fh;
140140 return $? == 0 ? 1 : 0;
141141}
142142
143143sub _log {
144144 my ($status, $to, $subject) = @_;
145145 my $path = $config->settings('uploads_dir') || '/tmp';
146146 $path .= '/_mail.log';
147147 if (open(my $fh, '>>', $path)) {
148148 print $fh scalar(localtime), "\t", $status, "\t", $to, "\t", $subject, "\n";
149149 close $fh;
150150 }
151151}
152152
153153# ---------------------------------------------------------------------
154154# send_bulk(user_id => N, to => '...', subject => '...',
155155# body_html => '...', body_text => '...', reply_to => '...')
156156#
157157# Tenant-driven campaign send. Routes through the user's own SMTP
158158# provider in email_providers. Never falls back to local sendmail --
159159# returns (0, error_message) if the tenant has nothing configured.
160160#
161161# Side effects on success: bumps last_send_at + monthly_send_count.
162162# Side effects on bounce: bumps bounce_count.
163163# Caller is responsible for higher-level send-quota enforcement (the
164164# pricing-tier's emails_included cap). This method does not throttle.
165165# ---------------------------------------------------------------------
166166sub send_bulk {
167167 my ($self, %a) = @_;
168168 my $user_id = ($a{user_id} || 0) + 0;
169169 my $to = $a{to} || '';
170170 my $subject = $a{subject} || '(no subject)';
171171 my $body = $a{body_html} || $a{body_text} || '';
172172 my $is_html = exists $a{body_html} ? 1 : 0;
173173
174174 return (0, 'user_id required for send_bulk') unless $user_id;
175175 return (0, 'recipient required') unless $to =~ /\@/;
176176
177177 require MODS::DBConnect;
178178 my $cfg = MODS::ContactForge::Config->new;
179179 my $DB = $cfg->settings('database_name');
180180 my $db = MODS::DBConnect->new;
181181 my $dbh = eval { $db->db_connect() };
182182 return (0, 'db connect failed') unless $dbh;
183183
184184 my $eps = MODS::ContactForge::EmailProviders->new;
185185 my $p = $eps->active_for_user($db, $dbh, $DB, $user_id);
186186 unless ($p) {
187187 eval { $db->db_disconnect($dbh) };
188188 return (0, 'No SMTP provider connected. Visit Settings -> Email Provider to connect SES / Postmark / SendGrid / Mailgun / custom SMTP.');
189189 }
190190 if ($p->{paused_at}) {
191191 eval { $db->db_disconnect($dbh) };
192192 return (0, "SMTP provider paused: " . ($p->{paused_reason} || 'manual pause'));
193193 }
194194
195195 # Honor the per-row reply_to but let the caller override.
196196 $p->{reply_to} = $a{reply_to} if defined $a{reply_to};
197197
198198 my ($ok, $msg) = MODS::ContactForge::EmailProviders::_net_smtp_send(
199199 $p, $to, $subject, $body, $is_html
200200 );
201201
202202 if ($ok) {
203203 $eps->record_send($db, $dbh, $DB, $p->{id});
204204 _log("bulk ok", $to, $subject);
205205 } else {
206206 # Treat 5xx-style messages as bounces; everything else just fails.
207207 if ($msg =~ /no such user|user unknown|mailbox.*not.*found|recipient.*reject|RCPT TO/i) {
208208 $eps->record_bounce($db, $dbh, $DB, $p->{id});
209209 }
210210 _log("bulk fail: $msg", $to, $subject);
211211 }
212212 eval { $db->db_disconnect($dbh) };
213213 return ($ok, $msg);
214214}
215215
216216# ---------------------------------------------------------------------
217217# send_template(slug => '...', user_id => N, vars => {...})
218218#
219219# Look up an editable template by slug, fill {{vars}}, append the
220220# unsubscribe footer (lifecycle/product/marketing only -- transactional
221221# is forced through), respect user_email_preferences, log to
222222# email_sends_log, and hand the rendered HTML to send().
223223#
224224# Returns 1 on send, 0 on suppressed/failed. Always logs to email_sends_log.
225225# ---------------------------------------------------------------------
226226sub send_template {
227227 my ($self, %a) = @_;
228228 my $slug = $a{slug} or return 0;
229229 my $user_id = $a{user_id} + 0;
230230 my $vars = $a{vars} || {};
231231 my $to_override = $a{to}; # optional override (e.g., admin "send test")
232232
233233 require MODS::DBConnect;
234234 require MODS::ContactForge::Config;
235235 my $cfg = MODS::ContactForge::Config->new;
236236 my $DB = $cfg->settings('database_name');
237237 my $db = MODS::DBConnect->new;
238238 my $dbh = eval { $db->db_connect() };
239239 return 0 unless $dbh;
240240
241241 # 1. Load template
242242 my $slug_q = $slug; $slug_q =~ s/'/''/g;
243243 my $tpl = $db->db_readwrite($dbh, qq~
244244 SELECT id, slug, category, subject, body_html, is_active
245245 FROM `${DB}`.email_templates WHERE slug='$slug_q' LIMIT 1
246246 ~, $0, __LINE__);
247247 unless ($tpl && $tpl->{id} && $tpl->{is_active}) {
248248 $self->_log_send($db, $dbh, $DB, $user_id, undef, $slug, '', '(no template)', 'failed', 'template missing or inactive');
249249 eval { $db->db_disconnect($dbh) };
250250 return 0;
251251 }
252252
253253 # 2. Resolve recipient + load user info
254254 my $to_email = $to_override;
255255 my $user;
256256 if ($user_id) {
257257 $user = $db->db_readwrite($dbh, qq~
258258 SELECT id, email, display_name, company_id FROM `${DB}`.users WHERE id='$user_id' LIMIT 1
259259 ~, $0, __LINE__);
260260 $to_email ||= $user->{email} if $user;
261261 }
262262 unless ($to_email) {
263263 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, '', $tpl->{subject}, 'failed', 'no recipient');
264264 eval { $db->db_disconnect($dbh) };
265265 return 0;
266266 }
267267
268268 # 3. Check user prefs (transactional bypasses)
269269 if ($user_id && $tpl->{category} ne 'transactional') {
270270 my $pref = $db->db_readwrite($dbh, qq~
271271 SELECT is_subscribed FROM `${DB}`.user_email_preferences
272272 WHERE user_id='$user_id' AND category='$tpl->{category}' LIMIT 1
273273 ~, $0, __LINE__);
274274 # Default-on for lifecycle, default-off for product+marketing
275275 my $default_on = ($tpl->{category} eq 'lifecycle') ? 1 : 0;
276276 my $sub = (defined $pref->{is_subscribed}) ? ($pref->{is_subscribed} ? 1 : 0) : $default_on;
277277 unless ($sub) {
278278 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, $to_email, $tpl->{subject}, 'suppressed_pref', "category=$tpl->{category}");
279279 eval { $db->db_disconnect($dbh) };
280280 return 0;
281281 }
282282 }
283283
284284 # 4. Auto-fill standard vars + ensure unsubscribe URL exists
285285 $vars->{display_name} //= ($user && $user->{display_name}) || '';
286286 $vars->{first_name} //= (split /\s+/, $vars->{display_name})[0] || '';
287287 $vars->{billing_url} //= 'https://crm.3dshawn.com/billing.cgi';
288288 $vars->{dashboard_url} //= 'https://crm.3dshawn.com/dashboard.cgi';
289289 $vars->{unsubscribe_url} //= $self->_unsubscribe_url($db, $dbh, $DB, $user_id);
290290 $vars->{abuse_url} //= $self->_abuse_url($db, $dbh, $DB, $user_id, $slug);
291291
292292 # 4b. Sanitize every var that's NOT a URL whitelist field. Closes the
293293 # "inviter_name = 'Free Bitcoin https://evil.tld'" payload-injection
294294 # vector — fixed template body can still carry a URL-bearing display
295295 # name into the recipient's inbox.
296296 foreach my $k (keys %$vars) {
297297 next if $URL_ALLOWED{$k};
298298 $vars->{$k} = _sanitize_display_var($vars->{$k});
299299 }
300300
301301 # 4c. Rate limit BEFORE rendering and sending. Hits both the team-invite
302302 # flow and the admin "send test" flow at this single chokepoint.
303303 my ($ok_rl, $rl_reason) = $self->_rate_limit_check($db, $dbh, $DB, $user_id, $slug, $to_email);
304304 unless ($ok_rl) {
305305 $self->_log_send($db, $dbh, $DB, $user_id, $tpl->{id}, $slug, $to_email, $tpl->{subject},
306306 'suppressed_rate', $rl_reason);
307307 eval { $db->db_disconnect($dbh) };
308308 return 0;
309309 }
310310
311311 # 5. Render: {{var}} substitution
312312 my $subject = _render_vars($tpl->{subject}, $vars);
313313 my $body = _render_vars($tpl->{body_html}, $vars);
314314
315315 # 6. Append footer (lifecycle/product/marketing -- not transactional)
316316 if ($tpl->{category} ne 'transactional') {
317317 $body .= qq~
318318<hr style="border:0;border-top:1px solid #e5e7eb;margin:32px 0 16px">
319319<p style="color:#94a3b8;font-size:11px;text-align:center;line-height:1.5">
320320You're receiving this because you have a ContactForge account.<br>
321321<a href="$vars->{unsubscribe_url}" style="color:#94a3b8">Manage email preferences</a> &middot;
322322<a href="$vars->{unsubscribe_url}&unsub_all=1" style="color:#94a3b8">Unsubscribe all</a> &middot;
323323<a href="$vars->{abuse_url}" style="color:#94a3b8">Report this email as abuse</a>
324324</p>~;
325325 } else {
326326 # Transactional gets a slimmer abuse-only footer (no unsubscribe -- legal)
327327 $body .= qq~
328328<hr style="border:0;border-top:1px solid #e5e7eb;margin:24px 0 12px">
329329<p style="color:#94a3b8;font-size:11px;text-align:center;line-height:1.5">
330330Didn't expect this email? <a href="$vars->{abuse_url}" style="color:#94a3b8">Report as abuse</a>
331331</p>~;
332332 }
333333
334334 eval { $db->db_disconnect($dbh) };
335335
336336 # 7. Send via the existing send() path
337337 $self->{_last_bounce} = 0;
338338 my $ok = $self->send(
339339 to => $to_email,
340340 subject => $subject,
341341 body_html => $body,
342342 );
343343 my $bounced = $self->{_last_bounce} ? 1 : 0;
344344
345345 # 8. Log + post-bounce suspension
346346 my $db2 = MODS::DBConnect->new;
347347 my $dbh2 = eval { $db2->db_connect() };
348348 if ($dbh2) {
349349 my $status = $ok ? 'sent' : ($bounced ? 'bounced' : 'failed');
350350 my $reason = $ok ? '' : ($bounced ? 'recipient rejected (5xx)' : 'mailer send returned false');
351351 $self->_log_send($db2, $dbh2, $DB, $user_id, $tpl->{id}, $slug, $to_email, $subject,
352352 $status, $reason);
353353 if ($bounced) {
354354 $self->_check_bounce_suspension($db2, $dbh2, $DB, $user_id);
355355 }
356356 eval { $db2->db_disconnect($dbh2) };
357357 }
358358 return $ok;
359359}
360360
361361sub _render_vars {
362362 my ($s, $vars) = @_;
363363 return '' unless defined $s;
364364 foreach my $k (keys %$vars) {
365365 my $v = $vars->{$k}; $v = '' unless defined $v;
366366 $s =~ s/\{\{\s*\Q$k\E\s*\}\}/$v/g;
367367 }
368368 return $s;
369369}
370370
371371sub _unsubscribe_url {
372372 my ($self, $db, $dbh, $DB, $user_id) = @_;
373373 return 'https://crm.3dshawn.com/unsubscribe.cgi' unless $user_id;
374374
375375 # Reuse existing token if present; mint otherwise.
376376 my $r = $db->db_readwrite($dbh, qq~
377377 SELECT token FROM `${DB}`.email_unsubscribe_tokens
378378 WHERE user_id='$user_id' ORDER BY id DESC LIMIT 1
379379 ~, $0, __LINE__);
380380 my $tok = ($r && $r->{token}) ? $r->{token} : '';
381381 unless ($tok) {
382382 my @c = ('a'..'z','A'..'Z',0..9);
383383 $tok = join('', map { $c[ int(rand(@c)) ] } 1..48);
384384 $db->db_readwrite($dbh, qq~
385385 INSERT INTO `${DB}`.email_unsubscribe_tokens (user_id, token) VALUES ('$user_id', '$tok')
386386 ~, $0, __LINE__);
387387 }
388388 return "https://crm.3dshawn.com/unsubscribe.cgi?t=$tok";
389389}
390390
391391sub _abuse_url {
392392 my ($self, $db, $dbh, $DB, $user_id, $slug) = @_;
393393 # No user_id (e.g., admin-test): use a generic abuse landing
394394 return 'https://crm.3dshawn.com/report_abuse.cgi' unless $user_id;
395395
396396 # Token doubles as the inviter pointer; one per (user_id, slug) is fine
397397 my $slug_q = $slug || ''; $slug_q =~ s/'/''/g;
398398 my $u_q = $user_id + 0;
399399 my $r = $db->db_readwrite($dbh, qq~
400400 SELECT token FROM `${DB}`.email_unsubscribe_tokens
401401 WHERE user_id='$u_q' ORDER BY id DESC LIMIT 1
402402 ~, $0, __LINE__);
403403 my $tok = ($r && $r->{token}) ? $r->{token} : '';
404404 unless ($tok) {
405405 my @c = ('a'..'z','A'..'Z',0..9);
406406 $tok = join('', map { $c[ int(rand(@c)) ] } 1..48);
407407 $db->db_readwrite($dbh, qq~
408408 INSERT INTO `${DB}`.email_unsubscribe_tokens (user_id, token) VALUES ('$u_q', '$tok')
409409 ~, $0, __LINE__);
410410 }
411411 return "https://crm.3dshawn.com/report_abuse.cgi?t=$tok&s=$slug_q";
412412}
413413
414414sub _sanitize_display_var {
415415 my ($v) = @_;
416416 return '' unless defined $v;
417417 $v =~ s/[\r\n\t]+/ /g;
418418 $v =~ s/[<>]//g;
419419 $v =~ s{https?://\S+}{[link removed]}gi;
420420 $v =~ s{(?<![\w.])www\.\S+}{[link removed]}gi;
421421 $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;
422422 $v =~ s/^\s+|\s+$//g;
423423 $v = substr($v, 0, 80) if length($v) > 80;
424424 return $v;
425425}
426426
427427sub _rate_limit_check {
428428 my ($self, $db, $dbh, $DB, $user_id, $slug, $to_email) = @_;
429429 return (1, '') unless $user_id;
430430 my $u_q = $user_id + 0;
431431
432432 my $hourly_cap = _setting('email_rate_hourly_cap', 20) + 0;
433433 my $daily_cap = _setting('email_rate_daily_cap', 100) + 0;
434434 my $dedupe_hours = _setting('email_dedupe_window_hours', 24) + 0;
435435 my $age_min_h = _setting('email_account_age_min_hours', 1) + 0;
436436
437437 # 1. Active suspension (set by bounce / abuse triggers)
438438 my $u = $db->db_readwrite($dbh, qq~
439439 SELECT email_suspended_until, email_suspended_reason, created_at
440440 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
441441 ~, $0, __LINE__);
442442 if ($u && $u->{email_suspended_until}) {
443443 my $still = $db->db_readwrite($dbh, qq~
444444 SELECT (email_suspended_until > NOW()) AS still
445445 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
446446 ~, $0, __LINE__);
447447 if ($still && $still->{still}) {
448448 return (0, "inviter suspended until $u->{email_suspended_until} ($u->{email_suspended_reason})");
449449 }
450450 }
451451
452452 # 2. Account-age gate (skip for password reset / verify / welcome)
453453 if ($u && $u->{created_at} && !$AGE_GATE_BYPASS{$slug || ''}) {
454454 my $age = $db->db_readwrite($dbh, qq~
455455 SELECT TIMESTAMPDIFF(HOUR, created_at, NOW()) AS h
456456 FROM `${DB}`.users WHERE id='$u_q' LIMIT 1
457457 ~, $0, __LINE__);
458458 if ($age && defined $age->{h} && $age->{h} < $age_min_h) {
459459 return (0, "account too new ($age->{h}h < $age_min_h h)");
460460 }
461461 }
462462
463463 # 3. Hourly burst
464464 my $hr = $db->db_readwrite($dbh, qq~
465465 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
466466 WHERE user_id='$u_q' AND status='sent'
467467 AND sent_at > DATE_SUB(NOW(), INTERVAL 1 HOUR)
468468 ~, $0, __LINE__);
469469 return (0, "hourly burst cap ($hourly_cap)") if ($hr && ($hr->{n} || 0) >= $hourly_cap);
470470
471471 # 4. Daily cap
472472 my $dy = $db->db_readwrite($dbh, qq~
473473 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
474474 WHERE user_id='$u_q' AND status='sent'
475475 AND sent_at > DATE_SUB(NOW(), INTERVAL 24 HOUR)
476476 ~, $0, __LINE__);
477477 return (0, "daily cap ($daily_cap)") if ($dy && ($dy->{n} || 0) >= $daily_cap);
478478
479479 # 5. Duplicate to same recipient + same template
480480 my $to_q = $to_email; $to_q =~ s/'/''/g;
481481 my $slug_q = $slug; $slug_q =~ s/'/''/g;
482482 my $dp = $db->db_readwrite($dbh, qq~
483483 SELECT COUNT(*) AS n FROM `${DB}`.email_sends_log
484484 WHERE user_id='$u_q' AND template_slug='$slug_q' AND to_email='$to_q'
485485 AND status='sent' AND sent_at > DATE_SUB(NOW(), INTERVAL $dedupe_hours HOUR)
486486 ~, $0, __LINE__);
487487 return (0, "duplicate send within ${dedupe_hours}h") if ($dp && ($dp->{n} || 0) >= 1);
488488
489489 return (1, '');
490490}
491491
492492# Called from _send_smtp when the RCPT TO line returns 5xx.
493493# Bumps inviter's bounce count; if rate exceeds threshold AND volume is
494494# meaningful, set email_suspended_until = NOW() + N days.
495495sub _check_bounce_suspension {
496496 my ($self, $db, $dbh, $DB, $user_id) = @_;
497497 return unless $user_id;
498498 my $u_q = $user_id + 0;
499499
500500 my $pct_thresh = _setting('email_bounce_suspend_pct', 10) + 0;
501501 my $min_vol = _setting('email_bounce_min_volume', 20) + 0;
502502 my $susp_days = _setting('email_suspend_days', 7) + 0;
503503
504504 my $r = $db->db_readwrite($dbh, qq~
505505 SELECT
506506 SUM(CASE WHEN status='bounced' THEN 1 ELSE 0 END) AS bounces,
507507 SUM(CASE WHEN status IN ('sent','bounced') THEN 1 ELSE 0 END) AS total
508508 FROM `${DB}`.email_sends_log
509509 WHERE user_id='$u_q'
510510 AND created_at > DATE_SUB(NOW(), INTERVAL 7 DAY)
511511 ~, $0, __LINE__);
512512 return unless $r;
513513 my $b = ($r->{bounces} || 0) + 0;
514514 my $t = ($r->{total} || 0) + 0;
515515 return if $t < $min_vol;
516516 my $pct = ($b * 100) / $t;
517517 return if $pct < $pct_thresh;
518518
519519 my $reason = sprintf("bounce rate %.1f%% (%d/%d) >= %d%%", $pct, $b, $t, $pct_thresh);
520520 $reason =~ s/'/''/g;
521521 $db->db_readwrite($dbh, qq~
522522 UPDATE `${DB}`.users
523523 SET email_suspended_until = DATE_ADD(NOW(), INTERVAL $susp_days DAY),
524524 email_suspended_reason = '$reason'
525525 WHERE id='$u_q'
526526 ~, $0, __LINE__);
527527}
528528
529529# Called from report_abuse.cgi after an abuse report is logged.
530530sub abuse_suspend_check {
531531 my ($self, $db, $dbh, $DB, $inviter_user_id) = @_;
532532 return unless $inviter_user_id;
533533 my $u_q = $inviter_user_id + 0;
534534
535535 my $thresh = _setting('email_abuse_suspend_threshold', 1) + 0;
536536 my $susp_days = _setting('email_suspend_days', 7) + 0;
537537
538538 my $r = $db->db_readwrite($dbh, qq~
539539 SELECT COUNT(*) AS n FROM `${DB}`.email_abuse_reports
540540 WHERE inviter_user_id='$u_q'
541541 AND reported_at > DATE_SUB(NOW(), INTERVAL 30 DAY)
542542 ~, $0, __LINE__);
543543 return unless $r && ($r->{n} || 0) >= $thresh;
544544
545545 my $reason = sprintf("abuse reports: %d in 30d (threshold %d)", $r->{n}, $thresh);
546546 $reason =~ s/'/''/g;
547547 $db->db_readwrite($dbh, qq~
548548 UPDATE `${DB}`.users
549549 SET email_suspended_until = DATE_ADD(NOW(), INTERVAL $susp_days DAY),
550550 email_suspended_reason = '$reason'
551551 WHERE id='$u_q'
552552 ~, $0, __LINE__);
553553}
554554
555555sub _log_send {
556556 my ($self, $db, $dbh, $DB, $user_id, $template_id, $slug, $to, $subject, $status, $reason) = @_;
557557 my $uid_sql = $user_id ? "'$user_id'" : 'NULL';
558558 my $tid_sql = $template_id ? "'$template_id'" : 'NULL';
559559 my $slug_q = $slug; $slug_q =~ s/'/''/g;
560560 my $to_q = $to; $to_q =~ s/'/''/g;
561561 my $subj_q = substr($subject, 0, 250); $subj_q =~ s/'/''/g;
562562 my $st = $status; $st =~ s/[^a-z_]//g;
563563 my $rsn_q = substr($reason || '', 0, 500); $rsn_q =~ s/'/''/g;
564564 my $sent_at_sql = ($status eq 'sent') ? 'NOW()' : 'NULL';
565565
566566 eval {
567567 $db->db_readwrite($dbh, qq~
568568 INSERT INTO `${DB}`.email_sends_log
569569 (user_id, template_id, template_slug, to_email, subject, status, failure_reason, sent_at)
570570 VALUES
571571 ($uid_sql, $tid_sql, '$slug_q', '$to_q', '$subj_q', '$st', '$rsn_q', $sent_at_sql)
572572 ~, $0, __LINE__);
573573 };
574574}
575575
5765761;