Diff

/var/www/vhosts/3dshawn.com/site1/_purge.pl

modified on local at 2026-07-12 00:19:35

Added

+46

lines

Removed

-5

lines

Context

162

unchanged

Blobs

from 35a296e95b1a
to d2622a1d705d

Restore this content →

Unified diff

Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.

1	1	#!/usr/bin/perl
2	2	#======================================================================
3	3	# DriftSense -- auto-purge daemon
4	4	#
5	5	# Cron entry point (NOT a CGI). Reclaims disk in BLOB_STORE by deleting
6	6	# blobs that are:
7	7	#
8	8	# * Older than the retention window (from config: retention_days,
9	9	# default 90 days -- measured from BLOB_STORE.first_seen_at)
10	10	# * NOT referenced by any FILE_CHANGES row inside a Named Release's
11	11	# scope (portfolio-wide releases pin ALL blobs; scoped releases pin
12	12	# only their scope; explicit NAMED_RELEASE_PINS pin exact blobs)
13	13	# * NOT the current-latest capture for any active file monitor
14	14	# (we always keep the "most recent" state of every monitored file)
15	15	#
16	16	# Dry-run by default. Pass --live to actually delete. Every action
17	17	# (planned or performed) is written to PURGE_LOG for the audit trail.
18	18	#======================================================================
19	19	use strict;
20	20	use warnings;
21	21	use lib '/var/www/vhosts/3dshawn.com/site1';
22	22	use POSIX ();
23	23	use MODS::Config;
24	24	use MODS::DBConnect;
25	25
26	26	$\| = 1;
27	27	my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
28	28
29	29	my $live = grep { $_ eq '--live' } @ARGV;
30	30	my $cfg = MODS::Config->new;
31	31	my $db = MODS::DBConnect->new;
32	32	my $dbh = $db->db_connect or die "[$ts] cannot connect to DriftSense storage DB\n";
33	33
34	34	my $retention_days = int($cfg->settings('retention_days') \|\| 90);
35	35	if ($retention_days < 1) { $retention_days = 90; }
36	36
37	37	# ---- Pin sets -------------------------------------------------------
38	38
39	39	# Explicit pins (NAMED_RELEASE_PINS)
40	40	my %pinned_sha;
41	41	my @pin_rows = $db->db_readwrite_multiple($dbh, q~
42	42	SELECT DISTINCT blob_sha FROM NAMED_RELEASE_PINS
43	43	WHERE blob_sha IS NOT NULL
44	44	~, __FILE__, __LINE__);
45	45	$pinned_sha{$_->{blob_sha}} = 1 for @pin_rows;
46	46
47	47	# Portfolio-wide named releases: pin ALL blobs referenced by any
48	48	# FILE_CHANGES up to the release's released_at moment.
49	49	my @portfolio_releases = $db->db_readwrite_multiple($dbh, q~
50	50	SELECT named_release_id, UNIX_TIMESTAMP(released_at) AS rel_epoch
51	51	FROM NAMED_RELEASES
52	52	WHERE is_locked = 1
53	53	AND scope_monitor_id IS NULL
54	54	AND scope_server_id IS NULL
55	55	~, __FILE__, __LINE__);
56	56	foreach my $rel (@portfolio_releases) {
57	57	my $ep = int($rel->{rel_epoch} \|\| 0);
58	58	next unless $ep;
59	59	my @refs = $db->db_readwrite_multiple($dbh, qq~
60	60	SELECT DISTINCT blob_sha FROM FILE_CHANGES
61	61	WHERE blob_sha IS NOT NULL
62	62	AND date_time <= FROM_UNIXTIME($ep)
63	63	~, __FILE__, __LINE__);
64	64	$pinned_sha{$_->{blob_sha}} = 1 for @refs;
65	65	}
66	66
67	67	# Scoped named releases: pin only blobs referenced by that scope
68	68	my @scoped_releases = $db->db_readwrite_multiple($dbh, q~
69	69	SELECT named_release_id, scope_monitor_id, scope_server_id,
70	70	UNIX_TIMESTAMP(released_at) AS rel_epoch
71	71	FROM NAMED_RELEASES
72	72	WHERE is_locked = 1
73	73	AND (scope_monitor_id IS NOT NULL OR scope_server_id IS NOT NULL)
74	74	~, __FILE__, __LINE__);
75	75	foreach my $rel (@scoped_releases) {
76	76	my $ep = int($rel->{rel_epoch} \|\| 0);
77	77	next unless $ep;
78	78	my $where = "date_time <= FROM_UNIXTIME($ep) AND blob_sha IS NOT NULL";
79	79	if ($rel->{scope_monitor_id}) {
80	80	$where .= " AND file_monitor_list_id = " . int($rel->{scope_monitor_id});
81	81	}
82	82	if ($rel->{scope_server_id}) {
83	83	$where .= " AND server_id = " . int($rel->{scope_server_id});
84	84	}
85	85	my @refs = $db->db_readwrite_multiple($dbh, qq~
86	86	SELECT DISTINCT blob_sha FROM FILE_CHANGES WHERE $where
87	87	~, __FILE__, __LINE__);
88	88	$pinned_sha{$_->{blob_sha}} = 1 for @refs;
89	89	}
90	90
91	91	# Current-latest state per file per monitor: never purge these
92	92	my @latest_rows = $db->db_readwrite_multiple($dbh, q~
93	93	SELECT DISTINCT fc.blob_sha
94	94	FROM FILE_CHANGES fc
95	95	JOIN (
96	96	SELECT file_monitor_list_id, file_name, MAX(file_changes_id) AS mx
97	97	FROM FILE_CHANGES
98	98	WHERE blob_sha IS NOT NULL
99	99	GROUP BY file_monitor_list_id, file_name
100	100	) l ON l.mx = fc.file_changes_id
101	101	WHERE fc.blob_sha IS NOT NULL
102	102	~, __FILE__, __LINE__);
103	103	$pinned_sha{$_->{blob_sha}} = 1 for @latest_rows;
104	104
105		# ---- Candidates: blobs older than retention window, NOT pinned -----
106		my @candidates = $db->db_readwrite_multiple($dbh, qq~
107		SELECT blob_sha, size_compressed, size_uncompressed
108		FROM BLOB_STORE
109		WHERE first_seen_at < DATE_SUB(NOW(), INTERVAL $retention_days DAY)
	105	# ---- Candidates: blobs older than the applicable retention window ---
	106	# Per-monitor: FILE_MONITOR_SETTINGS.retention_days overrides the global
	107	# default. Rule: a blob is eligible iff EVERY FILE_CHANGES row referring
	108	# to it is older than the retention_days of that row's monitor. If any
	109	# reference is within its monitor's retention, keep the blob.
	110
	111	# Pre-compute per-monitor retention (map mid -> days)
	112	my %monitor_retention;
	113	foreach my $m ($db->db_readwrite_multiple($dbh, q~
	114	SELECT file_monitor_list_id, retention_days FROM FILE_MONITOR_SETTINGS
	115	~, __FILE__, __LINE__)) {
	116	$monitor_retention{$m->{file_monitor_list_id}} =
	117	(defined $m->{retention_days} && $m->{retention_days} > 0)
	118	? int($m->{retention_days}) : $retention_days;
	119	}
	120
	121	# Fast path: pick blobs where the OLDEST reference's monitor retention
	122	# is already exceeded AND the NEWEST reference is also beyond the
	123	# per-monitor cutoff. Easier: iterate every blob, look at all its refs,
	124	# decide.
	125	my @candidates = $db->db_readwrite_multiple($dbh, q~
	126	SELECT bs.blob_sha, bs.size_compressed, bs.size_uncompressed,
	127	UNIX_TIMESTAMP(bs.first_seen_at) AS first_seen_epoch
	128	FROM BLOB_STORE bs
110	129	~, __FILE__, __LINE__);
	130	# Filter candidates by per-monitor retention: keep only blobs where ALL
	131	# referencing FILE_CHANGES.date_time are older than the reference's
	132	# monitor retention days.
	133	my @filtered;
	134	foreach my $b (@candidates) {
	135	my $sha = $b->{blob_sha};
	136	my $q_sha = $dbh->quote($sha);
	137	my @refs = $db->db_readwrite_multiple($dbh, qq~
	138	SELECT file_monitor_list_id AS mid, UNIX_TIMESTAMP(date_time) AS ts
	139	FROM FILE_CHANGES WHERE blob_sha = $q_sha
	140	~, __FILE__, __LINE__);
	141	next unless @refs; # unreferenced blobs already handled elsewhere
	142	my $now = time;
	143	my $eligible = 1;
	144	for my $r (@refs) {
	145	my $days_for = $monitor_retention{$r->{mid}} // $retention_days;
	146	my $cutoff = $now - $days_for * 86400;
	147	if (($r->{ts} // 0) > $cutoff) { $eligible = 0; last; }
	148	}
	149	push @filtered, $b if $eligible;
	150	}
	151	@candidates = @filtered;
111	152
112	153	my $planned = 0;
113	154	my $deleted = 0;
114	155	my $bytes_freed = 0;
115	156
116	157	foreach my $b (@candidates) {
117	158	next if $pinned_sha{$b->{blob_sha}};
118	159	my $sha = $b->{blob_sha};
119	160	my $q_sha = $dbh->quote($sha);
120	161	my $sz = int($b->{size_compressed} \|\| 0);
121	162	my $reason = "age > $retention_days d, no pin, not current-latest";
122	163
123	164	if ($live) {
124	165	# Delete FILE_CHANGES rows referencing this blob first (cascading)
125	166	# NO -- we KEEP the FILE_CHANGES metadata (name, timestamp) even
126	167	# after purging content; just null out blob_sha so the diff
127	168	# viewer shows "content purged" gracefully.
128	169	$db->db_readwrite($dbh, qq~
129	170	UPDATE FILE_CHANGES SET blob_sha = NULL
130	171	WHERE blob_sha = $q_sha
131	172	~, __FILE__, __LINE__);
132	173	$db->db_readwrite($dbh, qq~
133	174	DELETE FROM BLOB_STORE WHERE blob_sha = $q_sha
134	175	~, __FILE__, __LINE__);
135	176	$deleted++;
136	177	$bytes_freed += $sz;
137	178	$db->db_readwrite($dbh, qq~
138	179	INSERT INTO PURGE_LOG (blob_sha, freed_bytes, reason, dry_run)
139	180	VALUES ($q_sha, $sz, @{[ $dbh->quote($reason) ]}, 0)
140	181	~, __FILE__, __LINE__);
141	182	} else {
142	183	$db->db_readwrite($dbh, qq~
143	184	INSERT INTO PURGE_LOG (blob_sha, freed_bytes, reason, dry_run)
144	185	VALUES ($q_sha, $sz, @{[ $dbh->quote($reason) ]}, 1)
145	186	~, __FILE__, __LINE__);
146	187	$planned++;
147	188	}
148	189	}
149	190
150	191	$db->db_disconnect($dbh);
151	192
152	193	my $mode = $live ? 'LIVE' : 'dry-run';
153	194	if ($live) {
154	195	print "[$ts] purge $mode: deleted $deleted blobs, freed " . _fmt_bytes($bytes_freed) . "\n"
155	196	if $deleted;
156	197	} else {
157	198	print "[$ts] purge $mode: $planned blobs eligible (retention=$retention_days d) -- pass --live to execute\n"
158	199	if $planned;
159	200	}
160	201	exit 0;
161	202
162	203	sub _fmt_bytes {
163	204	my $n = shift;
164	205	return "$n B" if $n < 1024;
165	206	return sprintf('%.1f KB', $n/1024) if $n < 1024*1024;
166	207	return sprintf('%.1f MB', $n/1024/1024);
167	208	}