added on local at 2026-07-01 13:47:33
| 1 | package MODS::AffSoft::WebPush; | |
| 2 | #====================================================================== | |
| 3 | # AffSoft -- Web Push sender (RFC 8030 + 8292 VAPID). | |
| 4 | # | |
| 5 | # Lifted from PTMatrix's WebPush module (same OpenSSL-CLI approach; | |
| 6 | # no Crypt::EC dependency). Sends EMPTY-payload pushes. The service | |
| 7 | # worker (/sw.js) on receive shows a generic "new activity" notification | |
| 8 | # (or falls back gracefully); click opens /m.cgi. | |
| 9 | # | |
| 10 | # Public: | |
| 11 | # send_for_user($db, $dbh, $DB, $user_id) -> ($sent, $deleted) | |
| 12 | #====================================================================== | |
| 13 | use strict; | |
| 14 | use warnings; | |
| 15 | use Digest::SHA qw(sha256); | |
| 16 | use MIME::Base64 qw(encode_base64); | |
| 17 | use IPC::Open3; | |
| 18 | use Symbol 'gensym'; | |
| 19 | ||
| 20 | my $VAPID_KEY_PATH = '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/_vapid/private.pem'; | |
| 21 | ||
| 22 | sub new { return bless { _have_openssl => undef }, shift } | |
| 23 | ||
| 24 | sub _b64url { | |
| 25 | my $bytes = shift // ''; | |
| 26 | my $b = encode_base64($bytes, ''); | |
| 27 | $b =~ tr|+/|-_|; | |
| 28 | $b =~ s/=+$//; | |
| 29 | return $b; | |
| 30 | } | |
| 31 | ||
| 32 | sub _have_openssl { | |
| 33 | my $self = shift; | |
| 34 | return $self->{_have_openssl} if defined $self->{_have_openssl}; | |
| 35 | my $ok = (-x '/usr/bin/openssl') ? 1 : 0; | |
| 36 | $self->{_have_openssl} = $ok; | |
| 37 | return $ok; | |
| 38 | } | |
| 39 | ||
| 40 | # Convert ECDSA DER signature into raw r||s (64 bytes for P-256) for JOSE. | |
| 41 | sub _der_to_jose { | |
| 42 | my ($der) = @_; | |
| 43 | return undef unless defined $der && length($der) > 8; | |
| 44 | my $i = 0; | |
| 45 | return undef unless substr($der, $i++, 1) eq "\x30"; | |
| 46 | my $L = ord(substr($der, $i++, 1)); | |
| 47 | if ($L & 0x80) { $i += ($L & 0x7F); } | |
| 48 | return undef unless substr($der, $i++, 1) eq "\x02"; | |
| 49 | my $rL = ord(substr($der, $i++, 1)); | |
| 50 | my $r = substr($der, $i, $rL); $i += $rL; | |
| 51 | return undef unless substr($der, $i++, 1) eq "\x02"; | |
| 52 | my $sL = ord(substr($der, $i++, 1)); | |
| 53 | my $s = substr($der, $i, $sL); | |
| 54 | $r =~ s/^\x00// while length($r) > 32 && substr($r, 0, 1) eq "\x00"; | |
| 55 | $s =~ s/^\x00// while length($s) > 32 && substr($s, 0, 1) eq "\x00"; | |
| 56 | $r = ("\x00" x (32 - length($r))) . $r if length($r) < 32; | |
| 57 | $s = ("\x00" x (32 - length($s))) . $s if length($s) < 32; | |
| 58 | return $r . $s; | |
| 59 | } | |
| 60 | ||
| 61 | sub _sign_es256 { | |
| 62 | my ($self, $key_path, $msg) = @_; | |
| 63 | return undef unless $self->_have_openssl; | |
| 64 | my $err = gensym; | |
| 65 | my $pid = open3(my $in, my $out, $err, | |
| 66 | '/usr/bin/openssl', 'dgst', '-sha256', '-sign', $key_path); | |
| 67 | binmode $in; binmode $out; | |
| 68 | print $in $msg; | |
| 69 | close $in; | |
| 70 | local $/; | |
| 71 | my $der = <$out>; | |
| 72 | waitpid $pid, 0; | |
| 73 | return undef unless defined $der && length $der; | |
| 74 | return _der_to_jose($der); | |
| 75 | } | |
| 76 | ||
| 77 | sub _vapid_jwt { | |
| 78 | my ($self, $key_path, $aud, $subject, $exp_secs) = @_; | |
| 79 | $exp_secs ||= time + 12 * 3600; | |
| 80 | my $header = '{"typ":"JWT","alg":"ES256"}'; | |
| 81 | my $payload = sprintf('{"aud":"%s","exp":%d,"sub":"%s"}', | |
| 82 | _json_esc($aud), $exp_secs, _json_esc($subject)); | |
| 83 | my $signing_input = _b64url($header) . '.' . _b64url($payload); | |
| 84 | my $sig = $self->_sign_es256($key_path, $signing_input); | |
| 85 | return undef unless defined $sig && length $sig == 64; | |
| 86 | return $signing_input . '.' . _b64url($sig); | |
| 87 | } | |
| 88 | sub _json_esc { | |
| 89 | my $s = shift // ''; | |
| 90 | $s =~ s/\\/\\\\/g; $s =~ s/"/\\"/g; $s =~ s/\n/\\n/g; $s =~ s/\r/\\r/g; | |
| 91 | return $s; | |
| 92 | } | |
| 93 | ||
| 94 | # VAPID keys come from platform_settings, fallback subject = our hello@ addr. | |
| 95 | sub _vapid_keys { | |
| 96 | my ($self, $db, $dbh, $DB) = @_; | |
| 97 | my $pub = $db->db_readwrite($dbh, qq~ | |
| 98 | SELECT setting_value FROM ${DB}.platform_settings | |
| 99 | WHERE setting_key='vapid_public_key' LIMIT 1 | |
| 100 | ~, 'WebPush', __LINE__); | |
| 101 | my $sub = $db->db_readwrite($dbh, qq~ | |
| 102 | SELECT setting_value FROM ${DB}.platform_settings | |
| 103 | WHERE setting_key='vapid_subject' LIMIT 1 | |
| 104 | ~, 'WebPush', __LINE__); | |
| 105 | return ( | |
| 106 | ($pub && $pub->{setting_value}) || '', | |
| 107 | ($sub && $sub->{setting_value}) || 'mailto:hello@affiliate.3dshawn.com', | |
| 108 | ); | |
| 109 | } | |
| 110 | ||
| 111 | sub _audience { | |
| 112 | my $url = shift // ''; | |
| 113 | return $1 if $url =~ m{^(https?://[^/]+)}; | |
| 114 | return ''; | |
| 115 | } | |
| 116 | ||
| 117 | sub _send_one { | |
| 118 | my ($self, $sub, $pub_b64, $subject, $key_path) = @_; | |
| 119 | my $aud = _audience($sub->{endpoint}); | |
| 120 | return 0 unless $aud; | |
| 121 | my $jwt = $self->_vapid_jwt($key_path, $aud, $subject); | |
| 122 | return 0 unless $jwt; | |
| 123 | ||
| 124 | my $auth_hdr = "vapid t=$jwt, k=$pub_b64"; | |
| 125 | ||
| 126 | my $err = gensym; | |
| 127 | my @cmd = ( | |
| 128 | '/usr/bin/curl', '-sS', '-o', '/dev/null', | |
| 129 | '-w', '%{http_code}', | |
| 130 | '-X', 'POST', | |
| 131 | '--max-time', '10', | |
| 132 | '-H', "Authorization: $auth_hdr", | |
| 133 | '-H', 'TTL: 60', | |
| 134 | '-H', 'Content-Length: 0', | |
| 135 | '-H', 'Urgency: normal', | |
| 136 | $sub->{endpoint}, | |
| 137 | ); | |
| 138 | my $pid = open3(my $in, my $out, $err, @cmd); | |
| 139 | close $in; | |
| 140 | local $/; | |
| 141 | my $code = <$out> || ''; | |
| 142 | waitpid $pid, 0; | |
| 143 | $code =~ s/\D//g; | |
| 144 | return $code + 0; | |
| 145 | } | |
| 146 | ||
| 147 | # Fan-out to every subscription for a user. Returns (sent, deleted). | |
| 148 | # 404/410 -> subscription dead, hard delete. | |
| 149 | # 401/403 -> our VAPID signing is broken, DO NOT delete (deploy bug). | |
| 150 | # Other failures recorded but kept for retry next time. | |
| 151 | sub send_for_user { | |
| 152 | my ($self, $db, $dbh, $DB, $user_id) = @_; | |
| 153 | return (0, 0) unless $user_id; | |
| 154 | return (0, 0) unless $self->_have_openssl; | |
| 155 | ||
| 156 | my ($pub, $subj) = $self->_vapid_keys($db, $dbh, $DB); | |
| 157 | return (0, 0) unless length $pub; | |
| 158 | ||
| 159 | return (0, 0) unless -r $VAPID_KEY_PATH; | |
| 160 | ||
| 161 | my @subs = $db->db_readwrite_multiple($dbh, qq~ | |
| 162 | SELECT id, endpoint, p256dh_key, auth_key FROM ${DB}.push_subscriptions | |
| 163 | WHERE user_id='$user_id' | |
| 164 | LIMIT 25 | |
| 165 | ~, 'WebPush', __LINE__); | |
| 166 | ||
| 167 | my ($sent, $deleted) = (0, 0); | |
| 168 | foreach my $sub (@subs) { | |
| 169 | my $code = $self->_send_one($sub, $pub, $subj, $VAPID_KEY_PATH); | |
| 170 | if ($code == 201 || $code == 202 || $code == 200) { | |
| 171 | $sent++; | |
| 172 | $db->db_readwrite($dbh, qq~ | |
| 173 | UPDATE ${DB}.push_subscriptions SET last_used_at=NOW() | |
| 174 | WHERE id='$sub->{id}' | |
| 175 | ~, 'WebPush', __LINE__); | |
| 176 | } elsif ($code == 404 || $code == 410) { | |
| 177 | $deleted++; | |
| 178 | $db->db_readwrite($dbh, qq~ | |
| 179 | DELETE FROM ${DB}.push_subscriptions WHERE id='$sub->{id}' | |
| 180 | ~, 'WebPush', __LINE__); | |
| 181 | } | |
| 182 | # Other codes: leave the subscription alone for next attempt | |
| 183 | } | |
| 184 | return ($sent, $deleted); | |
| 185 | } | |
| 186 | ||
| 187 | 1; |