Diff -- /var/www/vhosts/3dshawn.com/site1/MODS/Restore.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/site1/MODS/Restore.pm

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

Added
+161
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to acf0f0a9caef
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::Restore;
2#======================================================================
3# DriftSense -- shared restore-write logic.
4#
5# Extracted from restore.cgi so sync.cgi (and future bulk operations)
6# can reuse it without HTTP self-calls.
7#
8# Public API:
9#
10# my ($ok, $msg, $backup) = MODS::Restore::write_blob(
11# server_row => $srow, # SERVERS row (has kind + ssh_* fields)
12# target => '/path/to/file',
13# blob_sha => '<sha256_hex>',
14# content => $bytes, # decompressed blob content
15# );
16#
17# Handles local + ssh_agent branches, creates a backup file
18# ($target.drift_restore_backup_<epoch>), writes the content, verifies
19# SHA post-write, returns (ok_bool, message, backup_path).
20#======================================================================
21use strict;
22use warnings;
23use IPC::Open3;
24use Symbol 'gensym';
25use Fcntl ();
26use Digest::SHA qw(sha256_hex);
27use MODS::Crypto;
28
29sub write_blob {
30 my (%a) = @_;
31 my $server = $a{server_row} or return (0, 'no server_row', '');
32 my $target = $a{target} or return (0, 'no target', '');
33 my $sha = $a{blob_sha} or return (0, 'no blob_sha', '');
34 my $content = $a{content};
35 return (0, 'no content', '') unless defined $content;
36
37 my $kind = $server->{kind} // 'local';
38 my $stamp = time();
39 my $backup = "$target.drift_restore_backup_$stamp";
40
41 if ($kind eq 'local') {
42 if (-e $target) {
43 unless (rename($target, $backup)) {
44 # Fallback: cp
45 open(my $src, '<:raw', $target) or return (0, "read $target: $!", '');
46 open(my $bak, '>:raw', $backup) or return (0, "backup $backup: $!", '');
47 local $/; print {$bak} <$src>;
48 close $src; close $bak;
49 }
50 } else {
51 $backup = '';
52 }
53 open(my $out, '>:raw', $target) or return (0, "write $target: $!", $backup);
54 print {$out} $content;
55 close $out;
56 # Verify
57 open(my $v, '<:raw', $target);
58 local $/; my $written = <$v>; close $v;
59 my $vsha = sha256_hex($written);
60 return (0, "post-write SHA mismatch: $vsha != $sha", $backup) if $vsha ne $sha;
61 return (1, "wrote " . length($content) . " bytes locally", $backup);
62 }
63
64 # ssh_agent
65 my ($rc, $out, $err) = _ssh_run($server,
66 "test -f " . _sh_quote($target) .
67 " && cp -p " . _sh_quote($target) . " " . _sh_quote($backup) .
68 " ; echo done");
69 $backup = '' if $rc != 0;
70
71 my $wrote = _ssh_write($server, $target, $content);
72 return (0, "ssh write failed", $backup) unless $wrote;
73
74 ($rc, $out, $err) = _ssh_run($server, "sha256sum " . _sh_quote($target));
75 my $vsha = ($out =~ /^([0-9a-f]{64})\s/) ? $1 : '';
76 return (0, "remote post-write SHA mismatch: $vsha != $sha", $backup) if $vsha ne $sha;
77 return (1, "wrote " . length($content) . " bytes via ssh", $backup);
78}
79
80#---------------------------------------------------------------------
81sub _ssh_argv {
82 my ($server) = @_;
83 my $user = $server->{ssh_user} || 'root';
84 my $host = $server->{ssh_host};
85 my $port = $server->{ssh_port} || 22;
86 my $key_path = $server->{ssh_key_path} || '';
87 my $tmp_key;
88
89 if ($server->{ssh_key_blob}) {
90 my $pem = eval { MODS::Crypto::decrypt($server->{ssh_key_blob}) };
91 if ($pem) {
92 my $p = '/tmp/.ds_restore_key_' . time() . '_' . $$ . '_' . int(rand(1_000_000));
93 if (sysopen(my $fh, $p,
94 Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_EXCL(), 0600)) {
95 print $fh $pem; close $fh;
96 $key_path = $p;
97 $tmp_key = $p;
98 }
99 }
100 }
101
102 my @argv = ('/usr/bin/ssh',
103 '-o', 'BatchMode=yes',
104 '-o', 'StrictHostKeyChecking=no',
105 '-o', 'UserKnownHostsFile=/dev/null',
106 '-o', 'LogLevel=ERROR',
107 '-o', 'ConnectTimeout=8',
108 '-p', $port);
109 push @argv, '-i', $key_path if $key_path && -r $key_path;
110 if ($server->{ssh_options}) {
111 foreach my $o (split /\s+/, $server->{ssh_options}) {
112 push @argv, '-o', $o if length $o;
113 }
114 }
115 push @argv, "$user\@$host";
116 return (\@argv, $tmp_key);
117}
118
119sub _ssh_run {
120 my ($server, $cmd) = @_;
121 my ($base, $tmp) = _ssh_argv($server);
122 my @full = (@$base, $cmd);
123 my ($wtr, $rdr, $err_fh); $err_fh = gensym;
124 my $pid = eval { open3($wtr, $rdr, $err_fh, @full) };
125 if ($@ || !$pid) { unlink $tmp if $tmp; return (-1, '', $@); }
126 close $wtr;
127 my $out = do { local $/; <$rdr> // '' };
128 my $err = do { local $/; <$err_fh> // '' };
129 close $rdr; close $err_fh;
130 waitpid $pid, 0;
131 my $rc = $? >> 8;
132 unlink $tmp if $tmp;
133 return ($rc, $out, $err);
134}
135
136sub _ssh_write {
137 my ($server, $path, $content) = @_;
138 my ($base, $tmp) = _ssh_argv($server);
139 my @full = (@$base, "cat > " . _sh_quote($path));
140 my ($wtr, $rdr, $err_fh); $err_fh = gensym;
141 my $pid = eval { open3($wtr, $rdr, $err_fh, @full) };
142 if ($@ || !$pid) { unlink $tmp if $tmp; return 0; }
143 binmode $wtr;
144 print {$wtr} $content;
145 close $wtr;
146 do { local $/; <$rdr> // ''; };
147 do { local $/; <$err_fh> // ''; };
148 close $rdr; close $err_fh;
149 waitpid $pid, 0;
150 my $rc = $? >> 8;
151 unlink $tmp if $tmp;
152 return $rc == 0 ? 1 : 0;
153}
154
155sub _sh_quote {
156 my $s = shift; $s //= '';
157 $s =~ s/'/'\\''/g;
158 return "'$s'";
159}
160
1611;