| Server IP : 157.90.209.209 / Your IP : 216.73.216.129 [ Web Server : Apache System : Linux hcomm124.dns-wk.info 4.18.0-553.64.1.el8_10.x86_64 #1 SMP Mon Jul 28 12:01:56 EDT 2025 x86_64 User : evidenciarevista ( 1049) PHP Version : 7.2.34 Disable Function : exec,passthru,shell_exec,system Domains : 216 Domains MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /etc/ |
Upload File : |
=encoding utf-8
=head1 NAME
/etc/exim.pl.local - Perl functions for exim that are loaded by /etc/exim.pl
=cut
my $VALIASES_DIR = '/etc/valiases';
my $VDOMAINALIASES_DIR = '/etc/vdomainaliases';
my $outgoing_mail_suspended_message;
my $outgoing_sender;
my $outgoing_sender_domain;
my $outgoing_sender_counted_domain;
my $outgoing_sender_sysuser;
my $outgoing_sender_is_mailman;
my $outgoing_sender_archive_directory = 'outgoing';
my $mail_gid;
my $nobody_uid;
my $nobody_gid;
my $mailtrap_gid;
my $check_mail_permissions_domain = '';
my $check_mail_permissions_sender = '';
my $check_mail_permissions_msgid = '';
my $check_mail_permissions_data = '';
my $check_mail_permissions_is_mailman = 0;
my $enforce_mail_permissions_data = '';
my $primary_hostname;
my %uid_cache = ( 0 => 'root', 47 => 'mailnull', 99 => 'nobody' );
my %user_cache = ( 'root' => 0, 'mailnull' => 47, 'nobody' => 99 );
my $reattempt_message = 'Message will be reattempted later';
my $sender_lookup;
my $sender_lookup_method;
# TEST VARIABLES
my $check_mail_permissions_result;
my %file_exists_cache;
sub file_exists {
return $file_exists_cache{ $_[0] } if exists $file_exists_cache{ $_[0] };
$file_exists_cache{ $_[0] } = -e $_[0] ? 1 : 0;
return $file_exists_cache{ $_[0] };
}
sub checkbx_autowhitelist {
my $address = shift;
my $phost = Exim::expand_string('$primary_hostname');
my $rp = Exim::expand_string('$received_protocol');
if ( $rp eq 'local' || $rp !~ /^e?smtps?a$/i || !$address || $address eq '' ) { return 'no'; }
my ( $localpart, $domain ) = split( /\@/, $address );
if ( ( !$domain || $domain eq '' || $domain eq $phost ) ) {
my $homedir = gethomedir($localpart);
unless ( $homedir ne '' ) {
return 'no';
}
if ( -e $homedir . '/etc/.boxtrapperenable' && !-e $homedir . '/etc/.boxtrapperautowhitelistdisable' ) {
return 'yes';
}
else {
return 'no';
}
}
else {
my $owner = getdomainowner($domain);
my $homedir = gethomedir($owner);
unless ( $homedir ne '' ) {
return 'no';
}
my $passwd = "${homedir}/etc/${domain}/passwd";
my $addressexists = user_exists_in_db( $localpart, $passwd );
if ( $addressexists && ( -e $homedir . "/etc/${domain}/${localpart}/.boxtrapperenable" && !-e $homedir . "/etc/${domain}/${localpart}/.boxtrapperautowhitelistdisable" ) ) {
return 'yes';
}
else {
return 'no';
}
}
}
sub getemailuser {
my ( $address, $received_protocol, $sender_ident ) = @_;
my $primary_hostname = Exim::expand_string('$primary_hostname');
my ( $local_part, $domain ) = split( m/[\@\+\%\:]/, ( $address || ( $received_protocol && $received_protocol eq 'local' ? $sender_ident : '' ) ) );
if ( !$domain || $domain eq '' || $domain eq $primary_hostname ) {
return $local_part;
}
else {
my $user = getdomainowner($domain);
if ($user) { return $user; }
}
return 'nobody';
}
#DO NOT REMOVE THIS COMMENT AS IT TELLS CPANEL TO ENABLE SERVICE AUTH CHECKING
#exim:serviceauth=1
#
# Checkpass not used since auth is passed to dovecot SASL
{
no warnings 'redefine';
sub checkuserpass { 0; }
sub checkpass { 0; }
}
sub checkspam {
# This is an old code block that should never be reached unless there is a serious
# problem installing their exim configuration
Exim::log_write("Something went very wrong during the exim configuration update. Please try reinstalling your exim configuration.");
1;
}
sub convert_address_directory_to_dovecot_lda_destination_username {
my $local_part = Exim::expand_string('$local_part');
my $domain = Exim::expand_string('$domain');
$primary_hostname ||= Exim::expand_string('$primary_hostname');
my $address_file = Exim::expand_string('$address_file');
if ( $address_file !~ m{mail/\Q$domain\E} ) {
return ( getpwuid($>) )[0];
}
else {
return $local_part . '@' . $domain;
}
}
sub convert_address_directory_to_dovecot_lda_mailbox {
my $address_file = Exim::expand_string('$address_file');
my ($mailbox) = $address_file =~ m{/\.([^\/]+)};
if ($mailbox) {
return "INBOX.$mailbox";
}
return 'INBOX';
}
sub call_cpwrap {
my ( $function, @ARGS ) = @_;
my @JSON_ENCODED_ARGS = map { aggressive_json_safe_encode($_) } @ARGS;
my $data = join( ' ', @JSON_ENCODED_ARGS );
my $json_template = qq[{"function":"$function","namespace":"Cpanel","version":2,"action":"run","data":"$data","send_data_only":1,"module":"exim"}\r\n\r\n];
require Cpanel::Encoder::Exim;
return eval { Exim::expand_string( '${readsocket{/usr/local/cpanel/var/cpwrapd.sock}{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($json_template) . '}{10s}}' ); };
}
sub aggressive_json_safe_encode {
my ($arg) = @_;
$arg =~ tr/^a-zA-Z0-9!#\$\-=?^_{}~:.//cd;
return $arg;
}
my $archived_at_domain_level = 0;
my $archived_outgoing = 0;
my $archived_mailman = 0;
sub should_archive_incoming_domain_message {
return ( $archived_at_domain_level = !_message_has_been_seen() );
}
sub _message_has_been_seen {
#ARCHIVE ONLY IF
#
#$parent_domain = ""
#
#OR
#
#$parent_domain != $domain
# Delivery was not a result of an expansion
my $parent_domain = Exim::expand_string('$parent_domain');
if ( !length $parent_domain ) {
return 0;
}
# Delivery was the result of an expansion / alias. Since its a diffrent domain we don't
# know if it was archived so we need to archive if enabled
my $domain = Exim::expand_string('$domain');
if ( $domain ne $parent_domain ) {
return 0;
}
my $parent_local_part = Exim::expand_string('$parent_local_part');
my $local_part = Exim::expand_string('$local_part');
# case 60975: If any deliveries happened, parent_domain and parent_local_part
# will get set to match domain and local_part. Since we need to
# still archive outgoing if it to our same domain or a local
# user we need to accept when they all match
if ( $parent_domain eq $domain && $local_part && $parent_local_part ) {
return 0;
}
# parent_local_part ne local_part and
# parent_domain == domain so it already got archived if we have it on
return 1;
}
sub archive_headers {
my ($router) = @_;
if ( $router eq 'archive_incoming_email_domain_method' ) {
return "X-Archive-Type: incoming\nX-Archive-Recipient: " . Exim::expand_string('$local_part') . '@' . Exim::expand_string('$domain');
}
elsif ( $router eq 'archive_incoming_email_local_user_method' ) {
return "X-Archive-Type: incoming\nX-Archive-Recipient: " . Exim::expand_string('$local_part');
}
elsif ( $router eq 'archive_outgoing_email' ) {
return "X-Archive-Type: " . $outgoing_sender_archive_directory . "\nX-Archive-Sender: $outgoing_sender";
}
}
sub should_archive_incoming_localuser_message {
# case 60999: Do not archive a message at the localuser level
# if we have already archived it at the domain level (avoid two copies)
return 0 if $archived_at_domain_level;
my $local_part = Exim::expand_string('$local_part');
my $incoming_domain = getusersdomain($local_part);
if ($incoming_domain) {
my $home = gethomedir($local_part);
if ( file_exists("$home/etc/$incoming_domain/archive/incoming") ) {
return 1;
}
}
return 0;
}
sub get_incoming_domain {
return getusersdomain( Exim::expand_string('$local_part') );
}
sub should_archive_outgoing_message {
return 0 if _message_has_been_seen();
return determine_sender_and_check_if_archive_needed();
}
sub determine_sender_and_check_if_archive_needed {
my $uid = int( Exim::expand_string('$originator_uid') );
my $gid = int( Exim::expand_string('$originator_gid') );
# outgoing_sender_domain is the domain of the actual sender
# outgoing_sender_counted_domain is the domain we actually count the message against
# Currently these are always the same except domain may be
# rewritten if we are coming from a mailman list in order
# to count against the owner of the list instead of the mailman
# user assuming /var/cpanel/email_send_limits/count_mailman exists
( $outgoing_sender, $outgoing_sender_domain, $outgoing_sender_counted_domain, $outgoing_sender_is_mailman ) = get_message_sender( $uid, $gid );
if ( $outgoing_sender_domain && $outgoing_sender_domain ne '-system-' ) {
$outgoing_sender_sysuser = getdomainowner($outgoing_sender_domain);
my $home = gethomedir($outgoing_sender_sysuser);
if ( $outgoing_sender_is_mailman && file_exists("$home/etc/$outgoing_sender_domain/archive/mailman") ) {
$outgoing_sender_archive_directory = 'mailman';
return 0 if $archived_mailman; # already archived
return ( $archived_mailman = 1 );
}
elsif ( file_exists("$home/etc/$outgoing_sender_domain/archive/outgoing") ) {
$outgoing_sender_archive_directory = 'outgoing';
return 0 if $archived_outgoing; # already archived
return ( $archived_outgoing = 1 );
}
}
return 0;
}
sub pack_archive_address_data {
my ($router) = @_;
return join( ' ',
'router=' . Cpanel::Encoder::Exim::encode_string_literal($router),
'sender=' . Cpanel::Encoder::Exim::encode_string_literal($outgoing_sender),
'sender_domain=' . Cpanel::Encoder::Exim::encode_string_literal($outgoing_sender_domain),
'sender_sysuser=' . Cpanel::Encoder::Exim::encode_string_literal($outgoing_sender_sysuser),
'sender_archive_directory=' . Cpanel::Encoder::Exim::encode_string_literal($outgoing_sender_archive_directory)
);
}
sub get_outgoing_sender {
return ( $outgoing_sender // Exim::expand_string('${extract{sender}{$address_data}}'));
}
sub get_outgoing_sender_domain {
return ( $outgoing_sender_domain // Exim::expand_string('${extract{sender_domain}{$address_data}}'));
}
sub get_outgoing_sender_sysuser {
return ( $outgoing_sender_sysuser // Exim::expand_string('${extract{sender_sysuser}{$address_data}}'));
}
sub get_outgoing_archive_directory {
return ( $outgoing_sender_archive_directory // Exim::expand_string('${extract{sender_archive_directory}{$address_data}}'));
}
sub YYYYMMDDGMT {
my ( $sec, $min, $hour, $mday, $mon, $year ) = gmtime( $_[0] || time() );
return sprintf( '%04d-%02d-%02d', $year + 1900, $mon + 1, $mday );
}
our $DEFAULT_EMAIL_SEND_LIMITS_DEFER_CUTOFF_PERCENTAGE = 125;
sub getmaxemailsperhour {
my $domain = shift;
return 0 if $domain eq '-system-';
$domain =~ s/\///g; #jic
my $maxemails = 0; # Defaults to "unlimited"
my $master_email_send_limits_mtime = ( stat('/etc/email_send_limits') )[9];
my $max_fh;
if ( open( $max_fh, '<', '/var/cpanel/email_send_limits/cache/' . $domain ) && ( stat($max_fh) )[9] > $master_email_send_limits_mtime ) { # This is the user's main domain. All user's domains are aggregated here
$maxemails = readline $max_fh;
close $max_fh;
return 0 if !$maxemails || $maxemails eq 'unlimited';
return ( $maxemails ? int($maxemails) : 0 );
}
my $search_regex = qr/^\Q$domain\E:/;
my $search_wildcard_regex = qr/^\Q*\E:/;
_check_cache_dir();
my $old_umask = umask();
umask(0027);
#format DOMAIN: MAX_EMAIL_PER_HOUR,MAX_DEFER_FAIL_PERCENTAGE,MIN_DEFER_FAIL_TO_TRIGGER_PROTECTION
if ( open( my $max_fh, '>', '/var/cpanel/email_send_limits/cache/.' . $domain ) ) {
umask($old_umask);
if ( open( my $email_limits_fh, '<', '/etc/email_send_limits' ) ) {
while ( readline($email_limits_fh) ) {
if ( $_ =~ $search_regex ) {
$maxemails = ( split( /\,/, ( split( /:\s+/, $_ ) )[1] ) )[0];
last if $maxemails || $maxemails eq '0'; # case 51568: if there is no value we use the wildcard
}
elsif ( $_ =~ $search_wildcard_regex ) {
$maxemails = ( split( /\,/, ( split( /:\s+/, $_ ) )[1] ) )[0];
last;
}
}
}
chomp $maxemails;
print {$max_fh} $maxemails;
close($max_fh);
rename( '/var/cpanel/email_send_limits/cache/.' . $domain, '/var/cpanel/email_send_limits/cache/' . $domain ); #rename is atomic and will overwrite the file
return int $maxemails; # case 51568: must transform 'unlimited' to 0
}
else {
umask($old_umask);
}
return 0;
}
sub increment_max_emails_per_hour {
my ( $domain, $time, $msgid ) = @_;
$domain =~ s/\///g; #jic
_check_tracker_dir($domain);
$time ||= time();
Exim::log_write( "SMTP connection outbound $time $msgid $domain " . Exim::expand_string('$local_part') . '@' . Exim::expand_string('$domain') );
if ( open( my $emailt_fh, '>>', "/var/cpanel/email_send_limits/track/$domain/" . join( '.', ( gmtime($time) )[ 2, 3, 4, 5 ] ) ) ) {
print {$emailt_fh} '1';
close($emailt_fh);
}
# !DEBUG!
# if ( open( my $emailt_fh, '>>', "/var/cpanel/email_send_limits/track/$domain/msgids_" . join( '.', ( gmtime( $time ) )[ 2, 3, 4, 5 ] ) ) ) {
#
# print {$emailt_fh} $msgid . "\n";
# close($emailt_fh);
# }
}
sub _check_cache_dir {
mkdir( '/var/cpanel/email_send_limits/cache', 0750 ) if !-e '/var/cpanel/email_send_limits/cache';
}
sub _check_tracker_dir {
my $domain = shift;
$domain =~ s/\///g; #jic
if ( !-e '/var/cpanel/email_send_limits/track/' . $domain ) {
mkdir( '/var/cpanel/email_send_limits', 0751 );
mkdir( '/var/cpanel/email_send_limits/track', 0750 );
mkdir( '/var/cpanel/email_send_limits/track/' . $domain, 0750 );
}
}
sub get_current_emails_per_hour {
( ( stat( "/var/cpanel/email_send_limits/track/$_[0]/" . join( '.', ( gmtime( $_[1] || time() ) )[ 2, 3, 4, 5 ] ) ) )[7] || 0 );
}
sub get_current_emails_per_day {
my $domain = shift;
$domain =~ s/\///g; #jic
return 0 if ( !-e '/var/cpanel/email_send_limits/track/' . $domain );
my $total_size = 0;
if ( opendir( my $domain_track_fh, '/var/cpanel/email_send_limits/track/' . $domain ) ) {
while ( my $domaintime = readdir($domain_track_fh) ) {
next if ( $domaintime =~ /^\.\.?$/ );
my $tracker_file_size = ( stat("/var/cpanel/email_send_limits/track/$domain/$domaintime") )[7];
$total_size += $tracker_file_size;
}
}
return $total_size;
}
sub reached_max_emails_per_hour {
my $domain = shift;
$domain =~ s/\///g; #jic
my $max_allowed = int( shift || 0 );
my $time = shift || time();
if ($max_allowed) {
# AKA number_of_emails_sent >= $max_allowed
if ( get_current_emails_per_hour( $domain, $time ) >= $max_allowed ) {
return 1;
}
else {
return 0;
}
}
return 0;
}
#
# This converse function for reference only
#
#sub set_email_send_limits_defer_cutoff {
# my $percentage = int shift ;
#
# # The value is the size of the file so we can avoid the open/close overhead (just a stat)
# if ( open(my $cut_off_percentage_fh,'>','/var/cpanel/email_send_limits/defer_cutoff') ) {
# print {$cut_off_percentage_fh} 'x' x $percentage;
# return 1;
# }
#
# return 0;
# }
sub get_email_send_limits_defer_cutoff {
# The value is the size of the file so we can avoid the open/close overhead (just a stat)
my $cut_off_percentage = ( stat('/var/cpanel/email_send_limits/defer_cutoff') )[7];
if ( !defined $cut_off_percentage ) { $cut_off_percentage = $DEFAULT_EMAIL_SEND_LIMITS_DEFER_CUTOFF_PERCENTAGE; }
return $cut_off_percentage;
}
#
# This converse function for reference only
#
# sub set_email_daily_limit_notify {
# my $limit = int shift ;
# if ( $limit == 0 ) {
# unlink '/var/cpanel/email_send_limits/daily_limit_notify';
# return 1;
# }
# # The value is the size of the file so we can avoid the open/close overhead (just a stat)
# if ( open(my $daily_limit_fh,'>','/var/cpanel/email_send_limits/daily_limit_notify') ) {
# print {$daily_limit_fh} 'x' x $limit;
# return 1;
# }
# return 0;
# }
sub get_email_daily_limit_notify {
# The value is the size of the file so we can avoid the open/close overhead (just a stat)
my $limit = ( stat('/var/cpanel/email_send_limits/daily_limit_notify') )[7];
if ( !defined $limit ) { $limit = 0; }
return $limit;
}
sub create_daily_notify_touchfile {
my $domain = shift;
$domain =~ s/\///g; #jic
mkdir( '/var/cpanel/email_send_limits/daily_notify', 0750 ) if !-e '/var/cpanel/email_send_limits/daily_notify';
if ( open( my $daily_limit_fh, '>', '/var/cpanel/email_send_limits/daily_notify/' . $domain ) ) {
close $daily_limit_fh;
}
return undef;
}
BEGIN {
unshift @INC, '/usr/local/cpanel';
}
#DO NOT USE lib here
# use Cpanel::Encoder::Exim (); -- no loaded with require or preload
sub gethomedir {
my $user = shift;
require Cpanel::Encoder::Exim;
return Exim::expand_string( '${extract{5}{:}{${lookup passwd{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($user) . '}{$value}}}}' ) || '';
}
sub getuid {
my $user = shift;
require Cpanel::Encoder::Exim;
my $uid = Exim::expand_string( '${extract{2}{:}{${lookup passwd{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($user) . '}{$value}}}}' );
return defined $uid ? $uid : '';
}
sub getdomainowner {
my $domain = shift;
require Cpanel::Encoder::Exim;
substr($domain,0,4,'') if index($domain,'www.') == 0;
return Exim::expand_string( '${lookup{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($domain) . '}lsearch{/etc/userdomains}{$value}}' ) || '';
}
my %domain_to_user_cache;
# This must be cached because we call getusersdomain as root in the archive_incoming_email_local_user_method router
# and then we need to read the user out of the memory cache in archiver_incoming_local_user_method since
# we no longer have access to read /etc/domainusers at that point. Note, we need to be able to cache multiple
# users in case they send a message to multiple system users
sub getusersdomain {
return '' if !$_[0] || $_[0] eq 'root' || $_[0] =~ tr{/}{} || !-e "/var/cpanel/users/$_[0]";
return ( $domain_to_user_cache{ $_[0] } || ( $domain_to_user_cache{ $_[0] } = lookup_key_in_file( '/etc/domainusers', $_[0] ) ) );
}
sub lookup_key_in_file {
my ( $file, $key ) = @_;
require Cpanel::Encoder::Exim;
return Exim::expand_string( '${lookup{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($key) . '}lsearch{' . $file . '}{$value}}' ) || '';
}
sub isdemo {
my $user = shift;
return if ( !$user );
return 0 if $user eq '0' || $user eq '8' || $user eq 'mail' || $user eq 'mailnull' || $user eq 'root';
if ( $user =~ /^\d+$/ ) {
return user_exists_in_db( $user, '/etc/demouids' );
}
return user_exists_in_db( $user, '/etc/demousers' );
}
sub user_exists_in_db {
my ( $user, $db ) = @_;
# If the user is empty, '0' or only whitespace
# we should return 0 as $lookup will always return
# 1 even if it does not exist
return 0 if !$user || $user !~ tr{ \t}{}c;
require Cpanel::Encoder::Exim;
return Exim::expand_string( '${lookup{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($user) . '}lsearch{' . $db . '}{1}{0}}' ) || '0';
}
my %sender_recent_authed_mail_ips_address_cache;
my $get_recent_authed_mail_ips_lookup_method;
sub get_recent_authed_mail_ips_text_entry {
my ( $sender, $domain ) = get_recent_authed_mail_ips_entry(@_);
return join( '|', ( $sender || '' ), $domain );
}
sub popbeforesmtpwarn {
if ( my @possible_users = _get_possible_users_from_recent_authed_mail_ips_users() ) {
return ( "X-PopBeforeSMTPSenders: " . join( ",", @possible_users ) );
}
return '';
}
sub get_recent_authed_mail_ips_entry {
my $log = shift;
# SENDING OVER POP B4 SMTP or NOAUTH
# case 43151, case 43150
$get_recent_authed_mail_ips_lookup_method = '';
my $sender_host_address = Exim::expand_string('$sender_host_address');
# Exim::log_write("!DEBUG! get_recent_authed_mail_ips_entry sender_host_address=[$sender_host_address] log=[$log]");
my ( $sender, $domain );
if ( exists $sender_recent_authed_mail_ips_address_cache{$sender_host_address} ) {
# Exim::log_write("!DEBUG! get_recent_authed_mail_ips_entry sender_host_address=[$sender_host_address] USING CACHE");
( $sender, $domain, $get_recent_authed_mail_ips_lookup_method ) = @{ $sender_recent_authed_mail_ips_address_cache{$sender_host_address} };
$get_recent_authed_mail_ips_lookup_method = "cached: " . $get_recent_authed_mail_ips_lookup_method;
$log = 0;
}
else {
my $recent_authed_mail_ips_users_is_up_to_date = ( stat('/etc/recent_authed_mail_ips_users') )[9] + 7200 > time() ? 1 : 0;
my $sender_address_domain;
# Exim::log_write("!DEBUG! get_recent_authed_mail_ips_entry sender_host_address=[$sender_host_address] recent_authed_mail_ips_users_is_up_to_date= $recent_authed_mail_ips_users_is_up_to_date");
# If we have a recent_authed_mail_ips_users file that is up to date, we can verify the ip matches
if ($recent_authed_mail_ips_users_is_up_to_date) {
# This is what the user has claimed as the sender
my $sender_address = Exim::expand_string('$sender_address');
my $from_h_domain = Exim::expand_string('${domain:$h_from:}');
my $from_h_localpart = Exim::expand_string('${local_part:$h_from:}');
my $from_h = "$from_h_localpart\@$from_h_domain";
# First we try to find the address in the recent_authed_mail_ips_users file (with a cached exim lookup)
if ( my @possible_users = _get_possible_users_from_recent_authed_mail_ips_users() ) {
if ( grep { tr/@// ? $from_h eq $_ : $from_h eq $_ . '@' . $primary_hostname } @possible_users ) {
$sender = $from_h;
$domain = getdomainfromaddress($from_h);
$get_recent_authed_mail_ips_lookup_method = "full match of from_h in recent_authed_mail_ips_users";
}
elsif ( grep { tr/@// ? $sender_address eq $_ : $sender_address eq $_ . '@' . $primary_hostname } @possible_users ) {
$sender = $sender_address;
$domain = getdomainfromaddress($sender_address);
$get_recent_authed_mail_ips_lookup_method = "full match of sender_address in recent_authed_mail_ips_users";
}
elsif ( ( $sender_address_domain = ( split( m/\@/, $sender_address ) )[1] ) && grep( m/\@\Q$sender_address_domain\E$/, @possible_users ) ) {
$domain = $sender_address_domain;
$sender = '-unknown-@' . $domain;
$get_recent_authed_mail_ips_lookup_method = "match of sender_address_domain in recent_authed_mail_ips_users";
}
elsif ( grep { tr/@// ? ( $from_h eq $_ ) : ( $from_h_localpart eq $_ && ( !length $from_h_domain || $from_h_domain eq $primary_hostname ) ) } @possible_users ) {
$sender = $from_h;
$domain = $from_h_domain;
$get_recent_authed_mail_ips_lookup_method = "full match of from_h in recent_authed_mail_ips_users";
}
elsif ( grep( m/\@\Q$from_h_domain\E$/, @possible_users ) ) {
$domain = $from_h_domain;
$sender = '-unknown-@' . $from_h_domain;
$get_recent_authed_mail_ips_lookup_method = "match of from_h_domain in recent_authed_mail_ips_users";
}
elsif ( $possible_users[0] && $possible_users[0] eq '-alwaysrelay-' ) {
if ($from_h_domain) {
Exim::log_write("$sender_host_address in /etc/alwaysrelay trusting from_h_domain of: $from_h_domain and from_h_localpart: $from_h_localpart");
$domain = $from_h_domain;
$sender = $from_h;
$get_recent_authed_mail_ips_lookup_method = "in alwaysrelay trusted from_h";
}
else {
Exim::log_write("$sender_host_address in /etc/alwaysrelay trusting sender_address_domain of: $sender_address_domain");
$domain = $sender_address_domain;
$sender = $sender_address;
$get_recent_authed_mail_ips_lookup_method = "in alwaysrelay trusted sender_address";
}
}
else {
# If none of them matched, we have to assume they authenticated in some we so we go with the first one
$domain = getdomainfromaddress( $possible_users[0] );
$sender = $possible_users[0];
$get_recent_authed_mail_ips_lookup_method = "in recent_authed_mail_ips_users using first address";
}
if ( $sender =~ m/^\*/ ) {
$sender =~ s/^\*/-unknown-/;
}
$sender_recent_authed_mail_ips_address_cache{$sender_host_address} = [ $sender, $domain, $get_recent_authed_mail_ips_lookup_method ];
}
}
# we need to check alwaysrelay since we don't require recentauthedmailiptracker to be enabled
if ( !$domain && -e '/etc/alwaysrelay' ) {
my $alwaysrelay_result = Exim::expand_string('${lookup{$sender_host_address}iplsearch{/etc/alwaysrelay}{$sender_host_address $value}}');
if ($alwaysrelay_result) {
my ( $alwaysrelay_ip, $alwaysrelay_user ) = split( /\s+/, $alwaysrelay_result );
if ($alwaysrelay_user) {
$domain = getdomainfromaddress($alwaysrelay_user);
$sender = $alwaysrelay_user;
$get_recent_authed_mail_ips_lookup_method = "full match in alwaysrelay with recentauthedmailiptracker disabled";
Exim::log_write("$sender_host_address in /etc/alwaysrelay using domain $domain from lookup of $alwaysrelay_user");
}
if ( !$domain ) {
$domain = $sender_address_domain = ( split( /\@/, Exim::expand_string('$sender_address') ) )[1];
$sender = "-unknown-\@$domain";
$get_recent_authed_mail_ips_lookup_method = "in alwaysrelay with recentauthedmailiptracker disabled";
Exim::log_write("$sender_host_address in /etc/alwaysrelay trusting sender_address_domain of: $sender_address_domain");
}
}
# no need to check /etc/alwaysrelay as they are automaticlly built into recent_authed_mail_ips_users
}
}
if ($domain) {
if ($log) {
my $message_exim_id = Exim::expand_string('$message_exim_id');
my $sender_host_name = Exim::expand_string('${if match_ip{$sender_host_address}{+loopback}{localhost}{$sender_host_name}}');
my $sender_host_port = Exim::expand_string('$sender_host_port');
my $recent_authed_mail_ips_local_user = getdomainowner($domain);
my $recent_authed_mail_ips_local_uid = user2uid($recent_authed_mail_ips_local_user);
Exim::log_write("SMTP connection identification H=$sender_host_name A=$sender_host_address P=$sender_host_port U=$recent_authed_mail_ips_local_user ID=$recent_authed_mail_ips_local_uid S=$sender B=get_recent_authed_mail_ips_entry");
}
return ( $sender, $domain, $get_recent_authed_mail_ips_lookup_method );
}
return ( '', '', '' );
}
sub _get_possible_users_from_recent_authed_mail_ips_users {
my $recent_authed_mail_ips_users_result = Exim::expand_string('${lookup{$sender_host_address}lsearch{/etc/recent_authed_mail_ips_users}{$value}}');
return map {
s/\/.*$//g if tr/\///;
tr/+%:/@/;
$_;
} split( m/\s*\,\s*/, $recent_authed_mail_ips_users_result );
}
my $local_connection_uid;
my $local_connection_user;
my %sender_host_address_cache;
sub get_identified_local_connection_uid {
$local_connection_uid;
}
sub get_identified_local_connection_user {
$local_connection_user;
}
sub identify_local_connection {
# passes but not for production
# use strict;
# On Linux we can identify users by reading /proc/net/tcp*
# Since this requires access kernel memory on bsd and we don't have a way
# do that under exim users MUST authenticate to send messages from localhost
my ( $sender_host_address, $sender_host_port, $received_ip_address, $received_port, $log ) = @_;
undef $local_connection_uid;
undef $local_connection_user;
my $uid;
if ( exists $sender_host_address_cache{ $sender_host_address . '__' . $sender_host_port } ) {
$uid = $sender_host_address_cache{ $sender_host_address . '__' . $sender_host_port };
$log = 0;
}
else {
local @INC = ( '/usr/local/cpanel', @INC ) if !grep { '/usr/local/cpanel' } @INC;
require Cpanel::Ident;
$uid = Cpanel::Ident::identify_local_connection( $sender_host_address, $sender_host_port, $received_ip_address, $received_port );
if ( !defined $uid ) {
$uid = identify_local_connection_wrapped( $sender_host_address, $sender_host_port, $received_ip_address, $received_port );
}
}
if ( defined $uid ) {
$local_connection_uid = $uid;
$sender_host_address_cache{ $sender_host_address . '__' . $sender_host_port } = $local_connection_uid;
if ( $uid == -1 ) {
Exim::log_write("Could not identify the local connection from $sender_host_address on port $sender_host_port. Please authenticate") if $log;
return 0;
}
$local_connection_user = uid2user($uid);
# Log this for tailwatchd
Exim::log_write("SMTP connection identification H=localhost A=$sender_host_address P=$sender_host_port U=$local_connection_user ID=$local_connection_uid S=$local_connection_user B=identify_local_connection") if $log;
return 1;
}
else {
$sender_host_address_cache{ $sender_host_address . '__' . $sender_host_port } = undef;
Exim::log_write("could not identify the local connection from $sender_host_address on port $sender_host_port. Please authenticate") if $log;
return 0;
}
}
sub identify_local_connection_wrapped {
my ( $address, $port, $localaddress, $localport ) = @_;
my $uidline = call_cpwrap( 'IDENTIFYLOCALCONNECTION', $address, $port, $localaddress, $localport );
chomp($uidline) if defined $uidline;
my ( $uidkey, $uid ) = split( /:/, $uidline, 2 );
$uid = undef if $uid eq '';
Exim::log_write("/usr/local/cpanel/bin/eximwrap IDENTIFYLOCALCONNECTION $address $port $localaddress $localport failed to return the uid key.") if ( !defined $uidkey || $uidkey ne 'uid' );
return $uid;
}
my $headers_rewrite_notice = '';
my $new_from_header;
use constant {
_ENOENT => 2,
_EEXIST => 17,
_SENDER_SYSTEM => '-system-',
};
sub spamd_is_available {
require Cpanel::Services::Enabled::Spamd;
return eval { Cpanel::Services::Enabled::Spamd::is_enabled() } // do {
warn;
1; # this defaults to on for historical reasons
};
}
sub get_dkim_domain {
my $msg_sender_domain = get_message_sender_domain();
if ($msg_sender_domain eq _SENDER_SYSTEM) {
$msg_sender_domain = Exim::expand_string('$sender_address_domain');
}
return $msg_sender_domain =~ tr<A-Z><a-z>r;
}
sub sender_domain_can_dkim_sign {
require Cpanel::DKIM::ValidityCache;
my $sender_domain = get_dkim_domain();
local $@;
return eval { Cpanel::DKIM::ValidityCache->get($sender_domain) } // do {
warn;
q<>;
};
}
sub discover_sender_information {
# If $sender_lookup_method and $check_mail_permissions_sender is already set
# we have already discovered the sender
if ( !$sender_lookup_method || !$check_mail_permissions_sender ) {
my $uid = int( Exim::expand_string('$originator_uid') );
my $gid = int( Exim::expand_string('$originator_gid') );
#Exim::log_write("discover_sender_information calling get_message_sender");
my ( $sender, $real_domain, $domain, $is_mailman ) = get_message_sender( $uid, $gid, 1 );
$check_mail_permissions_sender = $sender if $sender;
$check_mail_permissions_is_mailman = $is_mailman;
}
#Exim::log_write("discover_sender_information calling discover_sender_information");
$new_from_header = get_from_header_rewrite_target();
return 0;
}
sub get_headers_rewrite {
return $new_from_header if $new_from_header;
my ($from_h_sender) = _get_from_h_sender();
Exim::log_write("discover_sender_information failed to set the from header rewrite for $from_h_sender");
return $from_h_sender;
}
sub get_from_header_rewrite_target {
$headers_rewrite_notice = '';
my ( $from_h_sender, $from_h_localpart, $from_h_domain ) = _get_from_h_sender();
if ( $sender_lookup_method && $check_mail_permissions_sender ) {
my $actual_sender = _get_login_from_check_mail_permissions_sender($check_mail_permissions_sender);
#Exim::log_write("!DEBUG! get_from_header_rewrite_target() actual_sender=[$actual_sender] from_h_sender=[$from_h_sender]");
my $qualified_actual_sender = _qualify_as_email_address($actual_sender);
my ( $status, $statusmsg );
if ( $sender_lookup_method =~ m{^redirect/forwarder} ) {
$headers_rewrite_notice = 'unmodified, forwarded message';
return $from_h_sender;
}
elsif ($check_mail_permissions_is_mailman) {
$headers_rewrite_notice = 'unmodified, sender is mailman';
return $from_h_sender;
}
elsif ( $from_h_sender eq $actual_sender ) {
$headers_rewrite_notice = 'unmodified, already matched';
return $from_h_sender;
}
else {
if ( $actual_sender eq 'mailnull' ) { # handle Mailer-Daemon messages
$headers_rewrite_notice = 'unmodified, actual sender is mailnull';
return $from_h_sender;
}
my $from_h_sender_domainowner = getdomainowner($from_h_domain);
# Actual Sender is a system user.
if ( $from_h_sender_domainowner && $from_h_sender_domainowner eq $actual_sender ) {
$headers_rewrite_notice = 'unmodified, actual sender is system user that owns from domain in the from header';
return $from_h_sender;
}
elsif ( $from_h_sender eq $qualified_actual_sender ) {
$headers_rewrite_notice = 'unmodified, actual sender is the system user';
return $from_h_sender;
}
elsif ( $actual_sender eq 'root' ) {
$headers_rewrite_notice = 'unmodified, actual sender is root';
return $from_h_sender;
}
elsif ( $actual_sender eq 'mailman' ) {
$headers_rewrite_notice = 'unmodified, actual sender is mailman';
return $from_h_sender;
}
elsif ( $actual_sender !~ tr/\@// && _is_trusted_user($actual_sender) ) {
$headers_rewrite_notice = 'unmodified, actual sender is a trusted user';
return $from_h_sender;
}
elsif ( ( ( $status, $statusmsg ) = _has_valias_pointing_to_actual_sender( $from_h_sender, $actual_sender ) )[0] ) {
if ( $statusmsg eq 'valias_exact_match' ) {
$headers_rewrite_notice = 'unmodified, there is a forwarder that points to the actual sender.';
}
elsif ( $statusmsg eq 'valias_domainowner_match' ) {
$headers_rewrite_notice = 'unmodified, there is a forwarder that points to a user owned by actual sender.';
}
elsif ( $statusmsg eq 'vdomainaliases_match' ) {
$headers_rewrite_notice = 'unmodified, there is a domain forwarder that maps to the actual sender.';
}
return $from_h_sender;
}
else {
if ( $actual_sender !~ tr/\@// ) {
$headers_rewrite_notice = 'rewritten was: [' . $from_h_sender . '], actual sender is not the same system user';
}
else {
$headers_rewrite_notice = 'rewritten was: [' . $from_h_sender . '], actual sender does not match';
}
Exim::log_write("From: header ($headers_rewrite_notice) original=[$from_h_sender] actual_sender=[$qualified_actual_sender]");
return $qualified_actual_sender;
}
}
}
# We have no sender set so we leave it unmodified
# AKA unable to determine sender would get here
$headers_rewrite_notice = 'unmodified, no actual sender determined from check mail permissions';
return $from_h_sender;
}
sub get_headers_rewritten_notice {
if ($headers_rewrite_notice) {
return "X-From-Rewrite: $headers_rewrite_notice";
}
return '';
}
#
# This converts an unqualified address which is just a system
# account IE local_part. Into local_part@primary_hostname.
#
# If the address is already qualified ie has @, it returns returns the
# address.
#
sub _qualify_as_email_address {
my ($address) = @_;
return $address if $address =~ tr/@//;
$primary_hostname ||= Exim::expand_string('$primary_hostname');
return $address . '@' . $primary_hostname;
}
#
# Convert the $check_mail_permissions_sender variable
# into the real login that the user has authenticated as
# in most cases this is already their email address, however it may
# be USER@PRIMARY_HOSTNAME, in which case we want to strip PRIMARY_HOSTNAME
#
sub _get_login_from_check_mail_permissions_sender {
my ($sender) = @_;
$primary_hostname ||= Exim::expand_string('$primary_hostname');
$sender =~ s/\@\Q$primary_hostname\E$//;
return $sender;
}
# _has_valias_pointing_to_target lets us know if there
# if a forwarder for the address pointing at the target.
#
# For example ORIGIN bob@cpanel.net
# might point to a user account DEST 'bob'
#
sub _has_valias_pointing_to_actual_sender {
my ( $origin, $actual_sender ) = @_;
#Exim::log_write("!DEBUG! _has_valias_pointing_to_actual_sender() actual_sender=[$actual_sender] origin=[$origin]");
my $qualified_origin = _qualify_as_email_address($origin);
my $qualified_actual_sender = _qualify_as_email_address($actual_sender);
my ( $origin_local_part, $origin_domain ) = split( m{@}, $qualified_origin, 2 );
my ( $actual_sender_local_part, $actual_sender_domain ) = split( m{@}, $qualified_actual_sender, 2 );
my $actual_sender_domainowner;
require Cpanel::Encoder::Exim;
return ( 0, 'invalid_origin_domain' ) if $origin_domain =~ m{/};
if ( file_exists("$VALIASES_DIR/$origin_domain") ) {
if ( my $valiases_alias_line = Exim::expand_string( '${lookup{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($origin) . '}lsearch*{' . $VALIASES_DIR . '/' . $origin_domain . '}{$value}}' ) ) {
if ( my @forwarders = _get_forwarders_from_string($valiases_alias_line) ) {
foreach my $forwarder_destination (@forwarders) {
#
# Handle exact matches
# IE bob@cpanel.net is forwarded to the actual sender
#
if ( _qualify_as_email_address($forwarder_destination) eq $qualified_actual_sender ) {
return ( 1, 'valias_exact_match' );
}
# $VALIASES_DIR/dog.com: nick@dog.org: me@samsdomain.org
# I send email From: nick@dog.org and I am authenticated as 'sam' it should likely be allowed
if ( $actual_sender !~ tr/\@// && $forwarder_destination =~ tr/\@// ) {
my ( $forwarder_destination_local_part, $forwarder_destination_domain ) = split( m{@}, $forwarder_destination, 2 );
my $forwarder_destination_domainowner = getdomainowner($forwarder_destination_domain);
if ( $actual_sender eq $forwarder_destination_domainowner ) {
return ( 1, 'valias_domainowner_match' );
}
}
}
}
}
}
if ( file_exists("$VDOMAINALIASES_DIR/$origin_domain") ) {
if ( my $vdomainaliases_alias_line = Exim::expand_string( '${lookup{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($origin_domain) . '}lsearch{' . $VDOMAINALIASES_DIR . '/' . $origin_domain . '}{$value}}' ) ) {
my $vdomainaliases_domain = _ws_trim($vdomainaliases_alias_line);
if ( ( $origin_local_part . '@' . $vdomainaliases_domain ) eq $qualified_actual_sender ) {
return ( 1, 'vdomainaliases_match' );
}
}
}
return ( 0, 'no_match' );
}
sub _is_trusted_user {
my ($user) = @_;
return 0 if !file_exists('/etc/trusted_mail_users');
local $/;
open my $trusted_mail_users_fh, '<', '/etc/trusted_mail_users' or return 0;
my @trusted_mail_users = split( qq{\n}, <$trusted_mail_users_fh> );
close $trusted_mail_users_fh;
return scalar grep { $_ eq $user } @trusted_mail_users;
}
#
# From Cpanel::StringFunc::Trim
#
sub _ws_trim {
my ($this) = @_;
my $fix = ref $this eq 'SCALAR' ? $this : \$this;
${$fix} =~ s/^\s+//;
${$fix} =~ s/\s+$//;
return ${$fix};
}
#
# From Cpanel::API::Email
#
sub _get_forwarders_from_string {
my ($forwarder_csv) = @_;
# to leave \, as \, uncomment this:
# $forwarder_csv =~ s{\\,}{\\\\,}g;
my @forwarders =
$forwarder_csv =~ /^[\s"]*\:(fail|defer|blackhole|include)\:/
? ($forwarder_csv)
: split( /(?<![\\]),/, $forwarder_csv );
my @parsed_forwarders;
for my $forward (@forwarders) {
$forward = _ws_trim($forward);
next if ( $forward =~ m{^"} );
push @parsed_forwarders, $forward;
}
return wantarray ? @parsed_forwarders : \@parsed_forwarders;
}
sub check_mail_permissions_results {
return $check_mail_permissions_data;
}
sub enforce_mail_permissions_results {
$enforce_mail_permissions_data;
}
sub uid2user {
my $uid = shift;
return exists $uid_cache{$uid} ? $uid_cache{$uid} : ( $uid_cache{$uid} = ( getpwuid($uid) )[0] );
}
sub user2uid {
my $user = shift;
return exists $user_cache{$user} ? $user_cache{$user} : ( $user_cache{$user} = getuid($user) );
}
sub get_sender_from_uid {
my $uid = int( Exim::expand_string('$originator_uid') );
my $user = uid2user($uid);
return getdomainfromaddress($user);
}
sub mailtrapheaders {
$primary_hostname ||= Exim::expand_string('$primary_hostname');
my $original_domain = Exim::expand_string('$original_domain');
my $sender_address_domain = Exim::expand_string('$sender_address_domain');
my $originator_uid = Exim::expand_string('$originator_uid');
my $originator_gid = Exim::expand_string('$originator_gid');
my $caller_uid = Exim::expand_string('$caller_uid');
my $caller_gid = Exim::expand_string('$caller_gid');
my $headers =
"X-AntiAbuse: This header was added to track abuse, please include it with any abuse report\n"
. "X-AntiAbuse: Primary Hostname - $primary_hostname\n"
. "X-AntiAbuse: Original Domain - $original_domain\n"
. "X-AntiAbuse: Originator/Caller UID/GID - [$originator_uid $originator_gid] / [$caller_uid $caller_gid]\n"
. "X-AntiAbuse: Sender Address Domain - $sender_address_domain\n"
. check_mail_permissions_headers() . "\n";
if ( file_exists('/etc/eximmailtrap') ) {
my $xsource = $ENV{'X-SOURCE'};
my $xsourceargs = $ENV{'X-SOURCE-ARGS'};
my $xsourcedir = maskdir( $ENV{'X-SOURCE-DIR'} );
$headers .= "X-Source: ${xsource}\n" . "X-Source-Args: ${xsourceargs}\n" . "X-Source-Dir: ${xsourcedir}";
}
return ($headers);
}
sub getdomainfromaddress {
my $address = shift;
$address =~ s/\/.*$//g if $address =~ tr/\///; # remove /spam
if ( $address =~ tr/@+%:// ) {
unless ( $address =~ tr/@// ) {
# This matches exactly how authentication occurs
$address =~ s/[+:%]/@/;
}
$primary_hostname ||= Exim::expand_string('$primary_hostname');
if ( $address =~ m/[@]\Q$primary_hostname\E$/ ) {
return getusersdomain( ( split( m/[@]/, $address, 2 ) )[0] ) || _SENDER_SYSTEM; #from MailAuth.pm
}
else {
return ( split( m/[@]/, $address, 2 ) )[1]; #from MailAuth.pm
}
}
else {
return getusersdomain($address) || _SENDER_SYSTEM;
}
}
sub get_message_sender_domain {
my ( $uid, $gid, $log ) = @_;
$uid = int( Exim::expand_string('$originator_uid') ) if !defined $uid;
$gid = int( Exim::expand_string('$originator_gid') ) if !defined $gid;
return ( ( get_message_sender( $uid, $gid, $log ) )[1] ) || '';
}
sub get_sender_lookup_method {
return $sender_lookup_method || 'none';
}
sub get_sender_lookup {
return $sender_lookup || '';
}
sub check_mail_permissions_headers {
return "X-Get-Message-Sender-Via: " . ( $primary_hostname ||= Exim::expand_string('$primary_hostname') ) . ": " . get_sender_lookup_method() . "\n" . "X-Authenticated-Sender: " . ( $primary_hostname ||= Exim::expand_string('$primary_hostname') ) . ": " . get_sender_lookup();
}
# This must match the logic extactly for Cpanel::TailWatch::EximStats ($direction eq '<=')
sub get_message_sender {
#passes but not for production
#use strict;
my ( $uid, $gid, $log ) = @_;
my ( $authenticated_local_user, $authenticated_id, $recent_authed_mail_ips_text_entry, $domain, $counted_domain, $sender, $is_mailman, $username );
$sender_lookup_method = '';
my ( $acl_c_vhost_owner, $acl_c_vhost_owner_url ) = split( m{:}, Exim::expand_string('$acl_c_vhost_owner') || '', 2 );
my $message_exim_id = Exim::expand_string('$message_exim_id');
# SMTP AUTH
if ( $authenticated_id = Exim::expand_string('$authenticated_id') ) {
$authenticated_id =~ s/[\r\n\f]//g;
if ( $authenticated_id eq 'nobody' ) {
if ($acl_c_vhost_owner) {
$authenticated_id = uid2user($acl_c_vhost_owner);
}
$sender_lookup_method = 'uid via acl_c_vhost_owner from authenticated_id: ' . $authenticated_id . ' from ' . $acl_c_vhost_owner_url;
}
else {
$sender_lookup_method = 'authenticated_id: ' . $authenticated_id;
}
$sender = $authenticated_id;
$domain = getdomainfromaddress($authenticated_id);
# If the sender owns the domain they are sending
# from we can trust it
if ( length $sender && $sender !~ tr/\@// ) {
( $sender, $domain, $sender_lookup_method ) = resolve_authenticated_sender( $sender, $domain, $sender_lookup_method );
}
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from authenticated_id ($authenticated_id)");
}
# FROM A CONNECTION TO LOCALHOST (linux only)
elsif ( $authenticated_local_user = Exim::expand_string('${if match_ip{$sender_host_address}{+loopback}{$acl_c_authenticated_local_user}{}}') ) {
my $authenticated_local_uid = user2uid($authenticated_local_user);
my $sender_host_address = Exim::expand_string('$sender_host_address');
my $sender_host_name = Exim::expand_string('${if match_ip{$sender_host_address}{+loopback}{localhost}{$sender_host_name}}');
my $sender_host_port = Exim::expand_string('$sender_host_port');
$domain = getusersdomain($authenticated_local_user) || _SENDER_SYSTEM;
$sender = $authenticated_local_user;
$sender_lookup_method = 'acl_c_authenticated_local_user: ' . $authenticated_local_user;
if ($log) { Exim::log_write("SMTP connection identification H=$sender_host_name A=$sender_host_address P=$sender_host_port M=$message_exim_id U=$authenticated_local_user ID=$authenticated_local_uid S=$sender B=authenticated_local_user"); } #replay for tailwatchd
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from acl_c_authenticated_local_user");
}
# RELAY HOSTS
elsif ( $recent_authed_mail_ips_text_entry = Exim::expand_string('$acl_c_recent_authed_mail_ips_text_entry') ) {
#FIXME: need to get sender
( $sender, $domain ) = split( /\|/, $recent_authed_mail_ips_text_entry );
my $sender_host_address = Exim::expand_string('$sender_host_address');
my $sender_host_name = Exim::expand_string('${if match_ip{$sender_host_address}{+loopback}{localhost}{$sender_host_name}}');
my $sender_host_port = Exim::expand_string('$sender_host_port');
my $recent_authed_mail_ips_local_user = getdomainowner($domain);
my $recent_authed_mail_ips_local_uid = user2uid($recent_authed_mail_ips_local_user);
$sender_lookup_method = 'acl_c_recent_authed_mail_ips_text_entry: ' . $recent_authed_mail_ips_text_entry;
if ($log) { Exim::log_write("SMTP connection identification H=$sender_host_name A=$sender_host_address P=$sender_host_port M=$message_exim_id U=$recent_authed_mail_ips_local_user ID=$recent_authed_mail_ips_local_uid S=$sender B=recent_authed_mail_ips_domain") }
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from acl_c_recent_authed_mail_ips_text_entry");
}
elsif ( Exim::expand_string('$received_protocol') eq 'local' ) {
my $sender_ident = Exim::expand_string('$sender_ident');
$sender_ident =~ s/[\r\n\f]//g;
my $used_vhost_owner_lookup = 0;
if ( $sender_ident eq 'nobody' ) {
if ($acl_c_vhost_owner) {
$used_vhost_owner_lookup = 1;
$sender_ident = uid2user($acl_c_vhost_owner);
}
}
$sender = $sender_ident;
$domain = getusersdomain($sender_ident) || _SENDER_SYSTEM;
$sender_lookup_method = 'sender_ident via received_protocol == local: ' . $sender_ident . ( $used_vhost_owner_lookup ? ' : used vhost owner lookup from: ' . $acl_c_vhost_owner_url : '' );
# If the sender owns the domain they are sending
# from we can trust it
if ( length $sender && $sender !~ tr/\@// ) {
( $sender, $domain, $sender_lookup_method ) = resolve_authenticated_sender( $sender, $domain, $sender_lookup_method );
}
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from local user ($sender_ident)");
}
else {
$mail_gid ||= int( ( getgrnam('mail') )[2] );
#Exim::log_write("!DEBUG! mailgid=$mail_gid == gid=$gid (uid=$uid)");
if ( $gid == $mail_gid ) {
my ( $recent_authed_mail_ips_sender, $recent_authed_mail_ips_domain, $recent_authed_mail_ips_lookup_method ) = get_recent_authed_mail_ips_entry();
if ($recent_authed_mail_ips_domain) {
$sender = $recent_authed_mail_ips_sender;
$sender =~ s/[\r\n\f]//g;
$domain = $recent_authed_mail_ips_domain;
$sender_lookup_method = 'mailgid via get_recent_authed_mail_ips_entry: ' . $sender . "/$recent_authed_mail_ips_lookup_method";
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from get_recent_authed_mail_ips_entry() or sender_address_domain");
}
$primary_hostname ||= Exim::expand_string('$primary_hostname');
if ( $domain && $domain eq $primary_hostname ) {
$username = Exim::expand_string('$sender_address_local_part');
$sender = $username;
$domain = getusersdomain($username) || _SENDER_SYSTEM;
$sender_lookup_method = 'mailgid via primary_hostname' . "/$recent_authed_mail_ips_lookup_method";
}
if ( !$domain ) {
# If we cannot find the sender and it is not _SENDER_SYSTEM it is a redirected/forwarded message
my $parent_domain = Exim::expand_string('$parent_domain');
my $parent_local_part = Exim::expand_string('$parent_local_part');
my $local_part = Exim::expand_string('$local_part');
my $delivery_domain = Exim::expand_string('$domain');
$parent_domain =~ s/[^\w\.\-\/]//g;
$parent_local_part =~ s/[^\w\.\-\/]//g;
$local_part =~ s/[^\w\.\-\/]//g;
$delivery_domain =~ s/[^\w\.\-\/]//g;
# If we have a parent_domain its probably a redirect
if ( $parent_domain && ( $parent_domain ne $delivery_domain || $parent_local_part ne $local_part ) ) {
# If the parent_domain is the primary_hostname its a localuser redirect
if ( my $local_user = $parent_domain eq $primary_hostname ? $parent_local_part : getdomainowner($parent_domain) ) {
my $local_uid = user2uid($local_user);
my $redirected_domain = $parent_domain eq $primary_hostname ? getusersdomain($parent_local_part) : $parent_domain;
if ($log) { Exim::log_write("SMTP connection identification D=$redirected_domain O=$parent_local_part\@$parent_domain E=$local_part\@$delivery_domain M=$message_exim_id U=$local_user ID=$local_uid B=redirect_resolver") }
; #replay for tailwatchd
$domain = $redirected_domain;
$sender = $parent_domain eq $primary_hostname ? $local_user : "$parent_local_part\@$parent_domain";
$sender_lookup_method = "redirect/forwarder owner $parent_local_part\@$parent_domain -> $local_part\@$delivery_domain";
}
}
}
if ( !$domain ) {
$sender_lookup_method = 'mailgid no entry from get_recent_authed_mail_ips_entry';
#Exim::log_write("!DEBUG! get_message_sender() failed to get the domain. However the sender domain claims to be $sender_address_domain");
}
}
else {
# FROM A SHELL OR CGI
$username = uid2user($uid);
if ($username) {
if ( $username eq 'nobody' ) {
if ($acl_c_vhost_owner) {
$username = uid2user($acl_c_vhost_owner);
}
$sender_lookup_method = 'uid via acl_c_vhost_owner from shell cgi: ' . $username . ' from: ' . $acl_c_vhost_owner_url;
}
else {
$sender_lookup_method = 'uid via shell cgi: ' . $username;
}
$domain = getusersdomain($username) || _SENDER_SYSTEM;
$sender = $username;
}
# If the sender owns the domain they are sending
# from we can trust it
if ( length $sender && $sender !~ tr/\@// ) {
( $sender, $domain, $sender_lookup_method ) = resolve_authenticated_sender( $sender, $domain, $sender_lookup_method );
}
#Exim::log_write("!DEBUG! get_message_sender() got domain $domain from UID");
}
}
if ($domain) {
$domain =~ s/[^\w\.\-\/]//g;
$domain = lc $domain;
$counted_domain = $domain;
if ($sender) {
$sender =~ tr/+%:/@/;
$sender =~ s/[^\w\.\-\/\@]//g;
if ( $sender eq 'mailman' ) {
$is_mailman = 1;
$domain = lc Exim::expand_string('$sender_address_domain');
$sender_lookup_method .= '/mailman';
$sender = 'mailman@' . $domain;
$counted_domain = $domain if ( file_exists('/var/cpanel/email_send_limits/count_mailman') );
}
}
}
$sender_lookup = $sender;
if ( $log && $message_exim_id ) {
$username ||= ( ( $sender =~ tr{@}{} ) ? getdomainowner( ( split( m{@}, $sender ) )[1] ) : $sender );
if ($username) {
# Will log as 2017-05-26 13:42:22 1dEKBq-0007HB-6R Sender identification S=nick
Exim::log_write("Sender identification U=$username D=$domain S=$sender"); #replay for tailwatchd
}
}
return ( $sender, $domain, $counted_domain, $is_mailman );
}
sub get_message_sender_address {
return ( get_message_sender(@_) )[0];
}
sub enforce_mail_permissions {
$enforce_mail_permissions_data ? 1 : 0;
}
sub check_mail_permissions {
$check_mail_permissions_domain = undef;
#Exim::log_write("!DEBUG! running check_mail_permissions");
my $uid = int( Exim::expand_string('$originator_uid') );
$enforce_mail_permissions_data = ':fail: check_mail_permissions failed to complete or set a status';
$check_mail_permissions_result = '';
$check_mail_permissions_data = ':unknown:';
$check_mail_permissions_domain = '';
$check_mail_permissions_sender = '';
$check_mail_permissions_is_mailman = 0;
$nobody_uid ||= user2uid('nobody');
my $acl_c_vhost_owner = ( split( m{:}, Exim::expand_string('$acl_c_vhost_owner') || '' ) )[0];
my $acl_c_vhost_owner_known_user = ( $acl_c_vhost_owner && $acl_c_vhost_owner != $nobody_uid ) ? 1 : 0;
if ( $uid == $nobody_uid && !$acl_c_vhost_owner_known_user && file_exists('/etc/webspam') ) {
$enforce_mail_permissions_data = ':fail: Mail sent by user nobody being discarded due to sender restrictions in WHM->Tweak Settings';
$check_mail_permissions_result = "uid ($uid) is the nobody_uid ($nobody_uid) and /etc/webspam exists"; # for tests (only set when enforce_mail_permissions_data is empty)
return 'no';
}
my $gid = int( Exim::expand_string('$originator_gid') );
#MAILTRAP
if ( file_exists('/etc/eximmailtrap') ) {
$mailtrap_gid ||= int( ( getgrnam('mailtrap') )[2] );
$nobody_gid ||= int( ( getgrnam('nobody') )[2] );
if ( $uid >= $nobody_uid && $gid >= $nobody_gid && $gid != $mailtrap_gid ) {
$enforce_mail_permissions_data = ":fail: Gid $gid is not permitted to relay mail, or has directly called /usr/sbin/exim instead of /usr/sbin/sendmail.";
return 'no';
}
}
#MAILTRAP
if ( Exim::expand_string('$received_protocol') eq 'local' && isdemo($uid) ) {
$enforce_mail_permissions_data = ":fail: User with uid $uid is a demo user. You cannot send mail if your account is in demo mode.";
return 'no';
}
my $message_exim_id = Exim::expand_string('$message_exim_id');
if ( !$message_exim_id && !Exim::expand_string('$sender_address') ) {
$enforce_mail_permissions_data = ''; # permit normal acction
#Exim::log_write("!DEBUG! check_mail_permissions called without sender_address set from $sender_host_address (rcount: $recipients_count)");
$check_mail_permissions_result = "webspam check, mailtrap check, demo check passed and no sender_address"; # for tests (only set when enforce_mail_permissions_data is empty)
return 'no';
}
# real_domain is the domain of the actual sender
# domain is the domain we actually count the message against
# Currently these are always the same except domain may be
# rewritten if we are coming from a mailman list in order
# to count against the owner of the list instead of the mailman
# user assuming /var/cpanel/email_send_limits/count_mailman exists
my ( $sender, $real_domain, $domain, $is_mailman ) = get_message_sender( $uid, $gid, 1 );
if ( $sender =~ m/^_archive\@/ ) {
$enforce_mail_permissions_data = ":fail: Archive Users are not permitted to send email. Message discarded.";
$check_mail_permissions_result = "get_message_sender returned an archive user";
return 'no';
}
if ( !Cpanel::Server::Type::Role::MailRelay->is_enabled() ) {
$enforce_mail_permissions_data = ":fail: This server does not relay mail.";
$check_mail_permissions_result = "This server does not relay mail.";
return 'no';
}
if ( !$domain || $domain eq '' ) {
my $sender_host_address = Exim::expand_string('$received_protocol') eq 'local' ? 'localhost' : Exim::expand_string('$sender_host_address');
my $recipients_count = Exim::expand_string('$recipients_count');
my $routed_domain = Exim::expand_string('$domain');
if ( $sender eq 'nobody' && file_exists('/etc/webspam') ) {
Exim::log_write("check_mail_permissions could not determine the sender domain for a nobody message [routed_domain=$routed_domain message_exim_id=$message_exim_id sender_host_address=$sender_host_address recipients_count=$recipients_count]") if $recipients_count && !getdomainowner($routed_domain);
$enforce_mail_permissions_data = ':fail: Mail sent by user nobody that cannot be linked to a user is being discarded due to sender restrictions in WHM->Tweak Settings';
$check_mail_permissions_result = "The sender of the message nobody and /etc/webspam exists"; # for tests (only set when enforce_mail_permissions_data is empty)
}
else {
Exim::log_write("check_mail_permissions could not determine the sender domain [routed_domain=$routed_domain message_exim_id=$message_exim_id sender_host_address=$sender_host_address recipients_count=$recipients_count]") if $recipients_count && !getdomainowner($routed_domain);
# If delivery is to a userdomain that its expected that we cannot get the sender domain
$enforce_mail_permissions_data = ''; # permit normal acction
$check_mail_permissions_result = "get_message_sender returned no domain"; # for tests (only set when enforce_mail_permissions_data is empty)
}
return 'no';
}
else {
if ( !$message_exim_id ) {
#Exim::log_write("check_mail_permissions !DEBUG! got the domain ($domain) of a message before the message id!");
}
}
#Exim::log_write("check_mail_permissions !DEBUG! found sender domain of message: $message_exim_id to be $domain with sender [$sender]");
$check_mail_permissions_msgid = $message_exim_id if $message_exim_id;
$check_mail_permissions_domain = $domain if $domain;
$check_mail_permissions_sender = $sender if $sender;
$check_mail_permissions_is_mailman = $is_mailman;
if ( $domain && $domain ne _SENDER_SYSTEM ) {
my $now;
# Just before we check to see if we've exceeded the allowable mail counts for this domain,
# check to see if we need to notify the admin about someone exceeding the warning level
my $mail_count = get_current_emails_per_day($domain) + 1; # +1 for the one we're *about* to send, but haven't yet!
my $emails_to_notify = get_email_daily_limit_notify();
if ( ( $emails_to_notify > 0 ) && ( $mail_count > $emails_to_notify ) ) {
if ( !file_exists( '/var/cpanel/email_send_limits/daily_notify/' . $domain ) ) {
create_daily_notify_touchfile($domain);
Exim::log_write("check_mail_permissions Hit daily email notify limit for domain $domain");
}
}
if ( file_exists( '/var/cpanel/email_send_limits/max_deferfail_' . $domain ) ) {
local $/;
my $limit_data;
if ( open( my $email_fh, '<', '/var/cpanel/email_send_limits/max_deferfail_' . $domain ) ) {
$limit_data = readline($email_fh);
close($email_fh);
}
my ( $currentmail, $maxmails, $percentage ) = $limit_data =~ /([0-9]+)\/([0-9]+)\s+\(([0-9]+)/;
$currentmail ||= 'unknown';
$maxmails ||= 'unknown';
$percentage ||= 100;
$enforce_mail_permissions_data = ":fail: Domain $domain has exceeded the max defers and failures per hour ($currentmail/$maxmails ($percentage\%)) allowed. Message discarded.";
return 'no';
}
elsif ( my $maxmails = getmaxemailsperhour($domain) ) {
my $currentmail = get_current_emails_per_hour( $domain, ( $now ||= time() ) );
if ( $currentmail >= $maxmails ) {
my $cutoff_percentage = get_email_send_limits_defer_cutoff();
my $percentage = int( ( $currentmail / $maxmails ) * 100 );
if ( $percentage >= $cutoff_percentage ) {
$enforce_mail_permissions_data = ":fail: Domain $domain has exceeded the max emails per hour ($currentmail/$maxmails ($percentage\%)) allowed. Message discarded.";
return 'no';
}
else {
increment_max_emails_per_hour( $domain, ( $now ||= time() ), $message_exim_id ); # need to count it because we will try it later
# this will result in percentages above 100% which may be confusing however correct
# this is how we decide to defer or fail the message
return _check_mail_permission_defer_with_message("Domain $domain has exceeded the max emails per hour ($currentmail/$maxmails ($percentage\%)) allowed. $reattempt_message");
}
}
}
if ( domain_has_outgoing_mail_suspended($domain) ) {
# We already check this in the ACL, however if the sender domain
# is forged we have to check it again here to ensure that
# we are checking against the actual sender and not the
# domain in the from: field
$enforce_mail_permissions_data = ":fail: Domain $domain has an outgoing mail suspension. Message discarded.";
return 'no';
}
elsif ( domain_has_outgoing_mail_hold($domain) ) {
track_held_message($domain);
return _check_mail_permission_defer_with_message("Domain $domain has an outgoing mail hold. $reattempt_message");
}
elsif ($sender) {
if ( user_has_outgoing_mail_suspended($sender) ) {
# We already check this in the ACL, however if the sender domain
# is forged we have to check it again here to ensure that
# we are checking against the actual sender and not the
# domain in the from: field
$enforce_mail_permissions_data = ":fail: Sender $sender has an outgoing mail suspension. Message discarded.";
return 'no';
}
elsif ( user_has_outgoing_mail_hold($sender) ) {
track_held_message($sender);
return _check_mail_permission_defer_with_message("Sender $sender has an outgoing mail hold. $reattempt_message");
}
}
}
$enforce_mail_permissions_data = ''; # permit normal action
$check_mail_permissions_result = "reached end of check_mail_permissions"; # for tests (only set when enforce_mail_permissions_data is empty)
return 'no';
}
sub _check_mail_permission_defer_with_message {
my ($message) = @_;
my $message_body = Exim::expand_string('$message_body');
my $message_body_size = Exim::expand_string('$message_body_size');
my $message_body_length = length($message_body);
$check_mail_permissions_data =
qq{# Exim filter\n\nunseen mail }
. ( $check_mail_permissions_sender ? qq{to } . Cpanel::Encoder::Exim::unquoted_encode_string_literal($check_mail_permissions_sender) . qq{\n} : '' )
. q{subject "Mail delivery deferred: returning message to sender" }
. q{from "Mail Delivery System <Mailer-Daemon@$primary_hostname>" }
. q{text "This message was created automatically by mail delivery software.\n} . q{\n}
. q{A message that you sent could not be delivered to one or more of its\n}
. q{recipients. This is a temporary error. The following address(es) deferred:\n} . q{\n}
. q{ $local_part@$domain\n}
. qq{ $message} . q{\n\n}
. q{------- This is a copy of the message, including all the headers. ------\n}
. ( ( $message_body_length < $message_body_size ) ? ( q{------ The body of the message is $message_body_size characters long; only the first\n} . q{------ } . $message_body_length . q{ or so are included here.\n} ) : () )
. q{$message_headers\n\n}
. q{$message_body"}
. qq{\nfinish};
$enforce_mail_permissions_data = ":defer: \"$message\"";
return 'yes';
}
sub domain_has_outgoing_mail_hold {
my ($domain) = @_;
my $user = getdomainowner($domain);
if ( $user && user_has_outgoing_mail_hold($user) ) {
return 1;
}
return 0;
}
sub domain_has_outgoing_mail_suspended {
my ($domain) = @_;
my $user = getdomainowner($domain);
if ( $user && user_has_outgoing_mail_suspended($user) ) {
return 1;
}
return 0;
}
sub user_has_outgoing_mail_suspended {
my ($user) = @_;
if ( -e '/etc/outgoing_mail_suspended_users' ) {
return user_exists_in_db( $user, '/etc/outgoing_mail_suspended_users' );
}
return 0;
}
sub user_has_outgoing_mail_hold {
my ($user) = @_;
if ( -e '/etc/outgoing_mail_hold_users' ) {
return user_exists_in_db( $user, '/etc/outgoing_mail_hold_users' );
}
return 0;
}
sub check_outgoing_mail_suspended {
if ( !Cpanel::Server::Type::Role::MailSend->is_enabled() && Exim::expand_string('$sender_host_address') ) {
$outgoing_mail_suspended_message = "This server does not relay mail.";
return 1;
}
my $uid = int( Exim::expand_string('$originator_uid') );
my $gid = int( Exim::expand_string('$originator_gid') );
my ( $sender, $real_domain, $domain, $is_mailman ) = get_message_sender( $uid, $gid, 0 );
if ( $real_domain && $real_domain ne _SENDER_SYSTEM && domain_has_outgoing_mail_suspended($real_domain) ) {
$outgoing_mail_suspended_message = "Outgoing mail from \"$real_domain\" has been suspended.";
return 1;
}
elsif ( $sender && user_has_outgoing_mail_suspended($sender) ) {
$outgoing_mail_suspended_message = "Outgoing mail from \"$sender\" has been suspended.";
return 1;
}
return 0;
}
sub get_outgoing_mail_suspended_message {
return $outgoing_mail_suspended_message;
}
sub increment_max_emails_per_hour_if_needed {
# Exim::log_write("!DEBUG! increment_max_emails_per_hour_if_needed entered");
if ( $check_mail_permissions_domain && $check_mail_permissions_domain ne _SENDER_SYSTEM ) {
if ( Exim::expand_string('${if first_delivery{1}{0}}') || ( $check_mail_permissions_msgid && _get_last_delivery_message($check_mail_permissions_msgid) =~ m/$reattempt_message/o ) ) {
# if FIRST_DELIVERY or last line of msglog is our $reattempt_message
# example == f@kos.net R=check_mail_permissions defer (-1): Domain pigdog.org has exceeded the max emails per hour (12/10 (120%)) allowed. Message will be reattempted later
# we need to tell the next function to charge us for the message since it was deferred before and we did not get here
# Exim::log_write("!DEBUG! increment_max_emails_per_hour=$check_mail_permissions_domain msgid=$check_mail_permissions_msgid");
increment_max_emails_per_hour( $check_mail_permissions_domain, time(), $check_mail_permissions_msgid );
}
}
return 'no';
}
sub store_spam {
my $sender_host_address = shift;
my $spam_score = shift;
my $now = time();
open( my $spam_fh, '>>', '/var/cpanel/spamstore' );
#uncomment to deploy
# syswrite($spam_fh, $now . ':' . $sender_host_address . ':' . $spam_score . ":.\n");
close($spam_fh);
}
sub _get_last_delivery_message {
my $message_exim_id = shift;
my ( $last_message, $msglog_file, $msglog_size );
my $spool_directory = Exim::expand_string('$spool_directory');
my $spool_split_directory = substr( ( split( /-/, $message_exim_id ) )[0], -1, 1 );
if ( file_exists("$spool_directory/msglog/$spool_split_directory/$message_exim_id") ) { #split spool
$msglog_size = ( stat(_) )[7];
$msglog_file = "$spool_directory/msglog/$spool_split_directory/$message_exim_id";
}
elsif ( file_exists("$spool_directory/msglog/$message_exim_id") ) { #not split
$msglog_size = ( stat(_) )[7];
$msglog_file = "$spool_directory/msglog/$message_exim_id";
}
if ( $msglog_file && open( my $msg_log_fh, '<', $msglog_file ) ) {
seek( $msg_log_fh, $msglog_size - 4096, 0 ) if $msglog_size > 8192;
local $/;
$last_message = ( split( /\n/, readline($msg_log_fh) ) )[-1];
}
# Exim::log_write("!DEBUG! _get_last_delivery_message for [$message_exim_id] is $last_message");
return $last_message || '';
}
sub resolve_authenticated_sender {
my ( $sender, $domain, $sender_lookup_method ) = @_;
my $sender_address = Exim::expand_string('$sender_address');
my $sender_address_domain = Exim::expand_string('$sender_address_domain');
# We only want to use the sender in the from header if they have already
# authenticated with at least the permissions of the account
my ( $from_h_sender, $from_h_localpart, $from_h_domain ) = _get_from_h_sender();
$primary_hostname ||= Exim::expand_string('$primary_hostname');
# The user expects to be able to just set the From: headers
# we try to accomodate that first if they have permissions on the account
if ( $from_h_domain eq $primary_hostname ) {
$sender_lookup_method .= "/primary_hostname/system user";
}
elsif ( $sender eq getdomainowner($from_h_domain) ) {
$sender = $from_h_localpart . '@' . $from_h_domain;
$domain = $from_h_domain;
$sender_lookup_method .= "/from_h";
}
# otherwise we fallback to the sender_address_domain
elsif ( $sender eq getdomainowner($sender_address_domain) ) {
$sender = $sender_address;
$domain = $sender_address_domain;
$sender_lookup_method .= "/sender_address_domain";
}
else {
# finally we accept that we don't know who sent it besdies the
# authenticated user
$sender_lookup_method .= "/only user confirmed/virtual account not confirmed";
}
return ( $sender, $domain, $sender_lookup_method );
}
sub resolve_vhost_owner {
if ( file_exists('/var/cpanel/config/email/trust_x_php_script') ) {
if ( my $x_php_script = Exim::expand_string('$h_x-php-script:') ) {
#X-PHP-Script: <servername><php-self> for <remote-addr>
#X-PHP-Script: www.example.com/~user/testapp/send-mail.php for 10.0.0.1
my ( $servername, $uri ) = split( m{/}, $x_php_script, 2 );
if ( $uri =~ m/^\/?\~([^\/\s]+)/ ) {
my $http_user = $1;
my $uid = user2uid($http_user);
Exim::log_write("nobody send identification H=localhost A=127.0.0.1 U=$http_user ID=$uid B=acl_c_vhost_owner M=trust_x_php_script");
return $uid . ':' . '//' . $servername . '/' . $uri . ' ';
}
elsif ( my $http_user = getdomainowner($servername) ) {
my $uid = user2uid($http_user);
Exim::log_write("nobody send identification H=localhost A=127.0.0.1 U=$http_user ID=$uid B=acl_c_vhost_owner M=trust_x_php_script");
return $uid . ':' . '//' . $servername . '/' . $uri . ' ';
}
}
}
if ( file_exists('/var/cpanel/config/email/query_apache_for_nobody_senders') ) {
# Lets lookup the real uid by querying apache
require Cpanel::ProcessInfo;
require Cpanel::ApacheServerStatus;
my $server_status = Cpanel::ApacheServerStatus->new();
my $httpd_pid;
my $http_status_data;
my $current_pid = $$;
while ( ( $current_pid = Cpanel::ProcessInfo::get_parent_pid($current_pid) ) && $current_pid != 1 ) {
if ( my $status_data = $server_status->get_status_by_pid($current_pid) ) {
$httpd_pid = $current_pid;
$http_status_data = $status_data;
last;
}
}
if ($http_status_data) {
my $uri = ( split( /\s+/, $http_status_data->{'request'} ) )[1];
if ( $uri =~ m/^\/?\~([^\/\s]+)/ ) {
my $http_user = $1;
my $uid = user2uid($http_user);
Exim::log_write("nobody send identification H=localhost A=127.0.0.1 U=$http_user ID=$uid B=acl_c_vhost_owner M=query_apache_for_nobody_senders");
return $uid . ':' . '//' . $http_status_data->{'vhost'} . $uri . ' ';
}
elsif ( my $http_user = getdomainowner( $http_status_data->{'vhost'} ) ) {
my $uid = user2uid($http_user);
Exim::log_write("nobody send identification H=localhost A=127.0.0.1 U=$http_user ID=$uid B=acl_c_vhost_owner M=query_apache_for_nobody_senders");
return $uid . ':' . '//' . $http_status_data->{'vhost'} . $uri . ' ';
}
}
}
return;
}
# Obtain the from header from the message
# We fallback to the envelope sender if there
# is no from header set (ie sendmail -bt or missing From header)
sub _get_from_h_sender {
my $from_h_domain = Exim::expand_string('${domain:$h_from:}');
my $from_h_local_part = Exim::expand_string('${local_part:$h_from:}');
if ( length $from_h_local_part ) {
if ( length $from_h_domain ) {
return ( $from_h_local_part . '@' . $from_h_domain, $from_h_local_part, $from_h_domain );
}
else {
$primary_hostname ||= Exim::expand_string('$primary_hostname');
return ( $from_h_local_part . '@' . $primary_hostname, $from_h_local_part, $primary_hostname );
}
}
else {
# Handle fallback to sender_address when message is missing a from header
my $sender_address_domain = Exim::expand_string('$sender_address_domain');
my $sender_address_local_part = Exim::expand_string('$sender_address_local_part');
return ( $sender_address_local_part . '@' . $sender_address_domain, $sender_address_local_part, $sender_address_domain );
}
}
my $email_holds_dir = '/var/cpanel/email_holds';
sub track_held_message {
my ($holder) = @_;
if ( -1 != index( $holder, '/' ) ) {
warn "Holder “$holder” should not have “/” in it!";
$holder =~ s/\///g; #jic
}
my $message_exim_id = Exim::expand_string('$message_exim_id');
_check_hold_dir($holder);
my $path = "$email_holds_dir/track/$holder/$message_exim_id";
if ( !-e $path ) {
if ( $! == _ENOENT() ) {
open( my $fh, '>>', $path ) or do {
warn "open(>>, $path): $!";
};
}
else {
warn "stat($path): $!";
}
}
return 1;
}
sub _mkdir_if_not_exists_or_warn {
my ( $path, $mode ) = @_;
mkdir( $path, $mode ) or do {
if ( $! != _EEXIST() ) {
warn "mkdir($path, $mode): $!";
}
return undef;
};
return 1;
}
sub _check_hold_dir {
my ($holder) = @_;
if ( !-e "$email_holds_dir/track/$holder" ) {
if ( $! == _ENOENT() ) {
_mkdir_if_not_exists_or_warn( $email_holds_dir, 0751 );
_mkdir_if_not_exists_or_warn( "$email_holds_dir/track", 0750 );
_mkdir_if_not_exists_or_warn( "$email_holds_dir/track/$holder", 0750 );
}
else {
warn "stat($email_holds_dir/track/$holder): $!";
}
}
return;
}
=head2 maskdir($dir)
This function converts a path on the system to a path relative to the users home directory that it contains. The relative path is prefixed with the user's primary domain in the below format:
domain.tld:/public_html/cgi-bin/xyz.cgi
If the path is not contained within a user's home directory, the path is returned without modification.
=cut
sub maskdir {
my ($dir) = @_;
# Try the user first
my $maskeddir = $dir;
my ($likely_user) = ( split( m{/}, $dir ) )[2];
if ( my $likely_homedir = gethomedir($likely_user) ) {
chop $likely_homedir if substr( $likely_homedir, -1 ) eq '/';
if ( rindex( $dir, "$likely_homedir/", 0 ) == 0 ) {
substr( $maskeddir, 0, length($likely_homedir), getusersdomain($likely_user) . ":" );
return $maskeddir;
}
}
# Next try all users in /etc/passwd
if ( open my $passwd_fh, '<', "/etc/passwd" ) {
while ( readline($passwd_fh) ) {
my ( $homedir, $uid, $user ) = ( split( /:/, $_ ) )[ 0, 2, 5 ];
next if $uid < 100 || length $homedir < 3;
chop $homedir if substr( $homedir, -1 ) eq '/';
if ( rindex( $dir, "$homedir/", 0 ) == 0 ) {
substr( $maskeddir, 0, length($homedir), getusersdomain($user) . ":" );
return $maskeddir;
}
}
}
else {
warn "open(/etc/passwd): $!";
}
return $dir;
}
sub extract_hosts_from_route_list_item {
my $item = shift;
my (undef, $hosts, undef) = Exim::parse_route_item($item);
return $hosts;
}
sub convert_to_hostlist_item {
my ($item, $separator) = @_;
$separator //= '\n';
$item =~ s/^\s+//;
$item =~ s/\s+$//;
# Ignore group separator:
if ($item eq '+') {
$item = '';
}
# Extract bracketed IP address:
elsif ( $item !~ s/^\[(\S*)\]:\d+$/$1/ ) {
# If nothing subbed, what's left is an unbracketed IPv4 or a hostname.
# Remove port if present:
$item =~ s/:\d+$//;
# Finally, if the hostname specified /mx, do a lookup of its MX records and sub in the entire list:
if ($item =~ s{^(\S+)/mx$}{$1}i) {
$item = Exim::expand_string('${lookup dnsdb{>' . $separator . ' mxh=' . $item . '}{$value}}');
}
}
return $item;
}
sub get_suspended_shell {
my ($user) = @_;
my $passwd_file_shell = Exim::expand_string( '${extract{6}{:}{${lookup passwd{' . Cpanel::Encoder::Exim::unquoted_encode_string_literal($user) . '}}}}' );
if ( !length($passwd_file_shell) ) {
return '';
}
if ( $passwd_file_shell ne '/bin/false' ) {
return $passwd_file_shell;
}
if ( open my $fh, '<', "/var/cpanel/suspendinfo/${user}" ) {
while ( my $ln = readline($fh) ) {
if ( $ln =~ m{\Ashell=\s*(\S+)} ) {
close $fh;
return $1;
}
}
close $fh;
}
return '/usr/local/cpanel/bin/noshell';
}
sub is_temp_domain {
my ($domain) = @_;
if ( length $domain ) {
require Cpanel::IP::AutoDomain::TemporaryDomain::Check;
return 1 if Cpanel::IP::AutoDomain::TemporaryDomain::Check::domain_is_temporary_subdomain($domain);
}
return 0;
}
# Untaint a string for exim. This is not a perl untaint
sub untaint {
return $_[0];
}
require Cpanel::Encoder::Exim;
require Cpanel::Server::Type::Role::MailRelay;
require Cpanel::Server::Type::Role::MailSend;
1;
BEGIN { # Suppress load of all of these at earliest point.
$INC{'cPstrict.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Encoder/Exim.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ExceptionMessage.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Locale/Utils/Fallback.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ExceptionMessage/Raw.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/LoadModule/Utils.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ScalarUtil.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Exception/CORE.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Pack.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Pack/Template.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/IP/v4.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/IP.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/IP/Expand.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/Expand.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Linux/Netlink.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Linux/Proc/Net/Tcp.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Ident.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Autodie.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Autodie/CORE/exists.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Autodie/CORE/exists_nofollow.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Autodie/More/Lite.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Services/Enabled/Spamd.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FileUtils/Dir.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/DKIM/ValidityCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Context.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ProcessInfo.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Fcntl/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Socket/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Hulk/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ApacheServerStatus.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Sys/Uname.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Sys/Hostname/Fallback.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/LoadFile/ReadFast.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/LoadFile.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Time/Local.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Fcntl.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FileUtils/Open.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Parser/Vars.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Encoder/Tiny/Rare.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Encoder/Tiny.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Regex.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Carp.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Set.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/TimeHiRes.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeFileLock.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FHUtils/Tiny.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Hash.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeFile/LockInfoCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeFile/LockWatcher.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Syscall.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Inotify.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeFile.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/LoadModule.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Linux/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/FilesystemNodeName.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Notify.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Utils.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Logger.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Debug.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Sys/Hostname.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Hostname.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NAT/Object.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NAT.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Struct/Common/Time.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Struct/timespec.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NanoStat.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NanoUtime.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/HiRes.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Path/Normalize.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/JSON/Unicode.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Encoder/ASCII.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/UTF8/Strict.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/JSON.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/JSON/FailOK.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Hash/Stringify.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Destruct.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Finally.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Readlink.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FileUtils/Write.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FileUtils/Write/JSON/Lazy.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/AdminBin/Serializer.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/AdminBin/Serializer/FailOK.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SV.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Umask.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Config/LoadConfig.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Config/LoadWwwAcctConf.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/StatCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NSCD/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Socket/UNIX/Micro.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/NSCD/Check.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/PwCache/Helpers.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/PwCache/Cache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/PwCache/Find.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/PwCache/Build.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/PwCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeDir/MK.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/CachedCommand/Utils.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FindBin.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/CachedCommand/Valid.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/CachedCommand/Save.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/LocaleString.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Errno.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Config/Constants/Perl.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ChildErrorStringifier.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Env.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FHUtils/Autoflush.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FHUtils/OS.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FHUtils/Blocking.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IO/Flush.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ReadMultipleFH.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/ForkAsync.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeRun/Object.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/SafeRun/Env.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/CachedCommand.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/GlobalCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/NonlocalBind/Cache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/FileUtils/TouchFile.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Linux/NetlinkConstants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Linux/RtNetlink.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/Loopback.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/Configured.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/Bound.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/DIp/MainIP.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/StringFunc/Trim.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Encoder/Punycode.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/Domain/Tiny.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/Domain/Normalize.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/AutoDomain/Base.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Version/Tiny.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Version/Full.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Version/Compare.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Version.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/AutoDomain.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/AutoDomain/TemporaryDomain/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/YAML/Syck.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/YAML.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Transaction/File/Read/YAML.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Transaction/File/BaseReader.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Transaction/File/YAMLReader.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Transaction/File/Read/JSON.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Transaction/File/JSONReader.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/IP/AutoDomain/TemporaryDomain/Check.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Profile/Constants.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Validate/AnyAllMatcher.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Profile.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Role/EnabledCache.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Role.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Role/TouchFileRole.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Role/MailRelay.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
$INC{'Cpanel/Server/Type/Role/MailSend.pm'} = '/usr/local/cpanel/tmp/exim.local.build.pl.static';
}
{ # --- BEGIN cPstrict
package cPstrict;
# Copyright 2024 WebPros International, LLC
# All rights reserved.
# copyright@cpanel.net http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited.
use strict;
use warnings;
=pod
This is importing the following to your namespace
use strict;
use warnings;
use v5.30;
use feature 'signatures';
no warnings 'experimental::signatures';
=cut
sub import {
if ( $] < 5.030 ) {
require Carp;
Carp::confess("cPstrict is being loaded from an unsupported perl ($^X)");
}
# auto import strict and warnings to our caller
warnings->import();
strict->import();
require feature;
feature->import( ':5.30', 'signatures' );
warnings->unimport('experimental::signatures');
return;
}
1;
} # --- END cPstrict
{ # --- BEGIN Cpanel/Encoder/Exim.pm
package Cpanel::Encoder::Exim;
my %encodes = (
q{\\} => q{\\\\\\\\}, #\ -> \\\\
q{"} => q{\\"}, #" -> \"
q{$} => q{\\\\$}, #$ -> \\$
"\x0a" => q{\\n}, #newline -> \n
"\x0d" => q{\\r}, #carriage return -> \r
"\x09" => q{\\t}, #tab => \t
);
sub encode_string_literal {
return if !defined $_[0];
return q{"} . join( q{}, map { $encodes{$_} || $_ } split( m{}, $_[0] ) ) . q{"};
}
sub unquoted_encode_string_literal {
my $string = shift;
return if !defined $string;
$string =~ s/\\N/\\N\\\\N\\N/g; # Only use / here for perl compat
return "\\N$string\\N";
}
1;
} # --- END Cpanel/Encoder/Exim.pm
{ # --- BEGIN Cpanel/ExceptionMessage.pm
package Cpanel::ExceptionMessage;
use strict;
# use Cpanel::Exception (); # perlpkg line 211
*load_perl_module = \&Cpanel::Exception::load_perl_module;
1;
} # --- END Cpanel/ExceptionMessage.pm
{ # --- BEGIN Cpanel/Locale/Utils/Fallback.pm
package Cpanel::Locale::Utils::Fallback;
use strict;
use warnings;
no warnings 'once';
sub interpolate_variables {
my ( $str, @maketext_opts ) = @_;
my $c = 1;
my %h = map { $c++, $_ } @maketext_opts;
$str =~ s{(\[(?:[^_]+,)?_([0-9])+\])}{$h{$2}}g;
return $str;
}
1;
} # --- END Cpanel/Locale/Utils/Fallback.pm
{ # --- BEGIN Cpanel/ExceptionMessage/Raw.pm
package Cpanel::ExceptionMessage::Raw;
use strict;
use warnings;
no warnings 'once';
# use base Cpanel::ExceptionMessage (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::ExceptionMessage); }
# use Cpanel::Locale::Utils::Fallback (); # perlpkg line 211
sub new {
my ( $class, $str ) = @_;
my $str_copy = $str;
return bless( \$str_copy, $class );
}
sub to_string {
my ($self) = @_;
return $$self;
}
sub get_language_tag {
return 'en';
}
BEGIN {
*Cpanel::ExceptionMessage::Raw::convert_localized_to_raw = *Cpanel::Locale::Utils::Fallback::interpolate_variables;
*Cpanel::ExceptionMessage::Raw::to_locale_string = *Cpanel::ExceptionMessage::Raw::to_string;
*Cpanel::ExceptionMessage::Raw::to_en_string = *Cpanel::ExceptionMessage::Raw::to_string;
}
1;
} # --- END Cpanel/ExceptionMessage/Raw.pm
{ # --- BEGIN Cpanel/LoadModule/Utils.pm
package Cpanel::LoadModule::Utils;
use strict;
use warnings;
no warnings 'once';
sub module_is_loaded {
my $p = module_path( $_[0] );
return 0 unless defined $p;
return defined $INC{$p} ? 1 : 0;
}
sub module_path {
my ($module_name) = @_;
if ( defined $module_name && length($module_name) ) {
substr( $module_name, index( $module_name, '::' ), 2, '/' ) while index( $module_name, '::' ) > -1;
$module_name .= '.pm' unless substr( $module_name, -3 ) eq '.pm';
}
return $module_name;
}
sub is_valid_module_name {
return $_[0] =~ m/\A[A-Za-z_]\w*(?:(?:'|::)\w+)*\z/ ? 1 : 0;
}
1;
} # --- END Cpanel/LoadModule/Utils.pm
{ # --- BEGIN Cpanel/ScalarUtil.pm
package Cpanel::ScalarUtil;
use strict;
use warnings;
no warnings 'once';
sub blessed {
return ref( $_[0] ) && UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) || undef;
}
1;
} # --- END Cpanel/ScalarUtil.pm
{ # --- BEGIN Cpanel/Exception/CORE.pm
package Cpanel::Exception::CORE;
1;
package Cpanel::Exception;
use strict;
BEGIN {
$INC{'Cpanel/Exception.pm'} = '__BYPASSED__';
}
our $_SUPPRESS_STACK_TRACES = 0;
our $_EXCEPTION_MODULE_PREFIX = 'Cpanel::Exception';
our $IN_EXCEPTION_CREATION = 0;
our $_suppressed_msg = '__STACK_TRACE_SUPPRESSED__YOU_SHOULD_NEVER_SEE_THIS_MESSAGE__';
my $PACKAGE = 'Cpanel::Exception';
my $locale;
my @ID_CHARS = qw( a b c d e f g h j k m n p q r s t u v w x y z 2 3 4 5 6 7 8 9 );
my $ID_LENGTH = 6;
# use Cpanel::ExceptionMessage::Raw (); # perlpkg line 211
# use Cpanel::LoadModule::Utils (); # perlpkg line 211
use constant _TRUE => 1;
use overload (
'""' => \&__spew,
bool => \&_TRUE,
fallback => 1,
);
BEGIN {
die "Cannot compile Cpanel::Exception::CORE" if $INC{'B/C.pm'} && $0 !~ m{cpkeyclt|cpsrvd\.so|t/large};
}
sub _init { return 1 } # legacy
sub create {
my ( $exception_type, @args ) = @_;
_init();
if ($IN_EXCEPTION_CREATION) {
_load_cpanel_carp();
die 'Cpanel::Carp'->can('safe_longmess')->("Attempted to create a “$exception_type” exception with arguments “@args” while creating exception “$IN_EXCEPTION_CREATION->[0]” with arguments “@{$IN_EXCEPTION_CREATION->[1]}”.");
}
local $IN_EXCEPTION_CREATION = [ $exception_type, \@args ];
if ( $exception_type !~ m/\A[A-Za-z0-9_]+(?:\:\:[A-Za-z0-9_]+)*\z/ ) {
die "Invalid exception type: $exception_type";
}
my $perl_class;
if ( $exception_type eq __PACKAGE__ ) {
$perl_class = $exception_type;
}
else {
$perl_class = "${_EXCEPTION_MODULE_PREFIX}::$exception_type";
}
_load_perl_module($perl_class) unless $perl_class->can('new');
if ( $args[0] && ref $args[0] eq 'ARRAY' && scalar @{ $args[0] } > 1 ) {
$args[0] = { @{ $args[0] } };
}
return $perl_class->new(@args);
}
sub create_raw {
my ( $class, $msg, @extra_args ) = @_;
_init();
my $msg_obj = 'Cpanel::ExceptionMessage::Raw'->new($msg);
if ( $class =~ m<\A(?:\Q${_EXCEPTION_MODULE_PREFIX}::\E)?Collection\z> ) {
die "Use create('Collection', ..) to create a Cpanel::Exception::Collection object.";
}
return create( $class, $msg_obj, @extra_args );
}
sub _load_perl_module {
my ($module) = @_;
local ( $!, $@ );
if ( !defined $module ) {
die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module requires a module name.") );
}
return 1 if Cpanel::LoadModule::Utils::module_is_loaded($module);
my $module_name = $module;
$module_name =~ s{\.pm$}{};
if ( !Cpanel::LoadModule::Utils::is_valid_module_name($module_name) ) {
die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module requires a valid module name: '$module_name'.") );
}
{
eval qq{use $module (); 1 }
or die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module cannot load '$module_name': $@") )
}
return 1;
}
sub new {
my ( $class, @args ) = @_;
@args = grep { defined } @args;
my $self = {};
bless $self, $class;
if ( ref $args[-1] eq 'HASH' ) {
$self->{'_metadata'} = pop @args;
}
if ( defined $self->{'_metadata'}->{'longmess'} ) {
$self->{'_longmess'} = &{ $self->{'_metadata'}->{'longmess'} }($self)
if $self->{'_metadata'}->{'longmess'};
}
elsif ($_SUPPRESS_STACK_TRACES) {
$self->{'_longmess'} = $_suppressed_msg;
}
else {
if ( !$INC{'Carp.pm'} ) { _load_carp(); }
$self->{'_longmess'} = scalar do {
local $Carp::CarpInternal{'Cpanel::Exception'} = 1;
local $Carp::CarpInternal{$class} = 1;
'Carp'->can('longmess')->();
};
}
_init();
$self->{'_auxiliaries'} = [];
if ( UNIVERSAL::isa( $args[0], 'Cpanel::ExceptionMessage' ) ) {
$self->{'_message'} = shift @args;
}
else {
my @mt_args;
if ( @args && !ref $args[0] ) {
@mt_args = ( shift @args );
if ( ref $args[0] eq 'ARRAY' ) {
push @mt_args, @{ $args[0] };
}
}
else {
$self->{'_orig_mt_args'} = $args[0];
my $phrase = $self->_default_phrase( $args[0] );
if ($phrase) {
if ( ref $phrase ) {
@mt_args = $phrase->to_list();
}
else {
$self->{'_message'} = Cpanel::ExceptionMessage::Raw->new($phrase);
return $self;
}
}
}
if ( my @extras = grep { !ref } @args ) {
die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("Extra scalar(s) passed to $PACKAGE! (@extras)") );
}
if ( !length $mt_args[0] ) {
die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("No args passed to $PACKAGE constructor!") );
}
$self->{'_mt_args'} = \@mt_args;
}
return $self;
}
sub get_string {
my ( $exc, $no_id_yn ) = @_;
return get_string_no_id($exc) if $no_id_yn;
return _get_string( $exc, 'to_string' );
}
sub get_string_no_id {
my ($exc) = @_;
return _get_string( $exc, 'to_string_no_id' );
}
sub _get_string {
my ( $exc, $cp_exc_stringifier_name ) = @_;
return $exc if !ref $exc;
{
local $@;
my $ret = eval { $exc->$cp_exc_stringifier_name() };
return $ret if defined $ret && !$@ && !ref $ret;
}
if ( ref $exc eq 'HASH' && $exc->{'message'} ) {
return $exc->{'message'};
}
if ( $INC{'Cpanel/YAML.pm'} ) {
local $@;
my $ret = eval { 'Cpanel::YAML'->can('Dump')->($exc); };
return $ret if defined $ret && !$@;
}
if ( $INC{'Cpanel/JSON.pm'} ) {
local $@;
my $ret = eval { 'Cpanel::JSON'->can('Dump')->($exc); };
return $ret if defined $ret && !$@;
}
return $exc;
}
sub _create_id {
srand();
return join(
q<>,
map { $ID_CHARS[ int rand( 0 + @ID_CHARS ) ]; } ( 1 .. $ID_LENGTH ),
);
}
sub get_stack_trace_suppressor {
return Cpanel::Exception::_StackTraceSuppression->new();
}
sub set_id {
my ( $self, $new_id ) = @_;
$self->{'_id'} = $new_id;
return $self;
}
sub id {
my ($self) = @_;
return $self->{'_id'} ||= _create_id();
}
sub set {
my ( $self, $key ) = @_;
$self->{'_metadata'}{$key} = $_[2];
if ( exists $self->{'_orig_mt_args'} ) {
my $phrase = $self->_default_phrase( $self->{'_orig_mt_args'} );
if ($phrase) {
if ( ref $phrase ) {
$self->{'_mt_args'} = [ $phrase->to_list() ];
undef $self->{'_message'};
}
else {
$self->{'_message'} = Cpanel::ExceptionMessage::Raw->new($phrase);
}
}
}
return $self;
}
sub get {
my ( $self, $key ) = @_;
my $v = $self->{'_metadata'}{$key};
if ( my $reftype = ref $v ) {
local $@;
if ( $reftype eq 'HASH' ) {
$v = { %{$v} }; # shallow copy
}
elsif ( $reftype eq 'ARRAY' ) {
$v = [ @{$v} ]; # shallow copy
}
elsif ( $reftype eq 'SCALAR' ) {
$v = \${$v}; # shallow copy
}
else {
local ( $@, $! );
require Cpanel::ScalarUtil;
if ( $reftype ne 'GLOB' && !Cpanel::ScalarUtil::blessed($v) ) {
warn if !eval {
_load_perl_module('Clone') if !$INC{'Clone.pm'};
$v = 'Clone'->can('clone')->($v);
};
}
}
}
return $v;
}
sub get_all_metadata {
my $self = shift;
my %metadata_copy;
for my $key ( keys %{ $self->{'_metadata'} } ) {
$metadata_copy{$key} = $self->get($key);
}
return \%metadata_copy;
}
my $loaded_LocaleString;
sub _require_LocaleString {
return $loaded_LocaleString ||= do {
local $@;
eval 'require Cpanel::LocaleString; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) - # PPI NO PARSE - load on demand
1;
};
}
my $loaded_ExceptionMessage_Locale;
sub _require_ExceptionMessage_Locale {
return $loaded_ExceptionMessage_Locale ||= do {
local $@;
eval 'require Cpanel::ExceptionMessage::Locale; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) - # PPI NO PARSE - load on demand
1;
};
}
sub _default_phrase {
_require_LocaleString();
return 'Cpanel::LocaleString'->new( 'An unknown error in the “[_1]” package has occurred.', scalar ref $_[0] ); # PPI NO PARSE - loaded above
}
sub longmess {
my ($self) = @_;
return '' if $self->{'_longmess'} eq $_suppressed_msg;
_load_cpanel_carp() if !$INC{'Cpanel/Carp.pm'};
return Cpanel::Carp::sanitize_longmess( $self->{'_longmess'} );
}
sub to_string {
my ($self) = @_;
return _apply_id_prefix( $self->id(), $self->to_string_no_id() );
}
sub to_string_no_id {
my ($self) = @_;
my $string = $self->to_locale_string_no_id();
if ( $self->_message()->get_language_tag() ne 'en' ) {
my $en_string = $self->to_en_string_no_id();
$string .= "\n$en_string" if ( $en_string ne $string );
}
return $string;
}
sub _apply_id_prefix {
my ( $id, $msg ) = @_;
return sprintf "(XID %s) %s", $id, $msg;
}
sub to_en_string {
my ($self) = @_;
return _apply_id_prefix( $self->id(), $self->to_en_string_no_id() );
}
sub to_en_string_no_id {
my ($self) = @_;
return $self->_message()->to_en_string() . $self->_stringify_auxiliaries('to_en_string');
}
sub to_locale_string {
my ($self) = @_;
return _apply_id_prefix( $self->id(), $self->to_locale_string_no_id() );
}
sub to_locale_string_no_id {
my ($self) = @_;
return $self->_message()->to_locale_string() . $self->_stringify_auxiliaries('to_locale_string');
}
sub add_auxiliary_exception {
my ( $self, $aux ) = @_;
return push @{ $self->{'_auxiliaries'} }, $aux;
}
sub get_auxiliary_exceptions {
my ($self) = @_;
die 'List context only!' if !wantarray; #Can’t use Cpanel::Context
return @{ $self->{'_auxiliaries'} };
}
sub __spew {
my ($self) = @_;
return $self->_spew();
}
sub _spew {
my ($self) = @_;
return ref($self) . '/' . join "\n", $self->to_string() || '<no message>', $self->longmess() || ();
}
sub _stringify_auxiliaries {
my ( $self, $method ) = @_;
my @lines;
if ( @{ $self->{'_auxiliaries'} } ) {
local $@;
_require_LocaleString();
my $intro = 'Cpanel::LocaleString'->new( 'The following additional [numerate,_1,error,errors] occurred:', 0 + @{ $self->{'_auxiliaries'} } ); # PPI NO PARSE - required above
if ( $method eq 'to_locale_string' ) {
push @lines, _locale()->makevar( $intro->to_list() );
}
elsif ( $method eq 'to_en_string' ) {
push @lines, _locale()->makethis_base( $intro->to_list() );
}
else {
die "Invalid method: $method";
}
push @lines, map { UNIVERSAL::isa( $_, __PACKAGE__ ) ? $_->$method() : $_ } @{ $self->{'_auxiliaries'} };
}
return join q<>, map { "\n$_" } @lines;
}
*TO_JSON = \&to_string;
sub _locale {
return $locale ||= do {
local $@;
eval 'require Cpanel::Locale; 1;' or die $@;
'Cpanel::Locale'->get_handle(); # hide from perlcc
};
}
sub _reset_locale {
return undef $locale;
}
sub _load_carp {
if ( !$INC{'Carp.pm'} ) {
local $@;
eval 'require Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc
}
return;
}
sub _load_cpanel_carp {
if ( !$INC{'Cpanel/Carp.pm'} ) {
local $@;
eval 'require Cpanel::Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc
}
return;
}
sub _message {
my ($self) = @_;
return $self->{'_message'} if $self->{'_message'};
local $!;
if ($Cpanel::Exception::LOCALIZE_STRINGS) { # the default
_require_ExceptionMessage_Locale();
return ( $self->{'_message'} ||= 'Cpanel::ExceptionMessage::Locale'->new( @{ $self->{'_mt_args'} } ) ); # PPI NO PARSE - required above
}
return ( $self->{'_message'} ||= Cpanel::ExceptionMessage::Raw->new( Cpanel::ExceptionMessage::Raw::convert_localized_to_raw( @{ $self->{'_mt_args'} } ) ) );
}
package Cpanel::Exception::_StackTraceSuppression;
sub new {
my ($class) = @_;
$Cpanel::Exception::_SUPPRESS_STACK_TRACES++;
return bless [], $class;
}
sub DESTROY {
$Cpanel::Exception::_SUPPRESS_STACK_TRACES--;
return;
}
1;
} # --- END Cpanel/Exception/CORE.pm
{ # --- BEGIN Cpanel/Pack.pm
package Cpanel::Pack;
use strict;
sub new {
my ( $class, $template_ar ) = @_;
if ( @$template_ar % 2 ) {
die "Cpanel::Pack::new detected an odd number of elements in hash assignment!";
}
my $self = bless {
'template_str' => '',
'keys' => [],
}, $class;
my $ti = 0;
while ( $ti < $#$template_ar ) {
push @{ $self->{'keys'} }, $template_ar->[$ti];
$self->{'template_str'} .= $template_ar->[ 1 + $ti ];
$ti += 2;
}
return $self;
}
sub unpack_to_hashref { ## no critic (RequireArgUnpacking)
my %result;
@result{ @{ $_[0]->{'keys'} } } = unpack( $_[0]->{'template_str'}, $_[1] );
return \%result;
}
sub pack_from_hashref {
my ( $self, $opts_ref ) = @_;
no warnings 'uninitialized';
return pack( $self->{'template_str'}, @{$opts_ref}{ @{ $self->{'keys'} } } );
}
sub sizeof {
my ($self) = @_;
return ( $self->{'sizeof'} ||= length pack( $self->{'template_str'}, () ) );
}
sub malloc {
my ($self) = @_;
return pack( $self->{'template_str'} );
}
1;
} # --- END Cpanel/Pack.pm
{ # --- BEGIN Cpanel/Pack/Template.pm
package Cpanel::Pack::Template;
use strict;
use warnings;
no warnings 'once';
use constant PACK_TEMPLATE_INT => 'i';
use constant PACK_TEMPLATE_UNSIGNED_INT => 'i!';
use constant PACK_TEMPLATE_UNSIGNED_LONG => 'L!';
use constant PACK_TEMPLATE_U32 => 'L';
use constant U32_BYTES_LENGTH => 4;
use constant PACK_TEMPLATE_U16 => 'S';
use constant U16_BYTES_LENGTH => 2;
use constant PACK_TEMPLATE_U8 => 'C';
use constant U8_BYTES_LENGTH => 1;
use constant PACK_TEMPLATE_BE16 => 'n';
use constant PACK_TEMPLATE_BE32 => 'N';
1;
} # --- END Cpanel/Pack/Template.pm
{ # --- BEGIN Cpanel/Validate/IP/v4.pm
package Cpanel::Validate::IP::v4;
use strict;
use warnings;
no warnings 'once';
sub is_valid_ipv4 {
my ($ip) = @_;
return unless $ip; # False scalars are never an _[0].
my @segments = split /\./, $ip, -1;
return unless scalar @segments == 4;
my $octet_index;
for my $octet_value (@segments) {
return if !_valid_octet( $octet_value, ++$octet_index );
}
return 1;
}
sub is_valid_cidr4 {
my ($ip) = @_;
return unless defined $ip && $ip;
my ( $ip4, $mask ) = split /\//, $ip;
return if !defined $mask || !length $mask || $mask =~ tr/0-9//c;
return is_valid_ipv4($ip4) && 0 < $mask && $mask <= 32;
}
sub _valid_octet {
my ( $octet_value, $octet_index ) = @_;
return (
!length $octet_value || #
$octet_value =~ tr/0-9//c || #
$octet_value > 255 || #
( substr( $octet_value, 0, 1 ) == 0 && length($octet_value) > 1 ) || # Only dec values are permitted
$octet_index == 1 && length($octet_value) && !$octet_value # First oct can't be zero.
) ? 0 : 1;
}
1;
} # --- END Cpanel/Validate/IP/v4.pm
{ # --- BEGIN Cpanel/Validate/IP.pm
package Cpanel::Validate::IP;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
sub is_valid_ipv6 {
my ($ip) = @_;
return unless defined $ip && $ip;
if ( ( substr( $ip, 0, 1 ) eq ':' && substr( $ip, 1, 1 ) ne ':' )
|| ( substr( $ip, -1, 1 ) eq ':' && substr( $ip, -2, 1 ) ne ':' ) ) {
return; # Can't have single : on front or back
}
my @seg = split /:/, $ip, -1; # -1 to keep trailing empty fields
shift @seg if $seg[0] eq '';
pop @seg if $seg[-1] eq '';
my $max = 8;
if ( index( $seg[-1], '.' ) > -1 ) {
return unless Cpanel::Validate::IP::v4::is_valid_ipv4( pop @seg );
$max -= 2;
}
my $cmp;
for my $seg (@seg) {
if ( !defined $seg || $seg eq '' ) {
return if $cmp;
++$cmp;
next;
}
return if $seg =~ tr/0-9a-fA-F//c || length $seg == 0 || length $seg > 4;
}
if ($cmp) {
return ( @seg && @seg <= $max ) && 1; # true returned as 1
}
return $max == @seg;
}
sub is_valid_ipv6_prefix {
my ($ip) = @_;
return unless $ip;
my ( $ip6, $mask ) = split /\//, $ip;
return unless defined $mask;
return if !length $mask || $mask =~ tr/0-9//c;
return is_valid_ipv6($ip6) && 0 < $mask && $mask <= 128;
}
sub is_valid_ip {
return !defined $_[0] ? undef : index( $_[0], ':' ) > -1 ? is_valid_ipv6(@_) : Cpanel::Validate::IP::v4::is_valid_ipv4(@_);
}
sub ip_version {
return 4 if Cpanel::Validate::IP::v4::is_valid_ipv4(@_);
return 6 if is_valid_ipv6(@_);
return;
}
sub is_valid_ip_cidr_or_prefix {
return unless defined $_[0];
if ( $_[0] =~ tr/:// ) {
return $_[0] =~ tr{/}{} ? is_valid_ipv6_prefix(@_) : is_valid_ipv6(@_);
}
return $_[0] =~ tr{/}{} ? Cpanel::Validate::IP::v4::is_valid_cidr4(@_) : Cpanel::Validate::IP::v4::is_valid_ipv4(@_);
}
sub is_valid_ip_range_cidr_or_prefix {
my $str = shift;
return 0 if !$str;
return 1 if is_valid_ip_cidr_or_prefix($str);
my @pieces = split /-/, $str, 2;
return 1 if 2 == grep { defined($_) } map { Cpanel::Validate::IP::v4::is_valid_ipv4($_) } @pieces;
return 1 if 2 == grep { defined($_) } map { is_valid_ipv6($_) } @pieces;
return 0;
}
1;
} # --- END Cpanel/Validate/IP.pm
{ # --- BEGIN Cpanel/Validate/IP/Expand.pm
package Cpanel::Validate::IP::Expand;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Validate::IP (); # perlpkg line 211
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
sub normalize_ipv4 {
return unless Cpanel::Validate::IP::v4::is_valid_ipv4( $_[0] );
return join '.', map { $_ + 0 } split /\./, $_[0];
}
sub expand_ipv6 {
my $ip = shift;
return unless Cpanel::Validate::IP::is_valid_ipv6($ip);
return $ip if length $ip == 39; # already expanded
my @seg = split /:/, $ip, -1;
$seg[0] = '0000' if !length $seg[0];
$seg[-1] = '0000' if !length $seg[-1];
if ( $seg[-1] =~ tr{.}{} && Cpanel::Validate::IP::v4::is_valid_ipv4( $seg[-1] ) ) {
my @ipv4 = split /\./, normalize_ipv4( pop @seg );
push @seg, sprintf( '%04x', ( $ipv4[0] << 8 ) + $ipv4[1] ), sprintf( '%04x', ( $ipv4[2] << 8 ) + $ipv4[3] );
}
my @exp;
for my $seg (@seg) {
if ( !length $seg ) {
my $count = scalar(@seg) - scalar(@exp);
while ( $count + scalar(@exp) <= 8 ) {
push @exp, '0000';
}
}
else {
push @exp, sprintf( '%04x', hex $seg );
}
}
return join ':', @exp;
}
sub normalize_ipv6 {
my $ip = shift;
return unless $ip = expand_ipv6($ip);
$ip = lc($ip);
$ip =~ s/:(0+:){2,}/::/; # flatten multiple groups of 0's to :: #
$ip =~ s/(:0+){2,}$/::/; # flatten multiple groups of 0's to :: #
$ip =~ s/^0+([1-9a-f])/$1/; # flatten the first segment's leading 0's to a single 0 #
$ip =~ s/:0+([1-9a-f])/:$1/g; # flatten each segment, after the first, leading 0's to a single 0 #
$ip =~ s/:0+(:)/:0$1/g; # flatten any segments that are just 0's to a single 0 #
$ip =~ s/:0+$/:0/g; # flatten the end segment if it's just 0's to a single 0 #
$ip =~ s/^0+::/::/; # remove single 0 at the beginning #
$ip =~ s/::0+$/::/; # remote single 0 at the end #
return $ip;
}
sub normalize_ip {
return !defined $_[0] ? undef : index( $_[0], ':' ) > -1 ? normalize_ipv6( $_[0] ) : normalize_ipv4( $_[0] );
}
sub expand_ip {
return !defined $_[0] ? undef : index( $_[0], ':' ) > -1 ? expand_ipv6( $_[0] ) : normalize_ipv4( $_[0] );
}
1;
} # --- END Cpanel/Validate/IP/Expand.pm
{ # --- BEGIN Cpanel/IP/Expand.pm
package Cpanel::IP::Expand;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
# use Cpanel::Validate::IP::Expand (); # perlpkg line 211
sub expand_ip {
my ( $ip, $version ) = @_;
$ip =~ tr{ \r\n\t}{}d if defined $ip;
if ( defined $version && $version eq 6 && Cpanel::Validate::IP::v4::is_valid_ipv4($ip) ) {
my @ipv4 = map { $_ + 0 } split /\./, $ip;
return "0000:0000:0000:0000:0000:ffff:" . sprintf( '%04x', ( $ipv4[0] << 8 ) + $ipv4[1] ) . ':' . sprintf( '%04x', ( $ipv4[2] << 8 ) + $ipv4[3] );
}
my $expanded = Cpanel::Validate::IP::Expand::expand_ip($ip);
return $expanded if $expanded;
if ( defined $version && $version eq 6 || $ip =~ m/:/ ) {
return '0000:0000:0000:0000:0000:0000:0000:0000';
}
return '0.0.0.0';
}
sub ip2binary_string {
my $ip = shift || '';
if ( $ip =~ tr/:// ) {
$ip = expand_ip( $ip, 6 );
$ip =~ tr<:><>d;
return unpack( 'B128', pack( 'H32', $ip ) );
}
return unpack( 'B32', pack( 'C4C4C4C4', split( /\./, $ip ) ) );
}
sub first_last_ip_in_range {
my ($range) = @_;
my ( $range_firstip, $mask ) = split( m{/}, $range );
if ( !length $mask ) {
die "Invalid input ($range) -- must be CIDR!";
}
my $mask_offset = 0;
if ( $range_firstip !~ tr/:// ) { # match as if it were an embedded ipv4 in ipv6
$range_firstip = expand_ip( $range_firstip, 6 );
$mask_offset = ( 128 - 32 ); # If we convert the range from ipv4 to ipv6 we need to move the mask
}
my $size = 128;
my $range_firstip_binary_string = ip2binary_string($range_firstip);
my $range_lastip_binary_string = substr( $range_firstip_binary_string, 0, $mask + $mask_offset ) . '1' x ( $size - $mask - $mask_offset );
return ( $range_firstip_binary_string, $range_lastip_binary_string );
}
1;
} # --- END Cpanel/IP/Expand.pm
{ # --- BEGIN Cpanel/Linux/Netlink.pm
package Cpanel::Linux::Netlink;
use strict;
use warnings;
no warnings 'once';
use constant DEBUG => 0;
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Pack (); # perlpkg line 211
# use Cpanel::Pack::Template (); # perlpkg line 211
my $NETLINK_READ_SIZE = 262144; # Maximum size of netlink message
use constant PAGE_SIZE => 0x400;
use constant READ_SIZE => 8 * PAGE_SIZE;
our $PF_NETLINK = 16;
our $AF_INET = 2;
our $AF_INET6 = 10;
our $NLMSG_NOOP = 0x1;
our $NLMSG_ERROR = 0x2;
our $NLMSG_DONE = 0x3;
our $NLMSG_OVERRUN = 0x4;
our $NETLINK_INET_DIAG_26_KERNEL = 0;
our $NETLINK_INET_DIAG = 4;
our $NLM_F_REQUEST = 1;
our $NLM_F_MULTI = 2; # /* Multipart message, terminated by NLMSG_DONE */
our $NLM_F_ROOT = 0x100;
our $NLM_F_MATCH = 0x200; # in queries, return all matches
our $NLM_F_EXCL = 0x200; # in commands, don't alter if it exists
our $NLM_F_CREATE = 0x400; # in commands, create if it does not exist
our $NLM_F_ACK = 4;
our $SOCK_DGRAM = 2;
our $TCPDIAG_GETSOCK = 18;
our $INET_DIAG_NOCOOKIE = 0xFFFFFFFF;
use constant {
PACK_TEMPLATE_U16 => Cpanel::Pack::Template::PACK_TEMPLATE_U16,
U16_BYTES_LENGTH => Cpanel::Pack::Template::U16_BYTES_LENGTH,
PACK_TEMPLATE_U32 => Cpanel::Pack::Template::PACK_TEMPLATE_U32,
U32_BYTES_LENGTH => Cpanel::Pack::Template::U32_BYTES_LENGTH,
};
my $NLMSG_HEADER_PACK_OBJ;
my $NLMSG_HEADER_PACK_OBJ_SIZE;
our @NLMSG_HEADER_TEMPLATE;
BEGIN {
@NLMSG_HEADER_TEMPLATE = (
'nlmsg_length' => PACK_TEMPLATE_U32(), #__u32 nlmsg_len; /* Length of message including header. */
'nlmsg_type' => PACK_TEMPLATE_U16(), #__u16 nlmsg_type; /* Type of message content. */
'nlmsg_flags' => PACK_TEMPLATE_U16(), #__u16 nlmsg_flags; /* Additional flags. */
'nlmsg_seq' => PACK_TEMPLATE_U32(), #__u32 nlmsg_seq; /* Sequence number. */
'nlmsg_pid' => PACK_TEMPLATE_U32(), #__u32 nlmsg_pid; /* Sender port ID. */
);
}
my @NETLINK_XACTION_REQUIRED = (
'message', #hashref, to be sent via “send_pack_obj”
'send_pack_obj', #Cpanel::Pack instance
'recv_pack_obj', #Cpanel::Pack instance
'sock', #Perl socket
);
my %_u16_cache;
my %_u32_cache;
sub netlink_transaction {
my (%OPTS) = @_;
foreach (@NETLINK_XACTION_REQUIRED) {
die "$_ is required for netlink_transaction" if !$OPTS{$_};
}
my ( $message_ref, $send_pack_obj, $recv_pack_obj, $sock, $parser, $payload_parser, $header_parms_ar ) = @OPTS{ @NETLINK_XACTION_REQUIRED, 'parser', 'payload_parser', 'header' };
my $packed_nlmsg = _pack_nlmsg_with_header( $send_pack_obj, $message_ref, $header_parms_ar );
if (DEBUG) {
require Data::Dumper;
print STDERR "[request]:" . Data::Dumper::Dumper($message_ref);
}
printf STDERR "Send %v02x\n", $packed_nlmsg if DEBUG;
send( $sock, $packed_nlmsg, 0 ) or die "send: $!";
my $message_hr;
my $packed_response = '';
my $header_pack_size = $NLMSG_HEADER_PACK_OBJ->sizeof();
my $recv_pack_size = $recv_pack_obj->sizeof();
my $msgcount = 0;
my ( $msg, $u32, $u16, $nlmsg_length, $nlmsg_type, $nlmsg_flags );
READ_LOOP:
while ( !_nlmsg_type_indicates_finished_reading($message_hr) ) {
sysread( $sock, $packed_response, $NETLINK_READ_SIZE, length $packed_response ) or die "sysread: $!";
PARSE_LOOP:
while (1) {
$msg = substr( $packed_response, 0, $header_pack_size, q<> );
$u32 = substr( $msg, 0, U32_BYTES_LENGTH, '' );
$nlmsg_length = $_u32_cache{$u32} //= unpack( PACK_TEMPLATE_U32, $u32 );
$u16 = substr( $msg, 0, U16_BYTES_LENGTH, '' );
$nlmsg_type = $_u16_cache{$u16} //= unpack( PACK_TEMPLATE_U16, $u16 );
$u16 = substr( $msg, 0, U16_BYTES_LENGTH );
$nlmsg_flags = $_u16_cache{$u16} //= unpack( PACK_TEMPLATE_U16, $u16 );
last PARSE_LOOP if !$nlmsg_length || length $packed_response < $nlmsg_length - $NLMSG_HEADER_PACK_OBJ_SIZE;
print STDERR "Received message, total size: [$nlmsg_length]\n" if DEBUG;
if ( $nlmsg_type == $NLMSG_ERROR ) {
require Data::Dumper;
my ( $errno, $msg ) = unpack 'i a*', $packed_response;
die Cpanel::Exception::create( 'Netlink', [ error => do { local $! = -$errno }, message => $msg ] );
}
if ( $recv_pack_size <= length $packed_response ) {
my $main_msg = substr( $packed_response, 0, $recv_pack_size, '' );
$message_hr = $recv_pack_obj->unpack_to_hashref($main_msg);
if (DEBUG) {
require Data::Dumper;
printf STDERR "Received %v02x\n", $main_msg;
print STDERR "[response]:" . Data::Dumper::Dumper($message_hr);
}
my $payload = substr(
$packed_response,
0,
$nlmsg_length - $NLMSG_HEADER_PACK_OBJ_SIZE - $recv_pack_size,
q<>,
);
if ( $payload_parser && length $payload ) {
printf STDERR "payload: Received [%v02x]\n", $payload if DEBUG;
$payload_parser->( $msgcount, $message_hr, $payload );
}
}
last READ_LOOP if _nlmsg_type_flags_indicates_finished_reading( $nlmsg_type, $nlmsg_flags );
$msgcount++;
}
}
$parser->( $msgcount, $message_hr ) if $parser && $nlmsg_type;
return 1;
}
our @INET_DIAG_SOCKID_TEMPLATE = (
'idiag_sport' => Cpanel::Pack::Template::PACK_TEMPLATE_BE16, #__be16 idiag_sport;
'idiag_dport' => Cpanel::Pack::Template::PACK_TEMPLATE_BE16, #__be16 idiag_dport;
'idiag_src_0' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_src[0];
'idiag_src_1' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_src[1];
'idiag_src_2' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_src[2];
'idiag_src_3' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_src[3];
'idiag_dst_0' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_dst[0];
'idiag_dst_1' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_dst[1];
'idiag_dst_2' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_dst[2];
'idiag_dst_3' => Cpanel::Pack::Template::PACK_TEMPLATE_BE32, #__be32 idiag_dst[3];
'idiag_if' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_if;
'idiag_cookie_0' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_cookie[0];
'idiag_cookie_1' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_cookie[1];
);
my $INET_DIAG_MSG_PACK_OBJ;
our @INET_DIAG_MSG_TEMPLATE = (
'idiag_family' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_family; /* Family of addresses. */
'idiag_state' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_state;
'idiag_timer' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_timer;
'idiag_retrans' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_retrans;
@INET_DIAG_SOCKID_TEMPLATE, # inet_diag_sockid
'idiag_expires' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_expires;
'idiag_rqueue' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_rqueue;
'idiag_wqueue' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_wqueue;
'idiag_uid' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_uid;
'idiag_inode' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 #__u32 idiag_inode;
);
my $INET_DIAG_REQ_PACK_OBJ;
our @INET_DIAG_REQ_TEMPLATE = (
'idiag_family' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_family; /* Family of addresses. */
'idiag_src_len' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_src_len;
'idiag_dst_len' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_dst_len;
'idiag_ext' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 idiag_ext; /* Query extended information */
@INET_DIAG_SOCKID_TEMPLATE, #inet_diag_sockid
'idiag_states' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, #__u32 idiag_states; /* States to dump */
'idiag_dbs' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 #__u32 idiag_dbs; /* Tables to dump (NI) */
);
sub connection_lookup {
my ( $source_address, $source_port, $dest_address, $dest_port ) = @_;
die "A source port is required." if !defined $source_port;
die "A destination port is required." if !defined $dest_port;
my ( $idiag_dst_0, $idiag_dst_1, $idiag_dst_2, $idiag_dst_3 );
my ( $idiag_src_0, $idiag_src_1, $idiag_src_2, $idiag_src_3 );
my ($idiag_family);
if ( $dest_address =~ tr/:// ) {
require Cpanel::IP::Expand; # hide from exim but not perlcc - not eval quoted
( $idiag_dst_0, $idiag_dst_1, $idiag_dst_2, $idiag_dst_3 ) = unpack( 'N4', pack( 'n8', split /:/, Cpanel::IP::Expand::expand_ip($dest_address) ) );
( $idiag_src_0, $idiag_src_1, $idiag_src_2, $idiag_src_3 ) = unpack( 'N4', pack( 'n8', split /:/, Cpanel::IP::Expand::expand_ip($source_address) ) );
$idiag_family = $AF_INET6;
}
else {
my $u32_dest_address = unpack( 'N', pack( 'C4', split( /\D/, $dest_address, 4 ) ) );
my $u32_source_address = unpack( 'N', pack( 'C4', split( /\D/, $source_address, 4 ) ) );
$idiag_src_0 = $u32_source_address;
$idiag_dst_0 = $u32_dest_address;
$idiag_family = $AF_INET;
}
my $sock;
socket( $sock, $PF_NETLINK, $SOCK_DGRAM, $NETLINK_INET_DIAG ) or die "socket: $!";
$INET_DIAG_REQ_PACK_OBJ ||= Cpanel::Pack->new( \@INET_DIAG_REQ_TEMPLATE );
$INET_DIAG_MSG_PACK_OBJ ||= Cpanel::Pack->new( \@INET_DIAG_MSG_TEMPLATE );
my %RESPONSE;
netlink_transaction(
'message' => {
'idiag_family' => $idiag_family,
'idiag_dst_0' => $idiag_dst_0,
'idiag_dst_1' => $idiag_dst_1,
'idiag_dst_2' => $idiag_dst_2,
'idiag_dst_3' => $idiag_dst_3,
'idiag_dport' => $dest_port,
'idiag_src_0' => $idiag_src_0,
'idiag_src_1' => $idiag_src_1,
'idiag_src_2' => $idiag_src_2,
'idiag_src_3' => $idiag_src_3,
'idiag_sport' => $source_port,
'idiag_cookie_0' => $INET_DIAG_NOCOOKIE,
'idiag_cookie_1' => $INET_DIAG_NOCOOKIE,
},
'sock' => $sock,
'send_pack_obj' => $INET_DIAG_REQ_PACK_OBJ,
'recv_pack_obj' => $INET_DIAG_MSG_PACK_OBJ,
'parser' => sub {
my ( undef, $response_ref ) = @_;
%RESPONSE = %$response_ref if ( $response_ref && 'HASH' eq ref $response_ref );
}
);
return \%RESPONSE;
}
my @NETLINK_SEND_HEADER = (
'nlmsg_length' => undef, #gets put in place
'nlmsg_type' => $TCPDIAG_GETSOCK,
'nlmsg_flags' => 0, #gets |=’d with $NLM_F_REQUEST
'nlmsg_pid' => undef, #gets put in place
'nlmsg_seq' => 2, #default
);
sub _pack_nlmsg_with_header {
my ( $send_pack_obj, $message_ref, $header_parms_ar ) = @_;
my $nlmsg = $send_pack_obj->pack_from_hashref($message_ref);
if ( !$NLMSG_HEADER_PACK_OBJ ) {
$NLMSG_HEADER_PACK_OBJ = Cpanel::Pack->new( \@NLMSG_HEADER_TEMPLATE );
$NLMSG_HEADER_PACK_OBJ_SIZE = $NLMSG_HEADER_PACK_OBJ->sizeof();
}
my %header_data = (
@NETLINK_SEND_HEADER,
( $header_parms_ar ? @$header_parms_ar : () ),
nlmsg_length => $NLMSG_HEADER_PACK_OBJ_SIZE + length $nlmsg,
nlmsg_pid => $$,
);
$header_data{'nlmsg_flags'} |= $NLM_F_REQUEST;
my $hdr_str = $NLMSG_HEADER_PACK_OBJ->pack_from_hashref( \%header_data );
return $hdr_str . $nlmsg;
}
sub _nlmsg_type_indicates_finished_reading {
return _nlmsg_type_flags_indicates_finished_reading( $_[0]->{'nlmsg_type'}, $_[0]->{'nlmsg_flags'} );
}
sub _nlmsg_type_flags_indicates_finished_reading {
return 0 if !length $_[0];
return ( $_[0] == $NLMSG_ERROR || ( $_[1] & $NLM_F_MULTI && $_[0] == $NLMSG_DONE ) || !( $_[1] & $NLM_F_MULTI ) ) ? 1 : 0;
}
sub expect_acknowledgment {
my ( $my_sysread, $socket, $sequence ) = @_;
my $NETLINK_HEADER = Cpanel::Pack->new( \@NLMSG_HEADER_TEMPLATE );
my $response_buffer = '';
my $header_hr;
my $error_code;
do {
while ( length $response_buffer < $NETLINK_HEADER->sizeof() ) {
$my_sysread->( $socket, \$response_buffer, READ_SIZE(), length $response_buffer ) or return "sysread, message header: $!";
}
$header_hr = $NETLINK_HEADER->unpack_to_hashref( substr( $response_buffer, 0, $NETLINK_HEADER->sizeof() ) );
while ( length $response_buffer < $header_hr->{nlmsg_length} ) {
$my_sysread->( $socket, \$response_buffer, READ_SIZE(), length $response_buffer ) or return "sysread, message body: $!";
}
my $message = substr( $response_buffer, 0, $header_hr->{nlmsg_length}, '' );
$error_code = 0;
if ( $header_hr->{nlmsg_type} == $NLMSG_ERROR ) {
$error_code = unpack( Cpanel::Pack::Template::PACK_TEMPLATE_U32, substr( $message, $NETLINK_HEADER->sizeof(), Cpanel::Pack::Template::U32_BYTES_LENGTH ) );
}
if ( $header_hr->{nlmsg_seq} eq $sequence ) {
if ( $header_hr->{nlmsg_type} == $NLMSG_ERROR && $error_code != 0 ) {
local $! = -$error_code;
return "Received error code when expecting acknowledgement: $!\n";
}
if ( $header_hr->{nlmsg_type} == $NLMSG_OVERRUN ) {
return "Data lost due to message overrun";
}
if ( $header_hr->{nlmsg_type} == $NLMSG_DONE ) {
return "Received multipart data when expecting ACK";
}
}
} while ( $header_hr->{nlmsg_seq} ne $sequence || $header_hr->{nlmsg_type} != $NLMSG_ERROR || $error_code != 0 );
return undef;
}
1;
} # --- END Cpanel/Linux/Netlink.pm
{ # --- BEGIN Cpanel/Linux/Proc/Net/Tcp.pm
package Cpanel::Linux::Proc::Net::Tcp;
use strict;
our $PROC_NET_TCP = '/proc/net/tcp';
our $PROC_NET_TCP6 = '/proc/net/tcp6';
sub connection_lookup {
my ( $remote_address, $remote_port, $local_address, $local_port ) = @_;
my ( $tcp_file, $remote_ltl_endian_hex_address, $remote_hex_port, $local_ltl_endian_hex_address, $local_hex_port );
$remote_hex_port = _dec_port_to_hex_port($remote_port);
$local_hex_port = _dec_port_to_hex_port($local_port);
if ( $remote_address =~ tr/:// ) { #ipv6
$tcp_file = $PROC_NET_TCP6;
$remote_ltl_endian_hex_address = _ipv6_text_to_little_endian_hex_address($remote_address);
$local_ltl_endian_hex_address = _ipv6_text_to_little_endian_hex_address($local_address);
}
else {
$tcp_file = $PROC_NET_TCP;
$remote_ltl_endian_hex_address = _ipv4_txt_to_little_endian_hex_address($remote_address);
$local_ltl_endian_hex_address = _ipv4_txt_to_little_endian_hex_address($local_address);
}
if ( open( my $tcp_fh, '<', $tcp_file ) ) {
my $uid;
while ( readline($tcp_fh) ) {
if ( m/^\s*\d+:\s+([\dA-F]{8}(?:[\dA-F]{24})?):([\dA-F]{4})\s+([\dA-F]{8}(?:[\dA-F]{24})?):([\dA-F]{4})\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\d+)/
&& $remote_ltl_endian_hex_address eq $1
&& $remote_hex_port eq $2
&& $local_ltl_endian_hex_address eq $3
&& $local_hex_port eq $4 ) {
$uid = $6;
last;
}
}
return $uid;
}
return;
}
sub _dec_port_to_hex_port {
my ($dec_port) = @_;
return sprintf( '%04X', $dec_port );
}
sub _ipv4_txt_to_little_endian_hex_address {
my ($ipv4_txt) = @_;
return sprintf( "%08X", unpack( 'V', pack( 'C4', split( /\D/, $ipv4_txt, 4 ) ) ) );
}
sub _ipv6_text_to_little_endian_hex_address {
my ($ipv6_txt) = @_;
require Cpanel::IP::Expand; # hide from exim but not perlcc - not eval quoted
my $hexip = '';
my @ip = split /:/, Cpanel::IP::Expand::expand_ip( $ipv6_txt, 6 );
while (@ip) {
my $block1 = shift @ip;
my $block2 = shift @ip;
$hexip .= uc substr( $block2, 2, 2 ) . uc substr( $block2, 0, 2 ) . uc substr( $block1, 2, 2 ) . uc substr( $block1, 0, 2 );
}
return $hexip;
}
1;
} # --- END Cpanel/Linux/Proc/Net/Tcp.pm
{ # --- BEGIN Cpanel/Ident.pm
package Cpanel::Ident;
use strict;
our $TESTING_FLAGS = 0; # FOR TESTING
our $USE_NETLINK = 1; # FOR TESTING
our $USE_PROC = 2; # FOR TESTING
use constant NOTFOUND => 0xff_ff_ff_ff;
sub identify_local_connection {
my ( $source_address, $source_port, $dest_address, $dest_port ) = @_;
if ( !defined($source_port) || !defined($dest_port) ) {
die 'Need source and destination ports!';
}
my $netlink_failed;
if ( !$TESTING_FLAGS || $TESTING_FLAGS == $USE_NETLINK ) {
require Cpanel::Linux::Netlink; # hide from exim but not perlcc - not eval quoted
my $response;
local $@;
eval {
$response = Cpanel::Linux::Netlink::connection_lookup(
$source_address, $source_port,
$dest_address, $dest_port,
);
};
if ($@) {
$netlink_failed = 1;
warn;
}
elsif ( $response
&& defined $response->{'idiag_state'}
&& ( $response->{'idiag_state'} != 1 && $response->{'idiag_state'} != 8 && $response->{'idiag_state'} != 10 ) ) {
return -1;
}
elsif ( $response
&& ref $response
&& $response->{'idiag_dport'}
&& defined( $response->{'idiag_uid'} )
&& $response->{'idiag_uid'} != NOTFOUND() ) {
return $response->{'idiag_uid'};
}
}
if ( $netlink_failed || $TESTING_FLAGS == $USE_PROC ) {
require Cpanel::Linux::Proc::Net::Tcp; # hide from exim but not perlcc - not eval quoted
my $uid = Cpanel::Linux::Proc::Net::Tcp::connection_lookup( $source_address, $source_port, $dest_address, $dest_port );
return $uid if defined $uid;
}
return;
}
1;
} # --- END Cpanel/Ident.pm
{ # --- BEGIN Cpanel/Autodie.pm
package Cpanel::Autodie;
use strict;
use warnings;
no warnings 'once';
sub _ENOENT { return 2; }
sub _EEXIST { return 17; }
sub _EINTR { return 4; }
sub import {
shift;
_load_function($_) for @_;
return;
}
our $AUTOLOAD;
sub AUTOLOAD {
substr( $AUTOLOAD, 0, 1 + rindex( $AUTOLOAD, ':' ) ) = q<>;
_load_function($AUTOLOAD);
goto &{ Cpanel::Autodie->can($AUTOLOAD) };
}
sub _load_function {
_require("Cpanel/Autodie/CORE/$_[0].pm");
return;
}
sub _require {
local ( $!, $^E, $@ );
require $_[0];
return;
}
1;
} # --- END Cpanel/Autodie.pm
{ # --- BEGIN Cpanel/Autodie/CORE/exists.pm
package Cpanel::Autodie;
use strict;
use warnings;
no warnings 'once';
sub exists { ## no critic qw( RequireArgUnpacking )
local ( $!, $^E );
if ( ${^GLOBAL_PHASE} eq 'START' ) {
_die_err( $_[0], "do not access the filesystem at compile time" );
}
return 1 if -e $_[0];
return 0 if $! == _ENOENT();
return _die_err( $_[0], $! );
}
sub exists_nofollow {
my ($path) = @_;
local ( $!, $^E );
return 1 if CORE::lstat $path;
return 0 if $! == _ENOENT();
return _die_err( $path, $! );
}
sub _die_err {
my ( $path, $err ) = @_;
local $@; # $! is already local()ed.
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::StatError', [ error => $err, path => $path ] );
}
1;
} # --- END Cpanel/Autodie/CORE/exists.pm
{ # --- BEGIN Cpanel/Autodie/CORE/exists_nofollow.pm
package Cpanel::Autodie;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie::CORE::exists(); # PPI NO PARSE # perlpkg line 211
1;
} # --- END Cpanel/Autodie/CORE/exists_nofollow.pm
{ # --- BEGIN Cpanel/Autodie/More/Lite.pm
package Cpanel::Autodie::More::Lite;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie (); # perlpkg line 211
# use Cpanel::Autodie::CORE::exists (); # PPI USE OK - reload so we can map the symbol below # perlpkg line 211
# use Cpanel::Autodie::CORE::exists_nofollow (); # PPI USE OK - reload so we can map the symbol below # perlpkg line 211
BEGIN {
*exists = *Cpanel::Autodie::exists;
*exists_nofollow = *Cpanel::Autodie::exists_nofollow;
}
1;
} # --- END Cpanel/Autodie/More/Lite.pm
{ # --- BEGIN Cpanel/Services/Enabled/Spamd.pm
package Cpanel::Services::Enabled::Spamd;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie::More::Lite (); # perlpkg line 211
our $_TOUCHFILE_PATH = '/etc/spamddisable';
sub is_enabled {
return !Cpanel::Autodie::More::Lite::exists($_TOUCHFILE_PATH);
}
1;
} # --- END Cpanel/Services/Enabled/Spamd.pm
{ # --- BEGIN Cpanel/FileUtils/Dir.pm
package Cpanel::FileUtils::Dir;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
use constant _ENOENT => 2;
sub directory_has_nodes {
return directory_has_nodes_if_exists( $_[0] ) // do {
local $! = _ENOENT();
die _opendir_err( $_[0] );
};
}
sub directory_has_nodes_if_exists {
my ($dir) = @_;
local $!;
opendir my $dh, $dir or do {
if ( $! == _ENOENT() ) {
return undef;
}
die _opendir_err($dir);
};
local $!;
my $has_nodes = 0;
while ( my $node = readdir $dh ) {
next if $node eq '.' || $node eq '..';
$has_nodes = 1;
last;
}
_check_for_readdir_error($dir) if !$has_nodes;
_closedir( $dh, $dir );
return $has_nodes;
}
sub get_directory_nodes_if_exists {
my ($dir) = @_;
local $!;
if ( opendir my $dh, $dir ) {
return _read_directory_nodes( $dh, $dir );
}
elsif ( $! != _ENOENT() ) {
die _opendir_err($dir);
}
return undef;
}
sub get_directory_nodes {
return _read_directory_nodes( _opendir( $_[0] ), $_[0] );
}
sub _read_directory_nodes { ## no critic qw(Subroutines::RequireArgUnpacking) -- used in loops
local $!;
my @nodes = grep { $_ ne '.' && $_ ne '..' } readdir( $_[0] );
_check_for_readdir_error( $_[0] );
_closedir( $_[0], $_[1] );
return \@nodes;
}
sub _check_for_readdir_error {
if ( $! && ( $^V >= v5.20.0 ) ) {
die Cpanel::Exception::create( 'IO::DirectoryReadError', [ path => $_[0], error => $! ] );
}
return;
}
sub _opendir {
local $!;
opendir my $dh, $_[0] or do {
die _opendir_err( $_[0] );
};
return $dh;
}
sub _closedir {
local $!;
closedir $_[0] or do {
die Cpanel::Exception::create( 'IO::DirectoryCloseError', [ path => $_[1], error => $! ] );
};
return;
}
sub _opendir_err {
return Cpanel::Exception::create( 'IO::DirectoryOpenError', [ path => $_[0], error => $! ] );
}
1;
} # --- END Cpanel/FileUtils/Dir.pm
{ # --- BEGIN Cpanel/DKIM/ValidityCache.pm
package Cpanel::DKIM::ValidityCache;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie (); # perlpkg line 211
our $BASE_DIRECTORY = '/var/cpanel/domain_keys/validity_cache';
sub _BASE { return $BASE_DIRECTORY; }
sub get {
my ( undef, $entry ) = @_;
return Cpanel::Autodie::exists("$BASE_DIRECTORY/$entry");
}
sub get_all {
require Cpanel::FileUtils::Dir;
return Cpanel::FileUtils::Dir::get_directory_nodes_if_exists($BASE_DIRECTORY);
}
1;
} # --- END Cpanel/DKIM/ValidityCache.pm
{ # --- BEGIN Cpanel/Context.pm
package Cpanel::Context;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
sub must_be_list {
return 1 if ( caller(1) )[5]; # 5 = wantarray
my $msg = ( caller(1) )[3]; # 3 = subroutine
$msg .= $_[0] if defined $_[0];
return _die_context( 'list', $msg );
}
sub must_not_be_scalar {
my ($message) = @_;
my $wa = ( caller(1) )[5]; # 5 = wantarray
if ( !$wa && defined $wa ) {
_die_context( 'list or void', $message );
}
return 1;
}
sub must_not_be_void {
return if defined( ( caller 1 )[5] );
return _die_context('scalar or list');
}
sub _die_context {
my ( $context, $message ) = @_;
local $Carp::CarpInternal{__PACKAGE__} if $INC{'Carp.pm'};
my $to_throw = length $message ? "Must be $context context ($message)!" : "Must be $context context!";
die Cpanel::Exception::create_raw( 'ContextError', $to_throw );
}
1;
} # --- END Cpanel/Context.pm
{ # --- BEGIN Cpanel/ProcessInfo.pm
package Cpanel::ProcessInfo;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Context (); # perlpkg line 211
# use Cpanel::Autodie (); # perlpkg line 211
our $VERSION = '1.0';
sub get_pid_lineage {
Cpanel::Context::must_be_list();
my @lineage;
my $ppid = getppid();
while ( $ppid > 1 ) {
push @lineage, $ppid;
$ppid = get_parent_pid($ppid);
}
return @lineage;
}
sub get_parent_pid {
_die_if_pid_invalid( $_[0] );
return getppid() if $_[0] == $$;
if ( open( my $proc_status_fh, '<', "/proc/$_[0]/status" ) ) {
local $/;
my %status = map { lc $_->[0] => $_->[1] }
map { [ ( split( /\s*:\s*/, $_ ) )[ 0, 1 ] ] }
grep { index( $_, ':' ) > -1 }
split( /\n/, readline($proc_status_fh) );
return $status{'ppid'};
}
return undef;
}
sub get_pid_exe {
_die_if_pid_invalid( $_[0] );
return Cpanel::Autodie::readlink_if_exists( '/proc/' . $_[0] . '/exe' );
}
sub get_pid_cmdline {
_die_if_pid_invalid( $_[0] );
if ( open( my $cmdline, '<', "/proc/$_[0]/cmdline" ) ) {
local $/;
my $cmdline = readline($cmdline);
$cmdline =~ tr{\0}{ };
$cmdline =~ tr{\r\n}{}d;
substr( $cmdline, -1, 1, '' ) if substr( $cmdline, -1 ) eq ' ';
return $cmdline;
}
return '';
}
sub get_pid_cwd {
_die_if_pid_invalid( $_[0] );
return readlink( '/proc/' . $_[0] . '/cwd' ) || '/';
}
sub _die_if_pid_invalid {
die "Invalid PID: $_[0]" if !length $_[0] || $_[0] =~ tr{0-9}{}c;
return;
}
1;
} # --- END Cpanel/ProcessInfo.pm
{ # --- BEGIN Cpanel/Fcntl/Constants.pm
package Cpanel::Fcntl::Constants;
use strict;
use warnings;
no warnings 'once';
BEGIN {
our $O_RDONLY = 0;
our $O_WRONLY = 1;
our $O_RDWR = 2;
our $O_ACCMODE = 3;
our $F_GETFD = 1;
our $F_SETFD = 2;
our $F_GETFL = 3;
our $F_SETFL = 4;
our $SEEK_SET = 0;
our $SEEK_CUR = 1;
our $SEEK_END = 2;
our $S_IWOTH = 2;
our $S_ISUID = 2048;
our $S_ISGID = 1024;
our $O_CREAT = 64;
our $O_EXCL = 128;
our $O_TRUNC = 512;
our $O_APPEND = 1024;
our $O_NONBLOCK = 2048;
our $O_DIRECTORY = 65536;
our $O_NOFOLLOW = 131072;
our $O_CLOEXEC = 524288;
our $S_IFREG = 32768;
our $S_IFDIR = 16384;
our $S_IFCHR = 8192;
our $S_IFBLK = 24576;
our $S_IFIFO = 4096;
our $S_IFLNK = 40960;
our $S_IFSOCK = 49152;
our $S_IFMT = 61440;
our $LOCK_SH = 1;
our $LOCK_EX = 2;
our $LOCK_NB = 4;
our $LOCK_UN = 8;
our $FD_CLOEXEC = 1;
}
1;
} # --- END Cpanel/Fcntl/Constants.pm
{ # --- BEGIN Cpanel/Socket/Constants.pm
package Cpanel::Socket::Constants;
use strict;
use warnings;
no warnings 'once';
our $SO_REUSEADDR = 2;
our $AF_UNIX = 1;
our $AF_INET = 2;
our $PF_INET = 2;
our $AF_INET6 = 10;
our $PF_INET6 = 10;
our $PROTO_IP = 0;
our $PROTO_ICMP = 1;
our $PROTO_TCP = 6;
our $PROTO_UDP = 17;
our $IPPROTO_TCP;
*IPPROTO_TCP = \$PROTO_TCP;
our $SO_PEERCRED = 17;
our $SOL_SOCKET = 1;
our $SOCK_STREAM = 1;
our $SOCK_NONBLOCK = 2048;
our $SHUT_RD = 0;
our $SHUT_WR = 1;
our $SHUT_RDWR = 2;
our $MSG_PEEK = 2;
our $MSG_NOSIGNAL = 16384;
1;
} # --- END Cpanel/Socket/Constants.pm
{ # --- BEGIN Cpanel/Hulk/Constants.pm
package Cpanel::Hulk::Constants;
use strict;
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::Socket::Constants (); # perlpkg line 211
*F_GETFL = \$Cpanel::Fcntl::Constants::F_GETFL;
*F_SETFL = \$Cpanel::Fcntl::Constants::F_SETFL;
*O_NONBLOCK = \$Cpanel::Fcntl::Constants::O_NONBLOCK;
our $EINTR = 4;
our $EPIPE = 32;
our $EINPROGRESS = 115;
our $ETIMEDOUT = 110;
our $EISCONN = 106;
our $ECONNRESET = 104;
our $EAGAIN = 11;
*PROTO_IP = \$Cpanel::Socket::Constants::PROTO_IP;
*PROTO_ICMP = \$Cpanel::Socket::Constants::PROTO_ICMP;
*PROTO_TCP = \$Cpanel::Socket::Constants::PROTO_TCP;
*SO_PEERCRED = \$Cpanel::Socket::Constants::SO_PEERCRED;
*SOL_SOCKET = \$Cpanel::Socket::Constants::SOL_SOCKET;
*SOCK_STREAM = \$Cpanel::Socket::Constants::SOCK_STREAM;
*AF_INET6 = \$Cpanel::Socket::Constants::AF_INET6;
*AF_INET = \$Cpanel::Socket::Constants::AF_INET;
*AF_UNIX = \$Cpanel::Socket::Constants::AF_UNIX;
our $TOKEN_SALT_BASE = '$6$';
our $SALT_LENGTH = 16;
our $TIME_BASE = 1410000000;
our $SIX_HOURS_IN_SECONDS = 21600;
1;
} # --- END Cpanel/Hulk/Constants.pm
{ # --- BEGIN Cpanel/ApacheServerStatus.pm
package Cpanel::ApacheServerStatus;
# use Cpanel::Hulk::Constants (); # perlpkg line 211
sub new {
my ($class) = @_;
my $obj = {};
bless $obj, $class;
my $html = $obj->fetch_server_status_html();
$html =~ m/<table[^\>]*>(.*?)<\/table[^\>]*>/is;
my $inner_table = $1;
$inner_table =~ s/[\r\n\0]//g;
my $line_count = 0;
my ( @index, @data, %server_status );
while ( $inner_table =~ m/<tr[^\>]*>(.*?)<\/tr[^\>]*>/isg ) {
my $contents = $1;
@data = map { s/^\s+//; s/\s+$//; lc $_; } ( $contents =~ m/(?:<[^\>]+>)+([^\<]+)/isg );
if ( $line_count == 0 ) {
@index = @data;
}
else {
my $count = 0;
my %named_data = map { $index[ $count++ ] => $_; } @data;
$server_status{ $named_data{'pid'} } = \%named_data;
}
$line_count++;
}
$obj->{'server_status'} = \%server_status;
return $obj;
}
sub get_status_by_pid {
my ( $self, $pid ) = @_;
return $self->{'server_status'}->{$pid};
}
sub get_apache_port {
if ( open( my $ap_port_fh, '<', '/var/cpanel/config/apache/port' ) ) {
my $port_txt = readline($ap_port_fh);
chomp($port_txt);
if ( $port_txt =~ m/:/ ) {
return ( split( m/:/, $port_txt ) )[1];
}
elsif ( $port_txt =~ /^[0-9]+$/ ) {
return $port_txt;
}
}
}
sub fetch_server_status_html {
my ($self) = @_;
my $port = 80;
my $html;
eval {
my $socket_scc;
if ( !socket( $socket_scc, $Cpanel::Hulk::Constants::AF_INET, $Cpanel::Hulk::Constants::SOCK_STREAM, $Cpanel::Hulk::Constants::PROTO_TCP ) || !$socket_scc ) {
die "Could not setup tcp socket for connection to $port: $!";
}
if ( !connect( $socket_scc, pack( 'S n a4 x8', $Cpanel::Hulk::Constants::AF_INET, $port, ( pack 'C4', ( split /\./, "127.0.0.1" ) ) ) ) ) {
my $non_default_port = $self->get_apache_port();
if ( $non_default_port && $non_default_port != $port ) {
if ( !connect( $socket_scc, pack( 'S n a4 x8', $Cpanel::Hulk::Constants::AF_INET, $non_default_port, ( pack 'C4', ( split /\./, "127.0.0.1" ) ) ) ) ) {
die "Unable to connect to port $non_default_port on 127.0.0.1: $!";
}
}
}
syswrite( $socket_scc, "GET /whm-server-status HTTP/1.0\r\nHost: localhost\r\nConnection: close\r\n\r\n" );
local $/;
$html = readline($socket_scc);
close($socket_scc);
};
$html;
}
1;
} # --- END Cpanel/ApacheServerStatus.pm
{ # --- BEGIN Cpanel/Sys/Uname.pm
package Cpanel::Sys::Uname;
use strict;
our $SYS_UNAME = 63;
our $UNAME_ELEMENTS = 6;
our $_UTSNAME_LENGTH = 65;
my $UNAME_PACK_TEMPLATE = ( 'c' . $_UTSNAME_LENGTH ) x $UNAME_ELEMENTS;
my $UNAME_UNPACK_TEMPLATE = ( 'Z' . $_UTSNAME_LENGTH ) x $UNAME_ELEMENTS;
my @uname_cache;
sub get_uname_cached {
return ( @uname_cache ? @uname_cache : ( @uname_cache = syscall_uname() ) );
}
sub clearcache {
@uname_cache = ();
return;
}
sub syscall_uname {
my $uname;
if ( syscall( $SYS_UNAME, $uname = pack( $UNAME_PACK_TEMPLATE, () ) ) == 0 ) {
return unpack( $UNAME_UNPACK_TEMPLATE, $uname );
}
else {
die "The uname() system call failed because of an error: $!";
}
return;
}
1;
} # --- END Cpanel/Sys/Uname.pm
{ # --- BEGIN Cpanel/Sys/Hostname/Fallback.pm
package Cpanel::Sys::Hostname::Fallback;
use strict;
use warnings;
no warnings 'once';
use Socket ();
# use Cpanel::Sys::Uname (); # perlpkg line 211
sub get_canonical_hostname {
my @uname = Cpanel::Sys::Uname::get_uname_cached();
my ( $err, @results ) = Socket::getaddrinfo( $uname[1], 0, { flags => Socket::AI_CANONNAME() } );
if ( @results && $results[0]->{'canonname'} ) {
return $results[0]->{'canonname'};
}
return undef;
}
1;
} # --- END Cpanel/Sys/Hostname/Fallback.pm
{ # --- BEGIN Cpanel/LoadFile/ReadFast.pm
package Cpanel::LoadFile::ReadFast;
use strict;
use warnings;
no warnings 'once';
use constant READ_CHUNK => 1 << 18; # 262144
use constant _EINTR => 4;
sub read_fast {
$_[1] //= q<>;
return ( @_ > 3 ? sysread( $_[0], $_[1], $_[2], $_[3] ) : sysread( $_[0], $_[1], $_[2] ) ) // do {
goto \&read_fast if $! == _EINTR;
die "Failed to read data: $!";
};
}
my $_ret;
sub read_all_fast {
$_[1] //= q<>;
$_ret = 1;
while ($_ret) {
$_ret = sysread( $_[0], $_[1], READ_CHUNK, length $_[1] ) // do {
redo if $! == _EINTR;
die "Failed to read data: $!";
}
}
return;
}
1;
} # --- END Cpanel/LoadFile/ReadFast.pm
{ # --- BEGIN Cpanel/LoadFile.pm
package Cpanel::LoadFile;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
sub loadfileasarrayref {
my $fileref = _load_file( shift, { 'array_ref' => 1 } );
return ref $fileref eq 'ARRAY' ? $fileref : undef;
}
sub loadbinfile {
my $fileref = _load_file( shift, { 'binmode' => 1 } );
return ref $fileref eq 'SCALAR' ? $$fileref : undef;
}
sub slurpfile {
my $fh = shift;
my $fileref = _load_file(shift);
if ( ref $fileref eq 'SCALAR' ) {
print {$fh} $$fileref;
}
return;
}
sub loadfile {
my $fileref = _load_file(@_);
return ref $fileref eq 'SCALAR' ? $$fileref : undef;
}
sub loadfile_r {
my ( $file, $arg_ref ) = @_;
if ( open my $lf_fh, '<:stdio', $file ) {
if ( $arg_ref->{'binmode'} ) { binmode $lf_fh; }
my $data;
if ( $arg_ref->{'array_ref'} ) {
@{$data} = readline $lf_fh;
close $lf_fh;
return $data;
}
else {
$data = '';
local $@;
eval { Cpanel::LoadFile::ReadFast::read_all_fast( $lf_fh, $data ); };
return $@ ? undef : \$data;
}
}
return;
}
*_load_file = *loadfile_r;
sub _open {
return _open_if_exists( $_[0] ) || die Cpanel::Exception::create( 'IO::FileNotFound', [ path => $_[0], error => _ENOENT() ] );
}
sub _open_if_exists {
local $!;
open my $fh, '<:stdio', $_[0] or do {
if ( $! == _ENOENT() ) {
return undef;
}
die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $_[0], error => $!, mode => '<' ] );
};
return $fh;
}
sub load_if_exists {
my $ref = _load_r( \&_open_if_exists, @_ );
return $ref ? $$ref : undef;
}
sub load_r_if_exists {
return _load_r( \&_open_if_exists, @_ );
}
sub load {
return ${ _load_r( \&_open, @_ ) };
}
sub load_r {
return _load_r( \&_open, @_ );
}
sub _load_r {
my ( $open_coderef, $path, $offset, $length ) = @_;
my $fh = $open_coderef->($path) or return undef;
local $!;
if ($offset) {
sysseek( $fh, $offset, $Cpanel::Fcntl::Constants::SEEK_SET );
if ($!) {
die Cpanel::Exception::create(
'IO::FileSeekError',
[
path => $path,
position => $offset,
whence => $Cpanel::Fcntl::Constants::SEEK_SET,
error => $!,
]
);
}
}
my $data = q<>;
if ( !defined $length ) {
my $bytes_read = Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, Cpanel::LoadFile::ReadFast::READ_CHUNK );
if ( $bytes_read == Cpanel::LoadFile::ReadFast::READ_CHUNK ) {
my $file_size = -f $fh && -s _;
if ($file_size) {
Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, $file_size, length $data ) // die _read_err($path);
}
}
Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data );
}
else {
my $togo = $length;
my $bytes_read;
while ( $bytes_read = Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, $togo, length $data ) && length $data < $length ) {
$togo -= $bytes_read;
}
}
if ($!) {
die Cpanel::Exception::create( 'IO::FileReadError', [ path => $path, error => $! ] );
}
close $fh or warn "The system failed to close the file “$path” because of an error: $!";
return \$data;
}
sub _ENOENT { return 2; }
1;
} # --- END Cpanel/LoadFile.pm
{ # --- BEGIN Cpanel/Time/Local.pm
package Cpanel::Time::Local;
use strict;
our $server_offset_string;
our ( $timecacheref, $localtimecacheref ) = ( [ -1, '', -1 ], [ -1, '', -1 ] );
my $server_offset;
my $localtime_link_or_mtime;
our $ETC_LOCALTIME = q{/etc/localtime};
sub _clear_caches {
undef $_
for (
$server_offset,
$server_offset_string,
$timecacheref,
$localtimecacheref,
$localtime_link_or_mtime,
);
return;
}
sub localtime2timestamp {
my ( $time, $delimiter ) = @_;
$delimiter ||= ' ';
$time ||= time();
return $localtimecacheref->[2] if $localtimecacheref->[0] == $time && $localtimecacheref->[1] eq $delimiter;
my $tz_offset = get_server_offset_as_offset_string($time);
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime $time;
@{$localtimecacheref}[ 0, 1 ] = ( $time, $delimiter );
return ( $localtimecacheref->[2] = sprintf( '%04d-%02d-%02d' . $delimiter . '%02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz_offset ) );
}
sub get_server_offset_as_offset_string {
my ($time_supplied) = @_;
if ( !$time_supplied ) {
my $link_or_mtime;
if ( -l $ETC_LOCALTIME ) {
$link_or_mtime = readlink($ETC_LOCALTIME);
}
else {
$link_or_mtime = ( stat($ETC_LOCALTIME) )[9];
}
if ( defined $link_or_mtime ) {
$localtime_link_or_mtime ||= $link_or_mtime;
if ( $localtime_link_or_mtime ne $link_or_mtime ) {
_clear_caches();
$localtime_link_or_mtime = $link_or_mtime;
}
}
}
if ( $time_supplied || !defined $server_offset_string ) {
UNTIL_SAME_SECOND: {
my $starttime = time();
my $time = $time_supplied || $starttime;
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) = localtime $time;
my ( $gmmin, $gmhour, $gmyear, $gmyday ) = ( gmtime($time) )[ 1, 2, 5, 7 ];
redo UNTIL_SAME_SECOND if time != $starttime;
my $yday_offset;
if ( $year == $gmyear ) {
$yday_offset = ( $yday <=> $gmyday );
}
elsif ( $year < $gmyear ) {
$yday_offset = -1;
}
elsif ( $year > $gmyear ) {
$yday_offset = 1;
}
my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * $yday_offset;
my $offset_string = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 );
if ($time_supplied) {
return $offset_string;
}
else {
$server_offset_string = $offset_string;
}
}
}
return $server_offset_string;
}
sub get_server_offset_in_seconds {
if ( !defined $server_offset ) {
if ( get_server_offset_as_offset_string() =~ m/([-+]?[0-9]{2})([0-9]{2})/ ) {
my ( $hours, $minutes ) = ( $1, $2 );
my $seconds = ( ( abs($hours) * 60 * 60 ) + ( $minutes * 60 ) );
$server_offset = $hours < 0 ? "-$seconds" : $seconds;
}
else {
$server_offset = 0;
}
}
return $server_offset;
}
1;
} # --- END Cpanel/Time/Local.pm
{ # --- BEGIN Cpanel/Fcntl.pm
package Cpanel::Fcntl;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
my %CONSTANTS;
my %CACHE;
sub or_flags {
my (@flags) = @_;
my $flag_cache_key = join( '|', @flags );
return $CACHE{$flag_cache_key} if defined $CACHE{$flag_cache_key};
my $numeric = 0;
foreach my $o_const (@flags) {
$numeric |= (
$CONSTANTS{$o_const} ||= do {
my $glob = $Cpanel::Fcntl::Constants::{$o_const};
my $number_r = $glob && *{$glob}{'SCALAR'};
die "Missing \$Cpanel::Fcntl::Constants::$o_const! (does it need to be added?)" if !$number_r;
$$number_r;
}
);
}
return ( $CACHE{$flag_cache_key} = $numeric );
}
1;
} # --- END Cpanel/Fcntl.pm
{ # --- BEGIN Cpanel/FileUtils/Open.pm
package Cpanel::FileUtils::Open;
use strict;
# use Cpanel::Fcntl (); # perlpkg line 211
sub sysopen_with_real_perms { ##no critic qw(RequireArgUnpacking)
my ( $file, $mode, $custom_perms ) = ( @_[ 1 .. 3 ] );
if ( $mode && substr( $mode, 0, 1 ) eq 'O' ) {
$mode = Cpanel::Fcntl::or_flags( split m<\|>, $mode );
}
my ( $sysopen_perms, $original_umask );
if ( defined $custom_perms ) {
$custom_perms &= 0777;
$original_umask = umask( $custom_perms ^ 07777 );
$sysopen_perms = $custom_perms;
}
else {
$sysopen_perms = 0666;
}
my $ret = sysopen( $_[0], $file, $mode, $sysopen_perms );
if ( defined $custom_perms ) {
() = umask($original_umask);
}
return $ret;
}
1;
} # --- END Cpanel/FileUtils/Open.pm
{ # --- BEGIN Cpanel/Parser/Vars.pm
package Cpanel::Parser::Vars;
use strict;
our $current_tag = '';
our $can_leave_cpanelaction = 1;
our $buffer = '';
our $loaded_api = 0;
our $trial_mode = 0;
our $sent_headers = 0;
our $live_socket_file;
our $incpanelaction = 0;
our $altmode = 0;
our $jsonmode = 0;
our $javascript = 0;
our $title = 0;
our $input = 0;
our $style = 0;
our $embtag = 0;
our $textarea = 0;
our $file = '[stdin]';
our $firstfile = '[stdin]';
our $trap_defaultfh = undef; # Known to be boolean.
our %BACKCOMPAT;
our $cptag;
our $sent_content_type;
1;
} # --- END Cpanel/Parser/Vars.pm
{ # --- BEGIN Cpanel/Encoder/Tiny/Rare.pm
package Cpanel::Encoder::Tiny::Rare;
use strict;
use warnings;
no warnings 'once';
sub angle_bracket_decode {
my ($string) = @_;
$string =~ s{ < }{<}xmsg;
$string =~ s{ > }{>}xmsg;
return $string;
}
sub decode_utf8_html_entities {
my $str = shift;
$str =~ s/&\#(\d{4})\;/chr($1);/eg;
return $str;
}
my %uri_encoding_cache = (
'"' => '%22',
q{'} => '%27',
'(' => '%28',
')' => '%29',
q{ } => '%20',
"\t" => '%09',
);
sub css_encode_str {
my $str = shift;
$str =~ s{([\(\)\s"'])}{
$uri_encoding_cache{$1}
|| require Cpanel::Encoder::URI && Cpanel::Encoder::URI::uri_encode_str($1)
}ge;
return $str;
}
1;
} # --- END Cpanel/Encoder/Tiny/Rare.pm
{ # --- BEGIN Cpanel/Encoder/Tiny.pm
package Cpanel::Encoder::Tiny;
use strict;
my %XML_ENCODE_MAP = ( '&' => '&', '<' => '<', '>' => '>', '"' => '"', "'" => ''' );
my %HTML_ENCODE_MAP = ( '&' => '&', '<' => '<', '>' => '>', '"' => '"', "'" => ''' );
my %HTML_DECODE_MAP = ( 'amp' => '&', 'lt' => '<', 'gt' => '>', 'quot' => '"', 'apos' => q{'}, '#39' => q{'} );
my $decode_regex = do { my $tmp = join( '|', keys %HTML_DECODE_MAP ); "&($tmp);"; };
sub angle_bracket_encode {
my ($string) = @_;
$string =~ s{<}{<}xmsg;
$string =~ s{>}{>}xmsg;
return $string;
}
sub safe_xml_encode_str {
my $data = join( '', @_ );
return $data if $data !~ tr/&<>"'//;
$data =~ s/([&<>"'])/$XML_ENCODE_MAP{$1}/sg;
return $data;
}
sub safe_html_encode_str {
return $_[0] if !defined $_[0] || ( !defined $_[1] && $_[0] !~ tr/&<>"'// );
my $data = defined $_[1] ? join( '', @_ ) : $_[0];
return $data if $data !~ tr/&<>"'//;
$data =~ s/([&<>"'])/$HTML_ENCODE_MAP{$1}/sg;
return $data;
}
sub safe_html_decode_str {
return undef if !defined $_[0];
my $data = join( '', @_ );
$data =~ s/$decode_regex/$HTML_DECODE_MAP{$1}/g;
return $data;
}
sub css_encode_str {
require Cpanel::Encoder::Tiny::Rare;
*css_encode_str = *Cpanel::Encoder::Tiny::Rare::css_encode_str;
goto \&Cpanel::Encoder::Tiny::Rare::css_encode_str;
}
1;
} # --- END Cpanel/Encoder/Tiny.pm
{ # --- BEGIN Cpanel/Regex.pm
package Cpanel::Regex;
use strict;
our $VERSION = '0.2.5';
my $dblquotedstr = q{"([^\\\\"]*(?:\\\\.[^\\\\"]*)*)"};
my $sglquotedstr = $dblquotedstr;
$sglquotedstr =~ tr{"}{'};
my $zero_through_255 = '(?:25[0-5]|2[0-4][0-9]|1[0-9]{2}|[1-9][0-9]?|0)';
our %regex = (
'emailaddr' => '[a-zA-Z0-9!#\$\-=?^_{}~]+(?:\.[a-zA-Z0-9!#\$\-=?^_{}~]+)*(?:\+[a-zA-Z0-9 \.=\-\_]+)*\@[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?(?:\.[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?)*',
'oneplusdot' => '\.+',
'oneplusspacetab' => '[\s\t]+',
'multipledot' => '\.{2,}',
'commercialat' => '\@',
'plussign' => '\+',
'singledot' => '\.',
'newline' => '\n',
'doubledot' => '\.\.',
'lineofdigits' => '^\d+$',
'lineofnonprintingchars' => '^[\s\t]*$',
'getemailtransport' => '^from\s+.*\s+by\s+\S+\s+with\s+(\S+)',
'getreceivedfrom' => '^from\s+(.*)\s+by\s+',
'emailheaderterminator' => '^[\r\n]*$',
'forwardslash' => '\/',
'backslash' => chr(92) x 4,
'singlequote' => q('),
'doublequote' => '"',
'allspacetabchars' => '[\s\t]*',
'beginswithspaceortabs' => '^[\s\t]',
doublequotedstring => $dblquotedstr,
singlequotedstring => $sglquotedstr,
DUNS => '[0-9]{2}(?:-[0-9]{3}-[0-9]{4}|[0-9]{7})',
YYYY_MM_DD => '[0-9]{4}-(?:1[012]|0[1-9])-(?:3[01]|[12][0-9]|0[1-9])',
ipv4 => "(?:$zero_through_255\.){3}$zero_through_255",
iso_z_time => '[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}Z',
);
1;
} # --- END Cpanel/Regex.pm
{ # --- BEGIN Cpanel/Carp.pm
package Cpanel::Carp;
use strict;
# use Cpanel::Parser::Vars (); # perlpkg line 211
our ( $SHOW_TRACE, $OUTPUT_FORMAT, $VERBOSE ) = ( 1, 'text', 0 );
my $__CALLBACK_AFTER_DIE_SPEW; # Set when we need to run a code ref after spewing on die
my $error_count = 0;
sub import { return enable(); }
sub enable {
my (
$callback_before_warn_or_die_spew, # Runs before the spew on warn or die, currently used in cpanel to ensure we emit headers before body in the event of a warn or die spew
$callback_before_die_spew, # Runs before the spew on die, not currently used
$callback_after_die_spew, # Runs after the spew on die, currently used in whostmgr to ensure we emit the javascript footer when we die to avoid the UI breaking
) = @_;
$SIG{'__WARN__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars)
my @caller = caller(1);
return if defined $caller[3] && index( $caller[3], 'eval' ) > -1; # Case 35335: Quiet spurious warn errors from evals
++$error_count;
my $time = time();
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time);
my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ];
my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday );
my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 );
my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz );
my $longmess;
my $ignorable;
if ( UNIVERSAL::isa( $_[0], 'Cpanel::Exception' ) ) {
$longmess = Cpanel::Carp::safe_longmess( $_[0]->to_locale_string() );
}
elsif ( ref $_[0] eq 'Template::Exception' ) {
$longmess = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $_[0]->[0] . "]\n\t[INFO]=[" . $_[0]->[1] . "]\n\t[TEXT]=[" . ( ref $_[0]->[2] eq 'SCALAR' ? ${ $_[0]->[2] } : $_[0]->[2] ) . "]\n" );
}
else {
$longmess = Cpanel::Carp::safe_longmess(@_);
$ignorable = 1 if index( $_[0], 'Use of uninitialized value' ) == 0;
}
my $error_container_text = 'A warning occurred while processing this directive.';
my $current_file = $Cpanel::Parser::Vars::file || 'unknown';
print STDERR "[$error_timestamp] warn [Internal Warning while parsing $current_file $$] $longmess\n\n";
return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} );
return if $ignorable && !$VERBOSE;
_run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew;
if ( $OUTPUT_FORMAT eq 'html' ) {
if ($SHOW_TRACE) {
_print_without_die_handler( _generate_html_error_message( 'warn', $error_container_text, $longmess ) );
}
else {
_print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>});
}
}
elsif ( $OUTPUT_FORMAT eq 'xml' ) {
_print_without_die_handler("<error>$error_container_text</error>");
}
else {
_print_without_die_handler("[$error_container_text]\n");
}
};
$SIG{'__DIE__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars)
return if $^S;
die $_[0] unless defined $^S;
delete $SIG{'__DIE__'};
_run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew;
_run_callback_without_die_handler($callback_before_die_spew) if $callback_before_die_spew;
$__CALLBACK_AFTER_DIE_SPEW = $callback_after_die_spew;
goto \&spew_on_die;
};
return 1;
}
sub spew_on_die { ## no critic qw(Subroutines::RequireArgUnpacking)
my ($err) = @_;
++$error_count;
my $time = time();
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time);
my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ];
my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday );
my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 );
my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz );
my $error_text;
if ( UNIVERSAL::isa( $err, 'Cpanel::Exception' ) ) {
$error_text = Cpanel::Carp::safe_longmess( $err->to_locale_string() );
}
elsif ( UNIVERSAL::isa( $err, 'Template::Exception' ) ) {
$error_text = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $err->type() . "]\n\t[INFO]=[" . $err->info() . "]\n\t[TEXT]=[" . $err->text() . "]\n" );
}
else {
$error_text = Cpanel::Carp::safe_longmess(@_);
}
my $current_file = $Cpanel::Parser::Vars::file || 'unknown';
print STDERR "[$error_timestamp] die [Internal Death while parsing $current_file $$] $error_text\n\n";
return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} );
my $error_container_text = 'A fatal error or timeout occurred while processing this directive.';
if ( $OUTPUT_FORMAT eq 'html' ) {
if ($SHOW_TRACE) {
_print_without_die_handler( _generate_html_error_message( 'error', $error_container_text, $error_text ) );
}
else {
_print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>});
}
}
elsif ( $OUTPUT_FORMAT eq 'xml' ) {
_print_without_die_handler("<error>[$error_container_text]</error>");
}
else {
_print_without_die_handler("[$error_container_text]\n");
}
_run_callback_without_die_handler($__CALLBACK_AFTER_DIE_SPEW) if $__CALLBACK_AFTER_DIE_SPEW;
return;
}
my @SAFE_LONGMESS_KEY_REGEXP_ITEMS = (
'(?<![a-zA-Z0-9_])pw(?![a-zA-Z0-9_])',
qw(
hash
pass
auth
root
key
fullbackup
),
);
my @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS = (
@SAFE_LONGMESS_KEY_REGEXP_ITEMS,
'__ANON__',
);
sub _print_without_die_handler {
my ($text) = @_;
local $SIG{'__WARN__'} = sub { };
local $SIG{'__DIE__'} = 'DEFAULT';
return print $text;
}
sub _run_callback_without_die_handler {
my ($callback) = @_;
local $SIG{'__WARN__'} = sub { };
local $SIG{'__DIE__'} = 'DEFAULT';
return $callback->();
}
sub _generate_html_error_message {
my ( $type, $error_container_message, $error_message ) = @_;
require Cpanel::Encoder::Tiny;
my $safe_error_message = Cpanel::Encoder::Tiny::safe_html_encode_str($error_message);
return qq[
<style type="text/css">.cpanel_internal_message_container {display: inline-block; margin: 10px; width: auto;} .cpanel_internal_message { border: 1px solid #fff; outline-style: solid; outline-width: 1px; outline-color: #aaa; padding: 5px; } .cpanel_internal_error_warn { background-color: #FFF6CF; } .cpanel_internal_error_error { background-color: #F8E7E6; }</style>
<div id="cpanel_notice_item_$error_count" class="cjt-pagenotice-container cjt-notice-container cpanel_internal_message_container internal-error-container">
<div class="yui-module cjt-notice cjt-pagenotice cjt-notice-$type">
<div class="cpanel_internal_message cpanel_internal_error_$type bd">
<div class="cjt-notice-content" style="width: 420px;">
<span>
$error_container_message
<a
class="error"
style="cursor:hand;cursor:pointer;"
onClick="document.getElementById('cpanel_internal_error_$error_count').style.display='';this.style.display='none'; return false;">
[show]
</a>
<a
class="error"
style="cursor:hand;cursor:pointer;"
onClick="document.getElementById('cpanel_notice_item_$error_count').style.display='none'; return false;">
[close]
</a>
</span>
<div id="cpanel_internal_error_$error_count" style="display:none;">
<textarea class="cpanel_internal_error_$type" style="font-weight:900; height:200px; width:410px; color: black;">$safe_error_message</textarea>
</div>
</div>
</div>
</div>
</div>
];
}
sub safe_longmess {
require Carp;
$Carp::Internal{'Cpanel::Carp'} = 1;
return sanitize_longmess( scalar Carp::longmess(@_) );
}
my ( $key_regexp, $key_regexp_double, $function_regexp );
sub sanitize_longmess {
_build_regexes() if !$key_regexp;
return join(
"\n",
map {
( tr{'"}{} && ( m{$key_regexp}o || m{$key_regexp_double}o || ( ( $_ =~ m{^[ \t]*([^\(]+)\(} )[0] || '' ) =~ m{$function_regexp}o ) ) # matches a line that needs to be sanitized
&& _sanitize_line($_); # sanitize
$_
} split( m{\n}, $_[0] )
) . "\n";
}
sub error_count {
return $error_count;
}
sub _sanitize_line { # Operates directly on $_[0] for speed
if ( !$INC{'Cpanel/Regex.pm'} ) { # PPI NO PARSE - inc check
local $@;
eval {
local $SIG{__DIE__};
local $SIG{__WARN__};
require Cpanel::Regex; # PPI NO PARSE - inc check
};
}
$_[0] =~ s/$Cpanel::Regex::regex{'singlequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{'} ) != -1;
$_[0] =~ s/$Cpanel::Regex::regex{'doublequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{"} ) != -1;
return 1;
}
sub _build_regexes {
my $key_regexp_items = join '|', @SAFE_LONGMESS_KEY_REGEXP_ITEMS;
$key_regexp = qr<
'
.*?
(?:
$key_regexp_items
)
.*?
'
\s*
,
>x;
$key_regexp_double = $key_regexp;
$key_regexp_double =~ tr{'}{"}; # "' fix for poor editors
my $function_regexp_items = join '|', @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS;
$function_regexp = qr<
::
.*?
(?:
$function_regexp_items
)
.*?
$
>x;
return 1;
}
1;
} # --- END Cpanel/Carp.pm
{ # --- BEGIN Cpanel/Set.pm
package Cpanel::Set;
use strict;
use warnings;
no warnings 'once';
sub difference {
my ($super_ar) = @_;
my %lookup;
@lookup{ map { @$_ } @_[ 1 .. $#_ ] } = ();
return grep { !exists $lookup{$_} } @$super_ar;
}
sub intersection {
my ( $super_ar, $sub_ar ) = @_;
my %lookup;
@lookup{@$sub_ar} = ();
return grep { exists $lookup{$_} } @$super_ar;
}
1;
} # --- END Cpanel/Set.pm
{ # --- BEGIN Cpanel/TimeHiRes.pm
package Cpanel::TimeHiRes;
use strict;
use warnings;
no warnings 'once';
use constant {
_gettimeofday => 96,
_clock_gettime => 228,
_CLOCK_REALTIME => 0,
_EINTR => 4,
_PACK_TEMPLATE => 'L!L!',
};
sub clock_gettime {
my $timeval = pack( _PACK_TEMPLATE, () );
_get_time_from_syscall(
_clock_gettime,
_CLOCK_REALTIME,
$timeval,
);
return unpack( _PACK_TEMPLATE, $timeval );
}
sub time {
my ( $secs, $nsecs ) = clock_gettime();
return $secs + ( $nsecs / 1_000_000_000 );
}
sub sleep {
my ($secs) = @_;
local $!;
my $retval = select( undef, undef, undef, $secs );
if ( $retval == -1 && $! != _EINTR ) {
require Cpanel::Exception;
die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to suspend command execution for [quant,_1,second,seconds] because of an error: [_2]', [ $secs, $! ] );
}
return $secs;
}
sub gettimeofday {
my $timeval = pack( _PACK_TEMPLATE, () );
_get_time_from_syscall(
_gettimeofday,
$timeval,
undef,
);
return unpack( _PACK_TEMPLATE, $timeval );
}
sub _get_time_from_syscall { ##no critic qw(RequireArgUnpacking)
my $syscall_num = shift;
local $!;
my $retval = syscall( $syscall_num, @_ );
if ( $retval == -1 ) {
require Cpanel::Exception;
die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to retrieve the time because of an error: [_1]', [$!] );
}
return;
}
1;
} # --- END Cpanel/TimeHiRes.pm
{ # --- BEGIN Cpanel/SafeFileLock.pm
package Cpanel::SafeFileLock;
use strict;
use warnings;
no warnings 'once';
use constant {
_ENOENT => 2,
_EDQUOT => 122,
DEBUG => 0,
MAX_LOCKFILE_SIZE => 8192,
};
sub new {
my ( $class, $path_to_lockfile, $fh, $path_to_file_being_locked ) = @_;
if ( scalar @_ != 4 ) {
die 'Usage: Cpanel::SafeFileLock->new($path_to_lockfile, $fh, $path_to_file_being_locked)';
}
if ($fh) {
write_lock_contents( $fh, $path_to_lockfile ) or return;
}
my $self = bless [
$path_to_lockfile,
$fh,
$path_to_file_being_locked,
], $class;
push @$self, @{ $self->stat_ar() }[ 1, 9 ];
return $self;
}
sub new_before_lock {
my ( $class, $path_to_lockfile, $path_to_file_being_locked ) = @_;
if ( scalar @_ != 3 ) {
die 'Usage: Cpanel::SafeFileLock->new_before_lock($path_to_lockfile, $path_to_file_being_locked)';
}
return bless [
$path_to_lockfile,
undef,
$path_to_file_being_locked,
], $class;
}
sub set_filehandle_and_unlinker_after_lock {
$_[0][1] = $_[1];
push @{ $_[0] }, @{ $_[0]->stat_ar() }[ 1, 9 ];
$_[0][5] = $_[2];
return $_[0];
}
sub get_path {
return $_[0]->[0];
}
sub get_path_to_file_being_locked {
return $_[0]->[2] // die "get_path_to_file_being_locked requires the object to be instantiated with the path_to_file_being_locked";
}
sub set_filehandle {
$_[0][1] = $_[1];
return $_[0];
}
sub get_filehandle {
return $_[0]->[1];
}
sub get_inode {
return $_[0]->[3];
}
sub get_mtime {
return $_[0]->[4];
}
sub get_path_fh_inode_mtime {
return @{ $_[0] }[ 0, 1, 3, 4 ];
}
sub stat_ar {
return [ stat( ( $_[0]->[1] && fileno( $_[0]->[1] ) ) ? $_[0]->[1] : $_[0]->[0] ) ];
}
sub lstat_ar {
return [ $_[0]->[1] && fileno( $_[0]->[1] ) ? stat( $_[0]->[1] ) : lstat( $_[0]->[0] ) ];
}
sub close {
return close $_[0]->[1] if ref $_[0]->[1];
$_[0]->[5] = undef;
return;
}
sub write_lock_contents { ## no critic qw(Subroutines::RequireArgUnpacking) -- only unpack on the failure case
local $!;
if (DEBUG) {
require Cpanel::Carp;
return 1 if syswrite( $_[0], "$$\n$0\n" . Cpanel::Carp::safe_longmess() . "\n" );
}
return 1 if syswrite( $_[0], "$$\n$0\n" );
my ( $fh, $path_to_lockfile ) = @_;
my $write_error = $!;
CORE::close($fh);
unlink $path_to_lockfile;
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::FileWriteError', [ 'path' => $path_to_lockfile, 'error' => $write_error ] );
}
sub fetch_lock_contents_if_exists {
my ($lockfile) = @_;
die 'Need lock file!' if !$lockfile;
open my $lockfile_fh, '<:stdio', $lockfile or do {
return if $! == _ENOENT();
die "open($lockfile): $!";
};
my $buffer;
my $read_result = read( $lockfile_fh, $buffer, MAX_LOCKFILE_SIZE );
if ( !defined $read_result ) {
die "read($lockfile): $!";
}
my ( $pid_line, $lock_name, $lock_obj ) = split( /\n/, $buffer, 3 );
chomp($lock_name) if length $lock_name;
my ($lock_pid) = $pid_line && ( $pid_line =~ m/(\d+)/ );
return ( $lock_pid, $lock_name || 'unknown', $lock_obj || 'unknown', $lockfile_fh );
}
1;
} # --- END Cpanel/SafeFileLock.pm
{ # --- BEGIN Cpanel/FHUtils/Tiny.pm
package Cpanel::FHUtils::Tiny;
use strict;
use warnings;
no warnings 'once';
sub is_a {
return !ref $_[0] ? 0 : ( ref $_[0] eq 'IO::Handle' || ref $_[0] eq 'GLOB' || UNIVERSAL::isa( $_[0], 'GLOB' ) ) ? 1 : 0;
}
sub are_same {
my ( $fh1, $fh2 ) = @_;
return 1 if $fh1 eq $fh2;
if ( fileno($fh1) && ( fileno($fh1) != -1 ) && fileno($fh2) && ( fileno($fh2) != -1 ) ) {
return 1 if fileno($fh1) == fileno($fh2);
}
return 0;
}
sub to_bitmask {
my @fhs = @_;
my $mask = q<>;
for my $fh (@fhs) {
vec( $mask, ref($fh) ? fileno($fh) : $fh, 1 ) = 1;
}
return $mask;
}
1;
} # --- END Cpanel/FHUtils/Tiny.pm
{ # --- BEGIN Cpanel/Hash.pm
package Cpanel::Hash;
use strict;
*get_fastest_hash = \&fnv1a_32;
use constant FNV1_32A_INIT => 0x811c9dc5;
use constant FNV_32_PRIME => 0x01000193;
use constant FNV_32_MOD => 2**32; # AKA 0x100000000 but that it non-portable;
sub fnv1a_32 {
my $fnv32 = FNV1_32A_INIT();
( $fnv32 = ( ( $fnv32 ^ $_ ) * FNV_32_PRIME() ) % FNV_32_MOD ) for unpack( 'C*', $_[0] );
return $fnv32;
}
1;
} # --- END Cpanel/Hash.pm
{ # --- BEGIN Cpanel/SafeFile/LockInfoCache.pm
package Cpanel::SafeFile::LockInfoCache;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::SafeFileLock (); # perlpkg line 211
sub new {
my ( $class, $pathname ) = @_;
die 'need path!' if !$pathname;
return bless { _path => $pathname }, $class;
}
sub get {
my ( $self, $inode, $mtime ) = @_;
die 'Need an inode & an mtime!' if !defined $inode || !defined $mtime;
if ( !exists $self->{"_inode_${inode}_$mtime"} ) {
my ( $pid, $name, $obj, $fh ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists( $self->{'_path'} );
if ($pid) {
my ( $real_inode, $real_mtime ) = ( stat $fh )[ 1, 9 ];
$self->{"_inode_${real_inode}_$real_mtime"} = [ $pid, $name, $obj ];
}
}
return $self->{"_inode_${inode}_$mtime"} ||= undef;
}
1;
} # --- END Cpanel/SafeFile/LockInfoCache.pm
{ # --- BEGIN Cpanel/SafeFile/LockWatcher.pm
package Cpanel::SafeFile::LockWatcher;
use strict;
use warnings;
no warnings 'once';
use constant _ENOENT => 2;
use constant _FILEHANDLE_TTL => 2;
sub new {
my ( $class, $lockfile ) = @_;
my $self = bless { _path => $lockfile, _new => 1 }, $class;
return $self->reload_from_disk();
}
sub reload_from_disk {
my ($self) = @_;
my $old_inode = $self->{'inode'};
@{$self}{qw( inode uid size mtime)} = $self->_get_inode_uid_size_mtime();
if ( delete $self->{'_new'} ) {
$self->{'changed'} = 0;
}
else {
$self->{'changed'} = ( $self->{'inode'} || 0 ) != ( $old_inode || 0 ) ? 1 : 0;
}
return $self;
}
sub _get_inode_uid_size_mtime {
my ($self) = @_;
my ( $inode, $uid, $size, $mtime );
local $!;
if ( open my $fh, '<', $self->{'_path'} ) {
( $inode, $uid, $size, $mtime ) = ( stat $fh )[ 1, 4, 7, 9 ];
$self->_add_fh_if_needed( $fh, $inode );
}
elsif ( $! != _ENOENT ) {
die "open(<, $self->{'_path'}): $!";
}
return ( $inode, $uid, $size, $mtime );
}
sub _add_fh_if_needed {
my ( $self, $fh, $inode ) = @_;
my $now = time;
my $fhs_hr = $self->{'_time_fhs'} //= {};
my $seen_inode = 0;
for my $time ( keys %$fhs_hr ) {
if ( ( $now - $time ) > _FILEHANDLE_TTL() ) {
delete $fhs_hr->{$time};
next;
}
if ( !$seen_inode ) {
foreach my $entry ( @{ $fhs_hr->{$time} } ) {
if ( $entry->[1] == $inode ) {
$seen_inode = 1;
last;
}
}
}
}
return if $seen_inode;
push @{ $fhs_hr->{ time() } }, [ $fh, $inode ];
return;
}
1;
} # --- END Cpanel/SafeFile/LockWatcher.pm
{ # --- BEGIN Cpanel/Syscall.pm
package Cpanel::Syscall;
use strict;
my %NAME_TO_NUMBER = qw(
close 3
fcntl 72
lchown 94
getrlimit 97
getsid 124
gettimeofday 96
sendfile 40
setrlimit 160
splice 275
write 1
setsid 112
getsid 124
inotify_init1 294
inotify_add_watch 254
inotify_rm_watch 255
setresuid 117
setresgid 119
setgroups 116
umount2 166
);
sub name_to_number {
my ($name) = @_;
return $NAME_TO_NUMBER{$name} || _die_unknown_syscall($name);
}
sub _die_unknown_syscall {
my ($name) = @_;
die "Unknown system call: “$name”";
}
sub syscall { ##no critic qw(RequireArgUnpacking)
local $!;
_die_unknown_syscall( $_[0] ) unless defined $_[0] && $NAME_TO_NUMBER{ $_[0] };
my $ret = CORE::syscall( $NAME_TO_NUMBER{ $_[0] }, scalar @_ > 1 ? @_[ 1 .. $#_ ] : () );
if ( ( $ret == -1 ) && $! ) {
if ( $INC{'Cpanel/Exception.pm'} ) {
die Cpanel::Exception::create( 'SystemCall', [ name => $_[0], error => $!, arguments => [ @_[ 1 .. $#_ ] ] ] );
}
else {
die "Failed system call “$_[0]”: $!";
}
}
return $ret;
}
1;
} # --- END Cpanel/Syscall.pm
{ # --- BEGIN Cpanel/Inotify.pm
package Cpanel::Inotify;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie (); # perlpkg line 211
# use Cpanel::Context (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::Pack (); # perlpkg line 211
# use Cpanel::Syscall (); # perlpkg line 211
use constant POLL_SIZE => 65536;
use constant READ_TEMPLATE => (
wd => 'i', #int Watch descriptor
mask => 'I', #uint32_t Mask of events
cookie => 'I', #uint32_t Unique cookie associating related events
len => 'I', #uint32_t Size of “name” field
);
my %add_flags;
my %read_flags;
my %init1_flag;
my $UNPACK_OBJ;
my $UNPACK_SIZE;
sub new {
my ( $class, %opts ) = @_;
if ( !$UNPACK_OBJ ) {
$UNPACK_OBJ = Cpanel::Pack->new( [ READ_TEMPLATE() ] );
$UNPACK_SIZE = $UNPACK_OBJ->sizeof();
_setup_flags();
}
my @given_flags = $opts{'flags'} ? @{ $opts{'flags'} } : ();
my $mask = 0;
for my $f (@given_flags) {
$mask |= $init1_flag{$f} || do {
die Cpanel::Exception->create_raw("Invalid inotify_init1 flag: “$f”");
};
}
my $fd = Cpanel::Syscall::syscall( 'inotify_init1', $mask );
my %self = (
_fd => $fd,
);
Cpanel::Autodie::open( $self{'_fh'}, '<&=', $fd );
return bless \%self, $class;
}
sub add {
my ( $self, $path, %opts ) = @_;
my @flags = @{ $opts{'flags'} };
my $mask = 0;
for my $f (@flags) {
$mask |= $add_flags{$f} || do {
die Cpanel::Exception->create_raw("Invalid inotify_add_watch flag: “$f”");
};
}
my $wd = Cpanel::Syscall::syscall(
'inotify_add_watch',
$self->{'_fd'},
$path,
$mask,
);
if ( $wd < 1 ) {
die Cpanel::Exception->create_raw("inotify watch descriptor “$wd” means something is wrong?");
}
$self->{'_watches'}{$wd} = $path;
return $wd;
}
sub remove {
my ( $self, $wd ) = @_;
Cpanel::Syscall::syscall( 'inotify_rm_watch', $self->{'_fd'}, $wd );
return;
}
sub poll {
my ($self) = @_;
Cpanel::Context::must_be_list();
my $buf = q<>;
Cpanel::Autodie::sysread_sigguard( $self->{'_fh'}, $buf, POLL_SIZE() );
my @events;
while ( length $buf ) {
my $evt = $UNPACK_OBJ->unpack_to_hashref( substr( $buf, 0, $UNPACK_SIZE, q<> ) );
$evt->{'name'} = substr( $buf, 0, delete( $evt->{'len'} ), q<> );
$evt->{'name'} =~ s<\0+\z><>; #trailing NULs
$evt->{'flags'} = _mask_to_flags_ar( delete $evt->{'mask'} );
push @events, $evt;
}
return @events;
}
sub fileno {
my ($self) = @_;
return fileno( $self->{'_fh'} );
}
sub _mask_to_flags_ar {
my ($mask) = @_;
my @flags;
for my $k ( keys %read_flags ) {
push @flags, $k if $mask & $read_flags{$k};
}
@flags = sort @flags;
return \@flags;
}
sub _setup_flags {
my %flag_num = (
ACCESS => 0x1, # File was accessed
MODIFY => 0x2, # File was modified
ATTRIB => 0x4, # Metadata changed
CLOSE_WRITE => 0x8, # File opened for writing was closed
CLOSE_NOWRITE => 0x10, # File not opened for writing was closed
OPEN => 0x20, # File was opened
MOVED_FROM => 0x40, # File was moved from X
MOVED_TO => 0x80, # File was moved to Y
CREATE => 0x100, # Subfile was created
DELETE => 0x200, # Subfile was deleted
DELETE_SELF => 0x400, # Self was deleted
MOVE_SELF => 0x800, # Self was moved
);
%read_flags = (
%flag_num,
UNMOUNT => 0x00002000, # Backing fs was unmounted
Q_OVERFLOW => 0x00004000, # Event queued overflowed ('wd' is -1)
IGNORED => 0x00008000, # Watch was removed
ISDIR => 0x40000000, # event occurred against dir
);
%add_flags = (
%flag_num,
ONLYDIR => 0x01000000, # only watch the path if it is a directory
DONT_FOLLOW => 0x02000000, # don't follow a sym link
EXCL_UNLINK => 0x04000000, # exclude events on unlinked objects
MASK_ADD => 0x20000000, # add to the mask of an already existing watch
ONESHOT => 0x80000000, # only send event once
CLOSE => $read_flags{'CLOSE_WRITE'} | $read_flags{'CLOSE_NOWRITE'},
MOVE => $read_flags{'MOVED_FROM'} | $read_flags{'MOVED_TO'},
);
my $mask = 0;
$mask |= $_ for values %flag_num;
$add_flags{'ALL_EVENTS'} = $mask;
%init1_flag = (
CLOEXEC => $Cpanel::Fcntl::Constants::O_CLOEXEC,
NONBLOCK => $Cpanel::Fcntl::Constants::O_NONBLOCK,
);
return;
}
1;
} # --- END Cpanel/Inotify.pm
{ # --- BEGIN Cpanel/SafeFile.pm
package Cpanel::SafeFile;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::TimeHiRes (); # perlpkg line 211
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::SafeFileLock (); # perlpkg line 211
# use Cpanel::FHUtils::Tiny (); # perlpkg line 211
use constant {
_EWOULDBLOCK => 11,
_EACCES => 13,
_EDQUOT => 122,
_ENOENT => 2,
_EINTR => 4,
_EEXIST => 17,
_ENOSPC => 28,
_EPERM => 1,
MAX_LOCK_CREATE_ATTEMPTS => 90,
NO_PERM_TO_WRITE_TO_DOTLOCK_DIR => -1,
INOTIFY_FILE_DISAPPEARED => 2,
CREATE_FCNTL_VALUE => ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_EXCL | $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_NONBLOCK ),
UNLOCK_FCNTL_VALUE => $Cpanel::Fcntl::Constants::LOCK_UN,
LOCK_FILE_PERMS => 0644,
DEFAULT_LOCK_WAIT_TIME => 196,
MAX_LOCK_WAIT_TIME => 400,
MAX_LOCK_FILE_LENGTH => 225,
};
$Cpanel::SafeFile::VERSION = '5.0';
my $OVERWRITE_FCNTL_VALUE;
my $verbose = 0; # initialized in safelock
our $LOCK_WAIT_TIME; #allow lock wait time to be overwritten
my $OPEN_LOCKS = 0;
our $TIME_BETWEEN_DOTLOCK_CHECKS = 0.3;
our $TIME_BETWEEN_FLOCK_CHECKS = 0.05;
our $MAX_FLOCK_WAIT = 60; # allowed to be overwritten in tests
our $_SKIP_DOTLOCK_WHEN_NO_PERMS = 0;
our $_SKIP_WARN_ON_OPEN_FAIL = 0;
my $DOUBLE_LOCK_DETECTED = 4096;
sub safeopen { #fh, open()-style mode, path
my ( $mode, $file ) = _get_open_args( @_[ 1 .. $#_ ] );
my $open_method_coderef = sub {
my $ret = open( $_[0], $_[1], $_[2] ) || do {
_log_warn("open($_[1], $_[2]): $!");
return undef;
};
return $ret;
};
return _safe_open( $_[0], $mode, $file, $open_method_coderef, 'safeopen' );
}
sub safesysopen_no_warn_on_fail {
local $_SKIP_WARN_ON_OPEN_FAIL = 1;
return safesysopen(@_);
}
sub safesysopen_skip_dotlock_if_not_root {
local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1;
return safesysopen(@_);
}
sub safeopen_skip_dotlock_if_not_root {
local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1;
return safeopen(@_);
}
sub safelock_skip_dotlock_if_not_root {
local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1;
return safelock(@_);
}
sub safereopen { ##no critic qw(RequireArgUnpacking)
my $fh = shift;
if ( !$fh ) {
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("Undefined filehandle not allowed!");
}
elsif ( !fileno $fh ) {
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("Closed filehandle ($fh) not allowed!");
}
my ( $mode, $file ) = _get_open_args(@_);
my $open_method_coderef = sub {
return open( $_[0], $_[1], $_[2] ) || do {
_log_warn("open($_[1], $_[2]): $!");
return undef;
};
};
return _safe_re_open( $fh, $mode, $file, $open_method_coderef, 'safereopen' );
}
sub safesysopen { ##no critic qw(RequireArgUnpacking)
my ( $file, $open_mode, $custom_perms ) = ( @_[ 1 .. 3 ] );
my ( $sysopen_perms, $original_umask );
$open_mode = _sanitize_open_mode($open_mode);
my $open_method_coderef = sub {
return sysopen( $_[0], $_[2], $_[1], $sysopen_perms ) || do {
_log_warn("open($_[2], $_[1], $sysopen_perms): $!") unless $_SKIP_WARN_ON_OPEN_FAIL;
return undef;
};
};
if ( defined $custom_perms ) {
$custom_perms &= 0777;
$original_umask = umask( $custom_perms ^ 07777 );
$sysopen_perms = $custom_perms;
}
else {
$sysopen_perms = 0666;
}
my $lock_ref;
local $@;
my $ok = eval {
$lock_ref = _safe_open( $_[0], $open_mode, $file, $open_method_coderef, 'safesysopen' );
1;
};
if ( defined $custom_perms ) {
umask($original_umask);
}
die if !$ok;
return $lock_ref;
}
sub safeclose {
my ( $fh, $lockref, $do_something_before_releasing_lock ) = @_;
if ( $do_something_before_releasing_lock && ref $do_something_before_releasing_lock eq 'CODE' ) {
$do_something_before_releasing_lock->();
}
my $success = 1;
if ( $fh && defined fileno $fh ) {
flock( $fh, UNLOCK_FCNTL_VALUE ) or _log_warn( "flock(LOCK_UN) on “" . $lockref->get_path() . "” failed with error: $!" ); # LOCK_UN
$success = close $fh;
}
my $safe_unlock = safeunlock($lockref);
$OPEN_LOCKS-- if ( $safe_unlock && $success );
return ( $safe_unlock && $success );
}
sub safelock {
my ($file) = @_;
my $lock_obj = _safelock($file);
return if !ref $lock_obj;
return $lock_obj;
}
sub _safelock {
my ($file) = @_;
if ( !$file || $file =~ tr/\0// ) {
_log_warn('safelock: Invalid arguments');
return;
}
$verbose ||= ( _verbose_flag_file_exists() ? 1 : -1 );
my $lockfile = _calculate_lockfile($file);
my $safefile_lock = Cpanel::SafeFileLock->new_before_lock( $lockfile, $file );
my ( $lock_status, $lock_fh, $attempts, $last_err );
{
local $@;
while ( ++$attempts < MAX_LOCK_CREATE_ATTEMPTS ) {
( $lock_status, $lock_fh ) = _lock_wait( $file, $safefile_lock, $lockfile );
last if $lock_status;
$last_err = $!;
if ( $lock_fh && $lock_fh == $DOUBLE_LOCK_DETECTED ) {
return 0;
}
}
}
if ( $lock_fh == 1 ) {
return 1;
}
elsif ( $lock_status && $lock_fh ) {
return $safefile_lock;
}
_log_warn( 'safelock: waited for lock (' . $lockfile . ') ' . $attempts . ' times' );
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::FileCreateError', [ 'path' => $lockfile, 'error' => $last_err ] );
}
sub _write_temp_lock_file {
my ($lockfile) = @_;
my $temp_file = sprintf(
'%s-%x-%x-%x',
$lockfile,
substr( rand, 2 ),
scalar( reverse time ),
scalar( reverse $$ ),
);
my ( $ok, $fh_or_err ) = _create_lockfile($temp_file);
if ( !$ok ) {
if ( $fh_or_err == _EPERM() || $fh_or_err == _EACCES() ) {
local $!;
my $lock_dir = _getdir($lockfile);
if ( !-w $lock_dir ) {
if ($_SKIP_DOTLOCK_WHEN_NO_PERMS) { # A hack to allow /etc/valiases to still be flock()ed until we can refactor
return ( NO_PERM_TO_WRITE_TO_DOTLOCK_DIR, $fh_or_err );
}
else {
_log_warn("safelock: Failed to create a lockfile '$temp_file' in the directory '$lock_dir' that isn't writable: $fh_or_err");
}
}
}
return ( 0, $fh_or_err );
}
Cpanel::SafeFileLock::write_lock_contents( $fh_or_err, $temp_file );
return ( $temp_file, $fh_or_err );
}
sub _try_to_install_lockfile {
my ( $temp_file, $lockfile ) = @_;
link( $temp_file => $lockfile ) or do {
return 0 if $! == _EEXIST;
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::LinkError', [ oldpath => $temp_file, newpath => $lockfile, error => $! ] );
};
return 1;
}
sub safeunlock {
my $lockref = shift;
if ( !$lockref ) {
_log_warn('safeunlock: Invalid arguments');
return;
}
elsif ( !ref $lockref ) {
return 1 if $lockref eq '1'; # No lock file created so just succeed
$lockref = Cpanel::SafeFileLock->new( $lockref, undef, undef );
if ( !$lockref ) {
_log_warn("safeunlock: failed to generate a Cpanel::SafeFileLock object from a path");
return;
}
}
my ( $lock_path, $fh, $lock_inode, $lock_mtime ) = $lockref->get_path_fh_inode_mtime();
my ( $filesys_lock_ino, $filesys_lock_mtime ) = ( lstat $lock_path )[ 1, 9 ];
if ( $fh && !defined fileno($fh) ) {
return 1;
}
elsif ( !$filesys_lock_mtime ) {
_log_warn( 'Lock on ' . $lockref->get_path_to_file_being_locked() . ' lost!' );
$lockref->close();
return; # return false on false
}
elsif ( $lock_inode && ( $lock_inode == $filesys_lock_ino ) && $lock_path && ( $lock_mtime == $filesys_lock_mtime ) ) {
unlink $lock_path or do {
_log_warn("Could not unlink lock file “$lock_path” as ($>/$)): $!\n");
$lockref->close();
return; # return false on false
};
return $lockref->close();
}
$lockref->close();
my ( $lock_pid, $lock_name, $lock_obj ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists($lock_path);
if ($lock_pid) {
if ( $lock_pid == $$ ) {
unlink $lock_path; # best-effort; ignore failure
return 1;
}
$lock_inode ||= 0;
$lock_mtime ||= 0;
_log_warn("[$$] Attempt to unlock file that was locked by another process [LOCK_PATH]=[$lock_path] [LOCK_PID]=[$lock_pid] [LOCK_PROCESS]=[$lock_name] [LOCK_INODE]=[$filesys_lock_ino] [LOCK_MTIME]=[$filesys_lock_mtime] -- [NON_LOCK_PID]=[$$] [NON_LOCK_PROCESS]=[$0] [NON_LOCK_INODE]=[$lock_inode] [NON_LOCK_MTIME]=[$lock_mtime]");
}
return;
}
sub _safe_open {
my ( undef, $open_mode, $file, $open_method_coderef, $open_method ) = @_;
if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) {
_log_warn('_safe_open: Invalid arguments');
return;
}
elsif ( defined $_[0] ) {
my $fh_type = ref $_[0];
if ( !Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) {
_log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'");
return;
}
}
if ( my $lockref = _safelock($file) ) {
if ( $open_method_coderef->( $_[0], $open_mode, $file ) ) {
if ( my $err = _do_flock_or_return_exception( $_[0], $open_mode, $file ) ) {
safeunlock($lockref);
local $@ = $err;
die;
}
$OPEN_LOCKS++;
return $lockref;
}
else {
local $!;
safeunlock($lockref);
return;
}
}
else {
_log_warn("safeopen: could not acquire a lock for '$file': $!");
return;
}
}
my $_lock_ex_nb;
my $_lock_sh_nb;
sub _do_flock_or_return_exception {
my ( $fh, $open_mode, $path ) = @_;
my $flock_start_time;
my $lock_op =
_is_write_open_mode($open_mode)
? ( $_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB )
: ( $_lock_sh_nb //= $Cpanel::Fcntl::Constants::LOCK_SH | $Cpanel::Fcntl::Constants::LOCK_NB );
local $!;
my $flock_err;
my $flock_max_wait_time_is_whole_number = int($MAX_FLOCK_WAIT) == $MAX_FLOCK_WAIT;
while ( !flock $fh, $lock_op ) {
$flock_err = $!;
if ( $flock_err == _EINTR || $flock_err == _EWOULDBLOCK ) {
if ( !$flock_start_time ) {
$flock_start_time = $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time();
next;
}
if ( ( ( $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time() ) - $flock_start_time ) > $MAX_FLOCK_WAIT ) {
require Cpanel::Exception;
return _timeout_exception( $path, $MAX_FLOCK_WAIT );
}
else {
Cpanel::TimeHiRes::sleep($TIME_BETWEEN_FLOCK_CHECKS);
}
next;
}
require Cpanel::Exception;
return Cpanel::Exception::create( 'IO::FlockError', [ path => $path, error => $flock_err, operation => $lock_op ] );
}
return undef;
}
sub _safe_re_open {
my ( $fh, $open_mode, $file, $open_method_coderef, $open_method ) = @_;
if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) {
_log_warn('_safe_re_open: Invalid arguments');
return;
}
else {
my $fh_type = ref $fh;
if ( !Cpanel::FHUtils::Tiny::is_a($fh) ) {
_log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'");
return;
}
}
close $fh;
if ( $open_method_coderef->( $fh, $open_mode, $file ) ) {
if ( my $err = _do_flock_or_return_exception( $fh, $open_mode, $file ) ) {
die $err;
}
return $fh;
}
return;
}
sub _log_warn {
require Cpanel::Debug;
goto &Cpanel::Debug::log_warn;
}
sub _get_open_args {
my ( $mode, $file ) = @_;
if ( !$file ) {
( $mode, $file ) = $mode =~ m/^([<>+|]+|)(.*)/;
if ( $file && !$mode ) {
$mode = '<';
}
elsif ( !$file ) {
return;
}
}
$mode =
$mode eq '<' ? '<'
: $mode eq '>' ? '>'
: $mode eq '>>' ? '>>'
: $mode eq '+<' ? '+<'
: $mode eq '+>' ? '+>'
: $mode eq '+>>' ? '+>>'
: return;
return ( $mode, $file );
}
sub _sanitize_open_mode {
my ($mode) = @_;
return if $mode =~ m/[^0-9]/;
my $safe_mode = ( $mode & $Cpanel::Fcntl::Constants::O_RDONLY );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_RDWR );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_CREAT );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_EXCL );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_APPEND );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_TRUNC );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_NONBLOCK );
return $safe_mode;
}
sub _calculate_lockfile { ## no critic qw(Subroutines::RequireArgUnpacking)
my $lockfile = $_[0] =~ tr{<>}{} ? ( ( $_[0] =~ /^[><]*(.*)/ )[0] . '.lock' ) : $_[0] . '.lock';
return $lockfile if ( length $lockfile <= MAX_LOCK_FILE_LENGTH );
require File::Basename;
my $lock_basename = File::Basename::basename($lockfile);
return $lockfile if ( length $lock_basename <= MAX_LOCK_FILE_LENGTH );
require Cpanel::Hash;
my $hashed_lock_basename = Cpanel::Hash::get_fastest_hash($lock_basename) . ".lock";
if ( $lockfile eq $lock_basename ) {
return $hashed_lock_basename;
}
else {
return File::Basename::dirname($lockfile) . '/' . $hashed_lock_basename;
}
}
sub is_locked {
my ($file) = @_;
my $lockfile = _calculate_lockfile($file);
my ( $lock_pid, $lock_name, $lock_obj ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists($lockfile);
if ( _is_valid_pid($lock_pid) && _pid_is_alive($lock_pid) ) {
return 1;
}
return 0;
}
sub _timeout_exception {
my ( $path, $waited ) = @_;
require Cpanel::Exception;
return Cpanel::Exception::create( 'Timeout', 'The system failed to lock the file “[_1]” after [quant,_2,second,seconds].', [ $path, $waited ] );
}
sub _die_if_file_is_flocked_cuz_already_waited_a_while {
my ( $file, $waited ) = @_;
if ( _open_to_write( my $fh, $file ) ) {
$_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB;
if ( flock( $fh, $_lock_ex_nb ) == 1 ) {
flock $fh, UNLOCK_FCNTL_VALUE or die "Failed to unlock “$file” after having just locked it: $!";
}
else {
require Cpanel::Exception;
if ( $! == _EWOULDBLOCK ) {
die _timeout_exception( $file, $waited );
}
else {
die Cpanel::Exception::create( 'IO::FlockError', [ path => $file, error => $!, operation => $_lock_ex_nb ] );
}
}
}
return;
}
sub _lock_wait { ## no critic qw(Subroutines::ProhibitExcessComplexity)
my ( $file, $safefile_lock, $lockfile ) = @_;
my ( $temp_file, $fh ) = _write_temp_lock_file( $lockfile, $file );
if ( $temp_file eq NO_PERM_TO_WRITE_TO_DOTLOCK_DIR ) {
return ( 1, 1 );
}
if ( !$temp_file ) {
return ( 0, $fh );
}
$safefile_lock->set_filehandle_and_unlinker_after_lock( $fh, Cpanel::SafeFile::_temp->new($temp_file) );
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
local $0 = ( $verbose == 1 ) ? "$0 - waiting for lock on $file" : "$0 - waiting for lock";
require Cpanel::SafeFile::LockInfoCache;
require Cpanel::SafeFile::LockWatcher;
my $watcher = Cpanel::SafeFile::LockWatcher->new($lockfile);
my $waittime = _calculate_waittime_for_file($file);
my ( $inotify_obj, $inotify_mask, $inotify_file_disappeared );
my $start_time = time;
my $waited = 0;
my $lockfile_cache = Cpanel::SafeFile::LockInfoCache->new($lockfile);
my ( $inotify_inode, $inotify_mtime );
LOCK_WAIT:
while (1) {
$waited = ( time() - $start_time );
if ( $waited > $waittime ) {
_die_if_file_is_flocked_cuz_already_waited_a_while( $file, $waited );
if ( defined $watcher->{'inode'} ) {
require Cpanel::Debug;
Cpanel::Debug::log_warn( sprintf "Replacing stale lock file: $lockfile. The kernel’s lock is gone, last modified %s seconds ago (mtime=$watcher->{'mtime'}), and waited over $waittime seconds.", time - $watcher->{'mtime'} );
}
return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} );
die _timeout_exception( $file, $waittime );
}
if ( $watcher->{'inode'} ) {
my $lock_get = $lockfile_cache->get( @{$watcher}{ 'inode', 'mtime' } );
if ( !$lock_get ) {
my $size_before_reload = $watcher->{'size'};
$watcher->reload_from_disk();
if ( $size_before_reload == 0 && $watcher->{'size'} == 0 ) {
_log_warn("[$$] UID $> clobbering empty lock file “$lockfile” (UID $watcher->{'uid'}) written by “unknown” at $watcher->{'mtime'}");
return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} );
}
next LOCK_WAIT;
}
my ( $lock_pid, $lock_name, $lock_obj ) = @$lock_get;
if ( $lock_pid == $$ ) {
$watcher->reload_from_disk();
_log_warn("[$$] Double locking detected by self [LOCK_PATH]=[$lockfile] [LOCK_PID]=[$lock_pid] [LOCK_OBJ]=[$lock_obj] [LOCK_PROCESS]=[$lock_name] [ACTUAL_INODE]=[$watcher->{'inode'}] [ACTUAL_MTIME]=[$watcher->{'mtime'}]");
return ( 0, $DOUBLE_LOCK_DETECTED );
}
elsif ( !_pid_is_alive($lock_pid) ) {
my $time = time();
if ( _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} ) ) {
_log_warn("[$$] TIME $time UID $> clobbered stale lock file “$lockfile” (NAME “$lock_name”, UID $watcher->{'uid'}) written by PID $lock_pid at $watcher->{'mtime'}");
return ( 1, $fh );
}
$watcher->reload_from_disk();
next LOCK_WAIT;
}
else {
require Cpanel::Debug;
Cpanel::Debug::log_info("[$$] Waiting for lock on $file held by $lock_name with pid $lock_pid") if $verbose == 1;
}
}
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
$watcher->reload_from_disk();
if ( !$inotify_obj || !$inotify_inode || !$watcher->{'inode'} || $inotify_inode != $watcher->{'inode'} || $inotify_mtime != $watcher->{'mtime'} ) {
INOTIFY: {
( $inotify_obj, $inotify_mask, $inotify_file_disappeared ) = _generate_inotify_for_lock_file($lockfile);
$watcher->reload_from_disk();
if ( $inotify_file_disappeared || !$watcher->{'inode'} ) {
undef $inotify_obj;
next LOCK_WAIT;
}
redo INOTIFY if $watcher->{'changed'};
( $inotify_inode, $inotify_mtime ) = @{$watcher}{ 'inode', 'mtime' };
}
}
my $selected = _select( my $m = $inotify_mask, undef, undef, $TIME_BETWEEN_DOTLOCK_CHECKS );
if ( $selected == -1 ) {
die "select() error: $!" if $! != _EINTR();
}
elsif ($selected) {
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
$watcher->reload_from_disk();
() = $inotify_obj->poll();
}
}
return;
}
sub _select {
return select( $_[0], $_[1], $_[2], $_[3] );
}
sub _generate_inotify_for_lock_file {
my ($file) = @_;
require Cpanel::Inotify;
my $inotify_obj;
my $rin = '';
local $@;
eval {
$inotify_obj = Cpanel::Inotify->new( flags => ['NONBLOCK'] );
$inotify_obj->add( $file, flags => [ 'ATTRIB', 'DELETE_SELF' ] );
vec( $rin, $inotify_obj->fileno(), 1 ) = 1;
};
if ($@) {
my $err = $@;
if ( eval { $err->isa('Cpanel::Exception::SystemCall') } ) {
my $err = $err->get('error');
if ( $err == _ENOENT ) {
return ( undef, undef, INOTIFY_FILE_DISAPPEARED );
}
elsif ( $err != _EACCES ) { # Don’t warn if EACCES
local $@ = $err;
warn;
}
}
else {
local $@ = $err;
warn;
}
return;
}
return ( $inotify_obj, $rin, 0 );
}
sub _pid_is_alive {
my ($pid) = @_;
local $!;
if ( kill( 0, $pid ) ) {
return 1;
}
elsif ( $! == _EPERM ) {
return !!( stat "/proc/$pid" )[0];
}
return 0;
}
sub _calculate_waittime_for_file {
my ($file) = @_;
return $LOCK_WAIT_TIME if $LOCK_WAIT_TIME;
my $waittime = DEFAULT_LOCK_WAIT_TIME;
if ( -e $file ) {
$waittime = int( ( stat _ )[7] / 10000 );
$waittime = $waittime > MAX_LOCK_WAIT_TIME ? MAX_LOCK_WAIT_TIME : $waittime < DEFAULT_LOCK_WAIT_TIME ? DEFAULT_LOCK_WAIT_TIME : $waittime;
}
return $waittime;
}
sub _is_valid_pid {
my $pid = shift;
return 0 unless defined $pid;
return $pid =~ tr{0-9}{}c ? 0 : 1;
}
sub _getdir {
my @path = split( /\/+/, $_[0] );
return join( '/', (@path)[ 0 .. ( $#path - 1 ) ] ) || '.';
}
sub _create_lockfile {
my $lock_fh;
return sysopen( $lock_fh, $_[0], CREATE_FCNTL_VALUE, LOCK_FILE_PERMS ) ? ( 1, $lock_fh ) : ( 0, $! );
}
sub _open_to_write {
my $path = $_[1];
$OVERWRITE_FCNTL_VALUE ||= ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_NONBLOCK | $Cpanel::Fcntl::Constants::O_APPEND | $Cpanel::Fcntl::Constants::O_NOFOLLOW );
return sysopen( $_[0], $path, $OVERWRITE_FCNTL_VALUE, LOCK_FILE_PERMS );
}
sub _overwrite_lockfile_if_inode_mtime_matches {
my ( $temp_file, $lockfile, $lockfile_inode, $lockfile_mtime ) = @_;
my ( $inode, $mtime ) = ( stat $lockfile )[ 1, 9 ];
if ( !$inode ) {
die "stat($lockfile): $!" if $! != _ENOENT();
}
if ( !$inode || ( $inode == $lockfile_inode && $mtime == $lockfile_mtime ) ) {
rename( $temp_file, $lockfile ) or do {
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::RenameError', [ oldpath => $temp_file, newpath => $lockfile, error => $! ] );
};
return 1;
}
return 0;
}
sub _is_write_open_mode {
my ($mode) = @_;
if ( $mode =~ tr{0-9}{}c ) {
if ( $mode && ( -1 != index( $mode, '>' ) || -1 != index( $mode, '+' ) ) ) {
return 1;
}
}
else {
if ( $mode && ( ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY ) || ( $mode & $Cpanel::Fcntl::Constants::O_RDWR ) ) ) {
return 1;
}
}
return 0;
}
sub _verbose_flag_file_exists {
return -e '/var/cpanel/safefile_verbose';
}
package Cpanel::SafeFile::_temp;
use constant _ENOENT => 2;
sub new { return bless [ $_[1], $_SKIP_DOTLOCK_WHEN_NO_PERMS, $$ ], $_[0]; }
sub DESTROY {
local $!;
unlink $_[0]->[0] or do {
if ( !$_[0]->[1] && $! != _ENOENT && $_[0]->[2] == $$ ) {
warn "unlink($_[0]->[0]): $!";
}
};
return;
}
1;
} # --- END Cpanel/SafeFile.pm
{ # --- BEGIN Cpanel/LoadModule.pm
package Cpanel::LoadModule;
use strict;
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::LoadModule::Utils (); # perlpkg line 211
my $logger;
my $has_perl_dir = 0;
sub _logger_warn {
my ( $msg, $fail_ok ) = @_;
return if $fail_ok && $ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == -1;
if ( $INC{'Cpanel/Logger.pm'} ) {
$logger ||= 'Cpanel::Logger'->new();
$logger->warn($msg);
}
return warn $msg;
}
sub _reset_has_perl_dir {
$has_perl_dir = 0;
return;
}
sub load_perl_module { ## no critic qw(Subroutines::RequireArgUnpacking)
if ( -1 != index( $_[0], q<'> ) ) {
die Cpanel::Exception::create_raw( 'InvalidParameter', "Module names with single-quotes are prohibited. ($_[0])" );
}
return $_[0] if Cpanel::LoadModule::Utils::module_is_loaded( $_[0] );
my ( $mod, @LIST ) = @_;
local ( $!, $@ );
if ( !is_valid_module_name($mod) ) {
die Cpanel::Exception::create( 'InvalidParameter', '“[_1]” is not a valid name for a Perl module.', [$mod] );
}
my $args_str;
if (@LIST) {
$args_str = join ',', map {
die "Only scalar arguments allowed in LIST! (@LIST)" if ref;
_single_quote($_);
} @LIST;
}
else {
$args_str = q<>;
}
eval "use $mod ($args_str);"; ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
if ($@) {
die Cpanel::Exception::create( 'ModuleLoadError', [ module => $mod, error => $@ ] );
}
return $mod;
}
*module_is_loaded = *Cpanel::LoadModule::Utils::module_is_loaded;
*is_valid_module_name = *Cpanel::LoadModule::Utils::is_valid_module_name;
sub loadmodule {
return 1 if cpanel_namespace_module_is_loaded( $_[0] );
return _modloader( $_[0] );
}
sub lazy_load_module {
my $mod = shift;
my $mod_path = $mod;
$mod_path =~ s{::}{/}g;
if ( exists $INC{ $mod_path . '.pm' } ) {
return;
}
if ( !is_valid_module_name($mod) ) {
_logger_warn("Cpanel::LoadModule: Invalid module name ($mod)");
return;
}
eval "use $mod ();";
if ($@) {
delete $INC{ $mod_path . '.pm' };
_logger_warn( "Cpanel::LoadModule:: Failed to load module $mod - $@", 1 );
return;
}
return 1;
}
sub cpanel_namespace_module_is_loaded {
my ($modpart) = @_;
$modpart =~ s{::}{/}g;
return exists $INC{"Cpanel/$modpart.pm"} ? 1 : 0;
}
sub _modloader {
my $module = shift;
if ( !$module ) {
_logger_warn("Empty module name passed to modloader");
return;
}
if ( !is_valid_module_name($module) ) {
_logger_warn("Invalid module name ($module) passed to modloader");
return;
}
eval qq[ use Cpanel::${module}; Cpanel::${module}::${module}_init() if "Cpanel::${module}"->can("${module}_init"); ]; # PPI USE OK - This looks like usage of the Cpanel module and it's not.
if ($@) {
_logger_warn("Error loading module $module - $@");
return;
}
return 1;
}
sub _single_quote {
local ($_) = $_[0];
s/([\\'])/\\$1/g;
return qq('$_');
}
1;
} # --- END Cpanel/LoadModule.pm
{ # --- BEGIN Cpanel/Linux/Constants.pm
package Cpanel::Linux::Constants;
use strict;
use warnings;
no warnings 'once';
use constant {
NAME_MAX => 255,
PATH_MAX => 4096,
};
1;
} # --- END Cpanel/Linux/Constants.pm
{ # --- BEGIN Cpanel/Validate/FilesystemNodeName.pm
package Cpanel::Validate::FilesystemNodeName;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Linux::Constants (); # perlpkg line 211
sub is_valid {
my ($node) = @_;
local $@;
eval { validate_or_die($node); };
return $@ ? 0 : 1;
}
sub validate_or_die {
my ($name) = @_;
if ( !length $name ) {
die Cpanel::Exception::create('Empty');
}
elsif ( $name eq '.' || $name eq '..' ) {
die Cpanel::Exception::create( 'Reserved', [ value => $name ] );
}
elsif ( length $name > Cpanel::Linux::Constants::NAME_MAX() ) {
die Cpanel::Exception::create( 'TooManyBytes', [ value => $name, maxlength => Cpanel::Linux::Constants::NAME_MAX() ] );
}
elsif ( index( $name, '/' ) != -1 ) {
die Cpanel::Exception::create( 'InvalidCharacters', [ value => $name, invalid_characters => ['/'] ] );
}
elsif ( index( $name, "\0" ) != -1 ) {
die Cpanel::Exception::create( 'InvalidCharacters', 'This value may not contain a [asis,NUL] byte.', [ value => $name, invalid_characters => ["\0"] ] );
}
return 1;
}
1;
} # --- END Cpanel/Validate/FilesystemNodeName.pm
{ # --- BEGIN Cpanel/Notify.pm
package Cpanel::Notify;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Set (); # perlpkg line 211
# use Cpanel::Fcntl (); # perlpkg line 211
# use Cpanel::SafeFile (); # perlpkg line 211
# use Cpanel::LoadModule (); # perlpkg line 211
# use Cpanel::Validate::FilesystemNodeName (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
our $VERSION = '1.8';
my $DEFAULT_CONTENT_TYPE = 'text/plain; charset=utf-8';
our $NOTIFY_INTERVAL_STORAGE_DIR = '/var/cpanel/notifications';
sub notification_class {
my (%args) = @_;
if ( !defined $args{'interval'} ) {
$args{'interval'} = 1;
}
if ( !defined $args{'status'} ) {
$args{'status'} = 'No status set';
}
foreach my $param (qw(application status class constructor_args)) {
die Cpanel::Exception::create( 'MissingParameter', [ 'name' => $param ] ) if !defined $args{$param};
}
if ( my @unwelcome_params = Cpanel::Set::difference( [ keys %args ], [qw(application status class constructor_args interval)] ) ) {
die Cpanel::Exception::create_raw(
'InvalidParameters',
"The following parameters don't belong as an argument to notification_class(); you may have meant to pass these in constructor_args instead: " . join( ' ', @unwelcome_params )
);
}
my $constructor_args = { @{ $args{'constructor_args'} } };
if ( $constructor_args->{'skip_send'} ) {
my $class = "Cpanel::iContact::Class::$args{'class'}";
Cpanel::LoadModule::load_perl_module($class);
return $class->new(%$constructor_args);
}
return _notification_backend(
$args{'application'},
$args{'status'},
$args{'interval'},
sub {
my $class = "Cpanel::iContact::Class::$args{'class'}";
Cpanel::LoadModule::load_perl_module($class);
return $class->new(%$constructor_args);
},
);
}
sub notification {
my %AGS = @_;
my $app = $AGS{'app'} || $AGS{'application'} || 'Notice';
return _notification_backend(
$app,
$AGS{'status'},
$AGS{'interval'} || 0,
sub {
my $module = "Cpanel::iContact";
Cpanel::LoadModule::load_perl_module($module);
my $from = $AGS{'from'};
my $to = $AGS{'to'};
my $msgheader = $AGS{'msgheader'} || $AGS{'subject'};
my $message = $AGS{'message'};
my $plaintext_message = $AGS{'plaintext_message'};
my $priority = $AGS{'priority'} || 3;
my $attach_files = $AGS{'attach_files'} || [];
my $content_type = $AGS{'content-type'} || $DEFAULT_CONTENT_TYPE;
"$module"->can('icontact')->(
'attach_files' => $attach_files,
'application' => $app,
'level' => $priority,
'from' => $from,
'to' => $to,
'subject' => $msgheader,
'message' => $message,
'plaintext_message' => $plaintext_message,
'content-type' => $content_type,
);
}
);
}
sub _notification_backend {
my ( $app, $status, $interval, $todo_cr ) = @_;
my $is_ready = _checkstatusinterval(
'app' => $app,
'status' => $status,
'interval' => $interval,
);
if ($is_ready) {
return $todo_cr->();
}
elsif ( $Cpanel::Debug::level > 3 ) {
Cpanel::Debug::log_warn("not sending notify app=[$app] status=[$status] interval=[$interval]");
}
return $is_ready ? 1 : 0;
}
sub notify_blocked {
my %AGS = @_;
my $app = $AGS{'app'};
my $status = $AGS{'status'};
my $interval = $AGS{'interval'};
return 0 if $interval <= 1; # Special Case (ignore interval check);
$app =~ s{/}{_}g; # Its possible to have slashes in the app name
$status =~ s{:}{_}g; # Its possible to have colons in the status
my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app";
return 0 if !-e $db_file;
my %notifications;
my $notify_db_fh;
if (
my $nlock = Cpanel::SafeFile::safesysopen(
$notify_db_fh, $db_file, Cpanel::Fcntl::or_flags('O_RDONLY'),
0600
)
) {
local $/;
%notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) );
Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock );
}
else {
Cpanel::Debug::log_warn("Could not open $db_file: $!");
return;
}
if ( $notifications{$status} && ( ( $notifications{$status} + $interval ) > time() ) ) {
return 1;
}
return 0;
}
{
no warnings 'once';
*update_notification_time_if_interval_reached = \&_checkstatusinterval;
}
sub _checkstatusinterval {
my %AGS = @_;
my $app = $AGS{'app'};
my $status = $AGS{'status'};
my $interval = $AGS{'interval'};
return 1 if $interval <= 1; # Special Case (ignore interval check);
$app =~ s{/}{_}g; # Its possible to have slashes in the app name
$status =~ s{:}{_}g; # Its possible to have colons in the status
Cpanel::Validate::FilesystemNodeName::validate_or_die($app);
my $notify = 0;
if ( !-e $NOTIFY_INTERVAL_STORAGE_DIR ) {
Cpanel::LoadModule::load_perl_module('Cpanel::SafeDir::MK');
Cpanel::SafeDir::MK::safemkdir( $NOTIFY_INTERVAL_STORAGE_DIR, '0700' );
if ( !-d $NOTIFY_INTERVAL_STORAGE_DIR ) {
Cpanel::Debug::log_warn("Failed to setup notifications directory: $NOTIFY_INTERVAL_STORAGE_DIR: $!");
return;
}
}
my %notifications;
my $notify_db_fh;
my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app";
if ( my $nlock = Cpanel::SafeFile::safesysopen( $notify_db_fh, $db_file, Cpanel::Fcntl::or_flags(qw( O_RDWR O_CREAT )), 0600 ) ) {
local $/;
%notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) );
if ( !exists $notifications{$status} || ( int( $notifications{$status} ) + int($interval) ) < time() ) {
$notifications{$status} = time;
$notify = 1;
}
seek( $notify_db_fh, 0, 0 );
print {$notify_db_fh} join( "\n", map { $_ . ':' . $notifications{$_} } sort keys %notifications );
truncate( $notify_db_fh, tell($notify_db_fh) );
Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock );
}
else {
Cpanel::Debug::log_warn("Could not open $db_file: $!");
return;
}
return $notify;
}
1;
} # --- END Cpanel/Notify.pm
{ # --- BEGIN Cpanel/Server/Utils.pm
package Cpanel::Server::Utils;
use strict;
sub is_subprocess_of_cpsrvd {
return 0 if $INC{'cpanel/cpsrvd.pm'}; # If we ARE cpsrvd we do not want this behavior
return $ENV{'CPANEL'} ? 1 : 0;
}
1;
} # --- END Cpanel/Server/Utils.pm
{ # --- BEGIN Cpanel/Logger.pm
package Cpanel::Logger;
use strict;
# use Cpanel::Time::Local (); # perlpkg line 211
my $is_sandbox;
my $is_smoker;
our $VERSION = 1.3;
use constant TRACE_TOUCH_FILE => '/var/cpanel/log_stack_traces';
our $ENABLE_BACKTRACE;
our $DISABLE_OUTPUT; # used by cpanminus
our $ALWAYS_OUTPUT_TO_STDERR;
our $STD_LOG_FILE = '/usr/local/cpanel/logs/error_log';
our $PANIC_LOG_FILE = '/usr/local/cpanel/logs/panic_log';
my ( $cached_progname, $cached_prog_pid, %singleton_stash );
sub new {
my ( $class, $hr_args ) = @_;
if ( $hr_args->{'open_now'} && $hr_args->{'use_no_files'} ) {
die "“open_now” and “use_no_files” mutually exclude!";
}
my $args_sig = 'no_args';
if ( $hr_args && ref($hr_args) eq 'HASH' ) {
$args_sig = join( ',', map { $_ . '=>' . $hr_args->{$_} } sort keys %{$hr_args} ); # Storable::freeze($hr_args);
}
my $no_load_from_cache = $hr_args->{'no_load_from_cache'} ? 1 : 0;
if ( exists $singleton_stash{$class}{$args_sig} and !$no_load_from_cache ) {
$singleton_stash{$class}{$args_sig}->{'cloned'}++;
}
else {
$singleton_stash{$class}{$args_sig} = bless( {}, $class );
if ( $hr_args && ref($hr_args) eq 'HASH' ) {
foreach my $k ( keys %$hr_args ) {
$singleton_stash{$class}{$args_sig}->{$k} = $hr_args->{$k};
}
}
}
my $self = $singleton_stash{$class}{$args_sig};
if ( !$self->{'cloned'} ) {
if ( $self->{'open_now'} && !$self->{'use_no_files'} ) {
$self->_open_logfile();
}
}
$self->_set_backtrace( $ENABLE_BACKTRACE // $self->{'backtrace'} // _get_backtrace_touchfile() );
return $self;
}
sub __Logger_pushback {
if ( @_ && index( ref( $_[0] ), __PACKAGE__ ) == 0 ) {
return @_;
}
return ( __PACKAGE__->new(), @_ );
}
sub invalid {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'invalid',
'output' => 0,
'service' => $self->find_progname(),
'backtrace' => $self->get_backtrace(),
'die' => 0,
);
if ( is_sandbox() ) {
if ( !-e '/var/cpanel/DEBUG' ) {
$self->notify( 'invalid', \%log );
}
$log{'output'} = _stdin_is_tty() ? 2 : 1;
}
return $self->logger( \%log );
} # end of invalid
sub is_sandbox {
return 0 if $INC{'B/C.pm'}; # avoid cache during compile
return $is_sandbox if defined $is_sandbox;
return ( $is_sandbox = -e '/var/cpanel/dev_sandbox' ? 1 : 0 );
}
sub is_smoker {
return 0 if $INC{'B/C.pm'}; # avoid cache during compile
return $is_smoker if defined $is_smoker;
return ( $is_smoker = -e '/var/cpanel/smoker' ? 1 : 0 );
}
sub deprecated { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'deprecated',
'output' => 0,
'service' => $self->find_progname(),
'backtrace' => $self->get_backtrace(),
'die' => 0,
);
unless ( is_sandbox() ) {
$self->logger( \%log );
return;
}
$self->notify( 'deprecated', \%log );
$log{'output'} = _stdin_is_tty() ? 2 : 1;
$log{'die'} = 1;
return $self->logger( \%log );
}
sub debug {
my ( $self, $message, $conf_hr ) = @_; # not appropriate for debug() : __Logger_pushback(@_);
$self = $self->new() if !ref $self;
$conf_hr ||= {
'force' => 0,
'backtrace' => 0,
'output' => 1, # Logger's debug level should output to STDOUT
};
return unless $conf_hr->{'force'} || ( defined $Cpanel::Debug::level && $Cpanel::Debug::level ); ## PPI NO PARSE - avoid recursive use statements
if ( !defined $message ) {
my @caller = caller();
$message = "debug() at $caller[1] line $caller[2].";
}
my %log = (
'message' => $message,
'level' => 'debug',
'output' => $conf_hr->{'output'},
'backtrace' => $conf_hr->{'backtrace'},
);
if ( ref $log{'message'} ) {
my $outmsg = $log{'message'};
eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::YAML::Syck; $outmsg = YAML::Syck::Dump($outmsg);';
my @caller = caller();
$log{'message'} = "$log{'message'} at $caller[1] line $caller[2]:\n" . $outmsg;
}
elsif ( $log{'message'} =~ m/\A\d+(?:\.\d+)?\z/ ) {
$log{'message'} = "debug() number $log{'message'}";
}
$self->logger( \%log );
return \%log;
}
sub info {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'info',
'output' => $self->{'open_now'} ? 0 : 1, # FB#59177: info level should output to STDOUT
'backtrace' => 0
}
);
} # end of info
sub warn {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'warn',
'output' => _stdin_is_tty() ? 2 : 0,
'backtrace' => $self->get_backtrace()
}
);
} # end of warn
sub error {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'error',
'output' => -t STDIN ? 2 : 0,
'backtrace' => $self->get_backtrace()
}
);
} # end of error
sub die {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'die',
'output' => _stdin_is_tty() ? 2 : 0,
'backtrace' => $self->get_backtrace()
);
return $self->logger( \%log );
} # end of die
sub panic {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'panic',
'output' => 2,
'backtrace' => $self->get_backtrace()
);
return $self->logger( \%log );
} # end of panic
sub raw {
return $_[0]->logger(
{
'message' => $_[1],
'level' => 'raw',
'output' => 0,
'backtrace' => 0
}
);
}
sub cplog {
my $msg = shift;
my $loglevel = shift;
my $service = shift;
my $nostdout = shift;
if ( !$nostdout ) {
$nostdout = 1;
}
else {
$nostdout = 0;
}
logger( { 'message' => $msg, 'level' => $loglevel, 'service' => $service, 'output' => $nostdout, 'backtrace' => $ENABLE_BACKTRACE // _get_backtrace_touchfile() } );
} # end of cplog (deprecated)
sub _get_configuration_for_logger {
my ( $self, $cfg_or_msg ) = @_;
my $hr = ref($cfg_or_msg) eq 'HASH' ? $cfg_or_msg : { 'message' => $cfg_or_msg };
$hr->{'message'} ||= 'Something is wrong';
$hr->{'level'} ||= '';
$hr->{'output'} ||= 0;
$hr->{'output'} = 0 if $DISABLE_OUTPUT;
if ( !exists $hr->{'backtrace'} ) {
$hr->{'backtrace'} = $self->get_backtrace();
}
$hr->{'use_no_files'} ||= 0;
$hr->{'use_fullmsg'} ||= 0;
return $hr;
}
sub _write {
return print { $_[0] } $_[1];
}
sub get_backtrace {
my ($self) = __Logger_pushback(@_);
return $ENABLE_BACKTRACE // $self->{'backtrace'};
}
sub _set_backtrace {
my ( $self, @args ) = __Logger_pushback(@_);
$self->{'backtrace'} = $args[0] ? 1 : 0;
return;
}
sub _get_backtrace_touchfile {
return -e TRACE_TOUCH_FILE ? 1 : 0;
}
sub get_fh {
my ($self) = @_;
return $self->{'log_fh'};
}
sub set_fh {
my ( $self, $fh ) = @_;
$self->{'log_fh'} = $fh;
return 1;
}
sub logger { ## no critic(RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
my $hr = $self->_get_configuration_for_logger( $list[0] );
my ( $msg, $time, $status );
$status = 1;
my ($msg_maybe_bt) = $hr->{'backtrace'} ? $self->backtrace( $hr->{'message'} ) : $hr->{'message'} . "\n";
if ( $hr->{'level'} eq 'raw' ) {
$msg = $hr->{'message'};
}
else {
$time ||= Cpanel::Time::Local::localtime2timestamp();
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
if ( $self->{'log_pid'} ) {
$msg = "[$time] $hr->{'level'} [$hr->{'service'}] [$$] $msg_maybe_bt";
}
else {
$msg = "[$time] $hr->{'level'} [$hr->{'service'}] $msg_maybe_bt";
}
}
unless ( $hr->{'use_no_files'} ) {
local $self->{'log_fh'} = \*STDERR if $ALWAYS_OUTPUT_TO_STDERR;
$self->_open_logfile() if !$self->{'log_fh'} || ( !eval { fileno( $self->{'log_fh'} ) } && !UNIVERSAL::isa( $self->{'log_fh'}, 'IO::Scalar' ) );
_write( $self->{'log_fh'}, $msg ) or $status = 0;
if ( $hr->{'level'} eq 'panic' || $hr->{'level'} eq 'invalid' || $hr->{'level'} eq 'deprecated' ) {
my $panic_fh;
require Cpanel::FileUtils::Open;
if ( Cpanel::FileUtils::Open::sysopen_with_real_perms( $panic_fh, $PANIC_LOG_FILE, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) {
$time ||= Cpanel::Time::Local::localtime2timestamp();
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
_write( $panic_fh, "$time $hr->{level} [$hr->{'service'}] $msg_maybe_bt" );
close $panic_fh;
}
}
}
if ( $hr->{'output'} ) {
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
my $out = "$hr->{level} [$hr->{'service'}] $hr->{'message'}\n";
if ( $self->{'timestamp_prefix'} ) {
$out = "[$time] $out";
}
$out = $msg if $hr->{'use_fullmsg'};
$status &&= $self->_write_message( $hr, $out );
}
if ( ( $hr->{'level'} eq 'die' || $hr->{'level'} eq 'panic' || $hr->{'die'} ) ) {
CORE::die "exit level [$hr->{'level'}] [pid=$$] ($hr->{'message'})\n"; # make sure we die if die is overwritten
}
return $status;
} # end of logger
sub _write_message {
my ( $self, $hr, $out ) = @_;
my $status = 1;
if ( $hr->{'output'} == 3 ) {
_write( \*STDOUT, $out ) or $status = 0;
_write( \*STDERR, $out ) or $status = 0;
}
elsif ( $hr->{'output'} == 1 && ( $self->{'use_stdout'} || _stdout_is_tty() ) ) {
_write( \*STDOUT, $out ) or $status = 0;
}
elsif ( $hr->{'output'} == 2 ) {
_write( \*STDERR, $out ) or $status = 0;
}
return $status;
}
sub find_progname {
if ( $cached_progname && $cached_prog_pid == $$ ) {
return $cached_progname;
}
my $s = $0;
if ( !length $s ) { # Someone _could_ set $0 = '';
my $i = 1; # 0 is always find_progname
while ( my @service = caller( $i++ ) ) {
last if ( $service[3] =~ /::BEGIN$/ );
$s = $service[1] if ( $service[1] ne '' );
}
}
$s =~ s@.+/(.+)$@$1@ if $s =~ tr{/}{};
$s =~ s@\..+$@@ if $s =~ tr{\.}{};
$s =~ s@ .*$@@ if $s =~ tr{ }{};
$cached_progname = $s;
$cached_prog_pid = $$;
return $s;
}
sub backtrace { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
if ( ref $list[0] ) {
return $list[0] if scalar @list == 1;
return (@list);
}
require Cpanel::Carp;
local $_; # Protect surrounding program - just in case...
local $Carp::Internal{ (__PACKAGE__) } = 1;
local $Carp::Internal{'Cpanel::Debug'} = 1;
return Cpanel::Carp::safe_longmess(@list);
}
sub redirect_stderr_to_error_log {
return open( STDERR, '>>', $STD_LOG_FILE );
}
sub notify {
my ( $self, $call, $log_ref ) = @_;
my $time = Cpanel::Time::Local::localtime2timestamp();
my ($bt) = $self->backtrace( $log_ref->{'message'} );
$log_ref->{'service'} //= '';
my $logfile = qq{$time [$log_ref->{'service'}] } . ( $bt // '' );
if ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact::Class::Logger::Notify'); 1; } ) {
eval {
require Cpanel::Notify;
Cpanel::Notify::notification_class(
'class' => 'Logger::Notify',
'application' => 'Logger::Notify',
'constructor_args' => [
'origin' => $log_ref->{'service'},
'logger_call' => $call,
'attach_files' => [ { name => 'cpanel-logger-log.txt', content => \$logfile } ],
'subject' => $log_ref->{'subject'},
]
);
};
}
elsif ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact'); 1; } ) {
Cpanel::iContact::icontact(
'application' => $log_ref->{'service'},
'subject' => $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}},
'message' => $logfile,
);
}
else {
CORE::warn( $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}} . ": $logfile" );
}
return;
}
*fatal = *die;
*out = *info;
*success = *info;
*throw = *die;
*warning = *warn;
sub _is_subprocess_of_cpsrvd {
require Cpanel::Server::Utils;
goto \&Cpanel::Server::Utils::is_subprocess_of_cpsrvd;
}
sub _open_logfile {
my ($self) = @_;
my $usingstderr = 0;
my $log_fh;
$self->{'alternate_logfile'} ||= $STD_LOG_FILE;
if ( $STD_LOG_FILE eq $self->{'alternate_logfile'} && _is_subprocess_of_cpsrvd() ) {
$log_fh = \*STDERR;
$usingstderr = 1;
}
else {
require Cpanel::FileUtils::Open;
if ( !Cpanel::FileUtils::Open::sysopen_with_real_perms( $log_fh, $self->{'alternate_logfile'}, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) {
( $usingstderr, $log_fh ) = ( 1, \*STDERR );
}
select( ( select($log_fh), $| = 1 )[0] ); ## no critic qw(Variables::RequireLocalizedPunctuationVars InputOutput::ProhibitOneArgSelect) -- Cpanel::FHUtils::Autoflush would be expensive to load every time
}
$self->{'log_fh'} = $log_fh;
$self->{'usingstderr'} = $usingstderr;
return 1;
}
sub _stdin_is_tty {
local $@;
return eval { -t STDIN };
}
sub _stdout_is_tty {
local $@;
return eval { -t STDOUT };
}
sub clear_singleton_stash {
%singleton_stash = ();
return;
}
1;
} # --- END Cpanel/Logger.pm
{ # --- BEGIN Cpanel/Debug.pm
package Cpanel::Debug;
use strict;
use warnings;
no warnings 'once';
our $HOOKS_DEBUG_FILE = '/var/cpanel/debughooks';
our $level = ( exists $ENV{'CPANEL_DEBUG_LEVEL'} && $ENV{'CPANEL_DEBUG_LEVEL'} ? int $ENV{'CPANEL_DEBUG_LEVEL'} : 0 );
my $debug_hooks_value;
my $logger;
sub debug_level {
my ($level) = @_;
$Cpanel::Debug::level = $level if defined $level;
return $Cpanel::Debug::level;
}
sub logger {
$logger = shift if (@_); # Set method for $logger if something is passed in.
return $logger ||= do {
local ( $@, $! );
require Cpanel::Logger;
Cpanel::Logger->new();
};
}
sub log_error {
local $!; #prevent logger from overwriting $!
return logger()->error( $_[0] );
}
sub log_warn {
local $!; #prevent logger from overwriting $!
return logger()->warn( $_[0] );
}
sub log_warn_no_backtrace {
local $!; #prevent logger from overwriting $!
my $logger = logger();
no warnings 'once';
local $Cpanel::Logger::ENABLE_BACKTRACE = 0;
return $logger->warn( $_[0] );
}
sub log_invalid {
local $!; #prevent logger from overwriting $!
return logger()->invalid( $_[0] );
}
sub log_deprecated {
local $!; #prevent logger from overwriting $!
return logger()->deprecated( $_[0] );
}
sub log_panic {
local $!; #prevent logger from overwriting $!
return logger()->panic( $_[0] );
}
sub log_die {
local $!; #prevent logger from overwriting $!
return logger()->die( $_[0] );
}
sub log_info {
local $!; #prevent logger from overwriting $!
return logger()->info( $_[0] );
}
sub log_debug {
local $!; #prevent logger from overwriting $!
return logger()->debug( $_[0] );
}
sub log_dump {
require Data::Dumper;
no warnings 'once';
local $Data::Dumper::Sortkeys = 1;
return log_info( Data::Dumper::Dumper( $_[0] ) );
}
sub debug_hooks_value {
return $debug_hooks_value if defined $debug_hooks_value;
return ( $debug_hooks_value = ( stat($HOOKS_DEBUG_FILE) )[7] || 0 );
}
1;
} # --- END Cpanel/Debug.pm
{ # --- BEGIN Cpanel/Sys/Hostname.pm
package Cpanel::Sys::Hostname;
use strict;
use warnings;
no warnings 'once';
our $VERSION = 2.0;
# use Cpanel::Sys::Uname (); # perlpkg line 211
our $cachedhostname = '';
sub gethostname {
my $nocache = shift || 0;
if ( !$nocache && length $cachedhostname ) { return $cachedhostname }
my $hostname = _gethostname($nocache);
if ( length $hostname ) {
$hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn)
$cachedhostname = $hostname;
}
return $hostname;
}
sub _gethostname {
my $nocache = shift || 0;
my $hostname;
Cpanel::Sys::Uname::clearcache() if $nocache;
my @uname = Cpanel::Sys::Uname::get_uname_cached();
if ( $uname[1] && index( $uname[1], '.' ) > -1 ) {
$hostname = $uname[1];
$hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn)
return $hostname;
}
eval {
require Cpanel::Sys::Hostname::Fallback;
$hostname = Cpanel::Sys::Hostname::Fallback::get_canonical_hostname();
};
if ($hostname) {
$hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn)
return $hostname;
}
require Cpanel::LoadFile;
chomp( $hostname = Cpanel::LoadFile::loadfile( '/proc/sys/kernel/hostname', { 'skip_exists_check' => 1 } ) );
if ($hostname) {
$hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn)
$hostname =~ tr{\r\n}{}d; # chomp is not enough (not sure if this is required, however we cannot test all kernels so its safer to leave it in)
return $hostname;
}
require Cpanel::Debug;
Cpanel::Debug::log_warn('Unable to determine correct hostname');
return;
}
sub shorthostname {
my $hostname = gethostname();
return $hostname if index( $hostname, '.' ) == -1; # Hostname is not a FQDN (this should never happen)
return substr( $hostname, 0, index( $hostname, '.' ) );
}
1;
} # --- END Cpanel/Sys/Hostname.pm
{ # --- BEGIN Cpanel/Hostname.pm
package Cpanel::Hostname;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Sys::Hostname (); # perlpkg line 211
our $VERSION = 2.0;
{
no warnings 'once';
*gethostname = *Cpanel::Sys::Hostname::gethostname;
*shorthostname = *Cpanel::Sys::Hostname::shorthostname;
}
1;
} # --- END Cpanel/Hostname.pm
{ # --- BEGIN Cpanel/NAT/Object.pm
package Cpanel::NAT::Object;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
our $NAT_FILE = '/var/cpanel/cpnat';
sub new {
my ( $class, $file ) = @_;
my $self = {
'cpnat_file' => $file || $NAT_FILE,
'cpnat_data' => {},
'file_read' => 0,
'only_local_ip' => [],
'dups' => {},
};
bless $self, $class;
$self->load_file();
return $self;
}
sub load_file {
my ($self) = @_;
$self->{'file_read'} = 0;
$self->{'cpnat_data'} = {};
if ( !-e $self->{'cpnat_file'} || !-r _ || -z _ ) {
return;
}
my $nat_data;
{
local $/;
open my $fh, '<', $self->{'cpnat_file'} or die "Failed to open “$self->{'cpnat_file'}”: $!";
$nat_data = <$fh>;
close $fh;
}
$self->{'nat_data'} = $nat_data;
$self->{'cpnat_data'} = $self->_parse_nat_file($nat_data);
$self->{'file_read'} = 1;
return 1 if %{ $self->{'cpnat_data'} };
return;
}
sub enabled {
my ($self) = @_;
return $self->{'file_read'} ? 1 : 0;
}
sub ordered_list {
my ($self) = @_;
return ( $self->{'cpnat_ordered'} ||= $self->_create_ordered_list( $self->{'nat_data'} ) );
}
sub get_public_ip {
return $_[1] if !$_[1] || !$_[0]->{'file_read'} || !$_[0]->{'cpnat_data'}->{ $_[1] };
return $_[0]->_get_public_ip( $_[1] );
}
sub get_all_public_ips {
my ($self) = @_;
return [ sort values %{ $self->{cpnat_data} } ];
}
sub get_public_ip_raw {
my ( $self, $local_ip ) = @_;
return 'FILE NOT READ' if !$self->{'file_read'};
return 'INVALID LOCAL IP' if !$self->{'cpnat_data'}->{$local_ip} && !$self->_find_ip($local_ip) && !exists $self->{'dups'}->{$local_ip};
return $self->_get_public_ip($local_ip) || $self->{'dups'}->{$local_ip} || '';
}
sub _find_ip {
my ( $self, $ip ) = @_;
my $found = grep { $_ eq $ip } @{ $self->{'only_local_ip'} };
return $ip if $found;
return;
}
sub _get_public_ip {
my ( $self, $local_ip ) = @_;
my $public_ip = $self->{'cpnat_data'}->{$local_ip};
return $public_ip;
}
sub get_local_ip {
my ( $self, $public_ip ) = @_;
return $public_ip unless $public_ip;
return $public_ip if !$self->{'file_read'};
$self->{'_public_to_local'} ||= { reverse %{ $self->{'cpnat_data'} } };
return $self->{'_public_to_local'}{$public_ip} || $public_ip;
}
sub _parse_nat_file {
my ( $self, $nat_data ) = @_;
return if !$nat_data;
my $cpnat_hash = {};
my @file = split /\n/, $nat_data;
my $only_local_ip = $self->{'only_local_ip'};
foreach my $line (@file) {
my ( $local, $public ) = split /\s+/, $line;
if ( !$public ) {
push @$only_local_ip, $local;
next;
}
if ( !Cpanel::Validate::IP::v4::is_valid_ipv4($local)
&& !Cpanel::Validate::IP::v4::is_valid_ipv4($public) ) {
Cpanel::Debug::log_warn( 'Invalid line in cpnat file: ' . $line );
next;
}
if ( !grep { $public && $public eq $_ } values %{$cpnat_hash} ) {
$cpnat_hash->{$local} = $public;
}
else {
$self->{'dups'}->{$local} = $public;
}
}
return $cpnat_hash;
}
sub _create_ordered_list {
my ( $self, $nat_data ) = @_;
return if !$nat_data;
my $cpnat_array = [];
my $group_hash = {};
my $order = [];
my @file = split /\n/, $nat_data;
foreach my $line (@file) {
my ( $local, $public ) = split /\s+/, $line;
my $key = $public || $local;
$public ||= '';
push @$order, $key if !$group_hash->{$key};
push @{ $group_hash->{$key} }, [ $local, $public ];
}
foreach my $key (@$order) {
if ( scalar @{ $group_hash->{$key} } == 1 ) {
push @$cpnat_array, pop @{ $group_hash->{$key} };
}
else {
push @$cpnat_array, $group_hash->{$key};
}
}
return $cpnat_array;
}
1;
} # --- END Cpanel/NAT/Object.pm
{ # --- BEGIN Cpanel/NAT.pm
package Cpanel::NAT;
use strict;
# use Cpanel::NAT::Object (); # perlpkg line 211
my $nat;
sub set_cpnat {
$nat = shift;
return;
}
sub cpnat {
return $nat ||= Cpanel::NAT::Object->new();
}
sub reload {
return cpnat()->load_file();
}
sub get_public_ip {
return ( $nat ||= cpnat() )->get_public_ip( $_[0] );
}
sub get_local_ip {
return ( $nat ||= cpnat() )->get_local_ip( $_[0] );
}
sub get_public_ip_raw {
return ( $nat ||= cpnat() )->get_public_ip_raw( $_[0] );
}
sub ordered_list {
return cpnat()->ordered_list();
}
sub get_all_public_ips {
return cpnat()->get_all_public_ips();
}
sub is_nat {
return cpnat()->enabled();
}
1;
} # --- END Cpanel/NAT.pm
{ # --- BEGIN Cpanel/Struct/Common/Time.pm
package Cpanel::Struct::Common::Time;
use strict;
use warnings;
no warnings 'once';
use constant PACK_TEMPLATE => 'L!L!';
my %CLASS_PRECISION;
sub float_to_binary {
return pack(
PACK_TEMPLATE(),
int( $_[1] ),
int( 0.5 + ( $_[0]->_PRECISION() * $_[1] ) - ( $_[0]->_PRECISION() * int( $_[1] ) ) ),
);
}
sub binary_to_float {
return $_[0]->_binary_to_float( PACK_TEMPLATE(), $_[1] )->[0];
}
sub binaries_to_floats_at {
return $_[0]->_binary_to_float(
"\@$_[3] " . ( PACK_TEMPLATE() x $_[2] ),
$_[1],
);
}
my ( $i, $precision, @sec_psec_pairs );
sub _binary_to_float { ## no critic qw(RequireArgUnpacking)
@sec_psec_pairs = unpack( $_[1], $_[2] );
$i = 0;
my @floats;
$precision = $CLASS_PRECISION{ $_[0] } ||= $_[0]->_PRECISION();
while ( $i < @sec_psec_pairs ) {
push @floats, 0 + ( q<> . ( $sec_psec_pairs[$i] + ( $sec_psec_pairs[ $i + 1 ] / $precision ) ) );
$i += 2;
}
return \@floats;
}
1;
} # --- END Cpanel/Struct/Common/Time.pm
{ # --- BEGIN Cpanel/Struct/timespec.pm
package Cpanel::Struct::timespec;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Struct::Common::Time (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Struct::Common::Time); }
use constant {
_PRECISION => 1_000_000_000, # nanoseconds
};
1;
} # --- END Cpanel/Struct/timespec.pm
{ # --- BEGIN Cpanel/NanoStat.pm
package Cpanel::NanoStat;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Struct::timespec (); # perlpkg line 211
use constant {
_NR_stat => 4,
_NR_fstat => 5,
_NR_lstat => 6,
};
use constant _PACK_TEMPLATE => q<
Q # st_dev
Q # st_ino
@24 L # st_mode
@16 Q # st_nlink
@28
L # st_uid
L # st_gid
x![Q]
Q # st_rdev
Q # st_size
Q # st_blksize
Q # st_blocks
>;
my $pre_times_pack_len = length pack _PACK_TEMPLATE();
my $buf = ( "\0" x 144 );
sub stat {
return _syscall( _NR_stat(), $_[0] );
}
sub lstat {
return _syscall( _NR_lstat(), $_[0] );
}
sub fstat {
return _syscall( _NR_fstat(), 0 + ( ref( $_[0] ) ? fileno( $_[0] ) : $_[0] ) );
}
sub _syscall { ## no critic qw(RequireArgUnpacking)
my $arg_dupe = $_[1];
return undef if -1 == syscall( $_[0], $arg_dupe, $buf );
my @vals = unpack _PACK_TEMPLATE(), $buf;
splice(
@vals, 8, 0,
@{ Cpanel::Struct::timespec->binaries_to_floats_at( $buf, 3, $pre_times_pack_len ) },
);
return @vals;
}
1;
} # --- END Cpanel/NanoStat.pm
{ # --- BEGIN Cpanel/NanoUtime.pm
package Cpanel::NanoUtime;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Struct::timespec (); # perlpkg line 211
use constant {
_NR_utimensat => 280,
_AT_FDCWD => -100,
_AT_SYMLINK_NOFOLLOW => 0x100,
};
sub utime {
return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 );
}
sub futime {
return _syscall(
0 + ( ref( $_[2] ) ? fileno( $_[2] ) : $_[2] ),
undef,
@_[ 0, 1 ],
0,
);
}
sub lutime {
return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 + _AT_SYMLINK_NOFOLLOW() );
}
my ( $path, $buf ) = @_;
sub _syscall {
if ( defined $_[-3] ) {
if ( defined $_[-2] ) {
$buf = Cpanel::Struct::timespec->float_to_binary( $_[-3] ) . Cpanel::Struct::timespec->float_to_binary( $_[-2] );
}
else {
die "atime is “$_[-3]”, but mtime is undef!";
}
}
elsif ( defined $_[-2] ) {
die "atime is undef, but mtime is “$_[-2]”!";
}
else {
$buf = undef;
}
$path = $_[1];
return undef if -1 == syscall( 0 + _NR_utimensat(), $_[0], $path // undef, $buf // undef, $_[-1] );
return 1;
}
1;
} # --- END Cpanel/NanoUtime.pm
{ # --- BEGIN Cpanel/HiRes.pm
package Cpanel::HiRes;
use strict;
use warnings;
no warnings 'once';
my %_routes = (
'fstat' => [ 'NanoStat', 'fstat', 'stat', 1 ],
'lstat' => [ 'NanoStat', 'lstat', 'lstat', 1 ],
'stat' => [ 'NanoStat', 'stat', 'stat', 1 ],
'time' => [ 'TimeHiRes', 'time', 'time' ],
'utime' => [ 'NanoUtime', 'utime', 'utime' ],
'futime' => [ 'NanoUtime', 'futime', 'utime' ],
'lutime' => [ 'NanoUtime', 'lutime', undef ],
);
my $preloaded;
sub import {
my ( $class, %opts ) = @_;
if ( my $preload = $opts{'preload'} ) {
if ( $preload eq 'xs' ) {
require Time::HiRes;
}
elsif ( $preload eq 'perl' ) {
if ( !$preloaded ) {
require Cpanel::TimeHiRes; # PPI USE OK - preload
require Cpanel::NanoStat; # PPI USE OK - preload
require Cpanel::NanoUtime; # PPI USE OK - preload
}
}
else {
die "Unknown “preload”: “$preload”";
}
$preloaded = $preload;
}
return;
}
our $AUTOLOAD;
sub AUTOLOAD { ## no critic qw(Subroutines::RequireArgUnpacking)
substr( $AUTOLOAD, 0, 1 + rindex( $AUTOLOAD, ':' ) ) = q<>;
if ( !$AUTOLOAD || !$_routes{$AUTOLOAD} ) {
die "Unknown function in Cpanel::HiRes::$_[0]";
}
my $function = $AUTOLOAD;
undef $AUTOLOAD;
my ( $pp_module, $pp_function, $xs_function, $xs_needs_closure ) = @{ $_routes{$function} };
no strict 'refs';
if ( $INC{'Time/HiRes.pm'} && $xs_function ) {
*$function = *{"Time::HiRes::$xs_function"};
return Time::HiRes->can($xs_function)->(@_);
}
else {
_require("Cpanel/${pp_module}.pm") if !$INC{"Cpanel/${pp_module}.pm"};
my $pp_cr = "Cpanel::${pp_module}"->can($pp_function);
if ($xs_function) {
*$function = sub {
if ( $INC{'Time/HiRes.pm'} ) {
*$function = *{"Time::HiRes::$xs_function"};
return Time::HiRes->can($xs_function)->(@_);
}
goto &$pp_cr;
};
}
else {
*$function = $pp_cr;
}
}
goto &$function;
}
sub _require {
local ( $!, $^E, $@ );
require $_[0];
return;
}
1;
} # --- END Cpanel/HiRes.pm
{ # --- BEGIN Cpanel/Path/Normalize.pm
package Cpanel::Path::Normalize;
use strict;
use warnings;
no warnings 'once';
sub normalize {
my $uncleanpath = shift || return;
my $is_abspath = ( 0 == index( $uncleanpath, '/' ) );
my @pathdirs = split( m[/], $uncleanpath );
my @cleanpathdirs;
my $leading_dot_dots = 0;
foreach my $dir (@pathdirs) {
next if !length $dir; #Remove extraneous "//" and leading "/"
next if $dir eq '.';
if ( $dir eq '..' ) {
if (@cleanpathdirs) {
pop(@cleanpathdirs);
}
else {
$leading_dot_dots++;
}
}
else {
push( @cleanpathdirs, $dir );
}
}
if ($is_abspath) {
return ( '/' . join( '/', @cleanpathdirs ) );
}
unshift @cleanpathdirs, ('..') x $leading_dot_dots;
return join( '/', @cleanpathdirs );
}
1;
} # --- END Cpanel/Path/Normalize.pm
{ # --- BEGIN Cpanel/JSON/Unicode.pm
package Cpanel::JSON::Unicode;
use strict;
use warnings;
no warnings 'once';
use constant {
_LEAD_SURROGATE_MIN => 0xd800,
_TAIL_SURROGATE_MIN => 0xdc00,
_SURROGATE_MASK => 0xfc00,
_BACKSLASH_ORD => 0x5c,
_DOUBLE_QUOTE_ORD => 0x22,
};
my $UNICODE_ESCAPE_REGEXP = qr/
(?<!\x5c)
(
(?:\x5c\x5c)*
\x5c u ([0-9a-fA-F]{4})
)
/x;
sub replace_unicode_escapes_with_utf8 {
my ($json_sr) = @_;
my $lead_surrogate;
my $ret = $$json_sr =~ s<$UNICODE_ESCAPE_REGEXP><
_replacement(\$lead_surrogate, $json_sr, $+[0], @{^CAPTURE})
>ge;
if ($lead_surrogate) {
die sprintf "Incomplete surrogate pair (0x%04x)", $lead_surrogate;
}
return $ret;
}
sub _replacement {
my ( $lead_surrogate_sr, $json_sr, $match_end, @captures ) = @_;
my $num = hex $captures[1];
if ( ( $num & _SURROGATE_MASK ) == _TAIL_SURROGATE_MIN ) {
if ($$lead_surrogate_sr) {
my $utf8 = _decode_surrogates( $$lead_surrogate_sr, $num );
$$lead_surrogate_sr = undef;
return $utf8;
}
die sprintf "Unpaired trailing surrogate (0x%04x)", $num;
}
elsif ( ( $num & _SURROGATE_MASK ) == _LEAD_SURROGATE_MIN ) {
my $next2 = substr( $$json_sr, $match_end, 2 );
if ( !$next2 || $next2 ne '\\u' ) {
die sprintf "Unpaired leading surrogate (0x%04x)", $num;
}
$$lead_surrogate_sr = $num;
return q<>;
}
elsif ( $num < 0x20 || $num == _BACKSLASH_ORD || $num == _DOUBLE_QUOTE_ORD ) {
return $captures[0];
}
my $utf8 = chr $num;
utf8::encode($utf8);
return $utf8;
}
sub _decode_surrogates {
my ( $lead, $tail ) = @_;
my $uni = 0x10000 + ( ( $lead - 0xd800 ) << 10 ) + ( $tail - 0xdc00 );
my $un = chr $uni;
utf8::encode($un);
return $un;
}
1;
} # --- END Cpanel/JSON/Unicode.pm
{ # --- BEGIN Cpanel/Encoder/ASCII.pm
package Cpanel::Encoder::ASCII;
use strict;
use warnings;
no warnings 'once';
sub to_hex {
my ($readable) = @_;
$readable =~ s<\\><\\\\>g;
$readable =~ s<([\0-\x{1f}\x{7f}-\x{ff}])><sprintf '\x{%02x}', ord $1>eg;
return $readable;
}
1;
} # --- END Cpanel/Encoder/ASCII.pm
{ # --- BEGIN Cpanel/UTF8/Strict.pm
package Cpanel::UTF8::Strict;
use strict;
use warnings;
no warnings 'once';
sub decode {
utf8::decode( $_[0] ) or do {
local ( $@, $! );
require Cpanel::Encoder::ASCII;
die sprintf "Invalid UTF-8 in string: “%s”", Cpanel::Encoder::ASCII::to_hex( $_[0] );
};
return $_[0];
}
1;
} # --- END Cpanel/UTF8/Strict.pm
{ # --- BEGIN Cpanel/JSON.pm
package Cpanel::JSON;
use strict;
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::FHUtils::Tiny (); # perlpkg line 211
# use Cpanel::JSON::Unicode (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
use JSON::XS ();
# use Cpanel::UTF8::Strict (); # perlpkg line 211
our $NO_DECODE_UTF8 = 0;
our $DECODE_UTF8 = 1;
our $LOAD_STRICT = 0;
our $LOAD_RELAXED = 1;
our $MAX_LOAD_LENGTH_UNLIMITED = 0;
our $MAX_LOAD_LENGTH = 65535;
our $MAX_PRIV_LOAD_LENGTH = 4194304; # four megs
our $XS_ConvertBlessed_obj;
our $XS_RelaxedConvertBlessed_obj;
our $XS_NoSetUTF8RelaxedConvertBlessed_obj;
our $XS_NoSetUTF8ConvertBlessed_obj;
our $VERSION = '2.5';
my $copied_boolean = 0;
sub DumpFile {
my ( $file, $data ) = @_;
if ( Cpanel::FHUtils::Tiny::is_a($file) ) {
print {$file} Dump($data) || return 0;
}
else {
if ( open( my $fh, '>', $file ) ) {
print {$fh} Dump($data);
close($fh);
}
else {
return 0;
}
}
return 1;
}
sub copy_boolean {
if ( !$copied_boolean ) {
*Types::Serialiser::Boolean:: = *JSON::PP::Boolean::;
$copied_boolean = 1;
}
return;
}
sub _create_new_json_object {
copy_boolean() if !$copied_boolean;
return JSON::XS->new()->shrink(1)->allow_nonref(1)->convert_blessed(1);
}
sub true {
copy_boolean() if !$copied_boolean;
my $x = 1;
return bless \$x, 'Types::Serialiser::Boolean';
}
sub false {
copy_boolean() if !$copied_boolean;
my $x = 0;
return bless \$x, 'Types::Serialiser::Boolean';
}
sub pretty_dump {
return _create_new_json_object()->pretty(1)->encode( $_[0] );
}
my $XS_Canonical_obj;
sub canonical_dump {
return ( $XS_Canonical_obj ||= _create_new_json_object()->canonical(1) )->encode( $_[0] );
}
sub pretty_canonical_dump {
return _create_new_json_object()->canonical(1)->indent->space_before->space_after->encode( $_[0] );
}
sub Dump {
return ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->encode( $_[0] );
}
sub Load {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub LoadRelaxed {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_RelaxedConvertBlessed_obj ||= _create_new_json_object()->relaxed(1) )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub _throw_json_error {
my ( $exception, $path, $dataref ) = @_;
local $@;
require Cpanel::Exception;
die $exception if $@;
die 'Cpanel::Exception'->can('create')->( 'JSONParseError', { 'error' => $exception, 'path' => $path, 'dataref' => $dataref } );
}
sub LoadNoSetUTF8 {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_NoSetUTF8ConvertBlessed_obj ||= _create_new_no_set_utf8_json_object() )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub LoadNoSetUTF8Relaxed {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_NoSetUTF8RelaxedConvertBlessed_obj ||= _create_new_no_set_utf8_json_object()->relaxed(1) )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub _create_new_no_set_utf8_json_object {
my $obj = _create_new_json_object();
if ( $obj->can('no_set_utf8') ) {
$obj->no_set_utf8(1);
}
else {
warn "JSON::XS is missing the no_set_utf8 flag";
}
return $obj;
}
sub _replace_unicode_escapes_if_needed {
my $json_r = shift;
return unless defined $$json_r;
if ( -1 != index( $$json_r, '\\u' ) ) {
Cpanel::JSON::Unicode::replace_unicode_escapes_with_utf8($json_r);
}
return;
}
sub SafeLoadFile { # only allow a small bit of data to be loaded
return _LoadFile( $_[0], $MAX_LOAD_LENGTH, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT );
}
sub LoadFile {
return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT );
}
sub LoadFileRelaxed {
return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_RELAXED );
}
sub LoadFileNoSetUTF8 {
return _LoadFile( $_[0], $_[1] || $MAX_LOAD_LENGTH_UNLIMITED, $DECODE_UTF8, $_[2], $LOAD_STRICT );
}
sub _LoadFile {
my ( $file, $max, $decode_utf8, $path, $relaxed ) = @_;
my $data;
if ( Cpanel::FHUtils::Tiny::is_a($file) ) {
if ($max) {
my $togo = $max;
$data = '';
my $bytes_read;
while ( $bytes_read = read( $file, $data, $togo, length $data ) && length $data < $max ) {
$togo -= $bytes_read;
}
}
else {
Cpanel::LoadFile::ReadFast::read_all_fast( $file, $data );
}
}
else {
local $!;
open( my $fh, '<:stdio', $file ) or do {
my $err = $!;
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("Cannot open “$file”: $err");
};
Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data );
if ( !length $data ) {
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("“$file” is empty.");
}
close $fh or warn "close($file) failed: $!";
}
if ( $decode_utf8 && $decode_utf8 == $DECODE_UTF8 ) {
Cpanel::UTF8::Strict::decode($data);
return $relaxed ? LoadNoSetUTF8Relaxed( $data, $path || $file ) : LoadNoSetUTF8( $data, $path || $file );
}
return $relaxed ? LoadRelaxed( $data, $path || $file ) : Load( $data, $path || $file );
}
sub SafeDump {
my $raw_json = ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->encode( $_[0] );
$raw_json =~ s{\/}{\\/}g if $raw_json =~ tr{/}{};
return $raw_json;
}
sub _fh_looks_like_json {
my ($fh) = @_;
my $bytes_read = 0;
my $buffer = q{};
local $!;
while ( $buffer !~ tr{ \t\r\n\f}{}c && !eof $fh ) {
$bytes_read += ( read( $fh, $buffer, 1, length $buffer ) // die "read() failed: $!" );
}
return (
_string_looks_like_json($buffer),
\$buffer,
);
}
sub _string_looks_like_json { ##no critic qw(RequireArgUnpacking)
return $_[0] =~ m/\A\s*[\[\{"0-9]/ ? 1 : 0;
}
sub looks_like_json { ##no critic qw(RequireArgUnpacking)
if ( Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) {
my $fh = $_[0];
my ( $looks_like_json, $fragment_ref ) = _fh_looks_like_json($fh);
my $bytes_read = length $$fragment_ref;
if ($bytes_read) {
seek( $fh, -$bytes_read, $Cpanel::Fcntl::Constants::SEEK_CUR ) or die "seek() failed: $!";
}
return $looks_like_json;
}
return _string_looks_like_json( $_[0] );
}
sub to_bool {
my ($val) = @_;
$val = 0 if defined $val && $val eq 'false';
return !!$val ? true() : false();
}
1;
} # --- END Cpanel/JSON.pm
{ # --- BEGIN Cpanel/JSON/FailOK.pm
package Cpanel::JSON::FailOK;
use strict;
use warnings;
no warnings 'once';
sub LoadJSONModule {
local $@;
my $load_ok = eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
require Cpanel::JSON; # PPI NO PARSE - FailOK
1;
};
if ( !$load_ok && !$ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == 0 ) {
warn $@;
}
return $load_ok ? 1 : 0;
}
sub LoadFile {
return undef if !$INC{'Cpanel/JSON.pm'};
return eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
Cpanel::JSON::LoadFile(@_); # PPI NO PARSE - inc check above
};
}
1;
} # --- END Cpanel/JSON/FailOK.pm
{ # --- BEGIN Cpanel/Hash/Stringify.pm
package Cpanel::Hash::Stringify;
use strict;
use warnings;
no warnings 'once';
sub sorted_hashref_string {
my ($hashref) = @_;
return (
( scalar keys %$hashref )
? join(
'_____', map { $_, ( ref $hashref->{$_} eq 'HASH' ? sorted_hashref_string( $hashref->{$_} ) : ref $hashref->{$_} eq 'ARRAY' ? join( '_____', @{ $hashref->{$_} } ) : defined $hashref->{$_} ? $hashref->{$_} : '' ) }
sort keys %$hashref
)
: ''
); #sort is important for order;
}
1;
} # --- END Cpanel/Hash/Stringify.pm
{ # --- BEGIN Cpanel/Destruct.pm
package Cpanel::Destruct;
use strict;
my $in_global_destruction = 0;
my ( $package, $filename, $line, $subroutine ); # preallocate
sub in_dangerous_global_destruction {
if ( !$INC{'Test2/API.pm'} ) {
return 1 if in_global_destruction() && $INC{'Cpanel/BinCheck.pm'};
}
return 0;
}
sub in_global_destruction {
return $in_global_destruction if $in_global_destruction;
if ( defined( ${^GLOBAL_PHASE} ) ) {
if ( ${^GLOBAL_PHASE} eq 'DESTRUCT' ) {
$in_global_destruction = 1;
}
}
else {
local $SIG{'__WARN__'} = \&_detect_global_destruction_pre_514_WARN_handler;
warn;
}
return $in_global_destruction;
}
sub _detect_global_destruction_pre_514_WARN_handler {
if ( length $_[0] > 26 && rindex( $_[0], 'during global destruction.' ) == ( length( $_[0] ) - 26 ) ) {
$in_global_destruction = 1;
}
return;
}
1;
} # --- END Cpanel/Destruct.pm
{ # --- BEGIN Cpanel/Finally.pm
package Cpanel::Finally;
use cPstrict;
no warnings 'once';
# use Cpanel::Destruct (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
sub new ( $class, @todo_crs ) {
return bless { 'pid' => $$, 'todo' => [@todo_crs] }, $class;
}
sub add ( $self, @new_crs ) {
$self->{'todo'} //= [];
push @{ $self->{'todo'} }, @new_crs;
return;
}
sub skip ($self) {
return delete $self->{'todo'};
}
sub DESTROY ($self) {
if ( Cpanel::Destruct::in_dangerous_global_destruction() ) {
Cpanel::Debug::log_die(q[Cpanel::Finally should never be triggered during global destruction\n]);
}
return if $$ != $self->{'pid'} || !$self->{'todo'};
local $@; #prevent insidious clobber of error messages
while ( @{ $self->{'todo'} } ) {
my $ok = eval {
while ( my $item = shift @{ $self->{'todo'} } ) {
$item->();
}
1;
};
warn $@ if !$ok;
}
return;
}
1;
} # --- END Cpanel/Finally.pm
{ # --- BEGIN Cpanel/Readlink.pm
package Cpanel::Readlink;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
use Cwd ();
our $MAX_SYMLINK_DEPTH = 1024;
sub deep {
my ( $link, $provide_trailing_slash ) = @_;
die Cpanel::Exception::create( 'MissingParameter', 'Provide a link path.' ) if !length $link;
if ( length($link) > 1 && substr( $link, -1, 1 ) eq '/' ) {
$link = substr( $link, 0, length($link) - 1 );
return deep( $link, 1 );
}
if ( !-l $link ) {
return $provide_trailing_slash ? qq{$link/} : $link;
}
my %is_link;
$is_link{$link} = 1;
my $depth = 0;
my $base = _get_base_for($link);
if ( substr( $link, 0, 1 ) ne '/' ) {
$base = Cwd::abs_path() . '/' . $base;
}
while ( ( $is_link{$link} ||= -l $link ) && ++$depth <= $MAX_SYMLINK_DEPTH ) {
$link = Cpanel::Autodie::readlink($link);
if ( substr( $link, 0, 1 ) ne '/' ) {
$link = $base . '/' . $link;
}
$base = _get_base_for($link);
}
return $provide_trailing_slash ? qq{$link/} : $link;
}
sub _get_base_for {
my $basename = shift;
my @path = split( '/', $basename );
pop(@path);
return join( '/', @path );
}
1;
} # --- END Cpanel/Readlink.pm
{ # --- BEGIN Cpanel/FileUtils/Write.pm
package Cpanel::FileUtils::Write;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
use Cpanel::Autodie ( 'rename', 'syswrite_sigguard', 'seek', 'print', 'truncate' );
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::FileUtils::Open (); # perlpkg line 211
# use Cpanel::Finally (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
our $Errno_EEXIST = 17;
our $MAX_TMPFILE_CREATE_ATTEMPTS = 1024;
my $DEFAULT_PERMS = 0600;
my $_WRONLY_CREAT_EXCL;
sub write_fh { ##no critic qw(RequireArgUnpacking)
my $fh = $_[0];
Cpanel::Autodie::seek( $fh, 0, 0 );
Cpanel::Autodie::print( $fh, $_[1] );
Cpanel::Autodie::truncate( $fh, tell($fh) );
return 1;
}
sub write {
return _write_to_tmpfile( @_[ 0 .. 2 ], \&_write_finish );
}
sub overwrite {
return _write_to_tmpfile( @_[ 0 .. 2 ], \&_overwrite_finish );
}
sub overwrite_no_exceptions {
my $fh;
local $@;
eval {
$fh = overwrite(@_);
1;
} or Cpanel::Debug::log_warn("overwrite exception: $@");
return !!$fh;
}
sub _write_to_tmpfile { ##no critic qw(RequireArgUnpacking)
my ( $filename, $perms_or_hr, $finish_cr ) = ( $_[0], $_[2], $_[3] );
if ( !defined $filename ) {
exists $INC{'Carp.pm'} ? Carp::confess("write() called with undefined filename") : die("write() called with undefined filename");
}
if ( ref $filename ) {
die "Use write_fh to write to a file handle. ($filename is a filehandle, right?)";
}
my ( $fh, $tmpfile_is_renamed );
if ( -l $filename ) {
require Cpanel::Readlink;
$filename = Cpanel::Readlink::deep($filename);
}
my ( $callback_cr, $tmp_perms );
if ( 'HASH' eq ref $perms_or_hr ) {
$callback_cr = $perms_or_hr->{'before_installation'};
}
else {
$tmp_perms = $perms_or_hr;
}
$tmp_perms //= $DEFAULT_PERMS;
my ( $tmpfile, $attempts ) = ( '', 0 );
while (1) {
local $!;
my $rand = rand(99999999);
$rand = sprintf( '%x', substr( $rand, 2 ) );
my $last_slash_idx = rindex( $filename, '/' );
$tmpfile = $filename;
substr( $tmpfile, 1 + $last_slash_idx, 0 ) = ".tmp.$rand.";
last if Cpanel::FileUtils::Open::sysopen_with_real_perms(
$fh,
$tmpfile,
( $_WRONLY_CREAT_EXCL ||= ( $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_EXCL | $Cpanel::Fcntl::Constants::O_WRONLY ) ),
$tmp_perms,
);
if ( $! != $Errno_EEXIST ) {
die Cpanel::Exception::create( 'IO::FileCreateError', [ error => $!, path => $tmpfile, permissions => $tmp_perms ] );
}
++$attempts;
if ( $attempts >= $MAX_TMPFILE_CREATE_ATTEMPTS ) {
die Cpanel::Exception::create_raw( 'IO::FileCreateError', "Too many ($MAX_TMPFILE_CREATE_ATTEMPTS) failed attempts to create a temp file as EUID $> and GID $) based on “$filename”! The last tried file was “$tmpfile”, and the last error was: $!" );
}
}
my $finally = Cpanel::Finally->new(
sub {
if ( !$tmpfile_is_renamed ) {
Cpanel::Autodie::unlink_if_exists($tmpfile);
}
return;
}
);
if ( my $ref = ref $_[1] ) {
if ( $ref eq 'SCALAR' ) {
_write_fh( $fh, ${ $_[1] } );
}
else {
die Cpanel::Exception::create( 'InvalidParameter', 'Invalid content type “[_1]”, expect a scalar.', [$ref] );
}
}
else {
_write_fh( $fh, $_[1] );
}
$callback_cr->($fh) if $callback_cr;
$tmpfile_is_renamed = $finish_cr->( $tmpfile, $filename );
if ( !$tmpfile_is_renamed ) {
Cpanel::Autodie::unlink_if_exists($tmpfile);
}
$finally->skip();
return $fh;
}
*_syswrite = *Cpanel::Autodie::syswrite_sigguard;
our $DEBUG_WRITE;
sub _write_fh {
if ( length $_[1] ) {
my $pos = 0;
do {
local $SIG{'XFSZ'} = 'IGNORE' if $pos;
$pos += _syswrite( $_[0], $_[1], length( $_[1] ), $pos ) || do {
die "Zero bytes written, non-error!";
};
} while $pos < length( $_[1] );
}
return;
}
sub _write_finish {
Cpanel::Autodie::link(@_);
return 0;
}
*_overwrite_finish = *Cpanel::Autodie::rename;
1;
} # --- END Cpanel/FileUtils/Write.pm
{ # --- BEGIN Cpanel/FileUtils/Write/JSON/Lazy.pm
package Cpanel::FileUtils::Write::JSON::Lazy;
use strict;
use warnings;
no warnings 'once';
sub write_file {
my ( $file_or_fh, $data, $perms ) = @_;
if ( exists $INC{'Cpanel/JSON.pm'} && exists $INC{'JSON/XS.pm'} && ( my $Dump = 'Cpanel::JSON'->can('Dump') ) ) { # PPI NO PARSE -- check earlier - must be quoted or it ends up in the stash
require Cpanel::FileUtils::Write if !$INC{'Cpanel/FileUtils/Write.pm'};
require Cpanel::FHUtils::Tiny if !$INC{'Cpanel/FHUtils/Tiny.pm'};
my $func = Cpanel::FHUtils::Tiny::is_a($file_or_fh) ? 'write_fh' : 'overwrite';
if ( $func eq 'write_fh' ) {
if ( !defined $perms ) {
$perms = 0600;
}
chmod( $perms, $file_or_fh ) or die "Failed to set permissions on the file handle passed to Cpanel::FileUtils::Write::JSON::Lazy::write_file because of an error: $!";
}
return Cpanel::FileUtils::Write->can($func)->(
$file_or_fh,
$Dump->($data),
$perms
);
}
return 0;
}
sub write_file_pretty {
my ( $file_or_fh, $data, $perms ) = @_;
if ( exists $INC{'Cpanel/JSON.pm'} && exists $INC{'JSON/XS.pm'} && ( my $Dump = 'Cpanel::JSON'->can('pretty_dump') ) ) { # PPI NO PARSE -- check earlier - must be quoted or it ends up in the stash
require Cpanel::FileUtils::Write if !$INC{'Cpanel/FileUtils/Write.pm'};
require Cpanel::FHUtils::Tiny if !$INC{'Cpanel/FHUtils/Tiny.pm'};
my $func = Cpanel::FHUtils::Tiny::is_a($file_or_fh) ? 'write_fh' : 'overwrite';
if ( $func eq 'write_fh' ) {
if ( !defined $perms ) {
$perms = 0600;
}
chmod( $perms, $file_or_fh ) or die "Failed to set permissions on the file handle passed to Cpanel::FileUtils::Write::JSON::Lazy::write_file because of an error: $!";
}
return Cpanel::FileUtils::Write->can($func)->(
$file_or_fh,
$Dump->($data),
$perms
);
}
return 0;
}
1;
} # --- END Cpanel/FileUtils/Write/JSON/Lazy.pm
{ # --- BEGIN Cpanel/AdminBin/Serializer.pm
package Cpanel::AdminBin::Serializer;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::JSON (); # perlpkg line 211
our $VERSION = '2.4';
our $MAX_LOAD_LENGTH;
our $MAX_PRIV_LOAD_LENGTH;
BEGIN {
*MAX_LOAD_LENGTH = \$Cpanel::JSON::MAX_LOAD_LENGTH;
*MAX_PRIV_LOAD_LENGTH = \$Cpanel::JSON::MAX_PRIV_LOAD_LENGTH;
*DumpFile = *Cpanel::JSON::DumpFile;
}
BEGIN {
*Dump = *Cpanel::JSON::Dump;
*SafeDump = *Cpanel::JSON::SafeDump;
*LoadFile = *Cpanel::JSON::LoadFileNoSetUTF8;
*Load = *Cpanel::JSON::Load;
*looks_like_serialized_data = *Cpanel::JSON::looks_like_json;
}
sub SafeLoadFile {
return Cpanel::JSON::_LoadFile( $_[0], $Cpanel::JSON::MAX_LOAD_LENGTH, $Cpanel::JSON::DECODE_UTF8, $_[1], $Cpanel::JSON::LOAD_STRICT );
}
sub SafeLoad {
utf8::decode( $_[0] );
return Cpanel::JSON::LoadNoSetUTF8(@_);
}
sub clone {
return Cpanel::JSON::LoadNoSetUTF8( Cpanel::JSON::Dump( $_[0] ) );
}
1;
} # --- END Cpanel/AdminBin/Serializer.pm
{ # --- BEGIN Cpanel/AdminBin/Serializer/FailOK.pm
package Cpanel::AdminBin::Serializer::FailOK;
use strict;
use warnings;
no warnings 'once';
sub LoadModule {
local $@;
return 1 if $INC{'Cpanel/AdminBin/Serializer.pm'};
my $load_ok = eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
require Cpanel::AdminBin::Serializer;
1;
};
if ( !$load_ok && !$ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == 0 ) {
warn $@;
}
return $load_ok ? 1 : 0;
}
sub LoadFile {
my ( $file_or_fh, $path ) = @_;
return undef if !$INC{'Cpanel/AdminBin/Serializer.pm'};
return eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
Cpanel::AdminBin::Serializer::LoadFile( $file_or_fh, undef, $path );
};
}
1;
} # --- END Cpanel/AdminBin/Serializer/FailOK.pm
{ # --- BEGIN Cpanel/SV.pm
package Cpanel::SV;
use strict;
use warnings;
no warnings 'once';
sub untaint {
return $_[0] unless ${^TAINT};
require # Cpanel::Static OK - we should not untaint variables as part of updatenow.static
Taint::Util;
Taint::Util::untaint( $_[0] );
return $_[0];
}
1;
} # --- END Cpanel/SV.pm
{ # --- BEGIN Cpanel/Umask.pm
package Cpanel::Umask;
use strict;
# use parent Cpanel::Finally (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Finally); }
sub new {
my ( $class, $new ) = @_;
my $old = umask();
umask($new);
return $class->SUPER::new(
sub {
my $cur = umask();
if ( $cur != $new ) {
my ( $cur_o, $old_o, $new_o ) = map { '0' . sprintf( '%o', $_ ) } ( $cur, $old, $new );
warn "I want to umask($old_o). I expected the current umask to be $new_o, but it’s actually $cur_o.";
}
umask($old);
}
);
}
1;
} # --- END Cpanel/Umask.pm
{ # --- BEGIN Cpanel/Config/LoadConfig.pm
package Cpanel::Config::LoadConfig;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Hash::Stringify (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211
# use Cpanel::AdminBin::Serializer::FailOK (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
# use Cpanel::HiRes (); # perlpkg line 211
# use Cpanel::SV (); # perlpkg line 211
use constant _ENOENT => 2;
my $logger;
our $PRODUCT_CONF_DIR = '/var/cpanel';
our $_DEBUG_SAFEFILE = 0;
my %COMMON_CACHE_NAMES = (
':__^\s*[#;]____0__' => 'default_colon',
':\s+__^\s*[#;]____0__' => 'default_colon_any_space',
': __^\s*[#;]____0__' => 'default_colon_with_one_space',
'=__^\s*[#;]____0__skip_readable_check_____1' => 'default_skip_readable',
'=__^\s*[#;]____0__' => 'default',
'=__^\s*[#;]__(?^:\s+)__0__' => 'default_with_preproc_newline',
'=__^\s*[#;]____1__' => 'default_allow_undef',
'\s*[:]\s*__^\s*[#;]____0__' => 'default_colon_before_after_space',
'\s*=\s*__^\s*[#;]____1__' => 'default_equal_before_after_space_allow_undef',
'\s*[\=]\s*__^\s*[#]____0__use_reverse_____0' => 'default_equal_before_after_space',
': __^\s*[#;]____0__limit_____10000000000_____use_reverse_____0' => 'default_with_10000000000_limit',
'\s*[:]\s*__^\s*[#;]____0__use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_use_hash_of_arr_refs',
': __^\s*[#;]____0__limit__________use_reverse_____0' => 'default_colon_single_space_no_limit',
': __^\s*[#;]____1__skip_keys_____nobody_____use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_colon_skip_nobody_no_limit',
': __^\s*[#;]____1__use_reverse_____1' => 'default_reverse_allow_undef',
'\s+__^\s*[#;]____0__' => 'default_space_seperated_config',
'\s*=\s*__^\s*[#;]__^\s*__0__' => 'default_equal_space_seperated_config', #ea4.conf
);
my $DEFAULT_DELIMITER = '=';
my $DEFAULT_COMMENT_REGEXP = '^\s*[#;]'; #Keep in sync with tr{} below!!
my @BOOLEAN_OPTIONS = qw(
allow_undef_values
use_hash_of_arr_refs
use_reverse
);
my $CACHE_DIR_PERMS = 0700;
sub _process_parse_args {
my (%opts) = @_;
if ( !defined $opts{'delimiter'} ) {
$opts{'delimiter'} = $DEFAULT_DELIMITER;
}
$opts{'regexp_to_preprune'} ||= q{};
$opts{'comment'} ||= $DEFAULT_COMMENT_REGEXP;
$opts{'comment'} = '' if $opts{'comment'} eq '0E0';
$opts{$_} ||= 0 for @BOOLEAN_OPTIONS;
return %opts;
}
{
no warnings 'once';
*get_homedir_and_cache_dir = *_get_homedir_and_cache_dir;
}
sub _get_homedir_and_cache_dir {
my ( $homedir, $cache_dir );
if ( $> == 0 ) {
$cache_dir = "$PRODUCT_CONF_DIR/configs.cache";
}
else {
{
no warnings 'once';
$homedir = $Cpanel::homedir;
}
if ( !$homedir ) {
eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::PwCache'; ## no critic qw(ProhibitStringyEval) # PPI USE OK - just after
$homedir = Cpanel::PwCache::gethomedir() if $INC{'Cpanel/PwCache.pm'};
return unless $homedir; # undef for homedir and cache_dir avoid issues later when using undef as hash key
}
Cpanel::SV::untaint($homedir);
$homedir =~ tr{/}{}s;
return ( $homedir, undef ) if $homedir eq '/';
if ( $ENV{'TEAM_USER'} ) {
$cache_dir = "$homedir/$ENV{'TEAM_USER'}/.cpanel/caches/config";
}
else {
$cache_dir = "$homedir/.cpanel/caches/config";
}
}
return ( $homedir, $cache_dir );
}
sub loadConfig { ## no critic qw(Subroutines::ProhibitExcessComplexity Subroutines::ProhibitManyArgs)
my ( $file, $conf_ref, $delimiter, $comment, $regexp_to_preprune, $allow_undef_values, $arg_ref ) = @_;
$conf_ref ||= -1;
my %processed_positional_args = _process_parse_args(
delimiter => $delimiter,
comment => $comment,
regexp_to_preprune => $regexp_to_preprune,
allow_undef_values => $allow_undef_values,
$arg_ref ? %$arg_ref : (),
);
my $empty_is_invalid = ( defined $arg_ref ) ? delete $arg_ref->{'empty_is_invalid'} : undef;
my ( $use_reverse, $use_hash_of_arr_refs );
( $delimiter, $comment, $regexp_to_preprune, $allow_undef_values, $use_reverse, $use_hash_of_arr_refs ) = @processed_positional_args{
qw(
delimiter
comment
regexp_to_preprune
allow_undef_values
use_reverse
use_hash_of_arr_refs
)
};
if ( !$file || $file =~ tr/\0// ) {
_do_logger( 'warn', 'loadConfig requires valid filename' );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "loadConfig requires valid filename" );
}
return;
}
my $filesys_mtime = ( Cpanel::HiRes::stat($file) )[9] or do {
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "Unable to stat $file: $!" );
}
return;
};
my $load_into_conf_ref = ( !ref $conf_ref && $conf_ref == -1 ) ? 0 : 1;
if ($load_into_conf_ref) {
$conf_ref = _hashify_ref($conf_ref);
}
my ( $homedir, $cache_dir ) = _get_homedir_and_cache_dir();
my $cache_file;
Cpanel::AdminBin::Serializer::FailOK::LoadModule() if !$INC{'Cpanel/AdminBin/Serializer.pm'};
if ( $cache_dir && $INC{'Cpanel/JSON.pm'} && ( !defined $arg_ref || !ref $arg_ref || !exists $arg_ref->{'nocache'} && !$arg_ref->{'keep_locked_open'} ) ) {
$cache_file = get_cache_file(
'file' => $file,
'cache_dir' => $cache_dir,
'delimiter' => $delimiter,
'comment' => $comment,
'regexp_to_preprune' => $regexp_to_preprune,
'allow_undef_values' => $allow_undef_values,
'arg_ref' => $arg_ref,
);
my ( $cache_valid, $ref ) = load_from_cache_if_valid(
'file' => $file,
'cache_file' => $cache_file,
'filesys_mtime' => $filesys_mtime,
'conf_ref' => $conf_ref,
'load_into_conf_ref' => $load_into_conf_ref,
'empty_is_invalid' => $empty_is_invalid,
);
if ($cache_valid) {
return $ref;
}
}
$conf_ref = {} if !$load_into_conf_ref;
my $conf_fh;
my $conflock;
my $locked;
if ( $arg_ref->{'keep_locked_open'} || $arg_ref->{'rw'} ) {
require Cpanel::SafeFile;
$locked = 1;
$conflock = Cpanel::SafeFile::safeopen( $conf_fh, '+<', $file );
}
else {
$conflock = open( $conf_fh, '<', $file );
}
if ( !$conflock ) {
my $open_err = $! || '(unspecified error)';
local $_DEBUG_SAFEFILE = 1;
require Cpanel::Logger;
my $is_root = ( $> == 0 ? 1 : 0 );
if ( !$is_root && !$arg_ref->{'skip_readable_check'} ) {
if ( !-r $file ) {
my $msg;
if ( my $err = $! ) {
$msg = "$file’s readability check failed: $err";
}
else {
my $euser = getpwuid $>;
$msg = "$file is not readable as $euser.";
}
_do_logger( 'warn', $msg );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, $msg );
}
return;
}
}
my $verb = ( $locked ? 'lock/' : q<> ) . 'open';
my $msg = "Unable to $verb $file as UIDs $</$>: $open_err";
Cpanel::Logger::cplog( $msg, 'warn', __PACKAGE__ );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, $msg );
}
return;
}
my ( $parse_ok, $parsed ) = _parse_from_filehandle(
$conf_fh,
comment => $comment,
delimiter => $delimiter,
regexp_to_preprune => $regexp_to_preprune,
allow_undef_values => $allow_undef_values,
use_reverse => $use_reverse,
use_hash_of_arr_refs => $use_hash_of_arr_refs,
$arg_ref ? %$arg_ref : (),
);
if ( $locked && !$arg_ref->{'keep_locked_open'} ) {
require Cpanel::SafeFile;
Cpanel::SafeFile::safeclose( $conf_fh, $conflock );
}
if ( !$parse_ok ) {
require Cpanel::Logger;
Cpanel::Logger::cplog( "Unable to parse $file: $parsed", 'warn', __PACKAGE__ );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "Unable to parse $file: $parsed" );
}
return;
}
@{$conf_ref}{ keys %$parsed } = values %$parsed;
if ($cache_file) {
write_cache(
'cache_dir' => $cache_dir,
'cache_file' => $cache_file,
'homedir' => $homedir,
'is_root' => ( $> == 0 ? 1 : 0 ),
'data' => $parsed,
);
}
if ( $arg_ref->{'keep_locked_open'} ) {
return $conf_ref, $conf_fh, $conflock, "open success";
}
return $conf_ref;
}
sub load_from_cache_if_valid {
my (%opts) = @_;
my $cache_file = $opts{'cache_file'} or die "need cache_file!";
my $file = $opts{'file'};
my $conf_ref = $opts{'conf_ref'};
my $load_into_conf_ref = $opts{'load_into_conf_ref'};
my $filesys_mtime = $opts{'filesys_mtime'} || ( Cpanel::HiRes::stat($file) )[9];
open( my $cache_fh, '<:stdio', $cache_file ) or do {
my $err = $!;
my $msg = "non-fatal error: open($cache_file): $err";
warn $msg if $! != _ENOENT();
return ( 0, $msg );
};
my ( $cache_filesys_mtime, $now, $cache_conf_ref ) = ( ( Cpanel::HiRes::fstat($cache_fh) )[9], Cpanel::HiRes::time() ); # stat the file after we have it open to avoid a race condition
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig file:$file, cache_file:$cache_file, cache_filesys_mtime:$cache_filesys_mtime, filesys_mtime:$filesys_mtime, now:$now\n";
}
if ( $filesys_mtime && _greater_with_same_precision( $cache_filesys_mtime, $filesys_mtime ) && _greater_with_same_precision( $now, $cache_filesys_mtime ) ) {
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig using cache_file:$cache_file\n";
}
Cpanel::AdminBin::Serializer::FailOK::LoadModule() if !$INC{'Cpanel/AdminBin/Serializer.pm'};
if ( $cache_conf_ref = Cpanel::AdminBin::Serializer::FailOK::LoadFile($cache_fh) ) { #zero keys is a valid file still it may just be all comments or empty
close($cache_fh);
if ( $opts{'empty_is_invalid'} && scalar keys %$cache_conf_ref == 0 ) {
return ( 0, 'Cache is empty' );
}
my $ref_to_return;
if ($load_into_conf_ref) {
@{$conf_ref}{ keys %$cache_conf_ref } = values %$cache_conf_ref;
$ref_to_return = $conf_ref;
}
else {
$ref_to_return = $cache_conf_ref;
}
return ( 1, $ref_to_return );
}
elsif ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig failed to load cache_file:$cache_file\n";
}
}
else {
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig NOT using cache_file:$cache_file\n";
}
}
return ( 0, 'Cache not valid' );
}
sub _greater_with_same_precision {
my ( $float1, $float2 ) = @_;
my ( $int1, $int2 ) = ( int($float1), int($float2) );
if ( $float1 == $int1 or $float2 == $int2 ) {
return $int1 > $int2;
}
return $float1 > $float2;
}
sub get_cache_file { ## no critic qw(Subroutines::RequireArgUnpacking) - Args unpacked by _process_parse_args
my %opts = _process_parse_args(@_);
die 'need cache_dir!' if !$opts{'cache_dir'};
my $stringified_args = join(
'__',
@opts{qw(delimiter comment regexp_to_preprune allow_undef_values)}, ( scalar keys %{ $opts{'arg_ref'} } ? Cpanel::Hash::Stringify::sorted_hashref_string( $opts{'arg_ref'} ) : '' )
);
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) { # PPI NO PARSE - ok missing
print STDERR __PACKAGE__ . "::loadConfig stringified_args[$stringified_args]\n";
}
my $safe_filename = $opts{'file'};
$safe_filename =~ tr{/}{_};
return $opts{'cache_dir'} . '/' . $safe_filename . '___' . ( $COMMON_CACHE_NAMES{$stringified_args} || _get_fastest_hash($stringified_args) );
}
sub _get_fastest_hash {
require Cpanel::Hash;
goto \&Cpanel::Hash::get_fastest_hash;
}
sub write_cache {
my (%opts) = @_;
my $cache_file = $opts{'cache_file'};
my $cache_dir = $opts{'cache_dir'};
my $homedir = $opts{'homedir'};
my $is_root = $opts{'is_root'};
my $parsed = $opts{'data'};
my @dirs = ($cache_dir);
if ( !$is_root ) {
if ( $ENV{'TEAM_USER'} ) {
unshift @dirs, "$homedir/$ENV{'TEAM_USER'}", "$homedir/$ENV{'TEAM_USER'}/.cpanel", "$homedir/$ENV{'TEAM_USER'}/.cpanel/caches";
}
else {
unshift @dirs, "$homedir/.cpanel", "$homedir/.cpanel/caches";
}
}
foreach my $dir (@dirs) {
Cpanel::SV::untaint($dir);
chmod( $CACHE_DIR_PERMS, $dir ) or do {
if ( $! == _ENOENT() ) {
require Cpanel::Umask;
my $umask = Cpanel::Umask->new(0);
mkdir( $dir, $CACHE_DIR_PERMS ) or do {
_do_logger( 'warn', "Failed to create dir “$dir”: $!" );
};
}
else {
_do_logger( 'warn', "chmod($dir): $!" );
}
};
}
my $wrote_ok = eval { Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, $parsed, 0600 ) };
my $error = $@;
$error ||= "Unknown error" if !defined $wrote_ok;
if ($error) {
_do_logger( 'warn', "Could not create cache file “$cache_file”: $error" );
unlink $cache_file; #outdated
}
if ( ( $Cpanel::Debug::level || 0 ) > 4 ) { # PPI NO PARSE - ok missing
print STDERR __PACKAGE__ . "::loadConfig [lazy write cache file] [$cache_file] wrote_ok:[$wrote_ok]\n";
}
return 1;
}
sub _do_logger {
my ( $action, $msg ) = @_;
require Cpanel::Logger;
$logger ||= Cpanel::Logger->new();
return $logger->$action($msg);
}
sub parse_from_filehandle {
my ( $conf_fh, %opts ) = @_;
return _parse_from_filehandle( $conf_fh, _process_parse_args(%opts) );
}
sub _parse_from_filehandle {
my ( $conf_fh, %opts ) = @_;
my ( $comment, $limit, $regexp_to_preprune, $delimiter, $allow_undef_values, $use_hash_of_arr_refs, $skip_keys, $use_reverse ) = @opts{
qw(
comment
limit
regexp_to_preprune
delimiter
allow_undef_values
use_hash_of_arr_refs
skip_keys
use_reverse
)
};
my $conf_ref = {};
my $parser_code;
my ( $k, $v ); ## no critic qw(Variables::ProhibitUnusedVariables)
my $keys = 0;
my $key_value_text = $use_reverse ? '1,0' : '0,1';
my $cfg_txt = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $conf_fh, $cfg_txt );
my $has_cr = index( $cfg_txt, "\r" ) > -1 ? 1 : 0;
_remove_comments_from_text( \$cfg_txt, $comment, \$has_cr ) if $cfg_txt && $comment;
my $split_on = $has_cr ? '\r?\n' : '\n';
if ( !$limit && !$regexp_to_preprune && !$use_hash_of_arr_refs && length $delimiter ) {
if ($allow_undef_values) {
$parser_code = qq<
\$conf_ref = {
map {
(split(m/> . $delimiter . qq</, \$_, 2))[$key_value_text]
} split(/> . $split_on . qq</, \$cfg_txt)
};
>;
}
else {
$parser_code = ' $conf_ref = { map { ' . '($k,$v) = (split(m/' . $delimiter . '/, $_, 2))[' . $key_value_text . ']; ' . 'defined($v) ? ($k,$v) : () ' . '} split(/' . $split_on . '/, $cfg_txt ) }';
}
}
else {
if ( ( $Cpanel::Debug::level || 0 ) > 4 ) { # PPI NO PARSE - ok if not there
$limit ||= 0;
print STDERR __PACKAGE__ . "::parse_from_filehandle [slow LoadConfig parser used] LIMIT:[!$limit] REGEXP_TO_DELETE[!$regexp_to_preprune] USE_HASH_OF_ARR_REFS[$use_hash_of_arr_refs)]\n";
}
$parser_code = 'foreach (split(m/' . $split_on . '/, $cfg_txt)) {' . "\n" #
. q{next if !length;} . "\n" #
. ( $limit ? q{last if $keys++ == } . $limit . ';' : '' ) . "\n" . ( $regexp_to_preprune ? q{ s/} . $regexp_to_preprune . q{//g;} : '' ) . "\n" #
. (
length $delimiter ? #
(
q{( $k, $v ) = (split( /} . $delimiter . q{/, $_, 2 ))[} . $key_value_text . q{];} . "\n" . #
( !$allow_undef_values ? q{ next if !defined($v); } : '' ) . "\n" . #
( $use_hash_of_arr_refs ? q{ push @{ $conf_ref->{$k} }, $v; } : q{ $conf_ref->{$k} = $v; } ) . "\n" #
)
: q{$conf_ref->{$_} = 1; } . "\n"
) . '};';
}
$parser_code .= "; 1";
$parser_code =~ tr{\n}{\r}; ## no critic qw(Cpanel::TransliterationUsage)
eval($parser_code) or do { ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
$parser_code =~ tr{\r}{\n}; ## no critic qw(Cpanel::TransliterationUsage)
_do_logger( 'panic', "Failed to parse :: $parser_code: $@" );
return ( 0, "$@\n$parser_code" );
};
delete $conf_ref->{''} if !defined( $conf_ref->{''} );
if ($skip_keys) {
my $skip_keys_ar;
if ( ref $skip_keys eq 'ARRAY' ) {
$skip_keys_ar = $skip_keys;
}
elsif ( ref $skip_keys eq 'HASH' ) {
$skip_keys_ar = [ keys %$skip_keys ];
}
else {
return ( 0, 'skip_keys must be an ARRAY or HASH reference' );
}
delete @{$conf_ref}{@$skip_keys_ar};
}
return ( 1, $conf_ref );
}
sub _hashify_ref {
my $conf_ref = shift;
if ( !defined($conf_ref) ) {
$conf_ref = {};
return $conf_ref;
}
unless ( ref $conf_ref eq 'HASH' ) {
if ( ref $conf_ref ) {
require Cpanel::Logger;
Cpanel::Logger::cplog( 'hashifying non-HASH reference', 'warn', __PACKAGE__ );
${$conf_ref} = {};
$conf_ref = ${$conf_ref};
}
else {
require Cpanel::Logger;
Cpanel::Logger::cplog( 'defined value encountered where reference expected', 'die', __PACKAGE__ );
}
}
return $conf_ref;
}
sub default_product_dir {
$PRODUCT_CONF_DIR = shift if @_;
return $PRODUCT_CONF_DIR;
}
sub _remove_comments_from_text {
my ( $cfg_txt_sr, $comment, $has_cr_sr ) = @_;
if ($$has_cr_sr) {
$$cfg_txt_sr = join( "\n", grep ( !m/$comment/, split( m{\r?\n}, $$cfg_txt_sr ) ) );
$$has_cr_sr = 0;
}
elsif ( $comment eq $DEFAULT_COMMENT_REGEXP ) {
if ( rindex( $$cfg_txt_sr, '#', 0 ) == 0 && index( $$cfg_txt_sr, "\n" ) > -1 ) {
substr( $$cfg_txt_sr, 0, index( $$cfg_txt_sr, "\n" ) + 1, '' );
}
$$cfg_txt_sr =~ s{$DEFAULT_COMMENT_REGEXP.*}{}omg if $$cfg_txt_sr =~ tr{#;}{};
}
else {
$$cfg_txt_sr =~ s{$comment.*}{}mg;
}
return 1;
}
1;
} # --- END Cpanel/Config/LoadConfig.pm
{ # --- BEGIN Cpanel/Config/LoadWwwAcctConf.pm
package Cpanel::Config::LoadWwwAcctConf;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::HiRes (); # perlpkg line 211
# use Cpanel::Path::Normalize (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::JSON::FailOK (); # perlpkg line 211
my $SYSTEM_CONF_DIR = '/etc';
my $wwwconf_cache;
my $wwwconf_mtime = 0;
my $has_serializer;
our $wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf";
our $wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow";
sub import {
my $this = shift;
if ( !exists $INC{'Cpanel/JSON.pm'} ) {
Cpanel::JSON::FailOK::LoadJSONModule();
}
if ( $INC{'Cpanel/JSON.pm'} ) {
$has_serializer = 1;
}
return Exporter::import( $this, @_ );
}
sub loadwwwacctconf { ## no critic qw(Subroutines::ProhibitExcessComplexity)
if ( $INC{'Cpanel/JSON.pm'} ) { $has_serializer = 1; } #something else loaded it
my $filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconf) )[9];
return if !$filesys_mtime;
if ( $filesys_mtime == $wwwconf_mtime && $wwwconf_cache ) {
return wantarray ? %{$wwwconf_cache} : $wwwconf_cache;
}
my $wwwacctconf_cache = "$wwwacctconf.cache";
my $wwwacctconfshadow_cache = "$wwwacctconfshadow.cache";
my $is_root = $> ? 0 : 1;
if ($has_serializer) {
my $cache_file;
my $cache_filesys_mtime;
my $have_valid_cache = 1;
if ( $is_root && -e $wwwacctconfshadow_cache ) {
$cache_filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconfshadow_cache) )[9]; #shadow cache's mtime
my $shadow_file_mtime = ( Cpanel::HiRes::stat $wwwacctconfshadow )[9] || 0;
if ( $shadow_file_mtime < $cache_filesys_mtime ) {
$cache_file = $wwwacctconfshadow_cache;
}
else { #don't use shadow cache if shadow file is newer
$have_valid_cache = undef;
}
}
elsif ( -e $wwwacctconf_cache && !( $is_root && -r $wwwacctconfshadow ) ) {
$cache_filesys_mtime = ( Cpanel::HiRes::stat $wwwacctconf_cache )[9]; #regular cache's mtime
$cache_file = $wwwacctconf_cache;
}
else {
$have_valid_cache = undef;
}
my $now = Cpanel::HiRes::time();
if ( $Cpanel::Debug::level >= 5 ) {
print STDERR __PACKAGE__ . "::loadwwwacctconf cache_filesys_mtime = $cache_filesys_mtime , filesys_mtime: $filesys_mtime , now : $now\n";
}
if ( $have_valid_cache && $cache_filesys_mtime > $filesys_mtime && $cache_filesys_mtime < $now ) {
my $wwwconf_ref;
if ( open( my $conf_fh, '<', $cache_file ) ) {
$wwwconf_ref = Cpanel::JSON::FailOK::LoadFile($conf_fh);
close($conf_fh);
}
if ( $wwwconf_ref && ( scalar keys %{$wwwconf_ref} ) > 0 ) {
if ( $Cpanel::Debug::level >= 5 ) { print STDERR __PACKAGE__ . "::loadwwwconf file system cache hit\n"; }
$wwwconf_cache = $wwwconf_ref;
$wwwconf_mtime = $filesys_mtime;
return wantarray ? %{$wwwconf_ref} : $wwwconf_ref;
}
}
}
my @configfiles;
push @configfiles, $wwwacctconf;
if ($is_root) { push @configfiles, $wwwacctconfshadow; } #shadow file must be last as the cache gets written for each file with all the files before it in it
my $can_write_cache;
if ( $is_root && $has_serializer ) {
$can_write_cache = 1;
}
my %CONF = (
'ADDR' => undef,
'CONTACTEMAIL' => undef,
'DEFMOD' => undef,
'ETHDEV' => undef,
'HOST' => undef,
'NS' => undef,
'NS2' => undef,
);
require Cpanel::Config::LoadConfig;
foreach my $configfile (@configfiles) {
Cpanel::Config::LoadConfig::loadConfig( $configfile, \%CONF, '\s+', undef, undef, undef, { 'nocache' => 1 } );
foreach ( keys %CONF ) {
$CONF{$_} =~ s{\s+$}{} if defined $CONF{$_};
}
$CONF{'HOMEMATCH'} =~ s{/+$}{} if defined $CONF{'HOMEMATCH'}; # Remove trailing slashes
$CONF{'HOMEDIR'} = Cpanel::Path::Normalize::normalize( $CONF{'HOMEDIR'} ) if defined $CONF{'HOMEDIR'};
if ($can_write_cache) {
my $cache_file = $configfile . '.cache';
require Cpanel::FileUtils::Write::JSON::Lazy;
Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, \%CONF, ( $configfile eq $wwwacctconfshadow ) ? 0600 : 0644 );
}
}
$wwwconf_mtime = $filesys_mtime;
$wwwconf_cache = \%CONF;
return wantarray ? %CONF : \%CONF;
}
sub reset_mem_cache {
( $wwwconf_mtime, $wwwconf_cache ) = ( 0, undef );
}
sub reset_has_serializer {
$has_serializer = 0;
}
sub default_conf_dir {
$SYSTEM_CONF_DIR = shift if @_;
$wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf";
$wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow";
return $SYSTEM_CONF_DIR;
}
sub reset_caches {
my @cache_files = map { "$_.cache" } ( $wwwacctconf, $wwwacctconfshadow );
for my $cache_file (@cache_files) {
unlink $cache_file if -e $cache_file;
}
reset_mem_cache();
return;
}
1;
} # --- END Cpanel/Config/LoadWwwAcctConf.pm
{ # --- BEGIN Cpanel/StatCache.pm
package Cpanel::StatCache;
use strict;
use warnings;
no warnings 'once';
our $VERSION = 0.4;
my %STATCACHE;
our $USE_LSTAT = 0;
sub StatCache_init { }
sub cachedmtime {
return (
exists $STATCACHE{ $_[0] } ? $STATCACHE{ $_[0] }->[0]
: (
$STATCACHE{ $_[0] } = (
$USE_LSTAT && -l $_[0] ? [ ( lstat(_) )[ 9, 7, 10 ] ]
: -e $_[0] ? [ ( stat(_) )[ 9, 7, 10 ] ]
: [ 0, 0, 0 ]
)
)->[0]
);
}
sub cachedmtime_size {
return (
exists $STATCACHE{ $_[0] } ? @{ $STATCACHE{ $_[0] } }[ 0, 1 ]
: @{
(
$STATCACHE{ $_[0] } = (
$USE_LSTAT && -l $_[0] ? [ ( lstat(_) )[ 9, 7, 10 ] ]
: -e $_[0] ? [ ( stat(_) )[ 9, 7, 10 ] ]
: [ 0, 0, 0 ]
)
)
}[ 0, 1 ]
);
}
sub cachedmtime_ctime {
return (
exists $STATCACHE{ $_[0] } ? @{ $STATCACHE{ $_[0] } }[ 0, 2 ]
: @{
(
$STATCACHE{ $_[0] } = (
$USE_LSTAT && -l $_[0] ? [ ( lstat(_) )[ 9, 7, 10 ] ]
: -e $_[0] ? [ ( stat(_) )[ 9, 7, 10 ] ]
: [ 0, 0, 0 ]
)
)
}[ 0, 2 ]
);
}
sub clearcache {
%STATCACHE = ();
return 1;
}
1;
} # --- END Cpanel/StatCache.pm
{ # --- BEGIN Cpanel/NSCD/Constants.pm
package Cpanel::NSCD::Constants;
use strict;
our $NSCD_CONFIG_FILE = '/etc/nscd.conf';
our $NSCD_SOCKET = '/var/run/nscd/socket';
1;
} # --- END Cpanel/NSCD/Constants.pm
{ # --- BEGIN Cpanel/Socket/UNIX/Micro.pm
package Cpanel::Socket::UNIX::Micro;
use strict;
my $MAX_PATH_LENGTH = 107;
my $LITTLE_ENDIAN_TEMPLATE = 'vZ' . ( 1 + $MAX_PATH_LENGTH ); # x86_64 is always little endian
my $AF_UNIX = 1;
my $SOCK_STREAM = 1;
sub connect {
socket( $_[0], $AF_UNIX, $SOCK_STREAM, 0 ) or warn "socket(AF_UNIX, SOCK_STREAM): $!";
return connect( $_[0], micro_sockaddr_un( $_[1] ) );
}
sub micro_sockaddr_un {
if ( length( $_[0] ) > $MAX_PATH_LENGTH ) {
my $excess = length( $_[0] ) - $MAX_PATH_LENGTH;
die "“$_[0]” is $excess character(s) too long to be a path to a local socket ($MAX_PATH_LENGTH bytes maximum)!";
}
return pack( 'va*', $AF_UNIX, $_[0] ) if 0 == rindex( $_[0], "\0", 0 );
return pack(
$LITTLE_ENDIAN_TEMPLATE, # x86_64 is always little endian
$AF_UNIX,
$_[0],
);
}
sub unpack_sockaddr_un {
return substr( $_[0], 2 ) if 2 == rindex( $_[0], "\0", 2 );
return ( unpack $LITTLE_ENDIAN_TEMPLATE, $_[0] )[1];
}
1;
} # --- END Cpanel/Socket/UNIX/Micro.pm
{ # --- BEGIN Cpanel/NSCD/Check.pm
package Cpanel::NSCD::Check;
use strict;
# use Cpanel::NSCD::Constants (); # perlpkg line 211
# use Cpanel::Socket::UNIX::Micro (); # perlpkg line 211
our $CACHE_TTL = 600;
my $last_check_time = 0;
my $nscd_is_running_cache;
sub nscd_is_running {
my $now = time();
if ( $last_check_time && $last_check_time + $CACHE_TTL > $now ) {
return $nscd_is_running_cache;
}
$last_check_time = $now;
my $socket;
if ( Cpanel::Socket::UNIX::Micro::connect( $socket, $Cpanel::NSCD::Constants::NSCD_SOCKET ) ) {
return ( $nscd_is_running_cache = 1 );
}
return ( $nscd_is_running_cache = 0 );
}
1;
} # --- END Cpanel/NSCD/Check.pm
{ # --- BEGIN Cpanel/PwCache/Helpers.pm
package Cpanel::PwCache::Helpers;
use strict;
use warnings;
no warnings 'once';
my $skip_uid_cache = 0;
sub no_uid_cache { $skip_uid_cache = 1; return }
sub uid_cache { $skip_uid_cache = 0; return }
sub skip_uid_cache {
return $skip_uid_cache;
}
sub init {
my ( $totie, $skip_uid_cache_value ) = @_;
tiedto($totie);
$skip_uid_cache = $skip_uid_cache_value;
return;
}
{ # debugging helpers
sub confess { require Carp; return Carp::confess(@_) }
sub cluck { require Carp; return Carp::cluck(@_) }
}
{ # tie logic and cache
my $pwcacheistied = 0;
my $pwcachetie;
sub istied { return $pwcacheistied }
sub deinit { $pwcacheistied = 0; return; }
sub tiedto {
my $v = shift;
if ( !defined $v ) { # get
return $pwcacheistied ? $pwcachetie : undef;
}
else { # set
$pwcacheistied = 1;
$pwcachetie = $v;
}
return;
}
}
{
my $SYSTEM_CONF_DIR = '/etc';
my $PRODUCT_CONF_DIR = '/var/cpanel';
sub default_conf_dir { return $SYSTEM_CONF_DIR }
sub default_product_dir { return $PRODUCT_CONF_DIR; }
}
1;
} # --- END Cpanel/PwCache/Helpers.pm
{ # --- BEGIN Cpanel/PwCache/Cache.pm
package Cpanel::PwCache::Cache;
use strict;
use warnings;
no warnings 'once';
my %_cache;
my %_homedir_cache;
use constant get_cache => \%_cache;
use constant get_homedir_cache => \%_homedir_cache;
our $pwcache_inited = 0;
my $PWCACHE_IS_SAFE = 1;
sub clear { # clear all
%_cache = ();
%_homedir_cache = ();
$pwcache_inited = 0;
return;
}
sub remove_key {
my ($pwkey) = @_;
return delete $_cache{$pwkey};
}
sub replace {
my $h = shift;
%_cache = %$h if ref $h eq 'HASH';
return;
}
sub is_safe {
$PWCACHE_IS_SAFE = $_[0] if defined $_[0];
return $PWCACHE_IS_SAFE;
}
sub pwmksafecache {
return if $PWCACHE_IS_SAFE;
$_cache{$_}{'contents'}->[1] = 'x' for keys %_cache;
$PWCACHE_IS_SAFE = 1;
return;
}
1;
} # --- END Cpanel/PwCache/Cache.pm
{ # --- BEGIN Cpanel/PwCache/Find.pm
package Cpanel::PwCache::Find;
use strict;
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
our $PW_CHUNK_SIZE = 1 << 17;
sub field_with_value_in_pw_file {
my ( $passwd_fh, $field, $value, $lc_flag ) = @_;
return if ( $value =~ tr{\x{00}-\x{1f}\x{7f}:}{} );
my $needle = $field == 0 ? "\n${value}:" : ":${value}";
my $haystack;
my $match_pos = 0;
my $line_start;
my $line_end;
my $not_eof;
my $data = "\n";
while ( ( $not_eof = Cpanel::LoadFile::ReadFast::read_fast( $passwd_fh, $data, $PW_CHUNK_SIZE, length $data ) ) || length($data) > 1 ) {
$haystack = $not_eof ? substr( $data, 0, rindex( $data, "\n" ), '' ) : $data;
if ( $lc_flag && $lc_flag == 1 ) {
$haystack = lc $haystack;
$needle = lc $needle;
}
while ( -1 < ( $match_pos = index( $haystack, $needle, $match_pos ) ) ) {
$line_start = ( !$field ? $match_pos : rindex( $haystack, "\n", $match_pos ) ) + 1;
if (
!$field || (
$field == ( substr( $haystack, $line_start, $match_pos - $line_start + 1 ) =~ tr{:}{} )
&& ( length($haystack) == $match_pos + length($needle) || substr( $haystack, $match_pos + length($needle), 1 ) =~ tr{:\n}{} )
)
) {
$line_end = index( $haystack, "\n", $match_pos + length($needle) );
my $line = substr( $haystack, $line_start, ( $line_end > -1 ? $line_end : length($haystack) ) - $line_start );
return split( ':', $line );
}
$match_pos += length($needle);
}
last unless $not_eof;
}
return;
}
1;
} # --- END Cpanel/PwCache/Find.pm
{ # --- BEGIN Cpanel/PwCache/Build.pm
package Cpanel::PwCache::Build;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::JSON::FailOK (); # perlpkg line 211
# use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211
# use Cpanel::PwCache::Helpers (); # perlpkg line 211
# use Cpanel::PwCache::Cache (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
my ( $MIN_FIELDS_FOR_VALID_ENTRY, $pwcache_has_uid_cache ) = ( 0, 6 );
sub pwmksafecache {
return if Cpanel::PwCache::Cache::is_safe();
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
$pwcache_ref->{$_}{'contents'}->[1] = 'x' for keys %{$pwcache_ref};
Cpanel::PwCache::Cache::is_safe(1);
return;
}
sub pwclearcache { # also known as clear_this_process_cache
$pwcache_has_uid_cache = undef;
Cpanel::PwCache::Cache::clear();
return;
}
sub init_pwcache {
Cpanel::PwCache::Cache::is_safe(0);
return _build_pwcache();
}
sub init_passwdless_pwcache {
return _build_pwcache( 'nopasswd' => 1 );
}
sub fetch_pwcache {
init_passwdless_pwcache() unless pwcache_is_initted();
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
if ( scalar keys %$pwcache_ref < 3 ) {
die "The password cache unexpectedly had less than 3 entries";
}
return [ map { $pwcache_ref->{$_}->{'contents'} } grep { substr( $_, 0, 1 ) eq '0' } keys %{$pwcache_ref} ];
}
sub _write_json_cache {
my ($cache_file) = @_;
if ( !Cpanel::PwCache::Helpers::istied() && exists $INC{'Cpanel/JSON.pm'} ) {
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
if ( !ref $pwcache_ref || scalar keys %$pwcache_ref < 3 ) {
die "The system failed build the password cache";
}
Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, $pwcache_ref, 0600 );
}
return;
}
sub _write_tied_cache {
my ( $crypted_passwd_ref, $passwdmtime, $hpasswdmtime ) = @_;
my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir();
local $!;
if ( open( my $pwcache_passwd_fh, '<:stdio', "$SYSTEM_CONF_DIR/passwd" ) ) {
local $/;
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
my $data = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $pwcache_passwd_fh, $data );
die "The file “$SYSTEM_CONF_DIR/passwd” was unexpectedly empty" if !length $data;
my @fields;
my $skip_uid_cache = Cpanel::PwCache::Helpers::skip_uid_cache();
foreach my $line ( split( /\n/, $data ) ) {
next unless length $line;
@fields = split( /:/, $line );
next if scalar @fields < $MIN_FIELDS_FOR_VALID_ENTRY || $fields[0] =~ tr/[A-Z][a-z][0-9]._-//c;
$pwcache_ref->{ '0:' . $fields[0] } = {
'cachetime' => $passwdmtime,
'hcachetime' => $hpasswdmtime,
'contents' => [ $fields[0], $crypted_passwd_ref->{ $fields[0] } || $fields[1], $fields[2], $fields[3], '', '', $fields[4], $fields[5], $fields[6], -1, -1, $passwdmtime, $hpasswdmtime ]
};
next if $skip_uid_cache || !defined $fields[2] || exists $pwcache_ref->{ '2:' . $fields[2] };
$pwcache_ref->{ '2:' . $fields[2] } = $pwcache_ref->{ '0:' . $fields[0] };
}
close($pwcache_passwd_fh);
}
else {
die "The system failed to read $SYSTEM_CONF_DIR/passwd because of an error: $!";
}
return;
}
sub _cache_ref_is_valid {
my ( $cache_ref, $passwdmtime, $hpasswdmtime ) = @_;
my @keys = qw/0:root 0:cpanel 0:bin/;
return
$cache_ref
&& ( scalar keys %{$cache_ref} ) > 2
&& scalar @keys == grep { #
$cache_ref->{$_}->{'hcachetime'}
&& $cache_ref->{$_}->{'hcachetime'} == $hpasswdmtime
&& $cache_ref->{$_}->{'cachetime'}
&& $cache_ref->{$_}->{'cachetime'} == $passwdmtime
} @keys;
}
sub _build_pwcache {
my %OPTS = @_;
if ( $INC{'B/C.pm'} ) {
Cpanel::PwCache::Helpers::confess("Cpanel::PwCache::Build::_build_pwcache cannot be run under B::C (see case 162857)");
}
my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir();
my ( $cache_file, $passwdmtime, $cache_file_mtime, $crypted_passwd_ref, $crypted_passwd_file, $hpasswdmtime ) = ( "$SYSTEM_CONF_DIR/passwd.cache", ( stat("$SYSTEM_CONF_DIR/passwd") )[9] );
if ( $OPTS{'nopasswd'} ) {
$hpasswdmtime = ( stat("$SYSTEM_CONF_DIR/shadow") )[9];
$cache_file = "$SYSTEM_CONF_DIR/passwd" . ( Cpanel::PwCache::Helpers::skip_uid_cache() ? '.nouids' : '' ) . '.cache';
}
elsif ( -r "$SYSTEM_CONF_DIR/shadow" ) {
Cpanel::PwCache::Cache::is_safe(0);
$hpasswdmtime = ( stat(_) )[9];
$crypted_passwd_file = "$SYSTEM_CONF_DIR/shadow";
$cache_file = "$SYSTEM_CONF_DIR/shadow" . ( Cpanel::PwCache::Helpers::skip_uid_cache() ? '.nouids' : '' ) . '.cache';
}
else {
$hpasswdmtime = 0;
}
if ( !Cpanel::PwCache::Helpers::istied() && exists $INC{'Cpanel/JSON.pm'} ) {
if ( open( my $cache_fh, '<:stdio', $cache_file ) ) {
my $cache_file_mtime = ( stat($cache_fh) )[9] || 0;
if ( $cache_file_mtime > $hpasswdmtime && $cache_file_mtime > $passwdmtime ) {
my $cache_ref = Cpanel::JSON::FailOK::LoadFile($cache_fh);
Cpanel::Debug::log_debug("[read pwcache from $cache_file]") if ( $Cpanel::Debug::level > 3 );
if ( _cache_ref_is_valid( $cache_ref, $passwdmtime, $hpasswdmtime ) ) {
Cpanel::Debug::log_debug("[validated pwcache from $cache_file]") if ( $Cpanel::Debug::level > 3 );
my $memory_pwcache_ref = Cpanel::PwCache::Cache::get_cache();
@{$cache_ref}{ keys %$memory_pwcache_ref } = values %$memory_pwcache_ref;
Cpanel::PwCache::Cache::replace($cache_ref);
$Cpanel::PwCache::Cache::pwcache_inited = ( $OPTS{'nopasswd'} ? 1 : 2 );
return;
}
}
}
}
if ($crypted_passwd_file) { $crypted_passwd_ref = _load_pws($crypted_passwd_file); }
$Cpanel::PwCache::Cache::pwcache_inited = ( $OPTS{'nopasswd'} ? 1 : 2 );
$pwcache_has_uid_cache = ( Cpanel::PwCache::Helpers::skip_uid_cache() ? 0 : 1 );
_write_tied_cache( $crypted_passwd_ref, $passwdmtime, $hpasswdmtime );
_write_json_cache($cache_file) if $> == 0;
return 1;
}
sub pwcache_is_initted {
return ( $Cpanel::PwCache::Cache::pwcache_inited ? $Cpanel::PwCache::Cache::pwcache_inited : 0 );
}
sub _load_pws {
my $lookup_file = shift;
if ( $INC{'B/C.pm'} ) {
Cpanel::PwCache::Helpers::confess("Cpanel::PwCache::Build::_load_pws cannot be run under B::C (see case 162857)");
}
my %PW;
if ( open my $lookup_fh, '<:stdio', $lookup_file ) {
my $data = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $lookup_fh, $data );
die "The file “$lookup_file” was unexpectedly empty" if !length $data;
%PW = map { ( split(/:/) )[ 0, 1 ] } split( /\n/, $data );
if ( index( $data, '#' ) > -1 ) {
delete @PW{ '', grep { index( $_, '#' ) == 0 } keys %PW };
}
else {
delete $PW{''};
}
close $lookup_fh;
}
return \%PW;
}
1;
} # --- END Cpanel/PwCache/Build.pm
{ # --- BEGIN Cpanel/PwCache.pm
package Cpanel::PwCache;
use strict;
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::NSCD::Check (); # perlpkg line 211
# use Cpanel::PwCache::Helpers (); # perlpkg line 211
# use Cpanel::PwCache::Cache (); # perlpkg line 211
# use Cpanel::PwCache::Find (); # perlpkg line 211
use constant DUMMY_PW_RETURNS => ( -1, -1, 0, 0 );
use constant DEBUG => 0; # Must set $ENV{'CPANEL_DEBUG_LEVEL'} = 5 as well
our $VERSION = '4.2';
my %FIXED_KEYS = (
'0:root' => 1,
'0:nobody' => 1,
'0:cpanel' => 1,
'0:cpanellogin' => 1,
'0:mail' => 1,
'2:0' => 1,
'2:99' => 1
);
our $_WANT_ENCRYPTED_PASSWORD;
sub getpwnam_noshadow {
$_WANT_ENCRYPTED_PASSWORD = 0;
goto &_getpwnam;
}
sub getpwuid_noshadow {
$_WANT_ENCRYPTED_PASSWORD = 0;
goto &_getpwuid;
}
sub getpwnam {
$_WANT_ENCRYPTED_PASSWORD = !!wantarray;
goto &_getpwnam;
}
sub getpwuid {
$_WANT_ENCRYPTED_PASSWORD = !!wantarray;
goto &_getpwuid;
}
sub gethomedir {
my $uid_or_name = $_[0] // $>;
my $hd = Cpanel::PwCache::Cache::get_homedir_cache();
unless ( exists $hd->{$uid_or_name} ) {
$_WANT_ENCRYPTED_PASSWORD = 0;
if ( $uid_or_name !~ tr{0-9}{}c ) {
$hd->{$uid_or_name} = ( _getpwuid($uid_or_name) )[7];
}
else {
$hd->{$uid_or_name} = ( _getpwnam($uid_or_name) )[7];
}
}
return $hd->{$uid_or_name};
}
sub getusername {
my $uid = defined $_[0] ? $_[0] : $>;
$_WANT_ENCRYPTED_PASSWORD = 0;
return scalar _getpwuid($uid);
}
sub init_passwdless_pwcache {
require Cpanel::PwCache::Build;
*init_passwdless_pwcache = \&Cpanel::PwCache::Build::init_passwdless_pwcache;
goto &Cpanel::PwCache::Build::init_passwdless_pwcache;
}
sub _getpwuid { ## no critic qw(Subroutines::RequireArgUnpacking)
return unless ( length( $_[0] ) && $_[0] !~ tr/0-9//c );
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
if ( !exists $pwcache_ref->{"2:$_[0]"} && $> != 0 && !Cpanel::PwCache::Helpers::istied() && Cpanel::NSCD::Check::nscd_is_running() ) {
return CORE::getpwuid( $_[0] ) if !wantarray;
my @ret = CORE::getpwuid( $_[0] );
return @ret ? ( @ret, DUMMY_PW_RETURNS() ) : ();
}
if ( my $pwref = _pwfunc( $_[0], 2 ) ) {
return wantarray ? @$pwref : $pwref->[0];
}
return; #important not to return 0
}
sub _getpwnam { ## no critic qw(Subroutines::RequireArgUnpacking)
return unless ( length( $_[0] ) && $_[0] !~ tr{\x{00}-\x{20}\x{7f}:/#}{} );
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
if ( !exists $pwcache_ref->{"0:$_[0]"} && $> != 0 && !Cpanel::PwCache::Helpers::istied() && Cpanel::NSCD::Check::nscd_is_running() ) {
return CORE::getpwnam( $_[0] ) if !wantarray;
my @ret = CORE::getpwnam( $_[0] );
return @ret ? ( @ret, DUMMY_PW_RETURNS() ) : ();
}
if ( my $pwref = _pwfunc( $_[0], 0 ) ) {
return wantarray ? @$pwref : $pwref->[2];
}
return; #important not to return 0
}
sub _pwfunc { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $value, $field, $pwkey ) = ( $_[0], ( $_[1] || 0 ), $_[1] . ':' . ( $_[0] || 0 ) );
if ( Cpanel::PwCache::Helpers::istied() ) {
Cpanel::Debug::log_debug("cache tie (tied) value[$value] field[$field]") if (DEBUG);
my $pwcachetie = Cpanel::PwCache::Helpers::tiedto();
if ( ref $pwcachetie eq 'HASH' ) {
my $cache = $pwcachetie->{$pwkey};
if ( ref $cache eq 'HASH' ) {
return $pwcachetie->{$pwkey}->{'contents'};
}
}
return undef;
}
my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir();
my $lookup_encrypted_pass = 0;
if ($_WANT_ENCRYPTED_PASSWORD) {
$lookup_encrypted_pass = $> == 0 ? 1 : 0;
}
my ( $passwdmtime, $hpasswdmtime );
my $pwcache_ref = Cpanel::PwCache::Cache::get_cache();
if ( my $cache_entry = $pwcache_ref->{$pwkey} ) {
Cpanel::Debug::log_debug("exists in cache value[$value] field[$field]") if (DEBUG);
if (
( exists( $cache_entry->{'contents'} ) && $cache_entry->{'contents'}->[1] ne 'x' ) # Has shadow entry
|| !$lookup_encrypted_pass # Or we do not need it
) { # If we are root and missing the password field we could fail authentication
if ( $FIXED_KEYS{$pwkey} ) { # We assume root, nobody, and cpanellogin will never change during execution
Cpanel::Debug::log_debug("cache (never change) hit value[$value] field[$field]") if (DEBUG);
return $cache_entry->{'contents'};
}
$passwdmtime = ( stat("$SYSTEM_CONF_DIR/passwd") )[9];
$hpasswdmtime = $lookup_encrypted_pass ? ( stat("$SYSTEM_CONF_DIR/shadow") )[9] : 0;
if ( ( $lookup_encrypted_pass && $hpasswdmtime && $hpasswdmtime != $cache_entry->{'hcachetime'} )
|| ( $passwdmtime && $passwdmtime != $cache_entry->{'cachetime'} ) ) { #timewarp safe
DEBUG && Cpanel::Debug::log_debug( "cache miss value[$value] field[$field] pwkey[$pwkey] " . qq{hpasswdmtime: $hpasswdmtime != $cache_entry->{hcachetime} } . qq{passwdmtime: $passwdmtime != $cache_entry->{cachetime} } );
if ( defined $cache_entry && defined $cache_entry->{'contents'} ) {
Cpanel::PwCache::Cache::clear(); #If the passwd file mtime changes everything is invalid
}
}
else {
Cpanel::Debug::log_debug("cache hit value[$value] field[$field]") if (DEBUG);
return $cache_entry->{'contents'};
}
}
elsif (DEBUG) {
Cpanel::Debug::log_debug( "cache miss pwkey[$pwkey] value[$value] field[$field] passwdmtime[$passwdmtime] pwcacheistied[" . Cpanel::PwCache::Helpers::istied() . "] hpasswdmtime[$hpasswdmtime]" );
}
}
elsif (DEBUG) {
Cpanel::Debug::log_debug( "cache miss (no entry) pwkey[$pwkey] value[$value] field[$field] pwcacheistied[" . Cpanel::PwCache::Helpers::istied() . "]" );
}
my $pwdata = _getpwdata( $value, $field, $passwdmtime, $hpasswdmtime, $lookup_encrypted_pass );
_cache_pwdata( $pwdata, $pwcache_ref ) if $pwdata && @$pwdata;
return $pwdata;
}
sub _getpwdata {
my ( $value, $field, $passwdmtime, $shadowmtime, $lookup_encrypted_pass ) = @_;
return if ( !defined $value || !defined $field || $value =~ tr/\0// );
if ($lookup_encrypted_pass) {
return [ _readshadow( $value, $field, $passwdmtime, $shadowmtime ) ];
}
return [ _readpasswd( $value, $field, $passwdmtime, $shadowmtime ) ];
}
sub _readshadow { ## no critic qw(Subroutines::RequireArgUnpacking)
my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir();
my ( $value, $field, $passwdmtime, $shadowmtime ) = ( $_[0], ( $_[1] || 0 ), ( $_[2] || ( stat("$SYSTEM_CONF_DIR/passwd") )[9] ), ( $_[3] || ( stat("$SYSTEM_CONF_DIR/shadow") )[9] ) );
my @PW = _readpasswd( $value, $field, $passwdmtime, $shadowmtime );
return if !@PW;
$value = $PW[0];
if ( open my $shadow_fh, '<', "$SYSTEM_CONF_DIR/shadow" ) {
if ( my @SH = Cpanel::PwCache::Find::field_with_value_in_pw_file( $shadow_fh, 0, $value ) ) {
( $PW[1], $PW[9], $PW[10], $PW[11], $PW[12] ) = (
$SH[1], #encrypted pass
$SH[5], #expire time
$SH[2], #change time
$passwdmtime,
$shadowmtime
);
close $shadow_fh;
Cpanel::PwCache::Cache::is_safe(0);
return @PW;
}
}
else {
Cpanel::PwCache::Helpers::cluck("Unable to open $SYSTEM_CONF_DIR/shadow: $!");
}
Cpanel::PwCache::Helpers::cluck("Entry for $value missing in $SYSTEM_CONF_DIR/shadow");
return @PW;
}
sub _readpasswd { ## no critic qw(Subroutines::RequireArgUnpacking)
my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir();
my ( $value, $field, $passwdmtime, $shadowmtime, $block ) = ( $_[0], ( $_[1] || 0 ), ( $_[2] || ( stat("$SYSTEM_CONF_DIR/passwd") )[9] ), $_[3] );
if ( $INC{'B/C.pm'} ) {
die("Cpanel::PwCache::_readpasswd cannot be run under B::C (see case 162857)");
}
if ( open( my $passwd_fh, '<', "$SYSTEM_CONF_DIR/passwd" ) ) {
if ( my @PW = Cpanel::PwCache::Find::field_with_value_in_pw_file( $passwd_fh, $field, $value ) ) {
return ( $PW[0], $PW[1], $PW[2], $PW[3], '', '', $PW[4], $PW[5], $PW[6], -1, -1, $passwdmtime, ( $shadowmtime || $passwdmtime ) );
}
close($passwd_fh);
}
else {
Cpanel::PwCache::Helpers::cluck("open($SYSTEM_CONF_DIR/passwd): $!");
}
return;
}
sub _cache_pwdata {
my ( $pwdata, $pwcache_ref ) = @_;
$pwcache_ref ||= Cpanel::PwCache::Cache::get_cache();
if ( $pwdata->[2] != 0 || $pwdata->[0] eq 'root' ) { # special case for multiple uid 0 users
@{ $pwcache_ref->{ '2' . ':' . $pwdata->[2] } }{ 'cachetime', 'hcachetime', 'contents' } = ( $pwdata->[11], $pwdata->[12], $pwdata );
}
@{ $pwcache_ref->{ '0' . ':' . $pwdata->[0] } }{ 'cachetime', 'hcachetime', 'contents' } = ( $pwdata->[11], $pwdata->[12], $pwdata );
return 1;
}
1;
} # --- END Cpanel/PwCache.pm
{ # --- BEGIN Cpanel/SafeDir/MK.pm
package Cpanel::SafeDir::MK;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Debug (); # perlpkg line 211
my $DEFAULT_PERMISSIONS = 0755;
sub safemkdir_or_die {
my ( $dir, $mode, $created ) = @_;
my $ok = safemkdir( $dir, $mode, $created );
if ( !$ok ) {
my $error = $!;
require Cpanel::Exception;
die Cpanel::Exception::create(
'IO::DirectoryCreateError',
[
path => $dir,
error => $error,
]
);
}
return $ok;
}
sub safemkdir { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix
my ( $dir, $mode, $errors, $created ) = @_;
if ( defined $mode ) {
if ( $mode eq '' ) {
$mode = undef;
}
elsif ( index( $mode, '0' ) == 0 ) {
if ( length $mode < 3 || $mode =~ tr{0-7}{}c || !defined oct $mode ) {
$mode = $DEFAULT_PERMISSIONS;
}
else {
$mode = oct($mode);
}
}
elsif ( $mode =~ tr{0-9}{}c ) {
$mode = $DEFAULT_PERMISSIONS;
}
}
$dir =~ tr{/}{}s;
my $default = '';
if ( index( $dir, '/' ) == 0 ) {
$default = '/';
}
elsif ( $dir eq '.' || $dir eq './' ) {
if ( !-l $dir && defined $mode ) {
return chmod $mode, $dir;
}
return 1;
}
else {
substr( $dir, 0, 2, '' ) if index( $dir, './' ) == 0;
}
if ( _has_dot_dot($dir) ) {
Cpanel::Debug::log_warn("Possible improper directory $dir specified");
my @dir_parts = split m{/}, $dir;
my @good_parts;
my $first;
foreach my $part (@dir_parts) {
next if ( !defined $part || $part eq '' );
next if $part eq '.';
if ( $part eq '..' ) {
if ( !$first || !@good_parts ) {
Cpanel::Debug::log_warn("Will not proceed above first directory part $first");
return 0;
}
if ( $first eq $good_parts[$#good_parts] ) {
undef $first;
}
pop @good_parts;
next;
}
elsif ( $part !~ tr{.}{}c ) {
Cpanel::Debug::log_warn("Total stupidity found in directory $dir");
return 0;
}
push @good_parts, $part;
if ( !$first ) { $first = $part }
}
$dir = $default . join '/', @good_parts;
if ( !$dir ) {
Cpanel::Debug::log_warn("Could not validate given directory");
return;
}
Cpanel::Debug::log_warn("Improper directory updated to $dir");
}
if ( -d $dir ) {
if ( !-l $dir && defined $mode ) {
return chmod $mode, $dir;
}
return 1;
}
elsif ( -e _ ) {
Cpanel::Debug::log_warn("$dir was expected to be a directory!");
require Errno;
$! = Errno::ENOTDIR(); ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- for legacy reasons
return 0;
}
my @dir_parts = split m{/}, $dir;
if ( scalar @dir_parts > 100 ) {
Cpanel::Debug::log_warn("Encountered excessive directory length. This should never happen.");
return 0;
}
my $returnvalue;
foreach my $i ( 0 .. $#dir_parts ) {
my $newdir = join( '/', @dir_parts[ 0 .. $i ] );
next if $newdir eq '';
my $is_dir = -d $newdir;
my $exists = -e _;
if ( !$exists ) {
my $local_mode = defined $mode ? $mode : $DEFAULT_PERMISSIONS;
if ( mkdir( $newdir, $local_mode ) ) {
push @{$created}, $newdir if $created;
$returnvalue++;
}
else {
Cpanel::Debug::log_warn("mkdir $newdir failed: $!");
return;
}
}
elsif ( !$is_dir ) {
Cpanel::Debug::log_warn("Encountered non-directory $newdir in path of $dir: $!");
require Errno;
$! = Errno::ENOTDIR(); ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- for legacy reasons
last;
}
}
return $returnvalue;
}
sub _has_dot_dot { ## no critic qw(RequireArgUnpacking)
return 1 if $_[0] eq '..';
return 1 if -1 != index( $_[0], '/../' );
return 1 if 0 == index( $_[0], '../' );
return 1 if ( length( $_[0] ) - 3 ) == rindex( $_[0], '/..' );
return 0;
}
1;
} # --- END Cpanel/SafeDir/MK.pm
{ # --- BEGIN Cpanel/CachedCommand/Utils.pm
package Cpanel::CachedCommand::Utils;
# use Cpanel::SV (); # perlpkg line 211
my ( $cached_datastore_myuid, $cached_datastore_dir );
sub destroy {
my %OPTS = @_;
my $cache_file = _get_datastore_filename( $OPTS{'name'}, ( $OPTS{'args'} ? @{ $OPTS{'args'} } : () ) );
if ( -e $cache_file ) {
return unlink $cache_file;
}
else {
return 1;
}
return;
}
*get_datastore_filename = *_get_datastore_filename;
sub _get_datastore_filename {
my ( $bin, @args ) = @_;
my $file = join( '_', $bin, @args );
$file =~ tr{/}{_};
Cpanel::SV::untaint($file);
my $datastore_dir = _get_datastore_dir($file);
Cpanel::SV::untaint($datastore_dir);
return $datastore_dir . '/' . $file;
}
sub _get_datastore_dir {
my $file = shift;
my $myuid = $>;
if ( defined $cached_datastore_dir && length $cached_datastore_dir > 1 && defined $cached_datastore_myuid && $myuid == $cached_datastore_myuid ) {
my $homedir = Cpanel::PwCache::gethomedir();
$cached_datastore_dir = "$homedir/$ENV{'TEAM_USER'}/.cpanel/datastore" if $ENV{'TEAM_USER'} && $file =~ /^AVAILABLE_APPLICATIONS_CACHE/;
return $cached_datastore_dir;
}
require Cpanel::PwCache;
$cached_datastore_dir = Cpanel::SV::untaint( Cpanel::PwCache::gethomedir() );
$cached_datastore_dir .= "/$ENV{'TEAM_USER'}" if $ENV{'TEAM_USER'} && $file =~ /^AVAILABLE_APPLICATIONS_CACHE/;
if ( !-e $cached_datastore_dir . '/.cpanel/datastore' && $cached_datastore_dir ne '/' ) { # nobody's homedir is /
require Cpanel::SafeDir::MK;
Cpanel::SafeDir::MK::safemkdir( "$cached_datastore_dir/.cpanel/datastore", 0700 ) or warn "Failed to mkdir($cached_datastore_dir/.cpanel/datastore): $!";
}
$cached_datastore_myuid = $myuid;
$cached_datastore_dir .= '/.cpanel/datastore';
return $cached_datastore_dir;
}
sub invalidate_cache {
my $ds_file = get_datastore_filename(@_);
unlink $ds_file;
return $ds_file;
}
sub clearcache {
$cached_datastore_dir = undef;
$cached_datastore_myuid = undef;
return;
}
1;
} # --- END Cpanel/CachedCommand/Utils.pm
{ # --- BEGIN Cpanel/FindBin.pm
package Cpanel::FindBin;
use strict;
use warnings;
no warnings 'once';
use constant _ENOENT => 2;
our $VERSION = 1.2;
my %bin_cache;
my @default_path = qw( /usr/bin /usr/local/bin /bin /sbin /usr/sbin /usr/local/sbin );
sub findbin { ## no critic qw(Subroutines::RequireArgUnpacking)
my $binname = shift;
return if !$binname;
my @lookup_path = get_path(@_);
my $nocache = grep( /nocache/, @_ );
if ( !$nocache && exists $bin_cache{$binname} && $bin_cache{$binname} ne '' ) {
return $bin_cache{$binname};
}
foreach my $path (@lookup_path) {
next unless -d $path;
$path .= "/$binname";
if ( -e $path ) {
if ( -x _ ) {
$bin_cache{$binname} = $path unless $nocache;
return $path;
}
else {
warn "“$path” exists but is not executable; ignoring.\n";
}
}
elsif ( $! != _ENOENT() ) {
warn "stat($path): $!\n";
}
}
return;
}
sub get_path {
if ( !$_[0] ) {
return @default_path;
}
elsif ( scalar @_ > 1 ) {
my %opts;
%opts = @_ if ( scalar @_ % 2 == 0 );
if ( exists $opts{'path'} && ref $opts{'path'} eq 'ARRAY' ) {
return @{ $opts{'path'} };
}
else {
return @_;
}
}
elsif ( ref $_[0] eq 'ARRAY' ) {
return @{ $_[0] };
}
return @default_path;
}
1;
} # --- END Cpanel/FindBin.pm
{ # --- BEGIN Cpanel/CachedCommand/Valid.pm
package Cpanel::CachedCommand::Valid;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::StatCache (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
sub is_cache_valid { ## no critic qw(Subroutines::ProhibitExcessComplexity) -- needs to be refactored
my %OPTS = @_;
my ( $datastore_file, $datastore_file_mtime, $datastore_file_size, $binary, $ttl, $mtime, $min_expire_time, $now ) = ( ( $OPTS{'datastore_file'} || '' ), ( $OPTS{'datastore_file_mtime'} || 0 ), ( $OPTS{'datastore_file_size'} || 0 ), ( $OPTS{'binary'} || '' ), ( $OPTS{'ttl'} || 0 ), ( $OPTS{'mtime'} || 0 ), ( $OPTS{'min_expire_time'} || 0 ), ( $OPTS{'now'} || 0 ) );
if ( !$datastore_file_mtime && !-e $datastore_file ) {
print STDERR "is_cache_valid: rejecting $datastore_file because it does not exist.\n" if $Cpanel::Debug::level;
return 0;
}
if ( !$datastore_file_size || !$datastore_file_mtime ) {
( $datastore_file_size, $datastore_file_mtime ) = ( stat(_) )[ 7, 9 ];
}
if ( $datastore_file_mtime <= 0 ) {
print STDERR "is_cache_valid: rejecting $datastore_file as mtime is zero.\n" if $Cpanel::Debug::level;
return 0;
}
if ($binary) {
if ( substr( $binary, 0, 1 ) ne '/' ) {
require Cpanel::FindBin;
$binary = Cpanel::FindBin::findbin( $binary, split( /:/, $ENV{'PATH'} ) );
}
my ( $binary_mtime, $binary_ctime ) = Cpanel::StatCache::cachedmtime_ctime($binary);
if ( ( $binary_mtime && $binary_mtime > $datastore_file_mtime ) || ( $binary_ctime && $binary_ctime > $datastore_file_mtime ) ) {
if ($Cpanel::Debug::level) {
print STDERR "is_cache_valid: rejecting $datastore_file as binary ($binary) ctime or mtime is newer.\n";
print STDERR "is_cache_valid: datastore_file:$datastore_file mtime[$datastore_file_mtime]\n";
print STDERR "is_cache_valid: binary_file:$binary mtime[$binary_mtime] ctime[$binary_ctime]\n";
}
return 0;
}
}
$now ||= time();
if ( $datastore_file_mtime > $now ) {
print STDERR "is_cache_valid: rejecting $datastore_file as it is from the future (time warp safety).\n" if $Cpanel::Debug::level;
return 0;
}
elsif ( $min_expire_time && $datastore_file_mtime > ( $now - $min_expire_time ) ) {
print STDERR "is_cache_valid: accept $datastore_file (mtime=$datastore_file_mtime) as min_expire_time ($now - $min_expire_time) is older.\n" if $Cpanel::Debug::level;
return 1;
}
elsif ( $mtime > $datastore_file_mtime ) {
print STDERR "is_cache_valid: rejecting $datastore_file because mtime ($mtime) is newer then datastore mtime ($datastore_file_mtime).\n" if $Cpanel::Debug::level;
return 0;
}
elsif ( $ttl && ( $datastore_file_mtime + $ttl ) < $now ) {
print STDERR "is_cache_valid: rejecting $datastore_file as it has reached its time to live.\n" if $Cpanel::Debug::level;
return 0;
}
print STDERR "is_cache_valid: accepting $datastore_file as it passes all tests.\n" if $Cpanel::Debug::level;
return 1;
}
1;
} # --- END Cpanel/CachedCommand/Valid.pm
{ # --- BEGIN Cpanel/CachedCommand/Save.pm
package Cpanel::CachedCommand::Save;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::CachedCommand::Utils (); # perlpkg line 211
# use Cpanel::FileUtils::Write (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
use Try::Tiny;
sub _savefile {
my ( $filename, $content ) = @_;
return if !defined $content; #should be able to store 0
$filename =~ tr{/}{}s; # collapse //s to /
my @path = split( /\//, $filename );
my $file = pop(@path);
my $dir = join( '/', @path );
my $dir_uid = ( stat($dir) )[4];
if ( !defined $dir_uid ) {
Cpanel::Debug::log_warn("Unable to write datastore file: $filename: target directory: $dir does not exist.");
return;
}
elsif ( $dir_uid != $> ) {
Cpanel::Debug::log_warn("Unable to write datastore file: $filename: target directory: $dir does not match uid $>");
return;
}
local $!;
my $ret;
try {
$ret = Cpanel::FileUtils::Write::overwrite( $filename, ( ref $content ? $$content : $content ), 0600 );
}
catch {
my $err = $_;
Cpanel::Debug::log_warn( Cpanel::Exception::get_string($err) );
};
return $ret;
}
sub store {
my %OPTS = @_;
_savefile( Cpanel::CachedCommand::Utils::_get_datastore_filename( $OPTS{'name'} ), $OPTS{'data'} );
}
1;
} # --- END Cpanel/CachedCommand/Save.pm
{ # --- BEGIN Cpanel/LocaleString.pm
package Cpanel::LocaleString;
use strict;
use warnings;
no warnings 'once';
sub DESTROY { }
sub new {
if ( !length $_[1] ) {
die 'Must include at least a string!';
}
return bless \@_, shift;
}
sub set_json_to_freeze {
no warnings 'redefine';
*TO_JSON = \&_to_list_ref;
return ( __PACKAGE__ . '::_JSON_MODE' )->new();
}
sub thaw {
if ( ref( $_[1] ) ne 'ARRAY' ) {
die "Call thaw() on an ARRAY reference, not “$_[1]”!";
}
return $_[0]->new( @{ $_[1] }[ 1 .. $#{ $_[1] } ] );
}
sub is_frozen {
{
last if ref( $_[1] ) ne 'ARRAY';
last if !$_[1][0]->isa( $_[0] );
last if @{ $_[1] } < 2;
return 1;
}
return 0;
}
sub to_string {
return _locale()->makevar( @{ $_[0] } );
}
sub to_en_string {
return _locale()->makethis_base( @{ $_[0] } );
}
sub clone_with_args {
return ( ref $_[0] )->new(
$_[0][0], #the phrase, currently stored in the object
@_[ 1 .. $#_ ], #the new args, supplied by the caller
);
}
sub to_list {
if ( !wantarray ) {
require Cpanel::Context;
Cpanel::Context::must_be_list();
}
return @{ $_[0] };
}
*TO_JSON = \&to_string;
my $_locale;
sub _locale {
return $_locale if $_locale;
local $@;
eval 'require Cpanel::Locale;' or do { ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
warn "Failed to load Cpanel::Locale; falling back to substitute. Error was: $@";
};
eval { $_locale = Cpanel::Locale->get_handle() };
return $_locale || bless {}, 'Cpanel::LocaleString::_Cpanel_Locale_unavailable';
}
sub _put_back {
no warnings 'redefine';
*TO_JSON = \&to_string;
return;
}
sub _to_list_ref {
return [ ref( $_[0] ), @{ $_[0] } ];
}
package Cpanel::LocaleString::_JSON_MODE;
sub new {
require Cpanel::Finally; # PPI USE OK - loaded only when needed
return $_[0]->SUPER::new( \&Cpanel::LocaleString::_put_back );
}
package Cpanel::LocaleString::_Cpanel_Locale_unavailable;
BEGIN {
*Cpanel::LocaleString::_Cpanel_Locale_unavailable::makethis_base = *Cpanel::LocaleString::_Cpanel_Locale_unavailable::makevar;
}
sub makevar {
my ( $self, $str, @maketext_opts ) = @_;
local ( $@, $! );
require Cpanel::Locale::Utils::Fallback;
return Cpanel::Locale::Utils::Fallback::interpolate_variables( $str, @maketext_opts );
}
1;
} # --- END Cpanel/LocaleString.pm
{ # --- BEGIN Cpanel/Errno.pm
package Cpanel::Errno;
use strict;
my %_err_name_cache;
sub get_name_for_errno_number {
my ($number) = @_;
if ( !$INC{'Errno.pm'} ) {
local ( $@, $! );
require Errno;
}
die 'need number!' if !length $number;
if ( !%_err_name_cache ) {
my $s = scalar keys %Errno::; # init iterator
foreach my $k ( sort keys %Errno:: ) {
if ( Errno->EXISTS($k) ) {
my $v = 'Errno'->can($k)->();
$_err_name_cache{$v} = $k;
}
}
}
return $_err_name_cache{$number};
}
1;
} # --- END Cpanel/Errno.pm
{ # --- BEGIN Cpanel/Config/Constants/Perl.pm
package Cpanel::Config::Constants::Perl;
use strict;
our $ABRT = 6;
our $ALRM = 14;
our $BUS = 7;
our $CHLD = 17;
our $CLD = 17;
our $CONT = 18;
our $FPE = 8;
our $HUP = 1;
our $ILL = 4;
our $INT = 2;
our $IO = 29;
our $IOT = 6;
our $KILL = 9;
our $NUM32 = 32;
our $NUM33 = 33;
our $NUM35 = 35;
our $NUM36 = 36;
our $NUM37 = 37;
our $NUM38 = 38;
our $NUM39 = 39;
our $NUM40 = 40;
our $NUM41 = 41;
our $NUM42 = 42;
our $NUM43 = 43;
our $NUM44 = 44;
our $NUM45 = 45;
our $NUM46 = 46;
our $NUM47 = 47;
our $NUM48 = 48;
our $NUM49 = 49;
our $NUM50 = 50;
our $NUM51 = 51;
our $NUM52 = 52;
our $NUM53 = 53;
our $NUM54 = 54;
our $NUM55 = 55;
our $NUM56 = 56;
our $NUM57 = 57;
our $NUM58 = 58;
our $NUM59 = 59;
our $NUM60 = 60;
our $NUM61 = 61;
our $NUM62 = 62;
our $NUM63 = 63;
our $PIPE = 13;
our $POLL = 29;
our $PROF = 27;
our $PWR = 30;
our $QUIT = 3;
our $RTMAX = 64;
our $RTMIN = 34;
our $SEGV = 11;
our $STKFLT = 16;
our $STOP = 19;
our $SYS = 31;
our $TERM = 15;
our $TRAP = 5;
our $TSTP = 20;
our $TTIN = 21;
our $TTOU = 22;
our $UNUSED = 31;
our $URG = 23;
our $USR1 = 10;
our $USR2 = 12;
our $VTALRM = 26;
our $WINCH = 28;
our $XCPU = 24;
our $XFSZ = 25;
our $ZERO = 0;
our %SIGNAL_NAME = qw(
0 ZERO
1 HUP
10 USR1
11 SEGV
12 USR2
13 PIPE
14 ALRM
15 TERM
16 STKFLT
17 CHLD
18 CONT
19 STOP
2 INT
20 TSTP
21 TTIN
22 TTOU
23 URG
24 XCPU
25 XFSZ
26 VTALRM
27 PROF
28 WINCH
29 IO
3 QUIT
30 PWR
31 SYS
32 NUM32
33 NUM33
34 RTMIN
35 NUM35
36 NUM36
37 NUM37
38 NUM38
39 NUM39
4 ILL
40 NUM40
41 NUM41
42 NUM42
43 NUM43
44 NUM44
45 NUM45
46 NUM46
47 NUM47
48 NUM48
49 NUM49
5 TRAP
50 NUM50
51 NUM51
52 NUM52
53 NUM53
54 NUM54
55 NUM55
56 NUM56
57 NUM57
58 NUM58
59 NUM59
6 ABRT
60 NUM60
61 NUM61
62 NUM62
63 NUM63
64 RTMAX
7 BUS
8 FPE
9 KILL
);
1;
} # --- END Cpanel/Config/Constants/Perl.pm
{ # --- BEGIN Cpanel/ChildErrorStringifier.pm
package Cpanel::ChildErrorStringifier;
use strict;
# use Cpanel::LocaleString (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
sub new {
my ( $class, $CHILD_ERROR, $PROGRAM_NAME ) = @_;
return bless { _CHILD_ERROR => $CHILD_ERROR, _PROGRAM_NAME => $PROGRAM_NAME }, $class;
}
sub CHILD_ERROR {
my ($self) = @_;
return $self->{'_CHILD_ERROR'};
}
sub error_code {
my ($self) = @_;
return undef if !$self->CHILD_ERROR();
return $self->CHILD_ERROR() >> 8;
}
sub error_name {
my ($self) = @_;
my $error_number = $self->error_code();
return '' if ( !defined $error_number ); # Can't index a hash with undef
require Cpanel::Errno;
return Cpanel::Errno::get_name_for_errno_number($error_number) || q<>;
}
sub dumped_core {
my ($self) = @_;
return $self->CHILD_ERROR() && ( $self->CHILD_ERROR() & 128 ) ? 1 : 0;
}
sub signal_code {
my ($self) = @_;
return if !$self->CHILD_ERROR();
return $self->CHILD_ERROR() & 127;
}
sub signal_name {
my ($self) = @_;
require Cpanel::Config::Constants::Perl;
return $Cpanel::Config::Constants::Perl::SIGNAL_NAME{ $self->signal_code() };
}
sub exec_failed {
return $_[0]->{'_exec_failed'} ? 1 : 0;
}
sub program {
my ($self) = @_;
return $self->{'_PROGRAM_NAME'} || undef;
}
sub set_program {
my ( $self, $program ) = @_;
return ( $self->{'_PROGRAM_NAME'} = $program );
}
sub autopsy {
my ($self) = @_;
return undef if !$self->CHILD_ERROR();
my @localized_strings = (
$self->error_code() ? $self->_ERROR_PHRASE() : $self->_SIGNAL_PHRASE(),
$self->_core_dump_for_phrase_if_needed(),
$self->_additional_phrases_for_autopsy(),
);
return join ' ', map { $_->to_string() } @localized_strings;
}
sub terse_autopsy {
my ($self) = @_;
my $str;
if ( $self->signal_code() ) {
$str .= 'SIG' . $self->signal_name() . " (#" . $self->signal_code() . ")";
}
elsif ( my $code = $self->error_code() ) {
$str .= "exit $code";
}
else {
$str = 'OK';
}
if ( $self->dumped_core() ) {
$str .= ' (+core)';
}
return $str;
}
sub die_if_error {
my ($self) = @_;
my $err = $self->to_exception();
die $err if $err;
return $self;
}
sub to_exception {
my ($self) = @_;
if ( $self->signal_code() ) {
return Cpanel::Exception::create(
'ProcessFailed::Signal',
[
process_name => $self->program(),
signal_code => $self->signal_code(),
$self->_extra_error_args_for_die_if_error(),
],
);
}
if ( $self->error_code() ) {
return Cpanel::Exception::create(
'ProcessFailed::Error',
[
process_name => $self->program(),
error_code => $self->error_code(),
$self->_extra_error_args_for_die_if_error(),
],
);
}
return undef;
}
sub _extra_error_args_for_die_if_error { }
sub _additional_phrases_for_autopsy { }
sub _core_dump_for_phrase_if_needed {
my ($self) = @_;
if ( $self->dumped_core() ) {
return Cpanel::LocaleString->new('The process dumped a core file.');
}
return;
}
sub _ERROR_PHRASE {
my ($self) = @_;
if ( $self->program() ) {
return Cpanel::LocaleString->new( 'The subprocess “[_1]” reported error number [numf,_2] when it ended.', $self->program(), $self->error_code() );
}
return Cpanel::LocaleString->new( 'The subprocess reported error number [numf,_1] when it ended.', $self->error_code() );
}
sub _SIGNAL_PHRASE {
my ($self) = @_;
if ( $self->program() ) {
return Cpanel::LocaleString->new( 'The subprocess “[_1]” ended prematurely because it received the “[_2]” ([_3]) signal.', $self->program(), $self->signal_name(), $self->signal_code() );
}
return Cpanel::LocaleString->new( 'The subprocess ended prematurely because it received the “[_1]” ([_2]) signal.', $self->signal_name(), $self->signal_code() );
}
1;
} # --- END Cpanel/ChildErrorStringifier.pm
{ # --- BEGIN Cpanel/Env.pm
package Cpanel::Env;
use strict;
use warnings;
no warnings 'once';
our $VERSION = '1.7';
my $SAFE_ENV_VARS;
BEGIN {
$SAFE_ENV_VARS = q<
ALLUSERSPROFILE
APPDATA
BUNDLE_PATH
CLIENTNAME
COMMONPROGRAMFILES
COMPUTERNAME
COMSPEC
CPANEL_BASE_INSTALL
CPANEL_IS_CRON
CPANEL_RPM_LOCKED_IN_PARENT
CPBACKUP
DEBIAN_FRONTEND
DEBIAN_PRIORITY
DOCUMENT_ROOT
FORCEDCPUPDATE
FP_NO_HOST_CHECK
HOMEDRIVE
HOMEPATH
LANG
LANGUAGE
LC_ALL
LC_MESSAGES
LC_CTYPE
LOGONSERVER
NEWWHMUPDATE
NOTIFY_SOCKET
NUMBER_OF_PROCESSORS
OPENSSL_NO_DEFAULT_ZLIB
OS
PATH
PATHEXT
PROCESSOR_ARCHITECTURE
PROCESSOR_IDENTIFIER
PROCESSOR_LEVEL
PROCESSOR_REVISION
PROGRAMFILES
PROMPT
PYTHONIOENCODING
SERVER_SOFTWARE
SESSIONNAME
SKIP_DEFERRAL_CHECK
SSH_CLIENT
SYSTEMDRIVE
SYSTEMROOT
TEMP
TERM
TMP
UPDATENOW_NO_RETRY
UPDATENOW_PRESERVE_FAILED_FILES
USERDOMAIN
USERNAME
USERPROFILE
WINDIR
>;
$SAFE_ENV_VARS =~ tr<\n >< >s;
$SAFE_ENV_VARS =~ s<\A\s+><>;
}
{
no warnings 'once';
*cleanenv = *clean_env;
}
sub clean_env {
my %OPTS = @_;
my %SAFE_ENV_VARS = map { $_ => undef } split( m{ }, $SAFE_ENV_VARS );
if ( defined $OPTS{'keep'} && ref $OPTS{'keep'} eq 'ARRAY' ) {
@SAFE_ENV_VARS{ @{ $OPTS{'keep'} } } = undef;
}
if ( defined $OPTS{'delete'} && ref $OPTS{'delete'} eq 'ARRAY' ) {
delete @SAFE_ENV_VARS{ @{ $OPTS{'delete'} } };
}
delete @ENV{ grep { !exists $SAFE_ENV_VARS{$_} } keys %ENV };
if ( $OPTS{'http_purge'} ) {
delete @ENV{ 'SERVER_SOFTWARE', 'DOCUMENT_ROOT' };
}
return;
}
sub get_safe_env_vars {
return $SAFE_ENV_VARS;
}
sub get_safe_path {
return '/usr/local/jdk/bin:/usr/kerberos/sbin:/usr/kerberos/bin:/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/X11R6/bin:/usr/local/bin:/usr/X11R6/bin:/root/bin:/opt/bin';
}
sub set_safe_path {
return ( $ENV{'PATH'} = get_safe_path() );
}
1;
} # --- END Cpanel/Env.pm
{ # --- BEGIN Cpanel/FHUtils/Autoflush.pm
package Cpanel::FHUtils::Autoflush;
use strict;
use warnings;
no warnings 'once';
sub enable {
select( ( select( $_[0] ), $| = 1 )[0] ); ## no critic qw(InputOutput::ProhibitOneArgSelect Variables::RequireLocalizedPunctuationVars) - aka $socket->autoflush(1) without importing IO::Socket
return;
}
1;
} # --- END Cpanel/FHUtils/Autoflush.pm
{ # --- BEGIN Cpanel/FHUtils/OS.pm
package Cpanel::FHUtils::OS;
use strict;
use warnings;
no warnings 'once';
my $fileno;
sub is_os_filehandle {
local $@;
$fileno = eval { fileno $_[0] };
return ( defined $fileno ) && ( $fileno != -1 );
}
1;
} # --- END Cpanel/FHUtils/OS.pm
{ # --- BEGIN Cpanel/FHUtils/Blocking.pm
package Cpanel::FHUtils::Blocking;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Fcntl::Constants (); # perlpkg line 211
# use Cpanel::Autodie qw(fcntl); # perlpkg line 248
INIT { Cpanel::Autodie->import(qw{fcntl}); }
sub set_non_blocking {
return Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_SETFL, _get_fl_flags( $_[0] ) | $Cpanel::Fcntl::Constants::O_NONBLOCK ) && 1;
}
sub set_blocking {
return Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_SETFL, _get_fl_flags( $_[0] ) & ~$Cpanel::Fcntl::Constants::O_NONBLOCK ) && 1;
}
sub is_set_to_block {
return !( _get_fl_flags( $_[0] ) & $Cpanel::Fcntl::Constants::O_NONBLOCK ) ? 1 : 0;
}
sub _get_fl_flags {
return int Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_GETFL, 0 );
}
1;
} # --- END Cpanel/FHUtils/Blocking.pm
{ # --- BEGIN Cpanel/IO/Flush.pm
package Cpanel::IO::Flush;
use strict;
use warnings;
no warnings 'once';
use constant {
_EAGAIN => 11,
_EINTR => 4,
};
# use Cpanel::Exception (); # perlpkg line 211
use IO::SigGuard ();
sub write_all { ##no critic qw( RequireArgUnpacking )
my ( $fh, $timeout ) = @_; # $_[2] = payload
local ( $!, $^E );
my $offset = 0;
{
my $this_time = IO::SigGuard::syswrite( $fh, $_[2], length( $_[2] ), $offset );
if ($this_time) {
$offset += $this_time;
}
elsif ( $! == _EAGAIN() ) {
_wait_until_ready( $fh, $timeout );
}
else {
die Cpanel::Exception::create( 'IO::WriteError', [ error => $!, length => length( $_[2] ) - $offset ] );
}
redo if $offset < length( $_[2] );
}
return;
}
sub _wait_until_ready {
my ( $fh, $timeout ) = @_;
my $win;
vec( $win, fileno($fh), 1 ) = 1;
my $ready = select( undef, my $wout = $win, undef, $timeout );
if ( $ready == -1 ) {
redo if $! == _EINTR();
die Cpanel::Exception::create( 'IO::SelectError', [ error => $! ] );
}
elsif ( !$ready ) {
die Cpanel::Exception::create_raw( 'Timeout', 'write timeout!' );
}
return;
}
1;
} # --- END Cpanel/IO/Flush.pm
{ # --- BEGIN Cpanel/ReadMultipleFH.pm
package Cpanel::ReadMultipleFH;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::FHUtils::Blocking (); # perlpkg line 211
# use Cpanel::FHUtils::OS (); # perlpkg line 211
# use Cpanel::IO::Flush (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
my $CHUNK_SIZE = 2 << 16;
my $DEFAULT_TIMEOUT = 600; #10 minutes
my $DEFAULT_READ_TIMEOUT = 0;
sub new { ## no critic qw(Subroutines::ProhibitExcessComplexity)
my ( $class, %opts ) = @_;
my %fh_buffer;
my %output;
my @fhs = @{ $opts{'filehandles'} };
my $read_input = '';
my $read_output = '';
my %fhmap;
my %is_os_filehandle;
for my $fh_buf_ar (@fhs) {
if ( UNIVERSAL::isa( $fh_buf_ar, 'GLOB' ) ) {
$fh_buf_ar = [$fh_buf_ar];
}
elsif ( !UNIVERSAL::isa( $fh_buf_ar, 'ARRAY' ) ) {
die 'items in “filehandles” must be either a filehandle or ARRAY';
}
my $fh = $fh_buf_ar->[0];
Cpanel::FHUtils::Blocking::set_non_blocking($fh);
$fhmap{ fileno($fh) } = $fh;
vec( $read_input, fileno($fh), 1 ) = 1;
if ( defined $fh_buf_ar->[1] && UNIVERSAL::isa( $fh_buf_ar->[1], 'SCALAR' ) ) {
$fh_buffer{$fh} = $fh_buf_ar->[1];
}
else {
my $buf = q{};
$fh_buffer{$fh} = \$buf;
if ( defined $fh_buf_ar->[1] && UNIVERSAL::isa( $fh_buf_ar->[1], 'GLOB' ) ) {
$output{$fh} = $fh_buf_ar->[1];
$is_os_filehandle{$fh} = Cpanel::FHUtils::OS::is_os_filehandle( $fh_buf_ar->[1] );
}
elsif ( defined $fh_buf_ar->[1] ) {
die '2nd value in “filehandles” array member must be undef, SCALAR, or GLOB!';
}
}
}
my $finished;
my $self = {
_fh_buffer => \%fh_buffer,
_finished => 0,
};
bless $self, $class;
my ( $nfound, $select_time_left, $select_timeout );
my $overall_timeout = defined $opts{'timeout'} ? $opts{'timeout'} : $DEFAULT_TIMEOUT;
my $read_timeout = defined $opts{'read_timeout'} ? $opts{'read_timeout'} : $DEFAULT_READ_TIMEOUT;
my $has_overall_timeout = $overall_timeout ? 1 : 0;
my $overall_time_left = $overall_timeout || undef;
READ_LOOP:
while (
!$finished && # has not finished
( !$has_overall_timeout || $overall_time_left > 0 ) # has not reached overall timeout
) {
$select_timeout = _get_shortest_timeout( $overall_time_left, $read_timeout );
( $nfound, $select_time_left ) = select( $read_output = $read_input, undef, undef, $select_timeout );
if ( !$nfound ) {
$self->{'_timed_out'} = ( $select_timeout == $read_timeout ) ? $read_timeout : $overall_timeout;
last;
}
elsif ( $nfound != -1 ) { # case 47309: If we get -1 it probably means we got interrupted by a signal
for my $fileno ( grep { vec( $read_output, $_, 1 ) } keys %fhmap ) {
my $fh = $fhmap{$fileno};
Cpanel::LoadFile::ReadFast::read_fast( $fh, ${ $fh_buffer{$fh} }, $CHUNK_SIZE, length ${ $fh_buffer{$fh} } ) or do {
delete $fhmap{$fileno};
$finished = !( scalar keys %fhmap );
last READ_LOOP if $finished;
vec( $read_input, $fileno, 1 ) = 0;
next;
};
if ( $output{$fh} ) {
my $payload_sr = \substr( ${ $fh_buffer{$fh} }, 0, length ${ $fh_buffer{$fh} }, q<> );
if ( $is_os_filehandle{$fh} ) {
Cpanel::IO::Flush::write_all( $output{$fh}, $read_timeout, $$payload_sr );
}
else {
print { $output{$fh} } $$payload_sr;
}
}
}
}
$overall_time_left -= ( $select_timeout - $select_time_left ) if $has_overall_timeout;
}
delete $fh_buffer{$_} for keys %output;
%fhmap = ();
$self->{'_finished'} = $finished;
if ( !$finished && defined $overall_time_left && $overall_time_left <= 0 ) {
$self->{'_timed_out'} = $overall_timeout;
}
return $self;
}
sub _get_shortest_timeout {
my ( $overall_time_left, $read_timeout ) = @_;
return undef if ( !$overall_time_left && !$read_timeout );
return $read_timeout if !defined $overall_time_left;
return ( !$read_timeout || $overall_time_left <= $read_timeout )
?
$overall_time_left
:
$read_timeout;
}
sub get_buffer {
return $_[0]->{'_fh_buffer'}{ $_[1] };
}
sub did_finish {
return $_[0]->{'_finished'} ? 1 : 0;
}
sub timed_out {
return defined $_[0]->{'_timed_out'} ? $_[0]->{'_timed_out'} : 0;
}
1;
} # --- END Cpanel/ReadMultipleFH.pm
{ # --- BEGIN Cpanel/ForkAsync.pm
package Cpanel::ForkAsync;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
my $DEFAULT_ERROR_CODE = 127; #EKEYEXPIRED
our $quiet = 0;
our $no_warn = 0;
sub do_in_child {
my ( $code, @args ) = @_;
local ( $!, $^E );
my $pid = fork();
die Cpanel::Exception::create( 'IO::ForkError', [ error => $! ] ) if !defined $pid;
if ( !$pid ) {
local $@;
if ( !eval { $code->(@args); 1 } ) {
my $err = $@;
my $io_err = 0 + $!;
_print($err) unless $quiet;
exit( $io_err || $DEFAULT_ERROR_CODE );
}
exit 0;
}
return $pid;
}
sub do_in_child_quiet {
my ( $code, @args ) = @_;
local $quiet = 1;
return do_in_child( $code, @args );
}
sub _print {
my ($msg) = @_;
warn $msg unless $no_warn;
print STDERR $msg;
return;
}
1;
} # --- END Cpanel/ForkAsync.pm
{ # --- BEGIN Cpanel/SafeRun/Object.pm
package Cpanel::SafeRun::Object;
use cPstrict;
no warnings 'once';
# use parent Cpanel::ChildErrorStringifier (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::ChildErrorStringifier); }
BEGIN {
eval { require Proc::FastSpawn; };
}
use IO::SigGuard ();
# use Cpanel::Env (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::FHUtils::Autoflush (); # perlpkg line 211
# use Cpanel::FHUtils::OS (); # perlpkg line 211
# use Cpanel::ReadMultipleFH (); # perlpkg line 211
# use Cpanel::LoadModule (); # perlpkg line 211
# use Cpanel::LocaleString (); # perlpkg line 211
use constant _ENOENT => 2;
my $CHUNK_SIZE = 2 << 16;
my $DEFAULT_TIMEOUT = 3600; # 1 hour
my $DEFAULT_READ_TIMEOUT = 0;
our $SAFEKILL_TIMEOUT = 1;
my @_allowed_env_vars_cache;
sub new { ## no critic qw(Subroutines::ProhibitExcessComplexity)
my ( $class, %OPTS ) = @_;
die "No “program”!" if !length $OPTS{'program'};
if ( !defined $OPTS{'timeout'} ) {
$OPTS{'timeout'} = $DEFAULT_TIMEOUT;
}
if ( !defined $OPTS{'read_timeout'} ) {
$OPTS{'read_timeout'} = $DEFAULT_READ_TIMEOUT;
}
if ( $OPTS{'program'} =~ tr{><*?[]`$()|;&#$\\\r\n\t }{} && !-e $OPTS{'program'} ) {
die Cpanel::Exception::create( 'InvalidParameter', 'A value of “[_1]” is invalid for “[_2]” as it does not permit the following characters: “[_3]”', [ $OPTS{'program'}, 'program', '><*?[]`$()|;&#$\\\\\r\\n\\t' ] );
}
my $args_ar = $OPTS{'args'} || [];
die "“args” must be an arrayref" if defined $args_ar && ref $args_ar ne 'ARRAY';
die Cpanel::Exception::create( 'InvalidParameter', 'The “[_1]” argument is invalid.', ['logger'] ) if $OPTS{'logger'};
die "Undefined value given as argument! (@$args_ar)" if grep { !defined } @$args_ar;
my $pump_stdin_filehandle_into_child;
my ( %parent_read_fh, %child_write_fh );
my $merge_output_yn = $OPTS{'stdout'} && $OPTS{'stderr'} && ( $OPTS{'stdout'} eq $OPTS{'stderr'} );
local $!;
for my $handle_name (qw(stdout stderr)) {
my $custom_fh = $OPTS{$handle_name} && UNIVERSAL::isa( $OPTS{$handle_name}, 'GLOB' ) && $OPTS{$handle_name};
my $dupe_filehandle_will_work = $custom_fh && !tied(*$custom_fh) && ( fileno($custom_fh) > -1 );
if ( !$custom_fh && $OPTS{$handle_name} ) {
die "“$handle_name” must be a filehandle or undef, not $OPTS{$handle_name}";
}
if ($dupe_filehandle_will_work) {
if ( fileno($custom_fh) < 3 ) {
open my $copy, '>&', $custom_fh or die "dup($handle_name): $!";
$child_write_fh{$handle_name} = $copy;
}
else {
$child_write_fh{$handle_name} = $custom_fh;
}
}
elsif ( $merge_output_yn && $handle_name eq 'stderr' ) {
$parent_read_fh{'stderr'} = $parent_read_fh{'stdout'};
$child_write_fh{'stderr'} = $child_write_fh{'stdout'};
}
else {
pipe $parent_read_fh{$handle_name}, $child_write_fh{$handle_name} #
or die "pipe() failed: $!";
}
}
my ( $child_reads, $parent_writes );
my $close_child_reads = 0;
if ( !defined $OPTS{'stdin'} || !length $OPTS{'stdin'} ) {
open $child_reads, '<', '/dev/null' or die "open(<, /dev/null) failed: $!";
$close_child_reads = 1;
}
elsif ( UNIVERSAL::isa( $OPTS{'stdin'}, 'GLOB' ) ) {
my $fileno = fileno $OPTS{'stdin'};
if ( !defined $fileno || $fileno == -1 ) {
$pump_stdin_filehandle_into_child = 1;
}
else {
$child_reads = $OPTS{'stdin'};
}
}
if ( !$child_reads ) {
$close_child_reads = 1;
pipe( $child_reads, $parent_writes ) or die "pipe() failed: $!";
}
my $self = bless {
_program => $OPTS{'program'},
_args => $OPTS{'args'} || [],
}, $class;
local $SIG{'CHLD'} = 'DEFAULT';
my $exec_failed_message = "exec($OPTS{'program'}) failed:";
my $used_fastspawn = 0;
if (
$INC{'Proc/FastSpawn.pm'} # may not be available yet due to upcp.static or updatenow.static
&& !$OPTS{'before_exec'}
&& !$Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED # PPI NO PARSE - We not ever be set if its not loaded
) {
$used_fastspawn = 1;
my @env;
if ( !$OPTS{'keep_env'} ) {
if ( !@_allowed_env_vars_cache ) {
@_allowed_env_vars_cache = ( split( m{ }, Cpanel::Env::get_safe_env_vars() ) );
}
@env = map { exists $ENV{$_} ? ( $_ . '=' . ( $ENV{$_} // '' ) ) : () } @_allowed_env_vars_cache;
}
my $user = $OPTS{'user'};
my $homedir = $OPTS{'homedir'};
if ( !$user || !$homedir ) {
my ( $pw_user, $pw_homedir ) = ( getpwuid $> )[ 0, 7 ];
$user ||= $pw_user;
$homedir ||= $pw_homedir;
}
die "Invalid EUID: $>" if !$user || !$homedir;
push @env, "HOME=$homedir", "USER=$user"; # need to always be set since we start clean and don't have before_exec
push @env, "TMP=$homedir/tmp", "TEMP=$homedir/tmp" if !defined $ENV{'TMP'};
$self->{'_child_pid'} = Proc::FastSpawn::spawn_open3(
fileno($child_reads), # stdin
defined $child_write_fh{'stdout'} ? fileno( $child_write_fh{'stdout'} ) : -1, # stdout
defined $child_write_fh{'stderr'} ? fileno( $child_write_fh{'stderr'} ) : -1, # stderr
$OPTS{'program'}, # program
[ $OPTS{'program'}, @$args_ar ], # args
$OPTS{'keep_env'} ? () : \@env # env
);
if ( !$self->{_child_pid} ) {
$self->{'_CHILD_ERROR'} = $! << 8;
$self->{'_exec_failed'} = 1;
${ $self->{'_stdout'} } = '';
${ $self->{'_stderr'} } .= "$exec_failed_message $!";
}
}
else {
require Cpanel::ForkAsync;
$self->{'_child_pid'} = Cpanel::ForkAsync::do_in_child(
sub {
$SIG{'__DIE__'} = 'DEFAULT'; ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- will never be unset
if ( $parent_read_fh{'stdout'} ) {
close $parent_read_fh{'stdout'} or die "child close parent stdout failed: $!";
}
if ( $parent_read_fh{'stderr'} && !$merge_output_yn ) {
close $parent_read_fh{'stderr'} or die "child close parent stderr failed: $!";
}
if ($parent_writes) {
close $parent_writes or die "close() failed: $!";
}
open( *STDIN, '<&=' . fileno $child_reads ) or die "open(STDIN) failed: $!"; ##no critic qw(ProhibitTwoArgOpen)
my $fileno_stdout = fileno \*STDOUT;
if ( $fileno_stdout != fileno( $child_write_fh{'stdout'} ) ) {
if ( $fileno_stdout != 1 ) {
close *STDOUT or die "close(STDOUT) failed: $!";
open( *STDOUT, '>>&=1' ) or die "open(STDOUT, '>>&=1') failed: $!"; ##no critic qw(ProhibitTwoArgOpen)
}
open( *STDOUT, '>>&=' . fileno $child_write_fh{'stdout'} ) or die "open(STDOUT) failed: $!"; ##no critic qw(ProhibitTwoArgOpen)
}
my $fileno_stderr = fileno \*STDERR;
if ( $fileno_stderr != fileno( $child_write_fh{'stderr'} ) ) {
if ( $fileno_stderr != 2 ) {
close *STDERR or die "close(STDOUT) failed: $!";
open( *STDERR, '>>&=2' ) or die "open(STDERR, '>>&=2') failed: $!"; ##no critic qw(ProhibitTwoArgOpen)
}
open( *STDERR, '>>&=' . fileno $child_write_fh{'stderr'} ) or die "open(STDERR) failed: $!"; ##no critic qw(ProhibitTwoArgOpen)
}
if ( !$OPTS{'keep_env'} ) {
Cpanel::Env::clean_env();
}
if ($Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED) { # PPI NO PARSE -- can't be reduced if the module isn't loaded
my $target_euid = "$>";
my $target_egid = ( split( m{ }, "$)" ) )[0];
Cpanel::AccessIds::ReducedPrivileges::_restore_privileges( 0, 0 ); # PPI NO PARSE -- we will never get here if ReducedPrivileges wasn't loaded
Cpanel::LoadModule::load_perl_module('Cpanel::Sys::Setsid::Fast') if !$INC{'Cpanel/Sys/Setsid/Fast.pm'};
Cpanel::Sys::Setsid::Fast::fast_setsid();
Cpanel::LoadModule::load_perl_module('Cpanel::AccessIds::SetUids') if !$INC{'Cpanel/AccessIds/SetUids.pm'};
Cpanel::AccessIds::SetUids::setuids( $target_euid, $target_egid );
}
if ( $OPTS{'before_exec'} ) {
$OPTS{'before_exec'}->();
}
my $user = $OPTS{'user'};
my $homedir = $OPTS{'homedir'};
if ( !$user || !$homedir ) {
Cpanel::LoadModule::load_perl_module('Cpanel::PwCache') if !$INC{'Cpanel/PwCache.pm'};
my ( $pw_user, $pw_homedir ) = ( Cpanel::PwCache::getpwuid_noshadow($>) )[ 0, 7 ];
$user ||= $pw_user;
$homedir ||= $pw_homedir;
}
die "Invalid EUID: $>" if !$user || !$homedir;
$ENV{'HOME'} = $homedir if !defined $ENV{'HOME'}; # always cleared by clean_env, but may be reset in before_exec
$ENV{'USER'} = $user if !defined $ENV{'USER'}; # always cleared by clean_env, but may be reset in before_exec
$ENV{'TMP'} = "$homedir/tmp" if !defined $ENV{'TMP'};
$ENV{'TEMP'} = "$homedir/tmp" if !defined $ENV{'TEMP'};
exec( $OPTS{'program'}, @$args_ar ) or die "$exec_failed_message $!";
}
);
}
if ( $OPTS{'after_fork'} ) {
$OPTS{'after_fork'}->( $self->{'_child_pid'} );
}
if ($close_child_reads) { #only close it if we opened it
close $child_reads or die "close() failed: $!";
}
if ( $parent_read_fh{'stdout'} ) {
close $child_write_fh{'stdout'} or die "close() failed: $!";
}
if ( !$merge_output_yn && $parent_read_fh{'stderr'} ) {
close $child_write_fh{'stderr'} or die "close() failed: $!";
}
if ($parent_writes) {
if ( ref $OPTS{'stdin'} eq 'CODE' ) {
$OPTS{'stdin'}->($parent_writes);
}
else {
local $SIG{'PIPE'} = 'IGNORE';
Cpanel::FHUtils::Autoflush::enable($parent_writes);
if ($pump_stdin_filehandle_into_child) {
my $buffer;
my $is_os_stdin = Cpanel::FHUtils::OS::is_os_filehandle( $OPTS{'stdin'} );
local $!;
if ($is_os_stdin) {
while ( IO::SigGuard::sysread( $OPTS{'stdin'}, $buffer, $CHUNK_SIZE ) ) {
$self->_write_buffer_to_fh( $buffer, $parent_writes );
}
}
else {
while ( read $OPTS{'stdin'}, $buffer, $CHUNK_SIZE ) {
$self->_write_buffer_to_fh( $buffer, $parent_writes );
}
}
if ($!) {
die Cpanel::Exception::create( 'IO::ReadError', 'The system failed to read up to [format_bytes,_1] from the filehandle that contains standard input for the process that is running the command “[_2]”. This failure happened because of an error: [_3]', [ $CHUNK_SIZE, "$OPTS{'program'} @$args_ar", "$!" ] );
}
}
else {
my $to_print_r = ( ref $OPTS{'stdin'} eq 'SCALAR' ) ? $OPTS{'stdin'} : \$OPTS{'stdin'};
if ( length $$to_print_r ) {
$self->_write_buffer_to_fh( $$to_print_r, $parent_writes );
}
}
}
close $parent_writes or warn "close() failed: $!";
}
my $reader;
my $err_obj;
my @filehandles = map { $parent_read_fh{$_} ? [ $parent_read_fh{$_}, $OPTS{$_} ] : () } qw( stdout stderr );
if (@filehandles) {
local $@;
eval {
$reader = Cpanel::ReadMultipleFH->new(
filehandles => \@filehandles,
timeout => $OPTS{'timeout'},
read_timeout => $OPTS{'read_timeout'},
);
};
$err_obj = $@;
}
if ( $parent_read_fh{'stdout'} ) {
close $parent_read_fh{'stdout'} or warn "parent close(stdout) failed: $!";
}
if ( $parent_read_fh{'stderr'} && !$merge_output_yn ) {
close $parent_read_fh{'stderr'} or warn "parent close(stderr) failed: $!";
}
if ($err_obj) {
$self->{'_CHILD_ERROR'} = $self->_safe_kill_child();
die $err_obj;
}
elsif ($reader) {
if ( !$reader->did_finish() ) {
$self->{'_timed_out_after'} = $reader->timed_out();
$self->{'_CHILD_ERROR'} = $self->_safe_kill_child();
}
$self->{"_stdout"} = $parent_read_fh{stdout} && $reader->get_buffer( $parent_read_fh{stdout} );
if ( !$self->{"_stderr"} ) {
$self->{"_stderr"} = $parent_read_fh{stderr} && $reader->get_buffer( $parent_read_fh{stderr} );
}
}
if ( !defined $self->{'_CHILD_ERROR'} ) {
local $?;
waitpid( $self->{'_child_pid'}, 0 ) if defined $self->{'_child_pid'};
$self->{'_CHILD_ERROR'} = $?;
if ( $self->{'_CHILD_ERROR'} ) {
$self->{'_exec_failed'} = 1;
}
}
if ( $used_fastspawn && $self->{'_CHILD_ERROR'} == 32512 ) {
$self->{'_CHILD_ERROR'} = _ENOENT() << 8;
$self->{'_exec_failed'} = 1;
${ $self->{'_stderr'} } .= "$exec_failed_message $!";
}
elsif ( !$used_fastspawn && $self->{'_stderr'} && $self->{'_CHILD_ERROR'} && ( $self->{'_CHILD_ERROR'} >> 8 ) == 2 && index( ${ $self->{'_stderr'} }, $exec_failed_message ) > -1 ) {
$self->{'_exec_failed'} = 1;
}
return $self;
}
sub _write_buffer_to_fh ( $self, $buffer, $fh ) {
while ( length $buffer ) {
my $wrote = IO::SigGuard::syswrite( $fh, $buffer ) or die $self->_write_error( \$buffer, $! );
substr( $buffer, 0, $wrote, q<> );
}
return;
}
sub new_or_die {
my ( $class, @args ) = @_;
return $class->new(@args)->die_if_error();
}
sub to_exception {
my ($self) = @_;
if ( $self->timed_out() ) {
return Cpanel::Exception::create(
'ProcessFailed::Timeout',
[
process_name => $self->program(),
( $self->child_pid() ? ( pid => $self->child_pid() ) : () ),
timeout => $self->timed_out(),
$self->_extra_error_args_for_die_if_error(),
],
);
}
return $self->SUPER::to_exception();
}
sub _extra_error_args_for_die_if_error {
my ($self) = @_;
return (
stdout => $self->{'_stdout'} ? $self->stdout() : '',
stderr => $self->{'_stderr'} ? $self->stderr() : '',
);
}
sub _safe_kill_child {
my ($self) = @_;
Cpanel::LoadModule::load_perl_module('Cpanel::Kill::Single');
return 'Cpanel::Kill::Single'->can('safekill_single_pid')->( $self->{'_child_pid'}, $SAFEKILL_TIMEOUT ); # One second to die
}
sub stdout_r {
if ( !$_[0]->{'_stdout'} ) {
Cpanel::LoadModule::load_perl_module('Cpanel::Carp');
die 'Cpanel::Carp'->can('safe_longmess')->("STDOUT output went to filehandle!");
}
return $_[0]->{'_stdout'};
}
sub _additional_phrases_for_autopsy {
if ( $_[0]->timed_out() ) {
return Cpanel::LocaleString->new( 'The system aborted the subprocess because it reached the timeout of [quant,_1,second,seconds].', $_[0]->timed_out() );
}
return;
}
sub stdout {
return ${ $_[0]->stdout_r() };
}
sub stderr_r {
if ( !$_[0]->{'_stderr'} ) {
Cpanel::LoadModule::load_perl_module('Cpanel::Carp');
die 'Cpanel::Carp'->can('safe_longmess')->("STDERR output went to filehandle!");
}
return $_[0]->{'_stderr'};
}
sub stderr {
return ${ $_[0]->stderr_r() };
}
sub child_pid {
return $_[0]->{'_child_pid'};
}
sub timed_out {
return $_[0]->{'_timed_out_after'};
}
sub program {
return $_[0]->{'_program'};
}
sub _program_with_args_str {
my $args_ar = $_[0]->{'_args'};
return $_[0]->{'_program'} . ( ( $args_ar && ref $args_ar && scalar @$args_ar ) ? " @$args_ar" : '' );
}
sub _ERROR_PHRASE {
my ($self) = @_;
return Cpanel::LocaleString->new( 'The “[_1]” command (process [_2]) reported error number [_3] when it ended.', $self->_program_with_args_str(), $self->{'_child_pid'}, $self->error_code() );
}
sub _SIGNAL_PHRASE {
my ($self) = @_;
return Cpanel::LocaleString->new( 'The “[_1]” command (process [_2]) ended prematurely because it received the “[_3]” ([_4]) signal.', $self->_program_with_args_str(), $self->{'_child_pid'}, $self->signal_name(), $self->signal_code() );
}
sub _write_error {
my ( $self, $buffer_sr, $OS_ERROR ) = @_;
my @cmd = ( $self->{'_program'}, @{ $self->{'_args'} } );
return Cpanel::Exception::create( 'IO::WriteError', 'The system failed to send [format_bytes,_1] to the process that is running the command “[_2]” because of an error: [_3]', [ length($$buffer_sr), "@cmd", $OS_ERROR ], { length => length($$buffer_sr), error => $OS_ERROR } );
}
1;
} # --- END Cpanel/SafeRun/Object.pm
{ # --- BEGIN Cpanel/SafeRun/Env.pm
package Cpanel::SafeRun::Env;
use strict;
# use Cpanel::Env (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
our $VERSION = '1.0';
sub saferun_r_cleanenv {
return saferun_cleanenv2( { 'command' => \@_, 'return_ref' => 1, 'cleanenv' => { 'http_purge' => 1 } } );
}
sub saferun_cleanenv2 {
my $args_hr = shift;
return unless ( defined $args_hr->{'command'} && ref $args_hr->{'command'} eq 'ARRAY' );
if ($Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED) { # PPI NO PARSE -- can't be reduced if the module isn't loaded
die __PACKAGE__ . " cannot be used with ReducedPrivileges. Use Cpanel::SafeRun::Object instead";
}
my @command = @{ $args_hr->{'command'} };
my $return_reference = $args_hr->{'return_ref'};
my $error_output = $args_hr->{'errors'};
my %cleanenv_args = defined $args_hr->{'cleanenv'} && ref $args_hr->{'cleanenv'} eq 'HASH' ? %{ $args_hr->{'cleanenv'} } : ();
my $check_cpanel_homedir_user = defined $args_hr->{'check_cpanel_homedir_user'} ? $args_hr->{'check_cpanel_homedir_user'} : 1;
return if ( substr( $command[0], 0, 1 ) eq '/' && !-x $command[0] );
my $output;
if ( !@command ) {
Cpanel::Debug::log_warn('Cannot execute a null program');
return \$output if $return_reference;
return $output;
}
require Cpanel::Env;
local ( $/, *PROG, *RNULL );
no strict 'refs';
open( RNULL, '<', '/dev/null' ); ## no critic(InputOutput::ProhibitBarewordFileHandles InputOutput::RequireCheckedOpen)
my $pid = open( PROG, "-|" ); ## no critic(InputOutput::ProhibitBarewordFileHandles)
if ( $pid > 0 ) {
$output = <PROG>;
}
elsif ( $pid == 0 ) {
open( STDIN, '<&RNULL' );
if ($error_output) {
open STDERR, '>&STDOUT';
}
Cpanel::Env::clean_env(%cleanenv_args);
if ( $check_cpanel_homedir_user && ( !$Cpanel::homedir || !$Cpanel::user ) ) {
( $ENV{'USER'}, $ENV{'HOME'} ) = ( getpwuid($>) )[ 0, 7 ]; #do not use PwCache here
}
exec(@command) or exit(1); # Not reached
}
else {
Cpanel::Debug::log_warn('Could not fork new process');
return \$output if $return_reference;
return $output;
}
close(PROG);
close(RNULL);
waitpid( $pid, 0 );
return \$output if $return_reference;
return $output;
}
1;
} # --- END Cpanel/SafeRun/Env.pm
{ # --- BEGIN Cpanel/CachedCommand.pm
package Cpanel::CachedCommand;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::StatCache (); # perlpkg line 211
# use Cpanel::LoadFile (); # perlpkg line 211
# use Cpanel::CachedCommand::Utils (); # perlpkg line 211
# use Cpanel::CachedCommand::Valid (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
our $VERSION = '2.8';
my %MEMORY_CACHE;
sub _is_memory_cache_valid {
my %OPTS = @_;
my $datastore_file = $OPTS{'datastore_file'};
if ( !exists $MEMORY_CACHE{$datastore_file} ) {
print STDERR "_is_memory_cache_valid: rejecting $datastore_file because it does not exist in memory.\n" if $Cpanel::Debug::level;
return 0;
}
my $ttl = $OPTS{'ttl'};
my $mtime = $OPTS{'mtime'};
if ( !$ttl && $mtime && $MEMORY_CACHE{$datastore_file}->{'mtime'} == $mtime ) {
print STDERR "_is_memory_cache_valid: accepting $datastore_file because it passes the mtime test.\n" if $Cpanel::Debug::level;
return 1;
}
else {
my $now = time();
if ( $ttl && $MEMORY_CACHE{$datastore_file}->{'mtime'} > ( $now - $ttl ) ) {
print STDERR "_is_memory_cache_valid: accepting $datastore_file because it passes the ttl test.\n" if $Cpanel::Debug::level;
return 1;
}
}
print STDERR "_is_memory_cache_valid: rejecting $datastore_file because it not pass the ttl or mtime test.\n" if $Cpanel::Debug::level;
delete $MEMORY_CACHE{$datastore_file};
return 0;
}
sub invalidate_cache {
my $ds_file = Cpanel::CachedCommand::Utils::invalidate_cache(@_);
delete $MEMORY_CACHE{$ds_file};
return;
}
sub _cached_cmd {
my %OPTS = @_;
my ( $binary, $ttl, $mtime, $exact, $regexcheck, $args_hr, $min_expire_time, $get_result_cr ) = (
( $OPTS{'binary'} || '' ),
( $OPTS{'ttl'} || 0 ),
( $OPTS{'mtime'} || 0 ),
( $OPTS{'exact'} || 0 ),
( $OPTS{'regexcheck'} || '' ),
( $OPTS{'args_hr'} || {} ),
( $OPTS{'min_expire_time'} || 0 ),
( $OPTS{'get_result_cr'} || \&_default_get_result_cr ),
);
my @AG;
if ( ref $OPTS{'args'} eq 'ARRAY' ) {
@AG = @{ $OPTS{'args'} };
}
if ( substr( $binary, 0, 1 ) eq '/' && !-x $binary ) {
return "$binary is missing or not executable";
}
my @SAFEAG = @AG;
if ( !$exact && scalar @SAFEAG > 4 ) {
splice( @SAFEAG, 4 );
}
my $datastore_file = Cpanel::CachedCommand::Utils::_get_datastore_filename( $binary, @SAFEAG );
if (
_is_memory_cache_valid(
'binary' => $binary,
'datastore_file' => $datastore_file,
'ttl' => $ttl,
'mtime' => $mtime
)
) {
return $MEMORY_CACHE{$datastore_file}->{'contents'};
}
my ( $datastore_file_size, $datastore_file_mtime ) = ( stat($datastore_file) )[ 7, 9 ];
my $data_mtime;
my ( $used_cache, $res );
if (
Cpanel::CachedCommand::Valid::is_cache_valid(
'binary' => $binary,
'datastore_file' => $datastore_file,
'datastore_file_mtime' => $datastore_file_mtime,
'ttl' => $ttl,
'mtime' => $mtime,
'min_expire_time' => $min_expire_time,
)
) {
$res = Cpanel::LoadFile::loadfile_r( $datastore_file, { 'skip_exists_check' => 1 } );
$data_mtime = $datastore_file_mtime;
if ( $res && ( !$regexcheck || $$res =~ m/$regexcheck/ ) ) {
$used_cache = 1;
}
}
if ( !$used_cache ) {
$data_mtime = _time();
$res = $get_result_cr->( { binary => $binary, args => \@AG } );
if ( !$regexcheck || ( defined $res && ( ref $res ? $$res : $res ) =~ m/$regexcheck/ ) ) {
print STDERR "_cached_command: writing datastore file: $datastore_file " . ( $regexcheck ? "regex_check: $regexcheck" : '' ) . "\n" if $Cpanel::Debug::level;
require Cpanel::CachedCommand::Save;
Cpanel::CachedCommand::Save::_savefile( $datastore_file, $res );
}
else {
print STDERR "_cached_command: failed regex check NOT writing datastore file: $datastore_file " . ( $regexcheck ? "regex_check: $regexcheck" : '' ) . "\n" if $Cpanel::Debug::level;
}
}
return _cache_res_if_needed( $res, $ttl, $datastore_file, $data_mtime );
}
sub _cache_res_if_needed {
my ( $res, $ttl, $datastore_file, $data_mtime ) = @_;
if ( ref $res ) {
if ( $ttl && ( !defined $$res || length($$res) < 32768 ) ) { $MEMORY_CACHE{$datastore_file} = { 'mtime' => $data_mtime, 'contents' => $res }; }
return $res;
}
else {
if ( $ttl && ( !defined $res || length($res) < 32768 ) ) { $MEMORY_CACHE{$datastore_file} = { 'mtime' => $data_mtime, 'contents' => \$res }; }
return \$res;
}
}
sub _default_get_result_cr {
my ($opts) = @_;
return _get_cmd_output( 'program' => $opts->{binary}, 'args' => $opts->{args}, 'stderr' => \*STDERR );
}
sub _get_memory_cache {
return \%MEMORY_CACHE;
}
sub _time {
return time();
}
sub _get_cmd_output {
my (@key_val) = @_;
return eval {
require Cpanel::SafeRun::Object;
my $run = Cpanel::SafeRun::Object->new(@key_val);
$run->stdout();
};
}
sub has_cache {
my ( $ttl, $bin, @AG ) = @_;
my @SAFEAG = @AG;
if ( scalar @SAFEAG > 3 ) {
splice( @SAFEAG, 3 );
}
my $datastore_file = Cpanel::CachedCommand::Utils::_get_datastore_filename( $bin, @SAFEAG );
return (
Cpanel::CachedCommand::Valid::is_cache_valid(
'datastore_file' => $datastore_file,
'binary' => $bin,
'ttl' => $ttl
)
) ? 1 : 0;
}
sub cachedcommand {
my ( $binary, @ARGS ) = @_;
my $cache_ref = _cached_cmd(
'binary' => $binary,
'regexcheck' => qr/./, # only cache data that actually exists
'args' => \@ARGS
);
if ( ref $cache_ref eq 'SCALAR' ) { return $$cache_ref; }
return $cache_ref;
}
sub cachedcommand_no_errors {
my (%OPTS) = @_;
return _cached_cmd(
binary => $OPTS{'binary'},
args => $OPTS{'args'},
( defined $OPTS{'mtime'} ? ( mtime => $OPTS{'mtime'} ) : () ),
( defined $OPTS{'ttl'} ? ( ttl => $OPTS{'ttl'} ) : () ),
get_result_cr => sub {
my ($opts) = @_;
return _get_cmd_output( 'program' => $opts->{binary}, 'args' => $opts->{args}, ( $OPTS{ttl} ? ( 'timeout' => $OPTS{ttl}, 'read_timeout' => $OPTS{ttl} ) : () ) );
}
);
}
sub cachedcommand_multifile {
my ( $test_file_ar, $binary, @ARGS ) = @_;
my ( $mtime, $ctime ) = Cpanel::StatCache::cachedmtime_ctime($binary);
if ( $ctime > $mtime ) {
$mtime = $ctime;
}
foreach my $file (@$test_file_ar) {
my @test_times = Cpanel::StatCache::cachedmtime_ctime($file);
foreach my $new_time (@test_times) {
if ( $new_time > $mtime ) {
$mtime = $new_time;
}
}
}
my $cache_ref = _cached_cmd(
'binary' => $binary,
'args' => \@ARGS,
'mtime' => $mtime
);
if ( ref $cache_ref eq 'SCALAR' ) { return $$cache_ref; }
return $cache_ref;
}
sub cachedmcommand {
my ( $ttl, $binary, @ARGS ) = @_;
my $cache_ref = _cached_cmd(
'ttl' => $ttl,
'binary' => $binary,
'args' => \@ARGS
);
if ( ref $cache_ref eq 'SCALAR' ) { return $$cache_ref; }
return $cache_ref;
}
sub cachedmcommand_r_cleanenv {
my ( $ttl, $binary, @ARGS ) = @_;
my $cache_ref = _cached_cmd(
'ttl' => $ttl,
'binary' => $binary,
'args' => \@ARGS,
'get_result_cr' => sub {
my ($opts) = @_;
require Cpanel::SafeRun::Env;
return Cpanel::SafeRun::Env::saferun_r_cleanenv( $opts->{binary}, @{ $opts->{args} } );
},
);
if ( ref $cache_ref ne 'SCALAR' ) { return \$cache_ref; }
return $cache_ref;
}
sub cachedmcommand_cleanenv2 {
my ( $ttl, $args_hr ) = @_;
my @cmd = @{ $args_hr->{'command'} };
my $binary = shift @cmd;
my @ARGS = @cmd;
my $cache_ref = _cached_cmd(
'ttl' => $ttl,
'binary' => $binary,
'args' => \@ARGS,
'get_result_cr' => sub {
require Cpanel::SafeRun::Env;
return Cpanel::SafeRun::Env::saferun_cleanenv2($args_hr);
},
);
return $cache_ref;
}
sub cachedmcommand_r {
my ( $ttl, $binary, @ARGS ) = @_;
my $cache_ref = _cached_cmd(
'ttl' => $ttl,
'binary' => $binary,
'args' => \@ARGS
);
if ( ref $cache_ref ne 'SCALAR' ) { return \$cache_ref; }
return $cache_ref;
}
sub cachedmcommand2 {
my $arg_ref = shift;
my $bin = $arg_ref->{'bin'};
my $ttl = $arg_ref->{'age'};
my $timer = $arg_ref->{'timer'};
my $exact = $arg_ref->{'exact'};
my $regexcheck = $arg_ref->{'regexcheck'};
my @AG = @{ $arg_ref->{'ARGS'} };
my $cache_ref = _cached_cmd(
'binary' => $bin,
'ttl' => $ttl,
'exact' => $exact,
'regexcheck' => $regexcheck,
'args' => \@AG,
'get_result_cr' => sub {
my ($opts) = @_;
return _get_cmd_output( 'program' => $opts->{binary}, 'args' => $opts->{'args'}, 'stderr' => \*STDERR, ( int($timer) > 0 ? ( 'timeout' => $timer, 'read_timeout' => $timer ) : () ) );
},
);
if ( ref $cache_ref eq 'SCALAR' ) { return $$cache_ref; }
return $cache_ref;
}
sub noncachedcommand {
my ( $bin, @AG ) = @_;
if ( substr( $bin, 0, 1 ) eq '/' && !-x $bin ) {
return "$bin is missing or not executable";
}
my $datastore_file = Cpanel::CachedCommand::Utils::_get_datastore_filename( $bin, $AG[0] );
if ( -e $datastore_file ) {
unlink $datastore_file;
}
return _get_cmd_output( 'program' => $bin, 'args' => \@AG );
}
sub retrieve {
my %OPTS = @_;
return Cpanel::LoadFile::loadfile( Cpanel::CachedCommand::Utils::_get_datastore_filename( $OPTS{'name'} ) );
}
sub clear_memory_cache {
%MEMORY_CACHE = ();
}
1;
} # --- END Cpanel/CachedCommand.pm
{ # --- BEGIN Cpanel/GlobalCache.pm
package Cpanel::GlobalCache;
use strict;
# use Cpanel::JSON::FailOK (); # perlpkg line 211
my $GCACHEref = {};
our $PRODUCT_CONF_DIR = '/var/cpanel';
sub get_cache_mtime {
my ($cachename) = @_;
if ( !exists $GCACHEref->{$cachename} ) { load_cache($cachename); }
return $GCACHEref->{$cachename}{'mtime'};
}
sub load_cache {
my ($cachename) = @_;
if ( open( my $cache_fh, '<', "$PRODUCT_CONF_DIR/globalcache/$cachename.cache" ) ) {
$GCACHEref->{$cachename} ||= {};
my $cache_ref = $GCACHEref->{$cachename};
require Cpanel::JSON;
$cache_ref->{'data'} = Cpanel::JSON::FailOK::LoadFile($cache_fh);
if ( ref $cache_ref->{'data'} eq 'HASH' ) {
$cache_ref->{'mtime'} = ( stat($cache_fh) )[9];
}
else {
$cache_ref->{'data'} = {};
}
close($cache_fh);
}
return;
}
sub cachedmcommand { ## no critic(RequireArgUnpacking)
my $cachename = shift;
require Cpanel::CachedCommand;
if ( !exists $GCACHEref->{$cachename} ) { load_cache($cachename); }
my $cache_max_mtime = shift;
my $key = join( '_', @_ );
return (
( exists $GCACHEref->{$cachename}{'data'}{'command'}{$key} && ( $cache_max_mtime + $GCACHEref->{$cachename}{'mtime'} ) > time() )
? $GCACHEref->{$cachename}{'data'}{'command'}{$key}
: 'Cpanel::CachedCommand'->can('cachedmcommand')->( $cache_max_mtime, @_ )
);
}
sub cachedcommand { ## no critic(RequireArgUnpacking)
my $cachename = shift;
require Cpanel::CachedCommand;
require Cpanel::StatCache;
if ( !exists $GCACHEref->{$cachename} ) { load_cache($cachename); }
my ( $file_mtime, $file_ctime ) = 'Cpanel::StatCache'->can('cachedmtime_ctime')->( $_[0] );
my $key = join( '_', @_ );
return (
( exists $GCACHEref->{$cachename}{'data'}{'command'}{$key} && $GCACHEref->{$cachename}{'mtime'} > $file_mtime && $GCACHEref->{$cachename}{'mtime'} > $file_ctime )
? $GCACHEref->{$cachename}{'data'}{'command'}{$key}
: 'Cpanel::CachedCommand'->can('cachedcommand')->(@_)
);
}
sub loadfile {
my $cachename = shift;
if ( !exists $GCACHEref->{$cachename} ) { load_cache($cachename); }
my $file = shift;
my $file_mtime = shift;
unless ( defined $file_mtime ) {
$file_mtime = ( stat($file) )[9] || 0;
}
require Cpanel::LoadFile;
return (
( exists $GCACHEref->{$cachename}{'data'}{'file'}{$file} && $GCACHEref->{$cachename}{'mtime'} > $file_mtime )
? $GCACHEref->{$cachename}{'data'}{'file'}{$file}
: 'Cpanel::LoadFile'->can('loadfile')->($file)
);
}
sub data {
my $cachename = shift;
if ( !exists $GCACHEref->{$cachename} ) { load_cache($cachename); }
my $data = shift;
my $test_mtime = shift || 0;
return ( ( exists $GCACHEref->{$cachename}{'data'}{'data'}{$data} && $GCACHEref->{$cachename}{'mtime'} > $test_mtime ) ? $GCACHEref->{$cachename}{'data'}{'data'}{$data} : undef );
}
sub clearcache {
$GCACHEref = {};
return;
}
sub default_product_dir {
$PRODUCT_CONF_DIR = shift if @_;
return $PRODUCT_CONF_DIR;
}
1;
} # --- END Cpanel/GlobalCache.pm
{ # --- BEGIN Cpanel/IP/NonlocalBind/Cache.pm
package Cpanel::IP::NonlocalBind::Cache;
use strict;
use warnings;
no warnings 'once';
use constant {
DISABLED => '', # 0-bytes
ENABLED => 1, # 1-byte
UNKNOWN => 22, # 2-bytes
_ENOENT => 2,
};
our $CACHE_FILE = '/var/cpanel/ipv4_ip_nonlocal_bind';
our $_ipv4_ip_nonlocal_bind_cache_length;
sub ipv4_ip_nonlocal_bind_is_enabled {
if ( !defined $_ipv4_ip_nonlocal_bind_cache_length ) {
$_ipv4_ip_nonlocal_bind_cache_length = ( stat($CACHE_FILE) )[7];
if ( !defined $_ipv4_ip_nonlocal_bind_cache_length ) {
if ( $! != _ENOENT() ) {
warn "stat($CACHE_FILE): $!";
}
}
}
if ( defined $_ipv4_ip_nonlocal_bind_cache_length ) {
return 1 if $_ipv4_ip_nonlocal_bind_cache_length == length ENABLED();
return 0 if $_ipv4_ip_nonlocal_bind_cache_length == length DISABLED();
if ( $_ipv4_ip_nonlocal_bind_cache_length != length UNKNOWN() ) {
warn "“$CACHE_FILE” has unrecognized length: $_ipv4_ip_nonlocal_bind_cache_length";
}
}
return undef;
}
1;
} # --- END Cpanel/IP/NonlocalBind/Cache.pm
{ # --- BEGIN Cpanel/FileUtils/TouchFile.pm
package Cpanel::FileUtils::TouchFile;
use strict;
use warnings;
no warnings 'once';
use constant {
_ENOENT => 2,
};
my $logger;
our $VERSION = '1.3';
sub _log {
my ( $level, $msg ) = @_;
require Cpanel::Logger;
$logger ||= Cpanel::Logger->new();
$logger->$level($msg);
return;
}
my $mtime;
sub touchfile {
my ( $file, $verbose, $fail_ok ) = @_;
if ( !defined $file ) {
_log( 'warn', "touchfile called with undefined file" );
return;
}
my $mtime;
if ( utime undef, undef, $file ) {
return 1;
}
elsif ( $! != _ENOENT() ) {
_log( 'warn', "utime($file) as $>: $!" );
$mtime = -e $file ? ( stat _ )[9] : 0; # for warnings-safe numeric comparison
if ( !$mtime && $! != _ENOENT ) {
_log( 'warn', "Failed to stat($file) as $>: $!" );
return;
}
}
$mtime = ( stat $file )[9] // 0;
if ( open my $fh, '>>', $file ) { # append so we don't wipe out contents
my $mtime_after_open = ( stat $fh )[9] || 0; # for warnings safe numeric comparison
return 1 if $mtime != $mtime_after_open; # in case open does not change it, see comment below
}
else {
_log( 'warn', "Failed to open(>> $file) as $>: $!" ) unless $fail_ok;
}
if ($fail_ok) { return; }
my $at_this_point = ( stat $file )[9] || 0; # for warnings safe numeric comparison
if ( $mtime == $at_this_point ) {
my $new_at_this_point = ( stat $file )[9] || 0; # for warnings safe numeric comparison
if ( $mtime == $new_at_this_point ) {
if ($verbose) {
_log( 'info', 'Trying to do system “touch” command!' );
}
if ( system( 'touch', $file ) != 0 ) {
if ($verbose) {
_log( 'info', 'system method 1 failed.' );
}
}
}
}
if ( !-e $file ) { # obvisouly it didn't touch it if it doesn't exist...
_log( 'warn', "Failed to create $file: $!" );
return;
}
else {
my $after_all_that = ( stat $file )[9] || 0; # for warnings safe numeric comparison
if ( $mtime && $mtime == $after_all_that ) {
_log( 'warn', "mtime of “$file” not changed!" );
return;
}
return 1;
}
}
1;
} # --- END Cpanel/FileUtils/TouchFile.pm
{ # --- BEGIN Cpanel/Linux/NetlinkConstants.pm
package Cpanel::Linux::NetlinkConstants;
use strict;
use warnings;
no warnings 'once';
our $VERSION = '1.00';
# use Cpanel::Pack::Template (); # perlpkg line 211
use constant IFA_ADDRESS => 1;
use constant IFA_LOCAL => 2;
use constant IFA_LABEL => 3;
use constant IFA_CACHEINFO => 6;
use constant RT_SCOPE_UNIVERSE => 0;
use constant RT_SCOPE_SITE => 200;
use constant RT_SCOPE_LINK => 253;
use constant RT_SCOPE_HOST => 254;
use constant RT_SCOPE_NOWHERE => 255;
use constant RTM_GETLINK => 18;
use constant RTM_GETADDR => 22;
use constant RTM_GETROUTE => 26;
use constant RTA_DST => 1;
use constant RTA_PREFSRC => 7;
our @IFINFOMSG_TEMPLATE = ( #struct ifinfomsg
'ifi_family' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # unsigned char ifi_family;
'__ifi_pad' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # unsigned char __ifi_pad;
'ifi_type' => Cpanel::Pack::Template::PACK_TEMPLATE_U16, # unsigned short ifi_type; /* ARPHRD_* */
'ifi_index' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, # int ifi_index; /* Link index */
'ifi_flags' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, # unsigned ifi_flags; /* IFF_* flags */
'ifi_change' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 # unsigned ifi_change; /* IFF_* change mask */
);
our @IFA_CACHEINFO_TEMPLATE = ( #struct ifa_cacheinfo
'ifa_prefered' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, # __u32 ifa_prefered; # See: https://en,wiktionary,org/wiki/prefered -- It is mispelled upstream
'ifa_valid' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, # __u32 ifa_valid;
'cstamp' => Cpanel::Pack::Template::PACK_TEMPLATE_U32, # __u32 cstamp; /* created timestamp, hundredths of seconds */
'tstamp' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 # __u32 tstamp; /* updated timestamp, hundredths of seconds */
);
our @IFADDRMSG_TEMPLATE = ( # struct ifaddrmsg
'ifa_family' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 ifa_family;
'ifa_prefixlen' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 ifa_prefixlen; /* The prefix length */
'ifa_flags' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 ifa_flags; /* Flags */
'ifa_scope' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 ifa_scope; /* Address scope */
'ifa_index' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 # __u32 ifa_index; /* Link index */
);
our @RTMSG_TEMPLATE = ( # struct rtmsg
'rtm_family' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_family;
'rtm_dst_len' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_dst_len;
'rtm_src_len' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_src_len;
'rtm_tos' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_tos;
'rtm_table' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_table; /* Routing table id */
'rtm_protocol' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_protocol; /* Routing protocol */
'rtm_scope' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_scope; /* Address scope */
'rtm_type' => Cpanel::Pack::Template::PACK_TEMPLATE_U8, # __u8 rtm_type;
'rtm_flags' => Cpanel::Pack::Template::PACK_TEMPLATE_U32 # __u32 rtm_flags; /* Flags */
);
our @RTATTR_HEADER_TEMPLATE = (
'rta_len' => Cpanel::Pack::Template::PACK_TEMPLATE_U16,
'rta_type' => Cpanel::Pack::Template::PACK_TEMPLATE_U16,
);
1;
} # --- END Cpanel/Linux/NetlinkConstants.pm
{ # --- BEGIN Cpanel/Linux/RtNetlink.pm
package Cpanel::Linux::RtNetlink;
use cPstrict;
no warnings 'once';
# use Cpanel::Linux::Netlink (); # perlpkg line 211
# use Cpanel::Linux::NetlinkConstants (); # perlpkg line 211
# use Cpanel::Pack (); # perlpkg line 211
# use Cpanel::Pack::Template (); # perlpkg line 211
# use Cpanel::Socket::Constants (); # perlpkg line 211
# use Socket qw(inet_pton inet_ntop); # perlpkg line 248
INIT { Socket->import(qw{inet_pton inet_ntop}); }
use constant {
IFLA_IFNAME => 4,
DEBUG => 0,
AF_INET6 => $Cpanel::Linux::Netlink::AF_INET6,
IFA_LOCAL => Cpanel::Linux::NetlinkConstants::IFA_LOCAL(),
IFA_ADDRESS => Cpanel::Linux::NetlinkConstants::IFA_ADDRESS(),
IFA_CACHEINFO => Cpanel::Linux::NetlinkConstants::IFA_CACHEINFO(),
IFA_LABEL => Cpanel::Linux::NetlinkConstants::IFA_LABEL(),
PACK_TEMPLATE_U16 => Cpanel::Pack::Template::PACK_TEMPLATE_U16,
U16_BYTES_LENGTH => Cpanel::Pack::Template::U16_BYTES_LENGTH,
RTA_DST => Cpanel::Linux::NetlinkConstants::RTA_DST(),
RTA_PREFSRC => Cpanel::Linux::NetlinkConstants::RTA_PREFSRC(),
};
my $INFINITY_LIFE_TIME = 4294967295;
my $NETLINK_ROUTE_SOCKET = 0;
my $PF_NETLINK = 16;
my $IFINFOMSG_PACK_OBJ;
my $IFA_CACHEINFO_PACK_OBJ;
my $IFADDRMSG_PACK_OBJ;
my $RTMSG_PACK_OBJ;
sub get_first_interface_and_address {
my ($address_family) = @_;
die "List context only!" if !wantarray;
$address_family = _address_family_string_to_number($address_family);
my $socket = _make_netlink_socket();
my $addresses = _get_interface_addresses( $socket, $address_family );
my @fallback;
foreach my $address ( sort { $a->{'scope'} <=> $b->{'scope'} } @{$addresses} ) { # Prefer the largest global scope
$address->{'ip'} ||= _unpack_address_to_ip( $address->{'address'} || '' );
my @candidate = ( $address->{'ifindex'}, $address->{'ip'} );
if ( defined $address->{label} && index( $address->{label}, ':' ) > 0 ) { # do nothing if at position 0
my ( $interface, $virtual ) = split( ':', $address->{label}, 2 );
$candidate[0] .= ':' . $virtual;
}
@fallback = @candidate unless scalar @fallback;
next if is_reserved_ipv4( $address->{'ip'} );
return @candidate;
}
return @fallback;
}
sub is_reserved_ipv4 ($ip) {
return unless defined $ip;
return 1 if index( $ip, '127.' ) == 0 # 127.0.0.0/8
|| index( $ip, '10.' ) == 0 # 10.0.0.0/8
|| index( $ip, '11.' ) == 0 # 11.0.0.0/8
|| index( $ip, '192.168.' ) == 0 # 192.168.0.0/16
;
if ( index( $ip, '172.' ) == 0 || index( $ip, '2' ) == 0 ) {
if ( $ip =~ qr{^([0-9]+)\.([0-9]+)\.[0-9]+\.[0-9]+$} ) {
return 1 if $1 == 172 && ( 16 <= $2 && $2 <= 31 ); # 172.16.0.0/12
return 1 if $1 >= 224; # 224.0.0.0/4 & 240.0.0.0/4 & 255.255.255.255/32
}
}
return;
}
sub is_reserved_ipv6 ($ip) {
return unless defined $ip;
return 1 if $ip eq '::1';
$ip = lc $ip;
return 1 if index( $ip, 'fe80:' ) == 0;
return;
}
sub get_addresses_by_interface ($address_family) {
$address_family = _address_family_string_to_number($address_family);
my $socket = _make_netlink_socket();
my $addresses = _get_interface_addresses( $socket, $address_family, { 'ip' => 1 } );
my $interfaces = _get_interfaces( $socket, $address_family );
my %ifcount;
my %combined;
foreach my $address ( @{$addresses} ) {
next if $address->{'scope'} != Cpanel::Linux::NetlinkConstants::RT_SCOPE_UNIVERSE(); # only want global
my $if = $interfaces->[ $address->{'ifindex'} - 1 ];
$combined{$if}{ ++$ifcount{$if} } = $address;
}
return \%combined;
}
sub get_interfaces {
my ($address_family) = @_;
$address_family = _address_family_string_to_number($address_family);
return _get_interfaces( _make_netlink_socket(), $address_family );
}
sub get_interface_addresses ($address_family) {
$address_family = _address_family_string_to_number($address_family);
return _get_interface_addresses( _make_netlink_socket(), $address_family, { 'ip' => 1 } );
}
sub _get_interfaces ( $sock, $address_family ) {
my @interfaces;
$IFINFOMSG_PACK_OBJ ||= Cpanel::Pack->new( \@Cpanel::Linux::NetlinkConstants::IFINFOMSG_TEMPLATE );
Cpanel::Linux::Netlink::netlink_transaction(
'header' => [
'nlmsg_flags' => $Cpanel::Linux::Netlink::NLM_F_ROOT | $Cpanel::Linux::Netlink::NLM_F_MATCH,
'nlmsg_type' => Cpanel::Linux::NetlinkConstants::RTM_GETLINK(),
],
'message' => {
'ifi_family' => $address_family,
},
'sock' => $sock,
'send_pack_obj' => $IFINFOMSG_PACK_OBJ,
'recv_pack_obj' => $IFINFOMSG_PACK_OBJ,
'payload_parser' => _make_payload_parser(
sub {
my ( $nl_msgcount, $nl_response_hr, $rta_type, $value ) = @_;
print STDERR "toto-[$nl_msgcount]\ntype:[$rta_type]==value:[$value]\n" if DEBUG;
if ( $rta_type == Cpanel::Linux::NetlinkConstants::IFA_LABEL() ) {
$interfaces[ $nl_response_hr->{'ifi_index'} - 1 ] = $value =~ tr{\0}{}dr;
}
elsif (DEBUG) {
warn "Unknown rta_type: [$rta_type]";
}
},
),
);
return \@interfaces;
}
sub get_route_to ( $address_family, $dst_ip ) {
$address_family = _address_family_string_to_number($address_family);
$dst_ip = Socket::inet_pton $address_family, $dst_ip;
return _get_route_to( _make_netlink_socket(), $address_family, $dst_ip );
}
my @RTATTR_DATA = (
undef,
{
'name' => 'rta_dst',
'handler' => \&_rtattr_address_handler,
},
undef,
undef,
undef,
undef,
undef,
{
'name' => 'rta_prefsrc',
'handler' => \&_rtattr_address_handler,
},
);
sub _rtattr_address_handler ( $value, $address_family ) {
return Socket::inet_ntop( $address_family, $value );
}
sub _get_route_to ( $sock, $address_family, $dst_ip_packed ) { ## no critic qw(ProhibitManyArgs)
my ( $address_length, @attributes );
$address_length = ( $address_family == AF_INET6 ) ? 16 : 4;
$RTMSG_PACK_OBJ ||= Cpanel::Pack->new( \@Cpanel::Linux::NetlinkConstants::RTMSG_TEMPLATE );
my $RTMSG_WITH_DST_PACK_OBJ = Cpanel::Pack->new(
[
@Cpanel::Linux::NetlinkConstants::RTMSG_TEMPLATE,
@Cpanel::Linux::NetlinkConstants::RTATTR_HEADER_TEMPLATE,
'rta_dst' => 'a' . $address_length,
]
);
Cpanel::Linux::Netlink::netlink_transaction(
'header' => [
'nlmsg_type' => Cpanel::Linux::NetlinkConstants::RTM_GETROUTE(),
'nlmsg_seq' => 1, #seems unnecessary??
],
'message' => {
'rtm_family' => $address_family,
'rtm_dst_len' => $address_length * 8, # /32 for v4, /128 for v6
'rta_len' => 4 + $address_length, # includes rtattr header size (4 bytes)
'rta_type' => RTA_DST,
'rta_dst' => $dst_ip_packed,
},
'sock' => $sock,
'send_pack_obj' => $RTMSG_WITH_DST_PACK_OBJ,
'recv_pack_obj' => $RTMSG_PACK_OBJ,
'payload_parser' => _make_payload_parser(
sub {
my ( $msgcount, $response_ref, $rta_type, $value ) = @_;
$attributes[$msgcount] = {} unless defined $attributes[$msgcount];
if ( defined $RTATTR_DATA[$rta_type] ) {
my $rtattr_hr = $RTATTR_DATA[$rta_type];
$attributes[$msgcount]->{ $rtattr_hr->{'name'} } = $rtattr_hr->{'handler'}->( $value, $address_family );
}
else {
$attributes[$msgcount]->{$rta_type} = $value;
}
},
),
);
return \@attributes;
}
my %_u16_cache;
sub _make_payload_parser ($for_each_rtmsg_cr) {
return sub {
my ( $nl_msgcount, $nlresponse_hr, $payload_sr ) = ( $_[0], $_[1], \$_[2] );
my ( $u16, $rta_length, $rta_type, $value );
RTATTR_LOOP:
while ( length $$payload_sr ) {
$u16 = substr( $$payload_sr, 0, U16_BYTES_LENGTH, '' );
$rta_length = ( $_u16_cache{$u16} //= unpack( PACK_TEMPLATE_U16, $u16 ) ) or last RTATTR_LOOP; # unsigned short rta_len;
$u16 = substr( $$payload_sr, 0, U16_BYTES_LENGTH, '' );
$rta_type = ( $_u16_cache{$u16} //= unpack( PACK_TEMPLATE_U16, $u16 ) );
$value = substr( $$payload_sr, 0, $rta_length - ( U16_BYTES_LENGTH * 2 ), '' );
$for_each_rtmsg_cr->(
$nl_msgcount,
$nlresponse_hr,
$rta_type,
$value
);
}
};
}
sub _get_interface_addresses ( $sock, $address_family, $want = undef ) {
$want //= {};
my $want_ip = $want->{'ip'};
my @addresses;
$IFADDRMSG_PACK_OBJ ||= Cpanel::Pack->new( \@Cpanel::Linux::NetlinkConstants::IFADDRMSG_TEMPLATE );
$IFA_CACHEINFO_PACK_OBJ ||= Cpanel::Pack->new( \@Cpanel::Linux::NetlinkConstants::IFA_CACHEINFO_TEMPLATE );
Cpanel::Linux::Netlink::netlink_transaction(
'header' => [
'nlmsg_type' => Cpanel::Linux::NetlinkConstants::RTM_GETADDR(),
'nlmsg_flags' => $Cpanel::Linux::Netlink::NLM_F_ROOT,
'nlmsg_seq' => 1, #seems unnecessary??
],
'message' => {
'ifa_family' => $address_family,
},
'sock' => $sock,
'send_pack_obj' => $IFADDRMSG_PACK_OBJ,
'recv_pack_obj' => $IFADDRMSG_PACK_OBJ,
'payload_parser' => _make_payload_parser(
sub {
my ( $msgcount, $response_ref, $rta_type, $value ) = @_;
print STDERR "haha-[$msgcount]\n[$rta_type]==[$value]\n" if DEBUG;
if ( $rta_type == IFA_LOCAL || ( $rta_type == IFA_ADDRESS && !$addresses[$msgcount]->{'ip'} ) ) {
@{ $addresses[$msgcount] }{ 'scope', 'ifindex', 'prefix' } = @{$response_ref}{ 'ifa_scope', 'ifa_index', 'ifa_prefixlen' };
if ($want_ip) {
$addresses[$msgcount]->{'ip'} = ( $address_family == AF_INET6 ) ? join( ":", unpack( "H4H4H4H4H4H4H4H4", $value ) ) : join( '.', unpack( 'C4', $value ) );
}
else {
$addresses[$msgcount]->{'address'} = $value;
}
print STDERR "[address][$addresses[$msgcount]->{'ip'}]\n" if DEBUG;
}
elsif ( $rta_type == IFA_CACHEINFO ) {
$addresses[$msgcount]->{'cacheinfo'} = $IFA_CACHEINFO_PACK_OBJ->unpack_to_hashref($value);
if ( $addresses[$msgcount]->{'cacheinfo'}{'ifa_valid'} == $INFINITY_LIFE_TIME ) {
$addresses[$msgcount]->{'type'} = 0;
}
else {
$addresses[$msgcount]->{'temporary'} = 1;
}
}
elsif ( $rta_type == IFA_LABEL ) {
$addresses[$msgcount]->{'label'} = $value =~ tr{\0}{}dr;
}
elsif (DEBUG) {
warn "Unknown rta_type: [$rta_type]";
}
},
),
);
return \@addresses;
}
sub _make_netlink_socket() {
my $sock;
socket( $sock, $Cpanel::Linux::Netlink::PF_NETLINK, $Cpanel::Linux::Netlink::SOCK_DGRAM, $NETLINK_ROUTE_SOCKET ) or die "socket: $!";
return $sock;
}
my @ALLOWED_FAMILIES = qw(
AF_INET
AF_INET6
);
sub _address_family_string_to_number ($addr_fam) {
if ( !grep { $_ eq $addr_fam } @ALLOWED_FAMILIES ) {
die "“$addr_fam” is not a recognized address family; must be one of: @ALLOWED_FAMILIES";
}
return ${ *{ $Cpanel::Socket::Constants::{$addr_fam} }{'SCALAR'} };
}
sub _unpack_address_to_ip ($ip) {
return length $ip > 10 ? join( ":", unpack( "H4H4H4H4H4H4H4H4", $ip ) ) : join( '.', unpack( 'C4', $ip ) );
}
1;
} # --- END Cpanel/Linux/RtNetlink.pm
{ # --- BEGIN Cpanel/IP/Loopback.pm
package Cpanel::IP::Loopback;
use strict;
use warnings;
no warnings 'once';
sub is_loopback {
return (
length $_[0]
&& (
$_[0] eq 'localhost' #
|| $_[0] eq 'localhost.localdomain' #
|| $_[0] eq '0000:0000:0000:0000:0000:0000:0000:0001' #
|| index( $_[0], '0000:0000:0000:0000:0000:ffff:7f' ) == 0 # ipv4 inside of ipv6 match 127.*
|| index( $_[0], '::ffff:127.' ) == 0 # ipv4 inside of ipv6 match 127.*
|| index( $_[0], '127.' ) == 0 # ipv4 needs to match 127.*
|| $_[0] eq '0:0:0:0:0:0:0:1' #
|| $_[0] eq ':1' #
|| $_[0] eq '::1' #
|| $_[0] eq '(null)' #
|| $_[0] eq '(null):0000:0000:0000:0000:0000:0000:0000' #
|| $_[0] eq '0000:0000:0000:0000:0000:0000:0000:0000' #
|| $_[0] eq '0.0.0.0'
) #
) ? 1 : 0;
}
1;
} # --- END Cpanel/IP/Loopback.pm
{ # --- BEGIN Cpanel/IP/Configured.pm
package Cpanel::IP::Configured;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::CachedCommand::Utils (); # perlpkg line 211
# use Cpanel::FileUtils::TouchFile (); # perlpkg line 211
# use Cpanel::JSON::FailOK (); # perlpkg line 211
# use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211
# use Cpanel::PwCache (); # perlpkg line 211
use Try::Tiny;
our $VERSION = '1.7';
my $PRODUCT_CONF_DIR = '/var/cpanel';
my $SYSTEM_CONF_DIR = '/etc';
my $SYSTEM_SBIN_DIR = '/sbin';
my $DB_FILE = 'all_iplist.db';
my $configuredips;
sub clear_configured_ips_cache {
Cpanel::FileUtils::TouchFile::touchfile("$SYSTEM_CONF_DIR/ips"); # Reset mtime
Cpanel::CachedCommand::Utils::destroy( 'name' => $DB_FILE );
$configuredips = undef;
return 1;
}
sub getconfiguredips {
if ($configuredips) {
return wantarray ? @$configuredips : $configuredips;
}
my $iplist_cachefile = Cpanel::CachedCommand::Utils::get_datastore_filename($DB_FILE);
my $now = time();
my $iplist_cache_age = $now - ( ( stat $iplist_cachefile )[9] || 0 );
my $use_cache = 1;
if ( $iplist_cache_age < 0 || $iplist_cache_age > 300 ) {
$use_cache = 0;
}
else {
my $ips_age = $now - ( ( stat "$SYSTEM_CONF_DIR/ips" )[9] || 0 );
my $wwwacctconf_age = $now - ( ( stat "$SYSTEM_CONF_DIR/wwwacct.conf" )[9] || 0 );
if ( $iplist_cache_age > $ips_age || $iplist_cache_age > $wwwacctconf_age ) {
$use_cache = 0;
}
}
if ($use_cache) {
$configuredips = Cpanel::JSON::FailOK::LoadFile($iplist_cachefile);
}
if ( !$configuredips || !@$configuredips ) {
require Cpanel::Linux::RtNetlink;
require Cpanel::IP::Loopback;
my $ips = Cpanel::Linux::RtNetlink::get_interface_addresses('AF_INET');
@$configuredips = map { $_->{'ip'} } grep { !Cpanel::IP::Loopback::is_loopback( $_->{'ip'} ) } @$ips;
if ( Cpanel::PwCache::getusername() ne 'nobody' ) {
try {
Cpanel::FileUtils::Write::JSON::Lazy::write_file( $iplist_cachefile, $configuredips, 0644 );
}
catch {
_logger()->warn( Cpanel::Exception::get_string($_) );
};
}
}
$configuredips = [] unless ( defined $configuredips );
return wantarray ? @$configuredips : $configuredips;
}
sub clearcache {
$configuredips = undef;
return 1;
}
sub default_product_dir {
$PRODUCT_CONF_DIR = shift if @_;
return $PRODUCT_CONF_DIR;
}
sub default_conf_dir {
$SYSTEM_CONF_DIR = shift if @_;
return $SYSTEM_CONF_DIR;
}
sub default_sbin_dir {
$SYSTEM_SBIN_DIR = shift if @_;
return $SYSTEM_SBIN_DIR;
}
my $logger;
sub _logger {
return $logger if $logger;
require Cpanel::Logger;
return ( $logger = Cpanel::Logger->new() );
}
1;
} # --- END Cpanel/IP/Configured.pm
{ # --- BEGIN Cpanel/IP/Bound.pm
package Cpanel::IP::Bound;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Socket::Constants (); # perlpkg line 211
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
# use Cpanel::IP::NonlocalBind::Cache (); # perlpkg line 211
# use Cpanel::SV (); # perlpkg line 211
use constant {
_EADDRNOTAVAIL => 99,
_EADDRINUSE => 98
};
sub ipv4_is_bound {
my ($addr) = @_;
my $fd;
return 0 unless Cpanel::Validate::IP::v4::is_valid_ipv4($addr);
if ( index( $addr, '.' ) == 3 ) {
if ( ( substr( $addr, 0, 3 ) >= 224 ) && ( substr( $addr, 0, 3 ) < 240 ) ) {
warn "Multicast address ($addr) cannot be tested via this interface!\n";
return 0;
}
}
my $ipv4_ip_nonlocal_bind_is_enabled = Cpanel::IP::NonlocalBind::Cache::ipv4_ip_nonlocal_bind_is_enabled();
if ( !defined $ipv4_ip_nonlocal_bind_is_enabled || $ipv4_ip_nonlocal_bind_is_enabled ) {
return _slow_ipv4_is_bound_via_configured_ips($addr);
}
local $!;
socket( $fd, $Cpanel::Socket::Constants::PF_INET, $Cpanel::Socket::Constants::SOCK_STREAM, $Cpanel::Socket::Constants::IPPROTO_TCP ) or die "socket(PF_INET, SOCK_STREAM, IPPROTO_TCP): $!";
Cpanel::SV::untaint($addr);
bind( $fd, pack( 'SnC4x8', $Cpanel::Socket::Constants::AF_INET, 0, split( m{\.}, $addr ) ) ) or do {
return 1 if $! == _EADDRINUSE();
warn "bind($addr): $!\n" if $! != _EADDRNOTAVAIL();
return 0;
};
return 1;
}
sub _slow_ipv4_is_bound_via_configured_ips {
my ($addr) = @_;
require Cpanel::IP::Configured;
my $configured_ips_ar = Cpanel::IP::Configured::getconfiguredips();
foreach my $check_ip (@$configured_ips_ar) {
return 1 if $check_ip eq $addr;
}
return 0;
}
1;
} # --- END Cpanel/IP/Bound.pm
{ # --- BEGIN Cpanel/DIp/MainIP.pm
package Cpanel::DIp::MainIP;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Config::LoadWwwAcctConf (); # perlpkg line 211
# use Cpanel::GlobalCache (); # perlpkg line 211
# use Cpanel::IP::Bound (); # perlpkg line 211
# use Cpanel::LoadFile (); # perlpkg line 211
# use Cpanel::NAT (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::Validate::IP::v4 (); # perlpkg line 211
our $VERSION = '1.5';
my $PRODUCT_CONF_DIR = '/var/cpanel';
my $SYSTEM_CONF_DIR = '/etc';
my $SYSTEM_SBIN_DIR = '/sbin';
my $cachedmainip = q{};
my $cachedserverip = q{};
*getmainip = *getmainsharedip;
sub getmainsharedip {
return $cachedmainip if ( $cachedmainip ne '' );
my $wwwaccthash_ref = Cpanel::Config::LoadWwwAcctConf::loadwwwacctconf();
my $addr = q{};
if ( exists $wwwaccthash_ref->{'ADDR'} ) {
if ( !length $wwwaccthash_ref->{'ADDR'} ) {
return ( $cachedmainip = getmainserverip() );
}
elsif ( !Cpanel::Validate::IP::v4::is_valid_ipv4( $wwwaccthash_ref->{'ADDR'} ) && -x "$SYSTEM_SBIN_DIR/ip" ) {
return ( $cachedmainip = getmainserverip() );
}
elsif ( !-x "$SYSTEM_SBIN_DIR/ip" ) {
return ( $cachedmainip = $wwwaccthash_ref->{'ADDR'} );
}
$addr = $wwwaccthash_ref->{'ADDR'};
}
if ( !-x "$SYSTEM_SBIN_DIR/ip" ) {
Cpanel::Debug::log_warn("Working ip binary required to determine IP address. Please check the permissions of $SYSTEM_SBIN_DIR/ip");
return;
}
return ( $cachedmainip = $addr ) if Cpanel::IP::Bound::ipv4_is_bound($addr);
my $mainserverip = getmainserverip();
$cachedmainip = $mainserverip;
return $mainserverip;
}
sub getmainserverip {
return $cachedserverip if length $cachedserverip;
my $oldmainip = Cpanel::LoadFile::loadfile("$PRODUCT_CONF_DIR/mainip");
$oldmainip =~ tr{ \t\r\n}{}d if length $oldmainip;
if ( Cpanel::Validate::IP::v4::is_valid_ipv4($oldmainip) ) {
$cachedserverip = $oldmainip;
return $oldmainip;
}
my $wwwaccthash_ref = Cpanel::Config::LoadWwwAcctConf::loadwwwacctconf();
my $addr = $wwwaccthash_ref->{'ADDR'} // q{};
my $ethdev = $wwwaccthash_ref->{'ETHDEV'} // q{};
if ( !-x "$SYSTEM_SBIN_DIR/ip" ) {
return $addr if length $addr;
Cpanel::Debug::log_die("Fatal error: $SYSTEM_SBIN_DIR/ip is not executable, determining main server IP impossible");
}
my $wwwacct_conf_mtime = ( stat($Cpanel::Config::LoadWwwAcctConf::wwwacctconf) )[9];
my $ipconfig_mtime = 43200; #12 hours
if ( !$wwwacct_conf_mtime ) {
$ipconfig_mtime = 1;
}
else {
my $sec_since_wwwacct_conf_modified = ( time() - $wwwacct_conf_mtime );
if ( $sec_since_wwwacct_conf_modified < $ipconfig_mtime ) {
$ipconfig_mtime = $sec_since_wwwacct_conf_modified - 60;
}
}
my $thisip = _get_first_valid_ip( [ split( /\n/, Cpanel::GlobalCache::cachedmcommand( 'cpanel', $ipconfig_mtime, "$SYSTEM_SBIN_DIR/ip", '-4', 'addr', 'show', $ethdev eq '' ? () : $ethdev ) ) ] );
return ( $cachedserverip = $thisip ) if $thisip;
my $ips;
my $retry_ok = 0;
if ( !length $ethdev ) {
require Cpanel::CachedCommand;
$ips = Cpanel::CachedCommand::noncachedcommand( "$SYSTEM_SBIN_DIR/ip", '-4', 'addr', 'show' );
}
else {
$retry_ok = 1;
require Cpanel::CachedCommand;
$ips = Cpanel::CachedCommand::noncachedcommand( "$SYSTEM_SBIN_DIR/ip", '-4', 'addr', 'show', $ethdev );
}
$thisip = _get_first_valid_ip( [ split( /\n/, $ips ) ] );
return ( $cachedserverip = $thisip ) if $thisip;
if ($retry_ok) {
require Cpanel::CachedCommand;
$ips = Cpanel::CachedCommand::noncachedcommand( "$SYSTEM_SBIN_DIR/ip", '-4', 'addr', 'show' );
$thisip = _get_first_valid_ip( [ split( /\n/, $ips ) ] );
return ( $cachedserverip = $thisip ) if $thisip;
}
if ( $ethdev ne '' ) {
Cpanel::Debug::log_warn("No IP address found on $ethdev, make sure device is correctly configured, returning 0.0.0.0");
}
else {
Cpanel::Debug::log_warn("No IP address found, returning 0.0.0.0");
}
return '0.0.0.0';
}
sub getpublicmainserverip {
return Cpanel::NAT::get_public_ip( getmainserverip() );
}
sub clearcache {
$cachedmainip = '';
$cachedserverip = '';
if ( $INC{'Cpanel/DIp.pm'} ) {
Cpanel::DIp::clearcache();
}
return;
}
sub default_product_dir {
$PRODUCT_CONF_DIR = shift if @_;
return $PRODUCT_CONF_DIR;
}
sub default_conf_dir {
$SYSTEM_CONF_DIR = shift if @_;
return $SYSTEM_CONF_DIR;
}
sub default_sbin_dir {
$SYSTEM_SBIN_DIR = shift if @_;
return $SYSTEM_SBIN_DIR;
}
sub _get_first_valid_ip {
my ($ips_ref) = @_;
require Cpanel::Regex;
require Cpanel::IP::Loopback;
foreach my $ip (@$ips_ref) {
if ( $ip =~ m{ [\s\:] ($Cpanel::Regex::regex{'ipv4'}) }xoms ) {
my $thisip = $1;
if ( !Cpanel::IP::Loopback::is_loopback($thisip) ) {
return $thisip;
}
}
}
return undef;
}
1;
} # --- END Cpanel/DIp/MainIP.pm
{ # --- BEGIN Cpanel/StringFunc/Trim.pm
package Cpanel::StringFunc::Trim;
use strict;
use warnings;
no warnings 'once';
$Cpanel::StringFunc::Trim::VERSION = '1.02';
my %ws_chars = ( "\r" => undef, "\n" => undef, " " => undef, "\t" => undef, "\f" => undef );
sub trim {
my ( $str, $totrim ) = @_;
$str = rtrim( ltrim( $str, $totrim ), $totrim );
return $str;
}
sub ltrim {
my ( $str, $totrim ) = @_;
$str =~ s/^$totrim*//;
return $str;
}
sub rtrim {
my ( $str, $totrim ) = @_;
$str =~ s/$totrim*$//;
return $str;
}
sub endtrim {
my ( $str, $totrim ) = @_;
if ( substr( $str, ( length($totrim) * -1 ), length($totrim) ) eq $totrim ) {
return substr( $str, 0, ( length($str) - length($totrim) ) );
}
return $str;
}
sub begintrim {
my ( $str, $totrim ) = @_;
if (
defined $str && defined $totrim # .
&& substr( $str, 0, length($totrim) ) eq $totrim
) {
return substr( $str, length($totrim) );
}
return $str;
}
sub ws_trim {
my ($this) = @_;
return unless defined $this;
my $fix = ref $this eq 'SCALAR' ? $this : \$this;
return unless defined $$fix;
if ( $$fix =~ tr{\r\n \t\f}{} ) {
${$fix} =~ s/^\s+// if exists $ws_chars{ substr( $$fix, 0, 1 ) };
${$fix} =~ s/\s+$// if exists $ws_chars{ substr( $$fix, -1, 1 ) };
}
return ${$fix};
}
sub ws_trim_array {
my $ar = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; # [@_] :: copy @_ w/ out unpack first: !! not \@_ in this case !!
foreach my $idx ( 0 .. scalar( @{$ar} ) - 1 ) {
$ar->[$idx] = ws_trim( $ar->[$idx] );
}
return wantarray ? @{$ar} : $ar;
}
sub ws_trim_hash_values {
my $hr = ref $_[0] eq 'HASH' ? $_[0] : {@_}; # {@_} :: copy @_ w/ out unpack first:
foreach my $key ( keys %{$hr} ) {
$hr->{$key} = ws_trim( $hr->{$key} );
}
return wantarray ? %{$hr} : $hr;
}
1;
} # --- END Cpanel/StringFunc/Trim.pm
{ # --- BEGIN Cpanel/Encoder/Punycode.pm
package Cpanel::Encoder::Punycode;
use strict;
use warnings;
no warnings 'once';
our $VERSION = '1.0';
sub punycode_encode_str {
my ($string) = @_;
return $string if $string !~ tr<\x00-\x7f><>c;
my $at_at = index( $string, '@' );
require Cpanel::UTF8::Strict;
require Net::IDN::Encode;
if ( $at_at > -1 ) {
my $local_part = substr( $string, 0, $at_at );
my $domain = substr( $string, 1 + $at_at );
Cpanel::UTF8::Strict::decode($local_part);
Cpanel::UTF8::Strict::decode($domain);
return Net::IDN::Encode::domain_to_ascii($local_part) . '@' . Net::IDN::Encode::domain_to_ascii($domain);
}
Cpanel::UTF8::Strict::decode($string);
return Net::IDN::Encode::domain_to_ascii($string);
}
sub punycode_decode_str {
my ($string) = @_;
return $string if index( $string, 'xn--' ) == -1;
require Net::IDN::Encode;
my $at_at = index( $string, '@' );
if ( -1 != $at_at ) {
my $local_part = Net::IDN::Encode::domain_to_unicode( substr( $string, 0, $at_at ) );
my $domain = Net::IDN::Encode::domain_to_unicode( substr( $string, 1 + $at_at ) );
utf8::encode($local_part);
utf8::encode($domain);
return $local_part . '@' . $domain;
}
my $str = Net::IDN::Encode::domain_to_unicode($string);
utf8::encode($str);
return $str;
}
1;
} # --- END Cpanel/Encoder/Punycode.pm
{ # --- BEGIN Cpanel/Validate/Domain/Tiny.pm
package Cpanel::Validate::Domain::Tiny;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::Validate::IP (); # perlpkg line 211
sub domain_meets_basic_requirements {
my ( $domainname, $quiet ) = @_;
return wantarray ? ( 0, 'invalid domain name specified' ) : 0 unless defined $domainname;
if (
$domainname =~ tr{:0-9}{} && # It cannot be an ip address if it does not have a digit or a : in it
$domainname !~ tr{g-z}{} && # It cannot be an ip address if has non-hex characters
Cpanel::Validate::IP::is_valid_ip($domainname)
) {
Cpanel::Debug::log_warn( $domainname . ' is an IP address, not a domain name' ) if !$quiet;
return wantarray ? ( 0, 'argument is an IP address, not a domain name' ) : 0;
}
if ( length($domainname) > 254 ) {
Cpanel::Debug::log_warn( $domainname . ' domain name exceeds 254 characters' ) if !$quiet;
return wantarray ? ( 0, 'domain name exceeds 254 characters' ) : 0;
}
elsif ($domainname !~ m/[.][a-z0-9]+$/i
&& $domainname !~ m/[.]xn--[a-z0-9-]+$/i ) {
Cpanel::Debug::log_warn( $domainname . ' domain name must have a valid TLD label' ) if !$quiet;
return wantarray ? ( 0, 'domain name must have a valid TLD label' ) : 0;
}
if ( index( $domainname, '.' ) == -1 ) {
Cpanel::Debug::log_warn("invalid domain name $domainname") if !$quiet;
return wantarray ? ( 0, "invalid domain name $domainname" ) : 0;
}
return wantarray ? ( 1, 'ok' ) : 1;
}
sub validdomainname {
my ( $domainname, $quiet ) = @_;
my ( $status, $msg ) = domain_meets_basic_requirements( $domainname, $quiet );
return wantarray ? ( $status, $msg ) : $status if !$status;
LABELS_LOOP:
foreach my $label ( split( /\./, $domainname ) ) {
if (
length($label) < 64
&& length($label) > 0
&& (
$label =~ m{
\A
[a-z0-9]
[a-z0-9-]*
[a-z0-9]
\z
}xmsi
||
$label =~ m{
\A
[a-z0-9]
\z
}xmsi
)
) {
next LABELS_LOOP;
}
Cpanel::Debug::log_warn("domain name element $label does not conform to requirements") if !$quiet;
return wantarray ? ( 0, "domain name element $label does not conform to requirements" ) : 0;
}
return wantarray ? ( 1, $domainname ) : 1;
}
1;
} # --- END Cpanel/Validate/Domain/Tiny.pm
{ # --- BEGIN Cpanel/Validate/Domain/Normalize.pm
package Cpanel::Validate::Domain::Normalize;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::StringFunc::Trim (); # perlpkg line 211
# use Cpanel::Encoder::Punycode (); # perlpkg line 211
# use Cpanel::Validate::Domain::Tiny (); # perlpkg line 211
our $VERSION = '1.0';
sub normalize {
my ( $domain, $quiet ) = @_;
if ( !defined $domain ) {
return;
}
$domain = _just_normalize($domain);
if ( !$quiet && !Cpanel::Validate::Domain::Tiny::validdomainname($domain) ) {
Cpanel::Debug::log_info("Invalid domain $domain specified.");
}
return $domain;
}
sub normalize_wildcard {
my ($domain) = @_;
die "Domain is missing!" if !length $domain;
return _just_normalize($domain);
}
sub normalize_to_root_domain {
my ( $domain, $quiet ) = @_;
return undef unless defined $domain;
$domain = normalize( $domain, $quiet );
substr( $domain, 0, 2, '' ) if rindex( $domain, '*.', 0 ) == 0;
substr( $domain, 0, 4, '' ) if rindex( $domain, 'www.', 0 ) == 0;
return $domain;
}
sub _just_normalize {
my ($domain) = @_;
Cpanel::StringFunc::Trim::ws_trim( \$domain );
$domain =~ tr{A-Z}{a-z};
return Cpanel::Encoder::Punycode::punycode_encode_str($domain);
}
1;
} # --- END Cpanel/Validate/Domain/Normalize.pm
{ # --- BEGIN Cpanel/IP/AutoDomain/Base.pm
package Cpanel::IP::AutoDomain::Base;
use cPstrict;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::NAT (); # perlpkg line 211
# use Cpanel::DIp::MainIP (); # perlpkg line 211
# use Cpanel::Validate::Domain::Normalize (); # perlpkg line 211
use Simple::Accessor qw< auto_domain >;
sub build ( $self, %opts ) {
if ( my $domain = delete $opts{domain} ) {
$domain = '.' . $domain unless $domain =~ m{^\.};
$self->auto_domain($domain);
}
return $self;
}
sub _build_auto_domain {
die Cpanel::Exception::create( 'MissingParameter', 'Provide a domain or auto_domain.' );
}
sub ipv4_to_name ( $self, $ipv4 ) {
$ipv4 //= '';
return ( $ipv4 =~ tr/./-/r ) . $self->auto_domain();
}
sub get_hostname ($self) {
my $public_ip = Cpanel::NAT::get_public_ip( Cpanel::DIp::MainIP::getmainip() );
return $self->ipv4_to_name($public_ip);
}
sub is_subdomain_of_autodomain ( $self, $domain ) {
return unless defined $domain;
$domain =~ s/\.$//;
$domain =~ s!^https?://!!;
$domain = Cpanel::Validate::Domain::Normalize::normalize( $domain, 1 );
my @domain_parts = reverse( split /\./, $domain );
my @auto_domain_parts = grep { $_ ne '' } reverse( split /\./, $self->auto_domain() );
return if ( scalar(@domain_parts) < scalar(@auto_domain_parts) );
for my $i ( 0 .. $#auto_domain_parts ) {
return if $domain_parts[$i] ne $auto_domain_parts[$i];
}
return 1;
}
1;
} # --- END Cpanel/IP/AutoDomain/Base.pm
{ # --- BEGIN Cpanel/Version/Tiny.pm
package Cpanel::Version::Tiny;
use strict;
our $VERSION = '11.130.0';
our $VERSION_BUILD = '11.130.0.5';
our $VERSION_TEXT = '130.0 (build 5)';
our $VERSION_DISPLAY = '130.0.5';
our $parent_version = 11;
our $major_version = 130;
our $minor_version = 0;
our $build_number = 5;
our $build_time_text = 'Thu Aug 21 10:32:39 2025';
our $buildtime = 1755790359;
1;
} # --- END Cpanel/Version/Tiny.pm
{ # --- BEGIN Cpanel/Version/Full.pm
package Cpanel::Version::Full;
use strict;
my $full_version;
our $VERSION_FILE = '/usr/local/cpanel/version';
sub getversion {
if ( !$full_version ) {
if ( open my $ver_fh, '<', $VERSION_FILE ) {
if ( read $ver_fh, $full_version, 32 ) {
chomp($full_version);
}
elsif ($!) {
warn "read($VERSION_FILE): $!";
}
}
else {
warn "open($VERSION_FILE): $!";
}
if ( !$full_version || $full_version =~ tr{.}{} < 3 ) {
require Cpanel::Version::Tiny;
$full_version = $Cpanel::Version::Tiny::VERSION_BUILD;
}
}
return $full_version;
}
sub _clear_cache {
undef $full_version;
return;
}
1;
} # --- END Cpanel/Version/Full.pm
{ # --- BEGIN Cpanel/Version/Compare.pm
package Cpanel::Version::Compare;
use cPstrict;
no warnings 'once';
my %modes = (
'>' => sub ( $check, $against ) {
return if $check eq $against; # no need to continue if they are the same
return ( cmp_versions( $check, $against ) > 0 );
},
'<' => sub ( $check, $against ) {
return if $check eq $against; # no need to continue if they are the same
return ( cmp_versions( $check, $against ) < 0 );
},
'==' => sub ( $check, $against ) {
return ( $check eq $against || cmp_versions( $check, $against ) == 0 );
},
'!=' => sub ( $check, $against ) {
return ( $check ne $against && cmp_versions( $check, $against ) != 0 );
},
'>=' => sub ( $check, $against ) {
return 1 if $check eq $against; # no need to continue if they are the same
return ( cmp_versions( $check, $against ) >= 0 );
},
'<=' => sub ( $check, $against ) {
return 1 if $check eq $against; # no need to continue if they are the same
return ( cmp_versions( $check, $against ) <= 0 );
},
'<=>' => sub ( $check, $against ) {
return cmp_versions( $check, $against );
},
);
sub compare ( $check, $mode, $against ) {
if ( !defined $mode || !exists $modes{$mode} ) {
return;
}
foreach my $ver ( $check, $against ) {
$ver //= '';
if ( $ver !~ m{ ^((?:\d+[._]){0,}\d+[a-z]?).*?$ }axms ) {
return;
}
$ver = $1;
}
$check =~ s/_/\./g;
$against =~ s/_/\./g;
$check =~ s/([a-z])$/'.' . ord($1)/e;
$against =~ s/([a-z])$/'.' . ord($1)/e;
my @check_len = split( /[_\.]/, $check );
my @against_len = split( /[_\.]/, $against );
if ( @check_len > 4 ) {
return;
}
elsif ( @check_len < 4 ) {
for ( 1 .. 4 - @check_len ) {
$check .= '.0';
}
}
if ( @against_len > 4 ) {
return;
}
elsif ( @against_len < 4 ) {
for ( 1 .. 4 - @against_len ) {
$against .= '.0';
}
}
return if $check !~ m { \A \d+\.\d+\.\d+\.\d+ \z }axms;
return if $against !~ m { \A \d+\.\d+\.\d+\.\d+ \z }axms;
return $modes{$mode}->( $check, $against );
}
sub cmp_versions ( $left, $right ) {
my ( $maj, $min, $rev, $sup ) = split /[\._]/, $left;
my ( $mj, $mn, $rv, $sp ) = split /[\._]/, $right;
return $maj <=> $mj || $min <=> $mn || $rev <=> $rv || $sup <=> $sp;
}
sub get_major_release ( $version = '' ) {
$version =~ s/\s*//g;
my ( $major, $minor );
if ( $version =~ m/^([0-9]+)\.([0-9]+)/ ) {
$major = int $1;
$minor = int $2;
}
else {
return;
}
$minor++ if $minor % 2;
return "$major.$minor";
}
sub compare_major_release ( $check, $mode, $against ) {
return unless defined $check && defined $mode && defined $against;
my $maj1 = get_major_release($check);
return unless defined $maj1;
my $maj2 = get_major_release($against);
return unless defined $maj2;
return $modes{$mode}->( $maj1, $maj2 );
}
1;
} # --- END Cpanel/Version/Compare.pm
{ # --- BEGIN Cpanel/Version.pm
package Cpanel::Version;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Version::Full (); # perlpkg line 211
our ( $VERSION, $MAJORVERSION, $LTS ) = ( '4.0', '11.130', '11.130' );
sub get_version_text {
return sprintf( "%d.%d (build %d)", ( split( m{\.}, Cpanel::Version::Full::getversion() ) )[ 1, 2, 3 ] );
}
sub get_version_parent {
return _ver_key('parent_version');
}
sub get_version_display {
return sprintf( "%d.%d.%d", ( split( m{\.}, Cpanel::Version::Full::getversion() ) )[ 1, 2, 3 ] );
}
{
no warnings 'once'; # for updatenow
*get_version_full = *Cpanel::Version::Full::getversion;
}
sub getversionnumber {
return sprintf( "%d.%d.%d", ( split( m{\.}, Cpanel::Version::Full::getversion() ) )[ 0, 1, 2 ] );
}
sub get_lts {
return $LTS;
}
sub get_short_release_number {
my $current_ver = ( split( m{\.}, Cpanel::Version::Full::getversion() ) )[1];
if ( $current_ver % 2 == 0 ) {
return $current_ver;
}
return $current_ver + 1;
}
sub _ver_key {
require Cpanel::Version::Tiny if !$INC{'Cpanel/Version/Tiny.pm'};
return ${ $Cpanel::Version::Tiny::{ $_[0] } };
}
sub compare {
require Cpanel::Version::Compare;
goto &Cpanel::Version::Compare::compare;
}
sub is_major_version {
my ( $ver, $major ) = @_;
require Cpanel::Version::Compare;
return ( $ver eq $major || Cpanel::Version::Compare::get_major_release($ver) eq $major ) ? 1 : 0;
}
sub is_development_version {
return substr( $MAJORVERSION, -1 ) % 2 ? 1 : 0;
}
sub display_version {
my ($ver) = @_;
if ( defined $ver && $ver =~ tr{\.}{} >= 2 ) {
my @v = split( m{\.}, $ver );
if ( $v[0] == 11 && $v[1] >= 54 ) {
return join( '.', (@v)[ 1, 2, 3 ] );
}
return $ver;
}
return;
}
1;
} # --- END Cpanel/Version.pm
{ # --- BEGIN Cpanel/IP/AutoDomain.pm
package Cpanel::IP::AutoDomain;
use cPstrict;
no warnings 'once';
# use Cpanel::Hostname (); # perlpkg line 211
# use Cpanel::IP::AutoDomain::Base (); # perlpkg line 211
use constant AUTO_DOMAIN_FOR_CPANEL => 'cprapid.com'; # value used by cPanel builds (used by Whostmgr::Transfers::Systems::ServiceProxy)
use constant AUTO_DOMAIN_FOR_WP2 => 'wp2.host';
use constant AUTO_DOMAIN_FOR_HOST => 'cprapid.com';
use constant AUTO_DOMAIN_FOR_WEBSITE => 'cpanel.site';
use constant TEMP_DOMAIN_FIRST_SUPPORTED_VERSION => '130';
sub for_regular_cpanel() {
return Cpanel::IP::AutoDomain::Base->new( domain => AUTO_DOMAIN_FOR_CPANEL );
}
sub for_host() {
return Cpanel::IP::AutoDomain::Base->new( domain => AUTO_DOMAIN_FOR_HOST );
}
sub for_website() {
return Cpanel::IP::AutoDomain::Base->new( domain => AUTO_DOMAIN_FOR_WEBSITE );
}
sub for_any() {
return [ for_regular_cpanel(), for_host(), for_website() ];
}
sub is_subdomain_of_autodomain ($domain) {
foreach my $ad ( for_any()->@* ) {
return 1 if $ad->is_subdomain_of_autodomain($domain);
}
return;
}
sub for_domain ($domain) {
if ( length $domain && $domain eq Cpanel::Hostname::gethostname() ) {
return for_host();
}
return for_website();
}
sub is_temp_domains_supported {
require Cpanel::Version;
require Cpanel::Version::Compare;
return Cpanel::Version::Compare::compare( Cpanel::Version::get_short_release_number(), '>=', TEMP_DOMAIN_FIRST_SUPPORTED_VERSION );
}
sub is_for_regular_cpanel ($domain) {
return _is_for_auto_domain( $domain, AUTO_DOMAIN_FOR_CPANEL );
}
sub is_for_host ($domain) {
return _is_for_auto_domain( $domain, AUTO_DOMAIN_FOR_HOST );
}
sub is_for_website ($domain) {
return _is_for_auto_domain( $domain, AUTO_DOMAIN_FOR_WEBSITE );
}
sub _is_for_auto_domain ( $domain, $root_domain ) {
my $diff = length($domain) - length(".$root_domain");
return 0 if $diff < 0;
return rindex( $domain, ".$root_domain", $diff ) != -1 ? 1 : 0;
}
1;
} # --- END Cpanel/IP/AutoDomain.pm
{ # --- BEGIN Cpanel/IP/AutoDomain/TemporaryDomain/Constants.pm
package Cpanel::IP::AutoDomain::TemporaryDomain::Constants;
use cPstrict;
no warnings 'once';
our $TEMPORARY_DOMAIN_COMPONENTS = '/usr/local/cpanel/etc/temp-domain-components.yaml';
our $TEMPORARY_DOMAINS_IN_USE = '/var/cpanel/temporary-domains.yaml';
our $TEMPORARY_ISSUANCE_TIMEOUT = 60 * 5; # Allow up to 5 minutes for generating a unique random domain
1;
} # --- END Cpanel/IP/AutoDomain/TemporaryDomain/Constants.pm
{ # --- BEGIN Cpanel/YAML/Syck.pm
package Cpanel::YAML::Syck;
use YAML::Syck ();
sub _init {
$YAML::Syck::LoadBlessed = 0;
{
no warnings 'redefine';
*Cpanel::YAML::Syck::_init = sub { };
}
return;
}
_init();
1;
} # --- END Cpanel/YAML/Syck.pm
{ # --- BEGIN Cpanel/YAML.pm
package Cpanel::YAML;
use strict;
use YAML::Syck ();
# use Cpanel::YAML::Syck (); # perlpkg line 211
BEGIN {
*Load = *YAML::Syck::Load;
*SafeDump = \&Dump;
*DumpFile = *YAML::Syck::DumpFile;
}
our $MAX_LOAD_LENGTH = 65535;
our $MAX_PRIV_LOAD_LENGTH = 4194304; # four megs
sub _is_openhandle {
my $h = shift;
if ( my $isa = ref($h) ) {
return 1 if ( $isa eq 'GLOB' );
return 1 if ( $isa =~ m/^IO::/ );
}
return 1 if ( ref( \$h ) eq 'GLOB' );
return;
}
sub SafeLoadFile { # only allow a small bit of data to be loaded
return LoadFile( $_[0], $MAX_LOAD_LENGTH );
}
sub LoadFile {
my $file = shift;
my $max = shift;
my $str_r;
if ( _is_openhandle($file) ) {
if ($max) {
my $togo = $max;
my $buffer = '';
my $bytes_read;
while ( $bytes_read = read( $file, $buffer, $togo, length $buffer ) && length $buffer < $max ) {
$togo -= $bytes_read;
}
$str_r = \$buffer;
}
else {
$str_r = \do { local $/; <$file> };
}
}
else {
if ( !-e $file || -z $file ) {
require Carp;
Carp::croak("'$file' is non-existent or empty");
}
open( my $fh, '<', $file ) or do {
require Carp;
Carp::croak("Cannot read from $file: $!");
};
$str_r = \do { local $/; <$fh> };
}
return YAML::Syck::LoadYAML($$str_r);
}
sub Dump {
my ( $data, @extra ) = @_;
$data = _convert_json_boolean( $data, {} );
return YAML::Syck::Dump( $data, @extra );
}
sub _convert_json_boolean {
my ( $data, $seen ) = @_;
return unless defined $data;
return $data if $seen->{"$data"};
if ( my $isa = ref($data) ) {
if ( index( $isa, 'JSON::' ) == 0 ) {
if ( $isa eq 'JSON::PP::Boolean' || $isa eq 'JSON::XS::Boolean' ) {
return $data ? 1 : 0; # true / false: prefer 1/0 for roundtrip purpose
}
}
$seen->{"$data"} = 1;
if ( $isa eq 'HASH' ) {
foreach my $key ( keys %$data ) {
$data->{$key} = _convert_json_boolean( $data->{$key}, $seen );
}
}
elsif ( $isa eq 'ARRAY' ) {
foreach my $i ( 0 .. $#$data ) {
$data->[$i] = _convert_json_boolean( $data->[$i], $seen );
}
}
}
return $data;
}
1;
} # --- END Cpanel/YAML.pm
{ # --- BEGIN Cpanel/Transaction/File/Read/YAML.pm
package Cpanel::Transaction::File::Read::YAML;
use cPstrict;
no warnings 'once';
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
# use Cpanel::YAML (); # perlpkg line 211
sub _init_data {
my ( $self, %opts ) = @_;
return \undef if -z $self->{'_fh'};
my $func = \&Cpanel::YAML::Load;
my $txt = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $self->{'_fh'}, $txt );
my $load = $func->($txt);
return ref($load) ? $load : \$load;
}
1;
} # --- END Cpanel/Transaction/File/Read/YAML.pm
{ # --- BEGIN Cpanel/Transaction/File/BaseReader.pm
package Cpanel::Transaction::File::BaseReader;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Autodie qw(open exists stat close); # perlpkg line 248
INIT { Cpanel::Autodie->import(qw{open exists stat close}); }
# use Cpanel::Exception (); # perlpkg line 211
my $PACKAGE = __PACKAGE__;
sub new {
my ( $class, %opts ) = @_;
die "No file!" if !length $opts{'path'};
my $path = $opts{'path'};
my $self = bless {}, $class;
my $data;
if ( !Cpanel::Autodie::exists($path) ) {
$data = \undef;
}
else {
Cpanel::Autodie::open( my $read_fh, '<', $path );
$self->{'_original_mtime'} = ( Cpanel::Autodie::stat($read_fh) )[9];
local $self->{'_fh'} = $read_fh;
$data = $self->_init_data_with_catch(%opts);
Cpanel::Autodie::close( $read_fh, $path );
}
return bless { _data => $data, _did_init_data => 1 }, $class;
}
sub _init_data_with_catch {
my ( $self, %opts ) = @_;
my $data;
local $@;
eval { $data = $self->_init_data(%opts); 1 } or do {
die Cpanel::Exception->create(
'The system failed to load and to parse the file “[_1]” because of an error: [_2]',
[ $opts{'path'}, Cpanel::Exception::get_string($@) ]
);
};
return $data;
}
sub _init_data {
die "Do not instantiate $PACKAGE directly; use a subclass instead.";
}
sub _get_data {
if ( !$_[0]->{'_did_init_data'} ) {
$_[0]->{'_data'} = $_[0]->_init_data_with_catch( %{ $_[0]->{'_opts'} } );
$_[0]->{'_did_init_data'} = 1;
}
return $_[0]->{'_data'};
}
sub get_original_mtime {
return $_[0]->{'_original_mtime'};
}
sub path_is_newer {
return ( Cpanel::Autodie::stat( $_[0]->{'_path'} ) )[9] != $_[0]->{'_original_mtime'} ? 1 : 0;
}
sub get_fh {
return $_[0]->{'_fh'};
}
sub get_mtime {
return ( stat( $_[0]->{'_fh'} ) )[9];
}
no warnings 'once';
*get_data = \&_get_data;
1;
} # --- END Cpanel/Transaction/File/BaseReader.pm
{ # --- BEGIN Cpanel/Transaction/File/YAMLReader.pm
package Cpanel::Transaction::File::YAMLReader;
use cPstrict;
no warnings 'once';
# use Cpanel::Transaction::File::Read::YAML (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Transaction::File::Read::YAML); }
# use Cpanel::Transaction::File::BaseReader (); # perlpkg line 238
BEGIN { push @ISA, qw(Cpanel::Transaction::File::BaseReader); }
1;
} # --- END Cpanel/Transaction/File/YAMLReader.pm
{ # --- BEGIN Cpanel/Transaction/File/Read/JSON.pm
package Cpanel::Transaction::File::Read::JSON;
use strict;
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
# use Cpanel::JSON (); # perlpkg line 211
my $READ_SIZE = 262140;
sub _init_data {
my ( $self, %opts ) = @_;
return \undef if -z $self->{'_fh'};
my $func = \&Cpanel::JSON::Load;
my $txt = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $self->{'_fh'}, $txt );
my $load = $func->($txt);
return ref($load) ? $load : \$load;
}
1;
} # --- END Cpanel/Transaction/File/Read/JSON.pm
{ # --- BEGIN Cpanel/Transaction/File/JSONReader.pm
package Cpanel::Transaction::File::JSONReader;
use strict;
# use Cpanel::Transaction::File::Read::JSON (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Transaction::File::Read::JSON); }
# use Cpanel::Transaction::File::BaseReader (); # perlpkg line 238
BEGIN { push @ISA, qw(Cpanel::Transaction::File::BaseReader); }
1;
} # --- END Cpanel/Transaction/File/JSONReader.pm
{ # --- BEGIN Cpanel/IP/AutoDomain/TemporaryDomain/Check.pm
package Cpanel::IP::AutoDomain::TemporaryDomain::Check;
use cPstrict;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::IP::AutoDomain (); # perlpkg line 211
# use Cpanel::IP::AutoDomain::TemporaryDomain::Constants (); # perlpkg line 211
# use Cpanel::Transaction::File::YAMLReader (); # perlpkg line 211
# use Cpanel::Transaction::File::JSONReader (); # perlpkg line 211
our $_CACHED_EA4_TECH_DOMAINS_PATTERN;
our $ea4_metainfo = '/etc/cpanel/ea4/ea4-metainfo.json';
sub get_ea4_techdomains_pattern {
return $_CACHED_EA4_TECH_DOMAINS_PATTERN
if defined $_CACHED_EA4_TECH_DOMAINS_PATTERN;
return unless -f $ea4_metainfo;
my $txn = Cpanel::Transaction::File::JSONReader->new( path => $ea4_metainfo );
my $data = $txn->get_data();
my $arr_ref = $data->{tech_domains} // [];
my @valid = grep { $_ } $arr_ref->@*;
unless (@valid) {
warn "'tech_domains' array in $ea4_metainfo contained only invalid or empty entries.\n";
return;
}
my $inner = join '|',
map { '(?:.*\.)?' . quotemeta($_) } @valid;
return ( $_CACHED_EA4_TECH_DOMAINS_PATTERN = "^(?:$inner)\$" );
}
sub domain_is_temporary_subdomain ($domain) {
return 0 unless $domain;
if ( Cpanel::IP::AutoDomain::for_website()->is_subdomain_of_autodomain($domain) ) {
return 1;
}
my $tech_pattern = get_ea4_techdomains_pattern();
return 0 unless $tech_pattern;
if ( $domain =~ qr{$tech_pattern}i ) {
return 1;
}
return 0;
}
sub is_domain_in_use ($domain) {
return 0 if !domain_is_temporary_subdomain($domain);
my $tx = Cpanel::Transaction::File::YAMLReader->new( path => $Cpanel::IP::AutoDomain::TemporaryDomain::Constants::TEMPORARY_DOMAINS_IN_USE );
my $data = $tx->get_data();
return 0 if !defined $data || ref $data ne 'HASH';
return $data->{$domain} ? 1 : 0;
}
sub domain_assigned_to ($domain) {
return undef if !domain_is_temporary_subdomain($domain);
my $tx = Cpanel::Transaction::File::YAMLReader->new( path => $Cpanel::IP::AutoDomain::TemporaryDomain::Constants::TEMPORARY_DOMAINS_IN_USE );
my $data = $tx->get_data();
return undef if ref($data) eq 'SCALAR';
return $data->{$domain};
}
sub temporary_domain_contains_local_server_ip ($domain) {
return 0 unless $domain;
return 0 unless domain_is_temporary_subdomain($domain);
my $dashed_local_ip = Cpanel::IP::AutoDomain::for_website()->get_hostname();
return 0 unless $dashed_local_ip;
return $domain =~ /\Q$dashed_local_ip\E/ ? 1 : 0;
}
sub verify_domain_assigned_to ( $domain, $user ) {
die "domain parameter undef or missing" if !length $domain;
die "user parameter undef or missing" if !length $user;
my $assigned_user = domain_assigned_to($domain);
if ( !$assigned_user ) {
die Cpanel::Exception::create( 'InvalidParameter', 'The domain “[_1]” is not temporary or does not exist.', [$domain] );
}
elsif ( $assigned_user ne $user ) {
die Cpanel::Exception::create( 'DomainOwnership', 'The account “[_1]” does not own the domain “[_2]”.', [ $user, $domain ] );
}
return 1;
}
1;
} # --- END Cpanel/IP/AutoDomain/TemporaryDomain/Check.pm
{ # --- BEGIN Cpanel/Server/Type.pm
package Cpanel::Server::Type;
use cPstrict;
no warnings 'once';
use constant NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE => 1;
sub _get_license_file_path { return q{/usr/local/cpanel/cpanel.lisc} }
sub _get_dnsonly_file_path { return q{/var/cpanel/dnsonly} }
use constant _ENOENT => 2;
use constant SERVER_TYPE => q[cpanel];
my @server_config;
our %PRODUCTS;
our $MAXUSERS;
our %FIELDS;
our ( $DNSONLY_MODE, $NODE_MODE );
sub is_dnsonly {
return $DNSONLY_MODE if defined $DNSONLY_MODE;
return 1 if -e _get_dnsonly_file_path();
return 0 if $! == _ENOENT();
my $err = $!;
if ( _read_license() ) {
return $PRODUCTS{'dnsonly'} ? 1 : 0;
}
die sprintf( 'stat(%s): %s', _get_dnsonly_file_path(), "$err" );
}
sub is_wp_squared {
return SERVER_TYPE eq 'wp2';
}
sub get_producttype {
return $NODE_MODE if defined $NODE_MODE;
return 'DNSONLY' unless _read_license();
return 'STANDARD' if $PRODUCTS{'cpanel'};
foreach my $product (qw/dnsnode mailnode databasenode dnsonly/) {
return uc($product) if $PRODUCTS{$product};
}
return 'DNSONLY';
}
sub get_max_users {
return $MAXUSERS if defined $MAXUSERS;
return NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE unless _read_license();
return $MAXUSERS // NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE;
}
sub get_license_expire_gmt_date {
return $FIELDS{'license_expire_gmt_date'} if defined $FIELDS{'license_expire_gmt_date'};
return 0 unless _read_license();
return $FIELDS{'license_expire_gmt_date'} // 0;
}
sub is_licensed_for_product ($product) {
return unless $product;
$product = lc $product;
return unless _read_license();
return exists $PRODUCTS{$product};
}
sub get_features {
return unless _read_license();
my @features = split( ",", $FIELDS{'features'} // '' );
return @features;
}
sub has_feature ( $feature = undef ) {
length $feature or return;
return ( grep { $_ eq $feature } get_features() ) ? 1 : 0;
}
sub get_products {
return unless _read_license();
return keys %PRODUCTS;
}
sub _read_license {
my $LICENSE_FILE = _get_license_file_path();
my @new_stat = stat($LICENSE_FILE) if @server_config;
if ( @server_config && @new_stat && $new_stat[9] == $server_config[9] && $new_stat[7] == $server_config[7] ) {
return 1;
}
open( my $fh, '<', $LICENSE_FILE ) or do {
if ( $! != _ENOENT() ) {
warn "open($LICENSE_FILE): $!";
}
return;
};
_reset_cache();
my $content;
read( $fh, $content, 1024 ) // do {
warn "read($LICENSE_FILE): $!";
$content = q<>;
};
return _parse_license_contents_sr( $fh, \$content );
}
sub _parse_license_contents_to_hashref ($content_sr) {
my %vals = map { ( split( m{: }, $_ ) )[ 0, 1 ] } split( m{\n}, $$content_sr );
return \%vals;
}
sub _parse_license_contents_sr ( $fh, $content_sr ) {
my $vals_hr = _parse_license_contents_to_hashref($content_sr);
if ( length $vals_hr->{'products'} ) {
%PRODUCTS = map { ( $_ => 1 ) } split( ",", $vals_hr->{'products'} );
}
else {
return;
}
if ( length $vals_hr->{'maxusers'} ) {
$MAXUSERS //= int $vals_hr->{'maxusers'};
}
else {
return;
}
foreach my $field (qw/license_expire_time license_expire_gmt_date support_expire_time updates_expire_time/) {
$FIELDS{$field} = $vals_hr->{$field} // 0;
}
foreach my $field (qw/client features/) {
$FIELDS{$field} = $vals_hr->{$field} // '';
}
if ( length $vals_hr->{'fields'} ) {
foreach my $field ( split( ",", $vals_hr->{'fields'} ) ) {
my ( $k, $v ) = split( '=', $field, 2 );
$FIELDS{$k} = $v;
}
}
else {
return;
}
@server_config = stat($fh);
return 1;
}
sub _reset_cache {
undef %PRODUCTS;
undef %FIELDS;
undef @server_config;
undef $MAXUSERS;
undef $DNSONLY_MODE;
return;
}
1;
} # --- END Cpanel/Server/Type.pm
{ # --- BEGIN Cpanel/Server/Type/Profile/Constants.pm
package Cpanel::Server::Type::Profile::Constants;
use strict;
use warnings;
no warnings 'once';
use constant {
DNSNODE => "DNSNODE",
DATABASENODE => "DATABASENODE",
DNSONLY => "DNSONLY",
MAILNODE => "MAILNODE",
STANDARD => "STANDARD"
};
our %PROFILE_CHILD_WORKLOADS = (
MAILNODE() => ['Mail'],
);
1;
} # --- END Cpanel/Server/Type/Profile/Constants.pm
{ # --- BEGIN Cpanel/Validate/AnyAllMatcher.pm
package Cpanel::Validate::AnyAllMatcher;
use cPstrict;
no warnings 'once';
sub match {
my ( $args, $callback ) = @_;
if ( !defined $args ) {
require Cpanel::Exception;
die Cpanel::Exception::create( 'MissingParameter', 'No parameter value specified.' );
}
if ( !defined $callback ) {
require Cpanel::Exception;
die Cpanel::Exception::create( 'MissingParameter', 'No callback specified.' );
}
if ( !ref $args ) {
return $callback->($args) ? 1 : 0;
}
elsif ( ref $args eq 'HASH' ) {
my $match = $args->{match} || 'all';
my $items = $args->{items};
if ( $match ne 'any' && $match ne 'all' && $match ne 'none' ) {
require Cpanel::Exception;
die Cpanel::Exception::create( 'InvalidParameter', 'The “[_1]” parameter must be “[_2]”, “[_3]” or “[_4]” value.', [qw(match any all none)] );
}
if ( !$items || ref $items ne 'ARRAY' ) {
require Cpanel::Exception;
die Cpanel::Exception::create( 'InvalidParameter', 'The “[_1]” parameter must be an array reference.', ["items"] );
}
foreach my $item (@$items) {
my $bool = $callback->($item);
return 1 if $bool && $match eq 'any';
return 0 if $bool && $match eq 'none';
return 0 if !$bool && $match eq 'all';
}
return $match eq 'any' ? 0 : 1;
}
require Cpanel::Exception;
die Cpanel::Exception::create( 'InvalidParameter', 'The input parameter must be a string or a hash reference.' );
}
1;
} # --- END Cpanel/Validate/AnyAllMatcher.pm
{ # --- BEGIN Cpanel/Server/Type/Profile.pm
package Cpanel::Server::Type::Profile;
use cPstrict;
no warnings 'once';
# use Cpanel::Server::Type (); # PPI USE OK # perlpkg line 211
# use Cpanel::Server::Type::Profile::Constants (); # PPI USE OK # perlpkg line 211
our %ENABLED_IN_ALL_PROFILES = (
'Cpanel::Server::Type::Role::JetBackup' => 1,
'Cpanel::Server::Type::Role::LiteSpeed' => 1,
'Cpanel::Server::Type::Role::MailSend' => 1,
'Cpanel::Server::Type::Role::MailLocal' => 1,
'Cpanel::Server::Type::Role::RegularCpanel' => 1,
'Cpanel::Server::Type::Role::Reseller' => 1,
);
use constant all_roles => sort map { 'Cpanel::Server::Type::Role::' . $_ } qw/
CalendarContact
DNS
FTP
FileStorage
LiteSpeed
JetBackup
MailLocal
MailReceive
MailRelay
MailSend
MySQL
Postgres
RegularCpanel
Reseller
SpamFilter
Webmail
WebDisk
WebServer
/;
our %_META = (
STANDARD => {
experimental => 0,
enabled_roles => [all_roles]
},
MAILNODE => {
experimental => 0,
enabled_roles => [
qw(
Cpanel::Server::Type::Role::CalendarContact
Cpanel::Server::Type::Role::MailReceive
Cpanel::Server::Type::Role::MailRelay
Cpanel::Server::Type::Role::Webmail
), keys %ENABLED_IN_ALL_PROFILES
],
optional_roles => [
qw(
Cpanel::Server::Type::Role::MySQL
Cpanel::Server::Type::Role::Postgres
Cpanel::Server::Type::Role::DNS
Cpanel::Server::Type::Role::SpamFilter
)
]
},
DNSNODE => {
experimental => 0,
enabled_roles => [
qw(
Cpanel::Server::Type::Role::DNS
), keys %ENABLED_IN_ALL_PROFILES
],
optional_roles => [
qw(
Cpanel::Server::Type::Role::MySQL
Cpanel::Server::Type::Role::MailRelay
)
],
},
DATABASENODE => {
experimental => 1,
enabled_roles => [
qw(
Cpanel::Server::Type::Role::MySQL
), keys %ENABLED_IN_ALL_PROFILES
],
optional_roles => [
qw(
Cpanel::Server::Type::Role::Postgres
)
]
}
);
our ( $DNSNODE_MODE, $MAILNODE_MODE, $DATABASENODE_MODE );
my $_CURRENT_PROFILE;
sub get_current_profile {
return $_CURRENT_PROFILE if defined $_CURRENT_PROFILE;
my $product_type = Cpanel::Server::Type::get_producttype();
if ( $product_type && $product_type ne Cpanel::Server::Type::Profile::Constants::STANDARD() ) {
return $_CURRENT_PROFILE = $product_type;
}
my $roles = {};
require Cpanel::LoadModule;
PROFILE: foreach my $profile ( keys %_META ) {
next if $profile eq Cpanel::Server::Type::Profile::Constants::STANDARD();
my $disabled_roles_ar = get_disabled_roles_for_profile($profile);
if ($disabled_roles_ar) {
foreach my $role (@$disabled_roles_ar) {
if ( !exists $roles->{$role} ) {
Cpanel::LoadModule::load_perl_module($role);
$roles->{$role} = $role->is_enabled();
}
next PROFILE if $roles->{$role};
}
}
if ( $_META{$profile}{enabled_roles} ) {
foreach my $role ( @{ $_META{$profile}{enabled_roles} } ) {
if ( !exists $roles->{$role} ) {
Cpanel::LoadModule::load_perl_module($role);
$roles->{$role} = $role->is_enabled();
}
next PROFILE if !$roles->{$role};
}
}
return $_CURRENT_PROFILE = $profile;
}
return $_CURRENT_PROFILE = Cpanel::Server::Type::Profile::Constants::STANDARD();
}
sub current_profile_matches {
my ($profiles_ar) = @_;
$profiles_ar = [$profiles_ar] if 'ARRAY' ne ref $profiles_ar;
my $current_profile = get_current_profile();
return grep { $_ eq $current_profile } @{$profiles_ar};
}
sub is_valid_for_profile ($rule) {
if ( ref $rule ne 'HASH' ) {
return current_profile_matches($rule);
}
if ( !ref $rule->{items} ) {
require Data::Dumper;
die q[Invalid rule 'missing items entry' ] . Data::Dumper::Dumper($rule);
}
require Cpanel::Validate::AnyAllMatcher;
return Cpanel::Validate::AnyAllMatcher::match( $rule, \¤t_profile_matches );
}
my $_loaded_descriptions;
sub get_meta {
if ($_loaded_descriptions) {
foreach my $profile ( keys %_META ) {
delete @{ $_META{$profile} }{qw(name description)};
$_loaded_descriptions = 0;
}
}
return \%_META;
}
sub get_meta_with_descriptions {
if ( !$_loaded_descriptions ) {
require 'Cpanel/Server/Type/Profile/Descriptions.pm'; ## no critic qw(Bareword) - hide from perlpkg
my $add_hr = \%Cpanel::Server::Type::Profile::Descriptions::_META;
foreach my $profile ( keys %$add_hr ) {
@{ $_META{$profile} }{ keys %{ $add_hr->{$profile} } } = values %{ $add_hr->{$profile} };
}
}
return \%_META;
}
sub get_disabled_roles_for_profile {
my ($profile) = @_;
my $all_possible_roles = get_all_possible_roles();
my $meta = get_meta(); # call get_meta since it may be mocked
die "No META for profile “$profile”!" if !defined $meta->{$profile};
my %profile_roles = map { $_ => 1 } ( ( $meta->{$profile}{enabled_roles} ? @{ $meta->{$profile}{enabled_roles} } : () ), ( $meta->{$profile}{optional_roles} ? @{ $meta->{$profile}{optional_roles} } : () ) );
my @disabled_roles = grep { !$profile_roles{$_} } @$all_possible_roles;
return @disabled_roles ? \@disabled_roles : undef;
}
sub get_all_possible_roles {
return [all_roles];
}
sub get_service_subdomains_for_profile {
my ($profile) = @_;
my $meta = get_meta(); # call get_meta since it may be mocked
die "No META for profile “$profile”!" if !defined $meta->{$profile};
my @profile_roles = ( ( $meta->{$profile}{enabled_roles} ? @{ $meta->{$profile}{enabled_roles} } : () ), ( $meta->{$profile}{optional_roles} ? @{ $meta->{$profile}{optional_roles} } : () ) );
require 'Cpanel/Server/Type/Change/Backend.pm'; ## no critic qw(Bareword) - hide from perlpkg
my @service_subdomains;
push @service_subdomains, Cpanel::Server::Type::Change::Backend::get_role_service_subs($_) for @profile_roles;
return \@service_subdomains;
}
sub _reset_cache {
undef $_CURRENT_PROFILE;
return;
}
1;
} # --- END Cpanel/Server/Type/Profile.pm
{ # --- BEGIN Cpanel/Server/Type/Role/EnabledCache.pm
package Cpanel::Server::Type::Role::EnabledCache;
use cPstrict;
no warnings 'once';
use Carp ();
my %_THE_CACHE;
sub set ( $class, $value ) {
_validate_class($class);
if ( $value ne '0' && $value ne '1' ) {
_confess("Value must be 0 or 1, not “$value”.");
}
return $_THE_CACHE{$class} = $value;
}
sub get ($class) {
_validate_class($class);
return $_THE_CACHE{$class};
}
sub unset ($class) {
_validate_class($class);
return delete $_THE_CACHE{$class};
}
sub _confess ($msg) {
local $Carp::Internal{ (__PACKAGE__) } = 1;
return Carp::confess($msg);
}
sub _validate_class ($class) {
_confess("Give a class name, not $class!") if ref $class;
return;
}
sub _unset_all () {
%_THE_CACHE = ();
return;
}
1;
} # --- END Cpanel/Server/Type/Role/EnabledCache.pm
{ # --- BEGIN Cpanel/Server/Type/Role.pm
package Cpanel::Server::Type::Role;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Server::Type::Profile (); # perlpkg line 211
# use Cpanel::Server::Type::Profile::Constants (); # perlpkg line 211
# use Cpanel::Server::Type (); # perlpkg line 211
# use Cpanel::Server::Type::Role::EnabledCache (); # perlpkg line 211
sub new {
return bless {}, $_[0];
}
sub is_enabled {
my ($obj_or_class) = @_;
my $ref = ref($obj_or_class) || $obj_or_class;
my $product_type = Cpanel::Server::Type::get_producttype();
if ( $product_type eq Cpanel::Server::Type::Profile::Constants::DNSONLY() ) {
return Cpanel::Server::Type::Role::EnabledCache::set( $ref, 1 );
}
if ( $product_type ne Cpanel::Server::Type::Profile::Constants::STANDARD() ) {
my $META = Cpanel::Server::Type::Profile::get_meta();
return Cpanel::Server::Type::Role::EnabledCache::set( $ref, 1 ) if grep { $_ eq $ref } @{ $META->{$product_type}{enabled_roles} };
return Cpanel::Server::Type::Role::EnabledCache::set( $ref, 0 ) if !grep { $_ eq $ref } @{ $META->{$product_type}{optional_roles} };
}
my $val = Cpanel::Server::Type::Role::EnabledCache::get($ref);
$val //= Cpanel::Server::Type::Role::EnabledCache::set(
$ref,
$obj_or_class->is_available() && $obj_or_class->_is_enabled() ? 1 : 0,
);
return $val;
}
our %_AVAILABLE_CACHE;
sub is_available {
my ($obj_or_class) = @_;
my $ref = ref($obj_or_class) || $obj_or_class;
return $_AVAILABLE_CACHE{$ref} //= $obj_or_class->_is_available();
}
sub verify_enabled {
my ($class) = @_;
if ( !$class->is_enabled() ) {
my $role = substr( $class, 1 + rindex( $class, ':' ) );
require Cpanel::Exception;
die Cpanel::Exception::create( 'System::RequiredRoleDisabled', [ role => $role ] );
}
return;
}
sub SERVICES { return [] }
sub RESTART_SERVICES { return [] }
sub SERVICE_SUBDOMAINS {
return shift()->_SERVICE_SUBDOMAINS();
}
use constant _SERVICE_SUBDOMAINS => [];
sub RPM_TARGETS {
return shift()->_RPM_TARGETS();
}
use constant _RPM_TARGETS => [];
sub _is_available { return 1 }
sub _NAME {
require Cpanel::Exception;
die Cpanel::Exception::create( 'AbstractClass', [__PACKAGE__] );
}
*_DESCRIPTION = *_NAME;
1;
} # --- END Cpanel/Server/Type/Role.pm
{ # --- BEGIN Cpanel/Server/Type/Role/TouchFileRole.pm
package Cpanel::Server::Type::Role::TouchFileRole;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Server::Type::Role (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Server::Type::Role); }
our $ROLES_TOUCHFILE_BASE_PATH = "/var/cpanel/disabled_roles";
sub _is_enabled {
return !$_[0]->check_touchfile();
}
sub check_touchfile {
require Cpanel::Autodie;
return Cpanel::Autodie::exists( $_[0]->_TOUCHFILE() );
}
sub _TOUCHFILE {
require Cpanel::Exception;
die Cpanel::Exception::create( 'AbstractClass', [__PACKAGE__] );
}
1;
} # --- END Cpanel/Server/Type/Role/TouchFileRole.pm
{ # --- BEGIN Cpanel/Server/Type/Role/MailRelay.pm
package Cpanel::Server::Type::Role::MailRelay;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Server::Type::Role::TouchFileRole (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Server::Type::Role::TouchFileRole); }
my ( $NAME, $DESCRIPTION );
our $TOUCHFILE = $Cpanel::Server::Type::Role::TouchFileRole::ROLES_TOUCHFILE_BASE_PATH . "/mailrelay";
our $SERVICES = [
'exim',
'exim-altport',
];
sub _NAME {
require 'Cpanel/LocaleString.pm'; ## no critic qw(Bareword) - hide from perlpkg
$NAME ||= Cpanel::LocaleString->new("Relay Mail");
return $NAME;
}
sub _DESCRIPTION {
require 'Cpanel/LocaleString.pm'; ## no critic qw(Bareword) - hide from perlpkg
$DESCRIPTION ||= Cpanel::LocaleString->new("This role allows users to relay email through this server.");
return $DESCRIPTION;
}
sub _TOUCHFILE { return $TOUCHFILE; }
sub SERVICES { return $SERVICES; }
1;
} # --- END Cpanel/Server/Type/Role/MailRelay.pm
{ # --- BEGIN Cpanel/Server/Type/Role/MailSend.pm
package Cpanel::Server::Type::Role::MailSend;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Server::Type::Role::TouchFileRole (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Server::Type::Role::TouchFileRole); }
my ( $NAME, $DESCRIPTION );
our $TOUCHFILE = $Cpanel::Server::Type::Role::TouchFileRole::ROLES_TOUCHFILE_BASE_PATH . "/mailsend";
our $SERVICES = [
'exim',
'exim-altport',
];
sub _NAME {
require 'Cpanel/LocaleString.pm'; ## no critic qw(Bareword) - hide from perlpkg
$NAME ||= Cpanel::LocaleString->new("Send Mail");
return $NAME;
}
sub _DESCRIPTION {
require 'Cpanel/LocaleString.pm'; ## no critic qw(Bareword) - hide from perlpkg
$DESCRIPTION ||= Cpanel::LocaleString->new("Send Mail allows users to send email.");
return $DESCRIPTION;
}
sub _TOUCHFILE { return $TOUCHFILE; }
sub SERVICES { return $SERVICES; }
1;
} # --- END Cpanel/Server/Type/Role/MailSend.pm
package main;