π Viewing: //scripts/webapp_cleanup.pl
#!/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::webapp_cleanup;
use cPstrict;
use Cpanel ();
use Cpanel::AccessIds ();
use Cpanel::Config::Users ();
use Cpanel::PwCache ();
use Cpanel::WebApps::Cleanup ();
our $VERSION = '1.0';
=head1 NAME
webapp_cleanup.pl - age off the working files web applications leave under C<~/.cpanel/>
=head1 SYNOPSIS
/usr/local/cpanel/scripts/webapp_cleanup.pl [--run] [--days=N] [--user=NAME]
=head1 DESCRIPTION
The administrator's entry point to L<Cpanel::WebApps::Cleanup>: staging
directories for applications that were staged and never deployed, C<.incoming>
and C<.rollback> temporaries left by an interrupted intake, and the per-deploy
and per-build logs. Nothing else reclaims any of them.
B<Lists only unless given C<--run>>, matching C<ea-podman clean>, which covers
the other half of the same job β C<~/ea-podman.d/E<lt>containerE<gt>.bak>. The
two are disjoint: that one can destroy the only copy of an application's runtime
state, and nothing here can. Everything this removes is a record of a past run,
or a copy of source the user still has.
Runs on demand only. Scheduling it is deliberately not this script's business.
=head1 WHY IT ITERATES EVERY ACCOUNT
Not the accounts with applications in their registry. A staging directory
survives precisely when a deploy did I<not> happen, and a registry can be empty
while the leftovers are not β so a registry-driven sweep would skip the accounts
most likely to have something to reclaim, and skip them silently.
=cut
use constant _USAGE => <<'END_USAGE';
Usage: webapp_cleanup.pl [--run] [--days=N] [--user=NAME]
Reclaim the working files that a web application leaves under the `~/.cpanel/` directory: staging
directories that the application never deployed, interrupted-intake temporaries, and
per-deploy and per-build logs.
--run Remove the files. Without this option, the script only lists what it would
remove and does not change anything.
--days=N Consider artifacts older than N days. Default 30, matching
`ea-podman clean`. `--days=0` considers all of them.
--user=NAME Clean a single account instead of all accounts on the server.
--help This text.
Run as root. The script cleans each account in a separate privilege-dropped process, so one
account's unreadable registry or undeletable file cannot affect another's.
The script always keeps the most recent deployment's logs, regardless of age, so you can inspect the last
result. The script skips any applications with a deployment in progress, as well as any accounts whose registries are in use.
Exits non-zero if it could not clean any account or if it could not remove any data marked for removal.
END_USAGE
# Skip reasons that mean the sweep could not establish or finish something, as
# opposed to deciding not to act. These set the exit code; every other reason
# does not.
#
# registry_unreadable belongs here because Registry::load() reads a MISSING
# registry as an empty one and dies only on a file that exists and is corrupt or
# unreadable -- so this cannot misfire on an ordinary account that has never used
# web applications, and when it does fire nothing at all was established for that
# account.
#
# symlinked_root belongs here too: a cleanup root that is a symbolic link is
# refused rather than followed, so nothing under it was swept.
#
# registry_busy is deliberately NOT here. On a server-wide sweep one user part
# way through a stage() must not turn the whole run red; that is contention, and
# the next run gets it.
use constant _FAILURE_REASONS => qw(remove_failed registry_unreadable unreadable symlinked_root);
=head1 SUBROUTINES
=head2 run(@argv)
Parse C<@argv>, sweep, and return the process exit code.
=cut
sub run (@argv) {
my ( $act, $days, $only_user ) = ( 0, undef, undef );
for my $arg (@argv) {
if ( $arg eq '--help' || $arg eq '-h' ) { print _USAGE; return 0 }
elsif ( $arg eq '--run' ) { $act = 1 }
elsif ( $arg =~ m/\A--days=([0-9]+)\z/ ) { $days = $1 }
elsif ( $arg =~ m/\A--user=(.+)\z/ ) { $only_user = $1 }
else {
print STDERR "Unknown argument β$argβ.\n\n" . _USAGE;
return 2;
}
}
if ( $> != 0 ) {
print STDERR "webapp_cleanup.pl reads and removes files in other accounts' home directories, so you must run it as the root user.\n";
return 2;
}
# An allowlist, not a pattern: the set of real accounts is the only
# definition of a valid --user, and anything outside it fails closed rather
# than being reshaped into something that looks safe.
my @accounts = sort( Cpanel::Config::Users::getcpusers() );
if ( length( $only_user // '' ) ) {
if ( !grep { $_ eq $only_user } @accounts ) {
print STDERR "There is no cPanel account named β$only_userβ on this server.\n";
return 2;
}
@accounts = ($only_user);
}
my %age = defined $days ? ( max_age => $days * 24 * 60 * 60 ) : ();
# Said before the listing rather than only under --run, because --run is the
# only safeguard and the operator is deciding while they read this.
say "Note: A staging directory that an application did not deploy contains a copy of the user's source data. The logs are the record of past deployments.";
say "Considering artifacts older than " . ( defined $days ? _plural( $days, 'day' ) : '30 days' ) . '.';
say $act ? "Removing.\n" : "Listing only. Pass `--run` to remove.\n";
my ( $count, $unreachable, $failed ) = ( 0, 0, 0 );
for my $user (@accounts) {
my $report = _sweep_as( $user, $act, %age );
if ( !$report ) {
say "$user: UNKNOWN: The script could not clean the account or establish anything about it.";
$unreachable++;
next;
}
for my $removed ( @{ $report->{removed} } ) {
say sprintf(
'%s: %s (%s, %s)%s',
$user, $removed->{path}, $removed->{kind},
_plural( int( $removed->{age} / 86400 ), 'day' ) . ' old',
$act ? ' β REMOVED' : ''
);
$count++;
}
for my $skipped ( @{ $report->{skipped} } ) {
# too_recent, most_recent and registered are the sweep working as
# intended on every run; printing them would bury the ones that mean
# an operator has something to look at.
next if grep { $skipped->{reason} eq $_ } qw(too_recent most_recent registered);
say "$user: $skipped->{path} β kept ($skipped->{reason}).";
$failed++ if grep { $skipped->{reason} eq $_ } _FAILURE_REASONS;
}
}
say '';
if ( !$count ) {
say 'Nothing to clean up.';
}
else {
say _plural( $count, 'artifact' ) . ( $act ? ' removed.' : ' could be removed.' );
}
say "Could not clean $unreachable account(s)." if $unreachable;
return ( $unreachable || $failed ) ? 1 : 0;
}
# The sweep, as the account, with its report carried back across the fork.
#
# RETURNED, never collected into a lexical out here. do_as_user_with_exception()
# runs the closure in a FORKED child (Cpanel::ForkSync), so anything pushed to an
# enclosing lexical dies with the child and this process reports nothing for an
# account it has just swept. ForkSync serialises the return value back, which is
# the way across. ea-podman's `clean` shipped the other way round first and
# printed "Nothing to clean up" for every account it had cleaned.
#
# undef means "we do not know", never "there was nothing": a corrupt registry
# dies on purpose, and reporting that as a clean account would be a lie the
# operator cannot see through.
sub _sweep_as ( $user, $act, %age ) {
my $report = eval {
Cpanel::AccessIds::do_as_user_with_exception(
$user,
sub {
# Set rather than left to the fallback in Registry::path() and
# Source::_homedir(). Those read $Cpanel::homedir first and only
# then ask PwCache; this process is root, so leaving it unset
# works today by accident of it being empty. Naming it makes the
# account this is running for explicit and local to the child.
local $Cpanel::user = $user;
local $Cpanel::homedir = Cpanel::PwCache::gethomedir($user);
return Cpanel::WebApps::Cleanup::sweep( run => $act, %age );
}
);
};
if ( !$report || ref $report ne 'HASH' ) {
warn "webapp_cleanup: could not sweep β$userβ: " . ( $@ || "the account returned nothing\n" );
return undef;
}
return $report;
}
sub _plural ( $count, $noun ) {
return "$count $noun" . ( $count == 1 ? '' : 's' );
}
exit( run(@ARGV) // 0 ) unless caller;
1;
β Back to directory