YANZ UPLOAD ANJG #!/usr/local/cpanel/3rdparty/bin/perl
# Copyright 2026 WebPros International, LLC
# All rights reserved.
# copyright@cpanel.net http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited.
package scripts::comet_restorepkg_guard;
use cPstrict;
=encoding utf-8
=head1 NAME
comet_restorepkg_guard - make a failed C restore
actually fail the Comet job (CPANEL-55666)
=head1 SYNOPSIS
comet_restorepkg_guard --disable= --from-stdin --skipaccount --newuser [--comet-capture-domain-keys]
The snapshot archive arrives on B STDIN, exactly as it arrived on
C's before this guard was interposed.
=head1 DESCRIPTION
The C and C restore paths are
Comet C (process) restores: the agent runs the item's C
through C and pipes the snapshot to its STDIN.
B STRUCTURALLY CANNOT REPORT AN EXTRACTION FAILURE.> It
sets a transfer session up and then Cs C>,
which tails the session's logs and always exits 0. So when the archive is the
corrupted one CPANEL-55666's backup half produces, extraction dies with
C, the transfer session records a
C action in its C, and the process Comet is watching
still exits 0. The plugin then logs
C having restored nothing.
The pre-existing net does not catch it either: C<_mysql_restore_quarantined>
(CPANEL-54772) looks for the C directory
C leaves behind when a per-database
B fails. An archive that never EXTRACTED produces no dumps, so there is
nothing to fail to import and nothing to quarantine. Absent data and failed data
are different facts and only the second had a guard.
C adds the missing one, in four steps:
=over 4
=item 1. B The first two bytes of STDIN
must be gzip magic, after up to C<$MAX_LEADING_WHITESPACE_BYTES> leading
whitespace bytes (C<\n>, C<\r>, space, tab), which are skipped and never passed
on (CPANEL-57691: core C can print blank lines ahead of the archive). If they are not (or STDIN is empty), C is
B: the diagnostic names CPANEL-55666, echoes the leading bytes
(they are the error text core printed into the backup stream) and exits
non-zero. Refusing before dispatch is the whole point — a corrupted archive must
not get as far as creating a session, let alone half-restoring an account.
=item 2. B C is forked with
a pipe as its STDIN; the two head bytes are written first and the remainder of
our own STDIN is pumped after them, so the child sees a byte-identical archive.
Its STDERR is inherited (the Comet job log keeps C's error rendering
unchanged), and its STDOUT is captured to a regular temp FILE. A regular file is
what makes this deadlock-free regardless of how much C writes before
it drains STDIN — files never block, so there is no need for a second reader
process or a C loop. After the child exits the captured STDOUT is teed to
our own STDOUT verbatim, so the job log is byte-identical to today's inherited
output, just delivered on exit rather than streamed (fine for a Type=2 process
restore).
=item 3. B When C announced a
transfer session (step 4), the guard first waits for that session to finish,
whatever C's exit code (CPANEL-57740): C can exit 2 while
the session is still restoring the account, when its C looked for
the session log before the session had created it (core case CPANEL-57742). The
session's verdict then decides, so a session that finished clean is a success
even though C exited non-zero. A session that does not finish (it
stopped, never started, or ran past the wait's cap) fails the restore. Without an
announced session, a non-zero exit from C is reported and propagated.
=item 4. B
PRINTS.> C renders the session log by Cing
C<< /usr/local/cpanel/bin/view_transfer >>, and that command-path
line is LOCALE-INDEPENDENT (the sentences around it are translated; the path is
not). The session id is lifted from it with C<< m{/bin/view_transfer\s+(\S+)} >>.
C<< $SESSIONS_DIR//master.log >> is then scanned for C
records and any failure text found fails the job.
B, not
here (CPANEL-57056).> The plugin's own LOCAL C replays
-- C and
C -- had the identical defect and now ask the
identical question, so the id lift, the C scan and the fail-closed
rules are ONE implementation with two readers rather than a copy. This script
keeps the dispatch, the head check, the stream pump and every diagnostic it has
always printed; only the answer is fetched rather than derived.
B The obvious alternative — reading C's C
column — is WRONG: C runs the transfer through
C, which forks a MASTER CHILD via
C and stamps the session with THAT child's pid
(C / C<:211>), then Cs C. So the recorded
pid is a grandchild this guard never sees; a pid-keyed lookup found no row on a
perfectly good restore and failed every legacy restore, success or not (found by
live A/B). The printed C id is the session's own identity and is
race-free under parallel restores because each C prints its own.
=back
B With
C<--comet-capture-domain-keys> (the legacy settings dispatch passes it; the guard
removes it before running C) the archive's DKIM private keys and DNSSEC
keys are read out of the same bytes as they are passed on, and kept for the
C<--newuser> account in a root-only file
(C). A restore that moves the
account off an old-format temporary domain carries them to the new name; core only
installs keys for the names the account owns during the replay, and the archive is
gone afterwards. Reading the keys never changes what C receives or the
exit code.
B When the
C<--newuser> account is suspended once C exits, the guard locks the
shell, password, FTP, Web Disk digest and cron that core's modules restored, the way
C does (C). A
login it cannot lock fails the restore.
B A C that exited 0 without
announcing a C session did not restore anything, so the absence is
treated as a failure rather than as an all-clear. The same goes for a session
directory or C that cannot be read: the guard exists precisely
because this path's default answer was an unearned success.
B It does not parse C's rendered
result text (locale-fragile), and it does not reimplement the transfer session's
internals — it reads the one locale-independent line C prints and the
C core already writes.
C<$RESTOREPKG_BIN> and C<$SESSIONS_DIR> are package variables ONLY so the unit
suite can retarget them after C-loading this file; like the backup-side
guard, nothing here is settable from the environment or the command line, because
this program is exec'd from a string stored on the Comet server.
=cut
our $RESTOREPKG_BIN = '/usr/local/cpanel/scripts/restorepkg';
our $SESSIONS_DIR = '/var/cpanel/transfer_sessions';
# CPANEL-57716: core's suspension flag directory (Cpanel::AcctUtils::Suspended), read
# directly when the suspended-account check itself could not run.
our $SUSPENDED_DIR = '/var/cpanel/suspended';
# Same magic the backup-side guard checks; see comet_pkgacct_stream_guard.
our $GZIP_MAGIC = "\x1f\x8b";
our $MAX_CAPTURED_GARBAGE_BYTES = 4096;
our $CAPTURE_KEYS_OPTION = '--comet-capture-domain-keys';
our $READ_CHUNK_BYTES = 65_536;
# CPANEL-57691: archives stored by a backup that let core pkgacct's leading blank
# lines through begin with them. Same tolerance and cap as the backup-side guard.
our $MAX_LEADING_WHITESPACE_BYTES = 4096;
exit run(@ARGV) unless caller;
=head1 FUNCTIONS
=head2 run( @argv )
Runs C<$RESTOREPKG_BIN @argv> behind the head check and the session verdict
described above. Returns the process exit code: 0 only when the archive was
well-formed, C announced a transfer session on its STDOUT, that
session finished, and its C holds no C. C's
own exit code decides only when it announced no session.
=cut
sub run (@argv) {
local $SIG{'PIPE'} = 'IGNORE';
binmode STDIN; # best-effort: the archive is read with sysread, which ignores layers and is checked
# CPANEL-57650: the guard's own option, never passed to restorepkg.
my $capture_keys = grep { $_ eq $CAPTURE_KEYS_OPTION } @argv;
@argv = grep { $_ ne $CAPTURE_KEYS_OPTION } @argv;
my ( $skipped, $head ) = _read_head( \*STDIN );
return _refuse_bad_archive( $head, $skipped ) if !defined $head || $head ne $GZIP_MAGIC;
_note( 'Skipped blank bytes before the account backup archive', { user => _newuser(@argv) // '', bytes => $skipped } ) if $skipped;
my $keys = $capture_keys ? _key_collector(@argv) : undef;
my $result = _stream_to_restorepkg( $head, $keys ? $keys->{collector} : undef, @argv );
return 1 if !defined $result;
my $captured = _read_captured_stdout( $result->{out_fh} );
my $exit_code = _exit_code_from_status( $result->{status} );
# CPANEL-57740: restorepkg can exit before the transfer session it started has
# finished. Wait for the session before anything else reads the account or
# this process exits (the agent then deletes the archive's directory).
my $session_end = _wait_for_session( $captured, $exit_code, _newuser(@argv) );
# CPANEL-58273: core's Mysql module leaves the account's main database user with
# privileges at localhost only. Before the relock below, which must also lock any
# login this creates.
my $privileges_failed = _restore_owner_db_privileges( $session_end, @argv );
# CPANEL-57714: restorepkg ran, whatever its verdict, so lock what it wrote first.
my $relock_failed = _relock_suspended_logins( _newuser(@argv) );
_save_keys($keys) if $keys;
# Tee restorepkg's captured STDOUT to our own verbatim, ALWAYS, so the Comet
# job log keeps restorepkg's normal rendering whatever the verdict below is.
binmode STDOUT; # best-effort: the tee writes with syswrite, which ignores layers
_write_all( \*STDOUT, $captured );
_diag("the databases were restored, but the privileges of the account's main database user could not be restored for every MySQL access host.") if $privileges_failed;
if ($relock_failed) {
_diag('the account is suspended, but some of its restored logins could not be locked. Unsuspend the account, then suspend it again.');
return 1;
}
if ( !$session_end ) {
# No session was announced: restorepkg's exit code is all there is.
if ($exit_code) {
_diag("restorepkg exited with status $exit_code; the restore failed.");
return $exit_code;
}
}
elsif ( my $problem = _session_end_problem($session_end) ) {
_diag($problem);
return $exit_code || 1;
}
if ( $result->{pump} ne 'ok' ) {
_diag('the backup data could not be fully passed to restorepkg. The restore is incomplete.');
return 1;
}
# A session was announced and has finished: its verdict decides, whatever
# restorepkg's exit code was (CPANEL-57740).
my $rc = _verify_session_outcome($captured);
_note( 'restorepkg exited before the account restore finished, and the restore then finished without errors', { user => _newuser(@argv) // '', session_id => $session_end->{session_id}, restorepkg_exit => $exit_code } ) if !$rc && $exit_code;
return $rc || ( $privileges_failed ? 1 : 0 );
}
=head2 _wait_for_session( $captured_stdout, $exit_code, $user )
CPANEL-57740. C starts the transfer session in a forked MASTER process
and then Cs C, which dies when the MASTER has not created the
session log yet. C then exits 2 while the session goes on restoring
the account (core case CPANEL-57742). Grading at that point graded a restore that
had not finished, and the agent then deleted the directory holding the archive
the session was still reading.
So when C announced a session, this waits for it to finish
(C) whatever the exit code, and
returns C<< { state, waited, session_id } >>. It returns C when no session
was announced; the exit code then decides, as before. After a clean C
the session has already finished and this returns at once.
=cut
sub _wait_for_session ( $captured, $exit_code, $user ) {
my $sessionid = eval {
require Whostmgr::CometBackup::TransferSessionVerdict;
Whostmgr::CometBackup::TransferSessionVerdict::session_id_from_output($captured);
};
return undef if !defined $sessionid || !length $sessionid;
my $waited_for_it = 0;
my $end = Whostmgr::CometBackup::TransferSessionVerdict::wait_for_session_end(
$sessionid,
sessions_dir => $SESSIONS_DIR,
on_wait => sub ($id) {
$waited_for_it = 1;
_note( 'restorepkg exited before the account restore finished. Waiting for the restore to finish.', { user => $user // '', session_id => $id, restorepkg_exit => $exit_code } );
},
);
$end->{session_id} = $sessionid;
_note( 'Stopped waiting for the account restore', { user => $user // '', session_id => $sessionid, state => $end->{state}, waited_seconds => $end->{waited} } ) if $waited_for_it;
return $end;
}
=head2 _restore_owner_db_privileges( $session_end, @argv )
CPANEL-58273. Core's C module, run over an account that already exists,
leaves the account's main database user with privileges at C only (see
L). When C<--disable=> left C
enabled and the session finished, this gives them back for every MySQL access host.
Returns 1 when that failed, else 0. It only adds grants, so it runs whatever the
session's verdict was.
=cut
sub _restore_owner_db_privileges ( $session_end, @argv ) {
my $user = _newuser(@argv);
return 0 if !defined $user || !length $user;
return 0 if !$session_end || ( $session_end->{state} // '' ) ne 'complete';
return 0 if _mysql_module_disabled(@argv);
my $report = eval {
require Whostmgr::CometBackup::OwnerDbPrivileges;
Whostmgr::CometBackup::OwnerDbPrivileges::restore_for($user);
};
my $err = $@;
my $status = ref $report eq 'HASH' ? $report->{status} // '' : '';
return 0 if $status eq 'skipped';
if ( $status eq 'restored' ) {
_note( "Restored the privileges of the account's main database user for every MySQL access host", { user => $user, granted => $report->{granted} // 0 } );
return 0;
}
$err = ref $report eq 'HASH' && defined $report->{error} ? $report->{error} : ( length $err ? $err : 'unknown error' );
chomp $err;
_note( "Could not restore the privileges of the account's main database user for every MySQL access host", { user => $user, error => $err } );
return 1;
}
# Whether a --disable= list names core's Mysql restore module.
sub _mysql_module_disabled (@argv) {
for my $arg (@argv) {
next if $arg !~ m{\A--disable=(.*)\z}s;
return 1 if grep { $_ eq 'Mysql' } split m{,}, $1;
}
return 0;
}
# The diagnostic for a session that did not finish, or undef when its verdict can
# be read (it finished, or there is no such session, which the verdict reports).
sub _session_end_problem ($end) {
my $state = $end->{state} // '';
my $id = $end->{session_id};
return undef if $state eq 'complete' || $state eq 'no_session_dir';
return "transfer session $id did not start. The restore failed." if $state eq 'not_started';
return "transfer session $id stopped before it finished. The restore failed." if $state eq 'master_gone';
my $minutes = int( ( ( $end->{waited} // 0 ) + 59 ) / 60 );
return "transfer session $id did not finish after $minutes minute(s) of waiting. The restore is marked as failed because its result could not be verified.";
}
# Step 1. Nothing has been forked and nothing has been mutated at this point,
# which is the property that matters: a corrupted archive never reaches
# restorepkg, so it can never half-restore an account.
sub _refuse_bad_archive ( $head, $skipped = 0 ) {
if ( !defined $head || !length $head ) {
_diag('the backup data was empty. restorepkg was not run and nothing was restored.');
return 1;
}
my $captured = $head . _drain( \*STDIN, $MAX_CAPTURED_GARBAGE_BYTES - length $head );
my $hex = join( ' ', map { sprintf( '0x%02x', ord ) } split( //, $head ) );
_diag('the backup data is not a valid archive. restorepkg was not run and nothing was restored.');
_diag( $skipped ? sprintf( 'After %d blank byte(s), the next %d byte(s) were %s, expected 0x1f 0x8b.', $skipped, length $head, $hex ) : sprintf( 'First %d byte(s) were %s, expected 0x1f 0x8b.', length $head, $hex ) );
_diag('The error text found in the backup data is shown below:');
_diag_block($captured);
return 1;
}
# Step 2. Forks restorepkg with its STDIN on a pipe we own and its STDOUT on a
# regular temp file, then delivers the archive (head bytes first). STDERR is
# inherited so restorepkg's error rendering stays in the Comet job log.
#
# Manual fork + exec rather than open('|-'): open cannot redirect the child's
# STDOUT, and capturing STDOUT is how the session id is learned (step 4). A
# regular file for STDOUT is deadlock-free regardless of ordering — the child can
# write as much as it likes before it drains our pipe, because a file never
# blocks — so no second reader process and no select loop are needed.
#
# $collector, when defined, is handed every byte delivered (CPANEL-57650).
#
# Returns { out_fh, status, pump } or undef if the fork/pipe/tempfile failed.
sub _stream_to_restorepkg ( $head, $collector, @argv ) {
require POSIX;
require File::Temp;
my $out_fh = eval { File::Temp->new( TEMPLATE => 'comet-restorepkg-guard-out-XXXXXX', TMPDIR => 1 ) };
if ( !$out_fh ) {
my $err = $@ || $!;
_diag("could not create a capture file for restorepkg output: $err");
return;
}
binmode $out_fh;
my ( $child_in, $parent_out );
if ( !pipe( $child_in, $parent_out ) ) {
_diag("could not create a pipe to restorepkg: $!");
return;
}
my $pid = fork();
if ( !defined $pid ) {
_diag("could not fork to run $RESTOREPKG_BIN: $!");
return;
}
if ( !$pid ) {
_restorepkg_child( $child_in, $parent_out, $out_fh, @argv );
# _restorepkg_child never returns; this is only reached if exec somehow
# fell through without _exit.
POSIX::_exit(127);
}
close $child_in; # the parent never reads; keep only the write end
binmode $parent_out;
_tap( $collector, $head );
my $pump = _write_all( $parent_out, $head ) ? _pump( \*STDIN, $parent_out, $collector ) : 'write_error';
close $parent_out;
waitpid( $pid, 0 );
my $status = $?;
return { out_fh => $out_fh, status => $status, pump => $pump };
}
# The forked child: wire STDIN/STDOUT/STDERR and exec restorepkg. Runs POSIX
# _exit on any failure so a child that could not exec never returns into the
# guard's (or a test's) control flow and never runs the parent's END/DESTROY.
sub _restorepkg_child ( $child_in, $parent_out, $out_fh, @argv ) {
# restorepkg should run with default signal disposition; run() ignores
# SIGPIPE for its own writes and SIG_IGN survives exec. local is fine even
# though we are about to exec: the restore never runs (exec replaces the
# image), so SIG_DFL is what is in force at exec time.
local $SIG{'PIPE'} = 'DEFAULT';
close $parent_out;
# dup2 on the RAW filenos, not `open( STDOUT, '>&', ... )`: the Perl-layer
# dup goes through PerlIO, and STDOUT can be tied or re-layered by a test
# harness (Test2) or by whatever invoked us, so the redirect silently fails
# to reach the exec'd child's fd 1 and its output leaks to our own STDOUT.
# dup2 sets the OS descriptor directly and is immune to that. dup2 returns
# the NEW fd (0 for STDIN), which is false in Perl, so check definedness.
defined( POSIX::dup2( fileno($child_in), 0 ) ) or POSIX::_exit(127);
defined( POSIX::dup2( fileno($out_fh), 1 ) ) or POSIX::_exit(127);
close $child_in;
close $out_fh;
# The _exit is a deliberate safety net: exec never returns on success, so it
# only runs if exec fails.
exec {$RESTOREPKG_BIN} $RESTOREPKG_BIN, @argv or POSIX::_exit(127);
}
# Reads the captured STDOUT back from the start of the temp file.
sub _read_captured_stdout ($out_fh) {
seek( $out_fh, 0, 0 ) or return '';
binmode $out_fh;
local $/;
my $bytes = readline $out_fh;
return defined $bytes ? $bytes : '';
}
=head2 _verify_session_outcome( $captured_stdout )
Steps 3 (already done) and 4/5: ask the announced session what really happened.
B's; the
DIAGNOSTICS are this script's> (CPANEL-57056). Both halves matter. The rules --
which line the session id comes from, that a C fails the job, that a
missing session and an unreadable C both FAIL CLOSED -- are shared
with the plugin's LOCAL C replays and must not drift from them. The
wording below is what an operator reads out of a Comet job log and is unchanged
from the day this guard shipped.
A module that cannot be LOADED fails closed too, and says so distinctly: the
verdict was not obtained, which is a different fact from a session that was
unreadable.
=cut
sub _verify_session_outcome ($captured) {
my $verdict = eval {
require Whostmgr::CometBackup::TransferSessionVerdict;
Whostmgr::CometBackup::TransferSessionVerdict::session_verdict( $captured, sessions_dir => $SESSIONS_DIR );
};
if ( ref $verdict ne 'HASH' ) {
my $err = $@ || 'the verdict module returned nothing';
chomp $err;
_diag("could not check the restore result: $err");
_diag('The restore is marked as failed because its result could not be verified.');
return 1;
}
return 0 if $verdict->{'ok'};
my $sessionid = $verdict->{'session_id'};
if ( ( $verdict->{'reason'} // '' ) eq 'no_session' ) {
_diag('restorepkg reported no transfer session, so nothing was restored.');
_diag('The restore is marked as failed because its result could not be verified.');
return 1;
}
if ( ( $verdict->{'reason'} // '' ) eq 'session_unreadable' ) {
my $err = $verdict->{'error'} // 'unknown error';
chomp $err;
_diag("could not read transfer session $sessionid to confirm the restore: $err");
_diag('The restore is marked as failed because its result could not be verified.');
return 1;
}
my $failures = $verdict->{'failed_items'} // [];
_diag( "transfer session $sessionid recorded " . scalar(@$failures) . ' failed item(s). The restore failed.' );
_diag_block( join( "\n", @$failures ) );
return 1;
}
# Skips up to $MAX_LEADING_WHITESPACE_BYTES leading \n, \r, space and tab bytes,
# then reads the next two bytes. Returns ( $skipped_count, $head ); $head is undef
# on a read error and shorter than two bytes at EOF. Past the cap a whitespace byte
# is kept, so the head check refuses it. The skipped bytes never reach restorepkg
# (or the key collector): both see the archive from its gzip magic on.
sub _read_head ($fh) {
my $skipped = 0;
my $byte;
while (1) {
$byte = _read_exactly( $fh, 1 );
return ( $skipped, $byte ) if !defined $byte || !length $byte;
last if $byte !~ m{\A[\x09\x0a\x0d\x20]\z} || $skipped >= $MAX_LEADING_WHITESPACE_BYTES;
$skipped++;
}
my $rest = _read_exactly( $fh, length($GZIP_MAGIC) - 1 );
return ( $skipped, defined $rest ? $byte . $rest : undef );
}
sub _read_exactly ( $fh, $want ) {
my $buf = '';
while ( length($buf) < $want ) {
my $got = sysread( $fh, my $chunk, $want - length($buf) );
return undef if !defined $got;
last if $got == 0;
$buf .= $chunk;
}
return $buf;
}
# Reads up to $limit further bytes, for the refusal diagnostic only. It stops as
# soon as it has enough rather than draining to EOF: nothing downstream is going
# to consume this archive, so the agent getting EPIPE on the rest of it is the
# desired fast failure. (The BACKUP-side guard drains fully instead, because
# there it is a live pkgacct child that must be allowed to finish writing.)
sub _drain ( $fh, $limit ) {
my $captured = '';
while ( length($captured) < $limit ) {
my $got = sysread( $fh, my $chunk, $READ_CHUNK_BYTES );
last if !defined $got || $got == 0;
$captured .= substr( $chunk, 0, $limit - length $captured );
}
return $captured;
}
sub _pump ( $in_fh, $out_fh, $collector = undef ) {
while (1) {
my $got = sysread( $in_fh, my $chunk, $READ_CHUNK_BYTES );
return 'read_error' if !defined $got;
last if $got == 0;
return 'write_error' if !_write_all( $out_fh, $chunk );
_tap( $collector, $chunk );
}
return 'ok';
}
sub _write_all ( $fh, $data ) {
my $len = length $data;
my $written = 0;
while ( $written < $len ) {
my $wrote = syswrite( $fh, $data, $len - $written, $written );
return 0 if !defined $wrote;
$written += $wrote;
}
return 1;
}
# CPANEL-57650: the key collector for the --newuser account, or undef when there is no
# usable account name or the module cannot be loaded (then nothing is kept, and the
# restore that reads the keys finds none and says so).
sub _key_collector (@argv) {
my $user = _newuser(@argv);
return undef if !defined $user;
local $@;
my $collector = eval {
require Whostmgr::CometBackup::LegacyArchiveDomainKeys;
return undef if !defined Whostmgr::CometBackup::LegacyArchiveDomainKeys::capture_path($user);
Whostmgr::CometBackup::LegacyArchiveDomainKeys::discard_capture($user);
Whostmgr::CometBackup::LegacyArchiveDomainKeys::Collector->new();
};
return $collector ? { user => $user, collector => $collector } : undef;
}
# The --newuser account of restorepkg's argv, or undef.
# CPANEL-57714: on an account that was already suspended, the Suspend module stays
# disabled (ProtectedItemRestore::_restore_suspension_for) while core's Shell, Password, Ftp,
# DigestShadow and Cron modules write the restored logins unlocked.
# Whostmgr::CometBackup::SuspendedAccountLogins locks each one the way
# scripts/suspendacct does; it does nothing for an account that is not suspended or
# that this run's Suspend module suspended. Returns 1 when a login could not be locked:
# the suspended account is then open, and the restore fails rather than report success.
sub _relock_suspended_logins ($user) {
return 0 unless defined $user && length $user;
my $report = eval {
require Whostmgr::CometBackup::SuspendedAccountLogins;
Whostmgr::CometBackup::SuspendedAccountLogins::relock_if_suspended($user);
};
# CPANEL-57716: the check could not run at all (the lock module did not load), or
# could not tell whether the account is suspended. That is not "a suspended account
# left unlocked", and an account that is not suspended has nothing to lock: say what
# happened, and fail the restore only when core's suspension flag says it IS
# suspended (its restored logins are then open).
if ( ref $report ne 'HASH' || ( !$report->{suspended} && defined Whostmgr::CometBackup::SuspendedAccountLogins::failure_summary($report) ) ) {
my $err = ref $report eq 'HASH' ? Whostmgr::CometBackup::SuspendedAccountLogins::failure_summary($report) : ( $@ || 'unknown error' );
chomp $err;
my $suspended = _suspension_flagged($user);
_note( 'Could not check whether the restored logins of the account need locking', { user => $user, error => $err, suspended => ( $suspended ? 'yes' : 'no' ) } );
return $suspended ? 1 : 0;
}
if ( defined( my $failed = Whostmgr::CometBackup::SuspendedAccountLogins::failure_summary($report) ) ) {
chomp $failed;
_note( 'Could not lock the restored logins of a suspended account', { user => $user, failed => $failed } );
return 1;
}
_note( 'Locked the restored logins of a suspended account', { user => $user, locked => join( ',', @{ $report->{locked} } ) } ) if @{ $report->{locked} };
return 0;
}
# CPANEL-57716: whether core's suspension flag exists for $user -- the file
# Cpanel::AcctUtils::Suspended::is_suspended reads.
sub _suspension_flagged ($user) {
return 0 if $user =~ m{/} || $user eq '.' || $user eq '..';
return -e "$SUSPENDED_DIR/$user" ? 1 : 0;
}
sub _newuser (@argv) {
my $user;
for my $i ( 0 .. $#argv - 1 ) {
$user = $argv[ $i + 1 ] if $argv[$i] eq '--newuser';
}
return $user;
}
sub _tap ( $collector, $bytes ) {
return if !$collector;
local $@;
eval { $collector->add($bytes); 1 };
return;
}
sub _save_keys ($keys) {
local $@;
eval { Whostmgr::CometBackup::LegacyArchiveDomainKeys::save_capture( $keys->{user}, $keys->{collector}->result() ); 1 };
return;
}
sub _exit_code_from_status ($status) {
return 0 if !$status;
my $code = $status >> 8;
return $code if $code > 0 && $code < 256;
return 1;
}
# CPANEL-57691: a note for /var/log/comet_backup.log, never STDERR, the same as the
# backup-side guard (where a STDERR line turns the job into a Comet 7001 warning that
# fails it). A clean restore says nothing on STDERR.
# Fail-soft and silent: a log that cannot be written must not change the result.
sub _note ( $message, $context = {} ) {
local $@;
local $SIG{'__WARN__'} = sub { };
eval {
require Whostmgr::CometBackup::Logger;
Whostmgr::CometBackup::Logger->new()->info( $message, $context );
1;
};
return;
}
sub _diag ($message) {
print {*STDERR} "comet_restorepkg_guard: $message\n";
return;
}
sub _diag_block ($bytes) {
my $rendered = $bytes;
$rendered =~ s{([^\x09\x0a\x20-\x7e])}{sprintf( '\\x%02x', ord $1 )}ge;
print {*STDERR} "--- begin captured detail ---\n$rendered\n--- end captured detail ---\n";
return;
}
1;