#!/usr/local/cpanel/3rdparty/bin/perl BEGIN { # Suppress load of all of these at earliest point. $INC{'Try/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'cPstrict.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<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If #pod C<agent> — ends in a space character, the default user-agent string is #pod appended. #pod * C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class #pod that supports the C<add> and C<cookie_header> methods #pod * C<default_headers> — A hashref of default headers to apply to requests #pod * C<local_address> — The local IP address to bind to #pod * C<keep_alive> — Whether to reuse the last connection (if for the same #pod scheme, host and port) (defaults to 1) #pod * C<max_redirect> — Maximum number of redirects allowed (defaults to 5) #pod * C<max_size> — 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<http_proxy> — URL of a proxy server to use for HTTP connections #pod (default is C<$ENV{http_proxy}> — if set) #pod * C<https_proxy> — URL of a proxy server to use for HTTPS connections #pod (default is C<$ENV{https_proxy}> — if set) #pod * C<proxy> — URL of a generic proxy server for both HTTP and HTTPS #pod connections (default is C<$ENV{all_proxy}> — if set) #pod * C<no_proxy> — 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<timeout> — 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<verify_SSL> — A boolean that indicates whether to validate the SSL #pod certificate of an C<https> — connection (default is false) #pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to #pod L<IO::Socket::SSL> #pod #pod An accessor/mutator method exists for each attribute. #pod #pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> 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<keep_alive> 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</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> 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<request()> for the given method. The #pod URL must have unsafe characters escaped and international domain names encoded. #pod See C<request()> for valid options and a description of the response. #pod #pod The C<success> 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<POST> request and sends the key/value pairs from a #pod form data hash or array reference to the given URL with a C<content-type> of #pod C<application/x-www-form-urlencoded>. 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<www_form_urlencode> method for details on the encoding. #pod #pod The URL must have unsafe characters escaped and international domain names #pod encoded. See C<request()> for valid options and a description of the response. #pod Any C<content-type> header or content in the options hashref will be ignored. #pod #pod The C<success> 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<GET> 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<If-Modified-Since> header with the modification timestamp of the file. You #pod may specify a different C<If-Modified-Since> header yourself in the C<< #pod $options->{headers} >> hash. #pod #pod The C<success> 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<Last-Modified> 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<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification. #pod Don't use C<get> when you really want C<GET>. See L<LIMITATIONS> 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<headers> — #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<content> — #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<trailer_callback> — #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<data_callback> — #pod A code reference that will be called for each chunks of the response #pod body received. #pod * C<peer> — #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<Host> header is generated from the URL in accordance with RFC 2616. It #pod is a fatal error to specify C<Host> in the C<headers> option. Other headers #pod may be ignored or overwritten if necessary for transport compliance. #pod #pod If the C<content> 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<content> option is the empty string, no C<content-type> or #pod C<content-length> headers will be generated. #pod #pod If the C<data_callback> 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<status> or C<headers> #pod received prior to the content body.) #pod #pod The C<request> method returns a hashref containing the response. The hashref #pod will have the following keys: #pod #pod =for :list #pod * C<success> — #pod Boolean indicating whether the operation returned a 2XX status code #pod * C<url> — #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<status> — #pod The HTTP status code of the response #pod * C<reason> — #pod The response phrase returned by the server #pod * C<content> — #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<headers> — #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<protocol> - #pod If this field exists, it is the protocol of the response #pod such as HTTP/1.0 or HTTP/1.1 #pod * C<redirects> #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<status> field will #pod contain 599, and the C<content> 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<x-www-form-urlencoded> 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<Net::SSLeay> and L<IO::Socket::SSL>. #pod When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode> #pod is set in C<SSL_options>, 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<keep_alive> #pod option. #pod #pod In scalar context, returns the peer host and port, joined with a colon, or #pod C<undef> (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<Note>: 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@]<host>:<port>/\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<for> # 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() || '<no message>', $self->longmess() || (); } sub _stringify_auxiliaries { my ( $self, $method ) = @_; my @lines; if ( @{ $self->{'_auxiliaries'} } ) { local $@; _require_LocaleString(); my $intro = 'Cpanel::LocaleString'->new( 'The following additional [numerate,_1,error,errors] occurred:', 0 + @{ $self->{'_auxiliaries'} } ); # PPI NO PARSE - required above if ( $method eq 'to_locale_string' ) { push @lines, _locale()->makevar( $intro->to_list() ); } elsif ( $method eq 'to_en_string' ) { push @lines, _locale()->makethis_base( $intro->to_list() ); } else { die "Invalid method: $method"; } push @lines, map { UNIVERSAL::isa( $_, __PACKAGE__ ) ? $_->$method() : $_ } @{ $self->{'_auxiliaries'} }; } return join q<>, map { "\n$_" } @lines; } *TO_JSON = \&to_string; sub _locale { return $locale ||= do { local $@; eval 'require Cpanel::Locale; 1;' or die $@; 'Cpanel::Locale'->get_handle(); # hide from perlcc }; } sub _reset_locale { return undef $locale; } sub _load_carp { if ( !$INC{'Carp.pm'} ) { local $@; eval 'require Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc } return; } sub _load_cpanel_carp { if ( !$INC{'Cpanel/Carp.pm'} ) { local $@; eval 'require Cpanel::Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc } return; } sub _message { my ($self) = @_; return $self->{'_message'} if $self->{'_message'}; local $!; if ($Cpanel::Exception::LOCALIZE_STRINGS) { # the default _require_ExceptionMessage_Locale(); return ( $self->{'_message'} ||= 'Cpanel::ExceptionMessage::Locale'->new( @{ $self->{'_mt_args'} } ) ); # PPI NO PARSE - required above } return ( $self->{'_message'} ||= Cpanel::ExceptionMessage::Raw->new( Cpanel::ExceptionMessage::Raw::convert_localized_to_raw( @{ $self->{'_mt_args'} } ) ) ); } package Cpanel::Exception::_StackTraceSuppression; sub new { my ($class) = @_; $Cpanel::Exception::_SUPPRESS_STACK_TRACES++; return bless [], $class; } sub DESTROY { $Cpanel::Exception::_SUPPRESS_STACK_TRACES--; return; } 1; } # --- END Cpanel/Exception/CORE.pm { # --- BEGIN Cpanel/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 dns_supported => [qw{ bind }]; 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 dns_supported => [qw{ bind powerdns }]; 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{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("<error>$error_container_text</error>"); } else { _print_without_die_handler("[$error_container_text]\n"); } }; $SIG{'__DIE__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars) return if $^S; die $_[0] unless defined $^S; delete $SIG{'__DIE__'}; _run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew; _run_callback_without_die_handler($callback_before_die_spew) if $callback_before_die_spew; $__CALLBACK_AFTER_DIE_SPEW = $callback_after_die_spew; goto \&spew_on_die; }; return 1; } sub spew_on_die { ## no critic qw(Subroutines::RequireArgUnpacking) my ($err) = @_; ++$error_count; my $time = time(); my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time); my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ]; my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday ); my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 ); my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz ); my $error_text; if ( UNIVERSAL::isa( $err, 'Cpanel::Exception' ) ) { $error_text = Cpanel::Carp::safe_longmess( $err->to_locale_string() ); } elsif ( UNIVERSAL::isa( $err, 'Template::Exception' ) ) { $error_text = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $err->type() . "]\n\t[INFO]=[" . $err->info() . "]\n\t[TEXT]=[" . $err->text() . "]\n" ); } else { $error_text = Cpanel::Carp::safe_longmess(@_); } my $current_file = $Cpanel::Parser::Vars::file || 'unknown'; print STDERR "[$error_timestamp] die [Internal Death while parsing $current_file $$] $error_text\n\n"; return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} ); my $error_container_text = 'A fatal error or timeout occurred while processing this directive.'; if ( $OUTPUT_FORMAT eq 'html' ) { if ($SHOW_TRACE) { _print_without_die_handler( _generate_html_error_message( 'error', $error_container_text, $error_text ) ); } else { _print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("<error>[$error_container_text]</error>"); } else { _print_without_die_handler("[$error_container_text]\n"); } _run_callback_without_die_handler($__CALLBACK_AFTER_DIE_SPEW) if $__CALLBACK_AFTER_DIE_SPEW; return; } my @SAFE_LONGMESS_KEY_REGEXP_ITEMS = ( '(?<![a-zA-Z0-9_])pw(?![a-zA-Z0-9_])', qw( hash pass auth root key fullbackup ), ); my @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS = ( @SAFE_LONGMESS_KEY_REGEXP_ITEMS, '__ANON__', ); sub _print_without_die_handler { my ($text) = @_; local $SIG{'__WARN__'} = sub { }; local $SIG{'__DIE__'} = 'DEFAULT'; return print $text; } sub _run_callback_without_die_handler { my ($callback) = @_; local $SIG{'__WARN__'} = sub { }; local $SIG{'__DIE__'} = 'DEFAULT'; return $callback->(); } sub _generate_html_error_message { my ( $type, $error_container_message, $error_message ) = @_; require Cpanel::Encoder::Tiny; my $safe_error_message = Cpanel::Encoder::Tiny::safe_html_encode_str($error_message); return qq[ <style type="text/css">.cpanel_internal_message_container {display: inline-block; margin: 10px; width: auto;} .cpanel_internal_message { border: 1px solid #fff; outline-style: solid; outline-width: 1px; outline-color: #aaa; padding: 5px; } .cpanel_internal_error_warn { background-color: #FFF6CF; } .cpanel_internal_error_error { background-color: #F8E7E6; }</style> <div id="cpanel_notice_item_$error_count" class="cjt-pagenotice-container cjt-notice-container cpanel_internal_message_container internal-error-container"> <div class="yui-module cjt-notice cjt-pagenotice cjt-notice-$type"> <div class="cpanel_internal_message cpanel_internal_error_$type bd"> <div class="cjt-notice-content" style="width: 420px;"> <span> $error_container_message <a class="error" style="cursor:hand;cursor:pointer;" onClick="document.getElementById('cpanel_internal_error_$error_count').style.display='';this.style.display='none'; return false;"> [show] </a> <a class="error" style="cursor:hand;cursor:pointer;" onClick="document.getElementById('cpanel_notice_item_$error_count').style.display='none'; return false;"> [close] </a> </span> <div id="cpanel_internal_error_$error_count" style="display:none;"> <textarea class="cpanel_internal_error_$type" style="font-weight:900; height:200px; width:410px; color: black;">$safe_error_message</textarea> </div> </div> </div> </div> </div> ]; } sub safe_longmess { require Carp; $Carp::Internal{'Cpanel::Carp'} = 1; return sanitize_longmess( scalar Carp::longmess(@_) ); } my ( $key_regexp, $key_regexp_double, $function_regexp ); sub sanitize_longmess { _build_regexes() if !$key_regexp; return join( "\n", map { ( tr{'"}{} && ( m{$key_regexp}o || m{$key_regexp_double}o || ( ( $_ =~ m{^[ \t]*([^\(]+)\(} )[0] || '' ) =~ m{$function_regexp}o ) ) # matches a line that needs to be sanitized && _sanitize_line($_); # sanitize $_ } split( m{\n}, $_[0] ) ) . "\n"; } sub _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/ (?<!\x5c) ( (?:\x5c\x5c)* \x5c u ([0-9a-fA-F]{4}) ) /x; sub replace_unicode_escapes_with_utf8 { my ($json_sr) = @_; my $lead_surrogate; my $ret = $$json_sr =~ s<$UNICODE_ESCAPE_REGEXP>< _replacement(\$lead_surrogate, $json_sr, $+[0], @{^CAPTURE}) >ge; if ($lead_surrogate) { die sprintf "Incomplete surrogate pair (0x%04x)", $lead_surrogate; } return $ret; } sub _replacement { my ( $lead_surrogate_sr, $json_sr, $match_end, @captures ) = @_; my $num = hex $captures[1]; if ( ( $num & _SURROGATE_MASK ) == _TAIL_SURROGATE_MIN ) { if ($$lead_surrogate_sr) { my $utf8 = _decode_surrogates( $$lead_surrogate_sr, $num ); $$lead_surrogate_sr = undef; return $utf8; } die sprintf "Unpaired trailing surrogate (0x%04x)", $num; } elsif ( ( $num & _SURROGATE_MASK ) == _LEAD_SURROGATE_MIN ) { my $next2 = substr( $$json_sr, $match_end, 2 ); if ( !$next2 || $next2 ne '\\u' ) { die sprintf "Unpaired leading surrogate (0x%04x)", $num; } $$lead_surrogate_sr = $num; return q<>; } elsif ( $num < 0x20 || $num == _BACKSLASH_ORD || $num == _DOUBLE_QUOTE_ORD ) { return $captures[0]; } my $utf8 = chr $num; utf8::encode($utf8); return $utf8; } sub _decode_surrogates { my ( $lead, $tail ) = @_; my $uni = 0x10000 + ( ( $lead - 0xd800 ) << 10 ) + ( $tail - 0xdc00 ); my $un = chr $uni; utf8::encode($un); return $un; } 1; } # --- END Cpanel/JSON/Unicode.pm { # --- BEGIN Cpanel/Encoder/ASCII.pm package Cpanel::Encoder::ASCII; use strict; use warnings; sub to_hex { my ($readable) = @_; $readable =~ s<\\><\\\\>g; $readable =~ s<([\0-\x{1f}\x{7f}-\x{ff}])><sprintf '\x{%02x}', ord $1>eg; return $readable; } 1; } # --- END Cpanel/Encoder/ASCII.pm { # --- BEGIN Cpanel/UTF8/Strict.pm package Cpanel::UTF8::Strict; use strict; use warnings; 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(?<!\')\;(?!\')/o, $format ); # semi-colon that is not literal (?<!\')\;(?!\') if ($err) { require Carp; Carp::carp("Format had more than 2 pos/neg sections. Using default pattern."); $format = '#,##0.###'; } elsif ( $is_negative && $negative_pat ) { $format = $negative_pat; } elsif ($zero_positive_pat) { $format = $zero_positive_pat; } my $dec_sec_cnt = 0; if ( index( $format, q{'} ) == -1 ) { $dec_sec_cnt = $format =~ tr{\.}{}; } else { $dec_sec_cnt++ while ( $format =~ m/$FORCE_REGEX_LAZY(?<!\')\.(?!\')/og ); } if ( $dec_sec_cnt != 1 ) { require Carp; Carp::carp("Format should have one decimal section. Using default pattern."); $format = '#,##0.###'; } if ( !length $format || $format !~ tr{ \t\r\n\f}{}c ) { require Carp; Carp::carp("Format is empty. Using default pattern."); $format = '#,##0.###'; } my $result = ''; if ( $format eq '#,##0.###' ) { $result = $n; if ( $n =~ tr{0-9}{} > 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(?<!\')\.(?!\')/o, $format, 2 ); my ( $cur_idx, $trailing_non_n, $cur_d, $cur_pat ) = ( 0, '' ); # buffer my @i_pat = reverse( split( /$FORCE_REGEX_LAZY(?<!\')\,(?!\')/o, $i_pat ) ); my $next_to_last_pattern = @i_pat == 1 ? $i_pat[0] : $i_pat[-2]; substr( $next_to_last_pattern, -1, 1, '#' ) if substr( $next_to_last_pattern, -1 ) eq '0'; while ( $i_pat[0] =~ s/$FORCE_REGEX_LAZY((?:\'.\')+)$//o || $i_pat[0] =~ s/$FORCE_REGEX_LAZY([^0#]+)$//o ) { $trailing_non_n = "$1$trailing_non_n"; } while ( CORE::length( $cur_d = CORE::substr( $integer, -1, 1, '' ) ) ) { if ( $cur_idx == $#i_pat && !CORE::length( $i_pat[$cur_idx] ) ) { $i_pat[$cur_idx] = $next_to_last_pattern; } if ( !CORE::length( $i_pat[$cur_idx] ) ) { # this chunk is spent if ( defined $i_pat[ $cur_idx + 1 ] ) { # there are more chunks ... $cur_idx++; # ... next chunk please } } if ( CORE::length( $i_pat[$cur_idx] ) ) { if ( substr( $i_pat[$cur_idx], -3 ) eq q{','} ) { $result = CORE::substr( $i_pat[$cur_idx], -3, 3, '' ) . $result; redo; } $cur_pat = CORE::substr( $i_pat[$cur_idx], -1, 1, '' ); if ( $cur_pat ne '0' && $cur_pat ne '#' ) { $result = "$cur_pat$result"; redo; } } $result = !CORE::length( $i_pat[$cur_idx] ) && @i_pat != 1 ? ",$cur_d$result" : "$cur_d$result"; if ( $cur_idx == $#i_pat - 1 && $i_pat[$#i_pat] eq '#' && !CORE::length( $i_pat[$cur_idx] ) ) { $cur_idx++; $i_pat[$cur_idx] = $next_to_last_pattern; } } if ( CORE::length( $i_pat[$cur_idx] ) ) { $i_pat[$cur_idx] =~ s/$FORCE_REGEX_LAZY(?<!\')\#(?!\')//og; # remove any left over non-literal # $result = $result . $i_pat[$cur_idx]; # prepend it (e.g. 0 and -) } if ( substr( $result, 0, 1 ) eq ',' ) { substr( $result, 0, 1, '' ); } $result .= $trailing_non_n; if ( defined $decimals && CORE::length($decimals) ) { my @d_pat = ($d_pat); # TODO ? support sepeartor in decimal, !definedvia CLDR, no patterns have that ATM ? split( /(?<!\')\,(?!\')/, $d_pat ); $result .= '.'; $cur_idx = 0; $trailing_non_n = ''; while ( $d_pat[-1] =~ s/$FORCE_REGEX_LAZY((?:\'.\')+)$//o || $d_pat[-1] =~ s/$FORCE_REGEX_LAZY([^0#]+)$//o ) { $trailing_non_n = "$1$trailing_non_n"; } while ( CORE::length( $cur_d = CORE::substr( $decimals, 0, 1, '' ) ) ) { if ( !CORE::length( $d_pat[$cur_idx] ) ) { # this chunk is spent if ( !defined $d_pat[ $cur_idx + 1 ] ) { # there are no more chunks $cur_pat = '#'; } else { # next chunk please $result .= ','; $cur_idx++; } } if ( CORE::length( $d_pat[$cur_idx] ) ) { if ( index( $d_pat[$cur_idx], q{'.'} ) == 0 ) { $result .= CORE::substr( $d_pat[$cur_idx], 0, 3, '' ); redo; } $cur_pat = CORE::substr( $d_pat[$cur_idx], 0, 1, '' ); if ( $cur_pat ne '0' && $cur_pat ne '#' ) { $result .= $cur_pat; redo; } } $result .= $cur_d; } if ( substr( $result, -1, ) eq ',' ) { chop($result); } if ( defined $d_pat[$cur_idx] ) { $d_pat[$cur_idx] =~ s/$FORCE_REGEX_LAZY(?<!\')\#(?!\')//og; # remove any left over non-literal # $result .= $d_pat[$cur_idx]; # append it (e.g. 0 and -) } $result .= $trailing_non_n; } } my $used_place_holder = $cldr_formats->{_decimal_format_decimal} ne '.' && index( $result, '.' ) > -1 && $result =~ s/$FORCE_REGEX_LAZY(?<!\')\.(?!\')/_LOCALES-DECIMAL-PLACEHOLDER_/g; if ( $cldr_formats->{_decimal_format_group} ne ',' && index( $result, ',' ) > -1 ) { $result =~ s/$FORCE_REGEX_LAZY(?<!\')\,(?!\')/$cldr_formats->{_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{<span class="@classes">$string</span>}; } 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{<span$attr>$string</span>}; } *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{<div$attr>$string</div>}; } 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{<img src="$src" alt="$alt"$attr/>}; } sub output_abbr { my ( $lh, $abbr, $full, @attrs ) = @_; return !$lh->context_is_html() ? "$abbr ($full)" : qq{<abbr title="$full"} . __make_attr_str_from_ar( \@attrs, { 'title' => 1 } ) . qq{>$abbr</abbr>}; } sub output_acronym { my ( $lh, $acronym, $full, @attrs ) = @_; return !$lh->context_is_html() ? "$acronym ($full)" : qq{<abbr title="$full"} . __make_attr_str_from_ar( \@attrs, { 'title' => 1 }, { 'class' => 'initialism' } ) . qq{>$acronym</abbr>}; } sub output_sup { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return !$lh->context_is_html() ? $string : qq{<sup} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</sup>}; } sub output_sub { my ( $lh, $string, @attrs ) = @_; $string = __proc_string_with_embedded_under_vars( $string, 1 ); return !$lh->context_is_html() ? $string : qq{<sub} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</sub>}; } 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{<span style="text-decoration: underline"} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</span>}; } 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" : '<strong' . __make_attr_str_from_ar( \@attrs ) . ">$string</strong>"; } 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" : '<em' . __make_attr_str_from_ar( \@attrs ) . ">$string</em>"; } 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{<a$attr target="_blank" class="offsite" href="$url">$output_config{'html'}</a>} : qq{<a$attr href="$url">$output_config{'html'}</a>}; } 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<a-z><A-Z>; 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</, \$_, 2))[$key_value_text] } split(/> . $split_on . qq</, \$cfg_txt) }; >; } else { $parser_code = ' $conf_ref = { map { ' . '($k,$v) = (split(m/' . $delimiter . '/, $_, 2))[' . $key_value_text . ']; ' . 'defined($v) ? ($k,$v) : () ' . '} split(/' . $split_on . '/, $cfg_txt ) }'; } } else { if ( ( $Cpanel::Debug::level || 0 ) > 4 ) { # PPI NO PARSE - ok if not there $limit ||= 0; print STDERR __PACKAGE__ . "::parse_from_filehandle [slow LoadConfig parser used] LIMIT:[!$limit] REGEXP_TO_DELETE[!$regexp_to_preprune] USE_HASH_OF_ARR_REFS[$use_hash_of_arr_refs)]\n"; } $parser_code = 'foreach (split(m/' . $split_on . '/, $cfg_txt)) {' . "\n" # . q{next if !length;} . "\n" # . ( $limit ? q{last if $keys++ == } . $limit . ';' : '' ) . "\n" . ( $regexp_to_preprune ? q{ s/} . $regexp_to_preprune . q{//g;} : '' ) . "\n" # . ( length $delimiter ? # ( q{( $k, $v ) = (split( /} . $delimiter . q{/, $_, 2 ))[} . $key_value_text . q{];} . "\n" . # ( !$allow_undef_values ? q{ next if !defined($v); } : '' ) . "\n" . # ( $use_hash_of_arr_refs ? q{ push @{ $conf_ref->{$k} }, $v; } : q{ $conf_ref->{$k} = $v; } ) . "\n" # ) : q{$conf_ref->{$_} = 1; } . "\n" ) . '};'; } $parser_code .= "; 1"; $parser_code =~ tr{\n}{\r}; ## no critic qw(Cpanel::TransliterationUsage) eval($parser_code) or do { ## no critic qw(BuiltinFunctions::ProhibitStringyEval) $parser_code =~ tr{\r}{\n}; ## no critic qw(Cpanel::TransliterationUsage) _do_logger( 'panic', "Failed to parse :: $parser_code: $@" ); return ( 0, "$@\n$parser_code" ); }; delete $conf_ref->{''} if !defined( $conf_ref->{''} ); if ($skip_keys) { my $skip_keys_ar; if ( ref $skip_keys eq 'ARRAY' ) { $skip_keys_ar = $skip_keys; } elsif ( ref $skip_keys eq 'HASH' ) { $skip_keys_ar = [ keys %$skip_keys ]; } else { return ( 0, 'skip_keys must be an ARRAY or HASH reference' ); } delete @{$conf_ref}{@$skip_keys_ar}; } return ( 1, $conf_ref ); } sub _hashify_ref { my $conf_ref = shift; if ( !defined($conf_ref) ) { $conf_ref = {}; return $conf_ref; } unless ( ref $conf_ref eq 'HASH' ) { if ( ref $conf_ref ) { require Cpanel::Logger; Cpanel::Logger::cplog( 'hashifying non-HASH reference', 'warn', __PACKAGE__ ); ${$conf_ref} = {}; $conf_ref = ${$conf_ref}; } else { require Cpanel::Logger; Cpanel::Logger::cplog( 'defined value encountered where reference expected', 'die', __PACKAGE__ ); } } return $conf_ref; } sub default_product_dir { $PRODUCT_CONF_DIR = shift if @_; return $PRODUCT_CONF_DIR; } sub _remove_comments_from_text { my ( $cfg_txt_sr, $comment, $has_cr_sr ) = @_; if ($$has_cr_sr) { $$cfg_txt_sr = join( "\n", grep ( !m/$comment/, split( m{\r?\n}, $$cfg_txt_sr ) ) ); $$has_cr_sr = 0; } elsif ( $comment eq $DEFAULT_COMMENT_REGEXP ) { if ( rindex( $$cfg_txt_sr, '#', 0 ) == 0 && index( $$cfg_txt_sr, "\n" ) > -1 ) { substr( $$cfg_txt_sr, 0, index( $$cfg_txt_sr, "\n" ) + 1, '' ); } $$cfg_txt_sr =~ s{$DEFAULT_COMMENT_REGEXP.*}{}omg if $$cfg_txt_sr =~ tr{#;}{}; } else { $$cfg_txt_sr =~ s{$comment.*}{}mg; } return 1; } 1; } # --- END Cpanel/Config/LoadConfig.pm { # --- BEGIN Cpanel/Config/LoadWwwAcctConf.pm package Cpanel::Config::LoadWwwAcctConf; use strict; use warnings; # 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</\0><> ) { #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 = <<END; END my %memory_file_list_key = qw( DOMAINS DNS DEADDOMAINS XDNS HOMEDIRLINKS HOMEDIRPATHS ); sub clean_cpuser_hash { my ( $cpuser_ref, $user ) = @_; { my @missing = grep { !exists $cpuser_ref->{$_} } 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<A-Z><> 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.48'; our $VERSION_TEXT = '110.0 (build 48)'; our $VERSION_DISPLAY = '110.0.48'; our $parent_version = 11; our $major_version = 110; our $minor_version = 0; our $build_number = 48; our $build_time_text = 'Mon Nov 4 11:53:39 2024'; our $buildtime = 1730742819; 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{<p style="color:#FF0000">} if $position eq 'begin'; return '</p>' 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 : '<undef>'; } 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 <<EOS; Usage: scripts/upcp [--bg] [--cron] [--force] [--help] [--log=[path]] [--sync] Updates cPanel & WHM. Options: --bg Runs upcp in the background. Output is only visible in the log. --cron Follow WHM's Update Preferences (/etc/cpupdate.conf). --force Force a reinstall even if the system is up to date. --help Display this documentation. --log=[path] Overrides the default log file. --sync Updates the server to the currently-installed version instead of downloading a newer version. This will also run other maintenance items, such as package updates and repairs. You cannot use the --sync argument with the --force argument. EOS exit 1; ## no critic(Cpanel::NoExitsFromSubroutines) -- /scripts/upcp needs refactor to use Getopt } sub upcp { ## no critic(Subroutines::ProhibitExcessComplexity) - preserve original code Cpanel::Usage::wrap_options( \@ARGV, \&usage, {} ); #display usage information on --help open( STDERR, ">&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/<a.*?>//ig; $message =~ s{</a>}{}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;

