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