Restore

Restore file to captured state

Every captured change carries its SHA-256-addressed content in BLOB_STORE. Restoring writes that content back to the original path — current file gets backed up to <path>.drift_restore_backup_<epoch> before overwrite.

What will change

Preview -- nothing has been written yet.

Target file	/var/www/vhosts/3dshawn.com/site1/diff.cgi
Site	DriftSense self-monitor on local
Kind	local
Captured at	2026-07-10 22:19:08
Captured SHA	85df3ad0f26ddf290b4ef90e9edba3a7fa9b0fc8733c91a4ec91b70e4d2040ea

Current state on disk

Live check just now. If SHAs match, the restore is a no-op.

File present	yes
Size	9204 bytes
Current SHA	902f256a1a7c
Same as captured?	no -- restore will change it

See exactly what's different →

What restore will change — live diff

Left column shows current on-disk content; right shows what restore will write. +9 additions, -53 deletions, 174 unchanged context lines.

1	1	#!/usr/bin/perl
2	2	#======================================================================
3	3	# DriftSense -- /diff.cgi
4	4	#
5	5	# Renders a two-pane diff for a single change captured in FILE_CHANGES
6	6	# or SCHEMA_CHANGE. Pulls both blobs from BLOB_STORE, decompresses,
7	7	# runs a naive LCS-style line diff, marks added / removed / context,
8	8	# renders as syntax-highlight-ish HTML with monospace typography.
9	9	#
10	10	# URL:
11	11	# /diff.cgi?kind=file&id=N -- FILE_CHANGES row
12	12	# /diff.cgi?kind=schema&id=N -- SCHEMA_CHANGE row
13	13	#======================================================================
14	14	use strict;
15	15	use warnings;
16	16	use CGI ();
17	17	use Compress::Zlib qw(uncompress);
18	18	use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper;
19		use MODS::Diff;
20		use MODS::CompileCheck;
21		use JSON::PP ();
22	19
23	20	my $cgi = CGI->new;
24	21	my $db = MODS::DBConnect->new;
25	22	my $tpl = MODS::Template->new;
26		$\|=1;
	23	$\|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