JMDS TRACK Cameroon

Boost the productivity of your mobile ressources

Make An Appointment

Fleet management

Reduce the operting cost and the unavailability of your vehicles
reduce the fuel consumption of your fleet
Improve the driving dehavior and safety of your drivers
optimize the utilization rate of your equipment
protect your vehicle against theft
Improve the quality of your customer service

Find out more

Assets management

Track the roaming of your equipment
Optimise the management of your assets on site and during transport
Secure the transport of your goods
Make your team responsible for preventing the loss of tools, equipment
Take a real-time inventory of your equipment on site
Easily find your mobile objects or equipment

Find out more

Find out more

Antitheft solutions

Secure your vehicles and machinery and increase your chances of recovering them in the event of theft
Protect your assets and reduce the costs associated with their loss
Combine immobiliser and driver identification and limit the risk of theft
Identify fuel theft and reduce costs
Protect your goods and take no more risks
Be alerted to abnormal events

Our Location

Douala BP cité

and

Yaoundé Total Essos

Make An Appointment

Get Directions

682230363/ 677481892

What makes us different from others

young and dynamic team
call center 24/24 7/7
roaming throughout Africa
team of developers who can develop customer-specific solutions
diversity of services
reactive and prompt after-sales service when soliciting a customer or a malfunction
Free Maintenance and installation in the cities of Douala and Yaounde

https://youtu.be/xI1cz_Jh2x8

15+
years of experience in GPS system development, production and deployment.

15 Collaborators

More than 15 employees dedicated to the research and development of new applications and to customer care

5 000 Vehicles and mobile assets

5 000 vehicles and mobile assets under management, in Africa

Our Partners

Latest Case Studies

Our current projects

Our stand at the Yaoundé trade fair

Installation of solar-powered multi-beam wireless active infrared detectors at SABC

Vector now available

Introducing JMDS Track solutions to our partners

One of our professional technician installing a GPS at Cami Toyota

 5/5
Bon SAV , SATISFAIT DU TRAITEMENT DES REQUETES

M DIPITA CHRISTIAN
Logistic Safety Manager Road Safety Manager
 5/5
La réactivité de JMDS est excellente
Nous restons satisfait dans l’ensemble des prestations relatives a la couverture de notre parc automobile

Hervé Frédéric NDENGUE
Chef Service Adjoint de la Sécurité Générale (CNPS)
 5/5
L’APPLICATION EMIXIS est convivial A L’utilisation
BEIG-3 SARL
DIRECTOR GENERAL
 5/5
Nevertheless I am delighted with the service
MR. BISSE BENJAMIN
CUSTOMER