added on local at 2026-07-01 12:34:37
| 1 | #!/usr/bin/perl | |
| 2 | ||
| 3 | ################################################################################################################################## | |
| 4 | # ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____ | |
| 5 | # / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \ | |
| 6 | # / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / / | |
| 7 | # / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ / | |
| 8 | # \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/ | |
| 9 | # | |
| 10 | # - Written by: Shawn Pickering | |
| 11 | # - shawn@shawnpickering.com | |
| 12 | ################################################################################################################################## | |
| 13 | use strict; | |
| 14 | use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com'; | |
| 15 | ||
| 16 | ||
| 17 | ############################################################# | |
| 18 | ## Variables | |
| 19 | ############################################################# | |
| 20 | my $brand; | |
| 21 | ||
| 22 | ||
| 23 | ||
| 24 | ############################################################ | |
| 25 | # Modules | |
| 26 | ############################################################ | |
| 27 | use CGI; my $query = new CGI; my $form = $query->Vars; | |
| 28 | use MODS::PTMatrix::Urls; my $getlist = new MODS::PTMatrix::Urls; my $url = $getlist->urls(); | |
| 29 | use MODS::DBConnect; my $db = new MODS::DBConnect; | |
| 30 | use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name'); | |
| 31 | use MODS::PTMatrix::Mailer; | |
| 32 | ||
| 33 | $brand = $config->settings('brand_name') || 'PTMatrix'; | |
| 34 | ||
| 35 | ||
| 36 | ||
| 37 | ############################################################# | |
| 38 | ## Get form data | |
| 39 | ############################################################# | |
| 40 | foreach my $line(keys %$form){ | |
| 41 | $form->{$line} =~ s/[^!-~\s]//g; | |
| 42 | $form->{$line} = quotemeta("$form->{$line}"); | |
| 43 | } | |
| 44 | ||
| 45 | ||
| 46 | ||
| 47 | ############################################################ | |
| 48 | # Program Controls | |
| 49 | ############################################################ | |
| 50 | $|=1; | |
| 51 | print qq~Content-type:text/html; Cache-Control:no-cache;\n\n~; | |
| 52 | if(($form->{act} || '') eq 'report'){&record_report;} | |
| 53 | else{&abuse_form;} | |
| 54 | ||
| 55 | ||
| 56 | ############################################################ | |
| 57 | # Subroutines | |
| 58 | ############################################################ | |
| 59 | sub resolve_token{ | |
| 60 | #Returns (inviter_id, inviter_email) for the ?t=... param, or (undef, '') | |
| 61 | my $tok = $form->{t} || ''; | |
| 62 | $tok =~ s/[^a-zA-Z0-9]//g; | |
| 63 | return (undef, '') unless $tok; | |
| 64 | ||
| 65 | my $dbh = $db->db_connect(); | |
| 66 | my $tok_q = $tok; $tok_q =~ s/'/''/g; | |
| 67 | my $sql = qq~SELECT t.user_id, u.email FROM `${database_name}`.email_unsubscribe_tokens t LEFT JOIN `${database_name}`.users u ON u.id = t.user_id WHERE t.token = '$tok_q' LIMIT 1~; | |
| 68 | my $r = $db->db_readwrite($dbh, $sql, $0, __LINE__); | |
| 69 | $db->db_disconnect($dbh); | |
| 70 | if($r && $r->{user_id}){ | |
| 71 | return ($r->{user_id} + 0, $r->{email} || ''); | |
| 72 | } | |
| 73 | return (undef, ''); | |
| 74 | } | |
| 75 | ||
| 76 | sub record_report{ | |
| 77 | my($inviter_id, $inviter_email) = &resolve_token; | |
| 78 | if(!$inviter_id){ | |
| 79 | #Bad / expired token - just show the form anyway with a generic message | |
| 80 | &abuse_form; | |
| 81 | return; | |
| 82 | } | |
| 83 | ||
| 84 | my $tok = $form->{t} || ''; $tok =~ s/[^a-zA-Z0-9]//g; | |
| 85 | my $slug = $form->{s} || ''; $slug =~ s/[^a-z0-9_-]//g; | |
| 86 | my $notes = $form->{notes} || ''; $notes = substr($notes, 0, 500); $notes =~ s/[\r\n]+/ /g; | |
| 87 | ||
| 88 | my $remote_ip = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || ''; | |
| 89 | $remote_ip = substr($remote_ip, 0, 64); | |
| 90 | ||
| 91 | my $tok_q = $tok; $tok_q =~ s/'/''/g; | |
| 92 | my $slug_q = $slug; $slug_q =~ s/'/''/g; | |
| 93 | my $notes_q = $notes; $notes_q =~ s/'/''/g; | |
| 94 | my $ip_q = $remote_ip; $ip_q =~ s/'/''/g; | |
| 95 | my $u_q = $inviter_id + 0; | |
| 96 | ||
| 97 | my $dbh = $db->db_connect(); | |
| 98 | my $sql = qq~INSERT INTO `${database_name}`.email_abuse_reports (inviter_user_id, template_slug, token, reporter_ip, notes) VALUES ('$u_q', '$slug_q', '$tok_q', '$ip_q', '$notes_q')~; | |
| 99 | $db->db_readwrite($dbh, $sql, $0, __LINE__); | |
| 100 | ||
| 101 | #Check whether this inviter has crossed the auto-suspend threshold | |
| 102 | my $mailer = MODS::PTMatrix::Mailer->new; | |
| 103 | $mailer->abuse_suspend_check($db, $dbh, $database_name, $inviter_id); | |
| 104 | ||
| 105 | eval { $db->db_disconnect($dbh) }; | |
| 106 | ||
| 107 | print &shell(qq~ | |
| 108 | <h1>Thanks — report logged.</h1> | |
| 109 | <p>We've recorded your report. The sender will be reviewed and may | |
| 110 | be blocked from sending further email through $brand.</p> | |
| 111 | <p>You won't hear from us about this again.</p> | |
| 112 | ~); | |
| 113 | } | |
| 114 | ||
| 115 | sub abuse_form{ | |
| 116 | my(undef, $inviter_email) = &resolve_token; | |
| 117 | my $tok = $form->{t} || ''; $tok =~ s/[^a-zA-Z0-9]//g; | |
| 118 | my $slug = $form->{s} || ''; $slug =~ s/[^a-z0-9_-]//g; | |
| 119 | ||
| 120 | my $who = $inviter_email ? "from <strong>$inviter_email</strong>" : "from a $brand account"; | |
| 121 | ||
| 122 | print &shell(qq~ | |
| 123 | <h1>Report this email as abuse?</h1> | |
| 124 | <p>You're about to report the email $who as unwanted or abusive. | |
| 125 | Your report will be reviewed and the sender may be blocked from | |
| 126 | sending further email through $brand.</p> | |
| 127 | <form method="post" action="$url->{report_abuse}" style="margin-top:24px"> | |
| 128 | <input type="hidden" name="t" value="$tok"> | |
| 129 | <input type="hidden" name="s" value="$slug"> | |
| 130 | <input type="hidden" name="act" value="report"> | |
| 131 | <label style="display:block;margin-bottom:8px;color:#94a3b8;font-size:13px"> | |
| 132 | Optional — what made this feel like abuse? | |
| 133 | </label> | |
| 134 | <textarea name="notes" rows="3" maxlength="500" | |
| 135 | style="width:100%;background:#1a1f2c;color:#e5e7eb;border:1px solid #2a313d;border-radius:8px;padding:10px"></textarea> | |
| 136 | <div style="margin-top:16px;display:flex;gap:10px"> | |
| 137 | <button type="submit" | |
| 138 | style="background:#5aa9ff;color:#0b1220;border:0;border-radius:8px;padding:10px 18px;font-weight:600;cursor:pointer"> | |
| 139 | Report as abuse | |
| 140 | </button> | |
| 141 | <a href="/" style="background:#2a313d;color:#e5e7eb;border-radius:8px;padding:10px 18px;text-decoration:none"> | |
| 142 | Cancel | |
| 143 | </a> | |
| 144 | </div> | |
| 145 | </form> | |
| 146 | ~); | |
| 147 | } | |
| 148 | ||
| 149 | #Standalone HTML chrome - this page is public + linked from email footers, | |
| 150 | #so no app wrapper / login required | |
| 151 | sub shell{ | |
| 152 | my($body) = @_; | |
| 153 | return qq~<!doctype html> | |
| 154 | <html><head><meta charset="utf-8"><title>Report abuse · $brand</title> | |
| 155 | <style> | |
| 156 | body { background:#0b1220; color:#e5e7eb; font-family:-apple-system,Segoe UI,sans-serif; margin:0; padding:48px 16px; } | |
| 157 | .card { max-width:560px; margin:0 auto; background:#141a26; border:1px solid #2a313d; border-radius:12px; padding:32px; } | |
| 158 | h1 { margin:0 0 16px; font-size:22px; } | |
| 159 | p { color:#cbd5e1; line-height:1.55; } | |
| 160 | </style></head> | |
| 161 | <body><div class="card">$body</div></body></html>~; | |
| 162 | } |