added on local at 2026-07-12 00:19:43
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- /sync.cgi | |
| 4 | # | |
| 5 | # Cross-site "make N sites match this file" workflow. Given a source | |
| 6 | # file_changes_id, find every other monitor whose latest capture of a | |
| 7 | # same-basename file has a DIFFERENT SHA. Multi-select the targets + | |
| 8 | # confirm -> DriftSense writes the source blob content to each target's | |
| 9 | # file path in one pass, using MODS::Restore under the hood (which | |
| 10 | # handles the local / ssh_agent branch + backup + verify per target). | |
| 11 | # | |
| 12 | # GET /sync.cgi?id=N -> preview + multi-select | |
| 13 | # POST id=N confirm=1 targets=N,N -> execute the fanned-out restores | |
| 14 | #====================================================================== | |
| 15 | use strict; | |
| 16 | use warnings; | |
| 17 | use CGI (); | |
| 18 | use Compress::Zlib qw(uncompress); | |
| 19 | use IPC::Open3; | |
| 20 | use Symbol 'gensym'; | |
| 21 | use MODS::Config; | |
| 22 | use MODS::DBConnect; | |
| 23 | use MODS::Template; | |
| 24 | use MODS::PageWrapper; | |
| 25 | use MODS::Restore; | |
| 26 | use MODS::Diff; | |
| 27 | ||
| 28 | my $cgi = CGI->new; | |
| 29 | my $db = MODS::DBConnect->new; | |
| 30 | my $tpl = MODS::Template->new; | |
| 31 | $|=1; | |
| 32 | ||
| 33 | my $dbh = $db->db_connect or die "DB connect failed\n"; | |
| 34 | ||
| 35 | my $method = $ENV{REQUEST_METHOD} || 'GET'; | |
| 36 | my $id = int($cgi->param('id') || 0); | |
| 37 | ||
| 38 | # ---- Source row ---------------------------------------------------- | |
| 39 | my $src = $id ? $db->db_readwrite($dbh, qq~ | |
| 40 | SELECT fc.file_changes_id AS id, fc.file_name, fc.blob_sha, fc.status, | |
| 41 | fc.date_time, fc.file_monitor_list_id, | |
| 42 | m.scan_name AS src_scan_name, | |
| 43 | s.server_name AS src_server_name | |
| 44 | FROM FILE_CHANGES fc | |
| 45 | LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = fc.file_monitor_list_id | |
| 46 | LEFT JOIN SERVERS s ON s.server_id = fc.server_id | |
| 47 | WHERE fc.file_changes_id = $id LIMIT 1 | |
| 48 | ~, __FILE__, __LINE__) : undef; | |
| 49 | ||
| 50 | unless ($src && $src->{blob_sha}) { | |
| 51 | print "Content-Type: text/html; charset=utf-8\n\n"; | |
| 52 | my @body = $tpl->template('sync.html', { | |
| 53 | has_error => 1, | |
| 54 | error_msg => "Change #$id not found or has no blob.", | |
| 55 | }); | |
| 56 | MODS::PageWrapper->new->wrapper( | |
| 57 | page_title => 'Sync', page_key => '', | |
| 58 | body_html => join('', @body), userinfo => { display_name => 'Operator' }, | |
| 59 | ); | |
| 60 | exit; | |
| 61 | } | |
| 62 | ||
| 63 | # ---- Find candidate targets ---------------------------------------- | |
| 64 | my $basename = $src->{file_name}; $basename =~ s!.*/!!; | |
| 65 | my $q_base_like = $dbh->quote('%/' . $basename); | |
| 66 | my @targets = $db->db_readwrite_multiple($dbh, qq~ | |
| 67 | SELECT fc.file_changes_id AS latest_id, | |
| 68 | fc.file_name, | |
| 69 | fc.blob_sha, | |
| 70 | fc.status, | |
| 71 | fc.file_monitor_list_id AS mid, | |
| 72 | fc.server_id, | |
| 73 | m.scan_name, | |
| 74 | s.server_name, | |
| 75 | s.kind AS server_kind, | |
| 76 | s.ssh_host, s.ssh_user, s.ssh_port, | |
| 77 | s.ssh_key_path, s.ssh_options, s.ssh_key_blob | |
| 78 | FROM FILE_CHANGES fc | |
| 79 | JOIN ( | |
| 80 | SELECT file_monitor_list_id, file_name, MAX(file_changes_id) AS max_id | |
| 81 | FROM FILE_CHANGES | |
| 82 | WHERE file_name LIKE $q_base_like | |
| 83 | GROUP BY file_monitor_list_id, file_name | |
| 84 | ) latest ON latest.max_id = fc.file_changes_id | |
| 85 | LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = fc.file_monitor_list_id | |
| 86 | LEFT JOIN SERVERS s ON s.server_id = fc.server_id | |
| 87 | WHERE fc.file_monitor_list_id != $src->{file_monitor_list_id} | |
| 88 | AND fc.blob_sha IS NOT NULL | |
| 89 | AND fc.blob_sha != @{[ $dbh->quote($src->{blob_sha}) ]} | |
| 90 | AND fc.status != 'deleted' | |
| 91 | ORDER BY m.scan_name ASC | |
| 92 | ~, __FILE__, __LINE__); | |
| 93 | ||
| 94 | # ---- POST: execute the fanned-out writes --------------------------- | |
| 95 | if ($method eq 'POST' && $cgi->param('confirm')) { | |
| 96 | my %wanted = map { int($_) => 1 } $cgi->param('targets'); | |
| 97 | # Fetch the source blob content ONCE | |
| 98 | my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?"); | |
| 99 | $sth->execute($src->{blob_sha}); | |
| 100 | my $blob_row = $sth->fetchrow_arrayref; | |
| 101 | $sth->finish; | |
| 102 | my $content = ($blob_row && $blob_row->[0]) ? eval { uncompress($blob_row->[0]) } : undef; | |
| 103 | unless (defined $content) { | |
| 104 | $db->db_disconnect($dbh); | |
| 105 | print "Status: 302 Found\nLocation: /sync.cgi?id=$id&fail=99\n\n"; | |
| 106 | exit; | |
| 107 | } | |
| 108 | ||
| 109 | my ($ok_ct, $fail_ct) = (0, 0); | |
| 110 | foreach my $t (@targets) { | |
| 111 | next unless $wanted{$t->{latest_id}}; | |
| 112 | my ($ok, $msg, $backup) = MODS::Restore::write_blob( | |
| 113 | server_row => $t, | |
| 114 | target => $t->{file_name}, | |
| 115 | blob_sha => $src->{blob_sha}, | |
| 116 | content => $content, | |
| 117 | ); | |
| 118 | # Log a RESTORE_LOG row per target | |
| 119 | my $q_file = $dbh->quote($t->{file_name}); | |
| 120 | my $q_sha = $dbh->quote($src->{blob_sha}); | |
| 121 | my $q_bak = $dbh->quote($backup // ''); | |
| 122 | my $q_stat = $ok ? "'success'" : "'failed'"; | |
| 123 | my $q_err = $dbh->quote($ok ? '' : ($msg // '')); | |
| 124 | my $q_by = $dbh->quote('sync-from-' . $src->{id}); | |
| 125 | $db->db_readwrite($dbh, qq~ | |
| 126 | INSERT INTO RESTORE_LOG | |
| 127 | (source_change_id, server_id, target_file, source_blob_sha, | |
| 128 | backup_path, status, error_message, restored_by) | |
| 129 | VALUES | |
| 130 | ($src->{id}, $t->{server_id}, $q_file, $q_sha, | |
| 131 | $q_bak, $q_stat, $q_err, $q_by) | |
| 132 | ~, __FILE__, __LINE__); | |
| 133 | $ok ? $ok_ct++ : $fail_ct++; | |
| 134 | } | |
| 135 | $db->db_disconnect($dbh); | |
| 136 | print "Status: 302 Found\nLocation: /sync.cgi?id=$id&ok=$ok_ct&fail=$fail_ct\n\n"; | |
| 137 | exit; | |
| 138 | } | |
| 139 | ||
| 140 | # ---- GET: preview -------------------------------------------------- | |
| 141 | my $dry_run = $cgi->param('dry_run') ? 1 : 0; | |
| 142 | ||
| 143 | # Fetch source blob content once (needed for dry-run diff) | |
| 144 | my $src_content; | |
| 145 | if ($dry_run) { | |
| 146 | my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?"); | |
| 147 | $sth->execute($src->{blob_sha}); | |
| 148 | my $r = $sth->fetchrow_arrayref; | |
| 149 | $sth->finish; | |
| 150 | $src_content = ($r && $r->[0]) ? eval { uncompress($r->[0]) } : undef; | |
| 151 | } | |
| 152 | ||
| 153 | foreach my $t (@targets) { | |
| 154 | $t->{sha_short} = substr($t->{blob_sha} // '', 0, 12); | |
| 155 | $t->{file_short} = length($t->{file_name} // '') > 60 | |
| 156 | ? '...' . substr($t->{file_name}, -57) : $t->{file_name}; | |
| 157 | $t->{diff_url} = "/diff.cgi?kind=file&id=$t->{latest_id}"; | |
| 158 | $t->{kind_pill} = ($t->{server_kind} // '') eq 'ssh_agent' ? 'pill-info' : 'pill-mute'; | |
| 159 | ||
| 160 | if ($dry_run) { | |
| 161 | # Fetch target's current on-disk content and diff vs source | |
| 162 | my $cur_content = _read_current($t); | |
| 163 | if (defined $cur_content && defined $src_content) { | |
| 164 | my @lines = MODS::Diff::html_escape_lines(MODS::Diff::lines($cur_content, $src_content)); | |
| 165 | my ($add, $del) = (0, 0); | |
| 166 | for my $L (@lines) { | |
| 167 | $add++ if $L->{op} eq 'add'; | |
| 168 | $del++ if $L->{op} eq 'del'; | |
| 169 | } | |
| 170 | $t->{diff_lines} = \@lines; | |
| 171 | $t->{has_diff} = scalar(@lines) ? 1 : 0; | |
| 172 | $t->{diff_add} = $add; | |
| 173 | $t->{diff_del} = $del; | |
| 174 | $t->{diff_ctx} = scalar(@lines) - $add - $del; | |
| 175 | } else { | |
| 176 | $t->{diff_lines} = []; | |
| 177 | $t->{has_diff} = 0; | |
| 178 | $t->{diff_add} = 0; | |
| 179 | $t->{diff_del} = 0; | |
| 180 | $t->{diff_ctx} = 0; | |
| 181 | } | |
| 182 | } | |
| 183 | } | |
| 184 | my $ok_ct = int($cgi->param('ok') || 0); | |
| 185 | my $fail_ct = int($cgi->param('fail') || 0); | |
| 186 | ||
| 187 | $db->db_disconnect($dbh); | |
| 188 | ||
| 189 | my $tvars = { | |
| 190 | src_id => $src->{id}, | |
| 191 | src_file => $src->{file_name}, | |
| 192 | src_scan => $src->{src_scan_name}, | |
| 193 | src_server => $src->{src_server_name}, | |
| 194 | src_sha => substr($src->{blob_sha}, 0, 12), | |
| 195 | src_sha_full => $src->{blob_sha}, | |
| 196 | basename => $basename, | |
| 197 | targets => \@targets, | |
| 198 | has_targets => scalar(@targets) ? 1 : 0, | |
| 199 | total_targets => scalar @targets, | |
| 200 | ok_ct => $ok_ct, | |
| 201 | fail_ct => $fail_ct, | |
| 202 | has_result => ($ok_ct + $fail_ct) ? 1 : 0, | |
| 203 | src_diff_url => "/diff.cgi?kind=file&id=$src->{id}", | |
| 204 | dry_run => $dry_run, | |
| 205 | preview_url => "/sync.cgi?id=$src->{id}&dry_run=1", | |
| 206 | confirm_url => "/sync.cgi?id=$src->{id}", | |
| 207 | }; | |
| 208 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 209 | my @body = $tpl->template('sync.html', $tvars); | |
| 210 | MODS::PageWrapper->new->wrapper( | |
| 211 | page_title => 'Sync', page_key => '', | |
| 212 | body_html => join('', @body), userinfo => { display_name => 'Operator' }, | |
| 213 | ); | |
| 214 | exit; | |
| 215 | ||
| 216 | #--------------------------------------------------------------------- | |
| 217 | # _read_current($target_row) -> current on-disk content or undef | |
| 218 | #--------------------------------------------------------------------- | |
| 219 | sub _read_current { | |
| 220 | my ($t) = @_; | |
| 221 | my $path = $t->{file_name}; | |
| 222 | if (($t->{server_kind} // 'local') eq 'local') { | |
| 223 | return undef unless -r $path; | |
| 224 | open(my $fh, '<:raw', $path) or return undef; | |
| 225 | local $/; my $c = <$fh>; close $fh; | |
| 226 | # Cap at 512 KB for preview responsiveness | |
| 227 | return length($c) > 512_000 ? substr($c, 0, 512_000) : $c; | |
| 228 | } | |
| 229 | # SSH agent | |
| 230 | my $user = $t->{ssh_user} || 'root'; | |
| 231 | my $host = $t->{ssh_host}; | |
| 232 | my $port = $t->{ssh_port} || 22; | |
| 233 | my $key = $t->{ssh_key_path} || ''; | |
| 234 | my @argv = ('/usr/bin/ssh', | |
| 235 | '-o', 'BatchMode=yes', | |
| 236 | '-o', 'StrictHostKeyChecking=no', | |
| 237 | '-o', 'UserKnownHostsFile=/dev/null', | |
| 238 | '-o', 'LogLevel=ERROR', | |
| 239 | '-o', 'ConnectTimeout=6', | |
| 240 | '-p', $port); | |
| 241 | push @argv, '-i', $key if $key && -r $key; | |
| 242 | push @argv, "$user\@$host", | |
| 243 | "head -c 524288 " . _sh_q($path); | |
| 244 | my ($wtr, $rdr, $err_fh); | |
| 245 | $err_fh = gensym; | |
| 246 | my $pid = eval { open3($wtr, $rdr, $err_fh, @argv) }; | |
| 247 | return undef if $@ || !$pid; | |
| 248 | close $wtr; | |
| 249 | my $out = do { local $/; <$rdr> // '' }; | |
| 250 | close $rdr; close $err_fh; | |
| 251 | waitpid $pid, 0; | |
| 252 | return ($? >> 8) == 0 ? $out : undef; | |
| 253 | } | |
| 254 | sub _sh_q { my $s = shift; $s //= ''; $s =~ s/'/'\\''/g; return "'$s'"; } |