27	24
28	25	my $kind = $cgi->param('kind') \|\| '';
29	26	my $id = int($cgi->param('id') \|\| 0);
30		my $op = $cgi->param('op') \|\| '';
31
32		# ---- AJAX: compile check ------------------------------------------
33		if ($op eq 'compile' && $id) {
34		my $dbh2 = $db->db_connect;
35		my $r = $db->db_readwrite($dbh2, qq~
36		SELECT fc.file_name, fc.blob_sha, bs.content_gz
37		FROM FILE_CHANGES fc
38		LEFT JOIN BLOB_STORE bs ON bs.blob_sha = fc.blob_sha
39		WHERE fc.file_changes_id = $id LIMIT 1
40		~, __FILE__, __LINE__);
41		$db->db_disconnect($dbh2);
42		print "Content-Type: application/json\nCache-Control: no-cache\n\n";
43		unless ($r && $r->{content_gz}) {
44		print JSON::PP::encode_json({ status => 'unchecked', message => 'no blob' });
45		exit;
46		}
47		my $content = eval { Compress::Zlib::uncompress($r->{content_gz}) };
48		my $result = MODS::CompileCheck::check($content, $r->{file_name});
49		print JSON::PP::encode_json($result);
50		exit;
51		}
52	27
53		# HTML branch from here on
54		print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
55	28	my $dbh = $db->db_connect or die "DB connect failed\n";
56	29
57	30	my ($title, $subtitle, $blob_sha, $prev_sha, $meta) = ('', '', '', '', {});
58	31
59	32	if ($kind eq 'file' && $id) {
60	33	my $row = $db->db_readwrite($dbh, qq~
61	34	SELECT fc.file_changes_id AS id, fc.file_name, fc.status, fc.blob_sha,
62		fc.date_time, UNIX_TIMESTAMP(fc.date_time) AS ts_epoch,
63		fc.uid, fc.gid, fc.permissions, fc.is_ts_only,
	35	fc.date_time, fc.uid, fc.gid, fc.permissions, fc.is_ts_only,
64	36	fc.file_monitor_list_id, s.server_name
65	37	FROM FILE_CHANGES fc LEFT JOIN SERVERS s ON s.server_id = fc.server_id
66	38	WHERE fc.file_changes_id = $id LIMIT 1
67	39	~, __FILE__, __LINE__);
68	40	if ($row && $row->{id}) {
69		# Find the previous captured version of this file for the "before" pane.
70		# Prefer same-monitor scope, but fall back to file-name-only for legacy
71		# rows where file_monitor_list_id is NULL.
	41	# Find the previous captured version of this file for the "before" pane
72	42	my $q_fname = $dbh->quote($row->{file_name});
73		my $scope = defined $row->{file_monitor_list_id}
74		? "file_monitor_list_id = $row->{file_monitor_list_id} AND "
75		: '';
76	43	my $prev = $db->db_readwrite($dbh, qq~
77	44	SELECT blob_sha FROM FILE_CHANGES
78		WHERE $scope
79		file_name = $q_fname
	45	WHERE file_monitor_list_id = $row->{file_monitor_list_id}
	46	AND file_name = $q_fname
80	47	AND file_changes_id < $id
81	48	AND blob_sha IS NOT NULL
82	49	ORDER BY file_changes_id DESC LIMIT 1
83	50	~, __FILE__, __LINE__);
84	51	$title = $row->{file_name};
85		my $ep = int($row->{ts_epoch} \|\| 0);
86		$subtitle = qq~$row->{status} on $row->{server_name} at <span class="ts" data-ts="$ep" data-fmt="datetime">$row->{date_time}</span>~;
	52	$subtitle = "$row->{status} on $row->{server_name} at $row->{date_time}";
87	53	$blob_sha = $row->{blob_sha};
88	54	$prev_sha = $prev && $prev->{blob_sha} ? $prev->{blob_sha} : '';
89	55	$meta = { %$row };
90	56	}
91	57	}
92	58	elsif ($kind eq 'schema' && $id) {
93	59	my $row = $db->db_readwrite($dbh, qq~
94	60	SELECT sc.schema_change_id AS id, sc.database_name, sc.table_name, sc.changes,
95		sc.schema_blob_sha, sc.change_datetime,
96		UNIX_TIMESTAMP(sc.change_datetime) AS ts_epoch,
97		s.server_name, sc.server_id
	61	sc.schema_blob_sha, sc.change_datetime, s.server_name, sc.server_id
98	62	FROM SCHEMA_CHANGE sc LEFT JOIN SERVERS s ON s.server_id = sc.server_id
99	63	WHERE sc.schema_change_id = $id LIMIT 1
100	64	~, __FILE__, __LINE__);
101	65	if ($row && $row->{id}) {
102	66	my $q_db = $dbh->quote($row->{database_name});
103	67	my $q_t = $dbh->quote($row->{table_name});
104	68	my $prev = $db->db_readwrite($dbh, qq~
105	69	SELECT schema_blob_sha FROM SCHEMA_CHANGE
106	70	WHERE server_id = $row->{server_id}
107	71	AND database_name = $q_db AND table_name = $q_t
108	72	AND schema_change_id < $id
109	73	AND schema_blob_sha IS NOT NULL
110	74	ORDER BY schema_change_id DESC LIMIT 1
111	75	~, __FILE__, __LINE__);
112	76	$title = "$row->{database_name}.$row->{table_name}";
113		my $ep = int($row->{ts_epoch} \|\| 0);
114		$subtitle = qq~on $row->{server_name} at <span class="ts" data-ts="$ep" data-fmt="datetime">$row->{change_datetime}</span>~;
	77	$subtitle = "on $row->{server_name} at $row->{change_datetime}";
115	78	$blob_sha = $row->{schema_blob_sha};
116	79	$prev_sha = $prev && $prev->{schema_blob_sha} ? $prev->{schema_blob_sha} : '';
117	80	$meta = { %$row };
118	81	}
119	82	}
120	83
121	84	# Fetch + decompress blobs
122	85	my $curr = $blob_sha ? _fetch_blob($db, $dbh, $blob_sha) : '';
123	86	my $prev = $prev_sha ? _fetch_blob($db, $dbh, $prev_sha) : '';
124	87
125	88	$db->db_disconnect($dbh);
126	89
127	90	# Compute a naive line-level diff
128		my @lines = MODS::Diff::lines($prev // '', $curr // '');
	91	my @lines = _line_diff($prev // '', $curr // '');
129	92	my ($ct_add, $ct_del) = (0, 0);
130	93	foreach my $L (@lines) {
131	94	$ct_add++ if $L->{op} eq 'add';
132	95	$ct_del++ if $L->{op} eq 'del';
133		# HTML-escape diff'd content -- files under monitor may themselves be
134		# HTML/JS/CSS, and dumping raw content into an on-screen table renders
135		# the tags live. Escape it so it displays as source.
136		my $t = $L->{text}; $t = '' unless defined $t;
137		$t =~ s/&/&/g; $t =~ s/</</g; $t =~ s/>/>/g;
138		$L->{text} = $t;
139	96	}
140	97
141	98	my $tvars = {
142	99	title => $title \|\| '(unknown)',
143	100	subtitle => $subtitle,
144	101	kind => $kind,
145	102	id => $id,
146	103	has_diff => scalar(@lines) ? 1 : 0,
147	104	lines => \@lines,
148	105	ct_add => $ct_add,
149	106	ct_del => $ct_del,
150	107	ct_context => scalar(@lines) - $ct_add - $ct_del,
151	108	has_prev => $prev_sha ? 1 : 0,
152	109	curr_sha => substr($blob_sha \|\| '', 0, 12),
153	110	prev_sha => substr($prev_sha \|\| '', 0, 12),
154		restore_url => ($kind eq 'file' && $blob_sha) ? "/restore.cgi?id=$id" : '',
155	111	};
156	112
157	113	my @body = $tpl->template('diff.html', $tvars);
158	114	MODS::PageWrapper->new->wrapper(
159	115	page_title => "Diff -- $title",
160	116	page_key => ($kind eq 'schema' ? 'schema_changes' : 'file_changes'),
161	117	body_html => join('', @body),
162	118	userinfo => { display_name => 'Operator' },
163	119	);
164	120
165	121	#---------------------------------------------------------------------
166	122	sub _fetch_blob {
167	123	my ($db, $dbh, $sha) = @_;
168	124	my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?");
169	125	return '' unless $sth && $sth->execute($sha);
170	126	my $row = $sth->fetchrow_arrayref;
171	127	$sth->finish;
172	128	return '' unless $row && $row->[0];
173	129	my $decompressed = eval { uncompress($row->[0]) };
174	130	return $decompressed // '';
175	131	}
176	132
177	133	#---------------------------------------------------------------------
178	134	# _line_diff -- naive line-level diff. Returns an array of hashrefs:
179	135	# { op => 'add' \| 'del' \| 'ctx', text => $line, old_n, new_n }
180	136	# Uses a simple LCS-based approach; adequate for small-to-medium files.
181	137	# For huge diffs shell out to /usr/bin/diff (future optimization).
182	138	#---------------------------------------------------------------------
183	139	sub _line_diff {
184	140	my ($old, $new) = @_;
185	141	my @old_lines = split /\r?\n/, ($old // '');
186	142	my @new_lines = split /\r?\n/, ($new // '');
187	143
188	144	# LCS length table (dynamic programming) -- capped to prevent
189	145	# runaway memory on huge inputs.
190	146	my $O = scalar @old_lines;
191	147	my $N = scalar @new_lines;
192	148	if ($O > 5000 \|\| $N > 5000) {
193	149	# Fall back: just dump both sides linearly, marked as del/add.
194	150	my @out;
195	151	my $i = 0;
196	152	push @out, { op => 'del', text => $_, old_n => ++$i, new_n => '' } for @old_lines;
197	153	my $j = 0;
198	154	push @out, { op => 'add', text => $_, old_n => '', new_n => ++$j } for @new_lines;
199	155	return @out;
200	156	}
201	157
202	158	my @lcs; for my $i (0..$O) { $lcs[$i][0] = 0; }
203	159	for my $j (0..$N) { $lcs[0][$j] = 0; }
204	160	for my $i (1..$O) {
205	161	for my $j (1..$N) {
206	162	$lcs[$i][$j] = $old_lines[$i-1] eq $new_lines[$j-1]
207	163	? $lcs[$i-1][$j-1] + 1
208	164	: ($lcs[$i-1][$j] >= $lcs[$i][$j-1] ? $lcs[$i-1][$j] : $lcs[$i][$j-1]);
209	165	}
210	166	}
211	167
212	168	my @out;
213	169	my ($i, $j) = ($O, $N);
214	170	while ($i > 0 \|\| $j > 0) {
215	171	if ($i > 0 && $j > 0 && $old_lines[$i-1] eq $new_lines[$j-1]) {
216	172	unshift @out, { op => 'ctx', text => $old_lines[$i-1], old_n => $i, new_n => $j };
217	173	$i--; $j--;
218	174	} elsif ($j > 0 && ($i == 0 \|\| $lcs[$i][$j-1] >= $lcs[$i-1][$j])) {
219	175	unshift @out, { op => 'add', text => $new_lines[$j-1], old_n => '', new_n => $j };
220	176	$j--;
221	177	} else {
222	178	unshift @out, { op => 'del', text => $old_lines[$i-1], old_n => $i, new_n => '' };
223	179	$i--;
224	180	}
225	181	}
226	182	return @out;
227	183	}

Confirm restore

Backs current content to <target>.drift_restore_backup_<epoch>, writes the captured content, verifies SHA post-write.