added on local at 2026-07-01 15:02:39
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ContactForge -- /c.cgi visitor event collector (single-tenant). | |
| 4 | # Accepts a JSON POST body with u (uid), s (sid), t (event type), | |
| 5 | # p (page path) plus event-specific fields. Writes pageviews / events / | |
| 6 | # heartbeats. Single-tenant: no public_key gating, no site filter. | |
| 7 | # | |
| 8 | # CORS-open: replies with Access-Control-Allow-Origin: * so the snippet | |
| 9 | # also works from anywhere if someone embeds it elsewhere. | |
| 10 | #====================================================================== | |
| 11 | use strict; | |
| 12 | use warnings; | |
| 13 | use lib '/var/www/vhosts/3dshawn.com/crm.3dshawn.com'; | |
| 14 | ||
| 15 | # Read STDIN BEFORE loading CGI (which would consume it for form-parsing) | |
| 16 | my $raw = ''; | |
| 17 | if (($ENV{REQUEST_METHOD} || '') eq 'POST') { | |
| 18 | my $len = int($ENV{CONTENT_LENGTH} || 0); | |
| 19 | if ($len > 0 && $len < 1_048_576) { | |
| 20 | read STDIN, $raw, $len; | |
| 21 | } | |
| 22 | } | |
| 23 | ||
| 24 | use CGI; | |
| 25 | use MODS::DBConnect; | |
| 26 | use MODS::ContactForge::Config; | |
| 27 | use MODS::ContactForge::Tracking; | |
| 28 | use JSON::PP; | |
| 29 | ||
| 30 | my $cfg = MODS::ContactForge::Config->new; | |
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $trk = MODS::ContactForge::Tracking->new; | |
| 33 | my $DB = $cfg->settings('database_name'); | |
| 34 | ||
| 35 | print "Access-Control-Allow-Origin: *\n"; | |
| 36 | print "Access-Control-Allow-Methods: POST, OPTIONS\n"; | |
| 37 | print "Access-Control-Allow-Headers: Content-Type\n"; | |
| 38 | print "Access-Control-Max-Age: 86400\n"; | |
| 39 | print "Cache-Control: no-store\n"; | |
| 40 | ||
| 41 | if (($ENV{REQUEST_METHOD} || '') eq 'OPTIONS') { | |
| 42 | print "Content-Type: text/plain\n\nok"; | |
| 43 | exit; | |
| 44 | } | |
| 45 | ||
| 46 | print "Content-Type: application/json\n\n"; | |
| 47 | my $body = eval { JSON::PP::decode_json($raw) }; | |
| 48 | $body ||= {}; | |
| 49 | ||
| 50 | my $dbh = $db->db_connect(); | |
| 51 | unless ($dbh) { | |
| 52 | print '{"ok":0,"error":"db_unavailable"}'; | |
| 53 | exit; | |
| 54 | } | |
| 55 | ||
| 56 | # Stamp the IP server-side so the client can't spoof it. | |
| 57 | $body->{ip} = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || ''; | |
| 58 | $body->{user_agent} = $ENV{HTTP_USER_AGENT} || ''; | |
| 59 | ||
| 60 | my $res = eval { $trk->ingest($db, $dbh, $DB, $body) }; | |
| 61 | $res ||= { ok => 0, error => 'ingest_failed' }; | |
| 62 | $db->db_disconnect($dbh); | |
| 63 | ||
| 64 | print JSON::PP::encode_json($res); |