};
$txt .= qq{
$statusdata...};
$method eq 'print' ? print $txt : return $txt;
}
else {
$method eq 'print' ? print qq{$statusdata...} : return qq{$statusdata...};
}
return '';
}
sub setstatusdone {
Cpanel::LoadModule::load_perl_module('Cpanel::MagicRevision') if !$INC{'Cpanel/MagicRevision.pm'};
return _end_status_block( "Done", Cpanel::MagicRevision::calculate_magic_url( '/cjt/images/icons/success.png', $ENV{'REQUEST_URI'}, '/usr/local/cpanel/whostmgr/docroot' ) );
}
sub setstatuserror {
Cpanel::LoadModule::load_perl_module('Cpanel::MagicRevision') if !$INC{'Cpanel/MagicRevision.pm'};
return _end_status_block( "Failed", Cpanel::MagicRevision::calculate_magic_url( '/cjt/images/icons/error.png', $ENV{'REQUEST_URI'}, '/usr/local/cpanel/whostmgr/docroot' ) );
}
sub _end_status_block {
my ( $msg, $img ) = @_;
local $| = 1;
$status_block_depth--;
if ( !$nohtml && !( -t STDOUT || !defined $ENV{'GATEWAY_INTERFACE'} || $ENV{'GATEWAY_INTERFACE'} !~ /CGI/i ) ) {
my $txt = qq{
...$msg
\n};
$method eq 'print' ? print $txt : return $txt;
}
else {
$method eq 'print' ? print qq{...$msg\n} : return qq{...$msg\n};
}
return '';
}
sub clearstatus {
local $| = 1;
if ( !$nohtml
&& !( -t STDOUT || !defined $ENV{'GATEWAY_INTERFACE'} || $ENV{'GATEWAY_INTERFACE'} !~ /CGI/i ) ) {
if ( $method ne 'hide' ) { print "\n"; }
}
return '';
}
1;
} # --- END Whostmgr/UI.pm
{ # --- BEGIN Cpanel/AcctUtils/Domain.pm
package Cpanel::AcctUtils::Domain;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Config::LoadCpUserFile (); # perlpkg line 211
# use Cpanel::Config::HasCpUserFile (); # perlpkg line 211
sub getdomain {
my ($user) = @_;
return unless Cpanel::Config::HasCpUserFile::has_cpuser_file($user);
return Cpanel::Config::LoadCpUserFile::loadcpuserfile($user)->{'DOMAIN'};
}
1;
} # --- END Cpanel/AcctUtils/Domain.pm
{ # --- BEGIN Cpanel/Config/userdata/Constants.pm
package Cpanel::Config::userdata::Constants;
use strict;
use warnings;
no warnings 'once';
our $USERDATA_DIR = '/var/cpanel/userdata';
1;
} # --- END Cpanel/Config/userdata/Constants.pm
{ # --- BEGIN Cpanel/AcctUtils/Account.pm
package Cpanel::AcctUtils::Account;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::PwCache (); # perlpkg line 211
our $USERS_DIR = '/var/cpanel/users';
sub accountexists {
return 1 if $_[0] && $_[0] eq 'root';
return length( scalar Cpanel::PwCache::getpwnam_noshadow( $_[0] ) ) ? 1 : 0;
}
sub get_existing_account_parts {
my ($user) = @_;
my @existing_parts = ();
push( @existing_parts, "$USERS_DIR/$user" ) if -e "$USERS_DIR/$user";
push( @existing_parts, "system user “$user”" ) if accountexists($user);
require Cpanel::Config::userdata::Constants;
push( @existing_parts, "$Cpanel::Config::userdata::Constants::USERDATA_DIR/$user" ) if -e "$Cpanel::Config::userdata::Constants::USERDATA_DIR/$user";
return \@existing_parts;
}
sub accountexists_or_die {
accountexists( $_[0] ) or do {
require Cpanel::Exception;
die Cpanel::Exception::create( 'UserNotFound', [ name => $_[0] ] );
};
return 1;
}
1;
} # --- END Cpanel/AcctUtils/Account.pm
{ # --- BEGIN Cpanel/AcctUtils/Lookup/Webmail.pm
package Cpanel::AcctUtils::Lookup::Webmail;
use strict;
use warnings;
no warnings 'once';
sub is_webmail_user {
return (
(
defined $_[0] # must have some value
&& length( $_[0] ) > 4 # must be at least 5 characters long (1 localpart, 3 domain, 1 domain separator)
&& 1 == $_[0] =~ tr{+%:@}{} # must have 1 domain separator character
&& 1 == $_[0] =~ tr{a-zA-Z0-9._-}{}c # the domain separator is the only character present that is not allowed in a localpart or domain
&& substr( $_[0], 0, 1 ) !~ tr{+%:@.}{} # first character could be a localpart ( no domain separator or . )
&& substr( $_[0], -3, 2 ) !~ tr{+%:@_}{} # first two of the last three characters could be a domain
&& substr( $_[0], -1, 1 ) !~ tr{+%:@._-}{} # last character could be a tld
) ? 1 : 0
);
}
sub is_strict_webmail_user {
return (
(
defined $_[0] # must have some value
&& length( $_[0] ) > 4 # must be at least 5 characters long (1 localpart, 3 domain, 1 domain separator)
&& 1 == $_[0] =~ tr{@}{} # must contain 1 domain separator character
&& 1 == $_[0] =~ tr{a-z0-9._-}{}c # the domain separator is the only character that is not allowed in a localpart or domain
&& substr( $_[0], 0, 1 ) !~ tr{@.}{} # first character could be a localpart ( no domain separator or . )
&& substr( $_[0], -3, 2 ) !~ tr{@_}{} # first two of the last three characters could be a domain
&& substr( $_[0], -1, 1 ) !~ tr{@._-}{} # last character could be a tld
) ? 1 : 0
);
}
sub normalize_webmail_user {
my ($user) = @_;
$user =~ tr/A-Z+%:/a-z@/;
return ( wantarray() ? split( '@', $user, 2 ) : $user );
}
1;
} # --- END Cpanel/AcctUtils/Lookup/Webmail.pm
{ # --- BEGIN Cpanel/AcctUtils/Lookup.pm
package Cpanel::AcctUtils::Lookup;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::AcctUtils::DomainOwner::Tiny (); # perlpkg line 211
# use Cpanel::AcctUtils::Account (); # perlpkg line 211
# use Cpanel::AcctUtils::Lookup::Webmail (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
sub get_system_user {
my $sysuser = get_system_user_without_existence_validation( $_[0] );
if ( !Cpanel::AcctUtils::Account::accountexists($sysuser) ) {
die Cpanel::Exception::create( 'UserNotFound', [ name => $sysuser ] );
}
return $sysuser;
}
sub get_system_user_without_existence_validation { ##no critic qw(RequireArgUnpacking)
die Cpanel::Exception::create( 'UserNotFound', [ name => '' ] ) unless defined $_[0] && length $_[0];
if ( $_[0] =~ tr{/}{} ) {
die Cpanel::Exception::create( 'InvalidParameter', '“[_1]” is not a valid username because it contains a “[_2]” character.', [ $_[0], '/' ] );
}
return $_[0] if !Cpanel::AcctUtils::Lookup::Webmail::is_strict_webmail_user( $_[0] );
my ($domain) = ( split( m{@}, $_[0], 2 ) )[1];
my $sysuser = Cpanel::AcctUtils::DomainOwner::Tiny::getdomainowner( $domain, { 'skiptruelookup' => 1, 'default' => '' } );
if ( !length $sysuser ) {
die Cpanel::Exception::create( 'DomainDoesNotExist', 'The domain “[_1]” does not exist.', [$domain] );
}
return $sysuser;
}
1;
} # --- END Cpanel/AcctUtils/Lookup.pm
{ # --- BEGIN Cpanel/Sereal/Decoder.pm
package Cpanel::Sereal::Decoder;
use cPstrict;
no warnings 'once';
use Sereal::Decoder ();
my %REQUIRED_OPTIONS = (
refuse_objects => 1,
no_bless_objects => 1,
refuse_snappy => 1,
validate_utf8 => 1,
max_recursion_depth => 100,
);
sub create {
return Sereal::Decoder->new( \%REQUIRED_OPTIONS );
}
1;
} # --- END Cpanel/Sereal/Decoder.pm
{ # --- BEGIN Cpanel/Sereal/Encoder.pm
package Cpanel::Sereal::Encoder;
use cPstrict;
no warnings 'once';
use Sereal::Encoder ();
my %REQUIRED_OPTIONS = (
croak_on_bless => 1,
);
sub create {
return Sereal::Encoder->new( \%REQUIRED_OPTIONS );
}
1;
} # --- END Cpanel/Sereal/Encoder.pm
{ # --- BEGIN Cpanel/JSON/Sanitize.pm
package Cpanel::JSON::Sanitize;
use cPstrict;
no warnings 'once';
sub sanitize_for_dumping {
my $item = shift;
my $reftype = ref $item;
if ( !defined $item || $reftype eq "" ) {
return $item;
}
elsif ( ( $reftype eq 'SCALAR' || $reftype eq 'JSON::XS::Boolean' || $reftype eq 'JSON::PP::Boolean' || $reftype eq 'Types::Serialiser::Boolean' ) && ( $$item eq '1' || $$item eq '0' ) ) {
return $item;
}
elsif ( $reftype eq "ARRAY" ) {
return [ map { sanitize_for_dumping($_) } grep { _suitable_for_dumping($_) } @$item ];
}
elsif ( $reftype eq "HASH" ) {
return {
map { $_ => sanitize_for_dumping( $item->{$_} ) }
grep { _suitable_for_dumping( $item->{$_} ) }
keys %$item
};
}
else {
die "That data structure isn't suitable for dumping.";
}
}
sub filter_to_json ($item) {
my $ref = ref $item;
return $item if !$ref;
if ( 'ARRAY' eq $ref ) {
return [ map { filter_to_json($_) } @$item ];
}
elsif ( 'HASH' eq $ref ) {
my %dupe = map { ( $_ => filter_to_json( $item->{$_} ) ) } keys %$item;
return \%dupe;
}
elsif ( UNIVERSAL::can( $item, 'TO_JSON' ) ) {
return filter_to_json( $item->TO_JSON() );
}
require Carp;
Carp::croak("$item is not JSON-compatible!");
}
sub uxxxx_to_bytes {
my $str_r = \$_[0];
$$str_r =~ s/
(\\+)u( [a-fA-F0-9]{4} )
/
if ( length($1) % 2 ) {
my $c = pack('U', hex $2);
utf8::encode($c);
substr($1, 1) . $c;
}
else {
"$1u$2";
}
/exg;
return $$str_r;
}
sub _suitable_for_dumping {
my $item = shift;
my $reftype = ref $item;
return 1 if !defined $item;
return 1 if $reftype eq "" || $reftype eq 'ARRAY' || $reftype eq 'HASH';
return 1 if ( $reftype eq 'SCALAR' || $reftype eq 'JSON::XS::Boolean' || $reftype eq 'JSON::PP::Boolean' || $reftype eq 'Types::Serialiser::Boolean' ) && ( $$item eq '1' || $$item eq '0' );
return 0;
}
1;
} # --- END Cpanel/JSON/Sanitize.pm
{ # --- BEGIN Cpanel/UntrustedException.pm
package Cpanel::UntrustedException;
use strict;
use warnings;
no warnings 'once';
use overload ( '""' => \&stringify, fallback => 1 );
sub new {
my ( $package, %params ) = @_;
my $self = {
string => $params{string},
class => $params{class},
longmess => $params{longmess},
metadata => $params{metadata},
};
return bless $self, $package;
}
sub class {
my ($self) = @_;
return $self->{class};
}
sub string {
my ($self) = @_;
return $self->{string};
}
sub longmess {
my ($self) = @_;
return $self->{longmess};
}
sub get {
my ( $self, $attr ) = @_;
return $self->{metadata}{$attr};
}
sub stringify {
my ($self) = @_;
if ( $self->{class} ) {
return $self->{class} . '/' . join "\n", $self->{string} || '