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

O Operator
Diff

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

added on local at 2026-07-12 00:02:19

Added
+167
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 35a296e95b1a
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# DriftSense -- auto-purge daemon
4#
5# Cron entry point (NOT a CGI). Reclaims disk in BLOB_STORE by deleting
6# blobs that are:
7#
8# * Older than the retention window (from config: retention_days,
9# default 90 days -- measured from BLOB_STORE.first_seen_at)
10# * NOT referenced by any FILE_CHANGES row inside a Named Release's
11# scope (portfolio-wide releases pin ALL blobs; scoped releases pin
12# only their scope; explicit NAMED_RELEASE_PINS pin exact blobs)
13# * NOT the current-latest capture for any active file monitor
14# (we always keep the "most recent" state of every monitored file)
15#
16# Dry-run by default. Pass --live to actually delete. Every action
17# (planned or performed) is written to PURGE_LOG for the audit trail.
18#======================================================================
19use strict;
20use warnings;
21use lib '/var/www/vhosts/3dshawn.com/site1';
22use POSIX ();
23use MODS::Config;
24use MODS::DBConnect;
25
26$| = 1;
27my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
28
29my $live = grep { $_ eq '--live' } @ARGV;
30my $cfg = MODS::Config->new;
31my $db = MODS::DBConnect->new;
32my $dbh = $db->db_connect or die "[$ts] cannot connect to DriftSense storage DB\n";
33
34my $retention_days = int($cfg->settings('retention_days') || 90);
35if ($retention_days < 1) { $retention_days = 90; }
36
37# ---- Pin sets -------------------------------------------------------
38
39# Explicit pins (NAMED_RELEASE_PINS)
40my %pinned_sha;
41my @pin_rows = $db->db_readwrite_multiple($dbh, q~
42 SELECT DISTINCT blob_sha FROM NAMED_RELEASE_PINS
43 WHERE blob_sha IS NOT NULL
44~, __FILE__, __LINE__);
45$pinned_sha{$_->{blob_sha}} = 1 for @pin_rows;
46
47# Portfolio-wide named releases: pin ALL blobs referenced by any
48# FILE_CHANGES up to the release's released_at moment.
49my @portfolio_releases = $db->db_readwrite_multiple($dbh, q~
50 SELECT named_release_id, UNIX_TIMESTAMP(released_at) AS rel_epoch
51 FROM NAMED_RELEASES
52 WHERE is_locked = 1
53 AND scope_monitor_id IS NULL
54 AND scope_server_id IS NULL
55~, __FILE__, __LINE__);
56foreach my $rel (@portfolio_releases) {
57 my $ep = int($rel->{rel_epoch} || 0);
58 next unless $ep;
59 my @refs = $db->db_readwrite_multiple($dbh, qq~
60 SELECT DISTINCT blob_sha FROM FILE_CHANGES
61 WHERE blob_sha IS NOT NULL
62 AND date_time <= FROM_UNIXTIME($ep)
63 ~, __FILE__, __LINE__);
64 $pinned_sha{$_->{blob_sha}} = 1 for @refs;
65}
66
67# Scoped named releases: pin only blobs referenced by that scope
68my @scoped_releases = $db->db_readwrite_multiple($dbh, q~
69 SELECT named_release_id, scope_monitor_id, scope_server_id,
70 UNIX_TIMESTAMP(released_at) AS rel_epoch
71 FROM NAMED_RELEASES
72 WHERE is_locked = 1
73 AND (scope_monitor_id IS NOT NULL OR scope_server_id IS NOT NULL)
74~, __FILE__, __LINE__);
75foreach my $rel (@scoped_releases) {
76 my $ep = int($rel->{rel_epoch} || 0);
77 next unless $ep;
78 my $where = "date_time <= FROM_UNIXTIME($ep) AND blob_sha IS NOT NULL";
79 if ($rel->{scope_monitor_id}) {
80 $where .= " AND file_monitor_list_id = " . int($rel->{scope_monitor_id});
81 }
82 if ($rel->{scope_server_id}) {
83 $where .= " AND server_id = " . int($rel->{scope_server_id});
84 }
85 my @refs = $db->db_readwrite_multiple($dbh, qq~
86 SELECT DISTINCT blob_sha FROM FILE_CHANGES WHERE $where
87 ~, __FILE__, __LINE__);
88 $pinned_sha{$_->{blob_sha}} = 1 for @refs;
89}
90
91# Current-latest state per file per monitor: never purge these
92my @latest_rows = $db->db_readwrite_multiple($dbh, q~
93 SELECT DISTINCT fc.blob_sha
94 FROM FILE_CHANGES fc
95 JOIN (
96 SELECT file_monitor_list_id, file_name, MAX(file_changes_id) AS mx
97 FROM FILE_CHANGES
98 WHERE blob_sha IS NOT NULL
99 GROUP BY file_monitor_list_id, file_name
100 ) l ON l.mx = fc.file_changes_id
101 WHERE fc.blob_sha IS NOT NULL
102~, __FILE__, __LINE__);
103$pinned_sha{$_->{blob_sha}} = 1 for @latest_rows;
104
105# ---- Candidates: blobs older than retention window, NOT pinned -----
106my @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)
110~, __FILE__, __LINE__);
111
112my $planned = 0;
113my $deleted = 0;
114my $bytes_freed = 0;
115
116foreach my $b (@candidates) {
117 next if $pinned_sha{$b->{blob_sha}};
118 my $sha = $b->{blob_sha};
119 my $q_sha = $dbh->quote($sha);
120 my $sz = int($b->{size_compressed} || 0);
121 my $reason = "age > $retention_days d, no pin, not current-latest";
122
123 if ($live) {
124 # Delete FILE_CHANGES rows referencing this blob first (cascading)
125 # NO -- we KEEP the FILE_CHANGES metadata (name, timestamp) even
126 # after purging content; just null out blob_sha so the diff
127 # viewer shows "content purged" gracefully.
128 $db->db_readwrite($dbh, qq~
129 UPDATE FILE_CHANGES SET blob_sha = NULL
130 WHERE blob_sha = $q_sha
131 ~, __FILE__, __LINE__);
132 $db->db_readwrite($dbh, qq~
133 DELETE FROM BLOB_STORE WHERE blob_sha = $q_sha
134 ~, __FILE__, __LINE__);
135 $deleted++;
136 $bytes_freed += $sz;
137 $db->db_readwrite($dbh, qq~
138 INSERT INTO PURGE_LOG (blob_sha, freed_bytes, reason, dry_run)
139 VALUES ($q_sha, $sz, @{[ $dbh->quote($reason) ]}, 0)
140 ~, __FILE__, __LINE__);
141 } else {
142 $db->db_readwrite($dbh, qq~
143 INSERT INTO PURGE_LOG (blob_sha, freed_bytes, reason, dry_run)
144 VALUES ($q_sha, $sz, @{[ $dbh->quote($reason) ]}, 1)
145 ~, __FILE__, __LINE__);
146 $planned++;
147 }
148}
149
150$db->db_disconnect($dbh);
151
152my $mode = $live ? 'LIVE' : 'dry-run';
153if ($live) {
154 print "[$ts] purge $mode: deleted $deleted blobs, freed " . _fmt_bytes($bytes_freed) . "\n"
155 if $deleted;
156} else {
157 print "[$ts] purge $mode: $planned blobs eligible (retention=$retention_days d) -- pass --live to execute\n"
158 if $planned;
159}
160exit 0;
161
162sub _fmt_bytes {
163 my $n = shift;
164 return "$n B" if $n < 1024;
165 return sprintf('%.1f KB', $n/1024) if $n < 1024*1024;
166 return sprintf('%.1f MB', $n/1024/1024);
167}