#!/usr/local/cpanel/3rdparty/bin/perl BEGIN { # Suppress load of all of these at earliest point. $INC{'cPstrict.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Try/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'HTTP/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'File/Path/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/SysPerlBootstrap.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ExceptionMessage.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Fallback.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ExceptionMessage/Raw.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadModule/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ScalarUtil.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Exception/CORE.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadModule.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Linux.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Almalinux.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel6.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel7.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Almalinux8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Centos.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Centos7.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux6.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux7.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Ubuntu.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Ubuntu20.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rocky.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rocky8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/All.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/TimeHiRes.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Struct/Common/Time.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Struct/timespec.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/NanoStat.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/NanoUtime.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HiRes.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Env.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Autodie.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Fcntl/Constants.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Fcntl.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Touch.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/TouchFileBase.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Update/IsCron.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Time/Local.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Open.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Parser/Vars.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Encoder/Tiny/Rare.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Encoder/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Regex.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Carp.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Set.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeFileLock.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FHUtils/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Hash.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeFile/LockInfoCache.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeFile/LockWatcher.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Context.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Pack.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Syscall.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Inotify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Linux/Constants.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Validate/FilesystemNodeName.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Notify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Server/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Logger.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Debug.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeDir/MK.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FHUtils/Autoflush.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Update/Logger.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/TouchFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadFile/ReadFast.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Usage.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/UPID.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Unix/PID/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/JSON/Unicode.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Encoder/ASCII.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/UTF8/Strict.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/JSON.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/JSON/FailOK.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ConfigFiles.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Destruct.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Finally.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Readlink.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Write.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Write/JSON/Lazy.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/I18N/LangTags.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/I18N/LangTags/Detect.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locale/Maketext.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Normalize.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locales/Legacy.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locales/DB/LocaleDisplayPattern/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locales/DB/CharacterOrientation/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locales/Compile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locales.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CPAN/Locale/Maketext/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Paths.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/DB/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AdminBin/Serializer.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AdminBin/Serializer/FailOK.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/Constants.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Imports.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SSL/KeyTypeLabel.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SSL/DefaultKey/Constants.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUser/Defaults.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Hash/JSONable.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUser/Object.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SV.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Path/Normalize.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Hash/Stringify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Umask.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadConfig.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadWwwAcctConf.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Conf.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadCpUserFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/HasCpUserFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/NSCD/Constants.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Socket/UNIX/Micro.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/NSCD/Check.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwCache/Helpers.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwCache/Cache.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwCache/Find.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwCache/Build.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwCache.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/User.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Cookies.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeDir/Read.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ArrayFunc/Uniq.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Charmap.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/StringFunc/Case.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Legacy.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadCpUserFile/CurrentUser.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/YAML/Syck.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PwUtils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AccessIds/Normalize.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AccessIds/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AccessIds/ReducedPrivileges.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/DataStore.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/StringFunc/Trim.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/3rdparty.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/JS/Variations.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Display.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/Api1.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Lines.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeRun/Simple.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeRun/Errors.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Timezones.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/DateTime.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Time/ISO.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadUserDomains/Count.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Server/Type.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadUserDomains.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUser.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/FlushConfig.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUser/Write.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LinkedNode/Worker/Storage.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeFile/Replace.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUserGuard.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale/Utils/User/Modify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Version/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Version/Full.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Version/Compare.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Version.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Locale.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Sys/Uname.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Sys/Hostname/Fallback.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Sys/Hostname.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Hostname.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpConfGuard/CORE.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpConfGuard.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/LoadCpConf.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Maxmem.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OSSys/Bits.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Sys/Rlimit.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Rlimit.pm'} = '/usr/local/cpanel/scripts/upcp.static'; } { # --- BEGIN File::Path::Tiny package File::Path::Tiny; use strict; use warnings; use Cwd qw(cwd chdir); use Carp (); $File::Path::Tiny::VERSION = "1.0"; sub mk { my ( $path, $mask ) = @_; return 2 if -d $path; if ( -e $path ) { $! = 20; return; } $mask ||= '0777'; # Perl::Critic == Integer with leading zeros at ... $mask = oct($mask) if substr( $mask, 0, 1 ) eq '0'; require File::Spec; my ( $vol, $directories ) = File::Spec->splitpath( $path, 1 ); my @dirs = File::Spec->splitdir($directories); my @list; while ( my ($_dir) = shift @dirs ) { last if not defined $_dir; push @list, $_dir; next if ( $_dir eq '' ); my $progressive = File::Spec->catpath( $vol, File::Spec->catdir(@list), '' ); if ( !-d $progressive ) { mkdir( $progressive, $mask ) or -d $progressive or return; } } return 1 if -d $path; return; } sub rm { my ( $path, $fast ) = @_; my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ]; if ( -e _ && !-d _ ) { $! = 20; return; } return 2 if !-d _; empty_dir( $path, $fast ) or return; _bail_if_changed( $path, $orig_dev, $orig_ino ); rmdir($path) or !-e $path or return; return 1; } sub empty_dir { my ( $path, $fast ) = @_; my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ]; if ( -e _ && !-d _ ) { $! = 20; return; } my ( $starting_point, $starting_dev, $starting_ino ); if ( !$fast ) { $starting_point = cwd(); ( $starting_dev, $starting_ino ) = ( lstat $starting_point )[ 0, 1 ]; chdir($path) or Carp::croak("Failed to change directory to “$path”: $!"); $path = '.'; _bail_if_changed( $path, $orig_dev, $orig_ino ); } opendir( my $dh, $path ) or return; my @contents = grep { $_ ne '.' && $_ ne '..' } readdir($dh); closedir $dh; _bail_if_changed( $path, $orig_dev, $orig_ino ); require File::Spec if @contents; for my $thing (@contents) { my $long = File::Spec->catdir( $path, $thing ); if ( !-l $long && -d _ ) { _bail_if_changed( $path, $orig_dev, $orig_ino ); rm( $long, $fast ) or !-e $long or return; } else { _bail_if_changed( $path, $orig_dev, $orig_ino ); unlink $long or !-e $long or return; } } _bail_if_changed( $path, $orig_dev, $orig_ino ); if ( !$fast ) { chdir($starting_point) or Carp::croak("Failed to change directory to “$starting_point”: $!"); _bail_if_changed( ".", $starting_dev, $starting_ino ); } return 1; } sub mk_parent { my ( $path, $mode ) = @_; $path =~ s{/+$}{}; require File::Spec; my ( $v, $d, $f ) = File::Spec->splitpath( $path, 1 ); my @p = File::Spec->splitdir($d); # pop() is probably cheaper here, benchmark? $d = File::Spec->catdir(@p[0--$#p-1]); pop @p; $d = File::Spec->catdir(@p); my $parent = File::Spec->catpath( $v, $d, $f ); return mk( $parent, $mode ); } sub _bail_if_changed { my ( $path, $orig_dev, $orig_ino ) = @_; my ( $cur_dev, $cur_ino ) = ( lstat $path )[ 0, 1 ]; if ( !defined $cur_dev || !defined $cur_ino ) { $cur_dev ||= "undef(path went away?)"; $cur_ino ||= "undef(path went away?)"; } else { $path = Cwd::abs_path($path); } if ( $orig_dev ne $cur_dev || $orig_ino ne $cur_ino ) { local $Carp::CarpLevel += 1; Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting"); } } 1; } # --- END File::Path::Tiny { # --- BEGIN HTTP::Tiny # vim: ts=4 sts=4 sw=4 et: package HTTP::Tiny; use strict; use warnings; # ABSTRACT: A small, simple, correct HTTP/1.1 client our $VERSION = '0.080'; sub _croak { require Carp; Carp::croak(@_) } #pod =method new #pod #pod $http = HTTP::Tiny->new( %attributes ); #pod #pod This constructor returns a new HTTP::Tiny object. Valid attributes include: #pod #pod =for :list #pod * C — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If #pod C — ends in a space character, the default user-agent string is #pod appended. #pod * C — An instance of L — or equivalent class #pod that supports the C and C methods #pod * C — A hashref of default headers to apply to requests #pod * C — The local IP address to bind to #pod * C — Whether to reuse the last connection (if for the same #pod scheme, host and port) (defaults to 1) #pod * C — Maximum number of redirects allowed (defaults to 5) #pod * C — Maximum response size in bytes (only when not using a data #pod callback). If defined, requests with responses larger than this will return #pod a 599 status code. #pod * C — URL of a proxy server to use for HTTP connections #pod (default is C<$ENV{http_proxy}> — if set) #pod * C — URL of a proxy server to use for HTTPS connections #pod (default is C<$ENV{https_proxy}> — if set) #pod * C — URL of a generic proxy server for both HTTP and HTTPS #pod connections (default is C<$ENV{all_proxy}> — if set) #pod * C — List of domain suffixes that should not be proxied. Must #pod be a comma-separated string or an array reference. (default is #pod C<$ENV{no_proxy}> —) #pod * C — Request timeout in seconds (default is 60) If a socket open, #pod read or write takes longer than the timeout, the request response status code #pod will be 599. #pod * C — A boolean that indicates whether to validate the SSL #pod certificate of an C — connection (default is false) #pod * C — A hashref of C — options to pass through to #pod L #pod #pod An accessor/mutator method exists for each attribute. #pod #pod Passing an explicit C for C, C or C will #pod prevent getting the corresponding proxies from the environment. #pod #pod Errors during request execution will result in a pseudo-HTTP status code of 599 #pod and a reason of "Internal Exception". The content field in the response will #pod contain the text of the error. #pod #pod The C parameter enables a persistent connection, but only to a #pod single destination scheme, host and port. If any connection-relevant #pod attributes are modified via accessor, or if the process ID or thread ID change, #pod the persistent connection will be dropped. If you want persistent connections #pod across multiple destinations, use multiple HTTP::Tiny objects. #pod #pod See L for more on the C and C attributes. #pod #pod =cut my @attributes; BEGIN { @attributes = qw( cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy SSL_options verify_SSL ); my %persist_ok = map {; $_ => 1 } qw( cookie_jar default_headers max_redirect max_size ); no strict 'refs'; no warnings 'uninitialized'; for my $accessor ( @attributes ) { *{$accessor} = sub { @_ > 1 ? do { delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor}; $_[0]->{$accessor} = $_[1] } : $_[0]->{$accessor}; }; } } sub agent { my($self, $agent) = @_; if( @_ > 1 ){ $self->{agent} = (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent; } return $self->{agent}; } sub timeout { my ($self, $timeout) = @_; if ( @_ > 1 ) { $self->{timeout} = $timeout; if ($self->{handle}) { $self->{handle}->timeout($timeout); } } return $self->{timeout}; } sub new { my($class, %args) = @_; my $self = { max_redirect => 5, timeout => defined $args{timeout} ? $args{timeout} : 60, keep_alive => 1, verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default no_proxy => $ENV{no_proxy}, }; bless $self, $class; $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar}; for my $key ( @attributes ) { $self->{$key} = $args{$key} if exists $args{$key} } $self->agent( exists $args{agent} ? $args{agent} : $class->_agent ); $self->_set_proxies; return $self; } sub _set_proxies { my ($self) = @_; # get proxies from %ENV only if not provided; explicit undef will disable # getting proxies from the environment # generic proxy if (! exists $self->{proxy} ) { $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY}; } if ( defined $self->{proxy} ) { $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate } else { delete $self->{proxy}; } # http proxy if (! exists $self->{http_proxy} ) { # under CGI, bypass HTTP_PROXY as request sets it from Proxy header local $ENV{HTTP_PROXY} = ($ENV{CGI_HTTP_PROXY} || "") if $ENV{REQUEST_METHOD}; $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy}; } if ( defined $self->{http_proxy} ) { $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate $self->{_has_proxy}{http} = 1; } else { delete $self->{http_proxy}; } # https proxy if (! exists $self->{https_proxy} ) { $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy}; } if ( $self->{https_proxy} ) { $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate $self->{_has_proxy}{https} = 1; } else { delete $self->{https_proxy}; } # Split no_proxy to array reference if not provided as such unless ( ref $self->{no_proxy} eq 'ARRAY' ) { $self->{no_proxy} = (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : []; } return; } #pod =method get|head|put|post|patch|delete #pod #pod $response = $http->get($url); #pod $response = $http->get($url, \%options); #pod $response = $http->head($url); #pod #pod These methods are shorthand for calling C for the given method. The #pod URL must have unsafe characters escaped and international domain names encoded. #pod See C for valid options and a description of the response. #pod #pod The C field of the response will be true if the status code is 2XX. #pod #pod =cut for my $sub_name ( qw/get head put post patch delete/ ) { my $req_method = uc $sub_name; no strict 'refs'; eval <<"HERE"; ## no critic sub $sub_name { my (\$self, \$url, \$args) = \@_; \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH') or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n"); return \$self->request('$req_method', \$url, \$args || {}); } HERE } #pod =method post_form #pod #pod $response = $http->post_form($url, $form_data); #pod $response = $http->post_form($url, $form_data, \%options); #pod #pod This method executes a C request and sends the key/value pairs from a #pod form data hash or array reference to the given URL with a C of #pod C. If data is provided as an array #pod reference, the order is preserved; if provided as a hash reference, the terms #pod are sorted on key and value for consistency. See documentation for the #pod C method for details on the encoding. #pod #pod The URL must have unsafe characters escaped and international domain names #pod encoded. See C for valid options and a description of the response. #pod Any C header or content in the options hashref will be ignored. #pod #pod The C field of the response will be true if the status code is 2XX. #pod #pod =cut sub post_form { my ($self, $url, $data, $args) = @_; (@_ == 3 || @_ == 4 && ref $args eq 'HASH') or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n"); my $headers = {}; while ( my ($key, $value) = each %{$args->{headers} || {}} ) { $headers->{lc $key} = $value; } delete $args->{headers}; return $self->request('POST', $url, { %$args, content => $self->www_form_urlencode($data), headers => { %$headers, 'content-type' => 'application/x-www-form-urlencoded' }, } ); } #pod =method mirror #pod #pod $response = $http->mirror($url, $file, \%options) #pod if ( $response->{success} ) { #pod print "$file is up to date\n"; #pod } #pod #pod Executes a C request for the URL and saves the response body to the file #pod name provided. The URL must have unsafe characters escaped and international #pod domain names encoded. If the file already exists, the request will include an #pod C header with the modification timestamp of the file. You #pod may specify a different C header yourself in the C<< #pod $options->{headers} >> hash. #pod #pod The C field of the response will be true if the status code is 2XX #pod or if the status code is 304 (unmodified). #pod #pod If the file was modified and the server response includes a properly #pod formatted C header, the file modification time will #pod be updated accordingly. #pod #pod =cut sub mirror { my ($self, $url, $file, $args) = @_; @_ == 3 || (@_ == 4 && ref $args eq 'HASH') or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n"); if ( exists $args->{headers} ) { my $headers = {}; while ( my ($key, $value) = each %{$args->{headers} || {}} ) { $headers->{lc $key} = $value; } $args->{headers} = $headers; } if ( -e $file and my $mtime = (stat($file))[9] ) { $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime); } my $tempfile = $file . int(rand(2**31)); require Fcntl; sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY() or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/); binmode $fh; $args->{data_callback} = sub { print {$fh} $_[0] }; my $response = $self->request('GET', $url, $args); close $fh or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/); if ( $response->{success} ) { rename $tempfile, $file or _croak(qq/Error replacing $file with $tempfile: $!\n/); my $lm = $response->{headers}{'last-modified'}; if ( $lm and my $mtime = $self->_parse_http_date($lm) ) { utime $mtime, $mtime, $file; } } $response->{success} ||= $response->{status} eq '304'; unlink $tempfile; return $response; } #pod =method request #pod #pod $response = $http->request($method, $url); #pod $response = $http->request($method, $url, \%options); #pod #pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST', #pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and #pod international domain names encoded. #pod #pod B: Method names are B per the HTTP/1.1 specification. #pod Don't use C when you really want C. See L for #pod how this applies to redirection. #pod #pod If the URL includes a "user:password" stanza, they will be used for Basic-style #pod authorization headers. (Authorization headers will not be included in a #pod redirected request.) For example: #pod #pod $http->request('GET', 'http://Aladdin:open sesame@example.com/'); #pod #pod If the "user:password" stanza contains reserved characters, they must #pod be percent-escaped: #pod #pod $http->request('GET', 'http://john%40example.com:password@example.com/'); #pod #pod A hashref of options may be appended to modify the request. #pod #pod Valid options are: #pod #pod =for :list #pod * C — #pod A hashref containing headers to include with the request. If the value for #pod a header is an array reference, the header will be output multiple times with #pod each value in the array. These headers over-write any default headers. #pod * C — #pod A scalar to include as the body of the request OR a code reference #pod that will be called iteratively to produce the body of the request #pod * C — #pod A code reference that will be called if it exists to provide a hashref #pod of trailing headers (only used with chunked transfer-encoding) #pod * C — #pod A code reference that will be called for each chunks of the response #pod body received. #pod * C — #pod Override host resolution and force all connections to go only to a #pod specific peer address, regardless of the URL of the request. This will #pod include any redirections! This options should be used with extreme #pod caution (e.g. debugging or very special circumstances). It can be given as #pod either a scalar or a code reference that will receive the hostname and #pod whose response will be taken as the address. #pod #pod The C header is generated from the URL in accordance with RFC 2616. It #pod is a fatal error to specify C in the C option. Other headers #pod may be ignored or overwritten if necessary for transport compliance. #pod #pod If the C option is a code reference, it will be called iteratively #pod to provide the content body of the request. It should return the empty #pod string or undef when the iterator is exhausted. #pod #pod If the C option is the empty string, no C or #pod C headers will be generated. #pod #pod If the C option is provided, it will be called iteratively until #pod the entire response body is received. The first argument will be a string #pod containing a chunk of the response body, the second argument will be the #pod in-progress response hash reference, as described below. (This allows #pod customizing the action of the callback based on the C or C #pod received prior to the content body.) #pod #pod The C method returns a hashref containing the response. The hashref #pod will have the following keys: #pod #pod =for :list #pod * C — #pod Boolean indicating whether the operation returned a 2XX status code #pod * C — #pod URL that provided the response. This is the URL of the request unless #pod there were redirections, in which case it is the last URL queried #pod in a redirection chain #pod * C — #pod The HTTP status code of the response #pod * C — #pod The response phrase returned by the server #pod * C — #pod The body of the response. If the response does not have any content #pod or if a data callback is provided to consume the response body, #pod this will be the empty string #pod * C — #pod A hashref of header fields. All header field names will be normalized #pod to be lower case. If a header is repeated, the value will be an arrayref; #pod it will otherwise be a scalar string containing the value #pod * C - #pod If this field exists, it is the protocol of the response #pod such as HTTP/1.0 or HTTP/1.1 #pod * C #pod If this field exists, it is an arrayref of response hash references from #pod redirects in the same order that redirections occurred. If it does #pod not exist, then no redirections occurred. #pod #pod On an error during the execution of the request, the C field will #pod contain 599, and the C field will contain the text of the error. #pod #pod =cut my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/; sub request { my ($self, $method, $url, $args) = @_; @_ == 3 || (@_ == 4 && ref $args eq 'HASH') or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n"); $args ||= {}; # we keep some state in this during _request # RFC 2616 Section 8.1.4 mandates a single retry on broken socket my $response; for ( 0 .. 1 ) { $response = eval { $self->_request($method, $url, $args) }; last unless $@ && $idempotent{$method} && $@ =~ m{^(?:Socket closed|Unexpected end|SSL read error)}; } if (my $e = $@) { # maybe we got a response hash thrown from somewhere deep if ( ref $e eq 'HASH' && exists $e->{status} ) { $e->{redirects} = delete $args->{_redirects} if @{ $args->{_redirects} || []}; return $e; } # otherwise, stringify it $e = "$e"; $response = { url => $url, success => q{}, status => 599, reason => 'Internal Exception', content => $e, headers => { 'content-type' => 'text/plain', 'content-length' => length $e, }, ( @{$args->{_redirects} || []} ? (redirects => delete $args->{_redirects}) : () ), }; } return $response; } #pod =method www_form_urlencode #pod #pod $params = $http->www_form_urlencode( $data ); #pod $response = $http->get("http://example.com/query?$params"); #pod #pod This method converts the key/value pairs from a data hash or array reference #pod into a C string. The keys and values from the data #pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an #pod array reference, the key will be repeated with each of the values of the array #pod reference. If data is provided as a hash reference, the key/value pairs in the #pod resulting string will be sorted by key and value for consistent ordering. #pod #pod =cut sub www_form_urlencode { my ($self, $data) = @_; (@_ == 2 && ref $data) or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n"); (ref $data eq 'HASH' || ref $data eq 'ARRAY') or _croak("form data must be a hash or array reference\n"); my @params = ref $data eq 'HASH' ? %$data : @$data; @params % 2 == 0 or _croak("form data reference must have an even number of terms\n"); my @terms; while( @params ) { my ($key, $value) = splice(@params, 0, 2); _croak("form data keys must not be undef") if !defined($key); if ( ref $value eq 'ARRAY' ) { unshift @params, map { $key => $_ } @$value; } else { push @terms, join("=", map { $self->_uri_escape($_) } $key, $value); } } return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) ); } #pod =method can_ssl #pod #pod $ok = HTTP::Tiny->can_ssl; #pod ($ok, $why) = HTTP::Tiny->can_ssl; #pod ($ok, $why) = $http->can_ssl; #pod #pod Indicates if SSL support is available. When called as a class object, it #pod checks for the correct version of L and L. #pod When called as an object methods, if C is true or if C #pod is set in C, it checks that a CA file is available. #pod #pod In scalar context, returns a boolean indicating if SSL is available. #pod In list context, returns the boolean and a (possibly multi-line) string of #pod errors indicating why SSL isn't available. #pod #pod =cut sub can_ssl { my ($self) = @_; my($ok, $reason) = (1, ''); # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback local @INC = @INC; pop @INC if $INC[-1] eq '.'; unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) { $ok = 0; $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/; } # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) { $ok = 0; $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/; } # If an object, check that SSL config lets us get a CA if necessary if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) { my $handle = HTTP::Tiny::Handle->new( SSL_options => $self->{SSL_options}, verify_SSL => $self->{verify_SSL}, ); unless ( eval { $handle->_find_CA_file; 1 } ) { $ok = 0; $reason .= "$@"; } } wantarray ? ($ok, $reason) : $ok; } #pod =method connected #pod #pod $host = $http->connected; #pod ($host, $port) = $http->connected; #pod #pod Indicates if a connection to a peer is being kept alive, per the C #pod option. #pod #pod In scalar context, returns the peer host and port, joined with a colon, or #pod C (if no peer is connected). #pod In list context, returns the peer host and port or an empty list (if no peer #pod is connected). #pod #pod B: This method cannot reliably be used to discover whether the remote #pod host has closed its end of the socket. #pod #pod =cut sub connected { my ($self) = @_; if ( $self->{handle} ) { return $self->{handle}->connected; } return; } #--------------------------------------------------------------------------# # private methods #--------------------------------------------------------------------------# my %DefaultPort = ( http => 80, https => 443, ); sub _agent { my $class = ref($_[0]) || $_[0]; (my $default_agent = $class) =~ s{::}{-}g; my $version = $class->VERSION; $default_agent .= "/$version" if defined $version; return $default_agent; } sub _request { my ($self, $method, $url, $args) = @_; my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url); if ($scheme ne 'http' && $scheme ne 'https') { die(qq/Unsupported URL scheme '$scheme'\n/); } my $request = { method => $method, scheme => $scheme, host => $host, port => $port, host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"), uri => $path_query, headers => {}, }; my $peer = $args->{peer} || $host; # Allow 'peer' to be a coderef. if ('CODE' eq ref $peer) { $peer = $peer->($host); } # We remove the cached handle so it is not reused in the case of redirect. # If all is well, it will be recached at the end of _request. We only # reuse for the same scheme, host and port my $handle = delete $self->{handle}; if ( $handle ) { unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) { $handle->close; undef $handle; } } $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer ); $self->_prepare_headers_and_cb($request, $args, $url, $auth); $handle->write_request($request); my $response; do { $response = $handle->read_response_header } until (substr($response->{status},0,1) ne '1'); $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar}; my @redir_args = $self->_maybe_redirect($request, $response, $args); my $known_message_length; if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) { # response has no message body $known_message_length = 1; } else { # Ignore any data callbacks during redirection. my $cb_args = @redir_args ? +{} : $args; my $data_cb = $self->_prepare_data_cb($response, $cb_args); $known_message_length = $handle->read_body($data_cb, $response); } if ( $self->{keep_alive} && $handle->connected && $known_message_length && $response->{protocol} eq 'HTTP/1.1' && ($response->{headers}{connection} || '') ne 'close' ) { $self->{handle} = $handle; } else { $handle->close; } $response->{success} = substr( $response->{status}, 0, 1 ) eq '2'; $response->{url} = $url; # Push the current response onto the stack of redirects if redirecting. if (@redir_args) { push @{$args->{_redirects}}, $response; return $self->_request(@redir_args, $args); } # Copy the stack of redirects into the response before returning. $response->{redirects} = delete $args->{_redirects} if @{$args->{_redirects}}; return $response; } sub _open_handle { my ($self, $request, $scheme, $host, $port, $peer) = @_; my $handle = HTTP::Tiny::Handle->new( timeout => $self->{timeout}, SSL_options => $self->{SSL_options}, verify_SSL => $self->{verify_SSL}, local_address => $self->{local_address}, keep_alive => $self->{keep_alive} ); if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) { return $self->_proxy_connect( $request, $handle ); } else { return $handle->connect($scheme, $host, $port, $peer); } } sub _proxy_connect { my ($self, $request, $handle) = @_; my @proxy_vars; if ( $request->{scheme} eq 'https' ) { _croak(qq{No https_proxy defined}) unless $self->{https_proxy}; @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} ); if ( $proxy_vars[0] eq 'https' ) { _croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}}); } } else { _croak(qq{No http_proxy defined}) unless $self->{http_proxy}; @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} ); } my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars; if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) { $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth ); } $handle->connect($p_scheme, $p_host, $p_port, $p_host); if ($request->{scheme} eq 'https') { $self->_create_proxy_tunnel( $request, $handle ); } else { # non-tunneled proxy requires absolute URI $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}"; } return $handle; } sub _split_proxy { my ($self, $type, $proxy) = @_; my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) }; unless( defined($scheme) && length($scheme) && length($host) && length($port) && $path_query eq '/' ) { _croak(qq{$type URL must be in format http[s]://[auth@]:/\n}); } return ($scheme, $host, $port, $auth); } sub _create_proxy_tunnel { my ($self, $request, $handle) = @_; $handle->_assert_ssl; my $agent = exists($request->{headers}{'user-agent'}) ? $request->{headers}{'user-agent'} : $self->{agent}; my $connect_request = { method => 'CONNECT', uri => "$request->{host}:$request->{port}", headers => { host => "$request->{host}:$request->{port}", 'user-agent' => $agent, } }; if ( $request->{headers}{'proxy-authorization'} ) { $connect_request->{headers}{'proxy-authorization'} = delete $request->{headers}{'proxy-authorization'}; } $handle->write_request($connect_request); my $response; do { $response = $handle->read_response_header } until (substr($response->{status},0,1) ne '1'); # if CONNECT failed, throw the response so it will be # returned from the original request() method; unless (substr($response->{status},0,1) eq '2') { die $response; } # tunnel established, so start SSL handshake $handle->start_ssl( $request->{host} ); return; } sub _prepare_headers_and_cb { my ($self, $request, $args, $url, $auth) = @_; for ($self->{default_headers}, $args->{headers}) { next unless defined; while (my ($k, $v) = each %$_) { $request->{headers}{lc $k} = $v; $request->{header_case}{lc $k} = $k; } } if (exists $request->{headers}{'host'}) { die(qq/The 'Host' header must not be provided as header option\n/); } $request->{headers}{'host'} = $request->{host_port}; $request->{headers}{'user-agent'} ||= $self->{agent}; $request->{headers}{'connection'} = "close" unless $self->{keep_alive}; # Some servers error on an empty-body PUT/POST without a content-length if ( $request->{method} eq 'PUT' || $request->{method} eq 'POST' ) { if (!defined($args->{content}) || !length($args->{content}) ) { $request->{headers}{'content-length'} = 0; } } if ( defined $args->{content} ) { if ( ref $args->{content} eq 'CODE' ) { if ( exists $request->{'content-length'} && $request->{'content-length'} == 0 ) { $request->{cb} = sub { "" }; } else { $request->{headers}{'content-type'} ||= "application/octet-stream"; $request->{headers}{'transfer-encoding'} = 'chunked' unless exists $request->{headers}{'content-length'} || $request->{headers}{'transfer-encoding'}; $request->{cb} = $args->{content}; } } elsif ( length $args->{content} ) { my $content = $args->{content}; if ( $] ge '5.008' ) { utf8::downgrade($content, 1) or die(qq/Wide character in request message body\n/); } $request->{headers}{'content-type'} ||= "application/octet-stream"; $request->{headers}{'content-length'} = length $content unless $request->{headers}{'content-length'} || $request->{headers}{'transfer-encoding'}; $request->{cb} = sub { substr $content, 0, length $content, '' }; } $request->{trailer_cb} = $args->{trailer_callback} if ref $args->{trailer_callback} eq 'CODE'; } ### If we have a cookie jar, then maybe add relevant cookies if ( $self->{cookie_jar} ) { my $cookies = $self->cookie_jar->cookie_header( $url ); $request->{headers}{cookie} = $cookies if length $cookies; } # if we have Basic auth parameters, add them if ( length $auth && ! defined $request->{headers}{authorization} ) { $self->_add_basic_auth_header( $request, 'authorization' => $auth ); } return; } sub _add_basic_auth_header { my ($self, $request, $header, $auth) = @_; require MIME::Base64; $request->{headers}{$header} = "Basic " . MIME::Base64::encode_base64($auth, ""); return; } sub _prepare_data_cb { my ($self, $response, $args) = @_; my $data_cb = $args->{data_callback}; $response->{content} = ''; if (!$data_cb || $response->{status} !~ /^2/) { if (defined $self->{max_size}) { $data_cb = sub { $_[1]->{content} .= $_[0]; die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/) if length $_[1]->{content} > $self->{max_size}; }; } else { $data_cb = sub { $_[1]->{content} .= $_[0] }; } } return $data_cb; } sub _update_cookie_jar { my ($self, $url, $response) = @_; my $cookies = $response->{headers}->{'set-cookie'}; return unless defined $cookies; my @cookies = ref $cookies ? @$cookies : $cookies; $self->cookie_jar->add( $url, $_ ) for @cookies; return; } sub _validate_cookie_jar { my ($class, $jar) = @_; # duck typing for my $method ( qw/add cookie_header/ ) { _croak(qq/Cookie jar must provide the '$method' method\n/) unless ref($jar) && ref($jar)->can($method); } return; } sub _maybe_redirect { my ($self, $request, $response, $args) = @_; my $headers = $response->{headers}; my ($status, $method) = ($response->{status}, $request->{method}); $args->{_redirects} ||= []; if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/)) and $headers->{location} and @{$args->{_redirects}} < $self->{max_redirect} ) { my $location = ($headers->{location} =~ /^\//) ? "$request->{scheme}://$request->{host_port}$headers->{location}" : $headers->{location} ; return (($status eq '303' ? 'GET' : $method), $location); } return; } sub _split_url { my $url = pop; # URI regex adapted from the URI module my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/); $scheme = lc $scheme; $path_query = "/$path_query" unless $path_query =~ m<\A/>; my $auth = ''; if ( (my $i = index $host, '@') != -1 ) { # user:pass@host $auth = substr $host, 0, $i, ''; # take up to the @ for auth substr $host, 0, 1, ''; # knock the @ off the host # userinfo might be percent escaped, so recover real auth info $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; } my $port = $host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef; return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth); } # Date conversions adapted from HTTP::Date my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat"; my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec"; sub _http_date { my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]); return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", substr($DoW,$wday*4,3), $mday, substr($MoY,$mon*4,3), $year+1900, $hour, $min, $sec ); } sub _parse_http_date { my ($self, $str) = @_; require Time::Local; my @tl_parts; if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) { @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); } elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) { @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); } elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) { @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6); } return eval { my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1; $t < 0 ? undef : $t; }; } # URI escaping adapted from URI::Escape # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1 # perl 5.6 ready UTF-8 encoding adapted from JSON::PP my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; $escapes{' '}="+"; my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/; sub _uri_escape { my ($self, $str) = @_; return "" if !defined $str; if ( $] ge '5.008' ) { utf8::encode($str); } else { $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string if ( length $str == do { use bytes; length $str } ); $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag } $str =~ s/($unsafe_char)/$escapes{$1}/g; return $str; } package HTTP::Tiny::Handle; # hide from PAUSE/indexers use strict; use warnings; use Errno qw[EINTR EPIPE]; use IO::Socket qw[SOCK_STREAM]; use Socket qw[SOL_SOCKET SO_KEEPALIVE]; # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old # behavior if someone is unable to boostrap CPAN from a new perl install; it is # not intended for general, per-client use and may be removed in the future my $SOCKET_CLASS = $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' : eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.32) } ? 'IO::Socket::IP' : 'IO::Socket::INET'; sub BUFSIZE () { 32768 } ## no critic my $Printable = sub { local $_ = shift; s/\r/\\r/g; s/\n/\\n/g; s/\t/\\t/g; s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge; $_; }; my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/; my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x; sub new { my ($class, %args) = @_; return bless { rbuf => '', timeout => 60, max_line_size => 16384, max_header_lines => 64, verify_SSL => 0, SSL_options => {}, %args }, $class; } sub timeout { my ($self, $timeout) = @_; if ( @_ > 1 ) { $self->{timeout} = $timeout; if ( $self->{fh} && $self->{fh}->can('timeout') ) { $self->{fh}->timeout($timeout); } } return $self->{timeout}; } sub connect { @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n"); my ($self, $scheme, $host, $port, $peer) = @_; if ( $scheme eq 'https' ) { $self->_assert_ssl; } $self->{fh} = $SOCKET_CLASS->new( PeerHost => $peer, PeerPort => $port, $self->{local_address} ? ( LocalAddr => $self->{local_address} ) : (), Proto => 'tcp', Type => SOCK_STREAM, Timeout => $self->{timeout}, ) or die(qq/Could not connect to '$host:$port': $@\n/); binmode($self->{fh}) or die(qq/Could not binmode() socket: '$!'\n/); if ( $self->{keep_alive} ) { unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) { CORE::close($self->{fh}); die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/); } } $self->start_ssl($host) if $scheme eq 'https'; $self->{scheme} = $scheme; $self->{host} = $host; $self->{peer} = $peer; $self->{port} = $port; $self->{pid} = $$; $self->{tid} = _get_tid(); return $self; } sub connected { my ($self) = @_; if ( $self->{fh} && $self->{fh}->connected ) { return wantarray ? ( $self->{fh}->peerhost, $self->{fh}->peerport ) : join( ':', $self->{fh}->peerhost, $self->{fh}->peerport ); } return; } sub start_ssl { my ($self, $host) = @_; # As this might be used via CONNECT after an SSL session # to a proxy, we shut down any existing SSL before attempting # the handshake if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { unless ( $self->{fh}->stop_SSL ) { my $ssl_err = IO::Socket::SSL->errstr; die(qq/Error halting prior SSL connection: $ssl_err/); } } my $ssl_args = $self->_ssl_args($host); IO::Socket::SSL->start_SSL( $self->{fh}, %$ssl_args, SSL_create_ctx_callback => sub { my $ctx = shift; Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY()); }, ); unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { my $ssl_err = IO::Socket::SSL->errstr; die(qq/SSL connection failed for $host: $ssl_err\n/); } } sub close { @_ == 1 || die(q/Usage: $handle->close()/ . "\n"); my ($self) = @_; CORE::close($self->{fh}) or die(qq/Could not close socket: '$!'\n/); } sub write { @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n"); my ($self, $buf) = @_; if ( $] ge '5.008' ) { utf8::downgrade($buf, 1) or die(qq/Wide character in write()\n/); } my $len = length $buf; my $off = 0; local $SIG{PIPE} = 'IGNORE'; while () { $self->can_write or die(qq/Timed out while waiting for socket to become ready for writing\n/); my $r = syswrite($self->{fh}, $buf, $len, $off); if (defined $r) { $len -= $r; $off += $r; last unless $len > 0; } elsif ($! == EPIPE) { die(qq/Socket closed by remote server: $!\n/); } elsif ($! != EINTR) { if ($self->{fh}->can('errstr')){ my $err = $self->{fh}->errstr(); die (qq/Could not write to SSL socket: '$err'\n /); } else { die(qq/Could not write to socket: '$!'\n/); } } } return $off; } sub read { @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n"); my ($self, $len, $allow_partial) = @_; my $buf = ''; my $got = length $self->{rbuf}; if ($got) { my $take = ($got < $len) ? $got : $len; $buf = substr($self->{rbuf}, 0, $take, ''); $len -= $take; } # Ignore SIGPIPE because SSL reads can result in writes that might error. # See "Expecting exactly the same behavior as plain sockets" in # https://metacpan.org/dist/IO-Socket-SSL/view/lib/IO/Socket/SSL.pod#Common-Usage-Errors local $SIG{PIPE} = 'IGNORE'; while ($len > 0) { $self->can_read or die(q/Timed out while waiting for socket to become ready for reading/ . "\n"); my $r = sysread($self->{fh}, $buf, $len, length $buf); if (defined $r) { last unless $r; $len -= $r; } elsif ($! != EINTR) { if ($self->{fh}->can('errstr')){ my $err = $self->{fh}->errstr(); die (qq/Could not read from SSL socket: '$err'\n /); } else { die(qq/Could not read from socket: '$!'\n/); } } } if ($len && !$allow_partial) { die(qq/Unexpected end of stream\n/); } return $buf; } sub readline { @_ == 1 || die(q/Usage: $handle->readline()/ . "\n"); my ($self) = @_; while () { if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) { return $1; } if (length $self->{rbuf} >= $self->{max_line_size}) { die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/); } $self->can_read or die(qq/Timed out while waiting for socket to become ready for reading\n/); my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf}); if (defined $r) { last unless $r; } elsif ($! != EINTR) { if ($self->{fh}->can('errstr')){ my $err = $self->{fh}->errstr(); die (qq/Could not read from SSL socket: '$err'\n /); } else { die(qq/Could not read from socket: '$!'\n/); } } } die(qq/Unexpected end of stream while looking for line\n/); } sub read_header_lines { @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n"); my ($self, $headers) = @_; $headers ||= {}; my $lines = 0; my $val; while () { my $line = $self->readline; if (++$lines >= $self->{max_header_lines}) { die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/); } elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) { my ($field_name) = lc $1; if (exists $headers->{$field_name}) { for ($headers->{$field_name}) { $_ = [$_] unless ref $_ eq "ARRAY"; push @$_, $2; $val = \$_->[-1]; } } else { $val = \($headers->{$field_name} = $2); } } elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) { $val or die(qq/Unexpected header continuation line\n/); next unless length $1; $$val .= ' ' if length $$val; $$val .= $1; } elsif ($line =~ /\A \x0D?\x0A \z/x) { last; } else { die(q/Malformed header line: / . $Printable->($line) . "\n"); } } return $headers; } sub write_request { @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n"); my($self, $request) = @_; $self->write_request_header(@{$request}{qw/method uri headers header_case/}); $self->write_body($request) if $request->{cb}; return; } # Standard request header names/case from HTTP/1.1 RFCs my @rfc_request_headers = qw( Accept Accept-Charset Accept-Encoding Accept-Language Authorization Cache-Control Connection Content-Length Expect From Host If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer Transfer-Encoding Upgrade User-Agent Via ); my @other_request_headers = qw( Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin X-XSS-Protection ); my %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers; # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to # combine writes. sub write_header_lines { (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n"); my($self, $headers, $header_case, $prefix_data) = @_; $header_case ||= {}; my $buf = (defined $prefix_data ? $prefix_data : ''); # Per RFC, control fields should be listed first my %seen; for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) { next unless exists $headers->{$k}; $seen{$k}++; my $field_name = $HeaderCase{$k}; my $v = $headers->{$k}; for (ref $v eq 'ARRAY' ? @$v : $v) { $_ = '' unless defined $_; $buf .= "$field_name: $_\x0D\x0A"; } } # Other headers sent in arbitrary order while (my ($k, $v) = each %$headers) { my $field_name = lc $k; next if $seen{$field_name}; if (exists $HeaderCase{$field_name}) { $field_name = $HeaderCase{$field_name}; } else { if (exists $header_case->{$field_name}) { $field_name = $header_case->{$field_name}; } else { $field_name =~ s/\b(\w)/\u$1/g; } $field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n"); $HeaderCase{lc $field_name} = $field_name; } for (ref $v eq 'ARRAY' ? @$v : $v) { # unwrap a field value if pre-wrapped by user s/\x0D?\x0A\s+/ /g; die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n") unless $_ eq '' || /\A $Field_Content \z/xo; $_ = '' unless defined $_; $buf .= "$field_name: $_\x0D\x0A"; } } $buf .= "\x0D\x0A"; return $self->write($buf); } # return value indicates whether message length was defined; this is generally # true unless there was no content-length header and we just read until EOF. # Other message length errors are thrown as exceptions sub read_body { @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n"); my ($self, $cb, $response) = @_; my $te = $response->{headers}{'transfer-encoding'} || ''; my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ; return $chunked ? $self->read_chunked_body($cb, $response) : $self->read_content_body($cb, $response); } sub write_body { @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n"); my ($self, $request) = @_; if (exists $request->{headers}{'content-length'}) { return unless $request->{headers}{'content-length'}; return $self->write_content_body($request); } else { return $self->write_chunked_body($request); } } sub read_content_body { @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n"); my ($self, $cb, $response, $content_length) = @_; $content_length ||= $response->{headers}{'content-length'}; if ( defined $content_length ) { my $len = $content_length; while ($len > 0) { my $read = ($len > BUFSIZE) ? BUFSIZE : $len; $cb->($self->read($read, 0), $response); $len -= $read; } return length($self->{rbuf}) == 0; } my $chunk; $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) ); return; } sub write_content_body { @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n"); my ($self, $request) = @_; my ($len, $content_length) = (0, $request->{headers}{'content-length'}); while () { my $data = $request->{cb}->(); defined $data && length $data or last; if ( $] ge '5.008' ) { utf8::downgrade($data, 1) or die(qq/Wide character in write_content()\n/); } $len += $self->write($data); } $len == $content_length or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/); return $len; } sub read_chunked_body { @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n"); my ($self, $cb, $response) = @_; while () { my $head = $self->readline; $head =~ /\A ([A-Fa-f0-9]+)/x or die(q/Malformed chunk head: / . $Printable->($head) . "\n"); my $len = hex($1) or last; $self->read_content_body($cb, $response, $len); $self->read(2) eq "\x0D\x0A" or die(qq/Malformed chunk: missing CRLF after chunk data\n/); } $self->read_header_lines($response->{headers}); return 1; } sub write_chunked_body { @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n"); my ($self, $request) = @_; my $len = 0; while () { my $data = $request->{cb}->(); defined $data && length $data or last; if ( $] ge '5.008' ) { utf8::downgrade($data, 1) or die(qq/Wide character in write_chunked_body()\n/); } $len += length $data; my $chunk = sprintf '%X', length $data; $chunk .= "\x0D\x0A"; $chunk .= $data; $chunk .= "\x0D\x0A"; $self->write($chunk); } $self->write("0\x0D\x0A"); if ( ref $request->{trailer_cb} eq 'CODE' ) { $self->write_header_lines($request->{trailer_cb}->()) } else { $self->write("\x0D\x0A"); } return $len; } sub read_response_header { @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n"); my ($self) = @_; my $line = $self->readline; $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) (?: [\x09\x20]+ ([^\x0D\x0A]*) )? \x0D?\x0A/x or die(q/Malformed Status-Line: / . $Printable->($line). "\n"); my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); $reason = "" unless defined $reason; die (qq/Unsupported HTTP protocol: $protocol\n/) unless $version =~ /0*1\.0*[01]/; return { status => $status, reason => $reason, headers => $self->read_header_lines, protocol => $protocol, }; } sub write_request_header { @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n"); my ($self, $method, $request_uri, $headers, $header_case) = @_; return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A"); } sub _do_timeout { my ($self, $type, $timeout) = @_; $timeout = $self->{timeout} unless defined $timeout && $timeout >= 0; my $fd = fileno $self->{fh}; defined $fd && $fd >= 0 or die(qq/select(2): 'Bad file descriptor'\n/); my $initial = time; my $pending = $timeout; my $nfound; vec(my $fdset = '', $fd, 1) = 1; while () { $nfound = ($type eq 'read') ? select($fdset, undef, undef, $pending) : select(undef, $fdset, undef, $pending) ; if ($nfound == -1) { $! == EINTR or die(qq/select(2): '$!'\n/); redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; $nfound = 0; } last; } $! = 0; return $nfound; } sub can_read { @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n"); my $self = shift; if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { return 1 if $self->{fh}->pending; } return $self->_do_timeout('read', @_) } sub can_write { @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n"); my $self = shift; return $self->_do_timeout('write', @_) } sub _assert_ssl { my($ok, $reason) = HTTP::Tiny->can_ssl(); die $reason unless $ok; } sub can_reuse { my ($self,$scheme,$host,$port,$peer) = @_; return 0 if $self->{pid} != $$ || $self->{tid} != _get_tid() || length($self->{rbuf}) || $scheme ne $self->{scheme} || $host ne $self->{host} || $port ne $self->{port} || $peer ne $self->{peer} || eval { $self->can_read(0) } || $@ ; return 1; } # Try to find a CA bundle to validate the SSL cert, # prefer Mozilla::CA or fallback to a system file sub _find_CA_file { my $self = shift(); my $ca_file = defined( $self->{SSL_options}->{SSL_ca_file} ) ? $self->{SSL_options}->{SSL_ca_file} : $ENV{SSL_CERT_FILE}; if ( defined $ca_file ) { unless ( -r $ca_file ) { die qq/SSL_ca_file '$ca_file' not found or not readable\n/; } return $ca_file; } local @INC = @INC; pop @INC if $INC[-1] eq '.'; return Mozilla::CA::SSL_ca_file() if eval { require Mozilla::CA; 1 }; # cert list copied from golang src/crypto/x509/root_unix.go foreach my $ca_bundle ( "/etc/ssl/certs/ca-certificates.crt", # Debian/Ubuntu/Gentoo etc. "/etc/pki/tls/certs/ca-bundle.crt", # Fedora/RHEL "/etc/ssl/ca-bundle.pem", # OpenSUSE "/etc/openssl/certs/ca-certificates.crt", # NetBSD "/etc/ssl/cert.pem", # OpenBSD "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly "/etc/pki/tls/cacert.pem", # OpenELEC "/etc/certs/ca-certificates.crt", # Solaris 11.2+ ) { return $ca_bundle if -e $ca_bundle; } die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/ . qq/Try installing Mozilla::CA from CPAN\n/; } # for thread safety, we need to know thread id if threads are loaded sub _get_tid { no warnings 'reserved'; # for 'threads' return threads->can("tid") ? threads->tid : 0; } sub _ssl_args { my ($self, $host) = @_; my %ssl_args; # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't # added until IO::Socket::SSL 1.84 if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) { $ssl_args{SSL_hostname} = $host, # Sane SNI support } if ($self->{verify_SSL}) { $ssl_args{SSL_verifycn_scheme} = 'http'; # enable CN validation $ssl_args{SSL_verifycn_name} = $host; # set validation hostname $ssl_args{SSL_verify_mode} = 0x01; # enable cert validation $ssl_args{SSL_ca_file} = $self->_find_CA_file; } else { $ssl_args{SSL_verifycn_scheme} = 'none'; # disable CN validation $ssl_args{SSL_verify_mode} = 0x00; # disable cert validation } # user options override settings from verify_SSL for my $k ( keys %{$self->{SSL_options}} ) { $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/; } return \%ssl_args; } 1; } # --- END HTTP::Tiny { # --- BEGIN Try::Tiny package Try::Tiny; # git description: v0.30-11-g1b81d0a use 5.006; # ABSTRACT: Minimal try/catch with proper preservation of $@ our $VERSION = '0.31'; use strict; use warnings; BEGIN { use Exporter 5.57 'import'; our @EXPORT = our @EXPORT_OK = qw(try catch finally); use Carp; $Carp::Internal{+__PACKAGE__}++; if ($INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname ) { *_subname = \&Sub::Util::set_subname; *_HAS_SUBNAME = sub {1}; } elsif( $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) } ){ *_subname = \&Sub::Name::subname; *_HAS_SUBNAME = sub {1}; } else { *_HAS_SUBNAME = sub {0}; } } my %_finally_guards; # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list # context & not a scalar one sub try (&;@) { my ( $try, @code_refs ) = @_; # we need to save this here, the eval block will be in scalar context due # to $failed my $wantarray = wantarray; # work around perl bug by explicitly initializing these, due to the likelyhood # this will be used in global destruction (perl rt#119311) my ( $catch, @finally ) = (); # find labeled blocks in the argument list. # catch and finally tag the blocks by blessing a scalar reference to them. foreach my $code_ref (@code_refs) { if ( ref($code_ref) eq 'Try::Tiny::Catch' ) { croak 'A try() may not be followed by multiple catch() blocks' if $catch; $catch = ${$code_ref}; } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) { push @finally, ${$code_ref}; } else { croak( 'try() encountered an unexpected argument (' . ( defined $code_ref ? $code_ref : 'undef' ) . ') - perhaps a missing semi-colon before or' ); } } # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's # not perfect, but we could provide a list of additional errors for # $catch->(); # name the blocks if we have Sub::Name installed _subname(caller().'::try {...} ' => $try) if _HAS_SUBNAME; # set up scope guards to invoke the finally blocks at the end. # this should really be a function scope lexical variable instead of # file scope + local but that causes issues with perls < 5.20 due to # perl rt#119311 local $_finally_guards{guards} = [ map Try::Tiny::ScopeGuard->_new($_), @finally ]; # save the value of $@ so we can set $@ back to it in the beginning of the eval # and restore $@ after the eval finishes my $prev_error = $@; my ( @ret, $error ); # failed will be true if the eval dies, because 1 will not be returned # from the eval body my $failed = not eval { $@ = $prev_error; # evaluate the try block in the correct context if ( $wantarray ) { @ret = $try->(); } elsif ( defined $wantarray ) { $ret[0] = $try->(); } else { $try->(); }; return 1; # properly set $failed to false }; # preserve the current error and reset the original value of $@ $error = $@; $@ = $prev_error; # at this point $failed contains a true value if the eval died, even if some # destructor overwrote $@ as the eval was unwinding. if ( $failed ) { # pass $error to the finally blocks push @$_, $error for @{$_finally_guards{guards}}; # if we got an error, invoke the catch block. if ( $catch ) { # This works like given($error), but is backwards compatible and # sets $_ in the dynamic scope for the body of C<$catch> for ($error) { return $catch->($error); } # in case when() was used without an explicit return, the C # loop will be aborted and there's no useful return value } return; } else { # no failure, $@ is back to what it was, everything is fine return $wantarray ? @ret : $ret[0]; } } sub catch (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare catch()' unless wantarray; _subname(caller().'::catch {...} ' => $block) if _HAS_SUBNAME; return ( bless(\$block, 'Try::Tiny::Catch'), @rest, ); } sub finally (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare finally()' unless wantarray; _subname(caller().'::finally {...} ' => $block) if _HAS_SUBNAME; return ( bless(\$block, 'Try::Tiny::Finally'), @rest, ); } { package # hide from PAUSE Try::Tiny::ScopeGuard; use constant UNSTABLE_DOLLARAT => ("$]" < '5.013002') ? 1 : 0; sub _new { shift; bless [ @_ ]; } sub DESTROY { my ($code, @args) = @{ $_[0] }; local $@ if UNSTABLE_DOLLARAT; eval { $code->(@args); 1; } or do { warn "Execution of finally() block $code resulted in an exception, which " . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' . 'Your program will continue as if this event never took place. ' . "Original exception text follows:\n\n" . (defined $@ ? $@ : '$@ left undefined...') . "\n" ; } } } 1; } # --- END Try::Tiny { # --- BEGIN cPstrict package cPstrict; # cpanel - cPstrict.pm Copyright 2022 cPanel, L.L.C. # 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 { # 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/OS/SysPerlBootstrap.pm package Cpanel::OS::SysPerlBootstrap; use strict; use warnings; use constant CACHE_FILE => '/var/cpanel/caches/Cpanel-OS'; use constant CACHE_FILE_CUSTOM => CACHE_FILE . '.custom'; sub get_os_info { my ($iknowwhatimdoing) = @_; die("Please use Cpanel::OS for your OS info needs") unless ( $iknowwhatimdoing && $iknowwhatimdoing eq 'DO NOT USE THIS CALL' ); my @os_info = _read_os_info_cache(); return @os_info if @os_info; my ( $distro, $major, $minor, $build ) = _get_os_without_cache('redhat_first'); if ( !defined $distro || !length $distro || !defined $major || !length $major || !defined $minor || !length $minor || !defined $build || !length $build ) { die sprintf( "Could not determine OS info (distro: %s, major: %s, minor: %s, build: %s)\n", $distro // '', $major // '', $minor // '', $build // '' ); } _cache_os_info( $^O, $distro, $major, $minor, $build ); return ( $^O, $distro, $major, $minor, $build ); } sub _get_os_without_cache { my ($redhat_first) = @_; my @os; if ($redhat_first) { # preserve existing behavior for Cpanel::OS @os = _read_redhat_release(); @os = _read_os_release() unless scalar @os; } else { @os = _read_os_release(); @os = _read_redhat_release() unless scalar @os; } return @os; } sub _read_os_info_cache { my $cache_mtime = ( lstat CACHE_FILE )[9] or return; my $custom_os = readlink CACHE_FILE_CUSTOM; if ( !$custom_os ) { my $os_rel_mtime = ( stat("/etc/os-release") )[9]; $os_rel_mtime //= ( stat("/etc/redhat-release") )[9]; # in the case of cloudlinux 6, we check against this instead return if ( defined($os_rel_mtime) && $cache_mtime <= $os_rel_mtime ); } return split /\|/, readlink(CACHE_FILE); } sub _read_os_release { return unless -e '/etc/os-release'; open( my $os_fh, "<", "/etc/os-release" ) or die "Could not open /etc/os-release for reading: $!\n"; my ( $distro, $ver, $ver_id ); while ( my $line = <$os_fh> ) { my ( $key, $value ) = split( qr/\s*=\s*/, $line, 2 ); chomp $value; $value =~ s/\s.+//; $value =~ s/"\z//; $value =~ s/^"//; if ( !$distro && $key eq "ID" ) { $distro = $value; } elsif ( !$ver_id && $key eq "VERSION_ID" ) { $ver_id = $value; } elsif ( !$ver && $key eq "VERSION" ) { $ver = $value; } last if defined $distro && length $distro && defined $ver && length $ver && defined $ver_id && length $ver_id; } close $os_fh; my ( $major, $minor, $build ) = split( qr/\./, $ver_id ); return unless $distro; # We have to at a minimum have a distro name. All hope is lost otherwise. unless ( defined $major && length $major && defined $minor && length $minor && defined $build && length $build ) { my ( $ver_major, $ver_minor, $ver_build ) = split( qr/\./, $ver ); $major //= $ver_major; $minor //= ( $ver_minor // 0 ); $build //= ( $ver_build // 0 ); } return ( $distro, $major, $minor, $build ); } sub _read_redhat_release { return unless -e '/etc/redhat-release'; open( my $cr_fh, "<", "/etc/redhat-release" ) or die "Could not open /etc/redhat-release for reading: $!\n"; my $line = <$cr_fh>; chomp $line; my ($distro) = $line =~ m/^(\w+)/i; $distro = lc($distro); $distro = 'rhel' if $distro eq 'red'; my ( $major, $minor, $build ) = $line =~ m{\b([0-9]+)\.([0-9]+)\.([0-9]+)}; if ( !defined $major || !length $major ) { ( $major, $minor ) = $line =~ m{\b([0-9]+)\.([0-9]+)}; } if ( !defined $major || !length $major ) { ($major) = $line =~ m{\b([0-9]+)}; } $minor //= 0; $build //= 0; return ( $distro, $major, $minor, $build ); } sub _cache_os_info { my ( $os, $distro, $major, $minor, $build ) = @_; $> == 0 or return; mkdir '/var/cpanel', 0711; mkdir '/var/cpanel/caches', 0711; local $!; unlink CACHE_FILE; symlink "$os|$distro|$major|$minor|$build", CACHE_FILE; return 1; } 1; } # --- END Cpanel/OS/SysPerlBootstrap.pm { # --- BEGIN Cpanel/ExceptionMessage.pm package Cpanel::ExceptionMessage; use strict; # use Cpanel::Exception (); *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; 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; # use Cpanel::ExceptionMessage(); our @ISA; BEGIN { push @ISA, qw(Cpanel::ExceptionMessage); } # use Cpanel::Locale::Utils::Fallback (); 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; 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; 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 (); # use Cpanel::LoadModule::Utils (); 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() || '', $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/LoadModule.pm package Cpanel::LoadModule; use strict; # use Cpanel::Exception (); # use Cpanel::LoadModule::Utils (); 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/OS.pm package Cpanel::OS; use cPstrict; use Carp (); # use Cpanel::OS::SysPerlBootstrap (); # use Cpanel::LoadModule (); our $VERSION = '2.0'; sub _new_instance ( $os, $distro, $major, $minor, $build ) { my $distro_class = 'Cpanel::OS::' . ucfirst($distro) . $major; if ( !eval "require $distro_class; 1" ) { ## no critic qw(ProhibitStringyEval) -- This is how we do a runtime load here. require Cpanel::OS::Linux; # PPI USE OK -- used just after $distro_class = q[Cpanel::OS::Linux]; # unsupported distro $os //= q[Unknown]; } my $self = bless { os => $os, distro => $distro, major => $major, minor => $minor, build => $build, }, $distro_class; return $self; } my $instance; sub clear_cache { $INC{'Test/Cpanel/Policy.pm'} or Carp::croak("This interface is only for unit testing"); undef $instance; return; } sub clear_cache_after_cloudlinux_update { undef $instance; return; } sub _instance { ## no critic(RequireArgUnpacking) - Most of the time we do not need to process args. return $instance if $instance; Carp::croak("Cpanel::OS may not be called during cPanel binary compilation") if $INC{'B/C.pm'}; my ( $os, $distro, $major, $minor, $build ) = @_; if ( !length $build ) { ( $os, $distro, $major, $minor, $build ) = Cpanel::OS::SysPerlBootstrap::get_os_info('DO NOT USE THIS CALL'); } return $instance = _new_instance( $os, $distro, $major, $minor, $build ); } sub flush_disk_caches { local $!; return 0 if readlink Cpanel::OS::SysPerlBootstrap::CACHE_FILE_CUSTOM; unlink Cpanel::OS::SysPerlBootstrap::CACHE_FILE; return 1; } sub distro { return _instance()->{'distro'} } sub major { return _instance()->{'major'} } sub minor { return _instance()->{'minor'} } sub build { return _instance()->{'build'} } my %methods; BEGIN { %methods = map { $_ => 0 } ( 'is_supported', # This OS is supported by cPanel and not a virtual class (these exist!). 'eol_advice', # Additional information provided to updatenow blockers when the customer tries to upgrade on a removed distro. 'support_needs_minor_at_least_at', # miniimum minor version we support for this distro (optional 'is_experimental', # Defines if this distro is in experimental state or not. 'experimental_url', # Provides a link to information about the experimental state if it's currently that way. 'arch', # Somewhat of an unnecessary variable as all of our distros are set to x86_64. 'service_manager', # Does this distro use systemd or initd to manage services? 'is_systemd', # Easy boolean helper we use in most places to determine if the local system uses systemd. 'base_distro', # What is the root distro this distro is derived from? rhel/debian 'pretty_distro', # What is the preferred stylization of the distro name when being displayed for a user? 'display_name', # Example: Centos v7.9.2009 'display_name_lite', # Example: centos 7 'cpanalytics_cpos', # How should we present data regarding the OS to Google Analytics? 'binary_sync_source', # Provides the string corresponding to the binary sync source directory. 'nobody', # name of the user used for nobody 'nogroup', # name of the group used for nobody / nogroup 'sudoers', # name of the group used for sudo (by sudoers) 'has_wheel_group', # flag for whether wheel group is needed by sudo 'default_uid_min', # default value from /etc/login.defs 'default_gid_min', # default value from /etc/login.defs 'default_sys_uid_min', # default value from /etc/login.defs 'default_sys_gid_min', # default value from /etc/login.defs 'has_tcp_wrappers', # The distro supports TPC wrappers. 'setup_tz_method', # what method to use to setup a timezone 'is_cloudlinux', # is it a CloudLinux based distro? boolean 'can_be_elevated', # ELevate supports current OS as a source 'can_elevate_to', # ELevate can directly convert the current OS to these other OSes listed in the arrayref 'rsyslog_triggered_by_socket', # Is rsyslog triggered by syslog.socket 'has_quota_support_for_xfs', # Does this distro support xfs quota? 'program_to_apply_kernel_args', # What program do we need to run to ensure that kernels are booted with updated args? 'has_cloudlinux_enhanced_quotas', # Cloud linux does fancy things with quota we need to know about. 'who_wins_if_soft_gt_hard', # If we try to set a soft quota higher than a hard quota, which value wins? 'quota_packages_conditional', # Hashref of needed kernel package dependencies not encoded in the upstream distro in order for quotas to work 'bin_grub_mkconfig', # path to sbin/grub2-mkconfig 'bin_needs_restarting', # path to needs-restarting binary 'outdated_services_check', # which method to use to check outdated services? 'outdated_processes_check', # which method to use to check outdated processes? 'check_reboot_method', # which method to use to check if we need to reboot 'dns_supported', # Provides a list of dns servers supported on this platform. 'dns_named_basedir', # The path to the bind nameserver files. 'dns_named_conf', # /etc/named.conf 'dns_named_log', # What dir named logs are stored (/var/log/named) 'ssh_supported_algorithms', # list of supported ssh algo [ordered by preference] 'openssl_minimum_supported_version', # minimum openssl version to run 'openssl_escapes_subjects', # On generated certs, openssl started escaping subject lines at some point... 'unsupported_db_versions', # What DB versions does this distro NOT support. 'db_package_manager_key_params', # Hashref describing what to do to ensure keys are in place for DBMSes installed from a 3rdparty repo 'mysql_versions_use_repo_template', # Which MySQL versions use mysql_repo_template. 'mariadb_versions_use_repo_template', # Which MariaDB versions use mariadb_repo_template. 'mysql_repo_template', # What goes in the repo file to download mysql packages. 'mariadb_repo_template', # What goes in the repo file to download mariadb packages. 'mariadb_minimum_supported_version', # Minimum version of MariaDB supported 'mysql_community_packages', # Which MySQL packages need to be installed on this distro? 'mysql_dependencies', # Which distro packages need to be installed for MySQL to be happy? 'mysql_incompatible', # Which mysql packages need to be blocked as incompatible with cPanel packages on this distro? 'mysql_default_version', # Default MySQL version to use 'supports_postgresql', # Do we support PostgreSQL on this distro? 'postgresql_minimum_supported_version', # What is the minimum versions of PostgreSQL supported on this distro? 'postgresql_packages', # What packages do we need to install? 'postgresql_service_aliases', # What aliases, if any, of the service name might we expect to find PostgreSQL using? 'postgresql_initdb_commands', # Which commands do we run to make PostgreSQL initialize its DB storage area? 'ea4_install_repo_from_package', # Does a RPM provide the EA4 repo or do we download the repo file? 'ea4_from_pkg_url', # If we're installing the repo from RPM, where do we get it from? 'ea4_from_pkg_reponame', # ... And what will the repo be called when we install it? 'ea4_from_custom_repo_url', # Where can we download the repo file from? (needs to be over https) 'ea4_from_custom_repo_path', # ... And where should we put it when we download it? 'ea4tooling_all', # LIST - What are the packages to install which provide ea4 tooling on all server types? 'ea4tooling', # LIST - What ea4 tooling packages do we install on full cpanel servers? 'ea4tooling_dnsonly', # LIST - What additional packages do we need for dnsonly? << FACT CHECK 'ea4_modern_openssl', # Which openssl should be used on this platform to get the L&G Stuff? EA4 provides one in the event the distro's version is insufficient. 'ea4_testing_yum_repo', # undef or string with the name of the yum repo to enable 'ea4_conflicting_apache_distro_packages', # Conflicting packages that Cpanel::EA4::MigrateBlocker checks for 'ea4_install_from_profile_enforce_packages', 'package_manager', # which package manager does the distro use? ( yum/dnf/apt) 'package_manager_module', # Cpanel::whatever::$package_manager_module::... ( Yum or Apt ) 'package_repositories', # what additional repos need to be installed and enabled to install needed software? 'package_release_distro_tag', # the postfix extension used for the packages: ~el6, ~el7, ~el8, ~el9, ~u20, ~u22 'system_exclude_rules', # On yum based systems, how what will we block the main distro from installing 'kernel_package_pattern', # What are the kernal packages named so we can sometimes block them when updating. 'check_kernel_version_method', # What method to use to check the kernel version 'stock_kernel_version_regex', # Regular expression used to determine whether the version string returned for the kernel matches what the distro would return with a stock kernel. 'kernel_supports_fs_protected_regular', # Does fs.protected_regular a valid settings 'packages_required', # Which packages should /scripts/sysup assure are present on this system? ( provided during fresh install ) 'packages_supplemental', # Which packages should /scripts/sysup assure are present on this system? ( provided AFTER fresh install ) 'packages_supplemental_epel', # Packages we want to install from epel if it is available to us. 'is_apt_based', # Does this system use apt (and therefore deb packages) for package management? 'is_yum_based', # Does this system use a yum or a yum derivative (dnf) 'is_rpm_based', # Does this system do its package management with rpms? 'system_package_providing_perl', # Name of the package providing system Perl 'retry_rpm_cmd_no_tty_hack', # Hack: retry RPM comand when no TTY 'can_clean_plugins_repo', # Can we clean the 'plugins' repo 'repos_requires_dump_flag', # shiykd we use '--dump' when enabling a repo 'rpm_versions_system', # Which rpm_versions_system is currently used 'packages_arch', # Default architecture used by the rpm.versions system 'package_ImageMagick_Devel', # Name of the imagemagick devel package 'package_MySQL_Shell', # Name of the mysql-shell package (installed on demand) 'package_crond', # Name of the package providing the cron daemon 'plugins_repo_url', # URL to .repo / .list for cpanel-plugins 'repo_suffix', # Suffix for repo files, such as .repo or .list 'repo_dir', # Local directory path where system repo config files are stored for the package manager 'package_descriptions', # Description fields used in manage plugins 'supports_cpanel_cloud_edition', # Is cPCloud supported by this distro? 'supports_cpaddons', # Are cpaddons supported by this distro? 'supports_kernelcare', # Is Kernel Care available for this distro? 'supports_kernelcare_free', # Is Kernel Care Free available for this distro? << FACT CHECK (Note: This check implicitly ensures the system is not running CloudLinux) 'supports_3rdparty_wpt', # Is Wordpress Toolkit supported on this platform? 'supports_plugins_repo', # Is Cpanel::Plugins::Repo supported on this platform? 'supports_or_can_become_cloudlinux', # Does the system can become/or is CloudLinux? 'can_become_cloudlinux', # Can the system become CloudLinux? 'supports_imunify_av', # Can install Imunify AV 'supports_imunify_av_plus', # Can install Imunify AV Plus 'supports_imunify_360', # Can install Imunify AV 360 'jetbackup_repo_pkg', # URL to the package we install to set up the JetBackup repo ( somewhere on http://repo.jetlicense.com/ ) 'supports_letsencrypt_v2', 'supports_cpanel_analytics', 'security_service', # What security service the distro is using? apparmor or selinux 'firewall', # Which firewall is this distro using? (iptables / firewalld_nftables / ufw_iptables) 'firewall_module', # Which firewall module is used to manage it? (IpTables / NFTables) 'networking', # Not sure what this is for. Nothing uses it. ( networkscripts / netplan ) << FACT CHECK 'iptables_ipv4_savefile', # Where to store iptables rules for IPv4 'iptables_ipv6_savefile', # Where to store iptables rules for IPv6 'sysconfig_network', # sysconfig networ file to use, undef when unused. 'supports_hostaccess', # Does the system provide support for /etc/hosts.allow, etc.? 'supports_inetd', # Does the system provide support for inetd? 'supports_syslogd', # Does the system provide support for syslogd? 'install_gcc_from_slc6_devtoolset', # Do we need to install a custom gcc for building? 'check_ntpd_pid_method', # Method used to check the ntp daemon pid 'syslog_service_name', # Name of the service that handles syslog data, such as syslog, rsyslog, rsyslogd, etc, eg: `/usr/bin/systemctl show -p MainPID rsyslog.service` 'cron_bin_path', # Path to the cron daemon 'systemd_service_name_map', # Map of service names to possible counterparts, such as crond -> cron 'prelink_config_path', # Where do the control knobs for prelinking live? 'pam_file_controlling_crypt_algo', # Which file in /etc/pam.d manages the algorithm used to generate the passwd hash written to /etc/shadow for a user? 'user_crontab_dir', # Path to directory where user crontabs are stored by the crontab binary 'needs_els', # Does this server require the ELS product 'maillog_path', # Path to the mail.* syslog output as defined by the distro 'nat_server_buffer_connections', # Number of connections_required to trigger a test failure in simultaneous connections for NAT detection. ); } sub supported_methods { return sort keys %methods; ##no critic qw( ProhibitReturnSort ) - this will always be a list. } our $AUTOLOAD; # keep 'use strict' happy sub AUTOLOAD { ## no critic(RequireArgUnpacking) - Most of the time we do not need to process args. my $sub = $AUTOLOAD; $sub =~ s/.*:://; exists $methods{$sub} or Carp::croak("$sub is not a supported data variable for Cpanel::OS"); my $i = _instance(); my $can = $i->can($sub) or Carp::croak( ref($i) . " does not implement $sub" ); return $can->( $i, @_ ); } sub list_contains_value ( $key, $value ) { my $array_ref = _instance()->$key; ref $array_ref eq 'ARRAY' or Carp::croak("$key is not a list!"); if ( !defined $value ) { return ( grep { !defined $_ } @$array_ref ) ? 1 : 0; } return ( grep { $value eq $_ } @$array_ref ) ? 1 : 0; } sub DESTROY { } # This is a must for autoload modules. sub assert_unreachable_on_ubuntu ( $msg = "Ubuntu reached somewhere it shouldn't!" ) { Carp::croak($msg) if Cpanel::OS::base_distro() eq "debian"; return; } sub lookup_pretty_distro ($target) { require Cpanel::OS::All; my ( $name, $major ) = ( $target =~ m/^([A-Za-z]+)([0-9]+)$/ ); return if !$name || !$major; return unless grep { $_->[0] eq $name && $_->[1] == $major } Cpanel::OS::All::supported_distros(); my $module = "Cpanel::OS::$target"; Cpanel::LoadModule::load_perl_module($module); my $pretty_name = $module->pretty_distro; return "$pretty_name $major"; } 1; } # --- END Cpanel/OS.pm { # --- BEGIN Cpanel/OS/Linux.pm package Cpanel::OS::Linux; use cPstrict; use Carp (); # use Cpanel::OS (); # use Cpanel::OS(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS); } use constant eol_advice => ''; use constant is_supported => 0; # Base OS class for all platforms we currently support. use constant support_needs_minor_at_least_at => undef; # by default no restriction on minor version use constant is_experimental => 0; # By default, no distros are experimental. use constant experimental_url => ''; # ... and so no URL to document it. use constant dns_supported => [qw{ powerdns }]; # All platforms support powerdns as it is our default. use constant supports_3rdparty_wpt => 1; # We support WPT on all platforms ATM. use constant supports_plugins_repo => 1; use constant supports_imunify_av => 0; use constant supports_imunify_av_plus => 0; use constant supports_imunify_360 => 0; use constant supports_letsencrypt_v2 => 1; use constant supports_cpanel_analytics => 1; use constant supports_cpanel_cloud_edition => 0; use constant can_elevate_to => []; use constant setup_tz_method => q[timedatectl]; use constant nobody => q[nobody]; use constant nogroup => q[nobody]; use constant default_uid_min => 1_000; use constant default_gid_min => 1_000; use constant default_sys_uid_min => 201; use constant default_sys_gid_min => 201; use constant dns_named_basedir => '/var/named'; use constant dns_named_conf => '/etc/named.conf'; use constant dns_named_log => '/var/log/named'; use constant service_manager => 'systemd'; use constant arch => 'x86_64'; use constant maillog_path => '/var/log/maillog'; use constant supports_hostaccess => 1; use constant rsyslog_triggered_by_socket => 0; use constant packages_supplemental_epel => []; use constant quota_packages_conditional => {}; use constant unsupported_db_versions => []; use constant mariadb_repo_template => ''; # Not provided on ubuntu for instance. use constant mariadb_minimum_supported_version => '10.0'; use constant mysql_default_version => '5.7'; use constant postgresql_minimum_supported_version => undef; use constant postgresql_packages => []; use constant postgresql_service_aliases => []; use constant postgresql_initdb_commands => []; use constant openssl_minimum_supported_version => '1.0.2e'; use constant ea4_install_repo_from_package => 0; use constant ea4_from_pkg_url => undef; use constant ea4_from_pkg_reponame => undef; use constant ea4_from_custom_repo_url => undef; use constant ea4_from_custom_repo_path => undef; use constant ea4_testing_yum_repo => undef; use constant ea4tooling_all => [qw{ ea-cpanel-tools ea-profiles-cpanel }]; sub ea4tooling_dnsonly { return Carp::confess('unimplemented for this distro') } sub ea4tooling { return Carp::confess('unimplemented for this distro') } sub system_exclude_rules { return Carp::confess('unimplemented for this distro') } sub base_distro { return Carp::confess('unimplemented for this distro') } sub kernel_package_pattern { return Carp::confess('unimplemented for this distro') } use constant check_kernel_version_method => q[grubby]; use constant stock_kernel_version_regex => undef; sub mysql_versions_use_repo_template { return Carp::confess('unimplemented for this distro') } sub mariadb_versions_use_repo_template { return Carp::confess('unimplemented for this distro') } sub binary_sync_source { return Carp::confess('unimplemented for this distro') } use constant package_repositories => []; use constant system_package_providing_perl => 'perl'; use constant rpm_versions_system => 'centos'; use constant packages_arch => 'x86_64'; use constant package_MySQL_Shell => q[mysql-shell]; use constant package_crond => undef; use constant retry_rpm_cmd_no_tty_hack => 0; use constant check_ntpd_pid_method => 'pid_check_var_run_ntpd'; # how to check ntp daemon pid use constant prelink_config_path => undef; use constant pam_file_controlling_crypt_algo => undef; use constant iptables_ipv4_savefile => '/etc/sysconfig/iptables'; use constant iptables_ipv6_savefile => '/etc/sysconfig/ip6tables'; use constant sysconfig_network => q[/etc/sysconfig/network]; use constant bin_grub_mkconfig => q[/usr/sbin/grub2-mkconfig]; use constant ssh_supported_algorithms => [qw{ ed25519 ecdsa rsa }]; use constant bin_needs_restarting => q[/usr/local/cpanel/bin/needs-restarting-cpanel]; use constant outdated_services_check => q[default]; use constant outdated_processes_check => q[default]; use constant check_reboot_method => q[default]; use constant program_to_apply_kernel_args => undef; use constant security_service => 'selinux'; use constant supports_kernelcare => 0; use constant supports_kernelcare_free => 0; use constant supports_or_can_become_cloudlinux => 0; use constant can_become_cloudlinux => 0; use constant supports_inetd => 0; use constant supports_syslogd => 0; use constant install_gcc_from_slc6_devtoolset => 0; use constant supports_postgresql => 0; use constant openssl_escapes_subjects => 0; use constant has_cloudlinux_enhanced_quotas => 0; use constant ea4_install_from_profile_enforce_packages => 0; use constant repos_requires_dump_flag => 0; use constant is_cloudlinux => 0; use constant can_be_elevated => 0; use constant kernel_supports_fs_protected_regular => 0; use constant needs_els => 0; use constant has_quota_support_for_xfs => 1; use constant is_systemd => 1; use constant has_tcp_wrappers => 1; use constant can_clean_plugins_repo => 1; use constant supports_cpaddons => 1; use constant pretty_distro => undef; sub display_name { return sprintf( "%s v%s.%s.%s", Cpanel::OS::pretty_distro() // '', Cpanel::OS::major() // '', Cpanel::OS::minor() // '', Cpanel::OS::build() // '' ); ## no critic(Cpanel::CpanelOS) internal usage } sub display_name_lite { return sprintf( "%s %s", lc( Cpanel::OS::distro() // '' ), Cpanel::OS::major() // '' ); ## no critic(Cpanel::CpanelOS) internal usage } sub cpanalytics_cpos { return sprintf( "%s %s.%s", uc( Cpanel::OS::distro() // '' ), Cpanel::OS::major() // '', Cpanel::OS::minor() // '' ); ## no critic(Cpanel::CpanelOS) internal usage } use constant nat_server_buffer_connections => 4; 1; } # --- END Cpanel/OS/Linux.pm { # --- BEGIN Cpanel/OS/Rhel.pm package Cpanel::OS::Rhel; use cPstrict; # use Cpanel::OS::Linux (); # ea4tooling_all # use Cpanel::OS::Linux(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Linux); } use constant is_supported => 0; # Base OS class for all Rhel derivatives. use constant pretty_distro => 'Red Hat Enterprise Linux'; use constant sudoers => 'wheel'; use constant has_wheel_group => 1; use constant dns_supported => [qw{ bind powerdns }]; use constant supports_kernelcare => 1; use constant supports_kernelcare_free => 1; use constant supports_or_can_become_cloudlinux => 1; use constant can_become_cloudlinux => 1; use constant supports_imunify_av => 1; use constant supports_imunify_av_plus => 1; use constant cron_bin_path => '/usr/sbin/crond'; use constant systemd_service_name_map => {}; use constant ea4_modern_openssl => '/opt/cpanel/ea-openssl11/bin/openssl'; use constant firewall => 'iptables'; use constant firewall_module => 'IpTables'; use constant networking => 'networkscripts'; use constant package_manager => 'yum'; use constant package_manager_module => 'Yum'; use constant base_distro => 'rhel'; use constant is_apt_based => 0; use constant is_yum_based => 1; use constant is_rpm_based => 1; use constant kernel_package_pattern => 'kernel'; use constant stock_kernel_version_regex => qr/\.(?:noarch|x86_64|i[3-6]86)$/; use constant program_to_apply_kernel_args => 'grub2-mkconfig'; use constant prelink_config_path => '/etc/sysconfig/prelink'; use constant pam_file_controlling_crypt_algo => 'system-auth'; use constant user_crontab_dir => '/var/spool/cron'; use constant ea4_from_custom_repo_url => 'https://securedownloads.cpanel.net/EA4/EA4.repo'; use constant ea4_from_custom_repo_path => '/etc/yum.repos.d/EA4.repo'; use constant ea4_conflicting_apache_distro_packages => [qw( httpd httpd-tools php-cli )]; use constant ea4tooling => [ 'yum-plugin-universal-hooks', Cpanel::OS::Linux->ea4tooling_all->@* ]; use constant ea4tooling_dnsonly => ['yum-plugin-universal-hooks']; use constant syslog_service_name => 'rsyslogd'; use constant jetbackup_repo_pkg => 'https://repo.jetlicense.com/centOS/jetapps-repo-latest.rpm'; use constant plugins_repo_url => 'https://securedownloads.cpanel.net/cpanel-plugins/0/cpanel-plugins.repo'; use constant repo_suffix => 'repo'; use constant repo_dir => '/etc/yum.repos.d'; use constant system_exclude_rules => { 'dovecot' => 'dovecot*', 'nsd' => 'nsd*', 'php' => 'php*', 'exim' => 'exim*', 'pure-ftpd' => 'pure-ftpd*', 'proftpd' => 'proftpd*', 'p0f' => 'p0f', 'filesystem' => 'filesystem', 'kernel' => 'kernel kernel-xen kernel-smp kernel-pae kernel-PAE kernel-SMP kernel-hugemem kernel-debug* kernel-core kernel-modules', 'kmod-' => 'kmod-[a-z]*', 'bind-chroot' => 'bind-chroot', }; use constant packages_supplemental => [ 'nfs-utils', qw{ ImageMagick autoconf automake bind-devel bison boost-serialization cairo e2fsprogs-devel expat-devel flex fontconfig freetype ftp gcc-c++ gd-devel gdbm-devel gettext-devel ghostscript giflib glib2 hunspell hunspell-en krb5-devel libX11-devel libXpm libXpm-devel libaio-devel libidn-devel libjpeg-turbo-devel libpng-devel libstdc++-devel libtiff-devel libtool libtool-ltdl libtool-ltdl-devel libwmf libxml2-devel libxslt-devel ncurses ncurses-devel nscd openssl-devel pango perl-CPAN perl-ExtUtils-MakeMaker perl-IO-Tty perl-Module-Build perl-YAML-Syck perl-core perl-devel perl-libwww-perl pixman python-devel python-tools quota-devel strace sysstat tcp_wrappers-devel traceroute urw-fonts zlib-devel } ]; use constant packages_supplemental_epel => [ qw{ perl-Expect perl-JSON-XS perl-Try-Tiny perl-local-lib } ]; use constant packages_required => [ qw{ aspell at bind bind-libs bind-utils binutils boost-program-options bzip2 compat-db coreutils cpio cpp crontabs curl db4 db4-devel e2fsprogs expat file gawk gcc gd gd-progs gdbm gettext glibc-devel gmp gnupg2 grubby gzip initscripts iptables iptables-ipv6 json-c kernel-headers lcms less libaio libevent libgcc libgomp libicu libidn libjpeg-turbo libpcap libpng libstdc++ libtiff libxml2 libxslt libzip lsof make nano openssh openssh-clients openssh-server openssl pam pam-devel passwd patch pcre pcre2 popt procps python python-docs python-setuptools quota rdate rsync sed shadow-utils smartmontools tar tmpwatch unzip util-linux-ng wget which xz yum-utils zip zlib } ]; use constant package_ImageMagick_Devel => 'ImageMagick-devel'; use constant package_crond => 'cronie'; use constant mysql_incompatible => [ qw{ mariadb-client mariadb-devel mariadb-embedded mariadb-embedded-devel mariadb-libs mariadb-libs-compat mariadb-release mariadb-server mariadb-test mysql-client mysql-devel mysql-embedded mysql-embedded-devel mysql-libs mysql-libs-compat mysql-release mysql-server mysql-test mysql55-mysql-bench mysql55-mysql-devel mysql55-mysql-libs mysql55-mysql-server mysql55-mysql-test mysqlclient16 rh-mysql56-mysql-bench rh-mysql56-mysql-common rh-mysql56-mysql-config rh-mysql56-mysql-devel rh-mysql56-mysql-errmsg rh-mysql56-mysql-server rh-mysql56-mysql-test rh-mysql57-mysql-common rh-mysql57-mysql-config rh-mysql57-mysql-devel rh-mysql57-mysql-errmsg rh-mysql57-mysql-server rh-mysql57-mysql-test } ]; use constant mysql_community_packages => [ qw/ mysql-community-devel mysql-community-libs-compat mysql-community-server / ]; use constant mysql_dependencies => [ qw/ coreutils grep perl-DBI shadow-utils / ]; use constant db_package_manager_key_params => { method => 'add_repo_key', keys => [qw{https://repo.mysql.com/RPM-GPG-KEY-mysql-2023 https://repo.mysql.com/RPM-GPG-KEY-MySQL-2022 https://repo.mysql.com/RPM-GPG-KEY-mysql https://archive.mariadb.org/PublicKey https://supplychain.mariadb.com/MariaDB-Server-GPG-KEY}], }; use constant mariadb_repo_template => <<'___END_REPO_TEMPLATE___'; [MariaDB###MARIADB_FLAT_VERSION_SHORT###] name = MariaDB###MARIADB_FLAT_VERSION_SHORT### baseurl = https://archive.mariadb.org/mariadb-###MARIADB_VERSION_SHORT###/yum/centos/###DISTRO_MAJOR###/x86_64 gpgkey=https://archive.mariadb.org/PublicKey https://supplychain.mariadb.com/MariaDB-Server-GPG-KEY gpgcheck=1 ___END_REPO_TEMPLATE___ use constant mysql_repo_template => <<'___END_REPO_TEMPLATE___'; [Mysql-connectors-community] name=MySQL Connectors Community baseurl=https://repo.mysql.com/yum/mysql-connectors-community/el/###DISTRO_MAJOR###/$basearch/ enabled=1 gpgcheck=1 gpgkey=https://repo.mysql.com/RPM-GPG-KEY-mysql-2023 https://repo.mysql.com/RPM-GPG-KEY-MySQL-2022 https://repo.mysql.com/RPM-GPG-KEY-mysql [Mysql-tools-community] name=MySQL Tools Community baseurl=https://repo.mysql.com/yum/mysql-tools-community/el/###DISTRO_MAJOR###/$basearch/ enabled=1 gpgcheck=1 gpgkey=https://repo.mysql.com/RPM-GPG-KEY-mysql-2023 https://repo.mysql.com/RPM-GPG-KEY-MySQL-2022 https://repo.mysql.com/RPM-GPG-KEY-mysql [Mysql###MYSQL_FLAT_VERSION_SHORT###-community] name=MySQL ###MYSQL_VERSION_SHORT### Community Server baseurl=https://repo.mysql.com/yum/mysql-###MYSQL_VERSION_SHORT###-community/el/###DISTRO_MAJOR###/$basearch/ enabled=1 gpgcheck=1 gpgkey=https://repo.mysql.com/RPM-GPG-KEY-mysql-2023 https://repo.mysql.com/RPM-GPG-KEY-MySQL-2022 https://repo.mysql.com/RPM-GPG-KEY-mysql [Mysql-tools-preview] name=MySQL Tools Preview baseurl=https://repo.mysql.com/yum/mysql-tools-preview/el/###DISTRO_MAJOR###/$basearch/ enabled=0 gpgcheck=1 gpgkey=https://repo.mysql.com/RPM-GPG-KEY-mysql-2023 https://repo.mysql.com/RPM-GPG-KEY-MySQL-2022 https://repo.mysql.com/RPM-GPG-KEY-mysql ___END_REPO_TEMPLATE___ use constant supports_postgresql => 1; use constant package_descriptions => { 'short' => 'summary', 'long' => 'description', }; 1; } # --- END Cpanel/OS/Rhel.pm { # --- BEGIN Cpanel/OS/Almalinux.pm package Cpanel::OS::Almalinux; use cPstrict; # use Cpanel::OS::Rhel(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } use constant is_supported => 0; use constant pretty_distro => 'AlmaLinux'; 1; } # --- END Cpanel/OS/Almalinux.pm { # --- BEGIN Cpanel/OS/Rhel6.pm package Cpanel::OS::Rhel6; use cPstrict; # use Cpanel::OS::Rhel(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } use constant is_supported => 0; use constant binary_sync_source => 'linux-c6-x86_64'; use constant package_release_distro_tag => '~el6'; use constant service_manager => 'initd'; use constant unsupported_db_versions => [qw/10.5 10.6/]; use constant mariadb_versions_use_repo_template => [qw/10.0 10.1 10.2 10.3/]; use constant mysql_versions_use_repo_template => [qw/8.0/]; use constant who_wins_if_soft_gt_hard => 'hard'; use constant postgresql_minimum_supported_version => '7.4'; use constant postgresql_packages => [ qw{ postgresql postgresql-devel postgresql-libs postgresql-server rh-postgresql rh-postgresql-devel rh-postgresql-libs rh-postgresql-server } ]; use constant postgresql_service_aliases => [qw/rhdb/]; use constant postgresql_initdb_commands => ['/sbin/service postgresql initdb']; 1; } # --- END Cpanel/OS/Rhel6.pm { # --- BEGIN Cpanel/OS/Rhel7.pm package Cpanel::OS::Rhel7; use cPstrict; # use Cpanel::OS::Rhel6(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel6); } use constant is_supported => 1; # Rhel 7 support use constant binary_sync_source => 'linux-c7-x86_64'; use constant package_release_distro_tag => '~el7'; use constant service_manager => 'systemd'; use constant unsupported_db_versions => []; use constant mariadb_versions_use_repo_template => [qw/10.0 10.1 10.2 10.3 10.5 10.6/]; use constant mysql_versions_use_repo_template => [qw/5.7 8.0/]; use constant who_wins_if_soft_gt_hard => 'soft'; use constant postgresql_minimum_supported_version => '9.2'; use constant postgresql_service_aliases => []; use constant postgresql_initdb_commands => ['/usr/bin/postgresql-setup initdb']; use constant check_ntpd_pid_method => 'systemd_ntpd'; sub packages_supplemental ($self) { my @packages = $self->SUPER::packages_supplemental()->@*; push @packages, qw/ncurses-term perl-Try-Tiny perl-local-lib/; return [ sort @packages ]; } sub packages_supplemental_epel ($self) { my @packages = $self->SUPER::packages_supplemental_epel()->@*; push @packages, qw/dpkg/; @packages = grep { my $p = $_; !grep { $p eq $_ } qw/perl-Try-Tiny perl-local-lib/; } @packages; return [ sort @packages ]; } sub packages_required ($self) { my @packages = $self->SUPER::packages_required()->@*; @packages = grep { my $p = $_; !grep { $p eq $_ } qw/db4 db4-devel iptables-ipv6 lcms procps tmpwatch util-linux-ng/ } @packages; push @packages, qw/libdb libmount net-tools procps-ng psmisc python-tools/; return [ sort @packages ]; } 1; } # --- END Cpanel/OS/Rhel7.pm { # --- BEGIN Cpanel/OS/Rhel8.pm package Cpanel::OS::Rhel8; use cPstrict; # use Cpanel::OS::Linux (); # ea4tooling_all # use Cpanel::OS::Rhel7(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel7); } use constant is_supported => 0; # Rhel 8 is NOT supported but we use it as a base class for all Rhel derivatives. use constant binary_sync_source => 'linux-c8-x86_64'; use constant ea4_modern_openssl => '/usr/bin/openssl'; use constant firewall => 'firewalld_nftables'; use constant firewall_module => 'NFTables'; use constant supports_hostaccess => 0; use constant package_manager => 'dnf'; use constant package_release_distro_tag => '~el8'; use constant kernel_supports_fs_protected_regular => 1; use constant can_clean_plugins_repo => 0; use constant mysql_community_packages => [qw/mysql-community-server mysql-community-devel/]; # Removed mysql-community-libs-compat in RHEL 8 use constant mysql_default_version => '8.0'; use constant mariadb_minimum_supported_version => '10.3'; use constant postgresql_packages => [ qw{ postgresql postgresql-devel postgresql-libs postgresql-server } ]; use constant openssl_escapes_subjects => 1; use constant ea4tooling_dnsonly => ['dnf-plugin-universal-hooks']; use constant ea4tooling => [ 'dnf-plugin-universal-hooks', Cpanel::OS::Linux->ea4tooling_all->@* ]; use constant package_repositories => [qw/epel powertools/]; use constant system_package_providing_perl => 'perl-interpreter'; use constant retry_rpm_cmd_no_tty_hack => 1; use constant check_ntpd_pid_method => 'pid_check_var_run_ntpd'; use constant has_tcp_wrappers => 0; use constant ea4_install_from_profile_enforce_packages => 1; use constant repos_requires_dump_flag => 1; use constant system_exclude_rules => { 'dovecot' => 'dovecot*', 'php' => 'php*', 'exim' => 'exim*', 'pure-ftpd' => 'pure-ftpd*', 'proftpd' => 'proftpd*', 'p0f' => 'p0f', 'filesystem' => 'filesystem', 'kernel' => 'kernel kernel-xen kernel-smp kernel-pae kernel-PAE kernel-SMP kernel-hugemem kernel-debug* kernel-core kernel-modules*', 'kmod-' => 'kmod-[a-z]*', 'bind-chroot' => 'bind-chroot', }; use constant bin_needs_restarting => q[/usr/bin/needs-restarting]; sub packages_supplemental ($self) { my @packages = $self->SUPER::packages_supplemental()->@*; @packages = grep { my $p = $_; !grep { $p eq $_ } qw/ncurses-term python-devel python-tools quota-devel tcp_wrappers-devel/ } @packages; push @packages, qw{ python2-devel }; return [ sort @packages ]; } sub packages_required ($self) { my @packages = $self->SUPER::packages_required()->@*; @packages = grep { my $p = $_; !grep { $p eq $_ } qw/compat-db gd-progs libdb libmount procps-ng psmisc python python-docs python-setuptools python-tools rdate / } @packages; push @packages, qw/dnf glibc-locale-source mailx nftables python2 python2-docs python2-setuptools python2-tools python3-dnf python3-docs python3-libdnf python3-setuptools python36 util-linux-user sqlite cmake-filesystem/; return [ sort @packages ]; } use constant nat_server_buffer_connections => 2; 1; } # --- END Cpanel/OS/Rhel8.pm { # --- BEGIN Cpanel/OS/Almalinux8.pm package Cpanel::OS::Almalinux8; use cPstrict; use Cpanel::OS::Almalinux; # use Cpanel::OS::Rhel8(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel8); } use constant is_supported => 1; # Almalinux 8 use constant pretty_distro => Cpanel::OS::Almalinux->pretty_distro; use constant supports_imunify_360 => 1; use constant supports_cpanel_cloud_edition => 1; 1; } # --- END Cpanel/OS/Almalinux8.pm { # --- BEGIN Cpanel/OS/Centos.pm package Cpanel::OS::Centos; use cPstrict; # use Cpanel::OS::Rhel(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } use constant is_supported => 0; # Base OS class for all Centos derivatives. use constant pretty_distro => 'CentOS'; 1; } # --- END Cpanel/OS/Centos.pm { # --- BEGIN Cpanel/OS/Centos7.pm package Cpanel::OS::Centos7; use cPstrict; use Cpanel::OS::Centos; # use Cpanel::OS::Rhel7(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel7); } use constant is_supported => 1; # Centos 7 use constant pretty_distro => Cpanel::OS::Centos->pretty_distro; use constant supports_imunify_360 => 1; use constant can_be_elevated => 1; use constant can_elevate_to => [qw(Almalinux8)]; use constant needs_els => 1; 1; } # --- END Cpanel/OS/Centos7.pm { # --- BEGIN Cpanel/OS/Cloudlinux.pm package Cpanel::OS::Cloudlinux; use cPstrict; # use Cpanel::OS::Rhel(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } use constant is_supported => 0; # Base class for CL. use constant is_cloudlinux => 1; use constant pretty_distro => 'CloudLinux'; use constant ea4_yum_tooling => [qw{ yum-plugin-universal-hooks ea-cpanel-tools ea-profiles-cloudlinux }]; use constant ea4_dnf_tooling => [qw{ dnf-plugin-universal-hooks ea-cpanel-tools ea-profiles-cloudlinux }]; use constant supports_kernelcare_free => 0; 1; } # --- END Cpanel/OS/Cloudlinux.pm { # --- BEGIN Cpanel/OS/Cloudlinux6.pm package Cpanel::OS::Cloudlinux6; use cPstrict; # use Cpanel::OS (); use Cpanel::OS::Cloudlinux; # use Cpanel::OS::Rhel6(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel6); } use constant is_cloudlinux => 1; use constant default_uid_min => 500; use constant default_gid_min => 500; use constant setup_tz_method => q[sysconfig]; use constant pretty_distro => Cpanel::OS::Cloudlinux->pretty_distro; use constant ea4_install_repo_from_package => 1; use constant ea4_from_pkg_url => 'https://repo.cloudlinux.com/cloudlinux/EA4/cloudlinux-ea4-release-latest-6.noarch.rpm'; use constant ea4_from_pkg_reponame => 'cloudlinux-ea4-release'; use constant ea4_from_custom_repo_url => undef; use constant ea4_from_custom_repo_path => undef; use constant ea4tooling => Cpanel::OS::Cloudlinux->ea4_yum_tooling; use constant supports_kernelcare_free => Cpanel::OS::Cloudlinux->supports_kernelcare_free; use constant has_quota_support_for_xfs => 0; use constant program_to_apply_kernel_args => 'none'; use constant ssh_supported_algorithms => [qw{ ecdsa rsa }]; use constant supports_inetd => 1; use constant supports_syslogd => 1; use constant install_gcc_from_slc6_devtoolset => 1; use constant is_systemd => 0; use constant openssl_minimum_supported_version => 0; # check skipped on CL6 use constant has_cloudlinux_enhanced_quotas => 1; use constant can_become_cloudlinux => 0; use constant supports_imunify_360 => 1; use constant outdated_services_check => q[centos6]; use constant support_needs_minor_at_least_at => 6; sub packages_required ($self) { my @packages = $self->SUPER::packages_required()->@*; push @packages, qw/alt-libcurlssl alt-libxml2/; return [ sort @packages ]; } sub is_supported { my $needs_minor = Cpanel::OS::support_needs_minor_at_least_at(); return 0 if defined $needs_minor && Cpanel::OS::minor() < $needs_minor; return 1; } 1; } # --- END Cpanel/OS/Cloudlinux6.pm { # --- BEGIN Cpanel/OS/Cloudlinux7.pm package Cpanel::OS::Cloudlinux7; use cPstrict; use Cpanel::OS::Cloudlinux; # use Cpanel::OS::Rhel7(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel7); } use constant is_supported => 1; # Cloudlinux 7 use constant is_cloudlinux => 1; use constant pretty_distro => Cpanel::OS::Cloudlinux->pretty_distro; use constant can_be_elevated => 1; use constant can_elevate_to => [qw(Cloudlinux8)]; use constant ea4_install_repo_from_package => 1; use constant ea4_from_pkg_url => 'https://repo.cloudlinux.com/cloudlinux/EA4/cloudlinux-ea4-release-latest-7.noarch.rpm'; use constant ea4_from_pkg_reponame => 'cloudlinux-ea4-release'; use constant ea4_from_custom_repo_url => undef; use constant ea4_from_custom_repo_path => undef; use constant ea4tooling => Cpanel::OS::Cloudlinux->ea4_yum_tooling; use constant supports_kernelcare_free => Cpanel::OS::Cloudlinux->supports_kernelcare_free; use constant has_cloudlinux_enhanced_quotas => 1; use constant program_to_apply_kernel_args => 'none'; use constant can_become_cloudlinux => 0; use constant supports_imunify_360 => 1; 1; } # --- END Cpanel/OS/Cloudlinux7.pm { # --- BEGIN Cpanel/OS/Cloudlinux8.pm package Cpanel::OS::Cloudlinux8; use cPstrict; use Cpanel::OS::Cloudlinux; # use Cpanel::OS::Rhel8(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel8); } use constant is_supported => 1; # Cloudlinux 8 use constant is_cloudlinux => 1; use constant pretty_distro => Cpanel::OS::Cloudlinux->pretty_distro; use constant ea4_install_from_profile_enforce_packages => 0; use constant ea4_install_repo_from_package => 1; use constant ea4_from_pkg_url => 'https://repo.cloudlinux.com/cloudlinux/EA4/cloudlinux-ea4-release-latest-8.noarch.rpm'; use constant ea4_from_pkg_reponame => 'cloudlinux-ea4-release'; use constant ea4_from_custom_repo_url => undef; use constant ea4_from_custom_repo_path => undef; use constant ea4_testing_yum_repo => 'cl-ea4-testing'; use constant ea4tooling => Cpanel::OS::Cloudlinux->ea4_dnf_tooling; use constant package_repositories => [qw/cloudlinux-PowerTools epel/]; use constant supports_kernelcare_free => Cpanel::OS::Cloudlinux->supports_kernelcare_free; use constant has_cloudlinux_enhanced_quotas => 1; use constant can_become_cloudlinux => 0; use constant supports_imunify_360 => 1; 1; } # --- END Cpanel/OS/Cloudlinux8.pm { # --- BEGIN Cpanel/OS/Ubuntu.pm package Cpanel::OS::Ubuntu; use cPstrict; # use Cpanel::OS::Linux (); # ea4tooling_all # use Cpanel::OS::Linux(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Linux); } use constant is_supported => 0; use constant nogroup => q[nogroup]; use constant sudoers => 'sudo'; # Warning: need to change dynamicui.conf when updating this value use constant has_wheel_group => 0; use constant default_sys_uid_min => 100; use constant default_sys_gid_min => 100; use constant pretty_distro => 'Ubuntu'; use constant firewall => 'ufw_iptables'; use constant firewall_module => 'IpTables'; use constant networking => 'netplan'; use constant sysconfig_network => undef; use constant package_manager => 'apt'; use constant package_manager_module => 'Apt'; use constant is_apt_based => 1; use constant is_yum_based => 0; use constant is_rpm_based => 0; use constant base_distro => 'debian'; use constant supports_cpaddons => 0; use constant kernel_supports_fs_protected_regular => 1; use constant rpm_versions_system => 'ubuntu'; use constant packages_arch => 'amd64'; use constant mariadb_versions_use_repo_template => []; use constant mysql_versions_use_repo_template => ['8.0']; use constant db_package_manager_key_params => { method => 'add_repo_key_by_id', keys => [ 'A8D3785C', # For MySQL 8.0.36 and up '3A79BD29', # For MySQL 8.0.28 and up '5072E1F5', # For MySQL 8.0.27 and below 'C74CD1D8', # For all MariaDB versions ], }; use constant who_wins_if_soft_gt_hard => 'hard'; use constant security_service => 'apparmor'; use constant cron_bin_path => '/usr/sbin/cron'; use constant systemd_service_name_map => { 'crond' => 'cron' }; use constant ea4_modern_openssl => '/usr/bin/openssl'; use constant kernel_package_pattern => '^linux-image-[0-9]'; use constant check_kernel_version_method => q[boot-vmlinuz-file]; use constant stock_kernel_version_regex => qr/-(?:(?:(?:generic|lowlatency)(?:-hwe)?)|kvm|aws|azure|gcp|oracle)$/; use constant openssl_escapes_subjects => 1; use constant prelink_config_path => '/etc/default/prelink'; use constant pam_file_controlling_crypt_algo => 'common-password'; use constant user_crontab_dir => '/var/spool/cron/crontabs'; use constant supports_kernelcare => 1; use constant supports_kernelcare_free => 1; use constant iptables_ipv4_savefile => '/etc/iptables/rules.v4'; use constant iptables_ipv6_savefile => '/etc/iptables/rules.v6'; use constant mysql_incompatible => [ qw{ default-mysql-server default-mysql-server-core mariadb-client mariadb-client-10.3 mariadb-server mariadb-server-10.3 mariadb-test mysql-client-8.0 mysql-server-8.0 mysql-testsuite mysql-testsuite-8.0 } ]; use constant mysql_community_packages => [qw/mysql-community-server mysql-shell libmysqlclient-dev/]; use constant mysql_dependencies => [qw/libdbi-perl passwd adduser login coreutils/]; use constant mysql_default_version => '8.0'; use constant mariadb_minimum_supported_version => '10.3'; use constant outdated_services_check => q[needrestart_b]; use constant outdated_processes_check => q[checkrestart]; use constant check_reboot_method => q[check-reboot-required]; use constant bin_needs_restarting => undef; # The needs-restarting program is not supported on Ubuntu, so blank it out to reduce confusion. use constant syslog_service_name => 'rsyslog'; use constant rsyslog_triggered_by_socket => 1; use constant ea4_from_custom_repo_url => 'https://securedownloads.cpanel.net/EA4/EA4.list'; use constant ea4_from_custom_repo_path => '/etc/apt/sources.list.d/EA4.list'; use constant ea4_conflicting_apache_distro_packages => [qw( apache2 apache2-utils php-cli )]; use constant ea4tooling_dnsonly => ['apt-plugin-universal-hooks']; use constant ea4tooling => [ 'apt-plugin-universal-hooks', Cpanel::OS::Linux->ea4tooling_all->@* ]; use constant system_exclude_rules => { 'dovecot' => 'dovecot*', 'exim' => 'exim*', 'filesystem' => 'base-files', # block Ubuntu updates to current installed version (20.04) 'kernel' => 'linux-headers* linux-image* linux-modules*', 'nsd' => 'nsd', 'p0f' => 'p0f', 'php' => 'php*', 'proftpd' => 'proftpd*', 'pure-ftpd' => 'pure-ftpd*', }; use constant packages_supplemental => [ 'nfs-common', qw{ libcpan-perl-releases-perl libexpect-perl libio-pty-perl libjson-xs-perl liblocal-lib-perl libmodule-build-perl libtry-tiny-perl libwww-perl libyaml-syck-perl lsof nscd rpm strace sysstat tcpd util-linux } ]; use constant can_clean_plugins_repo => 0; use constant jetbackup_repo_pkg => 'https://repo.jetlicense.com/ubuntu/jetapps-repo-latest_amd64.deb'; use constant repo_suffix => 'list'; use constant repo_dir => '/etc/apt/sources.list.d'; use constant packages_required => [ qw{ acl apt-file apt-transport-https aspell at bind9 bind9-libs bind9-utils binutils bzip2 coreutils cpio cpp cracklib-runtime cron curl debian-goodies debianutils e2fsprogs expat file g++ g++-9 gawk gcc gdbmtool gettext glibc-source gnupg2 graphicsmagick-imagemagick-compat gzip icu-devtools iptables iptables-persistent language-pack-en-base less libaio1 libapt-pkg-perl libboost-program-options1.71.0 libcairo2-dev libcrack2 libdb5.3 libevent-2.1-7 libfile-fcntllock-perl libfontconfig1-dev libgcc1 libgd-tools libgd3 libgmp10 libgomp1 libicu-dev libicu66 libidn11 libjpeg-turbo8 liblua5.3-dev libmount1 libmysqlclient21 libncurses5 libpam0g libpam0g-dev libpango-1.0-0 libpangocairo-1.0-0 libpcap0.8 libpcre2-8-0 libpcre2-posix2 libpcre3 libpixman-1-0 libpng16-16 libpopt0 libreadline-dev libssl-dev libstdc++-9-dev libstdc++6 libtiff5 libuser libxml2 libxml2-dev libxslt1.1 libzip5 linux-libc-dev lsof make nano needrestart net-tools openssh-client openssh-server openssl passwd patch pcre2-utils procps python-setuptools python2 python2-doc python2.7-dev quota rdate rsync sed smartmontools ssl-cert sysstat tar unzip usrmerge wget xz-utils zip zlib1g } ]; use constant package_ImageMagick_Devel => 'libmagick++-6.q16-dev'; use constant package_crond => 'cron'; use constant system_package_providing_perl => 'perl-base'; use constant bin_grub_mkconfig => q[/usr/sbin/grub-mkconfig]; use constant program_to_apply_kernel_args => 'grub-mkconfig'; use constant package_descriptions => { 'short' => 'description', 'long' => 'longdesc', }; use constant nat_server_buffer_connections => 2; 1; } # --- END Cpanel/OS/Ubuntu.pm { # --- BEGIN Cpanel/OS/Ubuntu20.pm package Cpanel::OS::Ubuntu20; use cPstrict; # use Cpanel::OS::Ubuntu(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Ubuntu); } use constant is_supported => 1; use constant binary_sync_source => 'linux-u20-x86_64'; use constant package_release_distro_tag => '~u20'; use constant maillog_path => '/var/log/mail.log'; use constant plugins_repo_url => 'https://securedownloads.cpanel.net/cpanel-plugins/cpanel-plugins.list'; use constant supports_imunify_360 => 1; use constant supports_cpanel_cloud_edition => 1; use constant mysql_repo_template => <<'___END_REPO_TEMPLATE___'; deb https://repo.mysql.com/apt/ubuntu/ focal mysql-apt-config deb https://repo.mysql.com/apt/ubuntu/ focal mysql-###MYSQL_VERSION_SHORT### deb https://repo.mysql.com/apt/ubuntu/ focal mysql-tools deb-src https://repo.mysql.com/apt/ubuntu/ focal mysql-###MYSQL_VERSION_SHORT### ___END_REPO_TEMPLATE___ use constant quota_packages_conditional => { 'linux-aws' => ['linux-modules-extra-aws'], 'linux-aws-edge' => ['linux-modules-extra-aws-edge'], 'linux-aws-lts-20.04' => ['linux-modules-extra-aws-lts-20.04'], 'linux-azure' => ['linux-modules-extra-azure'], 'linux-azure-cvm' => ['linux-modules-extra-azure-cvm'], 'linux-azure-edge' => ['linux-modules-extra-azure-edge'], 'linux-azure-fde' => ['linux-modules-extra-azure-fde'], 'linux-azure-lts-20.04' => ['linux-modules-extra-azure-lts-20.04'], 'linux-gcp' => ['linux-modules-extra-gcp'], 'linux-gcp-edge' => ['linux-modules-extra-gcp-edge'], 'linux-gcp-lts-20.04' => ['linux-modules-extra-gcp-lts-20.04'], 'linux-gke' => ['linux-modules-extra-gke'], 'linux-gke-5.4' => ['linux-modules-extra-gke-5.4'], 'linux-gkeop' => ['linux-modules-extra-gkeop'], 'linux-gkeop-5.4' => ['linux-modules-extra-gkeop-5.4'], 'linux-ibm' => ['linux-modules-extra-ibm'], 'linux-ibm-lts-20.04' => ['linux-modules-extra-ibm-lts-20.04'], 'linux-virtual' => ['linux-image-extra-virtual'], 'linux-virtual-hwe-20.04' => ['linux-image-extra-virtual-hwe-20.04'], 'linux-virtual-hwe-20.04-edge' => ['linux-image-extra-virtual-hwe-20.04-edge'], }; 1; } # --- END Cpanel/OS/Ubuntu20.pm { # --- BEGIN Cpanel/OS/Rocky.pm package Cpanel::OS::Rocky; use cPstrict; # use Cpanel::OS::Rhel(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } use constant is_supported => 0; use constant pretty_distro => 'Rocky Linux'; 1; } # --- END Cpanel/OS/Rocky.pm { # --- BEGIN Cpanel/OS/Rocky8.pm package Cpanel::OS::Rocky8; use cPstrict; use Cpanel::OS::Rocky; # use Cpanel::OS::Rhel8(); our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel8); } use constant is_supported => 1; # Rockylinux 8 use constant pretty_distro => Cpanel::OS::Rocky->pretty_distro; use constant supports_imunify_360 => 1; 1; } # --- END Cpanel/OS/Rocky8.pm { # --- BEGIN Cpanel/OS/All.pm package Cpanel::OS::All; use cPstrict; use utf8; # use Cpanel::OS::Almalinux8 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Centos7 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Cloudlinux6 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Cloudlinux7 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Cloudlinux8 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Rhel7 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Ubuntu20 (); # PPI USE OK - fatpack usage # use Cpanel::OS::Rocky8 (); # PPI USE OK - fatpack usage sub supported_distros() { return ( [ Almalinux => 8 ], [ Centos => 7 ], [ Cloudlinux => 6 ], [ Cloudlinux => 7 ], [ Cloudlinux => 8 ], [ Rhel => 7 ], [ Rocky => 8 ], [ Ubuntu => 20 ], ); } sub advertise_supported_distros() { my $current_name; my $current_versions = []; my $advertise = ''; my $map_os_display_name = { 'Almalinux' => 'AlmaLinux', 'Centos' => 'CentOS', 'Rhel' => 'Red Hat Enterprise Linux', 'Cloudlinux' => 'CloudLinux®', 'Rocky' => 'Rocky Linux™', }; foreach my $d ( supported_distros() ) { my ( $name, $version ) = $d->@*; if ( !defined $current_name ) { $current_name = $name; push $current_versions->@*, $version; next; } if ( $current_name eq $name ) { push $current_versions->@*, $version; } else { my $display_name = $map_os_display_name->{$current_name} // $current_name; $advertise .= $display_name . ' ' . join( '/', $current_versions->@* ) . ', '; $current_name = $name; $current_versions = [$version]; } } if ( defined $current_name ) { my $display_name = $map_os_display_name->{$current_name} // $current_name; $advertise .= $display_name . ' ' . join( '/', $current_versions->@* ); } return $advertise; } 1; } # --- END Cpanel/OS/All.pm { # --- BEGIN Cpanel/TimeHiRes.pm package Cpanel::TimeHiRes; use strict; use warnings; 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/Struct/Common/Time.pm package Cpanel::Struct::Common::Time; use strict; use warnings; 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; # use Cpanel::Struct::Common::Time(); 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; # use Cpanel::Struct::timespec (); 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; # use Cpanel::Struct::timespec (); 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; 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/Env.pm package Cpanel::Env; use strict; use warnings; 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 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/Autodie.pm package Cpanel::Autodie; use strict; use warnings; 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/Fcntl/Constants.pm package Cpanel::Fcntl::Constants; use strict; use warnings; 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/Fcntl.pm package Cpanel::Fcntl; use strict; use warnings; # use Cpanel::Fcntl::Constants (); 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/Touch.pm package Cpanel::FileUtils::Touch; use strict; use warnings; use Try::Tiny; use Cpanel::Autodie; use Cpanel::Fcntl; sub touch_if_not_exists { my ($path) = @_; my $fh; try { Cpanel::Autodie::sysopen( $fh, $path, Cpanel::Fcntl::or_flags(qw( O_WRONLY O_CREAT O_EXCL )), ); } catch { undef $fh; if ( !try { $_->error_name() eq 'EEXIST' } ) { local $@ = $_; die; } }; return $fh ? 1 : 0; } 1; } # --- END Cpanel/FileUtils/Touch.pm { # --- BEGIN Cpanel/Config/TouchFileBase.pm package Cpanel::Config::TouchFileBase; use strict; use warnings; # use Cpanel::Autodie (); # use Cpanel::Exception (); sub _TOUCH_FILE { die Cpanel::Exception::create('AbstractClass') } sub is_on { my ( $self, @args ) = @_; my $exists = Cpanel::Autodie::exists( $self->_TOUCH_FILE(@args) ); if ( $exists && !-f _ ) { die Cpanel::Exception->create( '“[_1]” exists but is not a file!', [ $self->_TOUCH_FILE(@args) ] ); } return $exists; } sub set_on { my ( $self, @args ) = @_; my $path = $self->_TOUCH_FILE(@args); require Cpanel::FileUtils::Touch; return Cpanel::FileUtils::Touch::touch_if_not_exists($path); } sub set_off { my ( $self, @args ) = @_; return Cpanel::Autodie::unlink_if_exists( $self->_TOUCH_FILE(@args) ); } 1; } # --- END Cpanel/Config/TouchFileBase.pm { # --- BEGIN Cpanel/Update/IsCron.pm package Cpanel::Update::IsCron; use strict; use warnings; # use Cpanel::Config::TouchFileBase(); our @ISA; BEGIN { push @ISA, qw(Cpanel::Config::TouchFileBase); } our $_PATH = '/var/cpanel/upgrade_is_from_cron'; sub _TOUCH_FILE { return $_PATH } 1; } # --- END Cpanel/Update/IsCron.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/FileUtils/Open.pm package Cpanel::FileUtils::Open; use strict; # use Cpanel::Fcntl (); 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; 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 (); 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{[$error_container_text]}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("$error_container_text"); } 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{[$error_container_text]}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("[$error_container_text]"); } 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 = ( '(?(); } 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[
$error_container_message [show] [close]
]; } 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 _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; 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/SafeFileLock.pm package Cpanel::SafeFileLock; use strict; use warnings; 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; 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; # use Cpanel::SafeFileLock (); 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; 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/Context.pm package Cpanel::Context; use strict; use warnings; # use Cpanel::Exception (); 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/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/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; # use Cpanel::Autodie (); # use Cpanel::Context (); # use Cpanel::Exception (); # use Cpanel::Fcntl::Constants (); # use Cpanel::Pack (); # use Cpanel::Syscall (); 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; # use Cpanel::TimeHiRes (); # use Cpanel::Fcntl::Constants (); # use Cpanel::SafeFileLock (); # use Cpanel::FHUtils::Tiny (); 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) { $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/Linux/Constants.pm package Cpanel::Linux::Constants; use strict; use warnings; 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; # use Cpanel::Exception (); # use Cpanel::Linux::Constants (); 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; # use Cpanel::Set (); # use Cpanel::Fcntl (); # use Cpanel::SafeFile (); # use Cpanel::LoadModule (); # use Cpanel::Validate::FilesystemNodeName (); # use Cpanel::Exception (); # use Cpanel::Debug (); 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 (); 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; 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(); 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 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/SafeDir/MK.pm package Cpanel::SafeDir::MK; use strict; use warnings; # use Cpanel::Debug (); 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/FHUtils/Autoflush.pm package Cpanel::FHUtils::Autoflush; use strict; use warnings; 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/Update/Logger.pm package Cpanel::Update::Logger; use strict; use warnings; # use Cpanel::SafeDir::MK (); # use Cpanel::Time::Local (); # use Cpanel::FHUtils::Autoflush (); use File::Basename (); use constant { DEBUG => 0, INFO => 25, WARN => 50, ERROR => 75, FATAL => 100, }; our $VERSION = '1.2'; our $_BACKLOG_TIE_CLASS; sub new { my $class = shift; my $self = shift || {}; ref($self) eq 'HASH' or CORE::die("hashref not passed to new"); bless( $self, $class ); $self->{'stdout'} = 1 if ( !defined $self->{'stdout'} ); $self->{'timestamp'} = 1 if ( !defined $self->{'timestamp'} ); if ( $self->{'to_memory'} ) { $self->{'backlog'} = []; tie @{ $self->{'backlog'} }, $_BACKLOG_TIE_CLASS if $_BACKLOG_TIE_CLASS; } eval { $self->set_logging_level( $self->{'log_level'} ); 1 } or CORE::die("An invalid logging level was passed to new: $self->{'log_level'}"); $self->open_log() if $self->{'logfile'}; if ( exists $self->{'pbar'} and defined $self->{'pbar'} ) { $self->{'pbar'} += 0; $self->update_pbar( $self->{'pbar'} ); } return $self; } sub open_log { my $self = shift or CORE::die(); my $log_file = $self->{'logfile'}; my $logfile_dir = File::Basename::dirname($log_file); my $created_dir = 0; if ( !-d $logfile_dir ) { Cpanel::SafeDir::MK::safemkdir( $logfile_dir, '0700', 2 ); $created_dir = 1; } my $old_umask = umask(0077); # Case 92381: Logs should not be world-readable open( my $fh, '>>', $log_file ) or do { CORE::die("Failed to open '$log_file' for append: $!"); }; umask($old_umask); Cpanel::FHUtils::Autoflush::enable($fh); Cpanel::FHUtils::Autoflush::enable( \*STDOUT ) if $self->{'stdout'}; $self->{'fh'} = $fh; unless ( $self->{brief} ) { print {$fh} '-' x 100 . "\n"; print {$fh} "=> Log opened from $0 ($$) at " . localtime(time) . "\n"; } $self->warning("Had to create directory $logfile_dir before opening log") if ($created_dir); return; } sub close_log { my $self = shift or CORE::die(); return if ( !$self->{'fh'} ); my $fh = $self->{'fh'}; unless ( $self->{brief} ) { print {$fh} "=> Log closed " . localtime(time) . "\n"; } warn("Failed to close file handle for $self->{'logfile'}") if ( !close $fh ); delete $self->{'fh'}; return; } sub DESTROY { my $self = shift or CORE::die("DESTROY called without an object"); $self->close_log if ( $self->{'fh'} ); return; } sub log { my $self = shift or CORE::die("log called as a class"); ref $self eq __PACKAGE__ or CORE::die("log called as a class"); my $msg = shift or return; my $stdout = shift; $stdout = $self->{'stdout'} if ( !defined $stdout ); my $to_memory = $self->{'to_memory'}; my $fh = $self->{'fh'}; foreach my $line ( split( /[\r\n]+/, $msg ) ) { if ( $self->{'timestamp'} ) { substr( $line, 0, 0, '[' . Cpanel::Time::Local::localtime2timestamp() . '] ' ); } chomp $line; print STDOUT "$line\n" if $stdout; print {$fh} "$line\n" if $fh; push @{ $self->{'backlog'} }, "$line" if ($to_memory); } return; } sub _die { my $self = shift or CORE::die(); my $message = shift || ''; $self->log("***** DIE: $message"); return CORE::die( "exit level [die] [pid=$$] ($message) " . join ' ', caller() ); } sub fatal { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > FATAL ); my $message = shift || ''; $self->log("***** FATAL: $message"); $self->set_need_notify(); return; } sub error { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > ERROR ); my $message = shift || ''; $self->log("E $message"); return; } sub warning { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > WARN ); my $message = shift || ''; $self->log("W $message"); return; } sub panic { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > ERROR ); my $message = shift || ''; $self->log("***** PANIC!"); $self->log("E $message"); $self->log("***** PANIC!"); $self->set_need_notify(); return; } sub info { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > INFO ); my $message = shift || ''; $self->log(" $message"); return; } sub debug { my $self = shift or CORE::die(); return if ( $self->{'log_level_numeric'} > DEBUG ); my $message = shift || ''; $self->log("D $message"); return; } sub get_logging_level { return shift->{'log_level'} } sub set_logging_level { my $self = shift or CORE::die(); my $log_level = shift; $log_level = 'info' if ( !defined $log_level ); my $old_log_level = $self->get_logging_level(); if ( $log_level =~ m/^fatal/i ) { $self->{'log_level'} = 'fatal'; $self->{'log_level_numeric'} = FATAL; } elsif ( $log_level =~ m/^error/i ) { $self->{'log_level'} = 'error'; $self->{'log_level_numeric'} = ERROR; } elsif ( $log_level =~ m/^warn/i ) { $self->{'log_level'} = 'warning'; $self->{'log_level_numeric'} = WARN; } elsif ( $log_level =~ m/^info/i ) { $self->{'log_level'} = 'info'; $self->{'log_level_numeric'} = INFO; } elsif ( $log_level =~ m/^debug/i ) { $self->{'log_level'} = 'debug'; $self->{'log_level_numeric'} = DEBUG; } else { CORE::die("Unknown logging level '$log_level' passed to set_logging_level"); } return $old_log_level; } sub get_pbar { return shift->{'pbar'} } sub increment_pbar { my $self = shift or CORE::die(); return if ( !exists $self->{'pbar'} ); my $amount = shift || 1; my $new_value = $self->{'pbar'} + $amount; return $self->update_pbar($new_value); } sub update_pbar { my $self = shift or CORE::die(); return if ( !exists $self->{'pbar'} ); my $new_value = shift || 0; if ( $new_value > 100 ) { $self->debug("Pbar set to > 100 ($new_value)"); $new_value = 100; } return if $new_value == $self->{'pbar'}; $self->{'pbar'} = $new_value; $self->info( $new_value . '% complete' ); return; } sub set_need_notify { my $self = shift; ref $self eq __PACKAGE__ or CORE::die("log called as a class"); $self->info("The Administrator will be notified to review this output when this script completes"); return $self->{'need_notify'} = 1; } sub get_need_notify { my $self = shift; ref $self eq __PACKAGE__ or CORE::die("log called as a class"); return $self->{'need_notify'}; } sub get_stored_log { my $self = shift; ref $self eq __PACKAGE__ or CORE::die("log called as a class"); return if ( !$self->{'to_memory'} ); return $self->{'backlog'}; } sub get_next_log_message { my $self = shift; ref $self eq __PACKAGE__ or CORE::die("log called as a class"); return if ( !$self->{'to_memory'} ); return shift @{ $self->{'backlog'} }; } sub success { goto \&info; } sub out { goto \&info; } sub warn { goto \&warning; } sub die { goto \&_die; } 1; } # --- END Cpanel/Update/Logger.pm { # --- BEGIN Cpanel/FileUtils/TouchFile.pm package Cpanel::FileUtils::TouchFile; use strict; use warnings; 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/LoadFile/ReadFast.pm package Cpanel::LoadFile::ReadFast; use strict; use warnings; 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; # use Cpanel::Exception (); # use Cpanel::Fcntl::Constants (); # use Cpanel::LoadFile::ReadFast (); 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/Usage.pm package Cpanel::Usage; my $g_prefs; # Ref to hash containing up to three boolean preferences, as follows: $Cpanel::Usage::VERSION = '1.08'; sub version { # Reports our current revision number. $Cpanel::Usage::VERSION; } sub wrap_options { my $arg1 = $_[0]; $g_prefs = {}; if ( defined $arg1 && ( ref $arg1 ) =~ /\bHASH\b/ ) { # hash of preferences $g_prefs = $arg1; shift; } my ( $ar_argv, $cr_usage, $hr_opts ) = @_; getoptions( usage( $ar_argv, $cr_usage ), $hr_opts ); } sub usage { my ( $ar_argv, $cr_usage ) = @_; foreach my $arg (@$ar_argv) { if ( $arg =~ /^-+(h|help|usage)$/ ) { if ( defined($cr_usage) ) { &$cr_usage(); } return 1; } } $ar_argv; } sub getoptions { my ( $ar_cmdline, $hr ) = @_; my $non_opt_arg_seen = ""; return $ar_cmdline if ( ref $ar_cmdline || "" ) !~ /\bARRAY\b/; if ( !$#$ar_cmdline && $ar_cmdline->[0] eq "1" ) { return 1; } unless ( defined $hr && ( ref $hr ) =~ /\bHASH\b/ ) { print "Error: opts must be a hash reference\n"; return 2; } my $predefined = keys %{$hr}; my @cmdline_out = @$ar_cmdline; # save a copy of the arg array if ( !$predefined ) { if ( no_switches($ar_cmdline) ) { my $i = 0; foreach my $arg (@$ar_cmdline) { $hr->{ $i++ } = $arg; } return ""; } } if ($predefined) { my $default_value = exists $g_prefs->{'default_value'} ? $g_prefs->{'default_value'} : 0; foreach my $k ( keys %$hr ) { if ( ref( $hr->{$k} ) =~ /^HASH/ ) { foreach my $kk ( keys %{ $hr->{$k} } ) { ${ $hr->{$k}->{$kk} } = $default_value unless ( defined ${ $hr->{$k}->{$kk} } ); } } else { ${ $hr->{$k} } = $default_value unless ( defined ${ $hr->{$k} } ); } } } my $seen_dash_dash = 0; for ( my $i = 0; $i <= $#$ar_cmdline; $i++ ) { if ( $ar_cmdline->[$i] eq '--' ) { $seen_dash_dash = 1; } elsif ( !$seen_dash_dash && $ar_cmdline->[$i] =~ /^-+(.+)$/ ) { my $o = $1; if ( "" ne $non_opt_arg_seen and $g_prefs->{'require_left'} ) { print qq{Error: Preference require_left was specified, all opt args must therefore appear first on the command line; option "-$o" found after "$non_opt_arg_seen" violates this rule\n}; return 3; } my $eq_value = ''; if ( $o =~ /(.+?)=(.+)/ ) { $o = $1; $eq_value = $2; $eq_value =~ s@^\s+@@; $eq_value =~ s@\s+$@@; } if ( $g_prefs->{'strict'} && $predefined && !exists $hr->{$o} ) { print qq{Error: While "strict" is in effect, we have encountered option --$o on the command line, an option that was not specified in the opts hash.\n}; return 4; } if ( # It is a "lone switch", that is, an $eq_value eq '' && ( $i == $#$ar_cmdline || $ar_cmdline->[ $i + 1 ] =~ /^-+.+$/ ) ) { if ( ref( $hr->{$o} ) =~ /^HASH/ ) { foreach my $kk ( keys %{ $hr->{$o} } ) { if ($predefined) { ${ $hr->{$o}->{$kk} }++ if ( exists( $hr->{$o} ) ); } } } else { if ($predefined) { ${ $hr->{$o} }++ if ( exists( $hr->{$o} ) ); } else { $hr->{ _multihelp($o) }++; } } } else { # not a "lone switch"; the next arg might be the value if ( ref( $hr->{$o} ) =~ /^HASH/ ) { print "Error: A multi-level option can only be used when implicitly boolean (true), but you have attempted to use a multi-level option with an explicitly specified option argument.\n"; return 5; } if ( $eq_value ne '' ) { # Sorry, we already have a value for the switch if ($predefined) { ${ $hr->{$o} } = $eq_value if ( exists( $hr->{$o} ) ); } else { $hr->{$o} = $eq_value; } } else { # We have no value yet for the switch, so use next arg as the value $cmdline_out[$i] = undef if $g_prefs->{'remove'}; ++$i; if ($predefined) { ${ $hr->{$o} } = $ar_cmdline->[$i] if ( exists( $hr->{$o} ) ); } else { $hr->{$o} = $ar_cmdline->[$i]; } } } $cmdline_out[$i] = undef if $g_prefs->{'remove'}; } else { # It's a regular (non-hyphen-prefixed) arg, not an option arg if ( "" eq $non_opt_arg_seen ) { $non_opt_arg_seen = $ar_cmdline->[$i]; } } } if ( $g_prefs->{'remove'} ) { @cmdline_out = grep { defined } @cmdline_out; @{$ar_cmdline} = @cmdline_out; } return ""; # aka 0, successful completion } sub _multihelp { # For internal use only my $name = shift; return $name =~ /^(h|help|usage)$/ ? 'help' : $name; } sub no_switches { my $ar = shift; return !grep { /^-+.+/ } @{$ar}; } sub dump_args { my $hr_opts = shift; require Data::Dumper; print Data::Dumper::Dumper($hr_opts); } 1; } # --- END Cpanel/Usage.pm { # --- BEGIN Cpanel/UPID.pm package Cpanel::UPID; use strict; use warnings; # use Cpanel::LoadFile (); my $_boot_time; sub get { my ($pid) = @_; die "Need PID, not “$pid”!" if !$pid || $pid =~ tr<0-9><>c; my $start_delta = _get_pid_start_delta($pid); return undef if !$start_delta; $_boot_time ||= _get_boot_time(); return join( '.', $pid, $start_delta, $_boot_time ); } sub extract_pid { my ($upid) = @_; return substr( $upid, 0, index( $upid, '.' ) ); } sub is_alive { my ($upid) = @_; my $pid = extract_pid($upid); return ( $upid eq ( Cpanel::UPID::get($pid) // q<> ) ); } sub _get_boot_time { my $proc_stat = Cpanel::LoadFile::load('/proc/stat'); my $where_btime = index( $proc_stat, 'btime ' ); die '/proc/stat format changed???' if $where_btime == -1; my $where_lf = index( $proc_stat, "\n", $where_btime ); my $number_start = 6 + $where_btime; return substr( $proc_stat, $number_start, $where_lf - $number_start ); } sub _get_pid_start_delta { my ($pid) = @_; my $proc_pid_stat = Cpanel::LoadFile::load_if_exists("/proc/$pid/stat"); return undef if !$proc_pid_stat; my $right_paren_at = rindex( $proc_pid_stat, ')' ); substr( $proc_pid_stat, 0, 2 + $right_paren_at, q<> ); return ( split m<\s+>, $proc_pid_stat )[19]; } 1; } # --- END Cpanel/UPID.pm { # --- BEGIN Cpanel/Unix/PID/Tiny.pm package Cpanel::Unix::PID::Tiny; use strict; $Cpanel::Unix::PID::Tiny::VERSION = 0.9_2; sub new { my ( $self, $args_hr ) = @_; $args_hr->{'minimum_pid'} = 11 if !exists $args_hr->{'minimum_pid'} || $args_hr->{'minimum_pid'} !~ m{\A\d+\z}ms; # this does what one assumes m{^\d+$} would do if ( defined $args_hr->{'ps_path'} ) { $args_hr->{'ps_path'} .= '/' if $args_hr->{'ps_path'} !~ m{/$}; if ( !-d $args_hr->{'ps_path'} || !-x "$args_hr->{'ps_path'}ps" ) { $args_hr->{'ps_path'} = ''; } } else { $args_hr->{'ps_path'} = ''; } return bless { 'ps_path' => $args_hr->{'ps_path'}, 'minimum_pid' => $args_hr->{'minimum_pid'} }, $self; } sub kill { my ( $self, $pid, $give_kill_a_chance ) = @_; $give_kill_a_chance = int $give_kill_a_chance if defined $give_kill_a_chance; $pid = int $pid; my $min = int $self->{'minimum_pid'}; if ( $pid < $min ) { warn "kill() called with integer value less than $min"; return; } return 1 unless $self->is_pid_running($pid); my @signals = ( 15, 2, 1, 9 ); # TERM, INT, HUP, KILL foreach my $signal ( 15, 2, 1, 9 ) { # TERM, INT, HUP, KILL _kill( $signal, $pid ); if ($give_kill_a_chance) { my $start_time = time(); while ( time() < $start_time + $give_kill_a_chance ) { if ( $self->is_pid_running($pid) ) { select( undef, undef, undef, 0.25 ); } else { return 1; } } } return 1 unless $self->is_pid_running($pid); } return; } sub is_pid_running { my ( $self, $check_pid ) = @_; $check_pid = int $check_pid; return if !$check_pid || $check_pid < 0; return 1 if $> == 0 && _kill( 0, $check_pid ); # if we are superuser we can avoid the the system call. For details see `perldoc -f kill` return 1 if -e "/proc/$$" && -r "/proc/$$" && -r "/proc/$check_pid"; return; } sub pid_info_hash { my ( $self, $pid ) = @_; $pid = int $pid; return if !$pid || $pid < 0; my @outp = $self->_raw_ps( 'u', '-p', $pid ); chomp @outp; my %info; @info{ split( /\s+/, $outp[0], 11 ) } = split( /\s+/, $outp[1], 11 ); return wantarray ? %info : \%info; } sub _raw_ps { my ( $self, @ps_args ) = @_; my $psargs = join( ' ', @ps_args ); my @res = `$self->{'ps_path'}ps $psargs`; return wantarray ? @res : join '', @res; } sub get_pid_from_pidfile { my ( $self, $pid_file ) = @_; return 0 if !-e $pid_file or -z _; open my $pid_fh, '<', $pid_file or return; my $pid = <$pid_fh>; close $pid_fh; return 0 if !$pid; chomp $pid; return int( abs($pid) ); } sub is_pidfile_running { my ( $self, $pid_file ) = @_; my $pid = $self->get_pid_from_pidfile($pid_file) || return; return $pid if $self->is_pid_running($pid); return; } sub pid_file { my ( $self, $pid_file, $newpid, $retry_conf ) = @_; $newpid = $$ if !$newpid; my $rc = $self->pid_file_no_unlink( $pid_file, $newpid, $retry_conf ); if ( $rc && $newpid == $$ ) { $self->create_end_blocks($pid_file); } return 1 if defined $rc && $rc == 1; return 0 if defined $rc && $rc == 0; return; } sub create_end_blocks { my ( $self, $pid_file ) = @_; ## no critic qw(Variables::ProhibitUnusedVariables); if ( $self->{'unlink_end_use_current_pid_only'} ) { eval 'END { unlink $pid_file if $$ eq ' . $$ . '}'; ## no critic qw(ProhibitStringyEval) if ( $self->{'carp_unlink_end'} ) { eval 'END { require Carp;Carp::carp("[info] $$ unlink $pid_file (current pid check)") if $$ eq ' . $$ . '}'; ## no critic qw(ProhibitStringyEval) } } else { eval 'END { unlink $pid_file if Cpanel::Unix::PID::Tiny->get_pid_from_pidfile($pid_file) eq $$ }'; ## no critic qw(ProhibitStringyEval) if ( $self->{'carp_unlink_end'} ) { eval 'END { require Carp;Carp::carp("[info] $$ unlink $pid_file (pid file check)") if Cpanel::Unix::PID::Tiny->get_pid_from_pidfile($pid_file) eq $$ }'; ## no critic qw(ProhibitStringyEval) } } return; } *pid_file_no_cleanup = \&pid_file_no_unlink; # more intuitively named alias sub pid_file_no_unlink { my ( $self, $pid_file, $newpid, $retry_conf ) = @_; $newpid = $$ if !$newpid; if ( ref($retry_conf) eq 'ARRAY' ) { $retry_conf->[0] = int( abs( $retry_conf->[0] ) ); for my $idx ( 1 .. scalar( @{$retry_conf} ) - 1 ) { next if ref $retry_conf->[$idx] eq 'CODE'; $retry_conf->[$idx] = int( abs( $retry_conf->[$idx] ) ); } } else { $retry_conf = [ 3, 1, 2 ]; } my $passes = 0; require Fcntl; EXISTS: $passes++; if ( -e $pid_file ) { my $curpid = $self->get_pid_from_pidfile($pid_file); return 1 if int $curpid == $$ && $newpid == $$; # already setup return if int $curpid == $$; # can't change it while $$ is alive return if $self->is_pid_running( int $curpid ); unlink $pid_file; # must be a stale PID file, so try to remove it for sysopen() } my $pid_fh = _sysopen($pid_file); if ( !$pid_fh ) { return 0 if $passes >= $retry_conf->[0]; if ( ref( $retry_conf->[$passes] ) eq 'CODE' ) { $retry_conf->[$passes]->( $self, $pid_file, $passes ); } else { sleep( $retry_conf->[$passes] ) if $retry_conf->[$passes]; } goto EXISTS; } print {$pid_fh} int( abs($newpid) ); close $pid_fh; return 1; } sub _sysopen { my ($pid_file) = @_; sysopen( my $pid_fh, $pid_file, Fcntl::O_WRONLY() | Fcntl::O_EXCL() | Fcntl::O_CREAT() ) || return; return $pid_fh; } sub _kill { ## no critic(RequireArgUnpacking return CORE::kill(@_); # goto &CORE::kill; is problematic } sub get_run_lock { my ( $pid_file, $min_age_seconds, $max_age_seconds, $cmdline_regex ) = @_; $pid_file or die("Need a pid file to get a run lock."); defined $min_age_seconds or $min_age_seconds = 15 * 60; defined $max_age_seconds or $max_age_seconds = 20 * 60 * 60; foreach ( 1 .. 2 ) { my $upid = Cpanel::Unix::PID::Tiny->new(); my $got_pid = $upid->pid_file($pid_file); return 1 if ($got_pid); my @pid_stat = stat($pid_file); next if ( !@pid_stat ); my $pid_age = time() - $pid_stat[9]; return 0 if ( $min_age_seconds && $pid_age < $min_age_seconds ); my $active_pid = $upid->get_pid_from_pidfile($pid_file); if ( !-e "/proc/$active_pid" ) { unlink $pid_file; next; } open( my $fh, '<', "/proc/$active_pid/cmdline" ) or next; my $cmdline = <$fh>; if ( $max_age_seconds && $pid_age > $max_age_seconds ) { _kill( 'TERM', $active_pid ); unlink $pid_file; } if ( !$cmdline or ( $cmdline_regex && $cmdline !~ $cmdline_regex ) ) { unlink $pid_file; } } return undef; # I give up! } 1; } # --- END Cpanel/Unix/PID/Tiny.pm { # --- BEGIN Cpanel/JSON/Unicode.pm package Cpanel::JSON::Unicode; use strict; use warnings; 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/ (?< _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; sub to_hex { my ($readable) = @_; $readable =~ s<\\><\\\\>g; $readable =~ s<([\0-\x{1f}\x{7f}-\x{ff}])>eg; return $readable; } 1; } # --- END Cpanel/Encoder/ASCII.pm { # --- BEGIN Cpanel/UTF8/Strict.pm package Cpanel::UTF8::Strict; use strict; use warnings; 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 (); # use Cpanel::FHUtils::Tiny (); # use Cpanel::JSON::Unicode (); # use Cpanel::LoadFile::ReadFast (); use JSON::XS (); # use Cpanel::UTF8::Strict (); 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; 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] ); } 1; } # --- END Cpanel/JSON.pm { # --- BEGIN Cpanel/JSON/FailOK.pm package Cpanel::JSON::FailOK; use strict; use warnings; 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/ConfigFiles.pm package Cpanel::ConfigFiles; use strict; our $VERSION = '1.4'; our $cpanel_users = '/var/cpanel/users'; our $cpanel_users_cache = '/var/cpanel/users.cache'; our $backup_config_touchfile = '/var/cpanel/config/backups/metadata_disabled'; our $backup_config_touchfile_dir = '/var/cpanel/config/backups/'; our $backup_config = '/var/cpanel/backups/config'; our $cpanel_config_file = '/var/cpanel/cpanel.config'; our $cpanel_config_cache_file = '/var/cpanel/cpanel.config.cache'; our $cpanel_config_defaults_file = '/usr/local/cpanel/etc/cpanel.config'; our $features_cache_dir = "/var/cpanel/features.cache"; our $BASE_INSTALL_IN_PROGRESS_FILE = '/root/installer.lock'; our $CPSRVD_CHECK_CPLISC_FILE = q{/var/cpanel/cpsrvd_check_license}; our $ROOT_CPANEL_HOMEDIR = '/var/cpanel/userhomes/cpanel'; our $RESELLERS_FILE = '/var/cpanel/resellers'; our $RESELLERS_NAMESERVERS_FILE = '/var/cpanel/resellers-nameservers'; our $ACCOUNTING_LOG_FILE = '/var/cpanel/accounting.log'; our $FEATURES_DIR = '/var/cpanel/features'; our $BANDWIDTH_LIMIT_DIR = '/var/cpanel/bwlimited'; our $CUSTOM_PERL_MODULES_DIR = '/var/cpanel/perl'; our $PACKAGES_DIR; #defined below our $DEDICATED_IPS_FILE = '/etc/domainips'; our $DELEGATED_IPS_DIR = '/var/cpanel/dips'; our $MAIN_IPS_DIR = '/var/cpanel/mainips'; our $RESERVED_IPS_FILE = '/etc/reservedips'; our $RESERVED_IP_REASONS_FILE = '/etc/reservedipreasons'; our $IP_ADDRESS_POOL_FILE = '/etc/ipaddrpool'; our $ACL_LISTS_DIR = '/var/cpanel/acllists'; our $OUTGOING_MAIL_SUSPENDED_USERS_FILE = '/etc/outgoing_mail_suspended_users'; our $OUTGOING_MAIL_HOLD_USERS_FILE = '/etc/outgoing_mail_hold_users'; our $TRUEUSEROWNERS_FILE = '/etc/trueuserowners'; our $TRUEUSERDOMAINS_FILE = '/etc/trueuserdomains'; our $USERDOMAINS_FILE = '/etc/userdomains'; our $DBOWNERS_FILE = '/etc/dbowners'; our $DOMAINUSERS_FILE = '/etc/domainusers'; our $LOCALDOMAINS_FILE = '/etc/localdomains'; our $REMOTEDOMAINS_FILE = '/etc/remotedomains'; our $SECONDARYMX_FILE = '/etc/secondarymx'; our $MANUALMX_FILE = '/etc/manualmx'; our $USERBWLIMITS_FILE = '/etc/userbwlimits'; our $MAILIPS_FILE = '/etc/mailips'; our $MAILHELO_FILE = '/etc/mailhelo'; our $NEIGHBOR_NETBLOCKS_FILE = '/etc/neighbor_netblocks'; our $CPANEL_MAIL_NETBLOCKS_FILE = '/etc/cpanel_mail_netblocks'; our $GREYLIST_TRUSTED_NETBLOCKS_FILE = '/etc/greylist_trusted_netblocks'; our $GREYLIST_COMMON_MAIL_PROVIDERS_FILE = '/etc/greylist_common_mail_providers'; our $RECENT_RECIPIENT_MAIL_SERVER_IPS_FILE = '/etc/recent_recipient_mail_server_ips'; our $DEMOUSERS_FILE = '/etc/demousers'; our $APACHE_CONFIG_DIR = '/var/cpanel/conf/apache'; our $APACHE_PRIMARY_VHOSTS_FILE = '/var/cpanel/conf/apache/primary_virtual_hosts.conf'; our $MYSQL_CNF = '/etc/my.cnf'; our $SERVICEAUTH_DIR = '/var/cpanel/serviceauth'; our $DORMANT_SERVICES_DIR = '/var/cpanel/dormant_services'; our $DOMAIN_KEYS_ROOT = '/var/cpanel/domain_keys'; our $USER_NOTIFICATIONS_DIR = '/var/cpanel/user_notifications'; our $DATABASES_INFO_DIR = '/var/cpanel/databases'; our $CPANEL_ROOT = '/usr/local/cpanel'; our $MAILMAN_ROOT = "$CPANEL_ROOT/3rdparty/mailman"; our $FPM_CONFIG_ROOT = "/var/cpanel/php-fpm.d"; our $FPM_ROOT = "/var/cpanel/php-fpm"; our $MAILMAN_LISTS_DIR = "$MAILMAN_ROOT/lists"; our $MAILMAN_USER = 'mailman'; our $FTP_PASSWD_DIR = '/etc/proftpd'; our $FTP_SYMLINKS_DIR = '/etc/pure-ftpd'; our $VALIASES_DIR = '/etc/valiases'; our $VDOMAINALIASES_DIR = '/etc/vdomainaliases'; our $VFILTERS_DIR = '/etc/vfilters'; our $JAILSHELL_PATH = '/usr/local/cpanel/bin/jailshell'; our @COMMONDOMAINS_FILES = qw{/usr/local/cpanel/etc/commondomains /var/cpanel/commondomains}; our $BANDWIDTH_DIRECTORY = '/var/cpanel/bandwidth'; our $BANDWIDTH_CACHE_DIRECTORY = '/var/cpanel/bandwidth.cache'; our $BANDWIDTH_USAGE_CACHE_DIRECTORY = '/var/cpanel/bwusagecache'; our $TEMPLATE_COMPILE_DIR = '/var/cpanel/template_compiles'; our $DOVECOT_SNI_CONF = '/etc/dovecot/sni.conf'; our $DOVECOT_SSL_CONF = '/etc/dovecot/ssl.conf'; our $DOVECOT_SSL_KEY = '/etc/dovecot/ssl/dovecot.key'; our $DOVECOT_SSL_CRT = '/etc/dovecot/ssl/dovecot.crt'; our $GOOGLE_AUTH_TEMPFILE_PREFIX = '/var/cpanel/backups/google_oauth_tempfile_'; our $APACHE_LOGFILE_CLEANUP_QUEUE = '/var/cpanel/apache_logfile_cleanup.json'; our $SKIP_REPO_SETUP_FLAG = '/var/cpanel/skip-repo-setup'; our $ACCOUNT_ENHANCEMENTS_DIR = '/var/cpanel/account_enhancements'; our $ACCOUNT_ENHANCEMENTS_CONFIG_DIR = $Cpanel::ConfigFiles::ACCOUNT_ENHANCEMENTS_DIR . '/config'; our $ACCOUNT_ENHANCEMENTS_INSTALL_FILE = $Cpanel::ConfigFiles::ACCOUNT_ENHANCEMENTS_CONFIG_DIR . '/installed.json'; BEGIN { $PACKAGES_DIR = '/var/cpanel/packages'; } 1; } # --- END Cpanel/ConfigFiles.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 strict; sub new { my ( $class, @todo_crs ) = @_; return bless { 'pid' => $$, 'todo' => \@todo_crs }, $class; } sub add { my ( $self, @new_crs ) = @_; push @{ $self->{'todo'} }, @new_crs; return; } sub skip { my ($self) = @_; return delete $self->{'todo'}; } sub DESTROY { my ($self) = @_; 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; # use Cpanel::Autodie (); # use Cpanel::Exception (); 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; # use Cpanel::Fcntl::Constants (); use Cpanel::Autodie ( 'rename', 'syswrite_sigguard', 'seek', 'print', 'truncate' ); # use Cpanel::Exception (); # use Cpanel::FileUtils::Open (); # use Cpanel::Finally (); # use Cpanel::Debug (); 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; 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/CPAN/I18N/LangTags.pm package Cpanel::CPAN::I18N::LangTags; use strict; require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(); our @EXPORT_OK = qw(is_language_tag same_language_tag extract_language_tags super_languages similarity_language_tag is_dialect_of locale2language_tag alternate_language_tags encode_language_tag panic_languages implicate_supers implicate_supers_strictly ); our %EXPORT_TAGS = ( 'ALL' => \@EXPORT_OK ); our %Panic; our $VERSION = "0.35"; sub uniq { my %seen; return grep( !( $seen{$_}++ ), @_ ); } # a util function sub is_language_tag { my ($tag) = lc( $_[0] ); return 0 if $tag eq "i" or $tag eq "x"; return $tag =~ /^(?: # First subtag [xi] | [a-z]{2,3} ) (?: # Subtags thereafter - # separator [a-z0-9]{1,8} # subtag )* $/xs ? 1 : 0; } sub extract_language_tags { my ($text) = $_[0] =~ m/(.+)/ # to make for an untainted result ? $1 : ''; return grep( !m/^[ixIX]$/s, # 'i' and 'x' aren't good tags $text =~ m/ \b (?: # First subtag [iIxX] | [a-zA-Z]{2,3} ) (?: # Subtags thereafter - # separator [a-zA-Z0-9]{1,8} # subtag )* \b /xsg ); } sub same_language_tag { my $el1 = &encode_language_tag( $_[0] ); return 0 unless defined $el1; return $el1 eq &encode_language_tag( $_[1] ) ? 1 : 0; } sub similarity_language_tag { my $lang1 = &encode_language_tag( $_[0] ); my $lang2 = &encode_language_tag( $_[1] ); return undef if !defined($lang1) and !defined($lang2); return 0 if !defined($lang1) or !defined($lang2); my @l1_subtags = split( '-', $lang1 ); my @l2_subtags = split( '-', $lang2 ); my $similarity = 0; while ( @l1_subtags and @l2_subtags ) { if ( shift(@l1_subtags) eq shift(@l2_subtags) ) { ++$similarity; } else { last; } } return $similarity; } sub is_dialect_of { my $lang1 = &encode_language_tag( $_[0] ); my $lang2 = &encode_language_tag( $_[1] ); return undef if !defined($lang1) and !defined($lang2); return 0 if !defined($lang1) or !defined($lang2); return 1 if $lang1 eq $lang2; return 0 if length($lang1) < length($lang2); $lang1 .= '-'; $lang2 .= '-'; return ( substr( $lang1, 0, length($lang2) ) eq $lang2 ) ? 1 : 0; } sub super_languages { my $lang1 = $_[0]; return () unless defined($lang1) && &is_language_tag($lang1); $lang1 =~ s/^nb\b/no-bok/i; # yes, backwards $lang1 =~ s/^nn\b/no-nyn/i; # yes, backwards $lang1 =~ s/^[ix](-hakka\b)/zh$1/i; # goes the right way my @l1_subtags = split( '-', $lang1 ); my @supers = (); foreach my $bit (@l1_subtags) { push @supers, scalar(@supers) ? ( $supers[-1] . '-' . $bit ) : $bit; } pop @supers if @supers; shift @supers if @supers && $supers[0] =~ m<^[iIxX]$>s; return reverse @supers; } sub locale2language_tag { my $lang = $_[0] =~ m/(.+)/ # to make for an untainted result ? $1 : ''; return $lang if &is_language_tag($lang); # like "en" $lang =~ tr<_><->; # "en_US" -> en-US $lang =~ s<(?:[\.\@][-_a-zA-Z0-9]+)+$><>s; # "en_US.ISO8859-1" -> en-US return $lang if &is_language_tag($lang); return; } sub encode_language_tag { my ($tag) = $_[0] || return undef; return undef unless &is_language_tag($tag); $tag =~ s/^iw\b/he/i; # Hebrew $tag =~ s/^in\b/id/i; # Indonesian $tag =~ s/^cre\b/cr/i; # Cree $tag =~ s/^jw\b/jv/i; # Javanese $tag =~ s/^[ix]-lux\b/lb/i; # Luxemburger $tag =~ s/^[ix]-navajo\b/nv/i; # Navajo $tag =~ s/^ji\b/yi/i; # Yiddish $tag =~ s/^[ix]-hakka\b/zh-hakka/i; # Hakka $tag =~ s/^nb\b/no-bok/i; # BACKWARDS for Bokmal $tag =~ s/^nn\b/no-nyn/i; # BACKWARDS for Nynorsk $tag =~ s/^[xiXI]-//s; return "~" . uc($tag); } my %alt = qw( i x x i I X X I ); sub alternate_language_tags { my $tag = $_[0]; return () unless &is_language_tag($tag); my @em; # push 'em real goood! if ( $tag =~ m/^[ix]-hakka\b(.*)/i ) { push @em, "zh-hakka$1"; } elsif ( $tag =~ m/^zh-hakka\b(.*)/i ) { push @em, "x-hakka$1", "i-hakka$1"; } elsif ( $tag =~ m/^he\b(.*)/i ) { push @em, "iw$1"; } elsif ( $tag =~ m/^iw\b(.*)/i ) { push @em, "he$1"; } elsif ( $tag =~ m/^in\b(.*)/i ) { push @em, "id$1"; } elsif ( $tag =~ m/^id\b(.*)/i ) { push @em, "in$1"; } elsif ( $tag =~ m/^[ix]-lux\b(.*)/i ) { push @em, "lb$1"; } elsif ( $tag =~ m/^lb\b(.*)/i ) { push @em, "i-lux$1", "x-lux$1"; } elsif ( $tag =~ m/^[ix]-navajo\b(.*)/i ) { push @em, "nv$1"; } elsif ( $tag =~ m/^nv\b(.*)/i ) { push @em, "i-navajo$1", "x-navajo$1"; } elsif ( $tag =~ m/^yi\b(.*)/i ) { push @em, "ji$1"; } elsif ( $tag =~ m/^ji\b(.*)/i ) { push @em, "yi$1"; } elsif ( $tag =~ m/^nb\b(.*)/i ) { push @em, "no-bok$1"; } elsif ( $tag =~ m/^no-bok\b(.*)/i ) { push @em, "nb$1"; } elsif ( $tag =~ m/^nn\b(.*)/i ) { push @em, "no-nyn$1"; } elsif ( $tag =~ m/^no-nyn\b(.*)/i ) { push @em, "nn$1"; } push @em, $alt{$1} . $2 if $tag =~ /^([XIxi])(-.+)/; return @em; } { my @panic = ( # MUST all be lowercase! 'sv' => [qw(nb no da nn)], 'da' => [qw(nb no sv nn)], # I guess [qw(no nn nb)], [qw(no nn nb sv da)], 'is' => [qw(da sv no nb nn)], 'fo' => [qw(da is no nb nn sv)], # I guess 'pt' => [qw(es ca it fr)], # Portuguese, Spanish, Catalan, Italian, French 'ca' => [qw(es pt it fr)], 'es' => [qw(ca it fr pt)], 'it' => [qw(es fr ca pt)], 'fr' => [qw(es it ca pt)], [ qw( as bn gu kn ks kok ml mni mr ne or pa sa sd te ta ur ) ] => 'hi', 'hi' => [qw(bn pa as or)], ( [qw(ru be uk)] ) x 2, # Russian, Belarusian, Ukranian 'sr' => 'hr', 'hr' => 'sr', # Serb + Croat 'cs' => 'sk', 'sk' => 'cs', # Czech + Slovak 'ms' => 'id', 'id' => 'ms', # Malay + Indonesian 'et' => 'fi', 'fi' => 'et', # Estonian + Finnish ); my ( $k, $v ); while (@panic) { ( $k, $v ) = splice( @panic, 0, 2 ); foreach my $k ( ref($k) ? @$k : $k ) { foreach my $v ( ref($v) ? @$v : $v ) { push @{ $Panic{$k} ||= [] }, $v unless $k eq $v; } } } } sub panic_languages { my ( @out, %seen ); foreach my $t (@_) { next unless $t; next if $seen{$t}++; # so we don't return it or hit it again push @out, @{ $Panic{ lc $t } || next }; } return grep !$seen{$_}++, @out, 'en'; } sub implicate_supers { my @languages = grep is_language_tag($_), @_; my %seen_encoded; foreach my $lang (@languages) { $seen_encoded{ Cpanel::CPAN::I18N::LangTags::encode_language_tag($lang) } = 1; } my (@output_languages); foreach my $lang (@languages) { push @output_languages, $lang; foreach my $s ( Cpanel::CPAN::I18N::LangTags::super_languages($lang) ) { last if $seen_encoded{ Cpanel::CPAN::I18N::LangTags::encode_language_tag($s) }; push @output_languages, $s; } } return uniq(@output_languages); } sub implicate_supers_strictly { my @tags = grep is_language_tag($_), @_; return uniq( @_, map super_languages($_), @_ ); } 1; } # --- END Cpanel/CPAN/I18N/LangTags.pm { # --- BEGIN Cpanel/CPAN/I18N/LangTags/Detect.pm package Cpanel::CPAN::I18N::LangTags::Detect; use strict; use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS $USE_LITERALS $MATCH_SUPERS_TIGHTLY); BEGIN { unless ( defined &DEBUG ) { *DEBUG = sub () { 0 } } } $VERSION = "1.04"; @ISA = (); # use Cpanel::CPAN::I18N::LangTags (); sub _uniq { my %seen; return grep( !( $seen{$_}++ ), @_ ); } sub _normalize { my (@languages) = map lc($_), grep $_, map { ; $_, Cpanel::CPAN::I18N::LangTags::alternate_language_tags($_) } @_; return _uniq(@languages) if wantarray; return $languages[0]; } sub detect () { return __PACKAGE__->ambient_langprefs; } sub ambient_langprefs { # always returns things untainted my $base_class = $_[0]; return $base_class->http_accept_langs if length( $ENV{'REQUEST_METHOD'} || '' ); # I'm a CGI my @languages; foreach my $envname (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) { next unless $ENV{$envname}; DEBUG and print "Noting \$$envname: $ENV{$envname}\n"; push @languages, map Cpanel::CPAN::I18N::LangTags::locale2language_tag($_), split m/[,:]/, $ENV{$envname}; last; # first one wins } if ( $ENV{'IGNORE_WIN32_LOCALE'} ) { } elsif ( &_try_use('Win32::Locale') ) { push @languages, Win32::Locale::get_language() || '' if defined &Win32::Locale::get_language; } return _normalize @languages; } sub http_accept_langs { no integer; my $in = ( @_ > 1 ) ? $_[1] : $ENV{'HTTP_ACCEPT_LANGUAGE'}; return () unless defined $in and length $in; $in =~ s/\([^\)]*\)//g; # nix just about any comment if ( $in =~ m/^\s*([a-zA-Z][-a-zA-Z]+)\s*$/s ) { return _normalize $1; } elsif ( $in =~ m/^\s*[a-zA-Z][-a-zA-Z]+(?:\s*,\s*[a-zA-Z][-a-zA-Z]+)*\s*$/s ) { return _normalize( $in =~ m/([a-zA-Z][-a-zA-Z]+)/g ); } $in =~ s/\s+//g; # Yes, we can just do without the WS! my @in = $in =~ m/([^,]+)/g; my %pref; my $q; foreach my $tag (@in) { next unless $tag =~ m/^([a-zA-Z][-a-zA-Z]+) (?: ;q= ( \d* # a bit too broad of a RE, but so what. (?: \.\d+ )? ) )? $ /sx ; $q = ( defined $2 and length $2 ) ? $2 : 1; push @{ $pref{$q} }, lc $1; } return _normalize( map @{ $pref{$_} }, sort { $b <=> $a } keys %pref ); } my %tried = (); sub _try_use { # Basically a wrapper around "require Modulename" return $tried{ $_[0] } if exists $tried{ $_[0] }; # memoization my $module = $_[0]; # ASSUME sane module name! { no strict 'refs'; return ( $tried{$module} = 1 ) if %{ $module . "::Lexicon" } or @{ $module . "::ISA" }; } print " About to use $module ...\n" if DEBUG; { local $SIG{'__DIE__'}; eval "require $module"; # used to be "use $module", but no point in that. } if ($@) { print "Error using $module \: $@\n" if DEBUG > 1; return $tried{$module} = 0; } else { print " OK, $module is used\n" if DEBUG; return $tried{$module} = 1; } } 1; } # --- END Cpanel/CPAN/I18N/LangTags/Detect.pm { # --- BEGIN Cpanel/CPAN/Locale/Maketext.pm package Cpanel::CPAN::Locale::Maketext; use strict; our @ISA; our $VERSION; our $MATCH_SUPERS; our $USING_LANGUAGE_TAGS; our $USE_LITERALS; our $MATCH_SUPERS_TIGHTLY; use constant IS_ASCII => ord('A') == 65; BEGIN { unless ( defined &DEBUG ) { *DEBUG = sub () { 0 } } } $VERSION = '1.13_89'; $VERSION = eval $VERSION; @ISA = (); $MATCH_SUPERS = 1; $MATCH_SUPERS_TIGHTLY = 1; $USING_LANGUAGE_TAGS = 1; my $FORCE_REGEX_LAZY = ''; $USE_LITERALS = 1 unless defined $USE_LITERALS; my %isa_scan = (); my %isa_ones = (); sub quant { my ( $handle, $num, @forms ) = @_; return $num if @forms == 0; # what should this mean? return $forms[2] if @forms > 2 and $num == 0; # special zeroth case return ( $handle->numf($num) . ' ' . $handle->numerate( $num, @forms ) ); } sub numerate { my ( $handle, $num, @forms ) = @_; my $s = ( $num == 1 ); return '' unless @forms; if ( @forms == 1 ) { # only the headword form specified return $s ? $forms[0] : ( $forms[0] . 's' ); # very cheap hack. } else { # sing and plural were specified return $s ? $forms[0] : $forms[1]; } } sub numf { my ( $handle, $num ) = @_[ 0, 1 ]; if ( $num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num) ) { $num += 0; # Just use normal integer stringification. } else { $num = CORE::sprintf( '%G', $num ); } while ( $num =~ s/$FORCE_REGEX_LAZY^([-+]?\d+)(\d{3})/$1,$2/os ) { 1 } # right from perlfaq5 $num =~ tr<.,><,.> if ref($handle) and $handle->{'numf_comma'}; return $num; } sub sprintf { no integer; my ( $handle, $format, @params ) = @_; return CORE::sprintf( $format, @params ); } use integer; # vroom vroom... applies to the whole rest of the module sub language_tag { my $it = ref( $_[0] ) || $_[0]; return undef unless $it =~ m/$FORCE_REGEX_LAZY([^':]+)(?:::)?$/os; $it = lc($1); $it =~ tr<_><->; return $it; } sub encoding { my $it = $_[0]; return ( ( ref($it) && $it->{'encoding'} ) || 'iso-8859-1' # Latin-1 ); } sub fallback_languages { return ( 'i-default', 'en', 'en-US' ) } sub fallback_language_classes { return () } sub fail_with { # an actual attribute method! my ( $handle, @params ) = @_; return unless ref($handle); $handle->{'fail'} = $params[0] if @params; return $handle->{'fail'}; } sub blacklist { my ( $handle, @methods ) = @_; unless ( defined $handle->{'blacklist'} ) { no strict 'refs'; $handle->{'blacklist'} = { map { $_ => 1 } ( qw/ blacklist encoding fail_with failure_handler_auto fallback_language_classes fallback_languages get_handle init language_tag maketext new whitelist /, grep { substr( $_, 0, 1 ) eq '_' } keys %{ __PACKAGE__ . "::" } ), }; } if ( scalar @methods ) { $handle->{'blacklist'} = { %{ $handle->{'blacklist'} }, map { $_ => 1 } @methods }; } delete $handle->{'_external_lex_cache'}; return; } sub whitelist { my ( $handle, @methods ) = @_; if ( scalar @methods ) { if ( defined $handle->{'whitelist'} ) { $handle->{'whitelist'} = { %{ $handle->{'whitelist'} }, map { $_ => 1 } @methods }; } else { $handle->{'whitelist'} = { map { $_ => 1 } @methods }; } } delete $handle->{'_external_lex_cache'}; return; } sub failure_handler_auto { my $handle = shift; my $phrase = shift; $handle->{'failure_lex'} ||= {}; my $lex = $handle->{'failure_lex'}; my $value = $lex->{$phrase} ||= ( $phrase !~ tr/[// ? \"$phrase" : $handle->_compile($phrase) ); return ${$value} if ref($value) eq 'SCALAR'; return $value if ref($value) ne 'CODE'; { local $SIG{'__DIE__'}; eval { $value = &$value( $handle, @_ ) }; } if ($@) { my $err = $@; $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?} {\n in bracket code [compiled line $1],}s; require Carp; Carp::croak("Error in maketexting \"$phrase\":\n$err as used"); } else { return $value; } } sub new { my $class = ref( $_[0] ) || $_[0]; my $handle = bless {}, $class; $handle->blacklist; $handle->init; return $handle; } sub init { return } # no-op sub maketext { unless ( @_ > 1 ) { require Carp; Carp::croak('maketext requires at least one parameter'); } my ( $handle, $phrase ) = splice( @_, 0, 2 ); unless ( defined($handle) && defined($phrase) ) { require Carp; Carp::confess('No handle/phrase'); } my $value; if ( exists $handle->{'_external_lex_cache'}{$phrase} ) { DEBUG and warn "* Using external lex cache version of \"$phrase\"\n"; $value = $handle->{'_external_lex_cache'}{$phrase}; } else { my $ns = ref($handle) || $handle; foreach my $h_r ( @{ $isa_scan{$ns} || $handle->_lex_refs } ) { DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; if ( defined( $value = $h_r->{$phrase} ) ) { # Minimize looking at $h_r as much as possible as an expensive tied hash to CDB_File DEBUG and warn " Found \"$phrase\" in $h_r\n"; unless ( ref $value ) { if ( !length $value ) { DEBUG and warn " value is undef or ''"; if ( $isa_ones{"$h_r"} ) { DEBUG and warn " $ns ($h_r) is Onesided and \"$phrase\" entry is undef or ''\n"; $value = $phrase; } } if ( $handle->{'use_external_lex_cache'} ) { $handle->{'_external_lex_cache'}{$phrase} = $value = ( $value !~ tr/[// ? \"$value" : $handle->_compile($value) ); } else { $h_r->{$phrase} = $value = ( $value !~ tr/[// ? \"$value" : $handle->_compile($value) ); } } last; } elsif ( substr( $phrase, 0, 1 ) ne '_' and ( $handle->{'use_external_lex_cache'} ? ( exists $handle->{'_external_lex_cache'}{'_AUTO'} ? $handle->{'_external_lex_cache'}{'_AUTO'} : $h_r->{'_AUTO'} ) : $h_r->{'_AUTO'} ) ) { DEBUG and warn " Automaking \"$phrase\" into $h_r\n"; if ( $handle->{'use_external_lex_cache'} ) { $handle->{'_external_lex_cache'}{$phrase} = $value = ( $phrase !~ tr/[// ? \"$phrase" : $handle->_compile($phrase) ); } else { $h_r->{$phrase} = $value = ( $phrase !~ tr/[// ? \"$phrase" : $handle->_compile($phrase) ); } last; } DEBUG > 1 and print " Not found in $h_r, nor automakable\n"; } if ( !defined($value) ) { delete $handle->{'_external_lex_cache'}{$phrase}; DEBUG and warn "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n"; if ( ref($handle) and $handle->{'fail'} ) { DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n"; my $fail; if ( ref( $fail = $handle->{'fail'} ) eq 'CODE' ) { # it's a sub reference return &{$fail}( $handle, $phrase, @_ ); } else { # It's a method name return $handle->$fail( $phrase, @_ ); } } else { require Carp; Carp::croak("maketext doesn't know how to say:\n$phrase\nas needed"); } } } if ( ref($value) eq 'SCALAR' ) { return $$value; } elsif ( ref($value) ne 'CODE' ) { return $value; } local $@; { local $SIG{'__DIE__'}; return eval { &$value( $handle, @_ ) } unless $@; } my $err = $@; $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?} {\n in bracket code [compiled line $1],}s; require Carp; Carp::croak("Error in maketexting \"$phrase\":\n$err as used"); } sub get_handle { # This is a constructor and, yes, it CAN FAIL. my ( $base_class, @languages ) = @_; $base_class = ref($base_class) || $base_class; my $load_alternate_language_tags = 0; if (@languages) { DEBUG and warn 'Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; $load_alternate_language_tags = 1 if $USING_LANGUAGE_TAGS; # An explicit language-list was given! } else { @languages = $base_class->_ambient_langprefs; } my %seen; foreach my $module_name ( map { $base_class . '::' . $_ } @languages ) { next if !length $module_name # sanity || $seen{$module_name}++ # Already been here, and it was no-go || $module_name =~ tr{/-}{} || !&_try_use($module_name); # Try to use() it, but can't it. return ( $module_name->new ); # Make it! } if ($load_alternate_language_tags) { require Cpanel::CPAN::I18N::LangTags; @languages = map { ; $_, Cpanel::CPAN::I18N::LangTags::alternate_language_tags($_) } map Cpanel::CPAN::I18N::LangTags::locale2language_tag($_), @languages; DEBUG and warn 'Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } @languages = $base_class->_langtag_munging(@languages); foreach my $module_name ( map { $base_class . '::' . $_ } @languages ) { next if !length $module_name # sanity || $seen{$module_name}++ # Already been here, and it was no-go || $module_name =~ tr{/-}{} || !&_try_use($module_name); # Try to use() it, but can't it. return ( $module_name->new ); # Make it! } return undef; # Fail! } sub _langtag_munging { my ( $base_class, @languages ) = @_; DEBUG and warn 'Lgs1: ', map( "<$_>", @languages ), "\n"; if ($USING_LANGUAGE_TAGS) { require Cpanel::CPAN::I18N::LangTags; DEBUG and warn 'Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; @languages = $base_class->_add_supers(@languages); push @languages, Cpanel::CPAN::I18N::LangTags::panic_languages(@languages); DEBUG and warn "After adding panic languages:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; push @languages, $base_class->fallback_languages; DEBUG and warn 'Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; @languages = # final bit of processing to turn them into classname things map { my $it = $_; # copy $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _ $it =~ tr<_a-z0-9><>cd; # remove all but a-z0-9_ $it; } @languages; DEBUG and warn "Nearing end of munging:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } else { DEBUG and warn "Bypassing language-tags.\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } DEBUG and warn "Before adding fallback classes:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; push @languages, $base_class->fallback_language_classes; DEBUG and warn "Finally:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; return @languages; } sub _ambient_langprefs { require Cpanel::CPAN::I18N::LangTags::Detect; return Cpanel::CPAN::I18N::LangTags::Detect::detect(); } sub _add_supers { my ( $base_class, @languages ) = @_; if ( !$MATCH_SUPERS ) { DEBUG and warn "Bypassing any super-matching.\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } elsif ($MATCH_SUPERS_TIGHTLY) { require Cpanel::CPAN::I18N::LangTags; DEBUG and warn "Before adding new supers tightly:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; @languages = Cpanel::CPAN::I18N::LangTags::implicate_supers(@languages); DEBUG and warn "After adding new supers tightly:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } else { require Cpanel::CPAN::I18N::LangTags; DEBUG and warn "Before adding supers to end:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; @languages = Cpanel::CPAN::I18N::LangTags::implicate_supers_strictly(@languages); DEBUG and warn "After adding supers to end:\n", ' Lgs@', __LINE__, ': ', map( "<$_>", @languages ), "\n"; } return @languages; } my %tried = (); sub _try_use { # Basically a wrapper around "require Modulename" return $tried{ $_[0] } if exists $tried{ $_[0] }; # memoization my $module = $_[0]; # ASSUME sane module name! { no strict 'refs'; return ( $tried{$module} = 1 ) if ( %{ $module . '::Lexicon' } or @{ $module . '::ISA' } ); } DEBUG and warn " About to use $module ...\n"; { local $SIG{'__DIE__'}; eval "require $module"; # used to be "use $module", but no point in that. } if ($@) { DEBUG and warn "Error using $module \: $@\n"; return $tried{$module} = 0; } else { DEBUG and warn " OK, $module is used\n"; return $tried{$module} = 1; } } sub _lex_refs { # report the lexicon references for this handle's class no strict 'refs'; no warnings 'once'; my $class = ref( $_[0] ) || $_[0]; DEBUG and warn "Lex refs lookup on $class\n"; return $isa_scan{$class} if exists $isa_scan{$class}; # memoization! my @lex_refs; my $seen_r = ref( $_[1] ) ? $_[1] : {}; if ( defined( *{ $class . '::Lexicon' }{'HASH'} ) ) { push @lex_refs, *{ $class . '::Lexicon' }{'HASH'}; $isa_ones{"$lex_refs[-1]"} = defined ${ $class . '::Onesided' } && ${ $class . '::Onesided' } ? 1 : 0; DEBUG and warn '%' . $class . '::Lexicon contains ', scalar( keys %{ $class . '::Lexicon' } ), " entries\n"; } foreach my $superclass ( @{ $class . '::ISA' } ) { DEBUG and warn " Super-class search into $superclass\n"; next if $seen_r->{$superclass}++; push @lex_refs, @{ &_lex_refs( $superclass, $seen_r ) }; # call myself } $isa_scan{$class} = \@lex_refs; # save for next time return \@lex_refs; } sub clear_isa_scan { %isa_scan = (); return; } # end on a note of simplicity! BEGIN { } sub _compile { return \"$_[1]" if $_[1] !~ tr/[//; my ( $handle, $call_count, $big_pile, @c, @code ) = ( $_[0], 0, '', '' ); { my ( $in_group, $m, @params ) = (0); # scratch my $under_one = $_[1]; # There are taint issues using regex on $_ - perlbug 60378,27344 while ( $under_one =~ # Iterate over chunks. m/\G( [^\~\[\]]+ # non-~[] stuff | ~. # ~[, ~], ~~, ~other | \[ # [ presumably opening a group | \] # ] presumably closing a group | ~ # terminal ~ ? | $ )/xgs ) { DEBUG > 2 and warn qq{ "$1"\n}; if ( $1 eq '[' or $1 eq '' ) { # "[" or end if ($in_group) { if ( $1 eq '' ) { $handle->_die_pointing( $under_one, 'Unterminated bracket group' ); } else { $handle->_die_pointing( $under_one, 'You can\'t nest bracket groups' ); } } else { if ( $1 eq '' ) { DEBUG > 2 and warn " [end-string]\n"; } else { $in_group = 1; } die "How come \@c is empty?? in <$under_one>" unless @c; # sanity if ( length $c[-1] ) { $big_pile .= $c[-1]; if ( $USE_LITERALS and ( IS_ASCII ? $c[-1] !~ tr/\x20-\x7E//c : $c[-1] !~ m/$FORCE_REGEX_LAZY[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/os ) ) { $c[-1] =~ s/'/\\'/g if $c[-1] =~ tr{'}{}; push @code, q{ '} . $c[-1] . "',\n"; $c[-1] = ''; # reuse this slot } else { $c[-1] =~ s/\\\\/\\/g if $c[-1] =~ tr{\\}{}; push @code, ' $c[' . $#c . "],\n"; push @c, ''; # new chunk } } } } elsif ( $1 eq ']' ) { # "]" if ($in_group) { $in_group = 0; DEBUG > 2 and warn " --Closing group [$c[-1]]\n"; if ( !length( $c[-1] ) or $c[-1] !~ tr/ \t\r\n\f//c ) { DEBUG > 2 and warn " -- (Ignoring)\n"; $c[-1] = ''; # reset out chink next; } ( $m, @params ) = split( /,/, $c[-1], -1 ); # was /\s*,\s*/ if (IS_ASCII) { # ASCII, etc foreach ( $m, @params ) { tr/\x7F/,/ } } else { # EBCDIC (1047, 0037, POSIX-BC) foreach ( $m, @params ) { tr/\x07/,/ } } if ( $m eq '_1' or $m eq '_2' or $m eq '_3' or $m eq '_*' or ( substr( $m, 0, 1 ) eq '_' && $m =~ m/^_(-?\d+)$/s ) ) { unshift @params, $m; $m = ''; } elsif ( $m eq '*' ) { $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars" } elsif ( $m eq '#' ) { $m = 'numf'; # "#" for "number": [#,_1] for "the number _1" } if ( $m eq '' ) { push @code, ' ('; } elsif ( $m !~ tr{a-zA-Z0-9_}{}c # does not contain non-word characters && !$handle->{'blacklist'}{$m} && ( !defined $handle->{'whitelist'} || $handle->{'whitelist'}{$m} ) ) { push @code, ' $_[0]->' . $m . '('; } else { $handle->_die_pointing( $under_one, "Can't use \"$m\" as a method name in bracket group", 2 + length( $c[-1] ) ); } pop @c; # we don't need that chunk anymore ++$call_count; foreach my $p (@params) { if ( $p eq '_*' ) { $code[-1] .= ' @_[1 .. $#_], '; } elsif ( substr( $p, 0, 1 ) eq '_' && ( $p eq '_1' || $p eq '_2' || $p eq '_3' || $p =~ m/^_-?\d+$/s ) ) { $code[-1] .= '$_[' . ( 0 + substr( $p, 1 ) ) . '], '; } elsif ( $USE_LITERALS and ( IS_ASCII ? $p !~ tr/\x20-\x7E//c : $p !~ m/$FORCE_REGEX_LAZY[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/os ) ) { $p =~ s/'/\\'/g if $p =~ tr{'}{}; $code[-1] .= q{'} . $p . q{', }; } else { push @c, $p; push @code, ' $c[' . $#c . '], '; } } $code[-1] .= "),\n"; push @c, ''; } else { $handle->_die_pointing( $under_one, q{Unbalanced ']'} ); } } elsif ( substr( $1, 0, 1 ) ne '~' ) { if ( $1 =~ tr{\\}{} ) { my $text = $1; $text =~ s/\\/\\\\/g; $c[-1] .= $text; } else { $c[-1] .= $1; } } elsif ( $1 eq '~~' ) { # "~~" $c[-1] .= '~'; } elsif ( $1 eq '~[' ) { # "~[" $c[-1] .= '['; } elsif ( $1 eq '~]' ) { # "~]" $c[-1] .= ']'; } elsif ( $1 eq '~,' ) { # "~," if ($in_group) { if (IS_ASCII) { # ASCII etc $c[-1] .= "\x7F"; } else { # EBCDIC (cp 1047, 0037, POSIX-BC) $c[-1] .= "\x07"; } } else { $c[-1] .= '~,'; } } elsif ( $1 eq '~' ) { # possible only at string-end, it seems. $c[-1] .= '~'; } else { my $text = $1; $text =~ s/\\/\\\\/g if $text =~ tr{\\}{}; $c[-1] .= $text; } } } if ($call_count) { undef $big_pile; # Well, nevermind that. } else { return \$big_pile; } die q{Last chunk isn't null??} if @c and length $c[-1]; # sanity DEBUG and warn scalar(@c), " chunks under closure\n"; my $sub; if ( @code == 0 ) { # not possible? DEBUG and warn "Empty code\n"; return \''; } elsif ( scalar @code > 1 ) { # most cases, presumably! $sub = "sub { join '', map { defined \$_ ? \$_ : '' } @code }"; } else { $sub = "sub { $code[0] }"; } DEBUG and warn $sub; my $code; { use strict; $code = eval $sub; die "$@ while evalling" . $sub if $@; # Should be impossible. } return $code; } sub _die_pointing { my $target = shift; $target = ref($target) || $target; # class name my $i = index( $_[0], "\n" ); my $pointy; my $pos = pos( $_[0] ) - ( defined( $_[2] ) ? $_[2] : 0 ) - 1; if ( $pos < 1 ) { $pointy = "^=== near there\n"; } else { # we need to space over my $first_tab = index( $_[0], "\t" ); if ( $pos > 2 and ( -1 == $first_tab or $first_tab > pos( $_[0] ) ) ) { $pointy = ( '=' x $pos ) . "^ near there\n"; } else { $pointy = substr( $_[0], 0, $pos ); $pointy =~ tr/\t //cd; $pointy .= "^=== near there\n"; } } my $errmsg = "$_[1], in\:\n$_[0]"; if ( $i == -1 ) { $errmsg .= "\n" . $pointy; } elsif ( $i == ( length( $_[0] ) - 1 ) ) { $errmsg .= $pointy; } else { } require Carp; Carp::croak("$errmsg via $target, as used"); } 1; } # --- END Cpanel/CPAN/Locale/Maketext.pm { # --- BEGIN Cpanel/Locale/Utils/Normalize.pm package Cpanel::Locale::Utils::Normalize; use strict; use warnings; sub normalize_tag { my ($tag) = @_; return if !defined $tag; $tag =~ tr/A-Z/a-z/; $tag =~ tr{\r\n \t\f}{}d; if ( $tag =~ tr{a-z0-9}{}c ) { $tag =~ s{[^a-z0-9]+$}{}; # I18N::LangTags::locale2language_tag() does not allow trailing '_' $tag =~ tr{a-z0-9}{_}c; } if ( length $tag > 8 ) { while ( $tag =~ s/([^_]{8})([^_])/$1\_$2/ ) { } # I18N::LangTags::locale2language_tag() only allows parts between 1 and 8 character } return $tag; } 1; } # --- END Cpanel/Locale/Utils/Normalize.pm { # --- BEGIN Cpanel/CPAN/Locales/Legacy.pm package Cpanel::CPAN::Locales::Legacy; use strict; sub numf { my ( $self, $always_return ) = @_; my $class = ref($self) ? ref($self) : $self; $always_return ||= 0; $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} = '' if !defined $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'}; $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} = '' if !defined $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'}; if ( !$self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} || !$self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} ) { if ($always_return) { if ( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} || !$self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} ) { return 2 if $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} eq '.'; return 1; } elsif ( !$self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} || $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} ) { return 2 if $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} eq ','; return 1; } else { return 1; } } } if ( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'decimal'} eq "\#\,\#\#0\.\#\#\#" ) { if ( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} eq ',' && $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} eq '.' ) { return 1; } elsif ( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} eq '.' && $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} eq ',' ) { return 2; } } elsif ( $always_return && $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} && $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} ) { return 2 if $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} eq ','; return 2 if $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} eq '.'; return 1; } return [ $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'decimal'}, $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'}, $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'}, ]; } 1; } # --- END Cpanel/CPAN/Locales/Legacy.pm { # --- BEGIN Cpanel/CPAN/Locales/DB/LocaleDisplayPattern/Tiny.pm package Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny; use strict; $Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny::VERSION = '0.09'; $Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny::cldr_version = '2.0'; my %locale_display_lookup = ( 'ksh' => '{0} en {1}', 'ja' => '{0}({1})', 'zh' => '{0}（{1}）', 'ko' => '{0}({1})', ); sub get_locale_display_pattern { if ( exists $locale_display_lookup{ $_[0] } ) { return $locale_display_lookup{ $_[0] }; } else { require Cpanel::CPAN::Locales; my ($l) = Cpanel::CPAN::Locales::split_tag( $_[0] ); if ( $l ne $_[0] ) { return $locale_display_lookup{$l} if exists $locale_display_lookup{$l}; } return "\{0\}\ \(\{1\}\)"; } } 1; } # --- END Cpanel/CPAN/Locales/DB/LocaleDisplayPattern/Tiny.pm { # --- BEGIN Cpanel/CPAN/Locales/DB/CharacterOrientation/Tiny.pm package Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny; use strict; $Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny::VERSION = '0.09'; $Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny::cldr_version = '2.0'; my %rtl = ( 'ur' => '', 'ku' => '', 'he' => '', 'fa' => '', 'ps' => '', 'ar' => '', ); sub get_orientation { if ( exists $rtl{ $_[0] } ) { return 'right-to-left'; } else { require Cpanel::CPAN::Locales; my ($l) = Cpanel::CPAN::Locales::split_tag( $_[0] ); if ( $l ne $_[0] ) { return 'right-to-left' if exists $rtl{$l}; } return 'left-to-right'; } } 1; } # --- END Cpanel/CPAN/Locales/DB/CharacterOrientation/Tiny.pm { # --- BEGIN Cpanel/CPAN/Locales/Compile.pm package Cpanel::CPAN::Locales::Compile; use strict; use warnings; sub plural_rule_string_to_code { my ( $plural_rule_string, $return ) = @_; if ( !defined $return ) { $return = 1; } my %m; while ( $plural_rule_string =~ m/mod ([0-9]+)/g ) { $m{$1} = "( (\$_[0] % $1) + (\$_[0]-int(\$_[0])) )"; } my $perl_code = "sub { if ("; for my $or ( split /\s+or\s+/i, $plural_rule_string ) { my $and_exp; for my $and ( split /\s+and\s+/i, $or ) { my $copy = $and; my $n = '$_[0]'; $copy =~ s/ ?n is not / $n \!\= /g; $copy =~ s/ ?n is / $n \=\= /g; $copy =~ s/ ?n mod ([0-9]+) is not / $m{$1} \!\= /g; $copy =~ s/ ?n mod ([0-9]+) is / $m{$1} \=\= /g; $copy =~ s/ ?n not in ([0-9]+)\s*\.\.\s*([0-9]+) ?/ int\($n\) \!\= $n \|\| $n < $1 \|\| $n \> $2 /g; $copy =~ s/ ?n mod ([0-9]+) not in ([0-9]+)\s*\.\.\s*([0-9]+) ?/ int\($n\) \!\= $n \|\| $m{$1} < $2 \|\| $m{$1} \> $3 /g; $copy =~ s/ ?n not within ([0-9]+)\s*\.\.\s*([0-9]+) ?/ \($n < $1 \|\| $n > $2\) /g; $copy =~ s/ ?n mod ([0-9]+) not within ([0-9]+)\s*\.\.\s*([0-9]+) ?/ \($m{$1} < $2 \|\| $m{$1} > $3\) /g; $copy =~ s/ ?n in ([0-9]+)\s*\.\.\s*([0-9]+) ?/ int\($n\) \=\= $n \&\& $n \>\= $1 \&\& $n \<\= $2 /g; $copy =~ s/ ?n mod ([0-9]+) in ([0-9]+)\s*\.\.\s*([0-9]+) ?/ int\($n\) \=\= $n \&\& $m{$1} \>\= $2 \&\& $m{$1} \<\= $3 /g; $copy =~ s/ ?n within ([0-9]+)\s*\.\.\s*([0-9]+) ?/ $n \>\= $1 \&\& $n \<\= $2 /g; $copy =~ s/ ?n mod ([0-9]+) within ([0-9]+)\s*\.\.\s*([0-9]+) ?/ $m{$1} \>\= $2 \&\& $m{$1} \<\= $3 /g; if ( $copy eq $and ) { require Carp; Carp::carp("Unknown plural rule syntax"); return; } else { $and_exp .= "($copy) && "; } } $and_exp =~ s/\s+\&\&\s*$//; if ($and_exp) { $perl_code .= " ($and_exp) || "; } } $perl_code =~ s/\s+\|\|\s*$//; $perl_code .= ") { return '$return'; } return;}"; return $perl_code; } sub plural_rule_string_to_javascript_code { my ( $plural_rule_string, $return ) = @_; my $perl = plural_rule_string_to_code( $plural_rule_string, $return ); $perl =~ s/sub \{ /function (n) \{/; $perl =~ s/\$_\[0\]/n/g; $perl =~ s/ \(n \% ([0-9]+)\) \+ \(n-int\(n\)\) /n % $1/g; $perl =~ s/int\(/parseInt\(/g; return $perl; } 1; } # --- END Cpanel/CPAN/Locales/Compile.pm { # --- BEGIN Cpanel/CPAN/Locales.pm package Cpanel::CPAN::Locales; use strict; # use Cpanel::Locale::Utils::Normalize (); $Cpanel::CPAN::Locales::VERSION = 0.30_1; # change in POD $Cpanel::CPAN::Locales::cldr_version = '2.0'; # change in POD my $FORCE_REGEX_LAZY = ''; *normalize_tag = *Cpanel::Locale::Utils::Normalize::normalize_tag; my %singleton_stash; sub get_cldr_version { return $Cpanel::CPAN::Locales::cldr_version; } sub new { my ( $class, $tag ) = @_; $tag = normalize_tag($tag) || 'en'; if ( !exists $singleton_stash{$tag} ) { my $locale = { 'locale' => $tag, }; if ( my $soft = tag_is_soft_locale($tag) ) { $locale->{'soft_locale_fallback'} = $soft; $tag = $soft; } my $inc_class = ref($class) ? ref($class) : $class; $inc_class =~ s{\:\:|\'}{/}g; # per Module::Want::get_inc_key() if ( !exists $INC{"$inc_class/DB/Language/$tag.pm"} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::Language::$tag" || return; # Module::Want::have_mod("$class\::DB::Language::$tag"); } my ( $language, $territory ) = split_tag( $locale->{'locale'} ); $locale->{'language'} = $language; { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $locale->{'language_data'} = { 'VERSION' => \${"$class\::DB::Language::$tag\::VERSION"}, 'cldr_version' => \${"$class\::DB::Language::$tag\::cldr_version"}, 'misc_info' => \%{"$class\::DB::Language::$tag\::misc_info"}, }; } $locale->{'territory'} = $territory; $locale->{'misc'}{'list_quote_mode'} = 'none'; $singleton_stash{$tag} = bless $locale, $class; } return $singleton_stash{$tag}; } sub _load_territory_data { my ($self) = @_; my $tag = $self->{'locale'}; my $class = scalar ref $self; my $inc_class = $class; $inc_class =~ s{\:\:|\'}{/}g; # per Module::Want::get_inc_key() if ( !exists $INC{"$inc_class/DB/Territory/$tag.pm"} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::Territory::$tag" || return; # Module::Want::have_mod("$class\::DB::Language::$tag"); } { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $self->{'territory_data'} = { 'VERSION' => \${"$class\::DB::Territory::$tag\::VERSION"}, 'cldr_version' => \${"$class\::DB::Territory::$tag\::cldr_version"}, 'code_to_name' => \%{"$class\::DB::Territory::$tag\::code_to_name"}, }; } return 1; } sub _load_language_data_code_to_name { my ($self) = @_; my $tag = $self->{'locale'}; my $class = scalar ref $self; my $inc_class = $class; $inc_class =~ s{\:\:|\'}{/}g; # per Module::Want::get_inc_key() if ( !exists $INC{"$inc_class/DB/Language/code_to_name/$tag.pm"} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::Language::code_to_name::$tag" || return; # Module::Want::have_mod("$class\::DB::Language::$tag"); } { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $self->{'language_data'}{'code_to_name'} = \%{"$class\::DB::Language::$tag\::code_to_name"}; } return 1; } sub get_soft_locale_fallback { return $_[0]->{'soft_locale_fallback'} if $_[0]->{'soft_locale_fallback'}; return; } sub get_locale { shift->{'locale'} } sub get_territory { shift->{'territory'} } sub get_language { shift->{'language'} } sub get_native_language_from_code { my ( $self, $code, $always_return ) = @_; my $class = ref($self) ? ref($self) : $self; if ( !exists $self->{'native_data'} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::Native;" || return; # Module::Want::have_mod("$class\::DB::Native"); { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $self->{'native_data'} = { 'VERSION' => \${"$class\::DB::Native::VERSION"}, 'cldr_version' => \${"$class\::DB::Native::cldr_version"}, 'code_to_name' => \%{"$class\::DB::Native::code_to_name"}, }; } } $code ||= $self->{'locale'}; $code = normalize_tag($code); return if !defined $code; $always_return ||= 1 if $code eq $self->get_locale() && $self->get_soft_locale_fallback(); # force $always_return under soft locale objects $always_return ||= 0; if ( exists $self->{'native_data'}{'code_to_name'}{$code} ) { return $self->{'native_data'}{'code_to_name'}{$code}; } elsif ($always_return) { my ( $l, $t ) = split_tag($code); my $ln = $self->{'native_data'}{'code_to_name'}{$l}; $self->_load_territory_data() if !$self->{'territory_data'}; my $tn = defined $t ? $self->{'territory_data'}{'code_to_name'}{$t} : ''; return $code if !$ln && !$tn; if ( defined $t ) { my $tmp = Cpanel::CPAN::Locales->new($l); # if we even get to this point: this is a singleton so it is cheap if ($tmp) { if ( $tmp->get_territory_from_code($t) ) { $tn = $tmp->get_territory_from_code($t); } } } $ln ||= $l; $tn ||= $t; my $string = get_locale_display_pattern_from_code_fast($code) || $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'locale'} || '{0} ({1})'; substr( $string, index( $string, '{0}' ), 3, $ln ) while index( $string, '{0}' ) > -1; substr( $string, index( $string, '{1}' ), 3, $tn ) while index( $string, '{1}' ) > -1; return $string; } return; } sub numf { require Cpanel::CPAN::Locales::Legacy if !$INC{'Cpanel/CPAN/Locales/Legacy.pm'}; *numf = *Cpanel::CPAN::Locales::Legacy::numf; goto \&Cpanel::CPAN::Locales::Legacy::numf; } my $get_locale_display_pattern_from_code_fast = 0; sub get_locale_display_pattern_from_code_fast { if ( !$get_locale_display_pattern_from_code_fast ) { $get_locale_display_pattern_from_code_fast++; require Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny; } if ( @_ == 1 && ref( $_[0] ) ) { return Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny::get_locale_display_pattern( $_[0]->get_locale() ); } return Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny::get_locale_display_pattern( $_[-1] ); # last arg so it works as function or class method or object method } sub get_locale_display_pattern_from_code { my ( $self, $code, $always_return ) = @_; my $class = ref($self) ? ref($self) : $self; if ( !exists $self->{'locale_display_pattern_data'} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::LocaleDisplayPattern;" || return; # Module::Want::have_mod("$class\::DB::LocaleDisplayPattern"); { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $self->{'locale_display_pattern_data'} = { 'VERSION' => \${"$class\::DB::LocaleDisplayPattern::VERSION"}, 'cldr_version' => \${"$class\::DB::LocaleDisplayPattern::cldr_version"}, 'code_to_pattern' => \%{"$class\::DB::LocaleDisplayPattern::code_to_pattern"}, }; } } $code ||= $self->{'locale'}; $code = normalize_tag($code); return if !defined $code; $always_return ||= 1 if $code eq $self->get_locale() && $self->get_soft_locale_fallback(); # force $always_return under soft locale objects $always_return ||= 0; if ( exists $self->{'locale_display_pattern_data'}{'code_to_pattern'}{$code} ) { return $self->{'locale_display_pattern_data'}{'code_to_pattern'}{$code}; } elsif ($always_return) { my ( $l, $t ) = split_tag($code); if ( exists $self->{'locale_display_pattern_data'}{'code_to_pattern'}{$l} ) { return $self->{'locale_display_pattern_data'}{'code_to_pattern'}{$l}; } return '{0} ({1})'; } return; } my $get_character_orientation_from_code_fast = 0; sub get_character_orientation_from_code_fast { if ( !$get_character_orientation_from_code_fast ) { $get_character_orientation_from_code_fast++; require Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny; } if ( @_ == 1 && ref( $_[0] ) ) { return Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny::get_orientation( $_[0]->get_locale() ); } return Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny::get_orientation( $_[-1] ); # last arg so it works as function or class method or object method } sub get_character_orientation_from_code { my ( $self, $code, $always_return ) = @_; my $class = ref($self) ? ref($self) : $self; if ( !exists $self->{'character_orientation_data'} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require $class\::DB::CharacterOrientation;" || return; # Module::Want::have_mod("$class\::DB::CharacterOrientation"); { BEGIN { $^H = 0; }; # cheap no strict to allow for ref copy $self->{'character_orientation_data'} = { 'VERSION' => \${"$class\::DB::CharacterOrientation::VERSION"}, 'cldr_version' => \${"$class\::DB::CharacterOrientation::cldr_version"}, 'code_to_name' => \%{"$class\::DB::CharacterOrientation::code_to_name"}, }; } } $code ||= $self->{'locale'}; $code = normalize_tag($code); return if !defined $code; $always_return ||= 1 if $code eq $self->get_locale() && $self->get_soft_locale_fallback(); # force $always_return under soft locale objects $always_return ||= 0; if ( exists $self->{'character_orientation_data'}{'code_to_name'}{$code} ) { return $self->{'character_orientation_data'}{'code_to_name'}{$code}; } elsif ($always_return) { my ( $l, $t ) = split_tag($code); if ( exists $self->{'character_orientation_data'}{'code_to_name'}{$l} ) { return $self->{'character_orientation_data'}{'code_to_name'}{$l}; } return 'left-to-right'; } return; } sub get_plural_form_categories { return @{ $_[0]->{'language_data'}{'misc_info'}{'plural_forms'}{'category_list'} }; } sub supports_special_zeroth { return 1 if $_[0]->get_plural_form(0) eq 'other'; return; } sub plural_category_count { return scalar( $_[0]->get_plural_form_categories() ); } sub get_plural_form { my ( $self, $n, @category_values ) = @_; my $category; my $has_extra_for_zero = 0; my $abs_n = abs($n); # negatives keep same category as positive if ( !$self->{'language_data'}{'misc_info'}{'plural_forms'}{'category_rules_function'} ) { $self->{'language_data'}{'misc_info'}{'plural_forms'}{'category_rules_function'} = Cpanel::CPAN::Locales::plural_rule_hashref_to_code( $self->{'language_data'}{'misc_info'}{'plural_forms'} ); if ( !defined $self->{'language_data'}{'misc_info'}{'plural_forms'}{'category_rules_function'} ) { require Carp; Carp::carp("Could not determine plural logic."); } } $category = $self->{'language_data'}{'misc_info'}{'plural_forms'}{'category_rules_function'}->($abs_n); my @categories = $self->get_plural_form_categories(); if ( !@category_values ) { @category_values = @categories; } else { my $cat_len = @categories; my $val_len = @category_values; if ( $val_len == ( $cat_len + 1 ) ) { $has_extra_for_zero++; } elsif ( $cat_len != $val_len && $self->{'verbose'} ) { require Carp; Carp::carp("The number of given values ($val_len) does not match the number of categories ($cat_len)."); } } if ( !defined $category ) { my $cat_idx = $has_extra_for_zero && $abs_n != 0 ? -2 : -1; return wantarray ? ( $category_values[$cat_idx], $has_extra_for_zero && $abs_n == 0 ? 1 : 0 ) : $category_values[$cat_idx]; } else { GET_POSITION: my $cat_pos_in_list; my $index = -1; CATEGORY: for my $cat (@categories) { $index++; if ( $cat eq $category ) { $cat_pos_in_list = $index; last CATEGORY; } } if ( !defined $cat_pos_in_list && $category ne 'other' ) { require Carp; Carp::carp("The category ($category) is not used by this locale."); $category = 'other'; goto GET_POSITION; } elsif ( !defined $cat_pos_in_list ) { my $cat_idx = $has_extra_for_zero && $abs_n != 0 ? -2 : -1; return wantarray ? ( $category_values[$cat_idx], $has_extra_for_zero && $abs_n == 0 ? 1 : 0 ) : $category_values[$cat_idx]; } else { if ( $has_extra_for_zero && $category eq 'other' ) { # and 'other' is at the end of the list? nah... && $cat_pos_in_list + 1 == $#category_values my $cat_idx = $has_extra_for_zero && $abs_n == 0 ? -1 : $cat_pos_in_list; return wantarray ? ( $category_values[$cat_idx], $has_extra_for_zero && $abs_n == 0 ? 1 : 0 ) : $category_values[$cat_idx]; } else { return wantarray ? ( $category_values[$cat_pos_in_list], 0 ) : $category_values[$cat_pos_in_list]; } } } } sub _quote_get_list_items { my ( $self, $items_ar ) = @_; my $cnt = 0; if ( exists $self->{'misc'}{'list_quote_mode'} && $self->{'misc'}{'list_quote_mode'} ne 'none' ) { if ( $self->{'misc'}{'list_quote_mode'} eq 'all' ) { @{$items_ar} = ('') if @{$items_ar} == 0; for my $i ( 0 .. scalar( @{$items_ar} ) - 1 ) { $items_ar->[$i] = '' if !defined $items_ar->[$i]; $items_ar->[$i] = $self->quote( $items_ar->[$i] ); $cnt++; } } elsif ( $self->{'misc'}{'list_quote_mode'} eq 'some' ) { @{$items_ar} = ('') if @{$items_ar} == 0; for my $i ( 0 .. scalar( @{$items_ar} ) - 1 ) { $items_ar->[$i] = '' if !defined $items_ar->[$i]; if ( $items_ar->[$i] eq '' || $items_ar->[$i] eq ' ' || $items_ar->[$i] eq "\xc2\xa0" ) { $items_ar->[$i] = $self->quote( $items_ar->[$i] ); $cnt++; } } } else { require Carp; Carp::carp('$self->{misc}{list_quote_mode} is set to an unknown value'); } } return $cnt; } sub get_list_and { my $self = shift; return $self->_get_list_joined( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'list'}, @_, ); } sub get_list_or { my $self = shift; return $self->_get_list_joined( $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'list_or'}, @_, ); } sub _get_list_joined { my ( $self, $templates_hr, @items ) = @_; $self->_quote_get_list_items( \@items ); return if !@items; return $items[0] if @items == 1; my $ix; # used to cache index results in the following oneliner if ( @items == 2 ) { my $two = $templates_hr->{'2'}; substr( $two, $ix, 3, $items[0] ) while ( $ix = index( $two, '{0}' ) ) > -1; substr( $two, $ix, 3, $items[1] ) while ( $ix = index( $two, '{1}' ) ) > -1; return $two; } else { for (@items) { next if !defined $_; substr( $_, $ix, 3, '__{__0__}__' ) while ( $ix = index( $_, '{0}' ) ) > -1; substr( $_, $ix, 3, '__{__1__}__' ) while ( $ix = index( $_, '{1}' ) ) > -1; } my $aggregate = $templates_hr->{'start'}; substr( $aggregate, $ix, 3, $items[0] ) while ( $ix = index( $aggregate, '{0}' ) ) > -1; substr( $aggregate, $ix, 3, $items[1] ) while ( $ix = index( $aggregate, '{1}' ) ) > -1; for my $i ( 2 .. $#items ) { next if $i == $#items; my $middle = $templates_hr->{'middle'}; substr( $middle, $ix, 3, $aggregate ) while ( $ix = index( $middle, '{0}' ) ) > -1; my $item = defined $items[$i] ? $items[$i] : ''; substr( $middle, $ix, 3, $item ) while ( $ix = index( $middle, '{1}' ) ) > -1; $aggregate = $middle; } my $end = $templates_hr->{'end'}; substr( $end, $ix, 3, $aggregate ) while ( $ix = index( $end, '{0}' ) ) > -1; substr( $end, $ix, 3, $items[-1] ) while ( $ix = index( $end, '{1}' ) ) > -1; substr( $end, $ix, 11, '{0}' ) while ( $ix = index( $end, '__{__0__}__' ) ) > -1; substr( $end, $ix, 11, '{1}' ) while ( $ix = index( $end, '__{__1__}__' ) ) > -1; return $end; } } sub quote { my ( $self, $value ) = @_; $value = '' if !defined $value; return $self->{'language_data'}{'misc_info'}{'delimiters'}{'quotation_start'} . $value . $self->{'language_data'}{'misc_info'}{'delimiters'}{'quotation_end'}; } sub quote_alt { my ( $self, $value ) = @_; $value = '' if !defined $value; return $self->{'language_data'}{'misc_info'}{'delimiters'}{'alternate_quotation_start'} . $value . $self->{'language_data'}{'misc_info'}{'delimiters'}{'alternate_quotation_end'}; } sub get_formatted_ellipsis_initial { my ( $self, $str ) = @_; my $pattern = $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'ellipsis'}{'initial'} || '…{0}'; substr( $pattern, index( $pattern, '{0}' ), 3, $str ) while index( $pattern, '{0}' ) > -1; return $pattern; } sub get_formatted_ellipsis_medial { my ($self) = @_; # my ($self, $first, $second) = @_; my $pattern = $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'ellipsis'}{'medial'} || '{0}…{1}'; substr( $pattern, index( $pattern, '{0}' ), 3, $_[1] ) while index( $pattern, '{0}' ) > -1; substr( $pattern, index( $pattern, '{1}' ), 3, $_[2] ) while index( $pattern, '{1}' ) > -1; return $pattern; } sub get_formatted_ellipsis_final { my ( $self, $str ) = @_; my $pattern = $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'ellipsis'}{'final'} || '{0}…'; substr( $pattern, index( $pattern, '{0}' ), 3, $str ) while index( $pattern, '{0}' ) > -1; return $pattern; } sub get_formatted_decimal { my ( $self, $n, $max_decimal_places, $_my_pattern ) = @_; # $_my_pattern not documented on purpose, it is only intended for internal use, and may dropepd/changed at any time return if !defined $n; my $is_negative = $n < 0 ? 1 : 0; my $max_len = defined $max_decimal_places ? abs( int($max_decimal_places) ) : 6; # %f default is 6 $max_len = 14 if $max_len > 14; if ( $n > 10_000_000_000 || $n < -10_000_000_000 ) { return $n if $n =~ tr/Ee//; # poor man's is exponential check. if ( $n =~ m/\.([0-9]{$max_len})([0-9])?/ ) { my $trim = $1; # (defined $2 && $2 > 4) ? $1 + 1 : $1; if ( defined $2 && $2 > 4 ) { if ( ( $trim + 1 ) !~ tr/Ee// ) { # poor man's is exponential check. $trim++; } } $n =~ s/$FORCE_REGEX_LAZY\.[0-9]+/\.$trim/o; } } else { return $n if length $n < 3 && $n !~ tr{0-9}{}c; $n = sprintf( '%.' . $max_len . 'f', $n ); return $n if $n =~ tr/Ee//; # poor man's is exponential check. } $n =~ s{$FORCE_REGEX_LAZY([^0-9]+[0-9]*?[1-9])0+$}{$1}o; $n =~ s{$FORCE_REGEX_LAZY[^0-9]+0+$}{}o; if ( $n =~ tr{.0-9}{}c ) { # Only strip signs if the string has non-numeric and '.' characters such as '+' or '-' substr( $n, 0, 1, '' ) while substr( $n, 1 ) =~ tr{0-9}{}c; } my $cldr_formats = $self->{'language_data'}{'misc_info'}{'cldr_formats'}; my $format = $_my_pattern || $cldr_formats->{'decimal'}; # from http://unicode.org/repos/cldr-tmp/trunk/diff/by_type/number.pattern.html my ( $zero_positive_pat, $negative_pat, $err ) = split( /$FORCE_REGEX_LAZY(? 3 ) { while ( $result =~ s/$FORCE_REGEX_LAZY^([-+]?\d+)(\d{3})/$1,$2/os ) { 1 } # right from perlfaq5 } } else { my ( $integer, $decimals ) = split( /\./, $n, 2 ); my ( $i_pat, $d_pat ) = split( /$FORCE_REGEX_LAZY(?{_decimal_format_decimal} ne '.' && index( $result, '.' ) > -1 && $result =~ s/$FORCE_REGEX_LAZY(?{_decimal_format_group} ne ',' && index( $result, ',' ) > -1 ) { $result =~ s/$FORCE_REGEX_LAZY(?{_decimal_format_group}/og; } if ($used_place_holder) { my $ix; substr( $result, $ix, 29, $cldr_formats->{_decimal_format_decimal} ) while ( $ix = index( $result, '_LOCALES-DECIMAL-PLACEHOLDER_' ) ) > -1; } if ( $is_negative && !$negative_pat ) { $result = "-$result"; } return $result; } sub get_territory_codes { $_[0]->_load_territory_data() if !$_[0]->{'territory_data'}; return keys %{ shift->{'territory_data'}{'code_to_name'} }; } sub get_territory_names { $_[0]->_load_territory_data() if !$_[0]->{'territory_data'}; return values %{ shift->{'territory_data'}{'code_to_name'} }; } sub get_territory_lookup { $_[0]->_load_territory_data() if !$_[0]->{'territory_data'}; return %{ shift->{'territory_data'}{'code_to_name'} }; } sub get_territory_from_code { my ( $self, $code, $always_return ) = @_; $code ||= $self->{'territory'}; $code = normalize_tag($code); return if !defined $code; $self->_load_territory_data() if !$self->{'territory_data'}; if ( exists $self->{'territory_data'}{'code_to_name'}{$code} ) { return $self->{'territory_data'}{'code_to_name'}{$code}; } elsif ( !defined $self->{'territory'} || $code ne $self->{'territory'} ) { my ( $l, $t ) = split_tag($code); if ( $t && exists $self->{'territory_data'}{'code_to_name'}{$t} ) { return $self->{'territory_data'}{'code_to_name'}{$t}; } } return $code if $always_return; return; } sub get_code_from_territory { my ( $self, $name ) = @_; return if !$name; my $key = normalize_for_key_lookup($name); $self->_load_territory_data() if !$self->{'territory_data'}; if ( !$self->{'territory_data'}{'nam'} ) { $self->{'territory_data'}{'name_to_code'} = { map { normalize_for_key_lookup( $self->{'territory_data'}{'code_to_name'}->{$_} ) => $_ } keys %{ $self->{'territory_data'}{'code_to_name'} } }; } if ( exists $self->{'territory_data'}{'name_to_code'}{$key} ) { return $self->{'territory_data'}{'name_to_code'}{$key}; } return; } { no warnings 'once'; *code2territory = *get_territory_from_code; *territory2code = *get_code_from_territory; } sub get_language_codes { $_[0]->_load_language_data_code_to_name() if !$_[0]->{'language_data'}{'code_to_name'}; return keys %{ $_[0]->{'language_data'}{'code_to_name'} }; } sub get_language_names { $_[0]->_load_language_data_code_to_name() if !$_[0]->{'language_data'}{'code_to_name'}; return values %{ $_[0]->{'language_data'}{'code_to_name'} }; } sub get_language_lookup { $_[0]->_load_language_data_code_to_name() if !$_[0]->{'language_data'}{'code_to_name'}; return %{ $_[0]->{'language_data'}{'code_to_name'} }; } sub get_language_from_code { my ( $self, $code, $always_return ) = @_; $code ||= $self->{'locale'}; $code = normalize_tag($code); return if !defined $code; $always_return ||= 1 if $code eq $self->get_locale() && $self->get_soft_locale_fallback(); # force $always_return under soft locale objects $always_return ||= 0; $self->_load_language_data_code_to_name() if !$_[0]->{'language_data'}{'code_to_name'}; if ( exists $self->{'language_data'}{'code_to_name'}{$code} ) { return $self->{'language_data'}{'code_to_name'}{$code}; } elsif ($always_return) { $self->_load_territory_data() if !$self->{'territory_data'}; my ( $l, $t ) = split_tag($code); my $ln = $self->{'language_data'}{'code_to_name'}{$l}; my $tn = defined $t ? $self->{'territory_data'}{'code_to_name'}{$t} : ''; return $code if !$ln && !$tn; $ln ||= $l; $tn ||= $t; my $string = $self->{'language_data'}{'misc_info'}{'cldr_formats'}{'locale'} || '{0} ({1})'; substr( $string, index( $string, '{0}' ), 3, $ln ) while index( $string, '{0}' ) > -1; substr( $string, index( $string, '{1}' ), 3, $tn ) while index( $string, '{1}' ) > -1; return $string; } return; } sub get_code_from_language { my ( $self, $name ) = @_; return if !$name; my $key = normalize_for_key_lookup($name); $self->_load_language_data_code_to_name() if !$_[0]->{'language_data'}{'code_to_name'}; if ( !$self->{'language_data'}{'name_to_code'} ) { $self->{'language_data'}{'name_to_code'} = { map { normalize_for_key_lookup( $self->{'language_data'}{'code_to_name'}->{$_} ) => $_ } keys %{ $self->{'language_data'}{'code_to_name'} } }; } if ( exists $self->{'language_data'}{'name_to_code'}{$key} ) { return $self->{'language_data'}{'name_to_code'}{$key}; } return; } { no warnings 'once'; *code2language = *get_language_from_code; *language2code = *get_code_from_language; } sub tag_is_soft_locale { my ($tag) = @_; my ( $l, $t ) = split_tag($tag); return if !defined $l; # invalid tag is not soft return if !$t; # no territory part means it is not soft return if tag_is_loadable($tag); # if it can be loaded directly then it is not soft return if !territory_code_is_known($t); # if the territory part is not known then it is not soft return if !tag_is_loadable($l); # if the language part is not known then it is not soft return $l; # it is soft, so return the value suitable for 'soft_locale_fallback' } sub tag_is_loadable { my ( $tag, $as_territory ) = @_; # not documenting internal $as_territory, just use territory_code_is_known() directly if ( !exists $INC{"Cpanel/CPAN/Locales/DB/Loadable.pm"} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require Cpanel::CPAN::Locales::DB::Loadable" || return; # Module::Want::have_mod("Cpanel::CPAN::Locales::DB::Loadable") || return; } if ($as_territory) { no warnings 'once'; return 1 if exists $Cpanel::CPAN::Locales::DB::Loadable::territory{$tag}; } else { return 1 if exists $Cpanel::CPAN::Locales::DB::Loadable::code{$tag}; } return; } sub get_loadable_language_codes { if ( !exists $INC{"Cpanel/CPAN/Locales/DB/Loadable.pm"} ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) eval "require Cpanel::CPAN::Locales::DB::Loadable" || return; # Module::Want::have_mod("Cpanel::CPAN::Locales::DB::Loadable") || return; } return keys %Cpanel::CPAN::Locales::DB::Loadable::code; } sub territory_code_is_known { return tag_is_loadable( $_[0], 1 ); } sub split_tag { return split( /_/, normalize_tag( $_[0] ), 2 ); # we only do language[_territory] } sub get_i_tag_for_string { my $norm = normalize_tag( $_[0] ); if ( substr( $norm, 0, 2 ) eq 'i_' ) { return $norm; } else { return 'i_' . $norm; } } my %non_locales = ( 'und' => 1, 'zxx' => 1, 'mul' => 1, 'mis' => 1, 'art' => 1, ); sub non_locale_list { return ( sort keys %non_locales ); } sub is_non_locale { my $tag = normalize_tag( $_[0] ) || return; return 1 if exists $non_locales{$tag}; return; } sub typical_en_alias_list { return ( 'en_us', 'i_default' ); } sub is_typical_en_alias { my $tag = normalize_tag( $_[0] ) || return; return 1 if $tag eq 'en_us' || $tag eq 'i_default'; return; } sub normalize_tag_for_datetime_locale { my ( $pre, $pst ) = split_tag( $_[0] ); # we only do language[_territory] return if !defined $pre; if ($pst) { return $pre . '_' . uc($pst); } else { return $pre; } } sub normalize_tag_for_ietf { my ( $pre, $pst ) = split_tag( $_[0] ); # we only do language[_territory] return if !defined $pre; if ($pst) { return $pre . '-' . uc($pst); } else { return $pre; } } sub normalize_for_key_lookup { my $key = $_[0]; return '' if !defined $key; $key =~ tr/A-Z/a-z/; # lowercase $key =~ s{\s+}{}g if $key =~ tr{ \t\r\n\f}{}; $key =~ tr{\'\"\-\(\)\[\]\_}{}d; return $key; } sub plural_rule_string_to_javascript_code { require Cpanel::CPAN::Locales::Compile; *plural_rule_string_to_javascript_code = \&Cpanel::CPAN::Locales::Compile::plural_rule_string_to_javascript_code; goto \&Cpanel::CPAN::Locales::Compile::plural_rule_string_to_javascript_code; } sub plural_rule_string_to_code { require Cpanel::CPAN::Locales::Compile; *plural_rule_string_to_code = \&Cpanel::CPAN::Locales::Compile::plural_rule_string_to_code; goto \&Cpanel::CPAN::Locales::Compile::plural_rule_string_to_code; } sub plural_rule_hashref_to_code { my ($hr) = @_; if ( ref( $hr->{'category_rules'} ) ne 'HASH' ) { $hr->{'category_rules_compiled'} = { 'one' => q{sub { return 'one' if ( ( $n == 1 ) ); return;};}, }; return sub { my ($n) = @_; return 'one' if $n == 1; return; }; } else { for my $cat ( get_cldr_plural_category_list(1) ) { next if !exists $hr->{'category_rules'}{$cat}; next if exists $hr->{'category_rules_compiled'}{$cat}; $hr->{'category_rules_compiled'}{$cat} = plural_rule_string_to_code( $hr->{'category_rules'}{$cat}, $cat ); } return sub { my ($n) = @_; my $match; PCAT: for my $cat ( get_cldr_plural_category_list(1) ) { # use function instead of keys to preserve processing order next if !exists $hr->{'category_rules_compiled'}{$cat}; if ( ref( $hr->{'category_rules_compiled'}{$cat} ) ne 'CODE' ) { local $SIG{'__DIE__'}; # cpanel specific: ensure a benign eval does not trigger cpsrvd's DIE handler (may be made moot by internal case 50857) $hr->{'category_rules_compiled'}{$cat} = eval "$hr->{'category_rules_compiled'}{$cat}"; ## no critic (ProhibitStringyEval) # As of 0.22 this will be skipped for modules included w/ the main dist } if ( $hr->{'category_rules_compiled'}{$cat}->($n) ) { $match = $cat; last PCAT; } } return $match if $match; return; }; } } sub get_cldr_plural_category_list { return qw(zero one two few many other) if $_[0]; # check order return qw(one two few many other zero); # quant() arg order } sub get_fallback_list { my ( $self, $special_lookup ) = @_; my ( $super, $ter ) = split_tag( $self->{'locale'} ); return ( $self->{'locale'}, ( $super ne $self->{'locale'} && $super ne 'i' ? $super : () ), ( @{ $self->{'language_data'}{'misc_info'}{'fallback'} } ), ( defined $special_lookup && ref($special_lookup) eq 'CODE' ? ( map { my $n = Cpanel::Locale::Utils::Normalize::normalize_tag($_); $n ? ($n) : () } $special_lookup->( $self->{'locale'} ) ) : () ), 'en' ); } sub get_cldr_number_symbol_decimal { return $_[0]->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_decimal'} || '.'; } sub get_cldr_number_symbol_group { return $_[0]->{'language_data'}{'misc_info'}{'cldr_formats'}{'_decimal_format_group'} || ','; } 1; } # --- END Cpanel/CPAN/Locales.pm { # --- BEGIN Cpanel/CPAN/Locale/Maketext/Utils.pm package Cpanel::CPAN::Locale::Maketext::Utils; $Cpanel::CPAN::Locale::Maketext::Utils::VERSION = 0.33_95; # use Cpanel::CPAN::Locale::Maketext 1.13_89 (); # our 1.13_89 contains some optimizations and support for external_lex_cache that made its way to CPAN by v1.22 @Cpanel::CPAN::Locale::Maketext::Utils::ISA = qw(Cpanel::CPAN::Locale::Maketext); use constant LOCALE_FALLBACK_CACHE_DIR => '/usr/local/cpanel/etc/locale/fallback'; my $FORCE_REGEX_LAZY = ''; my %singleton_stash = (); sub _compile { my ( $lh, $string ) = @_; substr( $string, index( $string, '_TILDE_' ), 7, '~~' ) while index( $string, '_TILDE_' ) > -1; # this helps make parsing easier (via code or visually) my $compiled = $lh->SUPER::_compile($string); return $compiled if ref($compiled) ne 'CODE'; return sub { return $compiled->( $_[0], @_[ 1 .. $#_ ] ) if !grep { defined && index( $_, '_' ) > -1 } @_[ 1 .. $#_ ]; my ( $lh, @ref_args ) = @_; my $built = $compiled->( $lh, map { if ( defined && index( $_, '_' ) > -1 ) { s/$FORCE_REGEX_LAZY\_(\-?[0-9]+|\*)/-!-$1-!-/og; } $_ # Change embedded-arg-looking-string to a } @ref_args ); $built =~ s/$FORCE_REGEX_LAZY-!-(\-?[0-9]+|\*)-!-/_$1/og; # Change placeholders back to their original return $built; }; } sub get_handle { my ( $class, @langtags ) = @_; my $args_sig = join( ',', @langtags ) || 'no_args'; if ( exists $singleton_stash{$class}{$args_sig} ) { $singleton_stash{$class}{$args_sig}->{'_singleton_reused'}++; } else { $singleton_stash{$class}{$args_sig} = $class->SUPER::get_handle(@langtags); } return $singleton_stash{$class}{$args_sig}; } sub get_locales_obj { my ( $lh, $tag ) = @_; $tag ||= $lh->get_language_tag(); if ( !exists $lh->{'Locales.pm'}{$tag} ) { require Cpanel::CPAN::Locales; $lh->{'Locales.pm'}{$tag} = Cpanel::CPAN::Locales->new($tag) || ( $tag ne substr( $tag, 0, 2 ) ? Cpanel::CPAN::Locales->new( substr( $tag, 0, 2 ) ) : '' ) || ( $lh->{'fallback_locale'} ? ( Cpanel::CPAN::Locales->new( $lh->{'fallback_locale'} ) || ( $lh->{'fallback_locale'} ne substr( $lh->{'fallback_locale'}, 0, 2 ) ? Cpanel::CPAN::Locales->new( substr( $lh->{'fallback_locale'}, 0, 2 ) ) : '' ) ) : '' ) || Cpanel::CPAN::Locales->new('en'); } return $lh->{'Locales.pm'}{$tag}; } sub init { my ($lh) = @_; $lh->SUPER::init(); $lh->remove_key_from_lexicons('_AUTO'); no strict 'refs'; for my $ns ( $lh->get_base_class(), $lh->get_language_class() ) { if ( defined ${ $ns . '::Encoding' } ) { $lh->{'encoding'} = ${ $ns . '::Encoding' } if ${ $ns . '::Encoding' }; } } $lh->fail_with( sub { my ( $lh, $key, @args ) = @_; my $lookup; if ( exists $lh->{'_get_key_from_lookup'} ) { if ( ref $lh->{'_get_key_from_lookup'} eq 'CODE' ) { $lookup = $lh->{'_get_key_from_lookup'}->( $lh, $key, @args ); } } return $lookup if defined $lookup; if ( exists $lh->{'_log_phantom_key'} ) { if ( ref $lh->{'_log_phantom_key'} eq 'CODE' ) { $lh->{'_log_phantom_key'}->( $lh, $key, @args ); } } if ( $lh->{'use_external_lex_cache'} ) { local $lh->{'_external_lex_cache'}{'_AUTO'} = 1; if ( index( $key, '_' ) == 0 ) { return $lh->{'_external_lex_cache'}{$key} = $key; } return $lh->maketext( $key, @args ); } else { no strict 'refs'; local ${ $lh->get_base_class() . '::Lexicon' }{'_AUTO'} = 1; if ( index( $key, '_' ) == 0 ) { return ${ $lh->get_base_class() . '::Lexicon' }{$key} = $key; } return $lh->maketext( $key, @args ); } } ); } *makevar = \&Cpanel::CPAN::Locale::Maketext::maketext; sub makethis { my ( $lh, $phrase, @phrase_args ) = @_; $lh->{'cache'}{'makethis'}{$phrase} ||= $lh->_compile($phrase); my $type = ref( $lh->{'cache'}{'makethis'}{$phrase} ); if ( $type eq 'SCALAR' ) { return ${ $lh->{'cache'}{'makethis'}{$phrase} }; } elsif ( $type eq 'CODE' ) { return $lh->{'cache'}{'makethis'}{$phrase}->( $lh, @phrase_args ); } else { return $lh->{'cache'}{'makethis'}{$phrase}; } } sub makethis_base { my ($lh) = @_; $lh->{'cache'}{'makethis_base'} ||= $lh->get_base_class()->get_handle( $lh->{'fallback_locale'} || 'en' ); # this allows to have a separate cache of compiled phrases (? get_handle() explicit or base_locales() (i.e. en en_us i_default || L::M->fallback_languages) ?) return $lh->{'cache'}{'makethis_base'}->makethis( @_[ 1 .. $#_ ] ); } sub make_alias { my ( $lh, $pkgs, $is_base_class ) = @_; my $ns = $lh->get_language_class(); return if $ns =~ tr{:0-9A-Za-z_-}{}c; my $base = $is_base_class ? $ns : $lh->get_base_class(); no strict 'refs'; for my $pkg ( ref $pkgs ? @{$pkgs} : $pkgs ) { next if $pkg =~ tr{:0-9A-Za-z_-}{}c; *{ $base . '::' . $pkg . '::Encoding' } = *{ $ns . '::Encoding' }; *{ $base . '::' . $pkg . '::Lexicon' } = *{ $ns . '::Lexicon' }; @{ $base . '::' . $pkg . '::ISA' } = ($ns); } } sub remove_key_from_lexicons { my ( $lh, $key ) = @_; my $idx = 0; for my $lex_hr ( @{ $lh->_lex_refs() } ) { $lh->{'_removed_from_lexicons'}{$idx}{$key} = delete $lex_hr->{$key} if exists $lex_hr->{$key}; $idx++; } } my %grapheme_lookup = ( 'trademark' => "\xE2\x84\xA2", # 'TRADE MARK SIGN' (U+2122) 'registered' => "\xC2\xAE", # 'REGISTERED SIGN' (U+00AE) 'copyright' => "\xC2\xA9", # 'COPYRIGHT SIGN' (U+00A9) 'left_double_quote' => "\xE2\x80\x9C", # 'LEFT DOUBLE QUOTATION MARK' (U+201C) 'right_double_quote' => "\xE2\x80\x9D", # 'RIGHT DOUBLE QUOTATION MARK' (U+201D) 'ellipsis' => "\xE2\x80\xA6", # 'HORIZONTAL ELLIPSIS' (U+2026) 'left_single_quote' => "\xE2\x80\x98", # 'LEFT SINGLE QUOTATION MARK' (U+2018) 'right_single_quote' => "\xE2\x80\x99", # 'RIGHT SINGLE QUOTATION MARK' 'infinity' => "\xE2\x88\x9E", # 'INFINITY' (U+221E) ); sub get_grapheme_helper_hashref { return {%grapheme_lookup}; # copy } sub get_base_class { my $ns = $_[0]->get_language_class(); return $ns if $ns eq 'Cpanel::Locale'; return substr( $ns, 0, rindex( $ns, '::' ) ); } sub append_to_lexicons { my ( $lh, $appendage ) = @_; return if ref $appendage ne 'HASH'; no strict 'refs'; for my $lang ( keys %{$appendage} ) { my $ns = $lh->get_base_class() . ( $lang eq '_' ? '' : "::$lang" ) . '::Lexicon'; %{$ns} = ( %{$ns}, %{ $appendage->{$lang} } ); } } sub langtag_is_loadable { my ( $lh, $wants_tag ) = @_; $wants_tag = Cpanel::CPAN::Locale::Maketext::language_tag($wants_tag); my $tag_obj = eval $lh->get_base_class() . q{->get_handle( $wants_tag );}; my $has_tag = $tag_obj->language_tag(); return $wants_tag eq $has_tag ? $tag_obj : 0; } sub get_language_tag { return ( split '::', $_[0]->get_language_class() )[-1]; } sub print { local $Carp::CarpLevel = 1; print $_[0]->maketext( @_[ 1 .. $#_ ] ); } sub fetch { local $Carp::CarpLevel = 1; return $_[0]->maketext( @_[ 1 .. $#_ ] ); } sub say { local $Carp::CarpLevel = 1; my $text = $_[0]->maketext( @_[ 1 .. $#_ ] ); local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid print $text . $/ if $text; } sub get { local $Carp::CarpLevel = 1; my $text = $_[0]->maketext( @_[ 1 .. $#_ ] ); local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid return $text . $/ if $text; return; } sub get_language_tag_name { my ( $lh, $tag, $in_locale_tongue ) = @_; $tag ||= $lh->get_language_tag(); my $loc_obj = $lh->get_locales_obj( $in_locale_tongue ? () : ($tag) ); if ( $loc_obj->{'native_data'} && $tag eq $lh->get_language_tag() ) { return $loc_obj->get_native_language_from_code($tag); } return $loc_obj->get_language_from_code($tag); } sub get_html_dir_attr { my ( $lh, $raw_cldr, $is_tag ) = @_; if ($is_tag) { $raw_cldr = $lh->get_language_tag_character_orientation($raw_cldr); } else { $raw_cldr ||= $lh->get_language_tag_character_orientation(); } if ( $raw_cldr eq 'left-to-right' ) { return 'ltr'; } elsif ( $raw_cldr eq 'right-to-left' ) { return 'rtl'; } return; } sub get_locale_display_pattern { require Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny; return Cpanel::CPAN::Locales::DB::LocaleDisplayPattern::Tiny::get_locale_display_pattern( $_[1] || $_[0]->{'fallback_locale'} || $_[0]->get_language_tag() ); } sub get_language_tag_character_orientation { require Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny; return Cpanel::CPAN::Locales::DB::CharacterOrientation::Tiny::get_orientation( $_[1] || $_[0]->{'fallback_locale'} || $_[0]->get_language_tag() ); } *lextext = *text; sub text { if ( @_ != 2 ) { require Carp; Carp::croak('text() requires a singlef parameter'); } my ( $handle, $phrase ) = splice( @_, 0, 2 ); unless ( defined($handle) && defined($phrase) ) { require Carp; Carp::confess('No handle/phrase'); } if ( !$handle->{'use_external_lex_cache'} ) { require Carp; Carp::carp("text() requires you to have 'use_external_lex_cache' enabled."); return; } local $@; my $value; foreach my $h_r ( @{ $handle->_lex_refs } ) { # _lex_refs() caches itself if ( defined( $value = $h_r->{$phrase} ) ) { if ( ref $value ) { require Carp; Carp::carp("Previously compiled phrase ('use_external_lex_cache' enabled after phrase was compiled?)"); } return $value eq '' ? $phrase : $value; } elsif ( index( $phrase, '_' ) != 0 and $h_r->{'_AUTO'} ) { return $phrase; } } return ( !defined $value || $value eq '' ) ? $phrase : $value; } our $_NATIVE_ONLY = 0; sub lang_names_hashref_native_only { local $_NATIVE_ONLY = 1; return lang_names_hashref(@_); } sub lang_names_hashref { my ( $lh, @langcodes ) = @_; if ( !@langcodes ) { # they havn't specified any langcodes... require File::Spec; # only needed here, so we don't use() it my @search; my $path = $lh->get_base_class(); substr( $path, index( $path, '::' ), 2, '/' ) while index( $path, '::' ) > -1; if ( ref $lh->{'_lang_pm_search_paths'} eq 'ARRAY' ) { @search = @{ $lh->{'_lang_pm_search_paths'} }; } @search = @INC if !@search; # they havn't told us where they are specifically DIR: for my $dir (@search) { my $lookin = File::Spec->catdir( $dir, $path ); next DIR if !-d $lookin; if ( opendir my $dh, $lookin ) { PM: for my $pm ( grep { /^\w+\.pm$/ } grep !/^\.+$/, readdir($dh) ) { substr( $pm, -3, 3, '' ); # checked above - if substr( $pm, -3 ) eq '.pm'; next PM if !$pm; next PM if $pm eq 'Utils'; next PM if $pm eq 'Context'; next PM if $pm eq 'Lazy'; push @langcodes, $pm; } closedir $dh; } } } require Cpanel::CPAN::Locales; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); my $langname = {}; my $native = wantarray && $Cpanel::CPAN::Locales::VERSION > 0.06 ? {} : undef; my $direction = wantarray && $Cpanel::CPAN::Locales::VERSION > 0.09 ? {} : undef; for my $code ( 'en', @langcodes ) { # en since it is "built in" if ( defined $native ) { $native->{$code} = $lh->{'Locales.pm'}{'_main_'}->get_native_language_from_code( $code, 1 ); } $langname->{$code} = $_NATIVE_ONLY ? $native->{$code} : $lh->{'Locales.pm'}{'_main_'}->get_language_from_code( $code, 1 ); if ( defined $direction ) { $direction->{$code} = $lh->{'Locales.pm'}{'_main_'}->get_character_orientation_from_code_fast($code); } } return wantarray ? ( $langname, $native, $direction ) : $langname; } sub loadable_lang_names_hashref { my ( $lh, @langcodes ) = @_; my $langname = $lh->lang_names_hashref(@langcodes); for my $tag ( keys %{$langname} ) { delete $langname->{$tag} if !$lh->langtag_is_loadable($tag); } return $langname; } sub add_lexicon_override_hash { my ( $lh, $langtag, $name, $hr ) = @_; if ( @_ == 3 ) { $hr = $name; $name = $langtag; $langtag = $lh->get_language_tag(); } my $ns = $lh->get_language_tag() eq $langtag ? $lh->get_language_class() : $lh->get_base_class(); no strict 'refs'; if ( my $ref = tied( %{ $ns . '::Lexicon' } ) ) { return 1 if $lh->{'add_lex_hash_silent_if_already_added'} && exists $ref->{'hashes'} && exists $ref->{'hashes'}{$name}; if ( $ref->can('add_lookup_override_hash') ) { return $ref->add_lookup_override_hash( $name, $hr ); } } my $cur_errno = $!; if ( eval { require Sub::Todo } ) { goto &Sub::Todo::todo; } else { $! = $cur_errno; return; } } sub add_lexicon_fallback_hash { my ( $lh, $langtag, $name, $hr ) = @_; if ( @_ == 3 ) { $hr = $name; $name = $langtag; $langtag = $lh->get_language_tag(); } my $ns = $lh->get_language_tag() eq $langtag ? $lh->get_language_class() : $lh->get_base_class(); no strict 'refs'; if ( my $ref = tied( %{ $ns . '::Lexicon' } ) ) { return 1 if $lh->{'add_lex_hash_silent_if_already_added'} && exists $ref->{'hashes'} && exists $ref->{'hashes'}{$name}; if ( $ref->can('add_lookup_fallback_hash') ) { return $ref->add_lookup_fallback_hash( $name, $hr ); } } my $cur_errno = $!; if ( eval { require Sub::Todo } ) { goto &Sub::Todo::todo; } else { $! = $cur_errno; return; } } sub del_lexicon_hash { my ( $lh, $langtag, $name ) = @_; if ( @_ == 2 ) { return if $langtag eq '*'; $name = $langtag; $langtag = '*'; } return if !$langtag; my $count = 0; if ( $langtag eq '*' ) { no strict 'refs'; for my $ns ( $lh->get_base_class(), $lh->get_language_class() ) { if ( my $ref = tied( %{ $ns . '::Lexicon' } ) ) { if ( $ref->can('del_lookup_hash') ) { $ref->del_lookup_hash($name); $count++; } } } return 1 if $count; my $cur_errno = $!; if ( eval { require Sub::Todo } ) { goto &Sub::Todo::todo; } else { $! = $cur_errno; return; } } else { my $ns = $lh->get_language_tag() eq $langtag ? $lh->get_language_class() : $lh->get_base_class(); no strict 'refs'; if ( my $ref = tied( %{ $ns . '::Lexicon' } ) ) { if ( $ref->can('del_lookup_hash') ) { return $ref->del_lookup_hash($name); } } my $cur_errno = $!; if ( eval { require Sub::Todo } ) { goto &Sub::Todo::todo; } else { $! = $cur_errno; return; } } } sub get_language_class { return ref( $_[0] ) || $_[0]; } sub get_base_class_dir { my ($lh) = @_; if ( !exists $lh->{'Cpanel::CPAN::Locale::Maketext::Utils'}{'_base_clase_dir'} ) { $lh->{'Cpanel::CPAN::Locale::Maketext::Utils'}{'_base_clase_dir'} = undef; my $inc_key = $lh->get_base_class(); substr( $inc_key, index( $inc_key, '::' ), 2, '/' ) while index( $inc_key, '::' ) > -1; $inc_key .= '.pm'; if ( exists $INC{$inc_key} ) { if ( -e $INC{$inc_key} ) { my $hr = $lh->{'Cpanel::CPAN::Locale::Maketext::Utils'}; $hr->{'_base_clase_dir'} = $INC{$inc_key}; substr( $hr->{'_base_clase_dir'}, -3, 3, '' ) if substr( $hr->{'_base_clase_dir'}, -3 ) eq '.pm'; } } } return $lh->{'Cpanel::CPAN::Locale::Maketext::Utils'}{'_base_clase_dir'}; } sub list_available_locales { my ($lh) = @_; die "List context only!" if !wantarray; my $main_ns_dir = $lh->get_base_class_dir() || return; local $!; opendir my $dh, $main_ns_dir or die "Failed to open: $main_ns_dir: $!"; return map { ( substr( $_, -3 ) eq '.pm' && $_ ne 'Utils.pm' && $_ ne 'Lazy.pm' && $_ ne 'Context.pm' && $_ ne 'Fallback.pm' ) ? substr( $_, 0, -3 ) : () } readdir($dh); #de-taint } sub get_asset { my ( $lh, $code, $tag ) = @_; # No caching since $code can do anything. my $root = $tag || $lh->get_language_tag; my $ret; die "Invalid locale: $root" if index( $root, '/' ) > -1; $ret = $code->($root); return $ret if defined $ret; my $loc; # buffer my %seen = ( $root => 1 ); my @fallback_locales; if ( $lh->_has_fallback_list($root) ) { my $loc_obj = $lh->get_locales_obj($tag); @fallback_locales = $loc_obj->get_fallback_list( $lh->{'Locales.pm'}{'get_fallback_list_special_lookup_coderef'} ); } elsif ( $root ne 'en' ) { my $super = ( split( m{_}, $root ) )[0]; @fallback_locales = ( ( $super ne $root && $super ne 'i' ? $super : () ), 'en' ); } for $loc (@fallback_locales) { next if $seen{$loc}; # get_fallback_list can provide back dupes and its expensive to enumerate each one $ret = $code->($loc); $seen{$loc}++; last if defined $ret; } return $ret if defined $ret; return; } sub _has_fallback_list { return $_[0]->{'_has_fallback_list'}{ $_[1] } if defined $_[0]->{'_has_fallback_list'}{ $_[1] }; my $size = -s LOCALE_FALLBACK_CACHE_DIR . '/' . $_[1]; return ( $_[0]->{'_has_fallback_list'}{ $_[1] } = ( !defined $size || $size ) ? 1 : 0 ); } sub get_asset_file { my ( $lh, $find, $return ) = @_; $return = $find if !defined $return; return $lh->{'cache'}{'get_asset_file'}{$find}{$return} if exists $lh->{'cache'}{'get_asset_file'}{$find}{$return}; $lh->{'cache'}{'get_asset_file'}{$find}{$return} = $lh->get_asset( sub { return sprintf( $return, $_[0] ) if -f sprintf( $find, $_[0] ); return; } ); return $lh->{'cache'}{'get_asset_file'}{$find}{$return} if defined $lh->{'cache'}{'get_asset_file'}{$find}{$return}; return; } sub get_asset_dir { my ( $lh, $find, $return ) = @_; $return = $find if !defined $return; return $lh->{'cache'}{'get_asset_dir'}{$find}{$return} if exists $lh->{'cache'}{'get_asset_dir'}{$find}{$return}; $lh->{'cache'}{'get_asset_dir'}{$find}{$return} = $lh->get_asset( sub { return sprintf( $return, $_[0] ) if -d sprintf( $find, $_[0] ); return; } ); return $lh->{'cache'}{'get_asset_dir'}{$find}{$return} if defined $lh->{'cache'}{'get_asset_dir'}{$find}{$return}; return; } sub delete_cache { my ( $lh, $which ) = @_; if ( defined $which ) { return delete $lh->{'cache'}{$which}; } else { return delete $lh->{'cache'}; } } sub quant { my ( $handle, $num, @forms ) = @_; my $max_decimal_places = 3; if ( ref($num) eq 'ARRAY' ) { $max_decimal_places = $num->[1]; $num = $num->[0]; } $handle->{'Locales.pm'}{'_main_'} ||= $handle->get_locales_obj(); my ( $string, $spec_zero ) = $handle->{'Locales.pm'}{'_main_'}->get_plural_form( $num, @forms ); if ( index( $string, '%s' ) > -1 ) { return sprintf( $string, $handle->numf( $num, $max_decimal_places ) ); } elsif ( $num == 0 && $spec_zero ) { return $string; } else { $handle->numf( $num, $max_decimal_places ) . " $string"; } } sub numerate { my ( $handle, $num, @forms ) = @_; $handle->{'Locales.pm'}{'_main_'} ||= $handle->get_locales_obj(); return scalar( $handle->{'Locales.pm'}{'_main_'}->get_plural_form( $num, @forms ) ); } sub numf { my ( $handle, $num, $max_decimal_places ) = @_; $handle->{'Locales.pm'}{'_main_'} ||= $handle->get_locales_obj(); return $handle->{'Locales.pm'}{'_main_'}->get_formatted_decimal( $num, $max_decimal_places ); } sub join { shift; return CORE::join( shift, map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @_ ); } sub list_and { my $lh = shift; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); return $lh->{'Locales.pm'}{'_main_'}->get_list_and( map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @_ ); } sub list_or { my $lh = shift; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); return $lh->{'Locales.pm'}{'_main_'}->get_list_or( map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @_ ); } sub list_and_quoted { my ( $lh, @args ) = @_; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); local $lh->{'Locales.pm'}{'_main_'}{'misc'}{'list_quote_mode'} = 'all'; return $lh->list_and(@args); } sub list_or_quoted { my ( $lh, @args ) = @_; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); local $lh->{'Locales.pm'}{'_main_'}{'misc'}{'list_quote_mode'} = 'all'; return $lh->list_or(@args); } sub output_asis { return $_[1]; } sub asis { return $_[0]->output( 'asis', $_[1] ); # this allows for embedded methods but still called via [asis,...] instead of [output,asis,...] } sub comment { return ''; } sub is_future { my ( $lh, $dt, $future, $past, $current, $current_type ) = @_; if ( $dt =~ tr{0-9}{}c ) { $dt = __get_dt_obj_from_arg( $dt, 0 ); $dt = $dt->epoch(); } if ($current) { if ( !ref $dt ) { $dt = __get_dt_obj_from_arg( $dt, 0 ); } $current_type ||= 'hour'; if ( $current_type eq 'day' ) { } elsif ( $current_type eq 'minute' ) { } else { } } return ref $dt ? $dt->epoch() : $dt > time() ? $future : $past; } sub __get_dt_obj_from_arg { require # hide from Cpanel::Static DateTime; return !defined $_[0] || $_[0] eq '' ? DateTime->now() : ref $_[0] eq 'HASH' ? DateTime->new( %{ $_[0] } ) : $_[0] =~ m{ \A (\d+ (?: [.] \d+ )? ) (?: [:] (.*) )? \z }xms ? DateTime->from_epoch( 'epoch' => $1, 'time_zone' => ( $2 || 'UTC' ) ) : !ref $_[0] ? DateTime->now( 'time_zone' => ( $_[0] || 'UTC' ) ) : $_[1] ? $_[0]->clone() : $_[0]; } sub current_year { $_[0]->datetime( '', 'YYYY' ); } sub datetime { my ( $lh, $dta, $str ) = @_; my $dt = __get_dt_obj_from_arg( $dta, 1 ); if ( !$INC{'DateTime/Locale.pm'} ) { # __get_dt_obj_from_arg is loading DateTime eval q{ require DateTime::Locale; 1 } or die "Cannot load DateTime::Locale: $!"; } $dt->{'locale'} = DateTime::Locale->load( $lh->language_tag() ); my $format = ref $str eq 'CODE' ? $str->($dt) : $str; if ( defined $format ) { if ( $dt->{'locale'}->can($format) ) { $format = $dt->{'locale'}->$format(); } } $format = '' if !defined $format; return $dt->format_cldr( $dt->{'locale'}->format_for($format) || $format || $dt->{'locale'}->date_format_long() ); } sub output_amp { return $_[0]->output_chr(38) } sub output_lt { return $_[0]->output_chr(60) } # TODO: ? make the rest of these embeddable like amp() ? sub output_gt { return $_[0]->output_chr(62) } sub output_apos { return $_[0]->output_chr(39) } sub output_quot { return $_[0]->output_chr(34) } sub output_shy { return $_[0]->output_chr(173) } use constant output_nbsp => "\xC2\xA0"; my $space; sub format_bytes { my ( $lh, $bytes, $max_decimal_place ) = @_; $bytes ||= 0; if ( !defined $max_decimal_place ) { $max_decimal_place = 2; } else { $max_decimal_place = int( abs($max_decimal_place) ); } my $absnum = abs($bytes); $space ||= $lh->output_nbsp(); # avoid method call if we already have it if ( $absnum < 1024 ) { return ( $lh->{'_format_bytes_cache'}{ $bytes . '_' . $max_decimal_place } ||= $lh->maketext( '[quant,_1,%s byte,%s bytes]', [ $bytes, $max_decimal_place ] ) ); # the space between the '%s' and the 'b' is a non-break space (e.g. option-spacebar, not spacebar) } elsif ( $absnum < 1048576 ) { return $lh->numf( ( $bytes / 1024 ), $max_decimal_place ) . $space . 'KB'; } elsif ( $absnum < 1073741824 ) { return $lh->numf( ( $bytes / 1048576 ), $max_decimal_place ) . $space . 'MB'; } elsif ( $absnum < 1099511627776 ) { return $lh->numf( ( $bytes / 1073741824 ), $max_decimal_place ) . $space . 'GB'; } elsif ( $absnum < 1125899906842624 ) { return $lh->numf( ( $bytes / 1099511627776 ), $max_decimal_place ) . $space . 'TB'; } elsif ( $absnum < ( 1125899906842624 * 1024 ) ) { return $lh->numf( ( $bytes / 1125899906842624 ), $max_decimal_place ) . $space . 'PB'; } elsif ( $absnum < ( 1125899906842624 * 1024 * 1024 ) ) { return $lh->numf( ( $bytes / ( 1125899906842624 * 1024 ) ), $max_decimal_place ) . $space . 'EB'; } elsif ( $absnum < ( 1125899906842624 * 1024 * 1024 * 1024 ) ) { return $lh->numf( ( $bytes / ( 1125899906842624 * 1024 * 1024 ) ), $max_decimal_place ) . $space . 'ZB'; } else { return $lh->numf( ( $bytes / ( 1125899906842624 * 1024 * 1024 * 1024 ) ), $max_decimal_place ) . $space . 'YB'; } } sub convert { die __PACKAGE__ . "::convert is not supported (missing Math::Units)"; } sub is_defined { my ( $lh, $value, $is_defined, $not_defined, $is_defined_but_false ) = @_; return __proc_string_with_embedded_under_vars($not_defined) if !defined $value; if ( defined $is_defined_but_false && !$value ) { return __proc_string_with_embedded_under_vars($is_defined_but_false); } else { return __proc_string_with_embedded_under_vars($is_defined); } } sub boolean { my ( $lh, $boolean, $true, $false, $null ) = @_; if ($boolean) { return __proc_string_with_embedded_under_vars($true); } else { if ( !defined $boolean && defined $null ) { return __proc_string_with_embedded_under_vars($null); } return __proc_string_with_embedded_under_vars($false); } } sub __proc_string_with_embedded_under_vars { my $str = $_[0]; return $str if index( $str, '_' ) == -1 || $str !~ m/$FORCE_REGEX_LAZY\_(?:\-?[0-9]+)/o; my @args = __caller_args( $_[1] ); # this way be dragons $str =~ s/$FORCE_REGEX_LAZY\_(\-?[0-9]+)/$args[$1]/og; return $str; } sub __caller_args { package DB; () = caller( $_[0] + 3 ); return @DB::args; } sub __proc_emb_meth { my ( $lh, $str ) = @_; $str =~ s/$FORCE_REGEX_LAZY(su[bp])\(((?:\\\)|[^\)])+?)\)/my $s=$2;my $m="output_$1";$s=~s{\\\)}{\)}g;$lh->$m($s)/oeg if index( $str, 'su' ) > -1; $str =~ s/${FORCE_REGEX_LAZY}chr\(((?:\d+|[\S]))\)/$lh->output_chr($1)/oeg if index( $str, 'chr(' ) > -1; $str =~ s/${FORCE_REGEX_LAZY}numf\((\d+(?:\.\d+)?)\)/$lh->numf($1)/oeg if index( $str, 'numf(' ) > -1; substr( $str, index( $str, 'amp()' ), 5, $lh->output_amp() ) while index( $str, 'amp()' ) > -1; return $str; } sub output { my ( $lh, $output_function, $string, @output_function_args ) = @_; if ( defined $string && $string ne '' && index( $string, '(' ) > -1 ) { $string = __proc_emb_meth( $lh, $string ); } if ( $output_function eq 'url' && defined $output_function_args[0] && $output_function_args[0] ne '' && index( $output_function_args[0], '(' ) > -1 ) { $output_function_args[0] = __proc_emb_meth( $lh, $output_function_args[0] ); } if ( my $cr = ( $lh->{'_output_function_cache'}{$output_function} ||= $lh->can( 'output_' . $output_function ) ) ) { return $cr->( $lh, $string, @output_function_args ); } else { my $cur_errno = $!; if ( eval { require Sub::Todo } ) { $! = Sub::Todo::get_errno_func_not_impl(); } else { $! = $cur_errno; } return $string; } } sub output_encode_puny { my ( $self, $s ) = @_; require # do not include it in updatenow.static Cpanel::Encoder::Punycode; return Cpanel::Encoder::Punycode::punycode_encode_str($s); } sub output_decode_puny { my ( $self, $s ) = @_; require # do not include it in updatenow.static Cpanel::Encoder::Punycode; return Cpanel::Encoder::Punycode::punycode_decode_str($s); } my $has_encode; # checking for Encode this way facilitates only checking @INC once for the module on systems that do not have Encode sub output_chr { my ( $lh, $chr_num ) = @_; if ( $chr_num !~ m/$FORCE_REGEX_LAZY\A\d+\z/o ) { return if length($chr_num) != 1; return $chr_num if !$lh->context_is_html(); return $chr_num eq '"' ? '"' : $chr_num eq '&' ? '&' : $chr_num eq "'" ? ''' : $chr_num eq '<' ? '<' : $chr_num eq '>' ? '>' : $chr_num; } return if $chr_num !~ m/$FORCE_REGEX_LAZY\A\d+\z/o; my $chr = chr($chr_num); if ( $chr_num > 127 ) { if ( !defined $has_encode ) { $has_encode = 0; eval { require Encode; $has_encode = 1; }; } if ($has_encode) { $chr = Encode::encode( $lh->encoding(), $chr ); } else { $chr = eval '"\x{' . sprintf( '%04X', $chr_num ) . '}"'; } } if ( !$lh->context_is_html() ) { return $chr; } else { return $chr_num == 34 || $chr_num == 147 || $chr_num == 148 ? '"' : $chr_num == 38 ? '&' : $chr_num == 39 || $chr_num == 145 || $chr_num == 146 ? ''' : $chr_num == 60 ? '<' : $chr_num == 62 ? '>' : $chr_num == 173 ? '­' : $chr; } } sub output_class { my ( $lh, $string, @classes ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if $lh->context_is_plain(); return $lh->context_is_ansi() ? "\e[1m$string\e[0m" : qq{$string}; } sub output_asis_for_tests { my ( $lh, $string ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string; } sub __make_attr_str_from_ar { my ( $attr_ar, $strip_hr, $addin ) = @_; if ( ref($attr_ar) eq 'HASH' ) { $strip_hr = $attr_ar; $attr_ar = []; } my $attr = ''; my $general_hr = ref( $attr_ar->[-1] ) eq 'HASH' ? pop( @{$attr_ar} ) : undef; my $idx = 0; my $ar_len = @{$attr_ar}; $idx = 1 if $ar_len % 2; # handle “Odd number of elements” … my $did_addin; while ( $idx < $ar_len ) { if ( exists $strip_hr->{ $attr_ar->[$idx] } ) { $idx += 2; next; } my $atr = $attr_ar->[$idx]; my $val = $attr_ar->[ ++$idx ]; if ( exists $addin->{$atr} ) { $val = "$addin->{$atr} $val"; $did_addin->{$atr}++; } $attr .= qq{ $atr="$val"}; $idx++; } if ($general_hr) { for my $k ( keys %{$general_hr} ) { next if exists $strip_hr->{$k}; if ( exists $addin->{$k} ) { $general_hr->{$k} = "$addin->{$k} $general_hr->{$k}"; $did_addin->{$k}++; } $attr .= qq{ $k="$general_hr->{$k}"}; } } for my $r ( keys %{$addin} ) { if ( !exists $did_addin->{$r} ) { $attr .= qq{ $r="$addin->{$r}"}; } } return $attr; } sub output_inline { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if !$lh->context_is_html(); my $attr = __make_attr_str_from_ar( \@attrs ); return qq{$string}; } *output_attr = \&output_inline; sub output_block { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if !$lh->context_is_html(); my $attr = __make_attr_str_from_ar( \@attrs ); return qq{$string}; } sub output_img { my ( $lh, $src, $alt, @attrs ) = @_; if ( !defined $alt || $alt eq '' ) { $alt = $src; } else { $alt = __proc_string_with_embedded_under_vars( $alt, 1 ); } return $alt if !$lh->context_is_html(); my $attr = __make_attr_str_from_ar( \@attrs, { 'alt' => 1, 'src' => 1 } ); return qq{$alt}; } sub output_abbr { my ( $lh, $abbr, $full, @attrs ) = @_; return !$lh->context_is_html() ? "$abbr ($full)" : qq{ 1 } ) . qq{>$abbr}; } sub output_acronym { my ( $lh, $acronym, $full, @attrs ) = @_; return !$lh->context_is_html() ? "$acronym ($full)" : qq{ 1 }, { 'class' => 'initialism' } ) . qq{>$acronym}; } sub output_sup { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return !$lh->context_is_html() ? $string : qq{$string}; } sub output_sub { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return !$lh->context_is_html() ? $string : qq{$string}; } sub output_underline { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if $lh->context_is_plain(); return $lh->context_is_ansi() ? "\e[4m$string\e[0m" : qq{$string}; } sub output_strong { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if $lh->context_is_plain(); return $lh->context_is_ansi() ? "\e[1m$string\e[0m" : '$string"; } sub output_em { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return $string if $lh->context_is_plain(); return $lh->context_is_ansi() ? "\e[3m$string\e[0m" : '$string"; } sub output_url { my ( $lh, $url, @args ) = @_; $url ||= ''; # carp() ? my $arb_args_hr = ref $args[-1] eq 'HASH' ? pop(@args) : {}; my ( $url_text, %output_config ) = @args % 2 ? @args : ( undef, @args ); my $return = $url; if ( !$lh->context_is_html() ) { if ($url_text) { return "$url_text ($url)"; } if ( exists $output_config{'plain'} ) { $output_config{'plain'} ||= $url; my $orig = $output_config{'plain'}; $output_config{'plain'} = __proc_string_with_embedded_under_vars( $output_config{'plain'}, 1 ); $return = $orig ne $output_config{'plain'} && $output_config{'plain'} =~ m/\Q$url\E/ ? $output_config{'plain'} : "$output_config{'plain'} $url"; } } else { if ( exists $output_config{'html'} ) { $output_config{'html'} = __proc_string_with_embedded_under_vars( $output_config{'html'}, 1 ); } $output_config{'html'} ||= $url_text || $url; my $attr = __make_attr_str_from_ar( [ @args, $arb_args_hr ], { 'html' => 1, 'plain' => 1, '_type' => 1, } ); $return = exists $output_config{'_type'} && $output_config{'_type'} eq 'offsite' ? qq{$output_config{'html'}} : qq{$output_config{'html'}}; } return $return; } sub set_context_html { my ($lh) = @_; my $cur = $lh->get_context(); $lh->set_context('html'); return if !$lh->context_is_html(); return $cur; } sub set_context_ansi { my ($lh) = @_; my $cur = $lh->get_context(); $lh->set_context('ansi'); return if !$lh->context_is_ansi(); return $cur; } sub set_context_plain { my ($lh) = @_; my $cur = $lh->get_context(); $lh->set_context('plain'); return if !$lh->context_is_plain(); return $cur; } my %contexts = ( 'plain' => undef(), 'ansi' => 1, 'html' => 0, ); sub set_context { my ( $lh, $context ) = @_; if ( !$context ) { $lh->{'-t-STDIN'} = -t *STDIN ? 1 : 0; } elsif ( exists $contexts{$context} ) { $lh->{'-t-STDIN'} = $contexts{$context}; } else { require Carp; local $Carp::CarpLevel = 1; Carp::carp("Given context '$context' is unknown."); $lh->{'-t-STDIN'} = $context; } } sub context_is_html { return $_[0]->get_context() eq 'html'; } sub context_is_ansi { return $_[0]->get_context() eq 'ansi'; } sub context_is_plain { return $_[0]->get_context() eq 'plain'; } sub context_is { return $_[0]->get_context() eq $_[1]; } sub get_context { $_[0]->set_context() if !exists $_[0]->{'-t-STDIN'}; return !defined $_[0]->{'-t-STDIN'} ? 'plain' : $_[0]->{'-t-STDIN'} ? 'ansi' : 'html'; } sub maketext_html_context { my ( $lh, @mt_args ) = @_; my $cur = $lh->set_context_html(); my $res = $lh->maketext(@mt_args); $lh->set_context($cur); return $res; } sub maketext_ansi_context { my ( $lh, @mt_args ) = @_; my $cur = $lh->set_context_ansi(); my $res = $lh->maketext(@mt_args); $lh->set_context($cur); return $res; } sub maketext_plain_context { my ( $lh, @mt_args ) = @_; my $cur = $lh->set_context_plain(); my $res = $lh->maketext(@mt_args); $lh->set_context($cur); return $res; } 1; } # --- END Cpanel/CPAN/Locale/Maketext/Utils.pm { # --- BEGIN Cpanel/Locale/Utils/Paths.pm package Cpanel::Locale::Utils::Paths; use strict; use warnings; use constant { get_legacy_lang_cache_root => '/var/cpanel/lang.cache', get_i_locales_config_path => '/var/cpanel/i_locales', get_custom_whitelist_path => '/var/cpanel/maketext_whitelist' }; sub get_locale_database_root { return '/var/cpanel/locale' } sub get_locale_yaml_root { return '/usr/local/cpanel/locale' } sub get_legacy_lang_root { return '/usr/local/cpanel/lang' } sub get_locale_yaml_local_root { return '/var/cpanel/locale.local' } 1; } # --- END Cpanel/Locale/Utils/Paths.pm { # --- BEGIN Cpanel/Locale/Utils.pm package Cpanel::Locale::Utils; use strict; use warnings; BEGIN { eval { require CDB_File; }; } # use Cpanel::Locale::Utils::Paths (); $Cpanel::Locale::Utils::i_am_the_compiler = 0; my $logger; sub _logger { require Cpanel::Logger; $logger ||= Cpanel::Logger->new(); } sub get_readonly_tie { my ( $cdb_file, $cdb_hr ) = @_; if ( !$cdb_file ) { _logger()->warn('Undefined CDB file specified for readonly operation'); return; } elsif ( !$INC{'CDB_File.pm'} || !exists $CDB_File::{'TIEHASH'} ) { _logger()->warn("Failed to load CDB_File.pm") if $^X ne '/usr/bin/perl'; return; } my $tie_obj = tie %{$cdb_hr}, 'CDB_File', $cdb_file; if ( !$tie_obj && !-e $cdb_file ) { _logger()->warn("Missing CDB file $cdb_file specified for readonly operation"); return; } eval { exists $cdb_hr->{'__VERSION'} }; if ($@) { $tie_obj = undef; untie %$cdb_hr; } if ( !$tie_obj ) { _logger()->warn("CDB_File could not get read-only association to '$cdb_file': $!"); } return $tie_obj; } sub create_cdb { my ( $cdb_file, $cdb_hr ) = @_; if ( !$cdb_file ) { _logger()->warn('Undefined CDB file specified for writable operation'); return; } return CDB_File::create( %{$cdb_hr}, $cdb_file, "$cdb_file.$$" ); } sub get_writable_tie { require Carp; Carp::confess("cdb files are not writable"); } sub init_lexicon { my ( $langtag, $hr, $version_sr, $encoding_sr ) = @_; my $cdb_file; my $db_root = Cpanel::Locale::Utils::Paths::get_locale_database_root(); for my $file ( $Cpanel::CPDATA{'RS'} ? ("themes/$Cpanel::CPDATA{RS}/$langtag.cdb") : (), "$langtag.cdb" ) { # PPI NO PARSE - Only include Cpanel() when some other module uses it if ( -e "$db_root/$file" ) { $cdb_file = "$db_root/$file"; last; } } if ( !$cdb_file ) { if ( -e Cpanel::Locale::Utils::Paths::get_locale_yaml_root() . "/$langtag.yaml" && !$Cpanel::Locale::Utils::i_am_the_compiler ) { _logger()->info(qq{Locale needs to be compiled by root (/usr/local/cpanel/bin/build_locale_databases --locale=$langtag)}); } return; } my $cdb_tie = get_readonly_tie( $cdb_file, $hr ); if ( exists $hr->{'__VERSION'} && ref $version_sr ) { ${$version_sr} = $hr->{'__VERSION'}; } if ( ref $encoding_sr ) { ${$encoding_sr} ||= 'utf-8'; } return $cdb_file; } sub init_package { my ($caller) = caller(); my ($langtag) = reverse( split( /::/, $caller ) ); no strict 'refs'; no warnings 'once'; ${ $caller . '::CDB_File_Path' } ||= init_lexicon( "$langtag", \%{ $caller . '::Lexicon' }, \${ $caller . '::VERSION' }, \${ $caller . '::Encoding' }, ); return; } 1; } # --- END Cpanel/Locale/Utils.pm { # --- BEGIN Cpanel/DB/Utils.pm package Cpanel::DB::Utils; use strict; sub username_to_dbowner { my ($username) = @_; $username =~ tr<_.><>d if defined $username; return $username; } 1; } # --- END Cpanel/DB/Utils.pm { # --- BEGIN Cpanel/AdminBin/Serializer.pm package Cpanel::AdminBin::Serializer; use strict; use warnings; # use Cpanel::JSON (); 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; 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/Config/Constants.pm package Cpanel::Config::Constants; use strict; use warnings; our $DEFAULT_CPANEL_THEME = 'jupiter'; our $DEFAULT_CPANEL_MAILONLY_THEME = 'jupiter'; our $DEFAULT_WEBMAIL_THEME = 'jupiter'; our $DEFAULT_WEBMAIL_MAILONLY_THEME = 'jupiter'; our @DORMANT_SERVICES_LIST = qw(cpanalyticsd cpdavd cphulkd cpsrvd dnsadmin spamd); our $MAX_HOMEDIR_STREAM_TIME = ( 86400 * 2 ); 1; } # --- END Cpanel/Config/Constants.pm { # --- BEGIN Cpanel/Imports.pm package Cpanel::Imports; use strict; $Cpanel::Imports::VERSION = '0.02'; sub import { my $caller = caller; no strict 'refs'; ## no critic(ProhibitNoStrict) *{ $caller . '::logger' } = \&__logger; *{ $caller . '::locale' } = \&__locale; return; } my ( $logger, $locale ); sub _reset_lazy_facade { # usually for testing $logger = undef; $locale = undef; return; } sub __logger { require Cpanel::Logger if !$INC{'Cpanel/Logger.pm'}; if ( !$logger ) { # return $var ||= XYZ->new; works but, we keep it super vanilla to make it more likley to perlcc OK $logger = Cpanel::Logger->new; } return $logger; } sub __locale { require Cpanel::Locale if !$INC{'Cpanel/Locale.pm'}; if ( !$locale ) { # return $var ||= XYZ->new; works but, we keep it super vanilla to make it more likley to perlcc OK $locale = Cpanel::Locale->get_handle; } return $locale; } 1; } # --- END Cpanel/Imports.pm { # --- BEGIN Cpanel/SSL/KeyTypeLabel.pm package Cpanel::SSL::KeyTypeLabel; use cPstrict; use Cpanel::Imports; my %_ECDSA_DETAIL = ( prime256v1 => 'P-256 (prime256v1)', secp384r1 => 'P-384 (secp384r1)', ); sub to_label ($the_type) { my ( $type, $detail ) = split m<->, $the_type; die _invalid_type_msg($the_type) if !defined $detail; $type =~ tr; if ( $type eq 'RSA' ) { $detail = locale()->maketext( '[numf,_1]-bit', $detail ); } elsif ( $type eq 'ECDSA' ) { $detail = $_ECDSA_DETAIL{$detail} or die _invalid_type_msg($the_type); } else { die "need update? ($the_type)"; } return "$type, $detail"; } sub _invalid_type_msg ($the_type) { return "Invalid key type: “$the_type”"; } 1; } # --- END Cpanel/SSL/KeyTypeLabel.pm { # --- BEGIN Cpanel/SSL/DefaultKey/Constants.pm package Cpanel::SSL::DefaultKey::Constants; use cPstrict; # use Cpanel::SSL::KeyTypeLabel (); use constant OPTIONS => ( 'rsa-2048', 'ecdsa-secp384r1', 'ecdsa-prime256v1', 'rsa-4096', ); sub OPTIONS_AND_LABELS() { local ( $@, $! ); require Cpanel::Locale; my $lh = Cpanel::Locale->get_handle(); return map { ( $_ => Cpanel::SSL::KeyTypeLabel::to_label($_) ) } OPTIONS; } sub KEY_DESCRIPTIONS() { require Cpanel::Locale; my $lh = Cpanel::Locale->get_handle(); return { "rsa-2048" => $lh->maketext("[asis,RSA] is more compatible with older clients (for example, browsers older than [asis,Internet Explorer] 11) than [asis,ECDSA]. New installations of [asis,cPanel amp() WHM] ship with this setting."), "rsa-4096" => $lh->maketext( "[asis,RSA] is more compatible with older clients (for example, browsers older than [asis,Internet Explorer] 11) than [asis,ECDSA]. This is more secure than [_1]-bit, but will perform slower than [_1]-bit keys.", 'RSA, 2,048' ), "ecdsa-prime256v1" => $lh->maketext("[asis,ECDSA] allows websites to support [asis,Internet Explorer] 11 and retain compliance with [output,acronym,PCI,Payment Card Industry] standards."), "ecdsa-secp384r1" => $lh->maketext("[asis,ECDSA] allows websites to support [asis,Internet Explorer] 11 and retain compliance with [output,acronym,PCI,Payment Card Industry] standards. [asis,secp384r1] is more secure than [asis,prime256v1], but may perform slower."), }; } use constant USER_SYSTEM => 'system'; 1; } # --- END Cpanel/SSL/DefaultKey/Constants.pm { # --- BEGIN Cpanel/Config/CpUser/Defaults.pm package Cpanel::Config::CpUser::Defaults; use strict; use warnings; # use Cpanel::SSL::DefaultKey::Constants (); our @DEFAULTS_KV = ( 'BWLIMIT' => 'unlimited', 'CHILD_WORKLOADS' => q<>, 'DEADDOMAINS' => undef, 'DEMO' => 0, 'DOMAIN' => '', 'DOMAINS' => undef, 'FEATURELIST' => 'default', 'HASCGI' => 0, 'HASDKIM' => 0, 'HASSPF' => 0, 'IP' => '127.0.0.1', 'MAILBOX_FORMAT' => 'maildir', #keep in sync with cpconf 'MAX_EMAILACCT_QUOTA' => 'unlimited', 'MAXADDON' => 0, 'MAXFTP' => 'unlimited', 'MAXLST' => 'unlimited', 'MAXPARK' => 0, 'MAXPOP' => 'unlimited', 'MAXSQL' => 'unlimited', 'MAXSUB' => 'unlimited', 'OWNER' => 'root', 'PLAN' => 'undefined', 'RS' => '', 'STARTDATE' => '0000000000', 'MAXPASSENGERAPPS' => 4, 'SSL_DEFAULT_KEY_TYPE' => Cpanel::SSL::DefaultKey::Constants::USER_SYSTEM, ); 1; } # --- END Cpanel/Config/CpUser/Defaults.pm { # --- BEGIN Cpanel/Hash/JSONable.pm package Cpanel::Hash::JSONable; use cPstrict; sub TO_JSON ($self) { return {%$self}; } 1; } # --- END Cpanel/Hash/JSONable.pm { # --- BEGIN Cpanel/Config/CpUser/Object.pm package Cpanel::Config::CpUser::Object; use cPstrict; # use Cpanel::Hash::JSONable(); our @ISA; BEGIN { push @ISA, qw(Cpanel::Hash::JSONable); } use Class::XSAccessor ( getters => { username => 'USER', }, ); sub adopt ( $class, $ref ) { return bless $ref, $class; } sub domains_ar ($self) { return [ $self->{'DOMAIN'}, @{ $self->{'DOMAINS'} } ]; } sub contact_emails_ar ($self) { return [ grep { length } @{$self}{ 'CONTACTEMAIL', 'CONTACTEMAIL2' } ]; } sub child_workloads ($self) { if (wantarray) { return if !$self->{'CHILD_WORKLOADS'}; return split( m<,>, $self->{'CHILD_WORKLOADS'}, -1 ); } return 0 if !$self->{'CHILD_WORKLOADS'}; return 1 + ( $self->{'CHILD_WORKLOADS'} =~ tr<,><> ); } 1; } # --- END Cpanel/Config/CpUser/Object.pm { # --- BEGIN Cpanel/SV.pm package Cpanel::SV; use strict; use warnings; 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/Path/Normalize.pm package Cpanel::Path::Normalize; use strict; use warnings; 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/Hash/Stringify.pm package Cpanel::Hash::Stringify; use strict; use warnings; 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/Umask.pm package Cpanel::Umask; use strict; # use Cpanel::Finally(); 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; # use Cpanel::Hash::Stringify (); # use Cpanel::Debug (); # use Cpanel::FileUtils::Write::JSON::Lazy (); # use Cpanel::AdminBin::Serializer::FailOK (); # use Cpanel::LoadFile::ReadFast (); # use Cpanel::HiRes (); # use Cpanel::SV (); 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 . $split_on . qq; } 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; # use Cpanel::HiRes (); # use Cpanel::Path::Normalize (); # use Cpanel::Debug (); # use Cpanel::JSON::FailOK (); 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/Conf.pm package Cpanel::Conf; # use Cpanel::Config::Constants (); my $cpanel_theme; my $webmail_theme; sub new { my ( $class, %opts ) = @_; my $self = {}; bless $self, $class; if ( exists $opts{'wwwacct'} && ref $opts{'wwwacct'} eq 'HASH' ) { $self->{'wwwacct'} = $opts{'wwwacct'}; } undef $cpanel_theme; undef $webmail_theme; return $self; } sub system_config_dir { my ($self) = @_; return '/etc'; } sub product_config_dir { my ($self) = @_; return '/var/cpanel'; } sub product_base_dir { my ($self) = @_; return '/usr/local/cpanel'; } sub whm_base_dir { my ($self) = @_; return $self->product_base_dir . '/whostmgr'; } sub cpanel_theme_dir { my ($self) = @_; return $self->product_base_dir . '/base/frontend'; } sub whm_theme_dir { my ($self) = @_; return $self->whm_base_dir . '/docroot/themes'; } sub whm_theme { my ($self) = @_; return 'x'; } sub account_creation_defaults { my ($self) = @_; if ( exists $self->{'wwwacct'} ) { my %wwwacct = %{ $self->{'wwwacct'} }; return \%wwwacct; } require Cpanel::Config::LoadWwwAcctConf; return Cpanel::Config::LoadWwwAcctConf::loadwwwacctconf(); } sub cpanel_theme { my ($self) = @_; return $cpanel_theme if defined $cpanel_theme; $cpanel_theme = $Cpanel::Config::Constants::DEFAULT_CPANEL_THEME; my $defaults = {}; $defaults = $self->account_creation_defaults(); if ( ref $defaults eq 'HASH' && $defaults->{'DEFMOD'} ) { $cpanel_theme = $defaults->{'DEFMOD'}; } return $cpanel_theme; } sub default_webmail_theme { my ($self) = @_; return $webmail_theme if defined $webmail_theme; $webmail_theme = $Cpanel::Config::Constants::DEFAULT_WEBMAIL_THEME; my $defaults = {}; $defaults = $self->account_creation_defaults(); if ( ref $defaults eq 'HASH' && $defaults->{'DEFMOD'} ) { $webmail_theme = $defaults->{'DEFMOD'}; } return $webmail_theme; } 1; } # --- END Cpanel/Conf.pm { # --- BEGIN Cpanel/Config/LoadCpUserFile.pm package Cpanel::Config::LoadCpUserFile; use strict; use warnings; use Try::Tiny; # use Cpanel::DB::Utils (); # use Cpanel::Exception (); # use Cpanel::FileUtils::Write::JSON::Lazy (); # use Cpanel::AdminBin::Serializer::FailOK (); # use Cpanel::Config::Constants (); # use Cpanel::Config::CpUser::Defaults (); # use Cpanel::Config::CpUser::Object (); # use Cpanel::ConfigFiles (); # use Cpanel::LoadFile::ReadFast (); # use Cpanel::SV (); our $VERSION = '0.82'; # DO NOT CHANGE THIS FROM A DECIMAL sub _cpuser_defaults { return @Cpanel::Config::CpUser::Defaults::DEFAULTS_KV; } my %should_never_be_on_disk = map { $_ => undef } qw( DBOWNER DOMAIN DOMAINS DEADDOMAINS HOMEDIRLINKS ); my $logger; sub load_or_die { return ( _load( $_[0], undef, if_missing => 'die' ) )[2]; } sub load_if_exists { return ( _load( $_[0], undef, if_missing => 'return' ) )[2] // undef; } sub load_file { my ($file) = @_; return parse_cpuser_file( _open_cpuser_file( '<', $file ) ); } sub _open_cpuser_file_locked { my ( $mode, $file ) = @_; local $!; my $cpuser_fh; require Cpanel::SafeFile; my $lock_obj = Cpanel::SafeFile::safeopen( $cpuser_fh, $mode, $file ) or do { die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $file, error => $!, mode => $mode ] ); }; return ( $lock_obj, $cpuser_fh ); } sub _open_cpuser_file { my ( $mode, $file ) = @_; local $!; my $cpuser_fh; open( $cpuser_fh, $mode, $file ) or do { die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $file, error => $!, mode => $mode ] ); }; return $cpuser_fh; } sub parse_cpuser_file { my ($cpuser_fh) = @_; my $buffer = ''; Cpanel::LoadFile::ReadFast::read_all_fast( $cpuser_fh, $buffer ); return parse_cpuser_file_buffer($buffer); } sub parse_cpuser_file_buffer { my ($buffer) = @_; my %cpuser = _cpuser_defaults(); my %DOMAIN_MAP; my %DEAD_DOMAIN_MAP; my %HOMEDIRLINKS_MAP; local ( $!, $_ ); foreach ( split( m{\n}, $buffer ) ) { next if index( $_, '#' ) > -1 && m/^\s*#/; my ( $key, $value ) = split( /\s*=/, $_, 2 ); if ( !defined $value || exists $should_never_be_on_disk{$key} ) { next; } elsif ( $key eq 'DNS' ) { $cpuser{'DOMAIN'} = lc $value; } elsif ( index( $key, 'DNS' ) == 0 && substr( $key, 3, 1 ) =~ tr{0-9}{} ) { $DOMAIN_MAP{ lc $value } = undef; } elsif ( index( $key, 'XDNS' ) == 0 && substr( $key, 4, 1 ) =~ tr{0-9}{} ) { $DEAD_DOMAIN_MAP{ lc $value } = undef; } elsif ( index( $key, 'HOMEDIRPATHS' ) == 0 && $key =~ m{ \A HOMEDIRPATHS \d* \z }xms ) { $HOMEDIRLINKS_MAP{$value} = undef; } else { $cpuser{$key} = $value; } } delete @DEAD_DOMAIN_MAP{ keys %DOMAIN_MAP }; delete $DOMAIN_MAP{ $cpuser{'DOMAIN'} }; if ($!) { die Cpanel::Exception::create( 'IO::FileReadError', [ error => $! ] ); } if ( exists $cpuser{'USER'} ) { $cpuser{'DBOWNER'} = Cpanel::DB::Utils::username_to_dbowner( $cpuser{'USER'} ); } if ( !length $cpuser{'RS'} ) { require Cpanel::Conf; my $cp_defaults = Cpanel::Conf->new(); $cpuser{'RS'} = $cp_defaults->cpanel_theme; } if ( !$cpuser{'LOCALE'} ) { $cpuser{'LOCALE'} = 'en'; $cpuser{'__LOCALE_MISSING'} = 1; } $cpuser{'DOMAINS'} = [ sort keys %DOMAIN_MAP ]; # Sorted here so they can be tested with TM::is_deeply $cpuser{'DEADDOMAINS'} = [ sort keys %DEAD_DOMAIN_MAP ]; # Sorted here so they can be tested with TM::is_deeply $cpuser{'HOMEDIRLINKS'} = [ sort keys %HOMEDIRLINKS_MAP ]; return _wrap_cpuser( \%cpuser ); } sub _wrap_cpuser { return Cpanel::Config::CpUser::Object->adopt(shift); } sub _logger { return $logger ||= do { require Cpanel::Logger; Cpanel::Logger->new(); }; } sub load { my ( $user, $opts ) = @_; my $cpuser = ( _load( $user, $opts ) )[2]; if ( !ref $cpuser ) { _logger()->warn( "Failed to load cPanel user file for '" . ( $user || '' ) . "'" ) unless $opts->{'quiet'}; return wantarray ? () : bless( {}, 'Cpanel::Config::CpUser::Object' ); } return wantarray ? %$cpuser : $cpuser; } sub _load_locked { my ($user) = @_; my ( $fh, $lock_fh, $cpuser ) = _load( $user, { lock => 1 } ); return unless $fh && $lock_fh && $cpuser; return { 'file' => $fh, 'lock' => $lock_fh, 'data' => $cpuser, }; } sub clear_cache { my ($user) = @_; return unlink "$Cpanel::ConfigFiles::cpanel_users.cache/$user"; } sub _load { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix my ( $user, $load_opts_ref, %internal_opts ) = @_; if ( !$user || $user =~ tr<> ) { #no eq '' needed as !$user covers this _logger()->warn("Invalid username (falsy or forbidden character) given to loadcpuserfile."); if ( $internal_opts{'if_missing'} ) { die Cpanel::Exception::create( 'UserNotFound', [ name => '' ] ); } return; } my ( $now, $has_serializer, $user_file, $user_cache_file ) = ( time(), #now ( exists $INC{'Cpanel/JSON.pm'} ? 1 : 0 ), #has_serializer $load_opts_ref->{'file'} || "$Cpanel::ConfigFiles::cpanel_users/$user", # user_file "$Cpanel::ConfigFiles::cpanel_users.cache/$user", # user_cache_file ); my ( $cpuid, $cpgid, $size, $mtime ) = ( stat($user_file) )[ 4, 5, 7, 9 ]; if ( not defined($size) and my $if_missing = $internal_opts{'if_missing'} ) { if ( $! == _ENOENT() ) { if ( $if_missing eq 'return' ) { return; } die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] ); } die Cpanel::Exception->create( 'The system failed to find the file “[_1]” because of an error: [_2]', [ $user_file, $! ] ); } $mtime ||= 0; my $lock_fh; my $cpuser_fh; if ( $load_opts_ref->{'lock'} ) { my $mode = $mtime ? '+<' : '+>'; try { ( $lock_fh, $cpuser_fh ) = _open_cpuser_file_locked( $mode, $user_file ); } catch { if ( my $if_missing = $internal_opts{'if_missing'} ) { die $_ if $if_missing ne 'return'; } else { _logger()->warn($_); } }; return if !$lock_fh; } elsif ( !$size ) { if ( $user eq 'cpanel' ) { my $result = _load_cpanel_user(); _wrap_cpuser($result); return ( $cpuser_fh, $lock_fh, $result ); } else { _logger()->warn("User file '$user_file' is empty or non-existent.") unless $load_opts_ref->{'quiet'}; return; } } if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded _logger()->debug("load cPanel user file [$user]"); } if ($has_serializer) { Cpanel::SV::untaint($user_cache_file); # case CPANEL-11199 if ( open( my $cache_fh, '<:stdio', $user_cache_file ) ) { #ok if the file is not there my $cache_mtime = ( stat($cache_fh) )[9]; # Check the mtime after we have opened the file to prevent a race condition if ( $cache_mtime >= $mtime && $cache_mtime <= $now ) { my $cpuser_ref = Cpanel::AdminBin::Serializer::FailOK::LoadFile($cache_fh); if ( $cpuser_ref && ref $cpuser_ref eq 'HASH' ) { if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded _logger()->debug("load cache hit user[$user] now[$now] mtime[$mtime] cache_mtime[$cache_mtime]"); } $cpuser_ref->{'MTIME'} = $mtime; if ( ( $cpuser_ref->{'__CACHE_DATA_VERSION'} // 0 ) == $VERSION ) { _wrap_cpuser($cpuser_ref); return ( $cpuser_fh, $lock_fh, $cpuser_ref ); } else { unlink $user_cache_file; # force a re-cache of the latest data set } } } else { if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded _logger()->debug("load cache miss user[$user] now[$now] mtime[$mtime] cache_mtime[$cache_mtime]"); } } close($cache_fh); } else { if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded _logger()->debug("load cache miss user[$user] now[$now] mtime[$mtime] cache_mtime[0]"); } } } if ( !$lock_fh ) { try { $cpuser_fh = _open_cpuser_file( '<', $user_file ); } catch { die $_ if $internal_opts{'if_missing'}; _logger()->warn($_); }; return if !$cpuser_fh; } my $cpuser_hr; try { $cpuser_hr = parse_cpuser_file($cpuser_fh); } catch { _logger()->warn("Failed to read “$user_file”: $_"); }; return if !$cpuser_hr; $cpuser_hr->{'USER'} = $user; $cpuser_hr->{'DBOWNER'} = Cpanel::DB::Utils::username_to_dbowner($user); $cpuser_hr->{'__CACHE_DATA_VERSION'} = $VERSION; # set this before the cache is written so that it will be included in the cache if ( $> == 0 ) { create_users_cache_dir(); if ( $has_serializer && Cpanel::FileUtils::Write::JSON::Lazy::write_file( $user_cache_file, $cpuser_hr, 0640 ) ) { chown 0, $cpgid, $user_cache_file if $cpgid; # this is ok if the chown happens after as we fall though to reading the non-cache on a failed open } else { unlink $user_cache_file; #outdated } } $cpuser_hr->{'MTIME'} = ( stat($cpuser_fh) )[9]; if ( $load_opts_ref->{'lock'} ) { seek( $cpuser_fh, 0, 0 ); } else { if ($lock_fh) { require Cpanel::SafeFile; Cpanel::SafeFile::safeclose( $cpuser_fh, $lock_fh ); } $cpuser_fh = $lock_fh = undef; } return ( $cpuser_fh, $lock_fh, $cpuser_hr ); } sub loadcpuserfile { return load( $_[0] ); } sub _load_cpanel_user { my %cpuser = ( _cpuser_defaults(), 'DEADDOMAINS' => [], 'DOMAIN' => 'domain.tld', 'DOMAINS' => [], 'HASCGI' => 1, 'HOMEDIRLINKS' => [], 'LOCALE' => 'en', 'MAXADDON' => 'unlimited', 'MAXPARK' => 'unlimited', 'RS' => $Cpanel::Config::Constants::DEFAULT_CPANEL_THEME, 'USER' => 'cpanel', ); return wantarray ? %cpuser : \%cpuser; } sub create_users_cache_dir { my $uc = "$Cpanel::ConfigFiles::cpanel_users.cache"; if ( -f $uc || -l $uc ) { my $bad = "$uc.bad"; unlink $bad if -e $bad; rename $uc, $bad; } if ( !-e $uc ) { mkdir $uc; } return; } sub _ENOENT { return 2; } 1; } # --- END Cpanel/Config/LoadCpUserFile.pm { # --- BEGIN Cpanel/Config/HasCpUserFile.pm package Cpanel::Config::HasCpUserFile; use strict; use warnings; # use Cpanel::ConfigFiles (); sub has_cpuser_file { return 0 if !length $_[0] || $_[0] =~ tr{/\0}{}; return -e "$Cpanel::ConfigFiles::cpanel_users/$_[0]" && -s _; } sub has_readable_cpuser_file { my ($user) = @_; return unless defined $user and $user ne '' and $user !~ tr/\/\0//; return -e "$Cpanel::ConfigFiles::cpanel_users/$user" && -s _ && -r _; } 1; } # --- END Cpanel/Config/HasCpUserFile.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 (); # use Cpanel::Socket::UNIX::Micro (); 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; 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; 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 (); 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; # use Cpanel::Debug (); # use Cpanel::JSON::FailOK (); # use Cpanel::FileUtils::Write::JSON::Lazy (); # use Cpanel::PwCache::Helpers (); # use Cpanel::PwCache::Cache (); # use Cpanel::LoadFile::ReadFast (); 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 (); # use Cpanel::NSCD::Check (); # use Cpanel::PwCache::Helpers (); # use Cpanel::PwCache::Cache (); # use Cpanel::PwCache::Find (); 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/Locale/Utils/User.pm package Cpanel::Locale::Utils::User; use strict; # use Cpanel::Config::LoadCpUserFile (); # use Cpanel::Config::HasCpUserFile (); # use Cpanel::PwCache (); # use Cpanel::LoadModule (); our $DATASTORE_MODULE = 'Cpanel::DataStore'; our $LOCALE_LEGACY_MODULE = 'Cpanel::Locale::Utils::Legacy'; my $inited_cpdata_user; my $userlocale = {}; my $logger; sub _logger { require Cpanel::Logger; return ( $logger ||= Cpanel::Logger->new() ); } sub init_cpdata_keys { my $user = shift || $Cpanel::user || $ENV{'REMOTE_USER'} || ( $> == 0 ? 'root' : ( Cpanel::PwCache::getpwuid($>) )[0] ); return if ( defined $inited_cpdata_user && $inited_cpdata_user eq $user ); if ( !$Cpanel::CPDATA{'LOCALE'} && $user ne 'root' ) { require Cpanel::Server::Utils; if ( Cpanel::Server::Utils::is_subprocess_of_cpsrvd() && ( $> && $user ne 'cpanel' && $user ne 'cpanellogin' && !-e "/var/cpanel/users/$user" ) ) { _logger()->panic("get_handle() called before initcp()"); } if ( $> == 0 || ( $> && $> == Cpanel::PwCache::getpwnam($user) ) ) { $Cpanel::CPDATA{'LOCALE'} = get_user_locale($user); } } return ( $inited_cpdata_user = $user ); } sub clear_user_cache { my ($user) = @_; return delete $userlocale->{$user}; } sub get_user_locale { my $user = ( shift || $Cpanel::user || $ENV{'REMOTE_USER'} || ( $> == 0 ? 'root' : ( Cpanel::PwCache::getpwuid($>) )[0] ) ); my $cpuser_ref = shift; # not required, just faster if it is passed if ( !$user ) { require Cpanel::Locale; return Cpanel::Locale::get_server_locale() || 'en'; } return $userlocale->{$user} if exists $userlocale->{$user} && !shift; if ( $Cpanel::user && $user eq $Cpanel::user && $Cpanel::CPDATA{'LOCALE'} ) { return ( $userlocale->{$user} = $Cpanel::CPDATA{'LOCALE'} ); } my $locale; if ( $user eq 'root' ) { my $root_conf_yaml = ( Cpanel::PwCache::getpwnam('root') )[7] . '/.cpanel_config'; if ( -e $root_conf_yaml ) { Cpanel::LoadModule::load_perl_module($DATASTORE_MODULE); my $hr = $DATASTORE_MODULE->can('fetch_ref')->($root_conf_yaml); $locale = $hr->{'locale'}; } } elsif ( $user eq 'cpanel' ) { require Cpanel::Locale; $locale = Cpanel::Locale::get_locale_for_user_cpanel(); } else { if ( $cpuser_ref || ( Cpanel::Config::HasCpUserFile::has_readable_cpuser_file($user) && ( $cpuser_ref = Cpanel::Config::LoadCpUserFile::loadcpuserfile($user) ) ) ) { if ( defined $cpuser_ref->{'LOCALE'} ) { $locale = $cpuser_ref->{'LOCALE'}; } elsif ( defined $cpuser_ref->{'LANG'} ) { Cpanel::LoadModule::load_perl_module($LOCALE_LEGACY_MODULE); $locale = $LOCALE_LEGACY_MODULE->can('map_any_old_style_to_new_style')->( $cpuser_ref->{'LANG'} ); } } } if ( !$locale ) { require Cpanel::Locale; return $userlocale->{$user} = Cpanel::Locale::get_server_locale() || 'en'; } $userlocale->{$user} = $locale; return $userlocale->{$user}; } 1; } # --- END Cpanel/Locale/Utils/User.pm { # --- BEGIN Cpanel/Cookies.pm package Cpanel::Cookies; $Cpanel::Cookies::VERSION = '0.1'; sub get_cookie_hashref_from_string { return {} if !defined $_[0]; return { map { map { s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg if -1 != index( $_, '%' ); $_; } split m<=>, $_, 2 } split( /; /, $_[0] ) }; } my $http_cookie_cached; sub get_cookie_hashref { if ( !defined $http_cookie_cached ) { $http_cookie_cached = get_cookie_hashref_from_string( $ENV{'HTTP_COOKIE'} ); } return $http_cookie_cached; } sub get_cookie_hashref_recache { $http_cookie_cached = get_cookie_hashref_from_string( $ENV{'HTTP_COOKIE'} ); return $http_cookie_cached; } 1; } # --- END Cpanel/Cookies.pm { # --- BEGIN Cpanel/SafeDir/Read.pm package Cpanel::SafeDir::Read; use strict; use warnings; sub read_dir { my ( $dir, $coderef ) = @_; my @contents; if ( opendir my $dir_dh, $dir ) { @contents = grep { $_ ne '.' && $_ ne '..' } readdir($dir_dh); if ($coderef) { @contents = grep { $coderef->($_) } @contents; } closedir $dir_dh; return wantarray ? @contents : \@contents; } return; } 1; } # --- END Cpanel/SafeDir/Read.pm { # --- BEGIN Cpanel/ArrayFunc/Uniq.pm package Cpanel::ArrayFunc::Uniq; use cPstrict; sub uniq (@list) { if ( $INC{'List/Util.pm'} ) { no warnings 'redefine'; *uniq = *List::Util::uniq; return List::Util::uniq(@list); } my %seen; return grep { !$seen{$_}++ } @list; } 1; } # --- END Cpanel/ArrayFunc/Uniq.pm { # --- BEGIN Cpanel/Locale/Utils/Charmap.pm package Cpanel::Locale::Utils::Charmap; use cPstrict; # use Cpanel::ArrayFunc::Uniq (); sub get_charmap_list ( $root_says_to_make_symlinks = 0, $no_aliases = 0 ) { ## no critic(Subroutines::ProhibitManyArgs) my $args = { 'iconv' => 0, 'unpreferred_aliases' => ( $no_aliases ? 0 : 1 ) }; if ($root_says_to_make_symlinks) { make_symlinks(); } return @{ get_charmaps($args) }; } sub get_charmaps ( $args = {} ) { _validate_args( $args, { map { $_ => 1 } qw( iconv unpreferred_aliases ) } ); my ( $iconv, $unpreferred_aliases ) = @{$args}{ 'iconv', 'unpreferred_aliases' }; $iconv //= 1; # Provide iconv compatibility by default. my %charset_aliases = _get_charset_aliases(); my %excluded_charmaps = _get_excluded_charmaps( $iconv, $unpreferred_aliases ); my @raw_charmaps = ( qw(utf-8 us-ascii), _get_filesystem_charmaps(), ( $unpreferred_aliases ? %charset_aliases : ( values %charset_aliases ) ) ); my %charmaps; for my $cm (@raw_charmaps) { $cm =~ tr{A-Z}{a-z}; my $copy = $cm; my $stripped = ( $copy =~ tr{_.-}{}d ); #prefer "utf-8" over "utf8" if ( !exists( $excluded_charmaps{$cm} ) && ( !exists( $charmaps{$copy} ) || $stripped ) ) { $charmaps{$copy} = $cm; } } return [ sort ( Cpanel::ArrayFunc::Uniq::uniq( values %charmaps ) ) ]; } sub make_symlinks { return unless $> == 0; my %charset_aliases = _get_charset_aliases(); my $charmapsdir = _get_charmaps_dir(); for my $loop ( 1 .. 2 ) { for my $key ( keys %charset_aliases ) { lstat("$charmapsdir/$key.gz"); # unpreferred if ( -e _ ) { lstat("$charmapsdir/$charset_aliases{$key}.gz"); # preferred if ( !-e _ && !-l _ ) { symlink( "$charmapsdir/$key.gz", "$charmapsdir/$charset_aliases{$key}.gz" ); # unpreferred -> preferred } } elsif ( !-l _ && -e "$charmapsdir/$charset_aliases{$key}.gz" ) { # preferred symlink( "$charmapsdir/$charset_aliases{$key}.gz", "$charmapsdir/$key.gz" ); # preferred -> unpreferred } } } return 1; } sub _validate_args ( $args, $possible_args ) { if ( my @bad_args = grep { !$possible_args->{$_} } keys %{$args} ) { require Cpanel::Exception; die Cpanel::Exception::create_raw( 'InvalidParameters', 'The following arguments are invalid: ' . join ', ', @bad_args ); } } sub _get_charmaps_dir { state $charmaps_dir = -e '/usr/local/share/i18n/charmaps' ? '/usr/local/share/i18n/charmaps' : '/usr/share/i18n/charmaps'; return $charmaps_dir; } sub _get_charset_aliases { return ( # unpreferred => preferred 'ASCII' => 'US-ASCII', 'BIG5-ETEN' => 'BIG5', 'CP1251' => 'WINDOWS-1251', 'CP1252' => 'WINDOWS-1252', 'CP936' => 'GBK', 'CP949' => 'KS_C_5601-1987', # Note: same preferred as KS_C_5601 'EUC-CN' => 'GB2312', 'KS_C_5601' => 'KS_C_5601-1987', # Note: same preferred as CP949 'SHIFTJIS' => 'SHIFT_JIS', 'SHIFTJISX0213' => 'SHIFT_JISX0213', 'UNICODE-1-1-UTF-7' => 'UTF-7', # RFC 1642 (obs.) 'UTF8' => 'UTF-8', 'UTF-8-STRICT' => 'UTF-8', # Perl internal use 'HZ' => 'HZ-GB-2312', # RFC 1842 'GSM0338' => 'GSM03.38', ); } sub _get_iconv_blacklist { return ( 'big5-eten', 'bs_viewdata', 'csa_z243.4-1985-gr', 'gsm03.38', 'gsm0338', 'hz', 'hz-gb-2312', 'invariant', 'iso_10646', 'iso_646.basic', 'iso_646.irv', 'iso_6937-2-25', 'iso_6937-2-add', 'iso_8859-1,gl', 'iso_8859-supp', 'jis_c6220-1969-jp', 'jis_c6229-1984-a', 'jis_c6229-1984-b-add', 'jis_c6229-1984-hand', 'jis_c6229-1984-hand-add', 'jis_c6229-1984-kana', 'jis_x0201', 'jus_i.b1.003-mac', 'jus_i.b1.003-serb', 'ks_c_5601', 'ks_c_5601-1987', 'nats-dano-add', 'nats-sefi-add', 'nextstep', 'sami', 'sami-ws2', 't.101-g2', 't.61-7bit', 'unicode-1-1-utf-7', 'utf-8-strict', 'videotex-suppl', ); } sub _get_filesystem_charmaps { state @filesystem_charmaps; return @filesystem_charmaps if @filesystem_charmaps; my $charmapsdir = _get_charmaps_dir(); if ( opendir my $charmaps_dh, $charmapsdir ) { @filesystem_charmaps = map { m{\A([^.].*)[.]gz\z}xms ? $1 : () } readdir $charmaps_dh; closedir $charmaps_dh; } return @filesystem_charmaps; } sub _get_excluded_charmaps ( $iconv, $unpreferred_aliases ) { my %excluded; if ($iconv) { for my $bl ( _get_iconv_blacklist() ) { $excluded{$bl} = 1; } } if ( !$unpreferred_aliases ) { my %charset_aliases = _get_charset_aliases; for my $alias ( keys %charset_aliases ) { $alias =~ tr{A-Z}{a-z}; $excluded{$alias} = 1; } } return %excluded; } 1; } # --- END Cpanel/Locale/Utils/Charmap.pm { # --- BEGIN Cpanel/StringFunc/Case.pm package Cpanel::StringFunc::Case; use strict; use warnings; our $VERSION = '1.2'; sub ToUpper { return unless defined $_[0]; ( local $_ = $_[0] ) =~ tr/a-z/A-Z/; # avoid altering $_[0] by making a copy return $_; } sub ToLower { return unless defined $_[0]; ( local $_ = $_[0] ) =~ tr/A-Z/a-z/; # avoid altering $_[0] by making a copy return $_; } 1; } # --- END Cpanel/StringFunc/Case.pm { # --- BEGIN Cpanel/Locale/Utils/Legacy.pm package Cpanel::Locale::Utils::Legacy; use strict; use warnings; # use Cpanel::Locale::Utils::Normalize (); # use Cpanel::Locale::Utils::Paths (); my %oldname_to_locale; my $loc; sub _load_oldnames { %oldname_to_locale = ( 'turkish' => 'tr', 'traditional-chinese' => 'zh', 'thai' => 'th', 'swedish' => 'sv', 'spanish-utf8' => 'es', 'spanish' => 'es', 'slovenian' => 'sl', 'simplified-chinese' => 'zh_cn', 'russian' => 'ru', 'romanian' => 'ro', 'portuguese-utf8' => 'pt', 'portuguese' => 'pt', 'polish' => 'pl', 'norwegian' => 'no', 'korean' => 'ko', 'japanese-shift_jis' => 'ja', # see Cpanel::Locale::Utils::MkDB::compile_single_legacy_from_legacy_system() 'japanese-euc-jp' => 'ja', # see Cpanel::Locale::Utils::MkDB::compile_single_legacy_from_legacy_system() 'japanese' => 'ja', # see Cpanel::Locale::Utils::MkDB::compile_single_legacy_from_legacy_system() 'spanish_latinamerica' => 'es_419', 'iberian_spanish' => 'es_es', 'italian' => 'it', 'indonesian' => 'id', 'hungarian' => 'hu', 'german-utf8' => 'de', 'german' => 'de', 'french-utf8' => 'fr', 'french' => 'fr', 'finnish' => 'fi', 'english-utf8' => 'en', 'english' => 'en', 'dutch-utf8' => 'nl', 'dutch' => 'nl', 'chinese' => 'zh', 'bulgarian' => 'bg', 'brazilian-portuguese-utf8' => 'pt_br', 'brazilian-portuguese' => 'pt_br', 'arabic' => 'ar', ); { no warnings 'redefine'; *_load_oldnames = sub { }; } return; } sub get_legacy_to_locale_map { _load_oldnames(); return \%oldname_to_locale; } sub get_legacy_list_from_locale { my ($locale) = @_; return if !$locale; $locale = 'en' if $locale eq 'en_us' || $locale eq 'i_default'; _load_oldnames(); return grep { $oldname_to_locale{$_} eq $locale ? 1 : 0 } keys %oldname_to_locale; } sub get_best_guess_of_legacy_from_locale { my ( $locale, $always_return_useable ) = @_; return if !$locale && !$always_return_useable; $locale = 'en' if $locale eq 'en_us' || $locale eq 'i_default'; _load_oldnames(); my @legacy_locale_matches = grep { $oldname_to_locale{$_} eq $locale ? 1 : 0 } keys %oldname_to_locale; return $legacy_locale_matches[0] if @legacy_locale_matches; return 'english' if $always_return_useable; return; } sub get_legacy_name_list { _load_oldnames(); return sort { $a =~ m/\.local$/ ? $a cmp $b : $b cmp $a } keys %oldname_to_locale; } sub get_existing_filesys_legacy_name_list { require Cpanel::SafeDir::Read; my %args = @_; my @extras; if ( exists $args{'also_look_in'} && ref $args{'also_look_in'} eq 'ARRAY' ) { for my $path ( @{ $args{'also_look_in'} } ) { my $copy = $path; $copy =~ s/\/lang$//; next if !-d "$copy/lang"; push @extras, Cpanel::SafeDir::Read::read_dir("$copy/lang"); } } my @local_less_names; my %has_local; my @names; my $legacy_dir = Cpanel::Locale::Utils::Paths::get_legacy_lang_root(); for my $name ( grep { $_ !~ m/^\./ } ( $args{'no_root'} ? () : Cpanel::SafeDir::Read::read_dir($legacy_dir) ), @extras ) { my $copy = $name; if ( $copy =~ s/\.local$// ) { $has_local{$copy}++; } else { push @local_less_names, $copy; } } for my $name_localless ( sort { $b cmp $a } @local_less_names ) { push @names, exists $has_local{$name_localless} ? ( "$name_localless.local", $name_localless ) : $name_localless; } return @names; } sub get_legacy_root_in_locale_database_root { return Cpanel::Locale::Utils::Paths::get_locale_database_root() . '/legacy'; } sub get_legacy_file_cache_path { my ($legacy_file) = @_; $legacy_file .= 'cache'; my $legacy_dir = Cpanel::Locale::Utils::Paths::get_legacy_lang_root(); $legacy_file =~ s{$legacy_dir}{/var/cpanel/lang.cache}; return $legacy_file; } sub map_any_old_style_to_new_style { return wantarray ? map { get_new_langtag_of_old_style_langname($_) || $_ } @_ : get_new_langtag_of_old_style_langname( $_[0] ) || $_[0]; } my %charset_lookup; sub _determine_via_disassemble { my ( $lcl, $oldlang ) = @_; my ( $language, $territory, $encoding, $probable_ext ); my @parts = split( /[^A-Za-z0-9]+/, $oldlang ); # We can't use Cpanel::CPAN::Locales::normalize_tag since it breaks things into 8 character chunks return if @parts == 1; # we've already tried just $parts[0] if the split is only 1 item return if @parts > 4; # if there are more than 4 parts then there is unresolveable data if ( !ref($lcl) ) { $lcl = Cpanel::CPAN::Locales->new($lcl) or return; } for my $part (@parts) { my $found_part = 0; if ( $lcl->get_code_from_language($part) || $lcl->get_language_from_code($part) ) { if ($language) { if ( !$lcl->get_territory_from_code($part) ) { return; } } else { $found_part++; $language = $lcl->get_language_from_code($part) ? $part : $lcl->get_code_from_language($part); } } if ( !$found_part && ( $lcl->get_code_from_territory($part) || $lcl->get_territory_from_code($part) ) ) { if ($territory) { return; } else { $found_part++; $territory = $lcl->get_territory_from_code($part) ? $part : $lcl->get_code_from_territory($part); } } if ( !$found_part ) { if ( $part eq $parts[$#parts] ) { # && length($part) < $max_len_for_ext $probable_ext = $part; } else { if ( !%charset_lookup ) { require Cpanel::Locale::Utils::Charmap; @charset_lookup{ map { Cpanel::Locale::Utils::Normalize::normalize_tag($_) } Cpanel::Locale::Utils::Charmap::get_charmap_list() } = (); } if ( $charset_lookup{$part} ) { $found_part++; $encoding = $part; } else { return; } } } } if ($encoding) { } if ($probable_ext) { } if ($language) { if ($territory) { return "$language\_$territory"; } else { return $language; } } return; } sub real_get_new_langtag_of_old_style_langname { my ($oldlang) = @_; $oldlang = Cpanel::StringFunc::Case::ToLower($oldlang) || ""; # case 34321 item #3 $oldlang =~ s/\.legacy_duplicate\..+$//; # This '.legacy_duplicate. naming hack' is for copying legacy file into a name that maps back to it's new target locale if ( !defined $oldlang || $oldlang eq '' || $oldlang =~ m/^\s+$/ ) { return; # return a value ?, what is safe ... } elsif ( Cpanel::Locale::Utils::Normalize::normalize_tag($oldlang) eq 'default' ) { return; # return 'en' ? could be an incorrect assumption ... } elsif ( exists $oldname_to_locale{$oldlang} ) { return $oldname_to_locale{$oldlang}; } { local $@; $loc ||= Cpanel::CPAN::Locales->new('en') or die $@; } my $return; if ( $loc->get_language_from_code($oldlang) ) { $return = Cpanel::Locale::Utils::Normalize::normalize_tag($oldlang); # case 34321 item #4 } else { my $locale = $loc->get_code_from_language($oldlang); if ($locale) { $return = $locale; # case 34321 item #2 } else { $return = _determine_via_disassemble( $loc, $oldlang ); if ( !$return ) { local $SIG{'__DIE__'}; # may be made moot by case 50857 for my $nen ( grep { $_ ne 'en' } sort( $loc->get_language_codes() ) ) { my $loca = Cpanel::CPAN::Locales->new($nen) or next; # singleton my $locale = $loca->get_code_from_language($oldlang); if ($locale) { $return = $locale; # case 34321 item #2 last; } else { $return = _determine_via_disassemble( $loca, $oldlang ); last if $return; } } } } } if ( !$return ) { $return = Cpanel::CPAN::Locales::get_i_tag_for_string($oldlang); } return $return; } sub get_new_langtag_of_old_style_langname { _load_oldnames(); require Cpanel::StringFunc::Case; require Cpanel::CPAN::Locales; $loc = Cpanel::CPAN::Locales->new('en'); { no warnings 'redefine'; *get_new_langtag_of_old_style_langname = \&real_get_new_langtag_of_old_style_langname; } goto &real_get_new_langtag_of_old_style_langname; } my $legacy_lookup; sub phrase_is_legacy_key { my ($key) = @_; if ( !$legacy_lookup ) { require 'Cpanel/Locale/Utils/MkDB.pm'; ## no critic qw(Bareword) - hide from perlpkg $legacy_lookup = { %{ Cpanel::Locale::Utils::MkDB::get_hash_of_legacy_file( Cpanel::Locale::Utils::Paths::get_legacy_lang_root() . '/english-utf8' ) || {} }, %{ Cpanel::Locale::Utils::MkDB::get_hash_of_legacy_file('/usr/local/cpanel/base/frontend/jupiter/lang/english-utf8') || {} }, }; } return exists $legacy_lookup->{$key} ? 1 : 0; } sub fetch_legacy_lookup { return $legacy_lookup if $legacy_lookup; phrase_is_legacy_key(''); # ensure $legacy_lookup is loaded return $legacy_lookup; } sub get_legacy_key_english_value { my ($key) = @_; if ( phrase_is_legacy_key($key) ) { # inits $legacy_lookup cache return $legacy_lookup->{$key}; } return; } 1; } # --- END Cpanel/Locale/Utils/Legacy.pm { # --- BEGIN Cpanel/Config/LoadCpUserFile/CurrentUser.pm package Cpanel::Config::LoadCpUserFile::CurrentUser; use strict; use warnings; # use Cpanel::Config::LoadCpUserFile (); my $_cpuser_ref_singleton; my $_cpuser_user; sub load { my ($user) = @_; if ( $_cpuser_user && $_cpuser_user eq $user ) { return $_cpuser_ref_singleton; } $_cpuser_user = $user; return ( $_cpuser_ref_singleton = Cpanel::Config::LoadCpUserFile::load($user) ); } sub _reset { $_cpuser_ref_singleton = undef; $_cpuser_user = undef; return; } 1; } # --- END Cpanel/Config/LoadCpUserFile/CurrentUser.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/PwUtils.pm package Cpanel::PwUtils; use strict; use warnings; # use Cpanel::Exception (); # use Cpanel::PwCache (); sub normalize_to_uid { my ($user) = @_; if ( !length $user ) { die Cpanel::Exception::create( 'MissingParameter', 'Supply a username or a user ID.' ); } return $user if $user !~ tr{0-9}{}c; # Only has numbers so its a uid my $uid = Cpanel::PwCache::getpwnam_noshadow($user); if ( !defined $uid ) { die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] ); } return $uid; } 1; } # --- END Cpanel/PwUtils.pm { # --- BEGIN Cpanel/AccessIds/Normalize.pm package Cpanel::AccessIds::Normalize; use strict; use warnings; # use Cpanel::ArrayFunc::Uniq (); # use Cpanel::PwCache (); # use Cpanel::PwUtils (); # use Cpanel::Exception (); sub normalize_user_and_groups { my ( $user, @groups ) = @_; if ( ( scalar @groups == 1 && !defined $groups[0] ) || ( scalar @groups > 1 && scalar( grep { !defined } @groups ) ) ) { require Cpanel::Carp; # no load module for memory die Cpanel::Carp::safe_longmess("Undefined group passed to normalize_user_and_groups"); } my $uid; if ( defined $user && $user !~ tr{0-9}{}c ) { if ( scalar @groups == 1 && $groups[0] !~ tr{0-9}{}c ) { # we already have a gid return ( $user, $groups[0] ); } $uid = $user; if ( scalar @groups == 1 && $groups[0] !~ tr{0-9}{}c ) { # we already have a gid return ( $uid, $groups[0] ); } } elsif ( !scalar @groups ) { ( $uid, @groups ) = ( Cpanel::PwCache::getpwnam_noshadow($user) )[ 2, 3 ]; if ( !defined $uid ) { die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] ); } return ( $uid, @groups ); } else { $uid = Cpanel::PwUtils::normalize_to_uid($user); } my @gids = @groups ? ( map { !tr{0-9}{}c ? $_ : scalar( ( getgrnam $_ )[2] ) } @groups ) : ( ( Cpanel::PwCache::getpwuid_noshadow($uid) )[3] ); if ( scalar @gids > 2 ) { return ( $uid, Cpanel::ArrayFunc::Uniq::uniq(@gids) ); } elsif ( scalar @gids == 2 && $gids[0] eq $gids[1] ) { return ( $uid, $gids[0] ); } return ( $uid, @gids ); } sub normalize_code_user_groups { my @args = @_; my $code_index; for my $i ( 0 .. $#args ) { if ( ref $args[$i] eq 'CODE' ) { $code_index = $i; last; } } die "No coderef found!" if !defined $code_index; my $code = splice( @args, $code_index, 1 ); return ( $code, normalize_user_and_groups( grep { defined } @args ) ); } 1; } # --- END Cpanel/AccessIds/Normalize.pm { # --- BEGIN Cpanel/AccessIds/Utils.pm package Cpanel::AccessIds::Utils; use strict; use warnings; # use Cpanel::ArrayFunc::Uniq (); # use Cpanel::Debug (); sub normalize_user_and_groups { require Cpanel::AccessIds::Normalize; goto \&Cpanel::AccessIds::Normalize::normalize_user_and_groups; } sub normalize_code_user_groups { require Cpanel::AccessIds::Normalize; goto \&Cpanel::AccessIds::Normalize::normalize_code_user_groups; } sub set_egid { my @gids = @_; if ( !@gids ) { Cpanel::Debug::log_die("No arguments passed to set_egid()!"); } if ( scalar @gids > 1 ) { @gids = Cpanel::ArrayFunc::Uniq::uniq(@gids); } _check_positive_int($_) for @gids; my $new_egid = join( q{ }, $gids[0], @gids ); return _set_var( \$), 'EGID', $new_egid ); } sub set_rgid { my ( $gid, @extra_gids ) = @_; if (@extra_gids) { Cpanel::Debug::log_die("RGID can only be set to a single value! (Do you want set_egid()?)"); } _check_positive_int($gid); return _set_var( \$(, 'RGID', $gid ); } sub set_euid { my ($uid) = @_; _check_positive_int($uid); return _set_var( \$>, 'EUID', $uid ); } sub set_ruid { my ($uid) = @_; _check_positive_int($uid); return _set_var( \$<, 'RUID', $uid ); } sub _check_positive_int { if ( !length $_[0] || $_[0] =~ tr{0-9}{}c ) { Cpanel::Debug::log_die("“$_[0] is not a positive integer!"); } return 1; } sub _set_var { my ( $var_r, $name, $desired_value ) = @_; my $old_value = $$var_r; $$var_r = $desired_value; return $desired_value eq $$var_r ? 1 : validate_var_set( $name, # The name of the value like 'RUID' $desired_value, # The value we wanted it to be set to $$var_r, # Deferenced variable being set, ex $< $old_value # The value before we set it. ); } sub validate_var_set { my ( $name, $desired_value, $new_value, $old_value ) = @_; my $error; if ( $new_value =~ tr/ // ) { my ( $desired_first, @desired_parts ) = split( ' ', $desired_value ); my ( $new_first, @new_parts ) = split( ' ', $new_value ); if ( $new_first != $desired_first ) { $error = 1; } elsif ( @desired_parts && @new_parts ) { if ( scalar @desired_parts == 1 && scalar @new_parts == 1 ) { if ( $new_parts[0] != $desired_parts[0] ) { $error = 1; } } else { @desired_parts = sort { $a <=> $b } Cpanel::ArrayFunc::Uniq::uniq(@desired_parts); @new_parts = sort { $a <=> $b } Cpanel::ArrayFunc::Uniq::uniq(@new_parts); for my $i ( 0 .. $#desired_parts ) { if ( $new_parts[$i] != $desired_parts[$i] ) { $error = 1; last; } } } } } else { if ( $new_value != $desired_value ) { $error = 1; } } return 1 if !$error; if ( defined $old_value ) { Cpanel::Debug::log_die("Failed to change $name from “$old_value” to “$desired_value”: $!"); } Cpanel::Debug::log_die("Failed to change $name to “$desired_value”: $!"); return 0; #not reached } 1; } # --- END Cpanel/AccessIds/Utils.pm { # --- BEGIN Cpanel/AccessIds/ReducedPrivileges.pm package Cpanel::AccessIds::ReducedPrivileges; use strict; use warnings; # use Cpanel::Debug (); # use Cpanel::AccessIds::Utils (); # use Cpanel::AccessIds::Normalize (); our $PRIVS_REDUCED = 0; sub new { ## no critic qw(Subroutines::RequireArgUnpacking) my $class = shift; if ( $class ne __PACKAGE__ ) { Cpanel::Debug::log_die("Attempting to drop privileges as '$class'."); } my ( $uid, @gids ) = Cpanel::AccessIds::Normalize::normalize_user_and_groups(@_); _allowed_to_reduce_privileges(); _prevent_dropping_to_root( $uid, @gids ); my $self = { 'uid' => $>, 'gid' => $), 'new_uid' => $uid, 'new_gid' => join( q< >, @gids ), }; _reduce_privileges( $uid, @gids ); $PRIVS_REDUCED = 1; return bless $self; } sub DESTROY { my ($self) = @_; _allowed_to_restore_privileges( $self->{'new_uid'}, $self->{'new_gid'} ); return _restore_privileges( $self->{'uid'}, $self->{'gid'} ); } sub call_as_user { ## no critic qw(Subroutines::RequireArgUnpacking) my ( $code, $uid, $gid, @supplemental_gids ) = Cpanel::AccessIds::Normalize::normalize_code_user_groups(@_); _prevent_dropping_to_root( $uid, $gid ); if ( !$code ) { Cpanel::Debug::log_die("No code reference supplied."); } _allowed_to_reduce_privileges(); my ( $saved_uid, $saved_gid ) = ( $>, $) ); _reduce_privileges( $uid, $gid, @supplemental_gids ); local $PRIVS_REDUCED = 1; my ( $scalar, @list ); if (wantarray) { #list context @list = eval { $code->(); }; } elsif ( defined wantarray ) { #scalar context $scalar = eval { $code->(); }; } else { #void context eval { $code->(); }; } my $ex = $@; _restore_privileges( $saved_uid, $saved_gid ); die $ex if $ex; return wantarray ? @list : $scalar; } sub _allowed_to_reduce_privileges { if ( $< != 0 ) { Cpanel::Debug::log_die("Attempting to drop privileges as a normal user with RUID $<"); } if ( $> != 0 ) { Cpanel::Debug::log_die("Attempting to drop privileges as a normal user with EUID $>"); } return 1; } sub _reduce_privileges { my ( $uid, $gid, @supplemental_gids ) = @_; Cpanel::AccessIds::Utils::set_egid( $gid, @supplemental_gids ); Cpanel::AccessIds::Utils::set_euid($uid); return 1; } sub _prevent_dropping_to_root { if ( grep { !$_ } @_ ) { Cpanel::Debug::log_die("Attempting to drop privileges to root."); } return 1; } sub _allowed_to_restore_privileges { my ( $uid, $gid ) = @_; if ( $< != 0 ) { Cpanel::Debug::log_die("Attempting to restore privileges as a normal user with RUID $<"); } if ( $> != $uid ) { Cpanel::Debug::log_warn("EUID ($>) does not match expected reduced user ($uid)"); } my ( $first_egid, $first_given_gid ) = ( $), $gid ); $_ = ( split m{ } )[0] for ( $first_egid, $first_given_gid ); if ( int $first_egid != int $first_given_gid ) { Cpanel::Debug::log_warn("EGID ($)) does not match expected reduced user ($gid)"); } } sub _restore_privileges { my ( $saved_uid, $saved_gid ) = @_; Cpanel::AccessIds::Utils::set_euid($saved_uid); Cpanel::AccessIds::Utils::set_egid( split m{ }, $saved_gid ); $PRIVS_REDUCED = 0; return 1; } 1; } # --- END Cpanel/AccessIds/ReducedPrivileges.pm { # --- BEGIN Cpanel/DataStore.pm package Cpanel::DataStore; use strict; use warnings; # use Cpanel::Debug (); sub store_ref { my ( $file, $outof_ref, $perm ) = @_; require Cpanel::YAML::Syck; $YAML::Syck::ImplicitTyping = 0; local $YAML::Syck::SingleQuote; local $YAML::Syck::SortKeys; $YAML::Syck::SingleQuote = 1; $YAML::Syck::SortKeys = 1; if ( ref($file) ) { my $yaml_string = YAML::Syck::Dump($outof_ref); print( {$file} _format($yaml_string) ) || return; return $file; } if ( ref($perm) eq 'ARRAY' && !-l $file && !-e $file ) { require Cpanel::FileUtils::TouchFile; # or use() ? my $touch_chmod = sub { if ( !Cpanel::FileUtils::TouchFile::touchfile($file) ) { Cpanel::Debug::log_info("Could not touch \xE2\x80\x9C$file\xE2\x80\x9D: $!"); return; } if ( $perm->[0] ) { if ( !chmod( oct( $perm->[0] ), $file ) ) { Cpanel::Debug::log_info("Could not chmod \xE2\x80\x9C$file\xE2\x80\x9D to \xE2\x80\x9C$perm->[0]\xE2\x80\x9D: $!"); return; } } return 1; }; if ( $> == 0 && $perm->[1] && $perm->[1] ne 'root' ) { require Cpanel::AccessIds::ReducedPrivileges; # or use() ? Cpanel::AccessIds::ReducedPrivileges::call_as_user( $perm->[1], $touch_chmod ) || return; } else { $touch_chmod->() || return; } } if ( open my $yaml_out, '>', $file ) { my $yaml_string = YAML::Syck::Dump($outof_ref); print {$yaml_out} _format($yaml_string); close $yaml_out; return 1; } else { Cpanel::Debug::log_warn("Could not open file '$file' for writing: $!"); return; } } sub fetch_ref { my ( $file, $is_array ) = @_; my $fetch_ref = load_ref($file); my $data_type = ref $fetch_ref; my $data = $data_type ? $fetch_ref : undef; $data_type ||= 'UNDEF'; if ( $is_array && $data_type ne 'ARRAY' ) { return []; } elsif ( !$is_array && $data_type ne 'HASH' ) { return {}; } return $data; } sub load_ref { my ( $file, $into_ref ) = @_; return if ( !-e $file || -z _ ); require Cpanel::YAML::Syck; $YAML::Syck::ImplicitTyping = 0; my $struct; if ( ref($file) ) { local $!; $struct = eval { local $/; local $SIG{__WARN__}; local $SIG{__DIE__}; ( YAML::Syck::Load(<$file>) )[0]; }; Cpanel::Debug::log_warn("Error loading YAML data: $!") if ( !$struct ); } elsif ( open my $yaml_in, '<', $file ) { local $!; $struct = eval { local $/; local $SIG{__WARN__}; local $SIG{__DIE__}; ( YAML::Syck::Load(<$yaml_in>) )[0]; }; Cpanel::Debug::log_warn("Error loading YAML data: $!") if ( !$struct ); close $yaml_in; } else { my $err = $!; Cpanel::Debug::log_warn("Could not open file '$file' for reading: $err"); return; } if ( !$struct ) { Cpanel::Debug::log_warn("Failed to load YAML data from file $file"); return; } if ( defined $into_ref ) { my $type = ref $into_ref; my $yaml_type = ref $struct; if ( $yaml_type ne $type ) { Cpanel::Debug::log_warn("Invalid data type from file $file! YAML type $yaml_type does not match expected type $type. Data ignored!"); return; # if we want an empty ref on failure use fetch_ref() } if ( $yaml_type eq 'HASH' ) { %{$into_ref} = %{$struct}; } elsif ( $yaml_type eq 'ARRAY' ) { @{$into_ref} = @{$struct}; } else { Cpanel::Debug::log_warn("YAML in '$file' is not a hash or array reference"); return; # if we want an empty ref on failure use fetch_ref() } return $into_ref; } return $struct; } sub edit_datastore { my ( $file, $editor_cr, $is_array ) = @_; if ( ref $editor_cr ne 'CODE' ) { Cpanel::Debug::log_warn('second arg needs to be a coderef'); return; } my $ref = $is_array ? [] : {}; if ( !-e $file ) { Cpanel::Debug::log_info("Data store file $file does not exist. Attempting to create empty datastore."); store_ref( $file, $ref ); } if ( load_ref( $file, $ref ) ) { if ( $editor_cr->($ref) ) { if ( !store_ref( $file, $ref ) ) { Cpanel::Debug::log_warn("Modifications to file $file could not be saved"); return; } } } else { Cpanel::Debug::log_warn("Could not load datastore $file"); return; } return 1; } sub _format { my ($s) = @_; $s =~ s/[ \t]+$//mg; return __grapheme_to_character($s); } sub __grapheme_to_character { my ($yaml_string) = @_; $yaml_string = quotemeta($yaml_string); $yaml_string =~ s/\\{2}x/\\x/g; $yaml_string = eval qq{"$yaml_string"}; return $yaml_string; } 1; } # --- END Cpanel/DataStore.pm { # --- BEGIN Cpanel/StringFunc/Trim.pm package Cpanel::StringFunc::Trim; use strict; use warnings; $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/Locale/Utils/3rdparty.pm package Cpanel::Locale::Utils::3rdparty; use strict; use warnings; our %cpanel_provided = ( 'de' => 1, 'en' => 1, 'es_es' => 1, 'i_cpanel_snowmen' => 1, 'ru' => 1, 'ja' => 1, ); my %locale_to_3rdparty; sub _load_3rdparty { return if (%locale_to_3rdparty); %locale_to_3rdparty = ( 'ar' => { 'analog' => 'us', 'awstats' => 'ar', 'webalizer' => 'english' }, 'bg' => { 'analog' => 'bg', 'awstats' => 'bg', 'webalizer' => 'english' }, 'bn' => { 'analog' => 'us', 'awstats' => 'en', 'webalizer' => 'english' }, 'de' => { 'analog' => 'de', 'awstats' => 'de', 'webalizer' => 'german' }, 'en' => { 'analog' => 'us', 'awstats' => 'en', 'webalizer' => 'english' }, 'es' => { 'analog' => 'es', 'awstats' => 'es', 'webalizer' => 'spanish' }, 'es_es' => { 'analog' => 'es', 'awstats' => 'es', 'webalizer' => 'spanish' }, 'fi' => { 'analog' => 'fi', 'awstats' => 'fi', 'webalizer' => 'finnish' }, 'fr' => { 'analog' => 'fr', 'awstats' => 'fr', 'webalizer' => 'french' }, 'hi' => { 'analog' => 'us', 'awstats' => 'en', 'webalizer' => 'english' }, 'hu' => { 'analog' => 'hu', 'awstats' => 'hu', 'webalizer' => 'hungarian' }, 'id' => { 'analog' => 'us', 'awstats' => 'id', 'webalizer' => 'indonesian' }, 'it' => { 'analog' => 'it', 'awstats' => 'it', 'webalizer' => 'italian' }, 'ja' => { 'analog' => 'jpu', # appears to be the UTF-8 one 'awstats' => 'jp', 'webalizer' => 'japanese' }, 'ko' => { 'analog' => 'us', 'awstats' => 'ko', 'webalizer' => 'korean' }, 'nl' => { 'analog' => 'nl', 'awstats' => 'nl', 'webalizer' => 'dutch' }, 'no' => { 'analog' => 'no', 'awstats' => 'en', 'webalizer' => 'norwegian' }, 'pl' => { 'analog' => 'pl', 'awstats' => 'pl', 'webalizer' => 'polish' }, 'pt' => { 'analog' => 'pt', 'awstats' => 'pt', 'webalizer' => 'portuguese' }, 'pt_br' => { 'analog' => 'pt', 'awstats' => 'pt', 'webalizer' => 'portuguese_brazil' }, 'ro' => { 'analog' => 'ro', 'awstats' => 'ro', 'webalizer' => 'romanian' }, 'ru' => { 'analog' => 'ru', 'awstats' => 'ru', 'webalizer' => 'russian' }, 'sl' => { 'analog' => 'us', 'awstats' => 'en', 'webalizer' => 'slovene' }, 'sv' => { 'analog' => 'us', 'awstats' => 'en', 'webalizer' => 'swedish' }, 'th' => { 'analog' => 'us', 'awstats' => 'th', 'webalizer' => 'english' }, 'tr' => { 'analog' => 'tr', 'awstats' => 'tr', 'webalizer' => 'turkish' }, 'zh' => { 'analog' => 'cn', # the cn.lng does not say what it is so this is an assumption based on other pervasive bad practices 'awstats' => 'cn', 'webalizer' => 'chinese' }, 'zh_cn' => { 'analog' => 'cn', # the cn.lng does not say what it is so this is an assumption based on other pervasive bad practices 'awstats' => 'cn', 'webalizer' => 'simplified_chinese' }, ); } sub get_known_3rdparty_lang { my ( $locale, $_3rdparty ) = @_; _load_3rdparty(); my $locale_tag = ref $locale ? $locale->get_language_tag() : $locale; $locale_tag = 'en' if $locale_tag eq 'en_us' || $locale_tag eq 'i_default'; return if !exists $locale_to_3rdparty{$locale_tag}; return if !exists $locale_to_3rdparty{$locale_tag}{$_3rdparty}; return $locale_to_3rdparty{$locale_tag}{$_3rdparty}; } my %locale_lookup_cache; sub get_3rdparty_lang { my ( $locale, $_3rdparty ) = @_; my $known = get_known_3rdparty_lang( $locale, $_3rdparty ); return $known if $known; return if !ref($locale) && $locale =~ m/(?:\.\.|\/)/; return if $_3rdparty =~ m/(?:\.\.|\/)/; my $locale_tag = ref $locale ? $locale->get_language_tag() : $locale; $locale_tag = 'en' if $locale_tag eq 'en_us' || $locale_tag eq 'i_default'; if ( exists $locale_lookup_cache{$_3rdparty} ) { return $locale_lookup_cache{$_3rdparty}{$locale_tag} if exists $locale_lookup_cache{$_3rdparty}{$locale_tag}; return; } require Cpanel::DataStore; my $hr = Cpanel::DataStore::fetch_ref("/var/cpanel/locale/3rdparty/apps/$_3rdparty.yaml"); my %seen; %{ $locale_lookup_cache{$_3rdparty} } = map { ++$seen{ $hr->{$_} } == 1 ? ( $hr->{$_} => $_ ) : () } keys %{$hr}; return $locale_lookup_cache{$_3rdparty}{$locale_tag} if exists $locale_lookup_cache{$_3rdparty}{$locale_tag}; return; } my @list; sub get_3rdparty_list { return @list if @list; @list = qw(analog awstats webalizer); if ( -d "/var/cpanel/locale/3rdparty/apps" ) { require Cpanel::SafeDir::Read; push @list, sort map { my $f = $_; $f =~ s/\.yaml$// ? ($f) : () } Cpanel::SafeDir::Read::read_dir("/var/cpanel/locale/3rdparty/apps"); } return @list; } my %opt_cache; sub get_app_options { my ($_3rdparty) = @_; return if $_3rdparty =~ m/(?:\.\.|\/)/; return $opt_cache{$_3rdparty} if exists $opt_cache{$_3rdparty}; if ( $_3rdparty eq 'analog' || $_3rdparty eq 'awstats' || $_3rdparty eq 'webalizer' ) { _load_3rdparty(); my %seen; $opt_cache{$_3rdparty} = [ sort map { ++$seen{ $locale_to_3rdparty{$_}{$_3rdparty} } == 1 ? ( $locale_to_3rdparty{$_}{$_3rdparty} ) : () } keys %locale_to_3rdparty ]; } else { require Cpanel::DataStore; my $hr = Cpanel::DataStore::fetch_ref("/var/cpanel/locale/3rdparty/apps/$_3rdparty.yaml"); $opt_cache{$_3rdparty} = [ sort keys %{$hr} ]; } return $opt_cache{$_3rdparty}; } sub get_app_setting { my ( $locale, $_3rdparty ) = @_; return if !ref($locale) && $locale =~ m/(?:\.\.|\/)/; return if $_3rdparty =~ m/(?:\.\.|\/)/; require Cpanel::LoadFile; require Cpanel::StringFunc::Trim; my $locale_tag = ref $locale ? $locale->get_language_tag() : $locale; $locale_tag = 'en' if $locale_tag eq 'en_us' || $locale_tag eq 'i_default'; my $setting = Cpanel::StringFunc::Trim::ws_trim( Cpanel::LoadFile::loadfile("/var/cpanel/locale/3rdparty/conf/$locale_tag/$_3rdparty") ) || ''; if ( $_3rdparty eq 'analog' && $setting eq 'en' ) { $setting = 'us'; } return $setting; } sub set_app_setting { my ( $locale, $_3rdparty, $setting ) = @_; return if !ref($locale) && $locale =~ m/(?:\.\.|\/)/; return if $_3rdparty =~ m/(?:\.\.|\/)/; require Cpanel::SafeDir::MK; require Cpanel::FileUtils::Write; my $locale_tag = ref $locale ? $locale->get_language_tag() : $locale; $locale_tag = 'en' if $locale_tag eq 'en_us' || $locale_tag eq 'i_default'; Cpanel::SafeDir::MK::safemkdir("/var/cpanel/locale/3rdparty/conf/$locale_tag/"); Cpanel::FileUtils::Write::overwrite_no_exceptions( "/var/cpanel/locale/3rdparty/conf/$locale_tag/$_3rdparty", $setting, 0644 ); return; } 1; } # --- END Cpanel/Locale/Utils/3rdparty.pm { # --- BEGIN Cpanel/JS/Variations.pm package Cpanel::JS::Variations; use strict; sub lex_filename_for { my ( $filename, $locale ) = @_; return if !$filename || !$locale; return get_base_file( $filename, "-${locale}.js" ); } sub get_base_file { my ( $filename, $replace_extension ) = @_; return if !$filename; $replace_extension //= '.js'; $filename =~ s{/js2-min/}{/js2/}; $filename =~ s{(?:[\.\-]min|_optimized)?\.js$}{$replace_extension}; return $filename; } 1; } # --- END Cpanel/JS/Variations.pm { # --- BEGIN Cpanel/Locale/Utils/Display.pm package Cpanel::Locale::Utils::Display; use warnings; use strict; # use Cpanel::Locale::Utils::Paths (); sub get_locale_list { my ($lh) = @_; my @result = @{ $lh->{'_cached_get_locale_list'} ||= [ sort ( 'en', $lh->list_available_locales() ) ] }; if ( !-e "/var/cpanel/enable_snowmen" ) { @result = grep { !/i_cpanel_snowmen/ } @result; } return @result; } sub get_non_existent_locale_list { my ( $lh, $loc_obj ) = @_; $loc_obj ||= $lh->get_locales_obj('en'); my %have; @have{ get_locale_list($lh), 'en_us', 'i_default', 'und', 'zxx', 'mul', 'mis', 'art' } = (); return sort grep { !exists $have{$_} } $loc_obj->get_language_codes(); } sub get_locale_menu_hashref { my ( $lh, $omit_current_locale, $native_only, $skip_locales ) = @_; $skip_locales ||= {}; my %langs; my %dir; my @langs = get_locale_list($lh); my @wanted_langs = grep { !$skip_locales->{$_} } @langs; if ( !@wanted_langs ) { return ( {}, \@langs, {} ); } my $func = $native_only ? 'lang_names_hashref_native_only' : 'lang_names_hashref'; my ( $localized_name_for_tag, $native_name_for_tag, $direction_map ) = $lh->$func(@wanted_langs); my $current_tag = $lh->get_language_tag(); $current_tag = 'en' if $current_tag eq 'en_us' || $current_tag eq 'i_default'; my $i_locales_path = Cpanel::Locale::Utils::Paths::get_i_locales_config_path(); if ($omit_current_locale) { delete $localized_name_for_tag->{$current_tag}; delete $native_name_for_tag->{$current_tag}; @langs = grep { $_ ne $current_tag } @langs; } foreach my $tag ( keys %{$localized_name_for_tag} ) { if ( index( $tag, 'i_' ) == 0 ) { require Cpanel::DataStore; my $i_conf = Cpanel::DataStore::fetch_ref("$i_locales_path/$tag.yaml"); $langs{$tag} = exists $i_conf->{'display_name'} && defined $i_conf->{'display_name'} && $i_conf->{'display_name'} ne '' ? "$i_conf->{'display_name'} - $tag" : $tag; # slightly different format than real tags to visually indicate specialness $native_name_for_tag->{$tag} = $langs{$tag}; if ( exists $i_conf->{'character_orientation'} ) { $dir{$tag} = $lh->get_html_dir_attr( $i_conf->{'character_orientation'} ); } elsif ( exists $i_conf->{'fallback_locale'} && exists $direction_map->{ $i_conf->{'fallback_locale'} } ) { $dir{$tag} = $direction_map->{ $i_conf->{'fallback_locale'} }; } next; } if ( exists $direction_map->{$tag} ) { $dir{$tag} = $lh->get_html_dir_attr( $direction_map->{$tag} ); } next if $native_only; if ( $native_name_for_tag->{$tag} eq $localized_name_for_tag->{$tag} ) { if ( $tag eq $current_tag ) { $langs{$tag} = $native_name_for_tag->{$tag}; } else { $langs{$tag} = "$localized_name_for_tag->{$tag} ($tag)"; } } else { $langs{$tag} = "$localized_name_for_tag->{$tag} ($native_name_for_tag->{$tag})"; } } if ($native_only) { return wantarray ? ( $native_name_for_tag, \@langs, \%dir ) : $native_name_for_tag; } return wantarray ? ( \%langs, \@langs, \%dir ) : \%langs; } sub get_non_existent_locale_menu_hashref { my $lh = shift; $lh->{'Locales.pm'}{'_main_'} ||= $lh->get_locales_obj(); my %langs; my %dir; my @langs = get_non_existent_locale_list( $lh, $lh->{'Locales.pm'}{'_main_'} ); my $wantarray = wantarray() ? 1 : 0; for my $code (@langs) { if ($wantarray) { if ( my $orient = $lh->{'Locales.pm'}{'_main_'}->get_character_orientation_from_code_fast($code) ) { $dir{$code} = $lh->get_html_dir_attr($orient); } } my $current = $lh->{'Locales.pm'}{'_main_'}->get_language_from_code( $code, 1 ); my $native = $lh->{'Locales.pm'}{'_main_'}->get_native_language_from_code( $code, 1 ); $langs{$code} = $current eq $native ? "$current ($code)" : "$current ($native)"; } return wantarray ? ( \%langs, \@langs, \%dir ) : \%langs; } sub in_translation_vetting_mode { return ( -e '/var/cpanel/translation_vetting_mode' ) ? 1 : 0; } 1; } # --- END Cpanel/Locale/Utils/Display.pm { # --- BEGIN Cpanel/Locale/Utils/Api1.pm package Cpanel::Locale::Utils::Api1; use strict; use warnings; # use Cpanel::Locale (); my $_lh; sub _api1_maketext { ## no critic qw(Subroutines::RequireArgUnpacking) ## no extract maketext $_lh ||= Cpanel::Locale->get_handle(); $_[0] =~ s{\\'}{'}g; my $localized_str = $_lh->makevar(@_); if ($Cpanel::Parser::Vars::embtag) { # PPI NO PARSE -- module will already be there is we care about it require Cpanel::Encoder::Tiny; $localized_str = Cpanel::Encoder::Tiny::safe_html_encode_str($localized_str); } elsif ($Cpanel::Parser::Vars::javascript) { # PPI NO PARSE -- module will already be there is we care about it $localized_str =~ s/"/\\"/g; $localized_str =~ s/'/\\'/g; } return { status => 1, statusmsg => $localized_str, }; } 1; } # --- END Cpanel/Locale/Utils/Api1.pm { # --- BEGIN Cpanel/FileUtils/Lines.pm package Cpanel::FileUtils::Lines; use strict; # use Cpanel::Debug (); use IO::SigGuard (); use constant _ENOENT => 2; our $VERSION = '1.0'; my $MAX_LINE_SIZE = 32768; sub get_file_lines { my $cfgfile = shift; my $line_number = shift; return if ( !$line_number || $line_number !~ m/^\d+$/ ); my $numpadding = 7; my %ret; if ( open( my $cfg_fh, '<', $cfgfile ) ) { my $linecounter = 0; while ( readline($cfg_fh) ) { $linecounter++; if ( $linecounter < $line_number && $linecounter > ( $line_number - $numpadding ) ) { push @{ $ret{'previouslines'} }, { 'line' => $linecounter, 'data' => $_ }; } elsif ( $linecounter > $line_number && $linecounter < ( $line_number + $numpadding ) ) { push @{ $ret{'afterlines'} }, { 'line' => $linecounter, 'data' => $_ }; } elsif ( $linecounter == $line_number ) { push @{ $ret{'lines'} }, { 'line' => $linecounter, 'data' => $_ }; } elsif ( $linecounter > ( $line_number + $numpadding ) ) { last; } } close $cfg_fh; } return \%ret; } sub get_last_lines { my $cfgfile = shift; my $number = shift; if ( !$number || $number !~ m/^\d+$/ ) { $number = 10; } my @lines; if ( open( my $cfg_fh, '<', $cfgfile ) ) { my $size = ( stat($cfg_fh) )[7]; if ( $size > ( $MAX_LINE_SIZE * $number ) ) { seek( $cfg_fh, $size - ( $MAX_LINE_SIZE * $number ), 0 ); } my $linecounter = 0; while ( my $line = readline($cfg_fh) ) { chomp $line; if ( $linecounter >= $number ) { shift @lines; } push @lines, $line; $linecounter++; } close $cfg_fh; } else { Cpanel::Debug::log_warn("Unable to open $cfgfile: $!"); } return wantarray ? @lines : \@lines; } sub has_txt_in_file { my ( $file, $txt ) = @_; my $regex; eval { $regex = qr($txt); }; if ($@) { Cpanel::Debug::log_warn('Invalid regex'); return; } my $fh; if ( open $fh, '<', $file ) { while ( my $line = readline $fh ) { if ( $line =~ $regex ) { close $fh; return 1; } } close $fh; } return; } sub appendline { my ( $filename, $line ) = @_; my $fh; if ( open my $fh, '>>:stdio', $filename ) { IO::SigGuard::syswrite( $fh, $line . "\n" ) or do { warn "write($filename): $!"; }; close $fh; return 1; } else { warn "open($filename): $!" if $! != _ENOENT(); } return; } 1; } # --- END Cpanel/FileUtils/Lines.pm { # --- BEGIN Cpanel/SafeRun/Simple.pm package Cpanel::SafeRun::Simple; use strict; # use Cpanel::FHUtils::Autoflush (); # use Cpanel::LoadFile::ReadFast (); # use Cpanel::SV (); BEGIN { eval { require Proc::FastSpawn; }; } my $KEEP_STDERR = 0; my $MERGE_STDERR = 1; my $NULL_STDERR = 2; my $NULL_STDOUT = 3; sub saferun_r { return _saferun_r( \@_ ); } sub _saferun_r { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $cmdline, $error_flag ) = @_; if ($Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED) { # PPI NO PARSE -- can't be reduced if the module isn't loaded eval "use Cpanel::Carp;"; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) die Cpanel::Carp::safe_longmess( __PACKAGE__ . " cannot be used with ReducedPrivileges. Use Cpanel::SafeRun::Object instead" ); } elsif ( scalar @$cmdline == 1 && $cmdline->[0] =~ tr{><*?[]`$()|;&#$\\\r\n\t }{} ) { eval "use Cpanel::Carp;"; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) die Cpanel::Carp::safe_longmess( __PACKAGE__ . " prevents accidental execution of a shell. If you intended to execute a shell use saferun(" . join( ',', '/bin/sh', '-c', @$cmdline ) . ")" ); } my $output; if ( index( $cmdline->[0], '/' ) == 0 ) { my ($check) = !-e $cmdline->[0] && $cmdline->[0] =~ /[\s<>&\|\;]/ ? split( /[\s<>&\|\;]/, $cmdline->[0], 2 ) : $cmdline->[0]; if ( !-x $check ) { $? = -1; return \$output; } } $error_flag ||= 0; local ($/); my ( $pid, $prog_fh, $did_fastspawn ); if ( $INC{'Proc/FastSpawn.pm'} ) { # may not be available yet due to upcp.static or updatenow.static my @env = map { exists $ENV{$_} && $_ ne 'IFS' && $_ ne 'CDPATH' && $_ ne 'ENV' && $_ ne 'BASH_ENV' ? ( $_ . '=' . ( $ENV{$_} // '' ) ) : () } keys %ENV; my ($child_write); pipe( $prog_fh, $child_write ) or warn "Failed to pipe(): $!"; my $null_fh; if ( $error_flag == $NULL_STDERR || $error_flag == $NULL_STDOUT ) { open( $null_fh, '>', '/dev/null' ) or die "Failed open /dev/null: $!"; } Cpanel::FHUtils::Autoflush::enable($_) for ( $prog_fh, $child_write ); $did_fastspawn = 1; my $stdout_fileno = fileno($child_write); my $stderr_fileno = -1; if ( $error_flag == $MERGE_STDERR ) { $stderr_fileno = fileno($child_write); } elsif ( $error_flag == $NULL_STDERR ) { $stderr_fileno = fileno($null_fh); } elsif ( $error_flag == $NULL_STDOUT ) { $stdout_fileno = fileno($null_fh); $stderr_fileno = fileno($child_write); } $pid = Proc::FastSpawn::spawn_open3( -1, # stdin $stdout_fileno, # stdout $stderr_fileno, # stderr $cmdline->[0], # program $cmdline, # args \@env, #env ); } else { if ( $pid = open( $prog_fh, '-|' ) ) { } elsif ( defined $pid ) { delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; $ENV{'PATH'} ||= ''; Cpanel::SV::untaint( $ENV{'PATH'} ); if ( $error_flag == $MERGE_STDERR ) { open( STDERR, '>&STDOUT' ) or die "Failed to redirect STDERR to STDOUT: $!"; } elsif ( $error_flag == $NULL_STDERR ) { open( STDERR, '>', '/dev/null' ) or die "Failed to open /dev/null: $!"; } elsif ( $error_flag == $NULL_STDOUT ) { open( STDERR, '>&STDOUT' ) or die "Failed to redirect STDERR to STDOUT: $!"; open( STDOUT, '>', '/dev/null' ) or die "Failed to redirect STDOUT to /dev/null: $!"; } exec(@$cmdline) or exit( $! || 127 ); } else { die "fork() failed: $!"; } } if ( !$prog_fh || !$pid ) { $? = -1; ## no critic qw(Variables::RequireLocalizedPunctuationVars) return \$output; } Cpanel::LoadFile::ReadFast::read_all_fast( $prog_fh, $output ); close($prog_fh); waitpid( $pid, 0 ) if $did_fastspawn; return \$output; } sub _call_saferun { my ( $args, $flag ) = @_; my $ref = _saferun_r( $args, $flag || 0 ); return $$ref if $ref; return; } sub saferun { return _call_saferun( \@_, $KEEP_STDERR ); } sub saferunallerrors { return _call_saferun( \@_, $MERGE_STDERR ); } sub saferunnoerror { return _call_saferun( \@_, $NULL_STDERR ); } sub saferunonlyerrors { return _call_saferun( \@_, $NULL_STDOUT ); } 1; } # --- END Cpanel/SafeRun/Simple.pm { # --- BEGIN Cpanel/SafeRun/Errors.pm package Cpanel::SafeRun::Errors; use strict; # use Cpanel::SafeRun::Simple (); sub saferunallerrors { my $output_ref = Cpanel::SafeRun::Simple::_saferun_r( \@_, 1 ); #1 = errors to stdout return wantarray ? split( /\n/, $$output_ref ) : $$output_ref; } sub saferunnoerror { my $output_ref = Cpanel::SafeRun::Simple::_saferun_r( \@_, 2 ); # 2 = errors to devnull return wantarray ? split( /\n/, $$output_ref ) : $$output_ref; } sub saferunonlyerrors { my $output_ref = Cpanel::SafeRun::Simple::_saferun_r( \@_, 3 ); return wantarray ? split( /\n/, $$output_ref ) : $$output_ref; } 1; } # --- END Cpanel/SafeRun/Errors.pm { # --- BEGIN Cpanel/Timezones.pm package Cpanel::Timezones; use cPstrict; # use Cpanel::OS (); # use Cpanel::Debug (); use Cwd (); use constant _ENOENT => 2; our $timezones_cachefile = '/var/cpanel/timezones.cache'; my $cache_ttl = 3_600 * 24 * 7 * 6; #6 WEEKS our $timezones_cache; our $timezonedir = '/usr/share/zoneinfo'; our $zonetabfile = '/usr/share/zoneinfo/zone.tab'; our $etc_localtime = '/etc/localtime'; sub gettimezones() { if ( !$timezones_cache ) { my $timezones; if ( open my $fh, '<', $timezones_cachefile ) { $timezones = -f $fh; $timezones &&= ( time - ( stat $fh )[9] ) < $cache_ttl; $timezones &&= [<$fh>]; chomp @$timezones if $timezones; } elsif ( $! != _ENOENT ) { warn "open($timezones_cachefile): $!"; } if ( !$timezones || !scalar @{$timezones} || !grep { $_ eq "UTC" } @$timezones ) { $timezones = []; get_timezones_from_zonetab($timezones); if ( !scalar @{$timezones} ) { require Cpanel::FileUtils::Lines; require File::Find; File::Find::find( sub { if ( Cpanel::FileUtils::Lines::has_txt_in_file( $File::Find::name, '\ATZif' ) ) { ( my $stripped_name = $File::Find::name ) =~ s{\A$timezonedir/}{}; push @{$timezones}, $stripped_name; } }, $timezonedir ); } push @$timezones, "UTC" unless grep { $_ eq "UTC" } @$timezones; if ( _running_as_root() ) { require Cpanel::FileUtils::Write; Cpanel::FileUtils::Write::overwrite_no_exceptions( $timezones_cachefile, join( "\n", @{$timezones} ), 0644 ); } } $timezones_cache = $timezones; } return wantarray ? @$timezones_cache : $timezones_cache; } sub _running_as_root { return $> == 0 ? 1 : 0; } sub is_valid ($tz) { my $is_valid; require Cpanel::FileUtils::Lines; if ($timezones_cache) { $is_valid = grep { $_ eq $tz } @$timezones_cache; } elsif ( -f $timezones_cachefile && ( time() - ( stat $timezones_cachefile )[9] <= $cache_ttl ) ) { $is_valid = Cpanel::FileUtils::Lines::has_txt_in_file( $timezones_cachefile, qr(\A\Q$tz\E\Z) ); } else { $is_valid = grep { $_ eq $tz } ( gettimezones() ); } return $is_valid; } sub set ($tz) { return unless is_valid($tz); my $method = Cpanel::OS::setup_tz_method(); if ( $method eq 'timedatectl' ) { _setup_clock_using_timedatectl($tz); } elsif ( $method eq 'sysconfig' ) { _setup_clock_using_sysconfig($tz); } else { Cpanel::Debug::log_die("Invalid setup_tz_method method: $method"); } return; } sub _setup_clock_using_timedatectl ($tz) { require Cpanel::SafeRun::Errors; Cpanel::SafeRun::Errors::saferunallerrors( '/usr/bin/timedatectl', 'set-timezone', $tz ); return; } sub _setup_clock_using_sysconfig ($tz) { my @CLOCK; if ( open( my $fh, '<', '/etc/sysconfig/clock' ) ) { @CLOCK = (<$fh>); close($fh); } else { Cpanel::Debug::log_warn(qq[Could not open file "/etc/sysconfig/clock" for reading ($!)]); } if ( open( my $fh, '>', '/etc/sysconfig/clock' ) ) { my $ok; foreach my $line (@CLOCK) { if ( $line =~ m{\AZONE=}i ) { $ok = 1; print {$fh} qq[ZONE="$tz"\n]; } else { print {$fh} $line; } } print {$fh} qq[ZONE="$tz"\n] unless $ok; close($fh); unlink $etc_localtime; symlink "/usr/share/zoneinfo/$tz", $etc_localtime; } else { Cpanel::Debug::log_warn(qq[Could not open file "/etc/sysconfig/clock" for writing ($!)]); } return; } sub get_timezones_from_zonetab ($timezones_ar) { my $fh; if ( !open $fh, '<', $zonetabfile ) { Cpanel::Debug::log_warn("Could not open file \"$zonetabfile\" for reading ($!), will attempt to determine the time zone list by other (probably less precise) method(s)"); return; } while (<$fh>) { next unless m{ ^ [A-Z]+ \s+ [-+][-+\d]+ \s+ (\S+) }ax; push @{$timezones_ar}, $1; } close $fh; return 1; } sub _hash_file ($file) { require Digest::SHA; return Digest::SHA->new(512)->addfile($file)->hexdigest; } sub get_current_timezone (%opts) { my $tz = 'UTC'; # default value when none found if ( -l $etc_localtime ) { # check file being symlinked, if symlinked $tz = Cwd::abs_path($etc_localtime); $tz =~ s{^.*/usr/share/zoneinfo/}{}; } else { my $localhash = _hash_file($etc_localtime); my @TZS = gettimezones(); foreach my $tzfile (@TZS) { my $check = $timezonedir . '/' . $tzfile; next unless -f $check; my $digest = _hash_file($check); if ( $localhash eq $digest ) { $tz = $tzfile; last; } } } $tz =~ s{^posix/}{} if $opts{noposix}; return $tz; } sub calculate_TZ_env() { return get_current_timezone( noposix => 1 ); } sub set_zonetabfile ($file) { $zonetabfile = $file; return; } sub clear_caches() { undef $timezones_cache; unlink $timezones_cachefile; return; } 1; } # --- END Cpanel/Timezones.pm { # --- BEGIN Cpanel/Locale/Utils/DateTime.pm package Cpanel::Locale::Utils::DateTime; use strict; # use Cpanel::LoadModule (); # use Cpanel::Locale (); our $ENCODE_MODULE = 'Encode'; our $DATETIME_MODULE = 'DateTime'; our $DATETIME_LOCALE_MODULE = 'DateTime::Locale'; my %known_ids = (); sub datetime { my ( $lh, $epoch, $format, $timezone ) = @_; if ( $epoch && ref $epoch eq 'ARRAY' ) { $epoch = $epoch->[0]; } elsif ( !$epoch ) { $epoch = time; } $format ||= 'date_format_long'; my $encoding = $lh->encoding(); if ( _can_use_cpanel_date_format( $encoding, $timezone ) ) { Cpanel::LoadModule::load_perl_module('Cpanel::Date::Format'); return Cpanel::Date::Format::translate_for_locale( $epoch, $format, $lh->language_tag() ); } my $locale = _get_best_locale_for_datetime_obj( $lh->language_tag() ); return _get_formatted_datetime( $locale, $encoding, $format, $epoch, $timezone ); } sub _can_use_cpanel_date_format { my ( $encoding, $timezone ) = @_; return ( $encoding eq 'utf-8' ) && ( !$timezone || $timezone eq 'UTC' ); } sub get_lookup_hash_of_multi_epoch_datetime { my ( $lh, $epochs_ar, $format, $timezone ) = @_; $format ||= 'date_format_long'; my %lookups; my $encoding = $lh->encoding(); my $can_use_cpanel_date_format = _can_use_cpanel_date_format( $encoding, $timezone ); my $locale; if ($can_use_cpanel_date_format) { Cpanel::LoadModule::load_perl_module('Cpanel::Date::Format'); $locale = $lh->language_tag(); } else { $locale = _get_best_locale_for_datetime_obj( $lh->language_tag() ); } foreach my $epoch ( @{$epochs_ar} ) { $lookups{$epoch} ||= do { if ($can_use_cpanel_date_format) { Cpanel::Date::Format::translate_for_locale( $epoch, $format, $locale ); } else { _get_formatted_datetime( $locale, $encoding, $format, $epoch, $timezone ); } }; } return \%lookups; } sub _get_formatted_datetime { my ( $locale, $encoding, $format, $epoch, $timezone ) = @_; if ( !$timezone ) { $timezone = 'UTC'; } elsif ( $timezone !~ m{^[\.0-9A-Za-z\/_\+\-]+$} ) { die "Invalid timezone “$timezone”"; } my $datetime_obj = $DATETIME_MODULE->from_epoch( 'epoch' => $epoch, 'locale' => $locale, 'time_zone' => $timezone ); if ( $format && $format !~ m{_format$} && $datetime_obj->{'locale'}->can($format) ) { return $ENCODE_MODULE->can('encode')->( $encoding, $datetime_obj->format_cldr( $datetime_obj->{'locale'}->$format ) ); } die 'Invalid datetime format: ' . $format; } sub _get_best_locale_for_datetime_obj { my ($language_tag) = @_; my ( $fallback, $locale ) = _get_fallback_locale($language_tag); Cpanel::LoadModule::load_perl_module($ENCODE_MODULE) if !$INC{'Encode.pm'}; Cpanel::LoadModule::load_perl_module($DATETIME_MODULE); foreach my $try_locale ( $locale, $fallback, 'en_US', 'en' ) { next if !$try_locale; return $try_locale if $known_ids{$try_locale} || $Cpanel::Locale::known_locales_character_orientation{$try_locale}; if ( eval { $DATETIME_MODULE->load($try_locale) } ) { $known_ids{$try_locale} = 1; return $try_locale; } } die "Could not locale any working DateTime locale"; } sub _get_fallback_locale { my ($locale) = @_; my $fallback; if ( substr( $locale, 0, 2 ) eq 'i_' ) { require Cpanel::Locale::Utils::Paths; my $dir = Cpanel::Locale::Utils::Paths::get_i_locales_config_path(); if ( -e "$dir/$locale.yaml" ) { require Cpanel::DataStore; my $hr = Cpanel::DataStore::fetch_ref("$dir/$locale.yaml"); if ( exists $hr->{'fallback_locale'} && $hr->{'fallback_locale'} ) { $fallback = $hr->{'fallback_locale'}; } } } else { my ( $pre, $pst ) = split( /[\_\-]/, $locale, 2 ); if ($pst) { $fallback = $pre; $locale = $pre . '_' . uc($pst); } } $fallback ||= 'en'; return ( $fallback, $locale ); } 1; } # --- END Cpanel/Locale/Utils/DateTime.pm { # --- BEGIN Cpanel/Time/ISO.pm package Cpanel::Time::ISO; use strict; use warnings; # use Cpanel::Debug (); # use Cpanel::LoadModule (); sub unix2iso { Cpanel::LoadModule::load_perl_module('Cpanel::Time') unless $INC{'Cpanel/Time.pm'}; return sprintf( '%04d-%02d-%02dT%02d:%02d:%02dZ', reverse( ( Cpanel::Time::gmtime( $_[0] || time() ) )[ 0 .. 5 ] ) ); } sub iso2unix { my ($iso_time) = @_; if ( rindex( $iso_time, 'Z' ) != length($iso_time) - 1 ) { die "Only UTC times, not “$iso_time”!"; } my @smhdmy = reverse split m<[^0-9.]>, $iso_time; Cpanel::LoadModule::load_perl_module('Cpanel::Time') unless $INC{'Cpanel/Time.pm'}; return Cpanel::Time::timegm(@smhdmy); } sub unix2iso_date { Cpanel::LoadModule::load_perl_module('Cpanel::Time') unless $INC{'Cpanel/Time.pm'}; Cpanel::Debug::log_deprecated('This function will be removed, please use locale datetime'); return sprintf( '%04d-%02d-%02d', reverse( ( Cpanel::Time::gmtime( $_[0] || time() ) )[ 3 .. 5 ] ) ); } sub unix2iso_time { Cpanel::LoadModule::load_perl_module('Cpanel::Time') unless $INC{'Cpanel/Time.pm'}; Cpanel::Debug::log_deprecated('This function will be removed, please use locale datetime'); return sprintf( '%02d:%02d:%02d', reverse( ( Cpanel::Time::gmtime( $_[0] || time() ) )[ 0 .. 2 ] ) ); } 1; } # --- END Cpanel/Time/ISO.pm { # --- BEGIN Cpanel/Config/LoadUserDomains/Count.pm package Cpanel::Config::LoadUserDomains::Count; use strict; use warnings; # use Cpanel::Autodie qw(exists); INIT { Cpanel::Autodie->import(qw{exists}); } # use Cpanel::LoadFile::ReadFast (); # use Cpanel::ConfigFiles (); sub counttrueuserdomains { if ( !Cpanel::Autodie::exists( _trueuserdomains() ) ) { return 0; } return _count_file_lines( _trueuserdomains() ); } sub countuserdomains { if ( !Cpanel::Autodie::exists( _userdomains() ) ) { return 0; } return _count_file_lines( _userdomains() ) - 1; # -1 for *: nobody } sub _count_file_lines { my ($file) = @_; open( my $ud_fh, '<', $file ) or die "open($file): $!"; my $buffer = ''; Cpanel::LoadFile::ReadFast::read_all_fast( $ud_fh, $buffer ); my $num_ud = ( $buffer =~ tr/\n// ); close($ud_fh) or warn "close($file): $!"; $num_ud++ if length($buffer) && substr( $buffer, -1 ) ne "\n"; return $num_ud; } sub _userdomains { return $Cpanel::ConfigFiles::USERDOMAINS_FILE; } sub _domainusers { return $Cpanel::ConfigFiles::DOMAINUSERS_FILE; } sub _trueuserdomains { return $Cpanel::ConfigFiles::TRUEUSERDOMAINS_FILE; } 1; } # --- END Cpanel/Config/LoadUserDomains/Count.pm { # --- BEGIN Cpanel/Server/Type.pm package Cpanel::Server::Type; use cPstrict; 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; 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 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 has_els { return $FIELDS{els} if defined $FIELDS{els}; return 0 unless _read_license(); return $FIELDS{els} // 0; } 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/Config/LoadUserDomains.pm package Cpanel::Config::LoadUserDomains; use strict; use warnings; # use Cpanel::Config::LoadConfig (); # use Cpanel::Config::LoadUserDomains::Count (); # use Cpanel::Server::Type (); sub loaduserdomains { my ( $conf_ref, $reverse, $usearr ) = @_; $conf_ref = Cpanel::Config::LoadConfig::loadConfig( Cpanel::Config::LoadUserDomains::Count::_userdomains(), $conf_ref, ': ', # We write the file so there is no need to match stray spaces '0E0', # Avoid looking for comments since there will not be any 0, # reverse 1, # allow_undef_values since there will not be any { 'use_reverse' => $reverse ? 0 : 1, 'skip_keys' => ['nobody'], 'use_hash_of_arr_refs' => ( $usearr || 0 ), } ); if ( !defined($conf_ref) ) { $conf_ref = {}; } return wantarray ? %{$conf_ref} : $conf_ref; } sub loadtrueuserdomains { my ( $conf_ref, $reverse, $ignore_limit ) = @_; $conf_ref = Cpanel::Config::LoadConfig::loadConfig( ( $reverse ? Cpanel::Config::LoadUserDomains::Count::_domainusers() : Cpanel::Config::LoadUserDomains::Count::_trueuserdomains() ), $conf_ref, ': ', # We write the file so there is no need to match stray spaces '0E0', # Avoid looking for comments since there will not be any 0, # reverse 1, # allow_undef_values since there will not be any { 'limit' => ( $ignore_limit ? 0 : Cpanel::Server::Type::get_max_users() ) } ); if ( !defined($conf_ref) ) { $conf_ref = {}; } return wantarray ? %{$conf_ref} : $conf_ref; } *counttrueuserdomains = *counttrueuserdomains = *Cpanel::Config::LoadUserDomains::Count::counttrueuserdomains; 1; } # --- END Cpanel/Config/LoadUserDomains.pm { # --- BEGIN Cpanel/Config/CpUser.pm package Cpanel::Config::CpUser; use strict; # use Cpanel::Debug (); # use Cpanel::LoadModule (); # use Cpanel::Config::LoadUserDomains (); # use Cpanel::Config::LoadCpUserFile (); # use Cpanel::ConfigFiles (); # use Cpanel::FileUtils::Write::JSON::Lazy (); our $cpuser_dir; *cpuser_dir = \$Cpanel::ConfigFiles::cpanel_users; our $cpuser_cache_dir = "$cpuser_dir.cache"; our $header = <{$_} } required_cpuser_keys(); if (@missing) { $user = q{} if !defined $user; Cpanel::Debug::log_warn( "The following keys are missing from supplied '$user' cPanel user data: " . join( ', ', @missing ) . ", to prevent data loss, the data was not saved." ); return; } } if ( grep { $_ && index( $_, "\n" ) != -1 } %$cpuser_ref ) { Cpanel::Debug::log_warn("The cpuser data contains newlines. This is not allowed as it would corrupt the file."); return; } my $domain = $cpuser_ref->{'DOMAIN'}; if ( !$domain ) { # Try to lookup main domain in /etc/trueuserdomains my $trueuserdomains_ref = Cpanel::Config::LoadUserDomains::loadtrueuserdomains( undef, 1 ); $domain = $trueuserdomains_ref->{$user} || ''; if ( !$domain ) { Cpanel::Debug::log_info("Unable to determine user ${user}'s main domain"); } } my %clean_data = ( %$cpuser_ref, DNS => $domain, ); delete @clean_data{ q{}, 'DOMAIN', 'DBOWNER', '__CACHE_DATA_VERSION', ( keys %memory_file_list_key ), }; if ( defined $clean_data{'DISK_BLOCK_LIMIT'} && $clean_data{'DISK_BLOCK_LIMIT'} eq 'unlimited' ) { $clean_data{'DISK_BLOCK_LIMIT'} = 0; } while ( my ( $memkey, $filekey ) = each %memory_file_list_key ) { if ( exists $cpuser_ref->{$memkey} && scalar @{ $cpuser_ref->{$memkey} } ) { my $doms_ar = $cpuser_ref->{$memkey}; my $count = 0; @clean_data{ ( map { $filekey . ++$count } @$doms_ar ) } = @$doms_ar; } } my $homedirs_key_in_file = $memory_file_list_key{'HOMEDIRLINKS'}; if ( exists $clean_data{ $homedirs_key_in_file . 1 } ) { $clean_data{$homedirs_key_in_file} = delete $clean_data{ $homedirs_key_in_file . 1 }; } return wantarray ? %clean_data : \%clean_data; } sub get_cpgid { my ($user) = @_; my $cpgid = 0; if ( exists $INC{'Cpanel/PwCache.pm'} || Cpanel::LoadModule::load_perl_module('Cpanel::PwCache') ) { $cpgid = ( Cpanel::PwCache::getpwnam_noshadow($user) )[3]; } return $cpgid; } sub recache { my ( $cpuser_ref, $user, $cpgid ) = @_; my $user_cache_file = $cpuser_cache_dir . '/' . $user; Cpanel::Config::LoadCpUserFile::create_users_cache_dir(); $cpuser_ref->{'__CACHE_DATA_VERSION'} = $Cpanel::Config::LoadCpUserFile::VERSION; # set this before the cache is written so that it will be included in the cache if ( Cpanel::FileUtils::Write::JSON::Lazy::write_file( $user_cache_file, $cpuser_ref, 0640 ) ) { chown 0, $cpgid, $user_cache_file if $cpgid; # this is ok if the chown happens after as we fall though to reading the non-cache on a failed open } else { unlink $user_cache_file; #outdated } } sub required_cpuser_keys { my @keys = qw( FEATURELIST HASCGI MAXSUB MAXADDON DEMO RS USER MAXFTP MAXLST MAXPARK STARTDATE BWLIMIT IP MAXSQL DOMAIN MAXPOP PLAN OWNER ); return wantarray ? @keys : \@keys; } 1; } # --- END Cpanel/Config/CpUser.pm { # --- BEGIN Cpanel/Config/FlushConfig.pm package Cpanel::Config::FlushConfig; use strict; use warnings; # use Cpanel::FileUtils::Write (); # use Cpanel::Debug (); # use Cpanel::Exception (); our $VERSION = '1.4'; my $DEFAULT_DELIMITER = '='; sub flushConfig { my ( $filename_or_fh, $conf, $delimiter, $header, $opts ) = @_; if ( !$filename_or_fh ) { Cpanel::Debug::log_warn('flushConfig requires valid filename or fh as first argument'); return; } elsif ( !$conf || ref $conf ne 'HASH' ) { Cpanel::Debug::log_warn('flushConfig requires HASH reference as second argument'); return; } if ( ref $opts && $opts->{'no_overwrite'} ) { die Cpanel::Exception::create( 'Unsupported', 'Function ”flushConfig” called with an unsupported option “no_overwrite”.' ); } my $contents_sr = serialize( $conf, do_sort => $opts && $opts->{'sort'}, delimiter => $delimiter, header => $header, allow_array_values => $opts && $opts->{'allow_array_values'}, ); my $perms = 0644; # default permissions when unset if ( defined $opts->{'perms'} ) { $perms = $opts->{'perms'}; } elsif ( !ref $filename_or_fh && -e $filename_or_fh ) { $perms = ( stat(_) )[2] & 0777; } if ( ref $filename_or_fh ) { return Cpanel::FileUtils::Write::write_fh( $filename_or_fh, ref $contents_sr eq 'SCALAR' ? $$contents_sr : $contents_sr ); } return Cpanel::FileUtils::Write::overwrite_no_exceptions( $filename_or_fh, ref $contents_sr eq 'SCALAR' ? $$contents_sr : $contents_sr, $perms, ); } sub serialize { my ( $conf, %opts ) = @_; my ( $do_sort, $delimiter, $header, $allow_array_values ) = @opts{qw(do_sort delimiter header allow_array_values)}; $delimiter ||= $DEFAULT_DELIMITER; if ($allow_array_values) { my $contents = ''; $contents .= $header . "\n" if $header; foreach my $key ( $do_sort ? ( sort keys %{$conf} ) : ( keys %{$conf} ) ) { if ( ref( $conf->{$key} ) eq 'ARRAY' ) { $contents .= join( "\n", map { $key . $delimiter . $_ } ( @{ $conf->{$key} } ) ) . "\n"; } else { $contents .= $key . $delimiter . ( defined $conf->{$key} ? $conf->{$key} : '' ) . "\n"; } } return \$contents; } my $contents = ( $header ? ( $header . "\n" ) : '' ) . join( "\n", map { $_ . ( defined $conf->{$_} ? ( $delimiter . $conf->{$_} ) : '' ) } ( $do_sort ? ( sort keys %{$conf} ) : ( keys %{$conf} ) ) ) . "\n"; return \$contents; } 1; } # --- END Cpanel/Config/FlushConfig.pm { # --- BEGIN Cpanel/Config/CpUser/Write.pm package Cpanel::Config::CpUser::Write; use cPstrict; # use Cpanel::Config::CpUser (); # use Cpanel::Config::FlushConfig (); sub serialize ($cpuser_data) { die 'Pass data through clean_cpuser_hash() first!' if grep { ref } values %$cpuser_data; return ${ Cpanel::Config::FlushConfig::serialize( $cpuser_data, do_sort => 1, delimiter => '=', 'header' => $Cpanel::Config::CpUser::header, ) }; } 1; } # --- END Cpanel/Config/CpUser/Write.pm { # --- BEGIN Cpanel/LinkedNode/Worker/Storage.pm package Cpanel::LinkedNode::Worker::Storage; use strict; use warnings; sub read { my ( $cpuser_hr, $worker_type ) = @_; my $str = $cpuser_hr->{ _get_key($worker_type) }; return _parse($str); } sub set { my ( $cpuser_hr, $worker_type, $alias, $token ) = @_; $cpuser_hr->{ _get_key($worker_type) } = "$alias:$token"; return; } sub unset { my ( $cpuser_hr, $worker_type ) = @_; return _parse( delete $cpuser_hr->{ _get_key($worker_type) } ); } sub _get_key { my ($worker_type) = @_; substr( $worker_type, 0, 1 ) =~ tr<> or do { die "Worker type names always begin with a capital! (given: “$worker_type”)"; }; return "WORKER_NODE-$worker_type"; } sub _parse { my ($str) = @_; return $str ? [ split m<:>, $str, 2 ] : undef; } 1; } # --- END Cpanel/LinkedNode/Worker/Storage.pm { # --- BEGIN Cpanel/SafeFile/Replace.pm package Cpanel::SafeFile::Replace; use strict; use warnings; # use Cpanel::Fcntl::Constants (); # use Cpanel::FileUtils::Open (); use File::Basename (); use constant { WRONLY_CREAT_EXCL => $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_EXCL, _EEXIST => 17 }; sub safe_replace_content { my ( $fh, $safelock, @content ) = @_; return locked_atomic_replace_contents( $fh, $safelock, sub { local $!; @content = @{ $content[0] } if scalar @content == 1 && ref $content[0] eq 'ARRAY'; print { $_[0] } @content; if ($!) { my $length = 0; $length += length for @content; my $err = $!; require Cpanel::Exception; die Cpanel::Exception::create( 'IO::WriteError', [ length => $length, error => $err ] ); } return 1; } ); } my $_lock_ex_nb; sub locked_atomic_replace_contents { my ( $fh, $safelock, $coderef ) = @_; $_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB; if ( !flock $fh, $_lock_ex_nb ) { my $err = $!; require Cpanel::Exception; die Cpanel::Exception::create_raw( 'IOError', "locked_atomic_replace_contents could not lock the file handle because of an error: $err" ); } if ( !ref $safelock ) { local $@; if ( !eval { $safelock->isa('Cpanel::SafeFileLock') } ) { die "locked_atomic_replace_contents requires a Cpanel::SafeFileLock object"; } } my $locked_path = $safelock->get_path_to_file_being_locked(); die "locked_path must be valid" if !length $locked_path; my ( $temp_file, $temp_fh, $created_temp_file, $attempts ); my $current_perms = ( stat($fh) )[2] & 07777; while ( !$created_temp_file && ++$attempts < 100 ) { $temp_file = sprintf( '%s-%x-%x-%x', $locked_path, substr( rand, 2 ), scalar( reverse time ), scalar( reverse $$ ), ); my ( $basename, $dirname ); $basename = File::Basename::basename($temp_file); if ( length $basename >= 255 ) { $basename = substr( $basename, 255 ); $dirname = File::Basename::dirname($temp_file); $temp_file = "$dirname/$basename"; } $created_temp_file = Cpanel::FileUtils::Open::sysopen_with_real_perms( $temp_fh, $temp_file, WRONLY_CREAT_EXCL, $current_perms ) or do { last if $! != _EEXIST; }; } if ( !$created_temp_file ) { my $lasterr = $!; die Cpanel::Exception::create( 'TempFileCreateError', [ path => $temp_file, error => $lasterr ] ); } if ( !flock $temp_fh, $Cpanel::Fcntl::Constants::LOCK_EX ) { my $err = $!; require Cpanel::Exception; die Cpanel::Exception::create( 'IO::FlockError', [ path => $temp_file, error => $err, operation => $Cpanel::Fcntl::Constants::LOCK_EX ] ); } select( ( select($temp_fh), $| = 1 )[0] ); ##no critic qw(ProhibitOneArgSelect Variables::RequireLocalizedPunctuationVars) #aka $fd->autoflush(1); if ( $coderef->( $temp_fh, $temp_file, $current_perms ) ) { rename( $temp_file, $locked_path ); return $temp_fh; } local $!; close $temp_fh; unlink $temp_file; die "locked_atomic_replace_contents coderef returns false"; } 1; } # --- END Cpanel/SafeFile/Replace.pm { # --- BEGIN Cpanel/Config/CpUserGuard.pm package Cpanel::Config::CpUserGuard; use strict; use warnings; # use Cpanel::Destruct (); # use Cpanel::Config::CpUser (); # use Cpanel::Config::CpUser::Write (); # use Cpanel::Config::LoadCpUserFile (); # use Cpanel::Debug (); sub new { my ( $class, $user ) = @_; my ( $data, $file, $lock, $is_locked ) = ( undef, undef, undef, 0 ); my $cpuser = Cpanel::Config::LoadCpUserFile::_load_locked($user); if ( $cpuser && ref $cpuser eq 'HASH' ) { $data = $cpuser->{'data'}; $file = $cpuser->{'file'}; $lock = $cpuser->{'lock'}; $is_locked = defined $lock; } else { Cpanel::Debug::log_warn("Failed to load user file for '$user': $!"); return; } my $path = "$Cpanel::Config::CpUser::cpuser_dir/$user"; return bless { user => $user, data => $data, path => $path, _file => $file, _lock => $lock, _pid => $$, is_locked => $is_locked, }; } sub set_worker_node { my ( $self, $worker_type, $worker_alias, $token ) = @_; require Cpanel::LinkedNode::Worker::Storage; Cpanel::LinkedNode::Worker::Storage::set( $self->{'data'}, $worker_type, $worker_alias, $token ); return $self; } sub unset_worker_node { my ( $self, $worker_type ) = @_; require Cpanel::LinkedNode::Worker::Storage; return Cpanel::LinkedNode::Worker::Storage::unset( $self->{'data'}, $worker_type ); } sub save { my ($self) = @_; my $user = $self->{'user'}; my $data = $self->{'data'}; if ( $self->{'_pid'} != $$ ) { Cpanel::Debug::log_die('Locked in parent, cannot save'); return; } if ( !UNIVERSAL::isa( $data, 'HASH' ) ) { Cpanel::Debug::log_die( __PACKAGE__ . ': hash reference required' ); return; } my $clean_data = Cpanel::Config::CpUser::clean_cpuser_hash( $self->{'data'}, $user ); if ( !$clean_data ) { Cpanel::Debug::log_warn("Data for user '$user' was not saved."); return; } if ( !$self->{'_file'} || !$self->{'_lock'} ) { Cpanel::Debug::log_warn("Unable to save user file for '$user': file not open and locked for writing"); return; } require Cpanel::SafeFile::Replace; require Cpanel::Autodie; my $newfh = Cpanel::SafeFile::Replace::locked_atomic_replace_contents( $self->{'_file'}, $self->{'_lock'}, sub { my ($fh) = @_; chmod( 0640, $fh ) or do { warn sprintf( "Failed to set permissions on “%s” to 0%o: %s", $self->{'path'}, 0640, $! ); }; return Cpanel::Autodie::syswrite_sigguard( $fh, Cpanel::Config::CpUser::Write::serialize($clean_data), ); } ) or do { Cpanel::Debug::log_warn("Failed to save user file for “$user”: $!"); }; $self->{'_file'} = $newfh; my $cpgid = Cpanel::Config::CpUser::get_cpgid($user); if ($cpgid) { chown 0, $cpgid, $self->{'path'} or do { Cpanel::Debug::log_warn("Failed to chown( 0, $cpgid, $self->{'path'}): $!"); }; } if ( $INC{'Cpanel/Locale/Utils/User.pm'} ) { Cpanel::Locale::Utils::User::clear_user_cache($user); } Cpanel::Config::CpUser::recache( $data, $user, $cpgid ); require Cpanel::SafeFile; Cpanel::SafeFile::safeclose( $self->{'_file'}, $self->{'_lock'} ) or do { Cpanel::Debug::log_warn("Failed to safeclose $self->{'path'}: $!"); }; $self->{'_file'} = $self->{'_lock'} = undef; $self->{'is_locked'} = 0; return 1; } sub abort { my ($self) = @_; my $user = $self->{'user'}; my $data = $self->{'data'}; if ( $self->{'_pid'} != $$ ) { Cpanel::Debug::log_die('Locked in parent, cannot save'); return; } require Cpanel::SafeFile; Cpanel::SafeFile::safeclose( $self->{'_file'}, $self->{'_lock'} ); $self->{'_file'} = $self->{'_lock'} = undef; $self->{'is_locked'} = 0; return 1; } sub DESTROY { my ($self) = @_; return unless $self->{'is_locked'}; return if Cpanel::Destruct::in_dangerous_global_destruction(); return unless $self->{'_pid'} == $$; Cpanel::SafeFile::safeclose( $self->{'_file'}, $self->{'_lock'} ); $self->{'is_locked'} = 0; return; } 1; } # --- END Cpanel/Config/CpUserGuard.pm { # --- BEGIN Cpanel/Locale/Utils/User/Modify.pm package Cpanel::Locale::Utils::User::Modify; use strict; use warnings; # use Cpanel::PwCache (); sub save_user_locale { my ( $locale, undef, $user ) = @_; $locale ||= 'en'; $user ||= $Cpanel::user || $ENV{'REMOTE_USER'} || ( $> == 0 ? 'root' : ( Cpanel::PwCache::getpwuid_noshadow($>) )[0] ); if ( $user eq 'root' ) { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::DataStore'); my $root_conf_yaml = Cpanel::PwCache::gethomedir('root') . '/.cpanel_config'; my $hr = Cpanel::DataStore::fetch_ref($root_conf_yaml); return 2 if exists $hr->{'locale'} && $hr->{'locale'} eq $locale; $hr->{'locale'} = $locale; return 1 if Cpanel::DataStore::store_ref( $root_conf_yaml, $hr ); return; } elsif ( $> == 0 ) { require Cpanel::Config::CpUserGuard; my $cpuser_guard = Cpanel::Config::CpUserGuard->new($user) or return; $cpuser_guard->{'data'}->{'LOCALE'} = $locale; delete $cpuser_guard->{'data'}->{'LANG'}; delete $cpuser_guard->{'data'}{'__LOCALE_MISSING'}; return $cpuser_guard->save(); } else { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::AdminBin'); return Cpanel::AdminBin::run_adminbin_with_status( 'lang', 'SAVEUSERSETTINGS', $locale, 0, $user )->{'status'}; } return 1; } 1; } # --- END Cpanel/Locale/Utils/User/Modify.pm { # --- BEGIN Cpanel/Version/Tiny.pm package Cpanel::Version::Tiny; use strict; our $VERSION = '11.110.0'; our $VERSION_BUILD = '11.110.0.39'; our $VERSION_TEXT = '110.0 (build 39)'; our $VERSION_DISPLAY = '110.0.39'; our $parent_version = 11; our $major_version = 110; our $minor_version = 0; our $build_number = 39; our $build_time_text = 'Wed Aug 14 16:51:47 2024'; our $buildtime = 1723672307; 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; 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; # use Cpanel::Version::Full (); our ( $VERSION, $MAJORVERSION, $LTS ) = ( '4.0', '11.110', '11.110' ); 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/Locale.pm package Cpanel::Locale; use strict; BEGIN { $ENV{'IGNORE_WIN32_LOCALE'} = 1; } # use Cpanel::CPAN::Locale::Maketext::Utils(); our @ISA; BEGIN { push @ISA, qw(Cpanel::CPAN::Locale::Maketext::Utils); } # use Cpanel::Locale::Utils (); # Individual Locale modules depend on this being brought in here, if it is removed they will all need updated. Same for cpanel.pl # use Cpanel::Locale::Utils::Paths (); # use Cpanel::CPAN::Locale::Maketext (); # use Cpanel::Exception (); use constant _ENOENT => 2; BEGIN { local $^H = 0; # cheap no warnings without importing it local $^W = 0; *Cpanel::CPAN::Locale::Maketext::Utils::remove_key_from_lexicons = sub { }; # PPI NO PARSE - loaded above - disabled } our $SERVER_LOCALE_FILE = '/var/cpanel/server_locale'; our $LTR = 1; our $RTL = 2; our %known_locales_character_orientation = ( ar => $RTL, bn => $LTR, bg => $LTR, cs => $LTR, da => $LTR, de => $LTR, el => $LTR, en => $LTR, en_US => $LTR, en_GB => $LTR, es_419 => $LTR, es => $LTR, es_es => $LTR, fi => $LTR, fil => $LTR, fr => $LTR, he => $RTL, hi => $LTR, hu => $LTR, i_cpanel_snowmen => $LTR, i_cp_qa => $LTR, id => $LTR, it => $LTR, ja => $LTR, ko => $LTR, ms => $LTR, nb => $LTR, nl => $LTR, no => $LTR, pl => $LTR, pt_br => $LTR, pt => $LTR, ro => $LTR, ru => $LTR, sl => $LTR, sv => $LTR, th => $LTR, tr => $LTR, uk => $LTR, vi => $LTR, zh => $LTR, zh_tw => $LTR, zh_cn => $LTR, ); my $logger; sub _logger { require Cpanel::Logger; return ( $logger ||= Cpanel::Logger->new() ); } *get_lookup_hash_of_mutli_epoch_datetime = *get_lookup_hash_of_multi_epoch_datetime; sub preinit { if ( exists $INC{'Cpanel.pm'} && !$Cpanel::CPDATA{'LOCALE'} ) { require Cpanel::Locale::Utils::User if !exists $INC{'Cpanel/Locale/Utils/User.pm'}; Cpanel::Locale::Utils::User::init_cpdata_keys(); } if ( $ENV{'HTTP_COOKIE'} ) { require Cpanel::Cookies unless $INC{'Cpanel/Cookies.pm'}; if ( !keys %Cpanel::Cookies ) { %Cpanel::Cookies = %{ Cpanel::Cookies::get_cookie_hashref() }; } } %Cpanel::Grapheme = %{ Cpanel::Locale->get_grapheme_helper_hashref() }; return 1; } sub makevar { return $_[0]->maketext( ref $_[1] ? @{ $_[1] } : @_[ 1 .. $#_ ] ); ## no extract maketext } *maketext = *Cpanel::CPAN::Locale::Maketext::maketext; ## no extract maketext my %singleton_stash = (); BEGIN { no warnings; ## no critic(ProhibitNoWarnings) CHECK { if ( ( $INC{'O.pm'} || $INC{'Cpanel/BinCheck.pm'} || $INC{'Cpanel/BinCheck/Lite.pm'} ) && %singleton_stash ) { die("If you use a locale at begin time, you are responsible for deleting it too. Try calling _reset_singleton_stash\n"); } } } sub _reset_singleton_stash { foreach my $class ( keys %singleton_stash ) { foreach my $args_sig ( keys %{ $singleton_stash{$class} } ) { $singleton_stash{$class}{$args_sig}->cpanel_detach_lexicon(); } } %singleton_stash = (); return 1; } sub get_handle { preinit(); no warnings 'redefine'; *get_handle = *_real_get_handle; goto &_real_get_handle; } sub _map_any_old_style_to_new_style { my (@locales) = @_; if ( grep { !$known_locales_character_orientation{$_} && index( $_, 'i_' ) != 0 } @locales ) { require Cpanel::Locale::Utils::Legacy; goto \&Cpanel::Locale::Utils::Legacy::map_any_old_style_to_new_style; } return @locales; } our $IN_REAL_GET_HANDLE = 0; sub _setup_for_real_get_handle { ## no critic qw(RequireArgUnpacking) if ($IN_REAL_GET_HANDLE) { _load_carp(); if ( $IN_REAL_GET_HANDLE > 1 ) { die 'Cpanel::Carp'->can('safe_longmess')->("Attempted to call _setup_for_real_get_handle from _setup_for_real_get_handle"); } warn 'Cpanel::Carp'->can('safe_longmess')->("Attempted to call _setup_for_real_get_handle from _setup_for_real_get_handle"); if ($Cpanel::Exception::IN_EXCEPTION_CREATION) { # PPI NO PARSE - Only care about this check if the module is loaded $Cpanel::Exception::LOCALIZE_STRINGS = 0; # PPI NO PARSE - Only care about this check if the module is loaded } } local $IN_REAL_GET_HANDLE = $IN_REAL_GET_HANDLE + 1; if ( defined $Cpanel::App::appname && defined $ENV{'REMOTE_USER'} ) { # PPI NO PARSE - Only care about this check if the module is loaded if ( $Cpanel::App::appname eq 'whostmgr' # PPI NO PARSE - Only care about this check if the module is loaded && $ENV{'REMOTE_USER'} ne 'root' ) { require Cpanel::Config::HasCpUserFile; if ( Cpanel::Config::HasCpUserFile::has_readable_cpuser_file( $ENV{'REMOTE_USER'} ) ) { require Cpanel::Config::LoadCpUserFile::CurrentUser; my $cpdata_ref = Cpanel::Config::LoadCpUserFile::CurrentUser::load( $ENV{'REMOTE_USER'} ); if ( scalar keys %{$cpdata_ref} ) { *Cpanel::CPDATA = $cpdata_ref; } } } } my ( $class, @langtags ) = ( $_[0], ( defined $_[1] ? _map_any_old_style_to_new_style( (@_)[ 1 .. $#_ ] ) : exists $Cpanel::Cookies{'session_locale'} && $Cpanel::Cookies{'session_locale'} ? _map_any_old_style_to_new_style( $Cpanel::Cookies{'session_locale'} ) : ( exists $Cpanel::CPDATA{'LOCALE'} && $Cpanel::CPDATA{'LOCALE'} ) ? ( $Cpanel::CPDATA{'LOCALE'} ) : ( exists $Cpanel::CPDATA{'LANG'} && $Cpanel::CPDATA{'LANG'} ) ? ( _map_any_old_style_to_new_style( $Cpanel::CPDATA{'LANG'} ) ) : ( get_server_locale() ) ) ); if ( !$Cpanel::Locale::CDB_File_Path ) { $Cpanel::Locale::CDB_File_Path = Cpanel::Locale::Utils::init_lexicon( 'en', \%Cpanel::Locale::Lexicon, \$Cpanel::Locale::VERSION, \$Cpanel::Locale::Encoding ); } _make_alias_if_needed( @langtags ? @langtags : 'en_us' ); return @langtags; } my %_made_aliases; sub _make_alias_if_needed { foreach my $tag ( grep { ( $_ eq 'en' || $_ eq 'i_default' || $_ eq 'en_us' ) && !$_made_aliases{$_} } ( 'en', @_ ) ) { Cpanel::Locale->make_alias( [$tag], 1 ); $_made_aliases{$tag} = 1; } return 0; } sub _real_get_handle { my ( $class, @arg_langtags ) = @_; my @langtags = _setup_for_real_get_handle( $class, @arg_langtags ); @langtags = map { my $l = $_; $l = 'en' if ( $l eq 'en_us' || $l eq 'i_default' ); $l } grep { $class->cpanel_is_valid_locale($_) } @langtags; @langtags = ('en') unless scalar @langtags; my $args_sig = join( ',', @langtags ) || 'no_args'; return ( ( defined $singleton_stash{$class}{$args_sig} && ++$singleton_stash{$class}{$args_sig}->{'_singleton_reused'} ) ? $singleton_stash{$class}{$args_sig} : ( $singleton_stash{$class}{$args_sig} = Cpanel::CPAN::Locale::Maketext::get_handle( $class, @langtags ) ) ); } sub get_non_singleton_handle { my ( $class, @arg_langtags ) = @_; my @langtags = _setup_for_real_get_handle( $class, @arg_langtags ); return Cpanel::CPAN::Locale::Maketext::get_handle( $class, @langtags ); } sub init { my ($lh) = @_; $lh->SUPER::init(); $lh->_initialize_unknown_phrase_logging(); $lh->_initialize_bracket_notation_whitelist(); return $lh; } sub _initialize_unknown_phrase_logging { my $lh = shift; if ( defined $Cpanel::Locale::Context::DEFAULT_OUTPUT_CONTEXT ) { # PPI NO PARSE - Only needed if loaded my $setter_cr = $lh->can("set_context_${Cpanel::Locale::Context::DEFAULT_OUTPUT_CONTEXT}") or do { # PPI NO PARSE - Only needed if loaded die "Invalid \$Cpanel::Locale::Context::DEFAULT_OUTPUT_CONTEXT: “$Cpanel::Locale::Context::DEFAULT_OUTPUT_CONTEXT”!"; # PPI NO PARSE - Only needed if loaded }; $setter_cr->($lh); } elsif ( defined $Cpanel::Carp::OUTPUT_FORMAT ) { # issafe if ( $Cpanel::Carp::OUTPUT_FORMAT eq 'xml' ) { # issafe $lh->set_context_plain(); # no HTML markup or ANSI escape sequences } elsif ( $Cpanel::Carp::OUTPUT_FORMAT eq 'html' ) { # issafe $lh->set_context_html(); # HTML } } $lh->{'use_external_lex_cache'} = 1; if ( exists $Cpanel::CPDATA{'LOCALE_LOG_MISSING'} && $Cpanel::CPDATA{'LOCALE_LOG_MISSING'} ) { $lh->{'_log_phantom_key'} = sub { my ( $lh, $key ) = @_; my $chain = ''; my $base_class = $lh->get_base_class(); foreach my $class ( $lh->get_language_class, $base_class ) { my $lex_path = $lh->get_cdb_file_path( $class eq $base_class ? 1 : 0 ); next if !$lex_path; $chain .= "\tLOCALE: $class\n\tPATH: $lex_path\n"; last if $class eq 'Cpanel::Locale::en' || $class eq 'Cpanel::Locale::en_us' || $class eq 'Cpanel::Locale::i_default'; } my $pkg = $lh->get_language_tag(); _logger->info( ( $Cpanel::Parser::Vars::file ? "$Cpanel::Parser::Vars::file ::" : '' ) . qq{ Could not find key via '$pkg' locale:\n\tKEY: '$key'\n$chain} ); # PPI NO PARSE -- module will already be there is we care about it }; } return $lh; } our @DEFAULT_WHITELIST = qw(quant asis output current_year list_and list_or comment boolean datetime local_datetime format_bytes get_locale_name get_user_locale_name is_defined is_future join list_and_quoted list_or_quoted numerate numf); sub _initialize_bracket_notation_whitelist { my $lh = shift; my @whitelist = @DEFAULT_WHITELIST; my $custom_whitelist_file = Cpanel::Locale::Utils::Paths::get_custom_whitelist_path(); if ( open( my $fh, '<', $custom_whitelist_file ) ) { while ( my $ln = readline($fh) ) { chomp $ln; push @whitelist, $ln if length($ln); } close $fh; } $lh->whitelist(@whitelist); return $lh; } sub output_cpanel_error { my ( $lh, $position ) = @_; if ( $lh->context_is_ansi() ) { return "\e[1;31m" if $position eq 'begin'; return "\e[0m" if $position eq 'end'; return ''; } elsif ( $lh->context_is_html() ) { return qq{

} if $position eq 'begin'; return '

' if $position eq 'end'; return ''; } else { return ''; # e.g. $lh->context_is_plain() } } sub cpanel_get_3rdparty_lang { my ( $lh, $_3rdparty ) = @_; require Cpanel::Locale::Utils::3rdparty; return Cpanel::Locale::Utils::3rdparty::get_app_setting( $lh, $_3rdparty ) || Cpanel::Locale::Utils::3rdparty::get_3rdparty_lang( $lh, $_3rdparty ) || $lh->get_language_tag() || 'en'; } sub cpanel_is_valid_locale { my ( $lh, $locale ) = @_; my %valid_locales = map { $_ => 1 } ( qw(en en_us i_default), $lh->list_available_locales ); return $valid_locales{$locale} ? 1 : 0; } sub cpanel_get_3rdparty_list { my ($lh) = @_; require Cpanel::Locale::Utils::3rdparty; return Cpanel::Locale::Utils::3rdparty::get_3rdparty_list($lh); } sub cpanel_get_lex_path { my ( $lh, $path, $rv ) = @_; return if !defined $path || $path eq '' || substr( $path, -3 ) ne '.js'; require Cpanel::JS::Variations; my $query = $path; $query = Cpanel::JS::Variations::get_base_file( $query, '-%s.js' ); if ( defined $rv && index( $rv, '%s' ) == -1 ) { substr( $rv, -3, 3, '-%s.js' ); } my $asset_path = $lh->get_asset_file( $query, $rv ); return $asset_path if $asset_path && substr( $asset_path, -3 ) eq '.js' && index( $asset_path, '-' ) > -1; # Only return a value if there is a localized js file here return; } sub tag_is_default_locale { my $tag = $_[1] || $_[0]->get_language_tag(); return 1 if $tag eq 'en' || $tag eq 'en_us' || $tag eq 'i_default'; return; } sub get_cdb_file_path { my ( $lh, $core ) = @_; my $class = $core ? $lh->get_base_class() : $lh->get_language_class(); no strict 'refs'; return $class eq 'Cpanel::Locale::en' || $class eq 'Cpanel::Locale::en_us' || $class eq 'Cpanel::Locale::i_default' ? $Cpanel::Locale::CDB_File_Path : ${ $class . '::CDB_File_Path' }; } sub _slurp_small_file_if_exists_no_exception { my ($path) = @_; local ( $!, $^E ); open my $rfh, '<', $path or do { if ( $! != _ENOENT() ) { warn "open($path): $!"; } return undef; }; read $rfh, my $buf, 8192 or do { warn "read($path): $!"; }; return $buf; } my $_server_locale_file_contents; sub get_server_locale { if ( exists $ENV{'CPANEL_SERVER_LOCALE'} ) { return $ENV{'CPANEL_SERVER_LOCALE'} if $ENV{'CPANEL_SERVER_LOCALE'} !~ tr{A-Za-z0-9_-}{}c; return undef; } if (%main::CPCONF) { return $main::CPCONF{'server_locale'} if exists $main::CPCONF{'server_locale'}; } return ( $_server_locale_file_contents //= ( _slurp_small_file_if_exists_no_exception($SERVER_LOCALE_FILE) || '' ) ); } sub _clear_cache { $_server_locale_file_contents = undef; return; } sub get_locale_for_user_cpanel { if (%main::CPCONF) { return $main::CPCONF{'cpanel_locale'} if exists $main::CPCONF{'cpanel_locale'}; return $main::CPCONF{'server_locale'} if exists $main::CPCONF{'server_locale'}; } require Cpanel::Config::LoadCpConf; my $cpconf = Cpanel::Config::LoadCpConf::loadcpconf_not_copy(); # safe since we do not modify cpconf return $cpconf->{'cpanel_locale'} if $cpconf->{'cpanel_locale'}; # will not be autovivified, 0 and "" are invalid, if the value is invalid they will get 'en' return $cpconf->{'server_locale'} if $cpconf->{'server_locale'}; # will not be autovivified, 0 and "" are invalid, if the value is invalid they will get 'en' return; } sub cpanel_reinit_lexicon { my ($lh) = @_; $lh->cpanel_detach_lexicon(); $lh->cpanel_attach_lexicon(); } my $detach_locale_lex; sub cpanel_detach_lexicon { my ($lh) = @_; my $locale = $lh->get_language_tag(); no strict 'refs'; undef $Cpanel::Locale::CDB_File_Path; if ( $locale ne 'en' && $locale ne 'en_us' && $locale ne 'i_default' ) { $detach_locale_lex = ${ 'Cpanel::Locale::' . $locale . '::CDB_File_Path' }; undef ${ 'Cpanel::Locale::' . $locale . '::CDB_File_Path' }; } untie( %{ 'Cpanel::Locale::' . $locale . '::Lexicon' } ); untie %Cpanel::Locale::Lexicon; } sub cpanel_attach_lexicon { my ($lh) = @_; my $locale = $lh->get_language_tag(); $Cpanel::Locale::CDB_File_Path = Cpanel::Locale::Utils::init_lexicon( 'en', \%Cpanel::Locale::Lexicon, \$Cpanel::Locale::VERSION, \$Cpanel::Locale::Encoding ); _make_alias_if_needed($locale); no strict 'refs'; if ( defined $detach_locale_lex ) { ${ 'Cpanel::Locale::' . $locale . '::CDB_File_Path' } = $detach_locale_lex; } else { ${ 'Cpanel::Locale::' . $locale . '::CDB_File_Path' } = $Cpanel::Locale::CDB_File_Path; } my $file_path = $lh->get_cdb_file_path(); return if !$file_path; return Cpanel::Locale::Utils::get_readonly_tie( $lh->get_cdb_file_path(), \%{ 'Cpanel::Locale::' . $locale . '::Lexicon' } ); } sub is_rtl { my ($lh) = @_; return 'right-to-left' eq $lh->get_language_tag_character_orientation() ? 1 : 0; } sub get_language_tag_character_orientation { if ( my $direction = $known_locales_character_orientation{ $_[1] || $_[0]->{'fallback_locale'} || $_[0]->get_language_tag() } ) { return 'right-to-left' if $direction == $RTL; return 'left-to-right'; } $_[0]->SUPER::get_language_tag_character_orientation( @_[ 1 .. $#_ ] ); } my $menu_ar; sub get_locale_menu_arrayref { return $menu_ar if $menu_ar; require Cpanel::Locale::Utils::Display; $menu_ar = [ Cpanel::Locale::Utils::Display::get_locale_menu_hashref(@_) ]; # always array context to get all structs, properly uses other args besides object return $menu_ar; } my $non_existent; sub get_non_existent_locale_menu_arrayref { return $non_existent if $non_existent; require Cpanel::Locale::Utils::Display; $non_existent = [ Cpanel::Locale::Utils::Display::get_non_existent_locale_menu_hashref(@_) ]; # always array context to get all structs, properly uses other args besides object return $non_existent; } sub _api1_maketext { require Cpanel::Locale::Utils::Api1; goto \&Cpanel::Locale::Utils::Api1::_api1_maketext; ## no extract maketext } our $api1 = { 'maketext' => { ## no extract maketext 'function' => \&_api1_maketext, ## no extract maketext 'internal' => 1, 'legacy_function' => 2, 'modify' => 'inherit', }, }; sub current_year { return (localtime)[5] + 1900; # we override datetime() so we can't use the internal current_year() } sub local_datetime { my ( $lh, $epoch, $format ) = @_; my $timezone = $ENV{'TZ'} // do { require Cpanel::Timezones; Cpanel::Timezones::calculate_TZ_env(); }; return $lh->datetime( $epoch, $format, $timezone ); } sub datetime { my ( $lh, $epoch, $format, $timezone ) = @_; require Cpanel::Locale::Utils::DateTime; if ( $epoch && $epoch =~ tr<0-9><>c ) { require # do not include it in updatenow.static Cpanel::Validate::Time; Cpanel::Validate::Time::iso_or_die($epoch); require Cpanel::Time::ISO; $epoch = Cpanel::Time::ISO::iso2unix($epoch); } return Cpanel::Locale::Utils::DateTime::datetime( $lh, $epoch, $format, $timezone ); } sub get_lookup_hash_of_multi_epoch_datetime { my ( $lh, $epochs_ar, $format, $timezone ) = @_; require Cpanel::Locale::Utils::DateTime; return Cpanel::Locale::Utils::DateTime::get_lookup_hash_of_multi_epoch_datetime( $lh, $epochs_ar, $format, $timezone ); } sub get_locale_name_or_nothing { my ( $locale, $name, $in_locale_tongue ) = @_; $name ||= $locale->get_language_tag(); if ( index( $name, 'i_' ) == 0 ) { require Cpanel::DataStore; my $i_locales_path = Cpanel::Locale::Utils::Paths::get_i_locales_config_path(); my $i_conf = Cpanel::DataStore::fetch_ref("$i_locales_path/$name.yaml"); return $i_conf->{'display_name'} if $i_conf->{'display_name'}; } else { my $real = $locale->get_language_tag_name( $name, $in_locale_tongue ); return $real if $real; } return; } sub get_locale_name_or_tag { return $_[0]->get_locale_name_or_nothing( $_[1], $_[2] ) || $_[1] || $_[0]->get_language_tag(); } *get_locale_name = *get_locale_name_or_tag; # for shorter BN sub get_user_locale { return $Cpanel::CPDATA{'LOCALE'} if $Cpanel::CPDATA{'LOCALE'}; require Cpanel::Locale::Utils::User; # probably a no-op but just in case since its loading is conditional return Cpanel::Locale::Utils::User::get_user_locale(); } sub get_user_locale_name { require Cpanel::Locale::Utils::User; # probably a no-op but just in case since its loading is conditional return $_[0]->get_locale_name_or_tag( Cpanel::Locale::Utils::User::get_user_locale( $_[1] ) ); } sub set_user_locale { my ( $locale, $country_code ) = @_; if ($country_code) { my $language_name = $locale->lang_names_hashref(); if ( exists $language_name->{$country_code} ) { require Cpanel::Locale::Utils::Legacy; require Cpanel::Locale::Utils::User::Modify; my $language = Cpanel::Locale::Utils::Legacy::get_best_guess_of_legacy_from_locale($country_code); if ( Cpanel::Locale::Utils::User::Modify::save_user_locale( $country_code, $language, $Cpanel::user ) ) { return 1; } } } die Cpanel::Exception::create_raw( "Empty", $locale->maketext("Unable to set locale, please specify a valid country code.") ); } sub get_locales { my $locale = shift; my @listing; my ( $names, $local_names ) = $locale->lang_names_hashref(); foreach ( keys %{$names} ) { push @listing, { locale => $_, name => $names->{$_}, local_name => $local_names->{$_}, direction => ( !defined $known_locales_character_orientation{$_} || $known_locales_character_orientation{$_} == $LTR ) ? 'ltr' : 'rtl' }; } return \@listing; } my $api2_lh; sub api2_get_user_locale { $api2_lh ||= Cpanel::Locale->get_handle(); return ( { 'locale' => $api2_lh->get_user_locale() } ); } sub api2_get_user_locale_name { $api2_lh ||= Cpanel::Locale->get_handle(); return ( { 'name' => $api2_lh->get_user_locale_name() } ); } sub api2_get_locale_name { $api2_lh ||= Cpanel::Locale->get_handle(); my $tag = ( scalar @_ > 2 ) ? {@_}->{'locale'} : $_[1]; return ( { 'name' => $api2_lh->get_locale_name_or_tag($tag) } ); } sub api2_get_encoding { $api2_lh ||= Cpanel::Locale->get_handle(); return ( { 'encoding' => $api2_lh->encoding() } ); } sub api2_numf { my %args = @_; $api2_lh ||= Cpanel::Locale->get_handle(); return ( { 'numf' => $api2_lh->numf( $args{number}, $args{max_decimal_places} ) } ); } sub api2_get_html_dir_attr { $api2_lh ||= Cpanel::Locale->get_handle(); return ( { 'dir' => $api2_lh->get_html_dir_attr() } ); } my $allow_demo = { allow_demo => 1 }; our %API = ( get_locale_name => $allow_demo, get_encoding => $allow_demo, get_html_dir_attr => $allow_demo, get_user_locale => $allow_demo, get_user_locale_name => $allow_demo, numf => $allow_demo, ); sub api2 { my ($func) = @_; return { %{ $API{$func} } } if $API{$func}; return; } my $global_lh; sub lh { return ( $global_lh ||= Cpanel::Locale->get_handle() ); } sub import { my ( $package, @args ) = @_; my ($namespace) = caller; if ( @args == 1 && $args[0] eq 'lh' ) { no strict 'refs'; ## no critic(ProhibitNoStrict) my $exported_name = "${namespace}::lh"; *$exported_name = \*lh; } } sub _load_carp { if ( !$INC{'Cpanel/Carp.pm'} ) { local $@; eval 'require Cpanel::Carp; 1;' or die $@; # hide from perlcc } return; } sub user_feedback_text_for_more_locales { require Cpanel::Version; my $locale = Cpanel::Locale->get_handle(); my $version = Cpanel::Version::get_version_full(); my $survey_url = 'https://cpanel.typeform.com/changeLng?utm_source=cpanel-changelanguage&cpanel_productversion=' . $version; return $locale->maketext( "Don’t see your language of choice? Take our [output,url,_1,Language Support Feedback Survey,class,externalLink,target,Language Survey] to let us know your preferences.", $survey_url ); } 1; } # --- END Cpanel/Locale.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; use Socket (); # use Cpanel::Sys::Uname (); 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/Sys/Hostname.pm package Cpanel::Sys::Hostname; use strict; use warnings; our $VERSION = 2.0; # use Cpanel::Sys::Uname (); 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; # use Cpanel::Sys::Hostname (); our $VERSION = 2.0; { no warnings 'once'; *gethostname = *Cpanel::Sys::Hostname::gethostname; *shorthostname = *Cpanel::Sys::Hostname::shorthostname; } 1; } # --- END Cpanel/Hostname.pm { # --- BEGIN Cpanel/Config/CpConfGuard/CORE.pm package Cpanel::Config::CpConfGuard::CORE; use strict; use warnings; # use Cpanel::ConfigFiles (); # use Cpanel::Debug (); # use Cpanel::FileUtils::Write::JSON::Lazy (); # use Cpanel::LoadModule (); # use Cpanel::Config::CpConfGuard (); our $SENDING_MISSING_FILE_NOTICE = 0; my $FILESYS_PERMS = 0644; sub find_missing_keys { my ($self) = @_; _verify_called_as_object_method($self); Cpanel::LoadModule::load_perl_module('Cpanel::Config::CpConfGuard::Default'); my $default = 'Cpanel::Config::CpConfGuard::Default'->new( current_config => $self->{data}, current_changes => $self->{changes}, ); if ( $self->{'is_missing'} ) { if ( UNIVERSAL::isa( $self->{'cache'}, 'HASH' ) && %{ $self->{'cache'} } ) { $self->{'data'} = {}; %{ $self->{'data'} } = %{ $self->{'cache'} }; my $config = $self->{'data'}; foreach my $key ( $default->get_keys() ) { next if exists $config->{$key}; $config->{$key} = $default->get_default_for($key); } } else { $self->{'data'} = $default->get_all_defaults(); } $self->{'modified'} = 1; # Mark as save needed. return; } my $cache = $self->{'cache'}; undef( $self->{'cache'} ); # we do not need the cache after the first pass my $config = $self->{'data'}; my $changes = $self->{'changes'}; # used for notifications $config->{'tweak_unset_vars'} ||= ''; foreach my $key ( $default->get_keys() ) { next if exists $config->{$key}; $self->{'modified'} = 1; # Mark as save needed. if ( exists $cache->{$key} ) { $config->{$key} = $cache->{$key}; $changes->{'from_cache'} ||= []; push @{ $changes->{'from_cache'} }, $key; $changes->{'changed_keys'} ||= {}; $changes->{'changed_keys'}{$key} = 'from_cache'; next; } my $changes_type = $default->is_dynamic($key) ? 'from_dynamic' : 'from_default'; $changes->{'changed_keys'} ||= {}; $changes->{'changed_keys'}{$key} = $changes_type; $changes->{$changes_type} ||= []; push @{ $changes->{$changes_type} }, $key; $config->{$key} = $default->get_default_for($key); } foreach my $key ( @{ $default->dead_variables() } ) { next unless exists $config->{$key}; $self->{'modified'} = 1; # Mark as save needed. delete( $config->{$key} ); $changes->{'dead_variable'} ||= []; push @{ $changes->{'dead_variable'} }, $key; } return; } sub validate_keys { my ($self) = @_; _verify_called_as_object_method($self); Cpanel::LoadModule::load_perl_module('Cpanel::Config::CpConfGuard::Validate'); my $invalid = 'Cpanel::Config::CpConfGuard::Validate'->can('patch_cfg')->( $self->{'data'} ); if (%$invalid) { $self->{modified} = 1; $self->{'changes'}->{'invalid'} = $invalid; } return; } sub notify_and_save_if_changed { my ($self) = @_; _verify_called_as_object_method($self); return if !$self->{'use_lock'}; return if !$self->{'modified'}; my $config = $self->{'data'}; if ( $ENV{'CPANEL_BASE_INSTALL'} ) { ; # Do nothing for notification. } elsif ( $self->{'is_missing'} ) { $config->{'tweak_unset_vars'} = ''; Cpanel::Debug::log_warn("Missing cpanel.config regenerating …"); $self->notify_missing_file; } elsif ( %{ $self->{'changes'} } ) { my $changes = $self->{'changes'}; my %uniq = map { $_ => 1 } @{ $changes->{'from_default'} || [] }, @{ $changes->{'from_dynamic'} || [] }, split( /\s*,\s*/, $config->{'tweak_unset_vars'} ); $config->{'tweak_unset_vars'} = join ",", sort keys %uniq; $self->log_missing_values(); } return $self->save( keep_lock => 1 ); } sub _server_locale { my ($self) = @_; _verify_called_as_object_method($self); my $locale_name = $self->{'data'}->{'server_locale'} || 'en'; require Cpanel::Locale; return Cpanel::Locale->_real_get_handle($locale_name); } sub _longest { my @array = @_; return length( ( sort { length $b <=> length $a } @array )[0] ); } sub _stringify_undef { my $value = shift; return defined $value ? $value : ''; } sub log_missing_values { my ($self) = @_; require Cpanel::Hostname; my $changes = $self->{'changes'}; my $locale = $self->_server_locale(); my $hostname = Cpanel::Hostname::gethostname(); my $prev = $locale->set_context_plain(); my $message = ''; $message .= $locale->maketext( 'One or more key settings for “[_1]” were either not found in [asis,cPanel amp() WHM]’s server configuration file ([_2]), or were present but did not pass validation.', $hostname, $self->{'path'} ) . "\n"; if ( $changes->{'from_dynamic'} ) { $message .= $locale->maketext('The following settings were absent and have been selected based on the current state of your installation.'); $message .= "\n"; my @keys = @{ $changes->{'from_dynamic'} }; my $max_len = _longest(@keys) + 2; foreach my $key (@keys) { $message .= sprintf( " %-${max_len}s= %s\n", $key, _stringify_undef( $self->{'data'}->{$key} ) ); } $message .= "\n"; } if ( $changes->{'from_cache'} ) { $message .= $locale->maketext('The following settings were absent, but were restored from your [asis,cpanel.config.cache] file:'); $message .= "\n"; my @keys = @{ $changes->{'from_cache'} }; my $max_len = _longest(@keys) + 2; foreach my $key (@keys) { $message .= sprintf( " %-${max_len}s= %s\n", $key, _stringify_undef( $self->{'data'}->{$key} ) ); } $message .= "\n"; } if ( $changes->{'from_default'} or $changes->{'invalid'} ) { $message .= $locale->maketext('The following settings were absent or invalid. Your server has copied the defaults for them from the configuration defaults file ([asis,/usr/local/cpanel/etc/cpanel.config]).'); $message .= "\n"; if ( $changes->{'from_default'} ) { my @keys = @{ $changes->{'from_default'} }; my $max_len = _longest(@keys) + 2; foreach my $key (@keys) { $message .= sprintf( " %-${max_len}s= %s\n", $key, _stringify_undef( $self->{'data'}->{$key} ) ); } } if ( $changes->{'invalid'} ) { my $invalid = $changes->{'invalid'}; my @keys = keys %$invalid; my $max_len = _longest(@keys) + 2; foreach my $key (@keys) { $message .= sprintf( " %-${max_len}s= %s (Previously set to '%s')\n", $key, _stringify_undef( $invalid->{$key}->{'to'} ), _stringify_undef( $invalid->{$key}->{'from'} ) ); } } $message .= "\n"; } if ( $changes->{'dead_variable'} ) { $message .= $locale->maketext('The following settings are obsolete and have been removed from the server configuration file:'); $message .= "\n"; $message .= ' ' . join( ', ', @{ $changes->{'dead_variable'} } ); $message .= "\n\n"; } $message .= $locale->maketext( 'Read the [asis,cpanel.config] file [output,url,_1,documentation] for important information about this file.', 'https://go.cpanel.net/cpconfig' ); $message .= "\n\n"; Cpanel::Debug::logger(); # initialize the logger local $Cpanel::Logger::ENABLE_BACKTRACE = 0; foreach my $chunk ( split( /\n+/, $message ) ) { Cpanel::Debug::log_warn($chunk); } $locale->set_context($prev); return; } sub notify_missing_file { my ($self) = @_; if ($SENDING_MISSING_FILE_NOTICE) { return; #Already sending notification, don't double up } require Cpanel::Hostname; local $SENDING_MISSING_FILE_NOTICE = 1; my $locale = $self->_server_locale(); my $prev = $locale->set_context_plain(); my @to_log; my %critical_values; my $hostname = Cpanel::Hostname::gethostname(); push @to_log, $locale->maketext('Your server has copied the defaults from your cache and the configuration defaults file ([asis,/usr/local/cpanel/etc/cpanel.config]) to [asis,/var/cpanel/cpanel.config], and it has generated the following critical values:'); Cpanel::LoadModule::load_perl_module('Cpanel::Config::CpConfGuard::Default'); my $critical = Cpanel::Config::CpConfGuard::Default::critical_values(); my $max_len = _longest(@$critical) + 2; my $critical_value; foreach my $key ( sort @$critical ) { $critical_value = _stringify_undef( $self->{'data'}->{$key} ); $critical_values{$key} = $critical_value; push @to_log, sprintf( " %-${max_len}s= %s\n", $key, $critical_value ); } push @to_log, $locale->maketext( 'Read the [asis,cpanel.config] file [output,url,_1,documentation] for more information about this file.', 'https://go.cpanel.net/cpconfig' ) . ' '; Cpanel::Debug::logger(); # initialize the logger local $Cpanel::Logger::ENABLE_BACKTRACE = 0; foreach my $chunk (@to_log) { chomp $chunk; Cpanel::Debug::log_warn($chunk); } _icontact( \%critical_values ); $locale->set_context($prev); return; } sub _icontact { my $critical_values = shift; Cpanel::LoadModule::load_perl_module("Cpanel::iContact::Class::Config::CpConfGuard"); Cpanel::LoadModule::load_perl_module('Cpanel::Notify'); 'Cpanel::Notify'->can('notification_class')->( 'class' => 'Config::CpConfGuard', 'application' => 'Config::CpConfGuard', 'constructor_args' => [ 'origin' => 'cpanel.config', 'critical_values' => $critical_values, ] ); return; } sub save { my ( $self, %opts ) = @_; _verify_called_as_object_method($self); return unless ( $self->{'use_lock'} ); return if ( $] > 5.007 && $] < 5.014 ); return 1 if $Cpanel::Config::CpConfGuard::memory_only; if ( !$self->{'rw'} ) { Cpanel::LoadModule::load_perl_module('Cpanel::SafeFile'); $self->{'fh'} = 'Cpanel::SafeFile'->can('safereopen')->( $self->{'fh'}, '+>', $Cpanel::ConfigFiles::cpanel_config_file ); return $self->abort('Cannot reopen file for rw') unless $self->{'fh'}; $self->{'rw'} = 1; } return $self->abort('Locked in parent, cannot save') if $self->{'pid'} != $$; return $self->abort('hash reference required') if !UNIVERSAL::isa( $self->{'data'}, 'HASH' ); Cpanel::LoadModule::load_perl_module('Cpanel::Config::FlushConfig'); Cpanel::LoadModule::load_perl_module('Cpanel::Config::SaveCpConf'); 'Cpanel::Config::FlushConfig'->can('flushConfig')->( $self->{'fh'}, $self->{'data'}, '=', 'Cpanel::Config::SaveCpConf'->can('header_message')->(), { sort => 1, perms => $FILESYS_PERMS, }, ); %{$Cpanel::Config::CpConfGuard::MEM_CACHE} = %{ $self->{'data'} }; return 1 if $opts{keep_lock}; $self->release_lock; return 1; } sub _update_cache { my ($self) = @_; _verify_called_as_object_method($self); return 0 if Cpanel::Config::CpConfGuard::_cache_is_valid() && $self->{'cache_is_valid'}; # Don't re-write the file if it looks correct. $Cpanel::Config::CpConfGuard::MEM_CACHE_CPANEL_CONFIG_MTIME = ( stat($Cpanel::ConfigFiles::cpanel_config_file) )[9] || 0; return unless $self->{'use_lock'}; # never update the cache when not root local $@; my $ok = eval { Cpanel::FileUtils::Write::JSON::Lazy::write_file( $Cpanel::ConfigFiles::cpanel_config_cache_file, $Cpanel::Config::CpConfGuard::MEM_CACHE, $FILESYS_PERMS ) || 0 }; if ( !$ok ) { if ( !defined $ok ) { Cpanel::Debug::log_warn("Cannot update cache file: $Cpanel::ConfigFiles::cpanel_config_cache_file $@"); unlink $Cpanel::ConfigFiles::cpanel_config_cache_file; return -1; } return; } my $past = ( stat($Cpanel::ConfigFiles::cpanel_config_cache_file) )[9] - 1; return _adjust_timestamp_for( $Cpanel::ConfigFiles::cpanel_config_file => $past ); } sub _adjust_timestamp_for { my ( $f, $time ) = @_; return unless defined $f && defined $time; return 1 if utime( $time, $time, $f ); my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime($time); my $stamp = sprintf( "%04d%02d%02d%02d%02d.%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec ); unless ( _touch( $f => $stamp ) ) { Cpanel::Debug::log_warn("Cannot update mtime on $f: $@"); return; } return 1; } sub _touch { # mainly created to easily mock that part during the tests my ( $f, $stamp ) = @_; return system( 'touch', '-t', $stamp, $f ) == 0 ? 1 : 0; } sub _verify_called_as_object_method { if ( ref( $_[0] ) ne "Cpanel::Config::CpConfGuard" ) { die '' . ( caller(0) )[3] . " was not called as an object method [" . ref( $_[0] ) . "]\n"; } return; } sub abort { my ( $self, $msg ) = @_; _verify_called_as_object_method($self); if ( $self->{'pid'} != $$ ) { Cpanel::Debug::log_die('Locked in parent, cannot release lock'); return; } $self->release_lock(); Cpanel::Debug::log_die($msg) if $msg; return 1; } sub set { my ( $self, $k, $v ) = @_; _verify_called_as_object_method($self); return unless defined $k; my $config = $self->{'data'}; $config->{$k} = $v; if ( $config->{'tweak_unset_vars'} && index( $config->{'tweak_unset_vars'}, $k ) > -1 ) { my %unset = map { ( $_ => 1 ) } split( /\s*,\s*/, $config->{'tweak_unset_vars'} ); delete( $unset{$k} ); $config->{'tweak_unset_vars'} = join( ',', sort keys %unset ); } return 1; } 1; } # --- END Cpanel/Config/CpConfGuard/CORE.pm { # --- BEGIN Cpanel/Config/CpConfGuard.pm package Cpanel::Config::CpConfGuard; use strict; use warnings; # use Cpanel::JSON::FailOK (); # use Cpanel::ConfigFiles (); # use Cpanel::Debug (); # use Cpanel::Destruct (); use constant { _ENOENT => 2, }; our $IN_LOAD = 0; our $SENDING_MISSING_FILE_NOTICE = 0; my $FILESYS_PERMS = 0644; my $is_daemon; BEGIN { $is_daemon = 0; # initialize the value in the begin block if ( index( $0, 'updatenow' ) > -1 || index( $0, 'cpsrvd' ) > -1 || index( $0, 'cpdavd' ) > -1 || index( $0, 'queueprocd' ) > -1 || index( $0, 'tailwatchd' ) > -1 || index( $0, 'cpanellogd' ) > -1 || ( length $0 > 7 && substr( $0, -7 ) eq '.static' ) ) { $is_daemon = 1; } } my $module_file; our ( $MEM_CACHE_CPANEL_CONFIG_MTIME, $MEM_CACHE ) = ( 0, undef ); our $memory_only; sub _is_daemon { $is_daemon }; # for testing sub clearcache { $MEM_CACHE_CPANEL_CONFIG_MTIME = 0; $MEM_CACHE = undef; return; } sub new { my ( $class, %opts ) = @_; Cpanel::JSON::FailOK::LoadJSONModule() if !$is_daemon && !$INC{'Cpanel/JSON.pm'}; my $self = bless { %opts, # to be improved 'path' => $Cpanel::ConfigFiles::cpanel_config_file, 'pid' => $$, 'modified' => 0, 'changes' => {}, }, $class; $self->{'use_lock'} //= ( $> == 0 ) ? 1 : 0; if ($memory_only) { $self->{'data'} = ref($memory_only) eq 'HASH' ? $memory_only : {}; return $self; } ( $self->{'cache'}, $self->{'cache_is_valid'} ) = get_cache(); return $self if $self->{'loadcpconf'} && $self->{'cache_is_valid'}; $self->load_cpconf_file(); return $self if $is_daemon || $opts{'no_validate'} || !$self->{'use_lock'}; $self->find_missing_keys(); $self->validate_keys(); $self->notify_and_save_if_changed(); return $self; } sub set { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::set; } sub config_copy { my ($self) = @_; _verify_called_as_object_method($self); my $config = $self->{'data'} || $self->{'cache'} || {}; return {%$config}; } sub find_missing_keys { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::find_missing_keys; } sub validate_keys { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::validate_keys; } sub notify_and_save_if_changed { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::notify_and_save_if_changed; } sub log_missing_values { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::log_missing_values; } sub notify_missing_file { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::notify_missing_file; } sub save { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::save; } sub release_lock { my ($self) = @_; _verify_called_as_object_method($self); return unless $self->{'use_lock'} && defined $self->{'pid'} && $self->{'pid'} eq $$ && $self->{'lock'}; require Cpanel::SafeFile; Cpanel::SafeFile::safeclose( $self->{'fh'}, $self->{'lock'}, sub { return $self->_update_cache() } ); $self->{'fh'} = $self->{'lock'} = undef; $self->{'is_locked'} = 0; return; } sub abort { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::abort; } sub _update_cache { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::_update_cache; } sub _server_locale { require Cpanel::Config::CpConfGuard::CORE; goto \&Cpanel::Config::CpConfGuard::CORE::_server_locale; } sub get_cache { my $cpanel_config_mtime = ( stat($Cpanel::ConfigFiles::cpanel_config_file) )[9] || 0; my $verbose = ( defined $Cpanel::Debug::level ? $Cpanel::Debug::level : 0 ) >= 5; if ( $MEM_CACHE && ref($MEM_CACHE) eq 'HASH' && $cpanel_config_mtime && $cpanel_config_mtime == $MEM_CACHE_CPANEL_CONFIG_MTIME ) { Cpanel::Debug::log_info("loadcpconf memory cache hit") if $verbose; return ( $MEM_CACHE, 1 ); } clearcache(); # Invalidate the memory cache. Cpanel::Debug::log_info("loadcpconf memory cache miss") if $verbose; my $mtime_before_read; if ( !$INC{'Cpanel/JSON.pm'} ) { Cpanel::Debug::log_info("Cpanel::JSON not loaded. Skipping cache load.") if $verbose; return ( undef, 0 ); } elsif ( -e $Cpanel::ConfigFiles::cpanel_config_cache_file ) { # No need to do -r (costs 5 additional syscalls) since we write this 0644 $mtime_before_read = ( stat _ )[9] || 0; } else { Cpanel::Debug::log_info("The cache file “$Cpanel::ConfigFiles::cpanel_config_cache_file” could not be read. Skipping cache load.") if $verbose; return ( undef, 0 ); } my ( $mtime_after_read, $cpconf_ref ) = (0); my $loop_count = 0; while ( $mtime_after_read != $mtime_before_read && $loop_count++ < 10 ) { sleep 1 if ( $mtime_after_read == time ); # If it was just written to, give it a second in case it's being written to. Cpanel::Debug::log_info( "loadcpconf cache_filesys_mtime = $mtime_before_read , filesys_mtime: $cpanel_config_mtime , memory_mtime: $MEM_CACHE_CPANEL_CONFIG_MTIME , now: " . time ) if $verbose; $cpconf_ref = Cpanel::JSON::FailOK::LoadFile($Cpanel::ConfigFiles::cpanel_config_cache_file); $mtime_after_read = ( stat($Cpanel::ConfigFiles::cpanel_config_cache_file) )[9] || 0; sleep 1 if ( $mtime_after_read != $mtime_before_read ); } if ( $cpconf_ref && scalar keys %{$cpconf_ref} ) { if ( _cache_is_valid( $cpanel_config_mtime, $mtime_after_read ) ) { Cpanel::Debug::log_info("loadcpconf file system cache hit") if $verbose; ( $MEM_CACHE, $MEM_CACHE_CPANEL_CONFIG_MTIME ) = ( $cpconf_ref, $cpanel_config_mtime ); return ( $cpconf_ref, 1 ); } Cpanel::Debug::log_info("loadcpconf cpanel.config.cache miss.") if $verbose; return ( $cpconf_ref, 0 ); } Cpanel::Debug::log_info("loadcpconf cpanel.config.cache miss.") if $verbose; return ( undef, 0 ); } sub _cache_is_valid { my ( $config_mtime, $cache_mtime ) = @_; $cache_mtime ||= ( stat($Cpanel::ConfigFiles::cpanel_config_cache_file) )[9] || 0; return 0 unless $cache_mtime; $config_mtime ||= ( stat($Cpanel::ConfigFiles::cpanel_config_file) )[9] || 0; return 0 unless $config_mtime; return ( $config_mtime + 1 == $cache_mtime ) ? 1 : 0; } sub load_cpconf_file { my ($self) = @_; if ($IN_LOAD) { require Cpanel::Carp; die Cpanel::Carp::safe_longmess("Load loop detected"); } local $IN_LOAD = 1; _verify_called_as_object_method($self); my $config = {}; my $config_file = $Cpanel::ConfigFiles::cpanel_config_file; $self->{'is_missing'} = ( -e $config_file ) ? 0 : 1; return if ( !$self->{'use_lock'} && $self->{'is_missing'} ); # We can't do anything if the file is missing and we're not root. ABORT! if ( $self->{'use_lock'} && $self->{'is_missing'} ) { if ( open( my $touch_fh, '>>', $config_file ) ) { print {$touch_fh} ''; close $touch_fh; chown 0, 0, $config_file; # avoid pulling in Cpanel::PwCache for memory reasons chmod 0644, $config_file; } } $self->{'rw'} = 0; $self->{'rw'} = 1 if ( $self->{'use_lock'} && !$self->{'cache_is_valid'} ); require Cpanel::Config::LoadConfig; my ( $ref, $fh, $conflock, $err ) = Cpanel::Config::LoadConfig::loadConfig( $Cpanel::ConfigFiles::cpanel_config_file, $config, (undef) x 4, { 'keep_locked_open' => !!$self->{'use_lock'}, 'nocache' => 1, 'rw' => $self->{'rw'}, 'allow_undef_values' => 1, }, ); if ( !$ref && !$fh && $! != _ENOENT() ) { $err ||= '(unknown error)'; require Cpanel::Carp; die Cpanel::Carp::safe_longmess("Can’t read “$Cpanel::ConfigFiles::cpanel_config_file” ($err)"); } $self->{'fh'} = $fh; $self->{'lock'} = $conflock; $self->{'data'} = $config; if ( $self->{'use_lock'} ) { Cpanel::Debug::log_warn("Failed to establish lock on $Cpanel::ConfigFiles::cpanel_config_file") unless $self->{'lock'}; Cpanel::Debug::log_warn("Failed to get file handle for $Cpanel::ConfigFiles::cpanel_config_file") unless $self->{'fh'}; } $self->{'is_locked'} = defined $self->{'lock'} ? 1 : 0; # alias for external usage if ( !$MEM_CACHE ) { $MEM_CACHE = {}; %$MEM_CACHE = %$config; } return; } sub _verify_called_as_object_method { if ( ref( $_[0] ) ne __PACKAGE__ ) { die '' . ( caller(0) )[3] . " was not called as an object method [" . ref( $_[0] ) . "]\n"; } return; } sub DESTROY { ## no critic(RequireArgUnpacking) return 1 if ( $> || $memory_only ); # Special modes we don't or won't write to cpanel.config files. return 2 if ( !$_[0] || !keys %{ $_[0] } ); # Nothing to cleanup if we're just a blessed empty hash. return if !$_[0]->{'lock'}; return if Cpanel::Destruct::in_dangerous_global_destruction(); $_[0]->release_lock(); # Close the file so we can update the cache properly. return; } 1; } # --- END Cpanel/Config/CpConfGuard.pm { # --- BEGIN Cpanel/Config/LoadCpConf.pm package Cpanel::Config::LoadCpConf; use strict; use warnings; # use Cpanel::Config::CpConfGuard (); sub loadcpconf { my $cpconf = Cpanel::Config::CpConfGuard->new( 'loadcpconf' => 1 )->config_copy; return wantarray ? %$cpconf : $cpconf; } sub loadcpconf_not_copy { if ( !defined $Cpanel::Config::CpConfGuard::memory_only && $Cpanel::Config::CpConfGuard::MEM_CACHE_CPANEL_CONFIG_MTIME ) { my ( $cache, $cache_is_valid ) = Cpanel::Config::CpConfGuard::get_cache(); if ($cache_is_valid) { return wantarray ? %$cache : $cache; } } my $cpconf_obj = Cpanel::Config::CpConfGuard->new( 'loadcpconf' => 1 ); my $cpconf = $cpconf_obj->{'data'} || $cpconf_obj->{'cache'} || {}; return wantarray ? %$cpconf : $cpconf; } sub clearcache; *clearcache = *Cpanel::Config::CpConfGuard::clearcache; 1; } # --- END Cpanel/Config/LoadCpConf.pm { # --- BEGIN Cpanel/Maxmem.pm package Cpanel::Maxmem; use strict; use warnings; # use Cpanel::Config::LoadUserDomains::Count (); use constant _INITIAL_DEFAULT => 4096; sub _count_domains { return eval { Cpanel::Config::LoadUserDomains::Count::countuserdomains() } // 1; } sub minimum { return _INITIAL_DEFAULT() * ( 1 + int( _count_domains() / 10_000 ) ); } *default = *minimum; 1; } # --- END Cpanel/Maxmem.pm { # --- BEGIN Cpanel/OSSys/Bits.pm package Cpanel::OSSys::Bits; use strict; use warnings; our $MAX_32_BIT_SIGNED; our $MAX_32_BIT_UNSIGNED; our $MAX_64_BIT_SIGNED; our $MAX_64_BIT_UNSIGNED; our $MAX_NATIVE_SIGNED; our $MAX_NATIVE_UNSIGNED; sub getbits { return length( pack( 'l!', 1000 ) ) * 8; } BEGIN { $MAX_32_BIT_UNSIGNED = ( 1 << 32 ) - 1; $MAX_32_BIT_SIGNED = ( 1 << 31 ) - 1; $MAX_64_BIT_UNSIGNED = ~0; #true on both 32- and 64-bit systems $MAX_64_BIT_SIGNED = -1 >> 1; #true on both 32- and 64-bit systems if ( getbits() == 32 ) { $MAX_NATIVE_SIGNED = $MAX_32_BIT_SIGNED; $MAX_NATIVE_UNSIGNED = $MAX_32_BIT_UNSIGNED; } else { $MAX_NATIVE_SIGNED = $MAX_64_BIT_SIGNED; $MAX_NATIVE_UNSIGNED = $MAX_64_BIT_UNSIGNED; } } 1; } # --- END Cpanel/OSSys/Bits.pm { # --- BEGIN Cpanel/Sys/Rlimit.pm package Cpanel::Sys::Rlimit; use strict; use warnings; # use Cpanel::OSSys::Bits (); # use Cpanel::Pack (); # use Cpanel::Syscall (); my $SYS_getrlimit; my $SYS_setrlimit; our $RLIM_INFINITY; # denotes no limit on a resource our %RLIMITS = ( 'CPU' => 0, # CPU time limit in seconds. 'DATA' => 2, # The maximum size of the process's data segment 'CORE' => 4, # Maximum size of a core file 'RSS' => 5, # Specifies the limit (in pages) of the process's resident set 'NPROC' => 6, # The maximum number of processes 'NOFILE' => 7, # The maximum number of file descriptors 'AS' => 9, # The maximum size of the process's virtual memory 'FSIZE' => 1, 'STACK' => 3, 'MEMLOCK' => 8, 'LOCKS' => 10, 'SIGPENDING' => 11, 'MSGQUEUE' => 12, 'NICE' => 13, 'RTPRIO' => 14, 'RTTIME' => 15, ); BEGIN { $RLIM_INFINITY = $Cpanel::OSSys::Bits::MAX_NATIVE_UNSIGNED; } our $PACK_TEMPLATE = 'L!L!'; our @TEMPLATE = ( rlim_cur => 'L!', # unsigned long rlim_max => 'L!', # unsigned long ); sub getrlimit { my ($rlimit) = @_; local $!; die "getrlimit requires an rlimit constant" if !defined $rlimit; my $buffer = pack( $PACK_TEMPLATE, 0 ); my $rlimit_num = _rlimit_to_num($rlimit); Cpanel::Syscall::syscall( 'getrlimit', $rlimit_num, $buffer ); my $getrlimit_hr = Cpanel::Pack->new( \@TEMPLATE )->unpack_to_hashref($buffer); return ( $getrlimit_hr->{'rlim_cur'}, $getrlimit_hr->{'rlim_max'} ); } sub setrlimit { my ( $rlimit, $soft, $hard ) = @_; local $!; die "setrlimit requires an rlimit constant" if !defined $rlimit; die "setrlimit requires a soft limit" if !defined $soft; die "setrlimit requires a hard limit" if !defined $hard; my $buffer = pack( $PACK_TEMPLATE, $soft, $hard ); my $rlimit_num = _rlimit_to_num($rlimit); Cpanel::Syscall::syscall( 'setrlimit', $rlimit_num, $buffer ); return 1; } sub _rlimit_to_num { my ($rlimit) = @_; if ( length($rlimit) && $rlimit !~ tr<0-9><>c ) { return $rlimit; } elsif ( exists $RLIMITS{$rlimit} ) { return $RLIMITS{$rlimit}; } die "Unknown RLIMIT: $rlimit"; } 1; } # --- END Cpanel/Sys/Rlimit.pm { # --- BEGIN Cpanel/Rlimit.pm package Cpanel::Rlimit; use strict; # use Cpanel::Config::LoadCpConf (); # use Cpanel::Maxmem (); # use Cpanel::Sys::Rlimit (); sub set_rlimit { my ( $limit, $limit_names ) = @_; my ( $default_rlimit, $coredump_are_enabled ) = _get_server_setting_or_default(); $limit ||= $default_rlimit || $Cpanel::Sys::Rlimit::RLIM_INFINITY; $limit_names ||= [qw/RSS AS/]; my $core_limit = $coredump_are_enabled ? $limit : 0; if ( $limit > $Cpanel::Sys::Rlimit::RLIM_INFINITY ) { require Cpanel::Logger; Cpanel::Logger->new->warn("set_rlimit adjusted the requested limit of “$limit” to infinity because it exceeded the maximum allowed value."); $limit = $Cpanel::Sys::Rlimit::RLIM_INFINITY; } my $error = ''; foreach my $lim (@$limit_names) { local $@; eval { Cpanel::Sys::Rlimit::setrlimit( $lim, $limit, $limit ) } or do { my $limit_human_value = ( $limit == $Cpanel::Sys::Rlimit::RLIM_INFINITY ? 'INFINITY' : $limit ); $error .= "$$: Unable to set RLIMIT_$lim to $limit_human_value: $@\n"; } } local $@; eval { Cpanel::Sys::Rlimit::setrlimit( 'CORE', $core_limit, $core_limit ) } or $error .= "$$: Unable to set RLIMIT_CORE to $core_limit: $@\n"; if ($error) { $error =~ s/\n$//; require Cpanel::Logger; Cpanel::Logger->new->warn($error); return 0; } return 1; } sub set_min_rlimit { my ($min) = @_; my $error = ''; foreach my $lim (qw(RSS AS)) { my ( $current_soft, $current_hard ) = Cpanel::Sys::Rlimit::getrlimit($lim); if ( $current_soft < $min || $current_hard < $min ) { local $@; eval { Cpanel::Sys::Rlimit::setrlimit( $lim, $min, $min ) } or $error .= "$$: Unable to set RLIMIT_$lim to $min: $@\n"; } } if ($error) { $error =~ s/\n$//; require Cpanel::Logger; Cpanel::Logger->new->warn($error); return 0; } return 1; } sub get_current_rlimits { return { map { $_ => [ Cpanel::Sys::Rlimit::getrlimit($_) ] } (qw(RSS AS CORE)) }; } sub restore_rlimits { my $limit_hr = shift; my $error = ''; if ( ref $limit_hr eq 'HASH' ) { foreach my $resource_name ( keys %{$limit_hr} ) { my $values = $limit_hr->{$resource_name}; if ( ref $values ne 'ARRAY' || scalar @{$values} != 2 ) { $error .= "Invalid limit arguments, could not restore resource limit for $resource_name.\n"; next; } local $@; eval { Cpanel::Sys::Rlimit::setrlimit( $resource_name, $values->[0], $values->[1] ) } or $error .= "$$: Unable to set $resource_name to $values->[0] and $values->[1]: $@\n"; } } else { $error .= "Invalid arguments, could not restore resource limits.\n"; } if ($error) { $error =~ s/\n$//; require Cpanel::Logger; Cpanel::Logger->new->warn($error); return 0; } return 1; } sub set_rlimit_to_infinity { return set_rlimit($Cpanel::Sys::Rlimit::RLIM_INFINITY); } sub set_open_files_to_maximum { my $limit = 1048576; if ( open( my $fh, '<', '/proc/sys/fs/nr_open' ) ) { $limit = <$fh>; chomp($limit); close($fh); } return set_rlimit( $limit, [qw/NOFILE/] ); } sub _get_server_setting_or_default { my $cpconf = Cpanel::Config::LoadCpConf::loadcpconf_not_copy(); my $default_maxmem = Cpanel::Maxmem::default(); my $core_dumps_enabled = $cpconf->{'coredump'}; my $configured_maxmem = exists $cpconf->{'maxmem'} ? int( $cpconf->{'maxmem'} || 0 ) : $default_maxmem; if ( $configured_maxmem && $configured_maxmem < $default_maxmem ) { return ( _mebibytes_to_bytes($default_maxmem), $core_dumps_enabled ); } elsif ( $configured_maxmem == 0 ) { return ( $Cpanel::Sys::Rlimit::RLIM_INFINITY, $core_dumps_enabled ); } else { return ( _mebibytes_to_bytes($configured_maxmem), $core_dumps_enabled ); } } sub _mebibytes_to_bytes { my $mebibytes = shift; return ( $mebibytes * 1024**2 ); } 1; } # --- END Cpanel/Rlimit.pm package main; # cpanel - scripts/upcp Copyright 2022 cPanel, L.L.C. # All rights reserved. # copyright@cpanel.net http://cpanel.net # This code is subject to the cPanel license. Unauthorized copying is prohibited package scripts::upcp; BEGIN { unshift @INC, q{/usr/local/cpanel}; # if we are being called with a compile check flag ( perl -c ), skip the begin block # so we don't actually call upcp.static when just checking syntax and such is OK return if $^C; # static never gets --use-checked and should pass all the begin block checks return if $0 =~ /\.static$/; # let the '--use-check' instance compiled if ( grep { $_ eq '--use-check' } @ARGV ) { no warnings; # dynamic definition of the INIT block eval "INIT { exit(0); }"; return; } system("$0 --use-check >/dev/null 2>&1"); # compilation is ok with '--use-check', we will continue the non static version return if $? == 0; my $static = $0 . ".static"; if ( -f $static ) { print STDERR "We determined that $0 had compilation issues..\n"; print STDERR "Trying to exec $static " . join( ' ', @ARGV ) . "\n"; exec( $^X, $static, @ARGV ); } } use cPstrict; no warnings; ## no critic qw(ProhibitNoWarnings) use Try::Tiny; # use Cpanel::OS::All (); # PPI USE OK -- make sure Cpanel::OS is embedded # use Cpanel::HiRes ( preload => 'perl' ); # use Cpanel::Env (); # use Cpanel::Update::IsCron (); # use Cpanel::Update::Logger (); # use Cpanel::FileUtils::TouchFile (); # use Cpanel::LoadFile (); # use Cpanel::LoadModule (); # use Cpanel::Usage (); # use Cpanel::UPID (); use IO::Handle (); use POSIX (); # use Cpanel::Unix::PID::Tiny (); my $pidfile = '/var/run/upcp.pid'; my $lastlog = '/var/cpanel/updatelogs/last'; my $upcp_disallowed_path = '/root/.upcp_controlc_disallowed'; my $version_upgrade_file = '/usr/local/cpanel/upgrade_in_progress.txt'; our $logger; # Global for logger object. our $logfile_path; my $now; my $forced = 0; my $fromself = 0; my $sync_requested = 0; my $bg = 0; my $from_version; my $pbar_starting_point; exit( upcp() || 0 ) unless caller(); sub usage { print <&STDOUT" ) or die $!; local $| = 1; umask(0022); $now = time(); setupenv(); unset_rlimits(); ############################################################################# # Record the arguments used when started, check for certain flags my $update_is_available_exit_code = 42; my @retain_argv = @ARGV; foreach my $arg (@ARGV) { if ( $arg =~ m/^--log=(.*)/ ) { $logfile_path = $1; } elsif ( $arg eq '--fromself' ) { $fromself = 1; } elsif ( $arg eq '--force' ) { $forced = 1; $ENV{'FORCEDCPUPDATE'} = 1; } elsif ( $arg eq '--sync' ) { $sync_requested = 1; } elsif ( $arg eq '--bg' ) { $bg = 1; } } if ( $sync_requested && $forced ) { print "FATAL: --force and --sync are mutually exclusive commands.\n"; print " Force is designed to update your installed version, regardless of whether it's already up to date.\n"; print " Sync is designed to update the version already installed, regardless of what is available.\n"; return 1; } if ( $> != 0 ) { die "upcp must be run as root"; } ############################################################################# # Make sure easyapache isn't already running my $upid = Cpanel::Unix::PID::Tiny->new(); if ( $upid->is_pidfile_running('/var/run/easyapache.pid') ) { print "EasyApache is currently running. Please wait for EasyApache to complete before running cPanel Update (upcp).\n"; return 1; } ############################################################################# # Make sure we aren't already running && make sure everyone knows we are running my $curpid = $upid->get_pid_from_pidfile($pidfile) || 0; if ( $curpid && $curpid != $$ && !$fromself && -e '/var/cpanel/upcpcheck' ) { my $pidfile_mtime = ( stat($pidfile) )[9]; my $pidfile_age = ( time - $pidfile_mtime ); if ( $pidfile_age > 21600 ) { # Running for > 6 hours _logger()->warning("previous PID ($curpid) has been running more than 6 hours. Killing processes."); kill_upcp($curpid); # the pid_file_no_cleanup() will exit if it is still stuck after this sleep 1; # Give the process group time to die. } elsif ( my $logpath = _determine_logfile_path_if_running($curpid) ) { print _message_about_already_running( $curpid, $logpath ) . "\n"; return 1; } } if ( $curpid && $curpid != $$ && !$upid->is_pidfile_running($pidfile) ) { print "Stale PID file '$pidfile' (pid=$curpid)\n"; } if ( !$fromself && !$upid->pid_file_no_cleanup($pidfile) ) { print "process is already running\n"; return 1; } # to indicate re-entry into upcp $pbar_starting_point = $fromself ? 17 : 0; # record current version $from_version = fetch_cpanel_version(); ############################################################################# # Set up the upcp log directory and files setup_updatelogs(); ############################################################################# # Fork a child to the background. The child does all the heavy lifting and # logs to a file; the parent just watches, reads, and parses the log file, # displaying what it gets. # # Note that the parent reads the log in proper line-oriented -- and buffered! # -- fashion. An earlier version of this script did raw sysread() calls here, # and had to deal with all the mess that that entailed. The current approach # reaps all the benefits of Perl's and Linux's significant file read # optimizations without needing to re-invent any of them. The parent loop # below becomes lean, mean, and even elegant. # # Note in particular that we do not need to explicitly deal with an # end-of-file condition (other than avoiding using undefined data). For # exiting the read loop we merely need to test that the child has expired, # which in any case is the only situation that can cause an eof condition for # us on the file the child is writing. # # Note, too, that the open() needs to be inside this loop, in case the child # has not yet created the file. if ( !$fromself ) { # we need to be sure that log an pid are the current one when giving back the end unlink $lastlog if $bg; if ( my $updatepid = fork() ) { $logfile_path ||= _determine_logfile_path_if_running($updatepid); if ($logger) { # Close if logged about killing stale process. $logger->{'brief'} = 1; # Don't be chatty about closing $logger->close_log; } if ($bg) { print _message_about_newly_started( $updatepid, $logfile_path ) . "\n"; my $progress; select undef, undef, undef, .10; while ( !-e $lastlog ) { print '.'; select undef, undef, undef, .25; $progress = 1; } print "\n" if $progress; } else { monitor_upcp($updatepid); } return; } else { $logfile_path ||= _determine_logfile_path_if_running($$); } } local $0 = 'cPanel Update (upcp) - Slave'; open( my $RNULL, '<', '/dev/null' ) or die "Cannot open /dev/null: $!"; chdir '/'; _logger(); # Open the log file. ############################################################################# # Set CPANEL_IS_CRON env var based on detection algorithm my $cron_reason = set_cron_env(); $logger->info("Detected cron=$ENV{'CPANEL_IS_CRON'} ($cron_reason)"); my $set_cron_method = $ENV{'CPANEL_IS_CRON'} ? 'set_on' : 'set_off'; Cpanel::Update::IsCron->$set_cron_method(); my $openmax = POSIX::sysconf( POSIX::_SC_OPEN_MAX() ); if ( !$openmax ) { $openmax = 64; } foreach my $i ( 0 .. $openmax ) { POSIX::close($i) unless $i == fileno( $logger->{'fh'} ); } POSIX::setsid(); open( STDOUT, '>', '/dev/null' ) or warn $!; open( STDERR, '>', '/dev/null' ) or warn $!; $logger->update_pbar($pbar_starting_point); ############################################################################## # Symlink /var/cpanel/updatelogs/last to the current log file unlink $lastlog; symlink( $logfile_path, $lastlog ) or $logger->error("Could not symlink $lastlog: $!"); ############################################################################# # now that we have sporked: update our pidfile and ensure it is removed unlink $pidfile; # so that pid_file() won't see it as running. if ( !$upid->pid_file($pidfile) ) { # re-verifies (i.e. upcp was not also started after the unlink() and here) and sets up cleanup of $pidfile for sporked proc $logger->error("Could not update pidfile “$pidfile” with BG process: $!\n"); return 1; } # Assuming we didn't get re-executed from a upcp change after updatenow (!$fromself). # If the file is still there from a failed run, remove it. unlink($upcp_disallowed_path) if !$fromself && -f $upcp_disallowed_path; # make sure that the pid file is going to be removed when killed by a signal $SIG{INT} = $SIG{HUP} = $SIG{TERM} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars) unlink $pidfile; if ($logger) { $logger->close_log; $logger->open_log; $logger->error("User hit ^C or killed the process ( pid file '$pidfile' removed )."); $logger->close_log; } return; }; ############################################################################# # Get variables needed for update my $gotSigALRM = 0; my $connecttimeout = 30; my $liveconnect = 0; my $connectedhost = q{}; my @HOST_IPs = (); ## Case 46528: license checks moved to updatenow and Cpanel::Update::Blocker $logger->debug("Done getting update config variables.."); $logger->increment_pbar; ############################################################################# # Run the preupcp hook if ( -x '/usr/local/cpanel/scripts/preupcp' ) { $logger->info("Running /usr/local/cpanel/scripts/preupcp"); system '/usr/local/cpanel/scripts/preupcp'; } if ( -x '/usr/local/cpanel/scripts/hook' ) { $logger->info("Running Standardized hooks"); system '/usr/local/cpanel/scripts/hook', '--category=System', '--event=upcp', '--stage=pre'; } $logger->increment_pbar(); ############################################################################# # Check mtime on ourselves before sync # This is the target for a goto in the case that the remote TIERS file is # changed sometime during the execution of this upcp run. It prevents the # need for a new script argument and re-exec. STARTOVER: my $mtime = ( stat('/usr/local/cpanel/scripts/upcp') )[9]; $logger->info( "mtime on upcp is $mtime (" . scalar( localtime($mtime) ) . ")" ); # * If no fromself arg is passed, it's either the first run from crontab or called manually. # * --force is passed to updatenow, has no bearing on upcp itself. # * Even if upcp is changed 3 times in a row during an update (fastest builds ever?), we # would never actually update more than once unless the new upcp script changed the logic below if ( !$fromself ) { # run updatenow to sync everything # updatenow expects --upcp to be passed or will error out my @updatenow_args = ( '/usr/local/cpanel/scripts/updatenow', '--upcp', "--log=$logfile_path" ); # if --forced was received, pass it on to updatenow if ($forced) { push( @updatenow_args, '--force' ); } # if --sync was received, pass it on to updatenow. --force makes --sync meaningless. if ( !$forced && $sync_requested ) { push( @updatenow_args, '--sync' ); } # This is the point of no return, we are upgrading # and its no longer abortable. # set flag to disallow ^C during updatenow Cpanel::FileUtils::TouchFile::touchfile($upcp_disallowed_path) or $logger->warn("Failed to create: $upcp_disallowed_path: $!"); # call updatenow, if we get a non-zero status, die. my $exit_code = system(@updatenow_args); $logger->increment_pbar(15); if ( $exit_code != 0 ) { my $signal = $exit_code % 256; $exit_code = $exit_code >> 8; analyze_and_report_error( #success_msg => undef, error_msg => "Running `@updatenow_args` failed, exited with code $exit_code (signal = $signal)", type => 'upcp::UpdateNowFailed', exit_status => $exit_code, extra => [ 'signal' => $signal, 'updatenow_args' => \@updatenow_args, ], ); return ($exit_code); } # get the new mtime and compare it, if upcp changed, let's run ourselves again. # this should be a fairly rare occasion. my $newmtime = ( stat('/usr/local/cpanel/scripts/upcp') )[9]; if ( $newmtime ne $mtime ) { #----> Run our new self (and never come back). $logger->info("New upcp detected, restarting ourself"); $logger->close_log(); exec '/usr/local/cpanel/scripts/upcp', @retain_argv, '--fromself', "--log=$logfile_path"; } } ############################################################################# # Run the maintenance script my $last_logfile_position; my $save_last_logfile_position = sub { $last_logfile_position = int( qx{wc -l $logfile_path 2>/dev/null} || 0 ); }; $logger->close_log(); # Allow maintenance to write to the log $save_last_logfile_position->(); # remember how many lines has the logfile before starting the maintenance script my $exit_status; my $version_change_happened = -e $version_upgrade_file; if ($version_change_happened) { $exit_status = system( '/usr/local/cpanel/scripts/maintenance', '--pre', '--log=' . $logfile_path, '--pbar-start=20', '--pbar-stop=30' ); } else { $exit_status = system( '/usr/local/cpanel/scripts/maintenance', '--log=' . $logfile_path, '--pbar-start=20', '--pbar-stop=95' ); } $logger->open_log(); # Re-open the log now maintenance is done. analyze_and_report_error( success_msg => "Pre Maintenance completed successfully", error_msg => "Pre Maintenance ended, however it did not exit cleanly ($exit_status). Please check the logs for an indication of what happened", type => 'upcp::MaintenanceFailed', exit_status => $exit_status, logfile => $logfile_path, last_logfile_position => $last_logfile_position, ); # Run post-sync cleanup only if updatenow did a sync # Formerly run after layer2 did a sync. if ($version_change_happened) { # post_sync pbar range: 30%-55% $logger->close_log(); # Yield the log to post_sync_cleanup $save_last_logfile_position->(); # remember how many lines has the logfile before starting the post_sync_cleanup script my $post_exit_status = system( '/usr/local/cpanel/scripts/post_sync_cleanup', '--log=' . $logfile_path, '--pbar-start=30', '--pbar-stop=55' ); $logger->open_log; # reopen the log to continue writing messages analyze_and_report_error( success_msg => "Post-sync cleanup completed successfully", error_msg => "Post-sync cleanup has ended, however it did not exit cleanly. Please check the logs for an indication of what happened", type => 'upcp::PostSyncCleanupFailed', exit_status => $post_exit_status, logfile => $logfile_path, last_logfile_position => $last_logfile_position, ); unlink $version_upgrade_file; unlink($upcp_disallowed_path) if -f ($upcp_disallowed_path); # Maintenance pbar range: 55-95% $logger->close_log(); # Allow maintenance to write to the log $save_last_logfile_position->(); # remember how many lines has the logfile before starting the maintenance --post $exit_status = system( '/usr/local/cpanel/scripts/maintenance', '--post', '--log=' . $logfile_path, '--pbar-start=55', '--pbar-stop=95' ); $logger->open_log(); # Re-open the log now maintenance is done. analyze_and_report_error( success_msg => "Post Maintenance completed successfully", error_msg => "Post Maintenance ended, however it did not exit cleanly ($exit_status). Please check the logs for an indication of what happened", type => 'upcp::MaintenanceFailed', exit_status => $exit_status, logfile => $logfile_path, last_logfile_position => $last_logfile_position, ); # Check for new version... used when updating to next LTS version $logger->info("Polling updatenow to see if a newer version is available for upgrade"); $logger->close_log(); # Yield the log to updatenow my $update_available = system( '/usr/local/cpanel/scripts/updatenow', "--log=$logfile_path", '--checkremoteversion' ); $logger->open_log; # reopen the log to continue writing messages if ( !$sync_requested && $update_available && ( $update_available >> 8 ) == $update_is_available_exit_code ) { $logger->info("\n\n/!\\ - Next LTS version available, restarting upcp and updating system. /!\\\n\n"); $fromself = 0; goto STARTOVER; } } else { unlink($upcp_disallowed_path) if -f ($upcp_disallowed_path); } ############################################################################# # Run the post upcp hook $logger->update_pbar(95); if ( -x '/usr/local/cpanel/scripts/postupcp' ) { $logger->info("Running /usr/local/cpanel/scripts/postupcp"); system '/usr/local/cpanel/scripts/postupcp'; } if ( -x '/usr/local/cpanel/scripts/hook' ) { $logger->info("Running Standardized hooks"); system '/usr/local/cpanel/scripts/hook', '--category=System', '--event=upcp', '--stage=post'; } close($RNULL); ############################################################################# # All done. ############################################################################# $logger->update_pbar(100); $logger->info( "\n\n\tcPanel update completed\n\n", 1 ); $logger->info("A log of this update is available at $logfile_path\n\n"); # this happens on exit so it shouldn't be necessary $logger->info("Removing upcp pidfile"); unlink $pidfile if -f $pidfile || $logger->warn("Could not delete pidfile $pidfile : $!"); my $update_blocks_fname = '/var/cpanel/update_blocks.config'; if ( -s $update_blocks_fname ) { $logger->warning("NOTE: A system upgrade was not possible due to the following blockers:\n"); if ( open( my $blocks_fh, '<', $update_blocks_fname ) ) { while ( my $line = readline $blocks_fh ) { my ( $level, $message ) = split /,/, $line, 2; # Not using the level in the log, cause the logger can emit additional messages # on some of the levels used (fatal emits an 'email message', etc) # Remove URL from log output. Make sure message is defined. if ($message) { $message =~ s///ig; $message =~ s{}{}ig; } $logger->warning( uc("[$level]") . " - $message" ); } } else { $logger->warning("Unable to open blocks file! Please review '/var/cpanel/update_blocks.config' manually."); } } else { $logger->info("\n\nCompleted all updates\n\n"); } $logger->close_log(); return 0; } ############################################################################# ######[ Subroutines ]######################################################## ############################################################################# sub analyze_and_report_error { my %info = @_; my $type = $info{type} or die; my $exit_status = $info{exit_status}; if ( $exit_status == 0 ) { if ( defined $info{success_msg} ) { $logger->info( $info{success_msg} ); } return; } my $msg = $info{error_msg} or die; my @extra; if ( ref $info{extra} ) { @extra = @{ $info{extra} }; } my $logfile_content = Cpanel::LoadFile::loadfile_r($logfile_path); # add events to the end of the error log if ( try( sub { Cpanel::LoadModule::load_perl_module("Cpanel::Logs::ErrorEvents") } ) ) { my ($events) = Cpanel::Logs::ErrorEvents::extract_events_from_log( log => $logfile_content, after_line => $info{last_logfile_position} ); if ( $events && ref $events && scalar @$events ) { my $events_str = join ', ', map { qq["$_"] } @$events; $events_str = qq[The following events were logged: ${events_str}.]; $msg =~ s{(Please check)}{${events_str} $1} or $msg .= ' ' . $events_str; } } $logger->error( $msg, 1 ); if ( try( sub { Cpanel::LoadModule::load_perl_module("Cpanel::iContact::Class::$type") } ) ) { require Cpanel::Notify; Cpanel::Notify::notification_class( 'class' => $type, 'application' => $type, 'constructor_args' => [ 'exit_code' => $exit_status, 'events_after_line' => $info{last_logfile_position}, @extra, 'attach_files' => [ { 'name' => 'update_log.txt', 'content' => $logfile_content, 'number_of_preview_lines' => 25 } ] ] ); } elsif ( !try( sub { Cpanel::LoadModule::load_perl_module("Cpanel::iContact"); Cpanel::iContact::icontact( 'application' => 'upcp', 'subject' => 'cPanel & WHM update failure (upcp)', 'message' => $msg, ); } ) ) { $logger->error('Failed to send contact message'); } return 1; } ############################################################################# sub kill_upcp { my $pid = shift or die; my $status = shift || 'hanging'; my $msg = shift || "/usr/local/cpanel/scripts/upcp was running as pid '$pid' for longer than 6 hours. cPanel will kill this process and run a new upcp in its place."; # Attempt to notify admin of the kill. if ( try( sub { Cpanel::LoadModule::load_perl_module("Cpanel::iContact::Class::upcp::Killed") } ) ) { require Cpanel::Notify; Cpanel::Notify::notification_class( 'class' => 'upcp::Killed', 'application' => 'upcp::Killed', 'constructor_args' => [ 'upcp_path' => '/usr/local/cpanel/scripts/upcp', 'pid' => $pid, 'status' => $status, 'attach_files' => [ { 'name' => 'update_log.txt', 'content' => Cpanel::LoadFile::loadfile_r($logfile_path), 'number_of_preview_lines' => 25 } ] ] ); } else { try( sub { Cpanel::LoadModule::load_perl_module("Cpanel::iContact"); Cpanel::iContact::icontact( 'application' => 'upcp', 'subject' => "cPanel update $status", 'message' => $msg, ); } ); } print "Sending kill signal to process group for $pid\n"; kill -1, $pid; # Kill the process group for ( 1 .. 60 ) { print "Waiting for processes to die\n"; waitpid( $pid, POSIX::WNOHANG() ); last if ( !kill( 0, $pid ) ); sleep 1; } if ( kill( 0, $pid ) ) { print "Could not kill upcp nicely. Doing kill -9 $pid\n"; kill 9, $pid; } else { print "Done!\n"; } return; } ############################################################################# sub setupenv { Cpanel::Env::clean_env(); delete $ENV{'DOCUMENT_ROOT'}; delete $ENV{'SERVER_SOFTWARE'}; if ( $ENV{'WHM50'} ) { $ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1'; } ( $ENV{'USER'}, $ENV{'HOME'} ) = ( getpwuid($>) )[ 0, 7 ]; $ENV{'PATH'} .= ':/sbin:/usr/sbin:/usr/bin:/bin:/usr/local/bin'; $ENV{'LANG'} = 'C'; $ENV{'LC_ALL'} = 'C'; } sub unset_rlimits { # This is required if upcp started running from a pre-1132 eval { local $SIG{__DIE__}; require Cpanel::Rlimit; Cpanel::Rlimit::set_rlimit_to_infinity(); }; } ############################################################################# sub setup_updatelogs { return if ( -d '/var/cpanel/updatelogs' ); unlink('/var/cpanel/updatelogs'); mkdir( '/var/cpanel/updatelogs', 0700 ); } sub set_cron_env { # Do not override the env var if set. return 'env var CPANEL_IS_CRON was present before this process started.' if ( defined $ENV{'CPANEL_IS_CRON'} ); if ( grep { $_ eq '--cron' } @ARGV ) { $ENV{'CPANEL_IS_CRON'} = 1; return 'cron mode set from command line'; } if ( $ARGV[0] eq 'manual' ) { $ENV{'CPANEL_IS_CRON'} = 0; return 'manual flag passed on command line'; } if ($forced) { $ENV{'CPANEL_IS_CRON'} = 0; return '--force passed on command line'; } if ( -t STDOUT ) { $ENV{'CPANEL_IS_CRON'} = 0; return 'Terminal detected'; } if ( $ENV{'SSH_CLIENT'} ) { $ENV{'CPANEL_IS_CRON'} = 0; return 'SSH connection detected'; } # cron sets TERM=dumb if ( $ENV{'TERM'} eq 'dumb' ) { $ENV{'CPANEL_IS_CRON'} = 1; return 'TERM detected as set to dumb'; } # Check if parent is whostmgr if ( readlink( '/proc/' . getppid() . '/exe' ) =~ m/whostmgrd/ ) { $ENV{'CPANEL_IS_CRON'} = 0; return 'parent process is whostmgrd'; } # Default to cron enabled. $ENV{'CPANEL_IS_CRON'} = 1; return 'default'; } ############################################################################# sub fetch_cpanel_version { my $version; my $version_file = '/usr/local/cpanel/version'; return if !-f $version_file; my $fh; local $/ = undef; return if !open $fh, '<', $version_file; $version = <$fh>; close $fh; $version =~ s/^\s+|\s+$//gs; return $version; } ############################################################################# sub monitor_upcp { my $updatepid = shift or die; $0 = 'cPanel Update (upcp) - Master'; $SIG{INT} = $SIG{TERM} = sub { print "User hit ^C\n"; if ( -f $upcp_disallowed_path ) { print "Not allowing upcp slave to be killed during updatenow, just killing monitoring process.\n"; exit; } print "killing upcp\n"; kill_upcp( $updatepid, "aborted", "/usr/local/cpanel/scripts/upcp was aborted by the user hitting Ctrl-C." ); exit; }; $SIG{HUP} = sub { print "SIGHUP detected; closing monitoring process.\n"; print "The upcp slave has not been affected\n"; exit; }; # Wait till the file shows up. until ( -e $logfile_path ) { select undef, undef, undef, .25; # sleep just a bit } # Wait till we're allowed to open it. my $fh; until ( defined $fh && fileno $fh ) { $fh = IO::Handle->new(); if ( !open $fh, '<', $logfile_path ) { undef $fh; select undef, undef, undef, .25; # sleep just a bit next; } } # Read the file until the pid dies. my $child_done = 0; while (1) { # Read all the available lines. while (1) { my $line = <$fh>; last if ( !defined $line || $line eq '' ); print $line; } # Once the child is history, we need to do yet one more final read, # on the off chance (however remote) that she has written one last # hurrah after we last checked. Hence the following. last if $child_done; # from prev. pass $child_done = 1 if -1 == waitpid( $updatepid, 1 ); # and loop back for one more read select undef, undef, undef, .25; # Yield idle time to the cpu } close $fh if $fh; exit; } sub _logger { return $logger if $logger; $logger = Cpanel::Update::Logger->new( { 'logfile' => $logfile_path, 'stdout' => 1, 'log_level' => 'info' } ); # do not set the pbar in the constructor to do not display the 0 % in bg mode $logger->{pbar} = $pbar_starting_point; return $logger; } sub _determine_logfile_path_if_running ($pid) { my $upid = Cpanel::UPID::get($pid); return $upid ? "/var/cpanel/updatelogs/update.$upid.log" : undef; } #---------------------------------------------------------------------- # HANDLE WITH CARE!! This string is parsed # in at least one place. (cf. Cpanel::Update::Start) sub _message_about_newly_started ( $updatepid, $logfile_path ) { return "upcp is going into background mode (PID $updatepid). You can follow “$logfile_path” to watch its progress."; } #---------------------------------------------------------------------- # HANDLE WITH CARE!! This string is parsed # in at least one place. (cf. Cpanel::Update::Start) sub _message_about_already_running ( $curpid, $logpath ) { return "cPanel Update (upcp) is already running. Please wait for the previous upcp (PID $curpid, log file “$logpath”) to complete, then try again. You can use the command 'ps --pid $curpid' to check if the process is running. You may wish to use '--force'."; } 1;