Diff -- /var/www/vhosts/3dshawn.com/shop.3dshawn.com/track.cgi
Diff

/var/www/vhosts/3dshawn.com/shop.3dshawn.com/track.cgi

added on local at 2026-07-01 22:10:06

Added
+273
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 4937a45aa54f
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1#!/usr/bin/perl
2#======================================================================
3# ShopCart - Tracking ingest endpoint
4#
5# Receives JSON-shaped POSTs from /assets/javascript/track.js:
6# { kind: 'init', token, fingerprint{...}, page, referrer }
7# { kind: 'event', token, type, page, selector, x_pct, y_pct, offset_x_pct, offset_y_pct, scroll_pct, metadata }
8# { kind: 'chat_send',token, body }
9#
10# Returns a tiny JSON envelope: { ok: 1, session_id, chat_id? }
11# Regular request handler (not an underscore-prefix worker) -- this CGI
12# is hit by every storefront page-load via XHR from track.js.
13#======================================================================
14use strict;
15use warnings;
16
17$| = 1;
18
19# --- Read JSON body FIRST, before any module touches STDIN ------------
20# CGI.pm's new() consumes STDIN on POST. We avoid CGI.pm entirely here
21# and read the raw body ourselves so the JSON body always lands intact.
22my $body = '';
23if (($ENV{REQUEST_METHOD} || '') eq 'POST') {
24 my $len = $ENV{CONTENT_LENGTH} || 0;
25 $len = 0 if $len !~ /^\d+$/;
26 $len = 1_000_000 if $len > 1_000_000;
27 if ($len > 0) {
28 read(STDIN, $body, $len);
29 }
30}
31
32use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com';
33use MODS::DBConnect;
34use MODS::ShopCart::Config;
35use MODS::ShopCart::Tracking;
36
37my $db = MODS::DBConnect->new;
38my $cfg = MODS::ShopCart::Config->new;
39my $tr = MODS::ShopCart::Tracking->new;
40my $DB = $cfg->settings('database_name');
41
42# --- Debug stats: GET /track.cgi?debug=stats counts tracking rows -----
43# Sanity check from the browser. If schema_ready is false the tables
44# aren't installed. If sessions=0 then no init has reached us.
45if (($ENV{QUERY_STRING} || '') =~ /(?:^|&)debug=stats(?:&|$)/) {
46 my $dbh2 = $db->db_connect();
47 my $ready = $tr->schema_ready($db, $dbh2, $DB) ? 1 : 0;
48 my ($sessions, $events, $last_seen) = (0, 0, '');
49 if ($ready) {
50 my $s = $db->db_readwrite($dbh2, qq~SELECT COUNT(*) AS n FROM `${DB}`.tracking_sessions~, $ENV{SCRIPT_NAME}, __LINE__);
51 $sessions = $s->{n} || 0;
52 my $e = $db->db_readwrite($dbh2, qq~SELECT COUNT(*) AS n FROM `${DB}`.tracking_events~, $ENV{SCRIPT_NAME}, __LINE__);
53 $events = $e->{n} || 0;
54 my $l = $db->db_readwrite($dbh2, qq~SELECT MAX(last_seen_at) AS t FROM `${DB}`.tracking_sessions~, $ENV{SCRIPT_NAME}, __LINE__);
55 $last_seen = $l->{t} || '';
56 }
57 $db->db_disconnect($dbh2);
58 print "Content-Type: application/json\nCache-Control: no-store\n\n";
59 print qq~{"ok":1,"schema_ready":$ready,"sessions":$sessions,"events":$events,"last_seen":"$last_seen"}~;
60 exit;
61}
62
63# Tiny JSON parser -- handles the flat object shape track.js sends.
64# We do NOT pull JSON.pm so the platform stays dep-free.
65my %payload = _parse_flat_json($body);
66
67# Sanity-check token -- 36-char UUID.
68my $token = $payload{token} || '';
69$token =~ s/[^a-f0-9-]//g;
70
71# Resolve client IP (header chain).
72my $ip = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || '';
73$ip =~ s/,.*$//;
74$ip =~ s/^\s+|\s+$//g;
75
76my $dbh = $db->db_connect();
77unless ($tr->schema_ready($db, $dbh, $DB)) {
78 $db->db_disconnect($dbh);
79 _json({ ok => 0, err => 'schema_not_installed' });
80}
81
82# Resolve which storefront this hit belongs to from the request host.
83# track.js doesn't know its own storefront_id, so it can't send one
84# in the payload. Without this resolution every click would land with
85# storefront_id=NULL and never show up on /my_heatmap.cgi (which
86# filters by storefront_id).
87#
88# Two cases handled here:
89# 1. Subdomain: "3dshawn.shop.3dshawn.com" -> subdomain='3dshawn'
90# 2. Custom domain: "shop.example.com" -> custom_domain=host (whole)
91# Apex hits ("shop.3dshawn.com") aren't a storefront -- those clicks stay
92# unscoped, which is fine (admin platform-wide view still picks them).
93my $host = lc($ENV{HTTP_HOST} || '');
94$host =~ s/^https?:\/\///;
95$host =~ s/\/.*$//;
96$host =~ s/:.*$//;
97$host =~ s/[^a-z0-9\.\-]//g;
98unless ($payload{storefront_id}) {
99 if ($host && $host ne 'shop.3dshawn.com' && $host ne 'www.shop.3dshawn.com') {
100 my $sf_id = 0;
101 # Try subdomain first ("3dshawn.shop.3dshawn.com" -> "3dshawn")
102 if ($host =~ /^([a-z0-9\-]+)\.shopcart\.com$/) {
103 my $sub = $1;
104 my $r = $db->db_readwrite($dbh, qq~
105 SELECT id FROM `${DB}`.storefronts
106 WHERE subdomain='$sub' LIMIT 1
107 ~, $ENV{SCRIPT_NAME}, __LINE__);
108 $sf_id = $r->{id} if $r && $r->{id};
109 }
110 # Fallback to custom-domain match for off-platform hostnames.
111 unless ($sf_id) {
112 my $r = $db->db_readwrite($dbh, qq~
113 SELECT id FROM `${DB}`.storefronts
114 WHERE custom_domain='$host' LIMIT 1
115 ~, $ENV{SCRIPT_NAME}, __LINE__);
116 $sf_id = $r->{id} if $r && $r->{id};
117 }
118 $payload{storefront_id} = $sf_id if $sf_id;
119 }
120}
121
122my $kind = $payload{kind} || '';
123my $result = { ok => 1 };
124
125# Drop tracking from admin / dashboard pages. Heatmaps and visitor
126# analytics are about the public-facing site (storefronts, product
127# pages, marketing pages). Admin console clicks (the logged-in
128# staff UI) and the seller dashboard would pollute the same tables.
129# We refuse these events server-side so the rule is enforced even
130# if a future template change accidentally loads track.js where it
131# shouldn't.
132my $page_for_guard = $payload{page} || '';
133if ($page_for_guard =~ m{^/(?:admin|admin_|_)} ) {
134 $db->db_disconnect($dbh);
135 _json({ ok => 0, err => 'admin_page_excluded' });
136}
137
138if ($kind eq 'init') {
139 # Token must already be a UUID. If we have not seen this token,
140 # create the session row. If we have, refresh fingerprint fields.
141 unless (length $token == 36) {
142 $db->db_disconnect($dbh);
143 _json({ ok => 0, err => 'bad_token' });
144 }
145
146 my $existing = $tr->session_by_token($db, $dbh, $DB, $token);
147 my $sid;
148 if ($existing && $existing->{id}) {
149 $sid = $existing->{id};
150 $tr->heartbeat($db, $dbh, $DB, $sid, $payload{page});
151 } else {
152 # Server-side UA parse fills in OS/browser/device when client
153 # didn't pass them; client values win.
154 my $ua_parsed = $tr->parse_ua($ENV{HTTP_USER_AGENT}) || {};
155 $sid = $tr->create_session($db, $dbh, $DB,
156 session_token => $token,
157 ip_address => $ip,
158 user_agent => $ENV{HTTP_USER_AGENT},
159 referrer => $payload{referrer},
160 current_page_path => $payload{page},
161 storefront_id => $payload{storefront_id},
162 os_name => $payload{os_name} || $ua_parsed->{os_name},
163 os_version => $payload{os_version} || $ua_parsed->{os_version},
164 browser_name => $payload{browser_name} || $ua_parsed->{browser_name},
165 browser_version => $payload{browser_version}|| $ua_parsed->{browser_version},
166 device_type => $payload{device_type} || $ua_parsed->{device_type},
167 screen_w => $payload{screen_w},
168 screen_h => $payload{screen_h},
169 viewport_w => $payload{viewport_w},
170 viewport_h => $payload{viewport_h},
171 color_depth => $payload{color_depth},
172 pixel_ratio => $payload{pixel_ratio},
173 touch_capable => $payload{touch_capable},
174 language => $payload{language},
175 timezone => $payload{timezone},
176 );
177 }
178 $result->{session_id} = $sid;
179}
180elsif ($kind eq 'event') {
181 my $sess = $tr->session_by_token($db, $dbh, $DB, $token);
182 unless ($sess && $sess->{id}) {
183 $db->db_disconnect($dbh);
184 _json({ ok => 0, err => 'no_session' });
185 }
186 $tr->heartbeat($db, $dbh, $DB, $sess->{id}, $payload{page});
187 $tr->log_event($db, $dbh, $DB,
188 session_id => $sess->{id},
189 storefront_id => $payload{storefront_id} || $sess->{storefront_id},
190 event_type => $payload{type} || 'page_view',
191 page_path => $payload{page},
192 element_selector => $payload{selector},
193 x_pct => $payload{x_pct},
194 y_pct => $payload{y_pct},
195 offset_x_pct => $payload{offset_x_pct},
196 offset_y_pct => $payload{offset_y_pct},
197 scroll_pct => $payload{scroll_pct},
198 metadata => $payload{metadata},
199 );
200 $result->{session_id} = $sess->{id};
201}
202elsif ($kind eq 'chat_send') {
203 my $sess = $tr->session_by_token($db, $dbh, $DB, $token);
204 unless ($sess && $sess->{id}) {
205 $db->db_disconnect($dbh);
206 _json({ ok => 0, err => 'no_session' });
207 }
208 $tr->heartbeat($db, $dbh, $DB, $sess->{id}, $payload{page});
209 my $chat_id = $tr->get_or_create_chat($db, $dbh, $DB, $sess->{id});
210 $tr->post_chat_message($db, $dbh, $DB,
211 chat_id => $chat_id,
212 from_role => 'visitor',
213 body => $payload{body},
214 );
215 $result->{chat_id} = $chat_id;
216}
217elsif ($kind eq 'chat_end') {
218 my $sess = $tr->session_by_token($db, $dbh, $DB, $token);
219 unless ($sess && $sess->{id}) {
220 $db->db_disconnect($dbh);
221 _json({ ok => 0, err => 'no_session' });
222 }
223 my $chat_id = $tr->get_or_create_chat($db, $dbh, $DB, $sess->{id});
224 $tr->end_chat_by_visitor($db, $dbh, $DB, $chat_id);
225 $result->{chat_id} = $chat_id;
226}
227else {
228 $db->db_disconnect($dbh);
229 _json({ ok => 0, err => 'bad_kind' });
230}
231
232$db->db_disconnect($dbh);
233_json($result);
234
235# ----------------------------------------------------------------- helpers
236sub _json {
237 my $h = shift;
238 print "Content-Type: application/json\nCache-Control: no-store\n\n";
239 # Tiny JSON serializer -- flat hash, scalar values only.
240 my @pairs;
241 foreach my $k (sort keys %$h) {
242 my $v = $h->{$k};
243 my $val;
244 if (!defined $v) { $val = 'null'; }
245 elsif ($v =~ /^-?\d+$/) { $val = $v; }
246 else {
247 $v =~ s/\\/\\\\/g; $v =~ s/"/\\"/g; $v =~ s/\n/\\n/g; $v =~ s/\r/\\r/g;
248 $val = qq~"$v"~;
249 }
250 push @pairs, qq~"$k":$val~;
251 }
252 print '{' . join(',', @pairs) . '}';
253 exit;
254}
255
256sub _parse_flat_json {
257 my ($s) = @_;
258 return () unless defined $s && length $s;
259 my %out;
260 # Strip outer braces
261 $s =~ s/^\s*\{//; $s =~ s/\}\s*$//;
262 # Pull "key": "value" or "key": number / null
263 while ($s =~ /"([a-zA-Z0-9_]+)"\s*:\s*(?:"((?:[^"\\]|\\.)*)"|(true|false|null|-?\d+(?:\.\d+)?))/g) {
264 my $key = $1;
265 my $val = defined $2 ? $2 : $3;
266 if (defined $2) {
267 $val =~ s/\\n/\n/g; $val =~ s/\\r/\r/g; $val =~ s/\\"/"/g; $val =~ s/\\\\/\\/g;
268 }
269 $val = '' if defined $val && $val eq 'null';
270 $out{$key} = $val;
271 }
272 return %out;
273}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help