JezK

Edit File: upcp.static

#!/usr/local/cpanel/3rdparty/bin/perl BEGIN { # Suppress load of all of these at earliest point. $INC{'File/Path/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'HTTP/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Try/Tiny.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'cPstrict.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/Rhel8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Almalinux8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel9.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Almalinux9.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Rhel10.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Almalinux10.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Server/Type.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux8.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux9.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Cloudlinux10.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Ubuntu.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Ubuntu22.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/OS/Ubuntu24.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/Hash/Stringify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Time/Local.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/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/Autodie.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/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/JSON/Unicode.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadFile/ReadFast.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/AdminBin/Serializer.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/AdminBin/Serializer/FailOK.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SV.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/FlushConfig.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Update/Config.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/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/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/Alarm.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/Sources.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ArrayFunc/Shuffle.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/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/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/StringFunc/Trim.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Path/Normalize.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/FileUtils/TouchFile.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/YAML.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/DataStore.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LoadFile.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/Config/LoadCpConf.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/SafeRun/Simple.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeRun/Errors.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Lines.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/Config/LoadUserDomains.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/CpUser.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/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/Crypt/GPG/Settings.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FileUtils/Copy.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FHUtils/Blocking.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Rand/Get.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SocketIP.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/URL.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/UrlTools.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CachedCommand/Utils.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/PublicSuffix.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HTTP/Tiny/FastSSLVerify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Sync/Common.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/URI/Escape/Fast.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Encoder/URI.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/IP/Loopback.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HttpTimer.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/MirrorSearch.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Binaries.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/Base.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/LocaleString.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Errno.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Config/Constants/Perl.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ChildErrorStringifier.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/FHUtils/OS.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/IO/Flush.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ReadMultipleFH.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/ForkAsync.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeRun/Object.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Rand.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SafeDir/RM.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/TempFile.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/Import.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/Import/Temp.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/CachedDataStore.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HTTP/Client/Response.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HTTP/Client.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/SecureDownload.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/VendorKeys.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/VendorKeys/TimestampCache.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Crypt/GPG/VendorKeys/Verify.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/HttpRequest.pm'} = '/usr/local/cpanel/scripts/upcp.static'; $INC{'Cpanel/Update/Tiers.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/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.090'; 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 TLS/SSL #pod certificate of an C<https> — connection (default is true). Changed from false #pod to true in version 0.083. #pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to #pod L<IO::Socket::SSL> #pod * C<$ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}> - Changes the default #pod certificate verification behavior to not check server identity if set to 1. #pod Only effective if C<verify_SSL> is not set. Added in version 0.083. #pod #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</TLS/SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> #pod 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) = @_; # Support lower case verify_ssl argument, but only if verify_SSL is not # true. if ( exists $args{verify_ssl} ) { $args{verify_SSL} ||= $args{verify_ssl}; } my $self = { max_redirect => 5, timeout => defined $args{timeout} ? $args{timeout} : 60, keep_alive => 1, verify_SSL => defined $args{verify_SSL} ? $args{verify_SSL} : _verify_SSL_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 _verify_SSL_default { my ($self) = @_; # Check if insecure default certificate verification behaviour has been # changed by the user by setting PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT=1 return (($ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT} || '') eq '1') ? 0 : 1; } 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 by key 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; } return $self->request('POST', $url, { # Any existing 'headers' key in $args will be overridden with a # normalized version below. %$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 Content data in the request/response is handled as "raw bytes". Any #pod encoding/decoding (with associated headers) are the responsibility of the #pod caller. #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' ? map { ($_ => $data->{$_}) } sort keys %$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("&", @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.968 for default_ca() local @INC = @INC; pop @INC if $INC[-1] eq '.'; unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.968)}) { $ok = 0; $reason .= qq/IO::Socket::SSL 1.968 or later 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 or later 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; 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 => HTTP::Tiny::_verify_SSL_default(), 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; } sub _find_CA { my $self = shift; my $ca_file = $self->{SSL_options}->{SSL_ca_file}; if ( defined $ca_file ) { unless ( -r $ca_file ) { die qq/SSL_ca_file '$ca_file' not found or not readable\n/; } return ( SSL_ca_file => $ca_file ); } # Return default_ca() parameters from IO::Socket::SSL. It looks for the # default bundle and directory from Net::SSLeay, handles $ENV{SSL_CERT_FILE} # and $ENV{SSL_CERT_DIR}, and finally fails over to Mozilla::CA # my %default_ca = IO::Socket::SSL::default_ca(); return %default_ca if %default_ca; # If IO::Socket::SSL::default_ca() was unable to find a CA bundle, look for # one in well known locations as a last resort. 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 ( SSL_ca_file => $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 one from your OS vendor, or Mozilla::CA from CPAN\n/; } # not for internal use; backcompat shim only sub _find_CA_file { my $self = shift; my %res = $self->_find_CA(); return $res{SSL_ca_file}; } # 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_args, $self->_find_CA ); } 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.31-2-gc8e3a47 use 5.006; # ABSTRACT: Minimal try/catch with proper preservation of $@ our $VERSION = '0.32'; 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; # Copyright 2024 WebPros International, LLC # All rights reserved. # copyright@cpanel.net http://cpanel.net # This code is subject to the cPanel license. Unauthorized copying is prohibited. use strict; use warnings; =pod This is importing the following to your namespace use strict; use warnings; use v5.30; use feature 'signatures'; no warnings 'experimental::signatures'; =cut sub import { if ( $] < 5.030 ) { require Carp; Carp::confess("cPstrict is being loaded from an unsupported perl ($^X)"); } # auto import strict and warnings to our caller warnings->import(); strict->import(); require feature; feature->import( ':5.30', 'signatures' ); warnings->unimport('experimental::signatures'); return; } 1; } # --- END cPstrict { # --- BEGIN Cpanel/OS/SysPerlBootstrap.pm package Cpanel::OS::SysPerlBootstrap; use strict; use warnings; no warnings 'once'; 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 ) = _read_os_release(); 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 _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]; return if ( defined($os_rel_mtime) && $cache_mtime <= $os_rel_mtime ); } return split qr{\|}, readlink(CACHE_FILE); } sub _read_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; $distro = "cloudlinux" if -e '/etc/cloudlinux-release'; # Overcome CL10's lack of truth here. } 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 _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 (); # perlpkg line 211 *load_perl_module = \&Cpanel::Exception::load_perl_module; 1; } # --- END Cpanel/ExceptionMessage.pm { # --- BEGIN Cpanel/Locale/Utils/Fallback.pm package Cpanel::Locale::Utils::Fallback; use strict; use warnings; no warnings 'once'; sub interpolate_variables { my ( $str, @maketext_opts ) = @_; my $c = 1; my %h = map { $c++, $_ } @maketext_opts; $str =~ s{(\[(?:[^_]+,)?_([0-9])+\])}{$h{$2}}g; return $str; } 1; } # --- END Cpanel/Locale/Utils/Fallback.pm { # --- BEGIN Cpanel/ExceptionMessage/Raw.pm package Cpanel::ExceptionMessage::Raw; use strict; use warnings; no warnings 'once'; # use base Cpanel::ExceptionMessage (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::ExceptionMessage); } # use Cpanel::Locale::Utils::Fallback (); # perlpkg line 211 sub new { my ( $class, $str ) = @_; my $str_copy = $str; return bless( \$str_copy, $class ); } sub to_string { my ($self) = @_; return $$self; } sub get_language_tag { return 'en'; } BEGIN { *Cpanel::ExceptionMessage::Raw::convert_localized_to_raw = *Cpanel::Locale::Utils::Fallback::interpolate_variables; *Cpanel::ExceptionMessage::Raw::to_locale_string = *Cpanel::ExceptionMessage::Raw::to_string; *Cpanel::ExceptionMessage::Raw::to_en_string = *Cpanel::ExceptionMessage::Raw::to_string; } 1; } # --- END Cpanel/ExceptionMessage/Raw.pm { # --- BEGIN Cpanel/LoadModule/Utils.pm package Cpanel::LoadModule::Utils; use strict; use warnings; no warnings 'once'; sub module_is_loaded { my $p = module_path( $_[0] ); return 0 unless defined $p; return defined $INC{$p} ? 1 : 0; } sub module_path { my ($module_name) = @_; if ( defined $module_name && length($module_name) ) { substr( $module_name, index( $module_name, '::' ), 2, '/' ) while index( $module_name, '::' ) > -1; $module_name .= '.pm' unless substr( $module_name, -3 ) eq '.pm'; } return $module_name; } sub is_valid_module_name { return $_[0] =~ m/\A[A-Za-z_]\w*(?:(?:'|::)\w+)*\z/ ? 1 : 0; } 1; } # --- END Cpanel/LoadModule/Utils.pm { # --- BEGIN Cpanel/ScalarUtil.pm package Cpanel::ScalarUtil; use strict; use warnings; no warnings 'once'; sub blessed { return ref( $_[0] ) && UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) || undef; } 1; } # --- END Cpanel/ScalarUtil.pm { # --- BEGIN Cpanel/Exception/CORE.pm package Cpanel::Exception::CORE; 1; package Cpanel::Exception; use strict; BEGIN { $INC{'Cpanel/Exception.pm'} = '__BYPASSED__'; } our $_SUPPRESS_STACK_TRACES = 0; our $_EXCEPTION_MODULE_PREFIX = 'Cpanel::Exception'; our $IN_EXCEPTION_CREATION = 0; our $_suppressed_msg = '__STACK_TRACE_SUPPRESSED__YOU_SHOULD_NEVER_SEE_THIS_MESSAGE__'; my $PACKAGE = 'Cpanel::Exception'; my $locale; my @ID_CHARS = qw( a b c d e f g h j k m n p q r s t u v w x y z 2 3 4 5 6 7 8 9 ); my $ID_LENGTH = 6; # use Cpanel::ExceptionMessage::Raw (); # perlpkg line 211 # use Cpanel::LoadModule::Utils (); # perlpkg line 211 use constant _TRUE => 1; use overload ( '""' => \&__spew, bool => \&_TRUE, fallback => 1, ); BEGIN { die "Cannot compile Cpanel::Exception::CORE" if $INC{'B/C.pm'} && $0 !~ m{cpkeyclt|cpsrvd\.so|t/large}; } sub _init { return 1 } # legacy sub create { my ( $exception_type, @args ) = @_; _init(); if ($IN_EXCEPTION_CREATION) { _load_cpanel_carp(); die 'Cpanel::Carp'->can('safe_longmess')->("Attempted to create a “$exception_type” exception with arguments “@args” while creating exception “$IN_EXCEPTION_CREATION->[0]” with arguments “@{$IN_EXCEPTION_CREATION->[1]}”."); } local $IN_EXCEPTION_CREATION = [ $exception_type, \@args ]; if ( $exception_type !~ m/\A[A-Za-z0-9_]+(?:\:\:[A-Za-z0-9_]+)*\z/ ) { die "Invalid exception type: $exception_type"; } my $perl_class; if ( $exception_type eq __PACKAGE__ ) { $perl_class = $exception_type; } else { $perl_class = "${_EXCEPTION_MODULE_PREFIX}::$exception_type"; } _load_perl_module($perl_class) unless $perl_class->can('new'); if ( $args[0] && ref $args[0] eq 'ARRAY' && scalar @{ $args[0] } > 1 ) { $args[0] = { @{ $args[0] } }; } return $perl_class->new(@args); } sub create_raw { my ( $class, $msg, @extra_args ) = @_; _init(); my $msg_obj = 'Cpanel::ExceptionMessage::Raw'->new($msg); if ( $class =~ m<\A(?:\Q${_EXCEPTION_MODULE_PREFIX}::\E)?Collection\z> ) { die "Use create('Collection', ..) to create a Cpanel::Exception::Collection object."; } return create( $class, $msg_obj, @extra_args ); } sub _load_perl_module { my ($module) = @_; local ( $!, $@ ); if ( !defined $module ) { die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module requires a module name.") ); } return 1 if Cpanel::LoadModule::Utils::module_is_loaded($module); my $module_name = $module; $module_name =~ s{\.pm$}{}; if ( !Cpanel::LoadModule::Utils::is_valid_module_name($module_name) ) { die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module requires a valid module name: '$module_name'.") ); } { eval qq{use $module (); 1 } or die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("load_perl_module cannot load '$module_name': $@") ) } return 1; } sub new { my ( $class, @args ) = @_; @args = grep { defined } @args; my $self = {}; bless $self, $class; if ( ref $args[-1] eq 'HASH' ) { $self->{'_metadata'} = pop @args; } if ( defined $self->{'_metadata'}->{'longmess'} ) { $self->{'_longmess'} = &{ $self->{'_metadata'}->{'longmess'} }($self) if $self->{'_metadata'}->{'longmess'}; } elsif ($_SUPPRESS_STACK_TRACES) { $self->{'_longmess'} = $_suppressed_msg; } else { if ( !$INC{'Carp.pm'} ) { _load_carp(); } $self->{'_longmess'} = scalar do { local $Carp::CarpInternal{'Cpanel::Exception'} = 1; local $Carp::CarpInternal{$class} = 1; 'Carp'->can('longmess')->(); }; } _init(); $self->{'_auxiliaries'} = []; if ( UNIVERSAL::isa( $args[0], 'Cpanel::ExceptionMessage' ) ) { $self->{'_message'} = shift @args; } else { my @mt_args; if ( @args && !ref $args[0] ) { @mt_args = ( shift @args ); if ( ref $args[0] eq 'ARRAY' ) { push @mt_args, @{ $args[0] }; } } else { $self->{'_orig_mt_args'} = $args[0]; my $phrase = $self->_default_phrase( $args[0] ); if ($phrase) { if ( ref $phrase ) { @mt_args = $phrase->to_list(); } else { $self->{'_message'} = Cpanel::ExceptionMessage::Raw->new($phrase); return $self; } } } if ( my @extras = grep { !ref } @args ) { die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("Extra scalar(s) passed to $PACKAGE! (@extras)") ); } if ( !length $mt_args[0] ) { die __PACKAGE__->new( 'Cpanel::ExceptionMessage::Raw'->new("No args passed to $PACKAGE constructor!") ); } $self->{'_mt_args'} = \@mt_args; } return $self; } sub get_string { my ( $exc, $no_id_yn ) = @_; return get_string_no_id($exc) if $no_id_yn; return _get_string( $exc, 'to_string' ); } sub get_string_no_id { my ($exc) = @_; return _get_string( $exc, 'to_string_no_id' ); } sub _get_string { my ( $exc, $cp_exc_stringifier_name ) = @_; return $exc if !ref $exc; { local $@; my $ret = eval { $exc->$cp_exc_stringifier_name() }; return $ret if defined $ret && !$@ && !ref $ret; } if ( ref $exc eq 'HASH' && $exc->{'message'} ) { return $exc->{'message'}; } if ( $INC{'Cpanel/YAML.pm'} ) { local $@; my $ret = eval { 'Cpanel::YAML'->can('Dump')->($exc); }; return $ret if defined $ret && !$@; } if ( $INC{'Cpanel/JSON.pm'} ) { local $@; my $ret = eval { 'Cpanel::JSON'->can('Dump')->($exc); }; return $ret if defined $ret && !$@; } return $exc; } sub _create_id { srand(); return join( q<>, map { $ID_CHARS[ int rand( 0 + @ID_CHARS ) ]; } ( 1 .. $ID_LENGTH ), ); } sub get_stack_trace_suppressor { return Cpanel::Exception::_StackTraceSuppression->new(); } sub set_id { my ( $self, $new_id ) = @_; $self->{'_id'} = $new_id; return $self; } sub id { my ($self) = @_; return $self->{'_id'} ||= _create_id(); } sub set { my ( $self, $key ) = @_; $self->{'_metadata'}{$key} = $_[2]; if ( exists $self->{'_orig_mt_args'} ) { my $phrase = $self->_default_phrase( $self->{'_orig_mt_args'} ); if ($phrase) { if ( ref $phrase ) { $self->{'_mt_args'} = [ $phrase->to_list() ]; undef $self->{'_message'}; } else { $self->{'_message'} = Cpanel::ExceptionMessage::Raw->new($phrase); } } } return $self; } sub get { my ( $self, $key ) = @_; my $v = $self->{'_metadata'}{$key}; if ( my $reftype = ref $v ) { local $@; if ( $reftype eq 'HASH' ) { $v = { %{$v} }; # shallow copy } elsif ( $reftype eq 'ARRAY' ) { $v = [ @{$v} ]; # shallow copy } elsif ( $reftype eq 'SCALAR' ) { $v = \${$v}; # shallow copy } else { local ( $@, $! ); require Cpanel::ScalarUtil; if ( $reftype ne 'GLOB' && !Cpanel::ScalarUtil::blessed($v) ) { warn if !eval { _load_perl_module('Clone') if !$INC{'Clone.pm'}; $v = 'Clone'->can('clone')->($v); }; } } } return $v; } sub get_all_metadata { my $self = shift; my %metadata_copy; for my $key ( keys %{ $self->{'_metadata'} } ) { $metadata_copy{$key} = $self->get($key); } return \%metadata_copy; } my $loaded_LocaleString; sub _require_LocaleString { return $loaded_LocaleString ||= do { local $@; eval 'require Cpanel::LocaleString; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) - # PPI NO PARSE - load on demand 1; }; } my $loaded_ExceptionMessage_Locale; sub _require_ExceptionMessage_Locale { return $loaded_ExceptionMessage_Locale ||= do { local $@; eval 'require Cpanel::ExceptionMessage::Locale; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) - # PPI NO PARSE - load on demand 1; }; } sub _default_phrase { _require_LocaleString(); return 'Cpanel::LocaleString'->new( 'An unknown error in the “[_1]” package has occurred.', scalar ref $_[0] ); # PPI NO PARSE - loaded above } sub longmess { my ($self) = @_; return '' if $self->{'_longmess'} eq $_suppressed_msg; _load_cpanel_carp() if !$INC{'Cpanel/Carp.pm'}; return Cpanel::Carp::sanitize_longmess( $self->{'_longmess'} ); } sub to_string { my ($self) = @_; return _apply_id_prefix( $self->id(), $self->to_string_no_id() ); } sub to_string_no_id { my ($self) = @_; my $string = $self->to_locale_string_no_id(); if ( $self->_message()->get_language_tag() ne 'en' ) { my $en_string = $self->to_en_string_no_id(); $string .= "\n$en_string" if ( $en_string ne $string ); } return $string; } sub _apply_id_prefix { my ( $id, $msg ) = @_; return sprintf "(XID %s) %s", $id, $msg; } sub to_en_string { my ($self) = @_; return _apply_id_prefix( $self->id(), $self->to_en_string_no_id() ); } sub to_en_string_no_id { my ($self) = @_; return $self->_message()->to_en_string() . $self->_stringify_auxiliaries('to_en_string'); } sub to_locale_string { my ($self) = @_; return _apply_id_prefix( $self->id(), $self->to_locale_string_no_id() ); } sub to_locale_string_no_id { my ($self) = @_; return $self->_message()->to_locale_string() . $self->_stringify_auxiliaries('to_locale_string'); } sub add_auxiliary_exception { my ( $self, $aux ) = @_; return push @{ $self->{'_auxiliaries'} }, $aux; } sub get_auxiliary_exceptions { my ($self) = @_; die 'List context only!' if !wantarray; #Can’t use Cpanel::Context return @{ $self->{'_auxiliaries'} }; } sub __spew { my ($self) = @_; return $self->_spew(); } sub _spew { my ($self) = @_; return ref($self) . '/' . join "\n", $self->to_string() || '<no message>', $self->longmess() || (); } sub _stringify_auxiliaries { my ( $self, $method ) = @_; my @lines; if ( @{ $self->{'_auxiliaries'} } ) { local $@; _require_LocaleString(); my $intro = 'Cpanel::LocaleString'->new( 'The following additional [numerate,_1,error,errors] occurred:', 0 + @{ $self->{'_auxiliaries'} } ); # PPI NO PARSE - required above if ( $method eq 'to_locale_string' ) { push @lines, _locale()->makevar( $intro->to_list() ); } elsif ( $method eq 'to_en_string' ) { push @lines, _locale()->makethis_base( $intro->to_list() ); } else { die "Invalid method: $method"; } push @lines, map { UNIVERSAL::isa( $_, __PACKAGE__ ) ? $_->$method() : $_ } @{ $self->{'_auxiliaries'} }; } return join q<>, map { "\n$_" } @lines; } *TO_JSON = \&to_string; sub _locale { return $locale ||= do { local $@; eval 'require Cpanel::Locale; 1;' or die $@; 'Cpanel::Locale'->get_handle(); # hide from perlcc }; } sub _reset_locale { return undef $locale; } sub _load_carp { if ( !$INC{'Carp.pm'} ) { local $@; eval 'require Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc } return; } sub _load_cpanel_carp { if ( !$INC{'Cpanel/Carp.pm'} ) { local $@; eval 'require Cpanel::Carp; 1;' or die $@; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -- hide from perlcc } return; } sub _message { my ($self) = @_; return $self->{'_message'} if $self->{'_message'}; local $!; if ($Cpanel::Exception::LOCALIZE_STRINGS) { # the default _require_ExceptionMessage_Locale(); return ( $self->{'_message'} ||= 'Cpanel::ExceptionMessage::Locale'->new( @{ $self->{'_mt_args'} } ) ); # PPI NO PARSE - required above } return ( $self->{'_message'} ||= Cpanel::ExceptionMessage::Raw->new( Cpanel::ExceptionMessage::Raw::convert_localized_to_raw( @{ $self->{'_mt_args'} } ) ) ); } package Cpanel::Exception::_StackTraceSuppression; sub new { my ($class) = @_; $Cpanel::Exception::_SUPPRESS_STACK_TRACES++; return bless [], $class; } sub DESTROY { $Cpanel::Exception::_SUPPRESS_STACK_TRACES--; return; } 1; } # --- END Cpanel/Exception/CORE.pm { # --- BEGIN Cpanel/LoadModule.pm package Cpanel::LoadModule; use strict; # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::LoadModule::Utils (); # perlpkg line 211 my $logger; my $has_perl_dir = 0; sub _logger_warn { my ( $msg, $fail_ok ) = @_; return if $fail_ok && $ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == -1; if ( $INC{'Cpanel/Logger.pm'} ) { $logger ||= 'Cpanel::Logger'->new(); $logger->warn($msg); } return warn $msg; } sub _reset_has_perl_dir { $has_perl_dir = 0; return; } sub load_perl_module { ## no critic qw(Subroutines::RequireArgUnpacking) if ( -1 != index( $_[0], q<'> ) ) { die Cpanel::Exception::create_raw( 'InvalidParameter', "Module names with single-quotes are prohibited. ($_[0])" ); } return $_[0] if Cpanel::LoadModule::Utils::module_is_loaded( $_[0] ); my ( $mod, @LIST ) = @_; local ( $!, $@ ); if ( !is_valid_module_name($mod) ) { die Cpanel::Exception::create( 'InvalidParameter', '“[_1]” is not a valid name for a Perl module.', [$mod] ); } my $args_str; if (@LIST) { $args_str = join ',', map { die "Only scalar arguments allowed in LIST! (@LIST)" if ref; _single_quote($_); } @LIST; } else { $args_str = q<>; } eval "use $mod ($args_str);"; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) if ($@) { die Cpanel::Exception::create( 'ModuleLoadError', [ module => $mod, error => $@ ] ); } return $mod; } *module_is_loaded = *Cpanel::LoadModule::Utils::module_is_loaded; *is_valid_module_name = *Cpanel::LoadModule::Utils::is_valid_module_name; sub loadmodule { return 1 if cpanel_namespace_module_is_loaded( $_[0] ); return _modloader( $_[0] ); } sub lazy_load_module { my $mod = shift; my $mod_path = $mod; $mod_path =~ s{::}{/}g; if ( exists $INC{ $mod_path . '.pm' } ) { return; } if ( !is_valid_module_name($mod) ) { _logger_warn("Cpanel::LoadModule: Invalid module name ($mod)"); return; } eval "use $mod ();"; if ($@) { delete $INC{ $mod_path . '.pm' }; _logger_warn( "Cpanel::LoadModule:: Failed to load module $mod - $@", 1 ); return; } return 1; } sub cpanel_namespace_module_is_loaded { my ($modpart) = @_; $modpart =~ s{::}{/}g; return exists $INC{"Cpanel/$modpart.pm"} ? 1 : 0; } sub _modloader { my $module = shift; if ( !$module ) { _logger_warn("Empty module name passed to modloader"); return; } if ( !is_valid_module_name($module) ) { _logger_warn("Invalid module name ($module) passed to modloader"); return; } eval qq[ use Cpanel::${module}; Cpanel::${module}::${module}_init() if "Cpanel::${module}"->can("${module}_init"); ]; # PPI USE OK - This looks like usage of the Cpanel module and it's not. if ($@) { _logger_warn("Error loading module $module - $@"); return; } return 1; } sub _single_quote { local ($_) = $_[0]; s/([\\'])/\\$1/g; return qq('$_'); } 1; } # --- END Cpanel/LoadModule.pm { # --- BEGIN Cpanel/OS.pm package Cpanel::OS; use cPstrict; no warnings 'once'; use Carp (); # use Cpanel::OS::SysPerlBootstrap (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 our $VERSION = '2.0'; sub _new_instance ( $os, $distro, $major, $minor, $build ) { my $distro_class = 'Cpanel::OS::' . ucfirst($distro) . $major; my $fallback_to_linux; if ( $INC{'Cpanel/OS/All.pm'} ) { $fallback_to_linux = 1 unless $distro_class->can('is_supported'); } else { $fallback_to_linux = 1 unless eval "require $distro_class; 1"; ## no critic qw(ProhibitStringyEval) -- This is how we do a runtime load here. } if ($fallback_to_linux) { 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!). 'at_eol', # When true, this release is the end of the line for cPanel on this OS; future major releases will not support or even recognize this distro. '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 'release_codename', # Example: focal, jammy (Ubuntu specific) '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 'etc_shadow_groups', # group name that owns /etc/shadow 'etc_shadow_perms', # expected permissions for /etc/shadow '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 'rsync_old_args', # If needed, the args to make rsync behave as it did prior to CVE-2022-29154 'crypto_policy_needs_sha1', # This distro/version needs to have SHA1 added to its crypto policies 'crypto_policy_os_provides_sha1_module', # This distro actually has the subpolicy module to enable SHA-1; otherwise, we need to supply it 'lsof_needs_prlimit', # Does lsof on this distro need to be invoked via prlimit to constrain the file descriptor limits '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 'binary_locations', # paths to Cpanel::Binaries entries for this distro '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) 'var_named_permissions', # Permissions data for /var/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 'db_disable_auth_socket', # Hashref of values needed to disable auth_socket for databases. 'db_needs_preseed', # Does the DB need to do a preseed on install? 'db_additional_conf_files', # Any conf files that need to be symlinked. 'db_mariadb_default_conf_file', # The default conf file for mariadb, only set if it is not /etc/my.cnf 'db_mariadb_start_file', # The startup script used by systemd for mariadb '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 'mariadb_packages', # List of packages needed to install MariaDB. 'known_mariadb_deps', # List of dependencies needed for MariaDB installation. 'mariadb_incompatible_packages', # List of packages that are not compatible with MariaDB. '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? 'mariadb_default_version', # Default MariaDB 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? 'cpsc_from_bare_repo_url', # Where can we download the repo file from? (needs to be over https) 'cpsc_from_bare_repo_path', # ... And where should we put it when we download it? 'cpsc_from_bare_repo_key_url', 'ea4_install_repo_from_package', # Does an RPM provide an EA4 repo? '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_install_bare_repo', # Do we download a bare repo file? 'ea4_from_bare_repo_url', # Where can we download the repo file from? (needs to be over https) 'ea4_from_bare_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_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 '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_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 WP 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', 'supports_phpels', # Does this system support the TuxCare PHP ELS product? 'php_els_is_part_of_the_base_os', # Is PHP ELS provided as part of the base OS? (e.g., CloudLinux) '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 'nftables_config_file', # Where does nftables.conf live '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? '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 '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. 'ssh_service_name', # The systemd service name for ssh 'tuxcare_els_php_install_url', # Do we support Tuxcare on this system if so, this is the url to the install script. ); } 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; $target = ucfirst($target); 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; no warnings 'once'; use Carp (); # use Cpanel::OS (); # perlpkg line 211 # use parent Cpanel::OS (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS); } use constant at_eol => 0; 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 => 1; use constant supports_imunify_av_plus => 1; use constant supports_imunify_360 => 1; use constant supports_letsencrypt_v2 => 1; use constant supports_cpanel_analytics => 1; use constant supports_cpanel_cloud_edition => 0; use constant php_els_is_part_of_the_base_os => 0; use constant cpsc_from_bare_repo_url => undef; use constant cpsc_from_bare_repo_path => undef; use constant cpsc_from_bare_repo_key_url => undef; use constant can_elevate_to => []; use constant setup_tz_method => q[timedatectl]; use constant lsof_needs_prlimit => 0; 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 => 0; 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.3'; use constant mariadb_default_version => '10.11'; 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_install_bare_repo => 0; use constant ea4_from_bare_repo_url => undef; use constant ea4_from_bare_repo_path => undef; use constant ea4_modern_openssl => '/usr/bin/openssl'; use constant ea4tooling_all => [qw{ ea-cpanel-tools ea-profiles-cpanel }]; sub ea4tooling_dnsonly { return Carp::confess('ea4tooling_dnsonly unimplemented for this distro') } sub ea4tooling { return Carp::confess('ea4tooling unimplemented for this distro') } sub system_exclude_rules { return Carp::confess('system_exclude_rules unimplemented for this distro') } sub base_distro { return Carp::confess('base_distro 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'; # This has to do with where we publish rpms. Do not change or remove it. 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 => 1; 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 rsync_old_args => []; use constant ssh_service_name => 'sshd'; use constant iptables_ipv4_savefile => '/etc/sysconfig/iptables'; use constant iptables_ipv6_savefile => '/etc/sysconfig/ip6tables'; use constant nftables_config_file => '/etc/sysconfig/nftables.conf'; 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 binary_locations => { 'lsof' => '/usr/bin', }; 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 supports_postgresql => 0; use constant has_cloudlinux_enhanced_quotas => 0; use constant ea4_install_from_profile_enforce_packages => 0; use constant is_cloudlinux => 0; use constant can_be_elevated => 0; use constant crypto_policy_needs_sha1 => 0; use constant crypto_policy_os_provides_sha1_module => 0; use constant can_clean_plugins_repo => 0; use constant has_quota_support_for_xfs => 1; use constant is_systemd => 1; use constant has_tcp_wrappers => 1; use constant openssl_escapes_subjects => 1; use constant kernel_supports_fs_protected_regular => 1; use constant pretty_distro => undef; use constant release_codename => 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 var_named_permissions => { 'mode' => 0755, 'ownership' => [ 'named', 'named' ], }; use constant nat_server_buffer_connections => 2; use constant tuxcare_els_php_install_url => ''; 1; } # --- END Cpanel/OS/Linux.pm { # --- BEGIN Cpanel/OS/Rhel.pm package Cpanel::OS::Rhel; use cPstrict; no warnings 'once'; # use Cpanel::OS::Linux (); # ea4tooling_all # perlpkg line 211 # use parent Cpanel::OS::Linux (); # perlpkg line 238 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 etc_shadow_groups => ['root']; use constant etc_shadow_perms => [ 0000, 0200, 0600 ]; 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 cron_bin_path => '/usr/sbin/crond'; use constant systemd_service_name_map => {}; use constant firewall => 'firewalld_nftables'; use constant firewall_module => 'NFTables'; use constant networking => 'networkscripts'; use constant package_manager => 'dnf'; 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 who_wins_if_soft_gt_hard => 'soft'; use constant has_tcp_wrappers => 0; use constant binary_locations => { 'lsof' => '/usr/bin', 'needs-restarting' => '/usr/bin', 'named-checkzone' => '/usr/sbin', 'named-checkconf' => '/usr/sbin', }; use constant cpsc_from_bare_repo_url => 'http://ea4testing.cpanel.net/CPSC.repo'; use constant cpsc_from_bare_repo_path => '/etc/yum.repos.d/cpsc.repo'; use constant ea4_install_bare_repo => 1; use constant ea4_from_bare_repo_url => 'https://securedownloads.cpanel.net/EA4/0/EA4.repo'; use constant ea4_from_bare_repo_path => '/etc/yum.repos.d/EA4.repo'; use constant ea4_conflicting_apache_distro_packages => [qw( httpd httpd-tools php-cli )]; use constant ea4tooling_dnsonly => ['dnf-plugin-universal-hooks']; use constant ea4tooling => [ 'dnf-plugin-universal-hooks', Cpanel::OS::Linux->ea4tooling_all->@* ]; 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/1/cpanel-plugins.repo'; use constant repo_suffix => 'repo'; use constant repo_dir => '/etc/yum.repos.d'; use constant package_repositories => [qw/epel powertools/]; 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* kernel-devel*', '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-Try-Tiny perl-YAML-Syck perl-core perl-devel perl-libwww-perl perl-local-lib pixman strace sysstat traceroute urw-fonts zlib-devel } ]; use constant packages_supplemental_epel => [ qw{ dpkg perl-Expect perl-JSON-XS } ]; use constant packages_required => [ qw{ acl aspell at bind bind-libs bind-utils binutils boost-program-options bzip2 cmake-filesystem coreutils cpio cpp crontabs curl dnf e2fsprogs expat file gawk gcc gd gdbm gettext glibc-devel glibc-locale-source gmp gnupg2 grubby gzip initscripts iptables json-c kernel-headers less libaio libevent libgcc libgomp libicu libidn libjpeg-turbo libpcap libpng libstdc++ libtiff libxml2 libxslt libzip libzstd lsof lua lua-socket mailx make nano net-tools nftables oniguruma(x86-64) openssh openssh-clients openssh-server openssl pam pam-devel passwd patch pcre pcre2 pcre2-utf32 pigz popt postgresql-libs python3-dnf python3-dns python3-docs python3-html2text python3-libdnf python3-setuptools python36 python312 quota rsync sed shadow-utils smartmontools sqlite tar unzip util-linux-user wget which xz yum-utils zip zlib } ]; use constant postgresql_packages => [ qw{ postgresql postgresql-devel postgresql-libs postgresql-server } ]; use constant package_ImageMagick_Devel => 'ImageMagick-devel'; use constant package_crond => 'cronie'; use constant mariadb_versions_use_repo_template => [qw/10.0 10.1 10.2 10.3 10.5 10.6 10.11 11.4/]; use constant mysql_versions_use_repo_template => [qw/5.7/]; 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-server mysql-community-devel/]; use constant mariadb_packages => [qw( MariaDB-server MariaDB-client MariaDB-devel MariaDB-shared MariaDB-common )]; use constant mariadb_incompatible_packages => [ qw( mariadb-client mariadb-devel mariadb-embedded mariadb-embedded-devel mariadb-libs mariadb-libs-compat mariadb-release mariadb-server mariadb-test mysql-community-client mysql-community-common mysql-community-devel mysql-community-embedded mysql-community-embedded-devel mysql-community-libs mysql-community-libs-compat mysql-community-release mysql-community-server mysql-community-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 mysql57-community-release mysql80-community-release 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 known_mariadb_deps => { 'perl-DBI' => '', 'shadow-utils' => '', 'grep' => '', 'coreutils' => '', }; use constant db_disable_auth_socket => { 'unix_socket' => 'OFF', 'plugin-load-add' => 'auth_socket.so' }; use constant db_additional_conf_files => []; use constant db_mariadb_default_conf_file => undef; use constant db_mariadb_start_file => undef; 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-2025 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 db_needs_preseed => 0; 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/rhel/###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-2025 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-2025 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-2025 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-2025 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 postgresql_minimum_supported_version => '9.2'; use constant postgresql_initdb_commands => ['/usr/bin/postgresql-setup initdb']; use constant package_descriptions => { 'short' => 'summary', 'long' => 'description', }; use constant tuxcare_els_php_install_url => "https://go.cpanel.net/install-els-alt-php-rpm-repo-ip"; use constant supports_phpels => 1; 1; } # --- END Cpanel/OS/Rhel.pm { # --- BEGIN Cpanel/OS/Almalinux.pm package Cpanel::OS::Almalinux; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Rhel (); # perlpkg line 238 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/Rhel8.pm package Cpanel::OS::Rhel8; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Rhel (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } 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 package_release_distro_tag => '~el8'; use constant system_package_providing_perl => 'perl-interpreter'; use constant ea4_install_from_profile_enforce_packages => 1; 1; } # --- END Cpanel/OS/Rhel8.pm { # --- BEGIN Cpanel/OS/Almalinux8.pm package Cpanel::OS::Almalinux8; use cPstrict; no warnings 'once'; use Cpanel::OS::Almalinux; # use parent Cpanel::OS::Rhel8 (); # perlpkg line 238 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_cpanel_cloud_edition => 1; use constant can_be_elevated => 1; use constant can_elevate_to => [qw(Almalinux9)]; 1; } # --- END Cpanel/OS/Almalinux8.pm { # --- BEGIN Cpanel/OS/Rhel9.pm package Cpanel::OS::Rhel9; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Rhel8 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel8); } # use Cpanel::OS (); # perlpkg line 211 use constant is_supported => 0; # Rhel 9 is NOT supported but we use it as a base class for all Rhel derivatives. use constant support_needs_minor_at_least_at => 5; use constant networking => 'NetworkManager'; use constant package_repositories => [qw/epel crb/]; use constant binary_sync_source => 'linux-c9-x86_64'; use constant package_release_distro_tag => '~el9'; use constant program_to_apply_kernel_args => 'grubby'; use constant lsof_needs_prlimit => 1; use constant mysql_versions_use_repo_template => []; use constant mariadb_minimum_supported_version => '10.5'; sub rsync_old_args { return Cpanel::OS::minor() < 2 ? ['--old-args'] : [] } ## no critic qw(CpanelOS) -- behavior is conditional on minor release use constant crypto_policy_needs_sha1 => 1; use constant crypto_policy_os_provides_sha1_module => 1; use constant ea4_install_from_profile_enforce_packages => 0; use constant jetbackup_repo_pkg => 'https://repo.jetlicense.com/centOS/jetapps-repo-4096-latest.rpm'; use constant var_named_permissions => { 'mode' => 0770, 'ownership' => [ 'root', 'named' ], }; sub packages_supplemental ($self) { my @packages = $self->SUPER::packages_supplemental()->@*; push @packages, qw{ glibc-langpack-en s-nail }; return \@packages; } sub packages_required ($self) { my @packages = $self->SUPER::packages_required()->@*; @packages = sort grep { my $p = $_; !( grep { $p eq $_ } qw{ dnf-plugin-universal-hooks python36 python312 python3-docs mailx iptables } ) } @packages; push @packages, qw{ python3 libnsl2 dbus-tools openldap-compat iptables-nft }; return \@packages; } 1; } # --- END Cpanel/OS/Rhel9.pm { # --- BEGIN Cpanel/OS/Almalinux9.pm package Cpanel::OS::Almalinux9; use cPstrict; no warnings 'once'; use Cpanel::OS::Almalinux; # use parent Cpanel::OS::Rhel9 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel9); } use constant is_supported => 1; # Almalinux 9 use constant pretty_distro => Cpanel::OS::Almalinux->pretty_distro; 1; } # --- END Cpanel/OS/Almalinux9.pm { # --- BEGIN Cpanel/OS/Rhel10.pm package Cpanel::OS::Rhel10; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Rhel9 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel9); } use constant is_supported => 0; # Rhel 10 is NOT supported but we use it as a base class for all Rhel derivatives. use constant binary_sync_source => 'linux-c10-x86_64'; use constant package_release_distro_tag => '~el10'; use constant support_needs_minor_at_least_at => undef; use constant lsof_needs_prlimit => 0; use constant mariadb_versions_use_repo_template => [qw/10.11 11.4/]; use constant mariadb_minimum_supported_version => '10.11'; use constant crypto_policy_os_provides_sha1_module => 0; use constant postgresql_initdb_commands => ["/usr/bin/postgresql-setup --initdb --unit postgresql"]; sub packages_supplemental ($self) { my @packages = $self->SUPER::packages_supplemental()->@*; @packages = sort grep { my $p = $_; !( grep { $p eq $_ } qw{ nscd postgresql-libs } ) } @packages; push @packages, 'postgresql'; return \@packages; } sub packages_required ($self) { my @packages = $self->SUPER::packages_required()->@*; @packages = sort grep { my $p = $_; !( grep { $p eq $_ } qw{ dnf-plugin-universal-hooks pcre python3-html2text } ) } @packages; push @packages, qw{ libdb libxcrypt-compat }; return \@packages; } 1; } # --- END Cpanel/OS/Rhel10.pm { # --- BEGIN Cpanel/OS/Almalinux10.pm package Cpanel::OS::Almalinux10; use cPstrict; no warnings 'once'; use Cpanel::OS::Almalinux; # use parent Cpanel::OS::Rhel10 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel10); } use constant is_supported => 1; # Almalinux 10 use constant pretty_distro => Cpanel::OS::Almalinux->pretty_distro; 1; } # --- END Cpanel/OS/Almalinux10.pm { # --- BEGIN Cpanel/Server/Type.pm package Cpanel::Server::Type; use cPstrict; no warnings 'once'; use constant NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE => 1; sub _get_license_file_path { return q{/usr/local/cpanel/cpanel.lisc} } sub _get_dnsonly_file_path { return q{/var/cpanel/dnsonly} } use constant _ENOENT => 2; use constant SERVER_TYPE => q[cpanel]; my @server_config; our %PRODUCTS; our $MAXUSERS; our %FIELDS; our ( $DNSONLY_MODE, $NODE_MODE ); sub is_dnsonly { return $DNSONLY_MODE if defined $DNSONLY_MODE; return 1 if -e _get_dnsonly_file_path(); return 0 if $! == _ENOENT(); my $err = $!; if ( _read_license() ) { return $PRODUCTS{'dnsonly'} ? 1 : 0; } die sprintf( 'stat(%s): %s', _get_dnsonly_file_path(), "$err" ); } sub is_wp_squared { return SERVER_TYPE eq 'wp2'; } sub get_producttype { return $NODE_MODE if defined $NODE_MODE; return 'DNSONLY' unless _read_license(); return 'STANDARD' if $PRODUCTS{'cpanel'}; foreach my $product (qw/dnsnode mailnode databasenode dnsonly/) { return uc($product) if $PRODUCTS{$product}; } return 'DNSONLY'; } sub get_max_users { return $MAXUSERS if defined $MAXUSERS; return NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE unless _read_license(); return $MAXUSERS // NUMBER_OF_USERS_TO_ASSUME_IF_UNREADABLE; } sub get_license_expire_gmt_date { return $FIELDS{'license_expire_gmt_date'} if defined $FIELDS{'license_expire_gmt_date'}; return 0 unless _read_license(); return $FIELDS{'license_expire_gmt_date'} // 0; } sub is_licensed_for_product ($product) { return unless $product; $product = lc $product; return unless _read_license(); return exists $PRODUCTS{$product}; } sub get_features { return unless _read_license(); my @features = split( ",", $FIELDS{'features'} // '' ); return @features; } sub has_feature ( $feature = undef ) { length $feature or return; return ( grep { $_ eq $feature } get_features() ) ? 1 : 0; } sub get_products { return unless _read_license(); return keys %PRODUCTS; } sub _read_license { my $LICENSE_FILE = _get_license_file_path(); my @new_stat = stat($LICENSE_FILE) if @server_config; if ( @server_config && @new_stat && $new_stat[9] == $server_config[9] && $new_stat[7] == $server_config[7] ) { return 1; } open( my $fh, '<', $LICENSE_FILE ) or do { if ( $! != _ENOENT() ) { warn "open($LICENSE_FILE): $!"; } return; }; _reset_cache(); my $content; read( $fh, $content, 1024 ) // do { warn "read($LICENSE_FILE): $!"; $content = q<>; }; return _parse_license_contents_sr( $fh, \$content ); } sub _parse_license_contents_to_hashref ($content_sr) { my %vals = map { ( split( m{: }, $_ ) )[ 0, 1 ] } split( m{\n}, $$content_sr ); return \%vals; } sub _parse_license_contents_sr ( $fh, $content_sr ) { my $vals_hr = _parse_license_contents_to_hashref($content_sr); if ( length $vals_hr->{'products'} ) { %PRODUCTS = map { ( $_ => 1 ) } split( ",", $vals_hr->{'products'} ); } else { return; } if ( length $vals_hr->{'maxusers'} ) { $MAXUSERS //= int $vals_hr->{'maxusers'}; } else { return; } foreach my $field (qw/license_expire_time license_expire_gmt_date support_expire_time updates_expire_time/) { $FIELDS{$field} = $vals_hr->{$field} // 0; } foreach my $field (qw/client features/) { $FIELDS{$field} = $vals_hr->{$field} // ''; } if ( length $vals_hr->{'fields'} ) { foreach my $field ( split( ",", $vals_hr->{'fields'} ) ) { my ( $k, $v ) = split( '=', $field, 2 ); $FIELDS{$k} = $v; } } else { return; } @server_config = stat($fh); return 1; } sub _reset_cache { undef %PRODUCTS; undef %FIELDS; undef @server_config; undef $MAXUSERS; undef $DNSONLY_MODE; return; } 1; } # --- END Cpanel/Server/Type.pm { # --- BEGIN Cpanel/OS/Cloudlinux.pm package Cpanel::OS::Cloudlinux; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Rhel (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel); } # use Cpanel::Server::Type (); # perlpkg line 211 use constant is_supported => 0; # Base class for CL. use constant is_cloudlinux => 1; use constant pretty_distro => 'CloudLinux'; use constant supports_kernelcare_free => 0; use constant php_els_is_part_of_the_base_os => 1; sub ea4_yum_tooling { return [ qw{ yum-plugin-universal-hooks ea-cpanel-tools }, _ea_profiles() ]; } sub ea4_dnf_tooling { return [ qw{ dnf-plugin-universal-hooks ea-cpanel-tools }, _ea_profiles() ]; } sub _ea_profiles { if ( Cpanel::Server::Type::is_wp_squared() ) { return 'ea-profiles-cpanel'; } return 'ea-profiles-cloudlinux'; } 1; } # --- END Cpanel/OS/Cloudlinux.pm { # --- BEGIN Cpanel/OS/Cloudlinux8.pm package Cpanel::OS::Cloudlinux8; use cPstrict; no warnings 'once'; use Cpanel::OS::Cloudlinux; # use parent Cpanel::OS::Rhel8 (); # perlpkg line 238 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 php_els_is_part_of_the_base_os => Cpanel::OS::Cloudlinux->php_els_is_part_of_the_base_os; 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_install_bare_repo => 0; use constant ea4_from_bare_repo_url => undef; use constant ea4_from_bare_repo_path => undef; 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; 1; } # --- END Cpanel/OS/Cloudlinux8.pm { # --- BEGIN Cpanel/OS/Cloudlinux9.pm package Cpanel::OS::Cloudlinux9; use cPstrict; no warnings 'once'; use Cpanel::OS::Cloudlinux; # use parent Cpanel::OS::Rhel9 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel9); } use constant is_supported => 1; # Cloudlinux 9 use constant is_cloudlinux => 1; use constant pretty_distro => Cpanel::OS::Cloudlinux->pretty_distro; use constant php_els_is_part_of_the_base_os => Cpanel::OS::Cloudlinux->php_els_is_part_of_the_base_os; use constant ea4_install_repo_from_package => 1; use constant ea4_from_pkg_url => 'https://repo.cloudlinux.com/cloudlinux/EA4/cloudlinux-ea4-release-latest-9.noarch.rpm'; use constant ea4_from_pkg_reponame => 'cloudlinux-ea4-release'; use constant ea4tooling => Cpanel::OS::Cloudlinux->ea4_dnf_tooling; 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 who_wins_if_soft_gt_hard => 'hard'; 1; } # --- END Cpanel/OS/Cloudlinux9.pm { # --- BEGIN Cpanel/OS/Cloudlinux10.pm package Cpanel::OS::Cloudlinux10; use cPstrict; no warnings 'once'; use Cpanel::OS::Cloudlinux; # use parent Cpanel::OS::Rhel10 (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Rhel10); } use constant is_supported => 1; # Cloudlinux 10 use constant is_cloudlinux => 1; use constant pretty_distro => Cpanel::OS::Cloudlinux->pretty_distro; use constant php_els_is_part_of_the_base_os => Cpanel::OS::Cloudlinux->php_els_is_part_of_the_base_os; use constant ea4_install_repo_from_package => 1; use constant ea4_from_pkg_url => 'https://repo.cloudlinux.com/cloudlinux/EA4/cloudlinux-ea4-release-latest-10.noarch.rpm'; use constant ea4_from_pkg_reponame => 'cloudlinux-ea4-release'; use constant ea4tooling => Cpanel::OS::Cloudlinux->ea4_dnf_tooling; 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 who_wins_if_soft_gt_hard => 'hard'; 1; } # --- END Cpanel/OS/Cloudlinux10.pm { # --- BEGIN Cpanel/OS/Ubuntu.pm package Cpanel::OS::Ubuntu; use cPstrict; no warnings 'once'; # use Cpanel::OS::Linux (); # ea4tooling_all # perlpkg line 211 # use parent Cpanel::OS::Linux (); # perlpkg line 238 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 etc_shadow_groups => [ 'shadow', 'root' ]; use constant etc_shadow_perms => [ 0000, 0200, 0600, 0640 ]; 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 retry_rpm_cmd_no_tty_hack => 0; use constant base_distro => 'debian'; use constant rpm_versions_system => 'ubuntu'; use constant packages_arch => 'amd64'; use constant db_needs_preseed => 1; use constant mariadb_versions_use_repo_template => [ '10.5', '10.6', '10.11', '11.4' ]; use constant mysql_versions_use_repo_template => [ '8.0', '8.4' ]; 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 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 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 supports_hostaccess => 1; use constant iptables_ipv4_savefile => '/etc/iptables/rules.v4'; use constant iptables_ipv6_savefile => '/etc/iptables/rules.v6'; use constant nftables_config_file => '/etc/nftables.conf'; 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 outdated_services_check => q[needrestart_b]; use constant outdated_processes_check => q[checkrestart]; use constant check_reboot_method => q[check-reboot-required]; use constant syslog_service_name => 'rsyslog'; use constant rsyslog_triggered_by_socket => 1; use constant ea4_from_bare_repo_path => '/etc/apt/sources.list.d/EA4.list'; use constant cpsc_from_bare_repo_path => '/etc/apt/sources.list.d/CPSC.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 libonig-dev libtry-tiny-perl libwww-perl libyaml-syck-perl lsof nscd rpm strace sysstat tcpd util-linux } ]; 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.74.0 libcairo2-dev libcrack2 libdb5.3 libevent-2.1-7 libffi7 libfile-fcntllock-perl libfontconfig1-dev libgcc1 libgd-tools libgd3 libgmp10 libgomp1 libicu-dev libicu70 libidn12 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-posix3 libpcre3 libpq5 libpixman-1-0 libpng16-16 libpopt0 libreadline-dev libssl-dev libstdc++-9-dev libstdc++6 libsqlite0 libtiff5 libuser libxml2 libxml2-dev libxslt1.1 libzip4 libzstd1 linux-libc-dev lsof lua5.3 lua-socket make nano needrestart net-tools openssh-client openssh-server openssl passwd patch pcre2-utils pigz procps python-setuptools python3 python3-dnspython python3-html2text python3-minimal quota rdate rsync sed smartmontools ssl-cert sqlite sqlite3 sysstat tar unzip usrmerge wget xz-utils zip zlib1g } ]; use constant mariadb_packages => [qw( mariadb-server mariadb-client mariadb-common )]; use constant mariadb_incompatible_packages => [ qw( mariadb-devel mariadb-embedded mariadb-embedded-devel mariadb-libs mariadb-libs-compat mariadb-release mariadb-test mysql-community-client mysql-community-common mysql-community-devel mysql-community-embedded mysql-community-embedded-devel mysql-community-libs mysql-community-libs-compat mysql-community-release mysql-community-server mysql-community-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 mysql57-community-release mysql80-community-release 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 known_mariadb_deps => { 'libdbi-perl' => '', 'libvshadow-utils' => '', 'grep' => '', 'coreutils' => '', }; use constant db_disable_auth_socket => { 'unix_socket' => 'OFF', 'plugin-load-add' => 'auth_socket.so' }; use constant db_additional_conf_files => [ '/etc/mysql/debian.cnf', '/etc/mysql/mariadb.cnf' ]; use constant db_mariadb_default_conf_file => '/etc/mysql/mariadb.cnf'; use constant db_mariadb_start_file => '/etc/mysql/debian-start'; 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 tuxcare_els_php_install_url => "https://go.cpanel.net/install-els-alt-php-deb-repo-ip"; use constant supports_phpels => 1; 1; } # --- END Cpanel/OS/Ubuntu.pm { # --- BEGIN Cpanel/OS/Ubuntu22.pm package Cpanel::OS::Ubuntu22; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Ubuntu (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Ubuntu); } use constant is_supported => 1; use constant at_eol => 1; use constant can_be_elevated => 1; use constant can_elevate_to => [qw(Ubuntu24)]; use constant binary_sync_source => 'linux-u22-x86_64'; use constant package_release_distro_tag => '~u22'; use constant release_codename => 'jammy'; use constant binary_locations => { 'lsof' => '/usr/bin', 'named-checkzone' => '/usr/bin', 'named-checkconf' => '/usr/bin', }; use constant maillog_path => '/var/log/mail.log'; use constant firewall_module => 'NFTables'; use constant plugins_repo_url => 'https://securedownloads.cpanel.net/cpanel-plugins/xUbuntu_22.04.list'; use constant supports_cpanel_cloud_edition => 1; use constant ea4_install_bare_repo => 1; use constant ea4_from_bare_repo_url => 'https://securedownloads.cpanel.net/EA4/xUbuntu_22.04.list'; use constant cpsc_from_bare_repo_url => 'http://ea4testing.cpanel.net/CPSC.xUbuntu_22.04.list'; use constant cpsc_from_bare_repo_key_url => 'http://ea4testing.cpanel.net/CPSC/xUbuntu_22.04/Release.key'; use constant mysql_repo_template => <<'___END_REPO_TEMPLATE___'; deb https://repo.mysql.com/apt/ubuntu/ jammy mysql-apt-config deb https://repo.mysql.com/apt/ubuntu/ jammy mysql-###MYSQL_VERSION_SHORT### deb https://repo.mysql.com/apt/ubuntu/ jammy mysql-tools deb-src https://repo.mysql.com/apt/ubuntu/ jammy mysql-###MYSQL_VERSION_SHORT### ___END_REPO_TEMPLATE___ use constant mariadb_minimum_supported_version => '10.6'; use constant mariadb_repo_template => <<'___END_REPO_TEMPLATE___'; deb [arch=amd64,arm64] https://dlm.mariadb.com/repo/mariadb-server/###MARIADB_VERSION_SHORT###/repo/ubuntu jammy main deb [arch=amd64,arm64] https://dlm.mariadb.com/repo/mariadb-server/###MARIADB_VERSION_SHORT###/repo/ubuntu jammy main/debug ___END_REPO_TEMPLATE___ use constant stock_kernel_version_regex => qr/-(?:generic|lowlatency|kvm|aws|azure|gcp|gke(?:op)?|ibm|nvidia(?:-lowlatency)?|oracle)$/; use constant quota_packages_conditional => { 'linux-aws' => ['linux-modules-extra-aws'], 'linux-aws-edge' => ['linux-modules-extra-aws-edge'], 'linux-aws-lts-22.04' => ['linux-modules-extra-aws-lts-22.04'], 'linux-azure' => ['linux-modules-extra-azure'], 'linux-azure-edge' => ['linux-modules-extra-azure-edge'], 'linux-azure-fde' => ['linux-modules-extra-azure-fde'], 'linux-azure-fde-edge' => ['linux-modules-extra-azure-fde-edge'], 'linux-azure-fde-5.19-edge' => ['linux-modules-extra-azure-fde-5.19-edge'], 'linux-azure-fde-lts-22.04' => ['linux-modules-extra-azure-fde-lts-22.04'], 'linux-azure-lts-22.04' => ['linux-modules-extra-azure-lts-22.04'], 'linux-gcp' => ['linux-modules-extra-gcp'], 'linux-gcp-edge' => ['linux-modules-extra-gcp-edge'], 'linux-gcp-lts-22.04' => ['linux-modules-extra-gcp-lts-22.04'], 'linux-gkeop' => ['linux-modules-extra-gkeop'], 'linux-gkeop-5.15' => ['linux-modules-extra-gkeop-5.15'], 'linux-virtual' => ['linux-image-extra-virtual'], 'linux-virtual-hwe-22.04' => ['linux-image-extra-virtual-hwe-22.04'], 'linux-virtual-hwe-22.04-edge' => ['linux-image-extra-virtual-hwe-22.04-edge'], }; 1; } # --- END Cpanel/OS/Ubuntu22.pm { # --- BEGIN Cpanel/OS/Ubuntu24.pm package Cpanel::OS::Ubuntu24; use cPstrict; no warnings 'once'; # use parent Cpanel::OS::Ubuntu (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::OS::Ubuntu); } use constant is_supported => 1; use constant binary_sync_source => 'linux-u24-x86_64'; use constant package_release_distro_tag => '~u24'; use constant release_codename => 'noble'; use constant ssh_service_name => 'ssh'; use constant binary_locations => { 'lsof' => '/usr/bin', 'named-checkzone' => '/usr/bin', 'named-checkconf' => '/usr/bin', }; use constant maillog_path => '/var/log/mail.log'; use constant firewall_module => 'NFTables'; use constant plugins_repo_url => 'https://securedownloads.cpanel.net/cpanel-plugins/xUbuntu_24.04.list'; use constant ea4_install_bare_repo => 1; use constant ea4_from_bare_repo_url => 'https://securedownloads.cpanel.net/EA4/xUbuntu_24.04.list'; use constant mysql_repo_template => <<'___END_REPO_TEMPLATE___'; deb https://repo.mysql.com/apt/ubuntu/ noble mysql-apt-config deb https://repo.mysql.com/apt/ubuntu/ noble mysql-###MYSQL_VERSION_SHORT### deb https://repo.mysql.com/apt/ubuntu/ noble mysql-tools deb-src https://repo.mysql.com/apt/ubuntu/ noble mysql-###MYSQL_VERSION_SHORT### ___END_REPO_TEMPLATE___ use constant mariadb_versions_use_repo_template => [qw/10.11 11.4/]; use constant mariadb_minimum_supported_version => '10.11'; use constant mariadb_repo_template => <<'___END_REPO_TEMPLATE___'; deb [arch=amd64,arm64] https://dlm.mariadb.com/repo/mariadb-server/###MARIADB_VERSION_SHORT###/repo/ubuntu noble main deb [arch=amd64,arm64] https://dlm.mariadb.com/repo/mariadb-server/###MARIADB_VERSION_SHORT###/repo/ubuntu noble main/debug ___END_REPO_TEMPLATE___ use constant stock_kernel_version_regex => qr/-(?:generic|lowlatency|kvm|aws|azure|gcp|gke(?:op)?|ibm|nvidia(?:-lowlatency)?|oracle)$/; use constant quota_packages_conditional => { 'linux-aws' => ['linux-modules-extra-aws'], 'linux-aws-6.8' => ['linux-modules-extra-aws-6.8'], 'linux-aws-6.14' => ['linux-modules-extra-aws-6.14'], 'linux-aws-6.17' => ['linux-modules-extra-aws-6.17'], 'linux-aws-edge' => ['linux-modules-extra-aws-edge'], 'linux-aws-lts-24.04' => ['linux-modules-extra-aws-lts-24.04'], 'linux-azure' => ['linux-modules-extra-azure'], 'linux-azure-6.8' => ['linux-modules-extra-azure-6.8'], 'linux-azure-6.11' => ['linux-modules-extra-azure-6.11'], 'linux-azure-6.14' => ['linux-modules-extra-azure-6.14'], 'linux-azure-6.17' => ['linux-modules-extra-azure-6.17'], 'linux-azure-edge' => ['linux-modules-extra-azure-edge'], 'linux-azure-lts-24.04' => ['linux-modules-extra-azure-lts-24.04'], 'linux-azure-fde' => ['linux-modules-extra-azure-fde'], 'linux-azure-fde-6.8' => ['linux-modules-extra-azure-fde-6.8'], 'linux-azure-fde-6.11' => ['linux-modules-extra-azure-fde-6.11'], 'linux-azure-fde-6.14' => ['linux-modules-extra-azure-fde-6.14'], 'linux-azure-fde-6.17' => ['linux-modules-extra-azure-fde-6.17'], 'linux-azure-fde-edge' => ['linux-modules-extra-azure-fde-edge'], 'linux-azure-fde-lts-24.04' => ['linux-modules-extra-azure-fde-lts-24.04'], 'linux-gcp' => ['linux-modules-extra-gcp'], 'linux-gcp-6.8' => ['linux-modules-extra-gcp-6.8'], 'linux-gcp-6.11' => ['linux-modules-extra-gcp-6.11'], 'linux-gcp-6.14' => ['linux-modules-extra-gcp-6.14'], 'linux-gcp-6.17' => ['linux-modules-extra-gcp-6.17'], 'linux-gcp-edge' => ['linux-modules-extra-gcp-edge'], 'linux-gcp-lts-24.04' => ['linux-modules-extra-gcp-lts-24.04'], 'linux-gkeop' => ['linux-modules-extra-gkeop'], 'linux-gkeop-6.8' => ['linux-modules-extra-gkeop-6.8'], 'linux-virtual' => ['linux-image-extra-virtual'], 'linux-virtual-6.8' => ['linux-image-extra-virtual-6.8'], 'linux-virtual-6.11' => ['linux-image-extra-virtual-6.11'], 'linux-virtual-6.14' => ['linux-image-extra-virtual-6.14'], 'linux-virtual-6.17' => ['linux-image-extra-virtual-6.17'], }; sub packages_required ($self) { my %changes = ( "libaio1" => "libaio1t64", "libboost-program-options1.74.0" => "libboost-program-options1.83.0", "libevent-2.1-7" => "libevent-2.1-7t64", "libffi7" => "libffi8", "libicu70" => "libicu74", "libncurses5" => "libncurses6", "libpcap0.8" => "libpcap0.8t64", "libsqlite0" => "libsqlite3-0", "libtiff5" => "libtiff6", "libzip4" => "libzip4t64", "python-setuptools" => "python3-setuptools", ); my @packages = map { exists $changes{$_} ? () : $_ } grep { $_ ne 'usrmerge' && $_ ne 'sqlite' } @{ $self->SUPER::packages_required() }; push @packages, values %changes; return [ sort @packages ]; } 1; } # --- END Cpanel/OS/Ubuntu24.pm { # --- BEGIN Cpanel/OS/All.pm package Cpanel::OS::All; use cPstrict; no warnings 'once'; use utf8; # use Cpanel::OS::Almalinux8 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Almalinux9 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Almalinux10 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Cloudlinux8 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Cloudlinux9 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Cloudlinux10 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Ubuntu22 (); # PPI USE OK - fatpack usage # perlpkg line 211 # use Cpanel::OS::Ubuntu24 (); # PPI USE OK - fatpack usage # perlpkg line 211 sub supported_distros() { return ( [ Almalinux => 8 ], [ Almalinux => 9 ], [ Almalinux => 10 ], [ Cloudlinux => 8 ], [ Cloudlinux => 9 ], [ Cloudlinux => 10 ], [ Ubuntu => 22 ], [ Ubuntu => 24 ], ); } sub advertise_supported_distros() { my $current_name; my $current_versions = []; my $advertise = ''; my $map_os_display_name = { 'Almalinux' => 'AlmaLinux', 'Rhel' => 'Red Hat Enterprise Linux', 'Cloudlinux' => 'CloudLinux&reg;', }; 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; no warnings 'once'; use constant { _gettimeofday => 96, _clock_gettime => 228, _CLOCK_REALTIME => 0, _EINTR => 4, _PACK_TEMPLATE => 'L!L!', }; sub clock_gettime { my $timeval = pack( _PACK_TEMPLATE, () ); _get_time_from_syscall( _clock_gettime, _CLOCK_REALTIME, $timeval, ); return unpack( _PACK_TEMPLATE, $timeval ); } sub time { my ( $secs, $nsecs ) = clock_gettime(); return $secs + ( $nsecs / 1_000_000_000 ); } sub sleep { my ($secs) = @_; local $!; my $retval = select( undef, undef, undef, $secs ); if ( $retval == -1 && $! != _EINTR ) { require Cpanel::Exception; die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to suspend command execution for [quant,_1,second,seconds] because of an error: [_2]', [ $secs, $! ] ); } return $secs; } sub gettimeofday { my $timeval = pack( _PACK_TEMPLATE, () ); _get_time_from_syscall( _gettimeofday, $timeval, undef, ); return unpack( _PACK_TEMPLATE, $timeval ); } sub _get_time_from_syscall { ##no critic qw(RequireArgUnpacking) my $syscall_num = shift; local $!; my $retval = syscall( $syscall_num, @_ ); if ( $retval == -1 ) { require Cpanel::Exception; die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to retrieve the time because of an error: [_1]', [$!] ); } return; } 1; } # --- END Cpanel/TimeHiRes.pm { # --- BEGIN Cpanel/Struct/Common/Time.pm package Cpanel::Struct::Common::Time; use strict; use warnings; no warnings 'once'; use constant PACK_TEMPLATE => 'L!L!'; my %CLASS_PRECISION; sub float_to_binary { return pack( PACK_TEMPLATE(), int( $_[1] ), int( 0.5 + ( $_[0]->_PRECISION() * $_[1] ) - ( $_[0]->_PRECISION() * int( $_[1] ) ) ), ); } sub binary_to_float { return $_[0]->_binary_to_float( PACK_TEMPLATE(), $_[1] )->[0]; } sub binaries_to_floats_at { return $_[0]->_binary_to_float( "\@$_[3] " . ( PACK_TEMPLATE() x $_[2] ), $_[1], ); } my ( $i, $precision, @sec_psec_pairs ); sub _binary_to_float { ## no critic qw(RequireArgUnpacking) @sec_psec_pairs = unpack( $_[1], $_[2] ); $i = 0; my @floats; $precision = $CLASS_PRECISION{ $_[0] } ||= $_[0]->_PRECISION(); while ( $i < @sec_psec_pairs ) { push @floats, 0 + ( q<> . ( $sec_psec_pairs[$i] + ( $sec_psec_pairs[ $i + 1 ] / $precision ) ) ); $i += 2; } return \@floats; } 1; } # --- END Cpanel/Struct/Common/Time.pm { # --- BEGIN Cpanel/Struct/timespec.pm package Cpanel::Struct::timespec; use strict; use warnings; no warnings 'once'; # use parent Cpanel::Struct::Common::Time (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::Struct::Common::Time); } use constant { _PRECISION => 1_000_000_000, # nanoseconds }; 1; } # --- END Cpanel/Struct/timespec.pm { # --- BEGIN Cpanel/NanoStat.pm package Cpanel::NanoStat; use strict; use warnings; no warnings 'once'; # use Cpanel::Struct::timespec (); # perlpkg line 211 use constant { _NR_stat => 4, _NR_fstat => 5, _NR_lstat => 6, }; use constant _PACK_TEMPLATE => q< Q # st_dev Q # st_ino @24 L # st_mode @16 Q # st_nlink @28 L # st_uid L # st_gid x![Q] Q # st_rdev Q # st_size Q # st_blksize Q # st_blocks >; my $pre_times_pack_len = length pack _PACK_TEMPLATE(); my $buf = ( "\0" x 144 ); sub stat { return _syscall( _NR_stat(), $_[0] ); } sub lstat { return _syscall( _NR_lstat(), $_[0] ); } sub fstat { return _syscall( _NR_fstat(), 0 + ( ref( $_[0] ) ? fileno( $_[0] ) : $_[0] ) ); } sub _syscall { ## no critic qw(RequireArgUnpacking) my $arg_dupe = $_[1]; return undef if -1 == syscall( $_[0], $arg_dupe, $buf ); my @vals = unpack _PACK_TEMPLATE(), $buf; splice( @vals, 8, 0, @{ Cpanel::Struct::timespec->binaries_to_floats_at( $buf, 3, $pre_times_pack_len ) }, ); return @vals; } 1; } # --- END Cpanel/NanoStat.pm { # --- BEGIN Cpanel/NanoUtime.pm package Cpanel::NanoUtime; use strict; use warnings; no warnings 'once'; # use Cpanel::Struct::timespec (); # perlpkg line 211 use constant { _NR_utimensat => 280, _AT_FDCWD => -100, _AT_SYMLINK_NOFOLLOW => 0x100, }; sub utime { return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 ); } sub futime { return _syscall( 0 + ( ref( $_[2] ) ? fileno( $_[2] ) : $_[2] ), undef, @_[ 0, 1 ], 0, ); } sub lutime { return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 + _AT_SYMLINK_NOFOLLOW() ); } my ( $path, $buf ) = @_; sub _syscall { if ( defined $_[-3] ) { if ( defined $_[-2] ) { $buf = Cpanel::Struct::timespec->float_to_binary( $_[-3] ) . Cpanel::Struct::timespec->float_to_binary( $_[-2] ); } else { die "atime is “$_[-3]”, but mtime is undef!"; } } elsif ( defined $_[-2] ) { die "atime is undef, but mtime is “$_[-2]”!"; } else { $buf = undef; } $path = $_[1]; return undef if -1 == syscall( 0 + _NR_utimensat(), $_[0], $path // undef, $buf // undef, $_[-1] ); return 1; } 1; } # --- END Cpanel/NanoUtime.pm { # --- BEGIN Cpanel/HiRes.pm package Cpanel::HiRes; use strict; use warnings; no warnings 'once'; my %_routes = ( 'fstat' => [ 'NanoStat', 'fstat', 'stat', 1 ], 'lstat' => [ 'NanoStat', 'lstat', 'lstat', 1 ], 'stat' => [ 'NanoStat', 'stat', 'stat', 1 ], 'time' => [ 'TimeHiRes', 'time', 'time' ], 'utime' => [ 'NanoUtime', 'utime', 'utime' ], 'futime' => [ 'NanoUtime', 'futime', 'utime' ], 'lutime' => [ 'NanoUtime', 'lutime', undef ], ); my $preloaded; sub import { my ( $class, %opts ) = @_; if ( my $preload = $opts{'preload'} ) { if ( $preload eq 'xs' ) { require Time::HiRes; } elsif ( $preload eq 'perl' ) { if ( !$preloaded ) { require Cpanel::TimeHiRes; # PPI USE OK - preload require Cpanel::NanoStat; # PPI USE OK - preload require Cpanel::NanoUtime; # PPI USE OK - preload } } else { die "Unknown “preload”: “$preload”"; } $preloaded = $preload; } return; } our $AUTOLOAD; sub AUTOLOAD { ## no critic qw(Subroutines::RequireArgUnpacking) substr( $AUTOLOAD, 0, 1 + rindex( $AUTOLOAD, ':' ) ) = q<>; if ( !$AUTOLOAD || !$_routes{$AUTOLOAD} ) { die "Unknown function in Cpanel::HiRes::$_[0]"; } my $function = $AUTOLOAD; undef $AUTOLOAD; my ( $pp_module, $pp_function, $xs_function, $xs_needs_closure ) = @{ $_routes{$function} }; no strict 'refs'; if ( $INC{'Time/HiRes.pm'} && $xs_function ) { *$function = *{"Time::HiRes::$xs_function"}; return Time::HiRes->can($xs_function)->(@_); } else { _require("Cpanel/${pp_module}.pm") if !$INC{"Cpanel/${pp_module}.pm"}; my $pp_cr = "Cpanel::${pp_module}"->can($pp_function); if ($xs_function) { *$function = sub { if ( $INC{'Time/HiRes.pm'} ) { *$function = *{"Time::HiRes::$xs_function"}; return Time::HiRes->can($xs_function)->(@_); } goto &$pp_cr; }; } else { *$function = $pp_cr; } } goto &$function; } sub _require { local ( $!, $^E, $@ ); require $_[0]; return; } 1; } # --- END Cpanel/HiRes.pm { # --- BEGIN Cpanel/Env.pm package Cpanel::Env; use strict; use warnings; no warnings 'once'; our $VERSION = '1.7'; my $SAFE_ENV_VARS; BEGIN { $SAFE_ENV_VARS = q< ALLUSERSPROFILE APPDATA BUNDLE_PATH CLIENTNAME COMMONPROGRAMFILES COMPUTERNAME COMSPEC CPANEL_BASE_INSTALL CPANEL_IS_CRON CPANEL_RPM_LOCKED_IN_PARENT CPBACKUP DEBIAN_FRONTEND DEBIAN_PRIORITY DOCUMENT_ROOT FORCEDCPUPDATE FP_NO_HOST_CHECK HOMEDRIVE HOMEPATH LANG LANGUAGE LC_ALL LC_MESSAGES LC_CTYPE LOGONSERVER NEWWHMUPDATE NOTIFY_SOCKET NUMBER_OF_PROCESSORS OPENSSL_NO_DEFAULT_ZLIB OS PATH PATHEXT PROCESSOR_ARCHITECTURE PROCESSOR_IDENTIFIER PROCESSOR_LEVEL PROCESSOR_REVISION PROGRAMFILES PROMPT PYTHONIOENCODING SERVER_SOFTWARE SESSIONNAME SKIP_DEFERRAL_CHECK SSH_CLIENT SYSTEMDRIVE SYSTEMROOT TEMP TERM TMP UPDATENOW_NO_RETRY UPDATENOW_PRESERVE_FAILED_FILES USERDOMAIN USERNAME USERPROFILE WINDIR >; $SAFE_ENV_VARS =~ tr<\n >< >s; $SAFE_ENV_VARS =~ s<\A\s+><>; } { no warnings 'once'; *cleanenv = *clean_env; } sub clean_env { my %OPTS = @_; my %SAFE_ENV_VARS = map { $_ => undef } split( m{ }, $SAFE_ENV_VARS ); if ( defined $OPTS{'keep'} && ref $OPTS{'keep'} eq 'ARRAY' ) { @SAFE_ENV_VARS{ @{ $OPTS{'keep'} } } = undef; } if ( defined $OPTS{'delete'} && ref $OPTS{'delete'} eq 'ARRAY' ) { delete @SAFE_ENV_VARS{ @{ $OPTS{'delete'} } }; } delete @ENV{ grep { !exists $SAFE_ENV_VARS{$_} } keys %ENV }; if ( $OPTS{'http_purge'} ) { delete @ENV{ 'SERVER_SOFTWARE', 'DOCUMENT_ROOT' }; } return; } sub get_safe_env_vars { return $SAFE_ENV_VARS; } sub get_safe_path { return '/usr/local/jdk/bin:/usr/kerberos/sbin:/usr/kerberos/bin:/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/X11R6/bin:/usr/local/bin:/usr/X11R6/bin:/root/bin:/opt/bin'; } sub set_safe_path { return ( $ENV{'PATH'} = get_safe_path() ); } 1; } # --- END Cpanel/Env.pm { # --- BEGIN Cpanel/Hash/Stringify.pm package Cpanel::Hash::Stringify; use strict; use warnings; no warnings 'once'; sub sorted_hashref_string { my ($hashref) = @_; return ( ( scalar keys %$hashref ) ? join( '_____', map { $_, ( ref $hashref->{$_} eq 'HASH' ? sorted_hashref_string( $hashref->{$_} ) : ref $hashref->{$_} eq 'ARRAY' ? join( '_____', @{ $hashref->{$_} } ) : defined $hashref->{$_} ? $hashref->{$_} : '' ) } sort keys %$hashref ) : '' ); #sort is important for order; } 1; } # --- END Cpanel/Hash/Stringify.pm { # --- BEGIN Cpanel/Time/Local.pm package Cpanel::Time::Local; use strict; our $server_offset_string; our ( $timecacheref, $localtimecacheref ) = ( [ -1, '', -1 ], [ -1, '', -1 ] ); my $server_offset; my $localtime_link_or_mtime; our $ETC_LOCALTIME = q{/etc/localtime}; sub _clear_caches { undef $_ for ( $server_offset, $server_offset_string, $timecacheref, $localtimecacheref, $localtime_link_or_mtime, ); return; } sub localtime2timestamp { my ( $time, $delimiter ) = @_; $delimiter ||= ' '; $time ||= time(); return $localtimecacheref->[2] if $localtimecacheref->[0] == $time && $localtimecacheref->[1] eq $delimiter; my $tz_offset = get_server_offset_as_offset_string($time); my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime $time; @{$localtimecacheref}[ 0, 1 ] = ( $time, $delimiter ); return ( $localtimecacheref->[2] = sprintf( '%04d-%02d-%02d' . $delimiter . '%02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz_offset ) ); } sub get_server_offset_as_offset_string { my ($time_supplied) = @_; if ( !$time_supplied ) { my $link_or_mtime; if ( -l $ETC_LOCALTIME ) { $link_or_mtime = readlink($ETC_LOCALTIME); } else { $link_or_mtime = ( stat($ETC_LOCALTIME) )[9]; } if ( defined $link_or_mtime ) { $localtime_link_or_mtime ||= $link_or_mtime; if ( $localtime_link_or_mtime ne $link_or_mtime ) { _clear_caches(); $localtime_link_or_mtime = $link_or_mtime; } } } if ( $time_supplied || !defined $server_offset_string ) { UNTIL_SAME_SECOND: { my $starttime = time(); my $time = $time_supplied || $starttime; my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) = localtime $time; my ( $gmmin, $gmhour, $gmyear, $gmyday ) = ( gmtime($time) )[ 1, 2, 5, 7 ]; redo UNTIL_SAME_SECOND if time != $starttime; my $yday_offset; if ( $year == $gmyear ) { $yday_offset = ( $yday <=> $gmyday ); } elsif ( $year < $gmyear ) { $yday_offset = -1; } elsif ( $year > $gmyear ) { $yday_offset = 1; } my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * $yday_offset; my $offset_string = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 ); if ($time_supplied) { return $offset_string; } else { $server_offset_string = $offset_string; } } } return $server_offset_string; } sub get_server_offset_in_seconds { if ( !defined $server_offset ) { if ( get_server_offset_as_offset_string() =~ m/([-+]?[0-9]{2})([0-9]{2})/ ) { my ( $hours, $minutes ) = ( $1, $2 ); my $seconds = ( ( abs($hours) * 60 * 60 ) + ( $minutes * 60 ) ); $server_offset = $hours < 0 ? "-$seconds" : $seconds; } else { $server_offset = 0; } } return $server_offset; } 1; } # --- END Cpanel/Time/Local.pm { # --- BEGIN Cpanel/Fcntl/Constants.pm package Cpanel::Fcntl::Constants; use strict; use warnings; no warnings 'once'; BEGIN { our $O_RDONLY = 0; our $O_WRONLY = 1; our $O_RDWR = 2; our $O_ACCMODE = 3; our $F_GETFD = 1; our $F_SETFD = 2; our $F_GETFL = 3; our $F_SETFL = 4; our $SEEK_SET = 0; our $SEEK_CUR = 1; our $SEEK_END = 2; our $S_IWOTH = 2; our $S_ISUID = 2048; our $S_ISGID = 1024; our $O_CREAT = 64; our $O_EXCL = 128; our $O_TRUNC = 512; our $O_APPEND = 1024; our $O_NONBLOCK = 2048; our $O_DIRECTORY = 65536; our $O_NOFOLLOW = 131072; our $O_CLOEXEC = 524288; our $S_IFREG = 32768; our $S_IFDIR = 16384; our $S_IFCHR = 8192; our $S_IFBLK = 24576; our $S_IFIFO = 4096; our $S_IFLNK = 40960; our $S_IFSOCK = 49152; our $S_IFMT = 61440; our $LOCK_SH = 1; our $LOCK_EX = 2; our $LOCK_NB = 4; our $LOCK_UN = 8; our $FD_CLOEXEC = 1; } 1; } # --- END Cpanel/Fcntl/Constants.pm { # --- BEGIN Cpanel/Fcntl.pm package Cpanel::Fcntl; use strict; use warnings; no warnings 'once'; # use Cpanel::Fcntl::Constants (); # perlpkg line 211 my %CONSTANTS; my %CACHE; sub or_flags { my (@flags) = @_; my $flag_cache_key = join( '|', @flags ); return $CACHE{$flag_cache_key} if defined $CACHE{$flag_cache_key}; my $numeric = 0; foreach my $o_const (@flags) { $numeric |= ( $CONSTANTS{$o_const} ||= do { my $glob = $Cpanel::Fcntl::Constants::{$o_const}; my $number_r = $glob && *{$glob}{'SCALAR'}; die "Missing \$Cpanel::Fcntl::Constants::$o_const! (does it need to be added?)" if !$number_r; $$number_r; } ); } return ( $CACHE{$flag_cache_key} = $numeric ); } 1; } # --- END Cpanel/Fcntl.pm { # --- BEGIN Cpanel/FileUtils/Open.pm package Cpanel::FileUtils::Open; use strict; # use Cpanel::Fcntl (); # perlpkg line 211 sub sysopen_with_real_perms { ##no critic qw(RequireArgUnpacking) my ( $file, $mode, $custom_perms ) = ( @_[ 1 .. 3 ] ); if ( $mode && substr( $mode, 0, 1 ) eq 'O' ) { $mode = Cpanel::Fcntl::or_flags( split m<\|>, $mode ); } my ( $sysopen_perms, $original_umask ); if ( defined $custom_perms ) { $custom_perms &= 0777; $original_umask = umask( $custom_perms ^ 07777 ); $sysopen_perms = $custom_perms; } else { $sysopen_perms = 0666; } my $ret = sysopen( $_[0], $file, $mode, $sysopen_perms ); if ( defined $custom_perms ) { () = umask($original_umask); } return $ret; } 1; } # --- END Cpanel/FileUtils/Open.pm { # --- BEGIN Cpanel/Parser/Vars.pm package Cpanel::Parser::Vars; use strict; our $current_tag = ''; our $can_leave_cpanelaction = 1; our $buffer = ''; our $loaded_api = 0; our $trial_mode = 0; our $sent_headers = 0; our $live_socket_file; our $incpanelaction = 0; our $altmode = 0; our $jsonmode = 0; our $javascript = 0; our $title = 0; our $input = 0; our $style = 0; our $embtag = 0; our $textarea = 0; our $file = '[stdin]'; our $firstfile = '[stdin]'; our $trap_defaultfh = undef; # Known to be boolean. our %BACKCOMPAT; our $cptag; our $sent_content_type; 1; } # --- END Cpanel/Parser/Vars.pm { # --- BEGIN Cpanel/Encoder/Tiny/Rare.pm package Cpanel::Encoder::Tiny::Rare; use strict; use warnings; no warnings 'once'; sub angle_bracket_decode { my ($string) = @_; $string =~ s{ &lt; }{<}xmsg; $string =~ s{ &gt; }{>}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 = ( '&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&apos;' ); my %HTML_ENCODE_MAP = ( '&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&#39;' ); 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{<}{&lt;}xmsg; $string =~ s{>}{&gt;}xmsg; return $string; } sub safe_xml_encode_str { my $data = join( '', @_ ); return $data if $data !~ tr/&<>"'//; $data =~ s/([&<>"'])/$XML_ENCODE_MAP{$1}/sg; return $data; } sub safe_html_encode_str { return $_[0] if !defined $_[0] || ( !defined $_[1] && $_[0] !~ tr/&<>"'// ); my $data = defined $_[1] ? join( '', @_ ) : $_[0]; return $data if $data !~ tr/&<>"'//; $data =~ s/([&<>"'])/$HTML_ENCODE_MAP{$1}/sg; return $data; } sub safe_html_decode_str { return undef if !defined $_[0]; my $data = join( '', @_ ); $data =~ s/$decode_regex/$HTML_DECODE_MAP{$1}/g; return $data; } sub css_encode_str { require Cpanel::Encoder::Tiny::Rare; *css_encode_str = *Cpanel::Encoder::Tiny::Rare::css_encode_str; goto \&Cpanel::Encoder::Tiny::Rare::css_encode_str; } 1; } # --- END Cpanel/Encoder/Tiny.pm { # --- BEGIN Cpanel/Regex.pm package Cpanel::Regex; use strict; our $VERSION = '0.2.5'; my $dblquotedstr = q{"([^\\\\"]*(?:\\\\.[^\\\\"]*)*)"}; my $sglquotedstr = $dblquotedstr; $sglquotedstr =~ tr{"}{'}; my $zero_through_255 = '(?:25[0-5]|2[0-4][0-9]|1[0-9]{2}|[1-9][0-9]?|0)'; our %regex = ( 'emailaddr' => '[a-zA-Z0-9!#\$\-=?^_{}~]+(?:\.[a-zA-Z0-9!#\$\-=?^_{}~]+)*(?:\+[a-zA-Z0-9 \.=\-\_]+)*\@[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?(?:\.[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?)*', 'oneplusdot' => '\.+', 'oneplusspacetab' => '[\s\t]+', 'multipledot' => '\.{2,}', 'commercialat' => '\@', 'plussign' => '\+', 'singledot' => '\.', 'newline' => '\n', 'doubledot' => '\.\.', 'lineofdigits' => '^\d+$', 'lineofnonprintingchars' => '^[\s\t]*$', 'getemailtransport' => '^from\s+.*\s+by\s+\S+\s+with\s+(\S+)', 'getreceivedfrom' => '^from\s+(.*)\s+by\s+', 'emailheaderterminator' => '^[\r\n]*$', 'forwardslash' => '\/', 'backslash' => chr(92) x 4, 'singlequote' => q('), 'doublequote' => '"', 'allspacetabchars' => '[\s\t]*', 'beginswithspaceortabs' => '^[\s\t]', doublequotedstring => $dblquotedstr, singlequotedstring => $sglquotedstr, DUNS => '[0-9]{2}(?:-[0-9]{3}-[0-9]{4}|[0-9]{7})', YYYY_MM_DD => '[0-9]{4}-(?:1[012]|0[1-9])-(?:3[01]|[12][0-9]|0[1-9])', ipv4 => "(?:$zero_through_255\.){3}$zero_through_255", iso_z_time => '[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}Z', ); 1; } # --- END Cpanel/Regex.pm { # --- BEGIN Cpanel/Carp.pm package Cpanel::Carp; use strict; # use Cpanel::Parser::Vars (); # perlpkg line 211 our ( $SHOW_TRACE, $OUTPUT_FORMAT, $VERBOSE ) = ( 1, 'text', 0 ); my $__CALLBACK_AFTER_DIE_SPEW; # Set when we need to run a code ref after spewing on die my $error_count = 0; sub import { return enable(); } sub enable { my ( $callback_before_warn_or_die_spew, # Runs before the spew on warn or die, currently used in cpanel to ensure we emit headers before body in the event of a warn or die spew $callback_before_die_spew, # Runs before the spew on die, not currently used $callback_after_die_spew, # Runs after the spew on die, currently used in whostmgr to ensure we emit the javascript footer when we die to avoid the UI breaking ) = @_; $SIG{'__WARN__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars) my @caller = caller(1); return if defined $caller[3] && index( $caller[3], 'eval' ) > -1; # Case 35335: Quiet spurious warn errors from evals ++$error_count; my $time = time(); my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time); my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ]; my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday ); my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 ); my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz ); my $longmess; my $ignorable; if ( UNIVERSAL::isa( $_[0], 'Cpanel::Exception' ) ) { $longmess = Cpanel::Carp::safe_longmess( $_[0]->to_locale_string() ); } elsif ( ref $_[0] eq 'Template::Exception' ) { $longmess = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $_[0]->[0] . "]\n\t[INFO]=[" . $_[0]->[1] . "]\n\t[TEXT]=[" . ( ref $_[0]->[2] eq 'SCALAR' ? ${ $_[0]->[2] } : $_[0]->[2] ) . "]\n" ); } else { $longmess = Cpanel::Carp::safe_longmess(@_); $ignorable = 1 if index( $_[0], 'Use of uninitialized value' ) == 0; } my $error_container_text = 'A warning occurred while processing this directive.'; my $current_file = $Cpanel::Parser::Vars::file || 'unknown'; print STDERR "[$error_timestamp] warn [Internal Warning while parsing $current_file $$] $longmess\n\n"; return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} ); return if $ignorable && !$VERBOSE; _run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew; if ( $OUTPUT_FORMAT eq 'html' ) { if ($SHOW_TRACE) { _print_without_die_handler( _generate_html_error_message( 'warn', $error_container_text, $longmess ) ); } else { _print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("<error>$error_container_text</error>"); } else { _print_without_die_handler("[$error_container_text]\n"); } }; $SIG{'__DIE__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars) return if $^S; die $_[0] unless defined $^S; delete $SIG{'__DIE__'}; _run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew; _run_callback_without_die_handler($callback_before_die_spew) if $callback_before_die_spew; $__CALLBACK_AFTER_DIE_SPEW = $callback_after_die_spew; goto \&spew_on_die; }; return 1; } sub spew_on_die { ## no critic qw(Subroutines::RequireArgUnpacking) my ($err) = @_; ++$error_count; my $time = time(); my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time); my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ]; my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday ); my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 ); my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz ); my $error_text; if ( UNIVERSAL::isa( $err, 'Cpanel::Exception' ) ) { $error_text = Cpanel::Carp::safe_longmess( $err->to_locale_string() ); } elsif ( UNIVERSAL::isa( $err, 'Template::Exception' ) ) { $error_text = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $err->type() . "]\n\t[INFO]=[" . $err->info() . "]\n\t[TEXT]=[" . $err->text() . "]\n" ); } else { $error_text = Cpanel::Carp::safe_longmess(@_); } my $current_file = $Cpanel::Parser::Vars::file || 'unknown'; print STDERR "[$error_timestamp] die [Internal Death while parsing $current_file $$] $error_text\n\n"; return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} ); my $error_container_text = 'A fatal error or timeout occurred while processing this directive.'; if ( $OUTPUT_FORMAT eq 'html' ) { if ($SHOW_TRACE) { _print_without_die_handler( _generate_html_error_message( 'error', $error_container_text, $error_text ) ); } else { _print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>}); } } elsif ( $OUTPUT_FORMAT eq 'xml' ) { _print_without_die_handler("<error>[$error_container_text]</error>"); } else { _print_without_die_handler("[$error_container_text]\n"); } _run_callback_without_die_handler($__CALLBACK_AFTER_DIE_SPEW) if $__CALLBACK_AFTER_DIE_SPEW; return; } my @SAFE_LONGMESS_KEY_REGEXP_ITEMS = ( '(?<![a-zA-Z0-9_])pw(?![a-zA-Z0-9_])', qw( hash pass auth root key fullbackup ), ); my @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS = ( @SAFE_LONGMESS_KEY_REGEXP_ITEMS, '__ANON__', ); sub _print_without_die_handler { my ($text) = @_; local $SIG{'__WARN__'} = sub { }; local $SIG{'__DIE__'} = 'DEFAULT'; return print $text; } sub _run_callback_without_die_handler { my ($callback) = @_; local $SIG{'__WARN__'} = sub { }; local $SIG{'__DIE__'} = 'DEFAULT'; return $callback->(); } sub _generate_html_error_message { my ( $type, $error_container_message, $error_message ) = @_; require Cpanel::Encoder::Tiny; my $safe_error_message = Cpanel::Encoder::Tiny::safe_html_encode_str($error_message); return qq[ <style type="text/css">.cpanel_internal_message_container {display: inline-block; margin: 10px; width: auto;} .cpanel_internal_message { border: 1px solid #fff; outline-style: solid; outline-width: 1px; outline-color: #aaa; padding: 5px; } .cpanel_internal_error_warn { background-color: #FFF6CF; } .cpanel_internal_error_error { background-color: #F8E7E6; }</style> <div id="cpanel_notice_item_$error_count" class="cjt-pagenotice-container cjt-notice-container cpanel_internal_message_container internal-error-container"> <div class="yui-module cjt-notice cjt-pagenotice cjt-notice-$type"> <div class="cpanel_internal_message cpanel_internal_error_$type bd"> <div class="cjt-notice-content" style="width: 420px;"> <span> $error_container_message <a class="error" style="cursor:hand;cursor:pointer;" onClick="document.getElementById('cpanel_internal_error_$error_count').style.display='';this.style.display='none'; return false;"> [show] </a> <a class="error" style="cursor:hand;cursor:pointer;" onClick="document.getElementById('cpanel_notice_item_$error_count').style.display='none'; return false;"> [close] </a> </span> <div id="cpanel_internal_error_$error_count" style="display:none;"> <textarea class="cpanel_internal_error_$type" style="font-weight:900; height:200px; width:410px; color: black;">$safe_error_message</textarea> </div> </div> </div> </div> </div> ]; } sub safe_longmess { require Carp; $Carp::Internal{'Cpanel::Carp'} = 1; return sanitize_longmess( scalar Carp::longmess(@_) ); } my ( $key_regexp, $key_regexp_double, $function_regexp ); sub sanitize_longmess { _build_regexes() if !$key_regexp; return join( "\n", map { ( tr{'"}{} && ( m{$key_regexp}o || m{$key_regexp_double}o || ( ( $_ =~ m{^[ \t]*([^\(]+)\(} )[0] || '' ) =~ m{$function_regexp}o ) ) # matches a line that needs to be sanitized && _sanitize_line($_); # sanitize $_ } split( m{\n}, $_[0] ) ) . "\n"; } sub error_count { return $error_count; } sub _sanitize_line { # Operates directly on $_[0] for speed if ( !$INC{'Cpanel/Regex.pm'} ) { # PPI NO PARSE - inc check local $@; eval { local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::Regex; # PPI NO PARSE - inc check }; } $_[0] =~ s/$Cpanel::Regex::regex{'singlequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{'} ) != -1; $_[0] =~ s/$Cpanel::Regex::regex{'doublequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{"} ) != -1; return 1; } sub _build_regexes { my $key_regexp_items = join '|', @SAFE_LONGMESS_KEY_REGEXP_ITEMS; $key_regexp = qr< ' .*? (?: $key_regexp_items ) .*? ' \s* , >x; $key_regexp_double = $key_regexp; $key_regexp_double =~ tr{'}{"}; # "' fix for poor editors my $function_regexp_items = join '|', @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS; $function_regexp = qr< :: .*? (?: $function_regexp_items ) .*? $ >x; return 1; } 1; } # --- END Cpanel/Carp.pm { # --- BEGIN Cpanel/Set.pm package Cpanel::Set; use strict; use warnings; no warnings 'once'; sub difference { my ($super_ar) = @_; my %lookup; @lookup{ map { @$_ } @_[ 1 .. $#_ ] } = (); return grep { !exists $lookup{$_} } @$super_ar; } sub intersection { my ( $super_ar, $sub_ar ) = @_; my %lookup; @lookup{@$sub_ar} = (); return grep { exists $lookup{$_} } @$super_ar; } 1; } # --- END Cpanel/Set.pm { # --- BEGIN Cpanel/SafeFileLock.pm package Cpanel::SafeFileLock; use strict; use warnings; no warnings 'once'; use constant { _ENOENT => 2, _EDQUOT => 122, DEBUG => 0, MAX_LOCKFILE_SIZE => 8192, }; sub new { my ( $class, $path_to_lockfile, $fh, $path_to_file_being_locked ) = @_; if ( scalar @_ != 4 ) { die 'Usage: Cpanel::SafeFileLock->new($path_to_lockfile, $fh, $path_to_file_being_locked)'; } if ($fh) { write_lock_contents( $fh, $path_to_lockfile ) or return; } my $self = bless [ $path_to_lockfile, $fh, $path_to_file_being_locked, ], $class; push @$self, @{ $self->stat_ar() }[ 1, 9 ]; return $self; } sub new_before_lock { my ( $class, $path_to_lockfile, $path_to_file_being_locked ) = @_; if ( scalar @_ != 3 ) { die 'Usage: Cpanel::SafeFileLock->new_before_lock($path_to_lockfile, $path_to_file_being_locked)'; } return bless [ $path_to_lockfile, undef, $path_to_file_being_locked, ], $class; } sub set_filehandle_and_unlinker_after_lock { $_[0][1] = $_[1]; push @{ $_[0] }, @{ $_[0]->stat_ar() }[ 1, 9 ]; $_[0][5] = $_[2]; return $_[0]; } sub get_path { return $_[0]->[0]; } sub get_path_to_file_being_locked { return $_[0]->[2] // die "get_path_to_file_being_locked requires the object to be instantiated with the path_to_file_being_locked"; } sub set_filehandle { $_[0][1] = $_[1]; return $_[0]; } sub get_filehandle { return $_[0]->[1]; } sub get_inode { return $_[0]->[3]; } sub get_mtime { return $_[0]->[4]; } sub get_path_fh_inode_mtime { return @{ $_[0] }[ 0, 1, 3, 4 ]; } sub stat_ar { return [ stat( ( $_[0]->[1] && fileno( $_[0]->[1] ) ) ? $_[0]->[1] : $_[0]->[0] ) ]; } sub lstat_ar { return [ $_[0]->[1] && fileno( $_[0]->[1] ) ? stat( $_[0]->[1] ) : lstat( $_[0]->[0] ) ]; } sub close { return close $_[0]->[1] if ref $_[0]->[1]; $_[0]->[5] = undef; return; } sub write_lock_contents { ## no critic qw(Subroutines::RequireArgUnpacking) -- only unpack on the failure case local $!; if (DEBUG) { require Cpanel::Carp; return 1 if syswrite( $_[0], "$$\n$0\n" . Cpanel::Carp::safe_longmess() . "\n" ); } return 1 if syswrite( $_[0], "$$\n$0\n" ); my ( $fh, $path_to_lockfile ) = @_; my $write_error = $!; CORE::close($fh); unlink $path_to_lockfile; require Cpanel::Exception; die Cpanel::Exception::create( 'IO::FileWriteError', [ 'path' => $path_to_lockfile, 'error' => $write_error ] ); } sub fetch_lock_contents_if_exists { my ($lockfile) = @_; die 'Need lock file!' if !$lockfile; open my $lockfile_fh, '<:stdio', $lockfile or do { return if $! == _ENOENT(); die "open($lockfile): $!"; }; my $buffer; my $read_result = read( $lockfile_fh, $buffer, MAX_LOCKFILE_SIZE ); if ( !defined $read_result ) { die "read($lockfile): $!"; } my ( $pid_line, $lock_name, $lock_obj ) = split( /\n/, $buffer, 3 ); chomp($lock_name) if length $lock_name; my ($lock_pid) = $pid_line && ( $pid_line =~ m/(\d+)/ ); return ( $lock_pid, $lock_name || 'unknown', $lock_obj || 'unknown', $lockfile_fh ); } 1; } # --- END Cpanel/SafeFileLock.pm { # --- BEGIN Cpanel/FHUtils/Tiny.pm package Cpanel::FHUtils::Tiny; use strict; use warnings; no warnings 'once'; sub is_a { return !ref $_[0] ? 0 : ( ref $_[0] eq 'IO::Handle' || ref $_[0] eq 'GLOB' || UNIVERSAL::isa( $_[0], 'GLOB' ) ) ? 1 : 0; } sub are_same { my ( $fh1, $fh2 ) = @_; return 1 if $fh1 eq $fh2; if ( fileno($fh1) && ( fileno($fh1) != -1 ) && fileno($fh2) && ( fileno($fh2) != -1 ) ) { return 1 if fileno($fh1) == fileno($fh2); } return 0; } sub to_bitmask { my @fhs = @_; my $mask = q<>; for my $fh (@fhs) { vec( $mask, ref($fh) ? fileno($fh) : $fh, 1 ) = 1; } return $mask; } 1; } # --- END Cpanel/FHUtils/Tiny.pm { # --- BEGIN Cpanel/Hash.pm package Cpanel::Hash; use strict; *get_fastest_hash = \&fnv1a_32; use constant FNV1_32A_INIT => 0x811c9dc5; use constant FNV_32_PRIME => 0x01000193; use constant FNV_32_MOD => 2**32; # AKA 0x100000000 but that it non-portable; sub fnv1a_32 { my $fnv32 = FNV1_32A_INIT(); ( $fnv32 = ( ( $fnv32 ^ $_ ) * FNV_32_PRIME() ) % FNV_32_MOD ) for unpack( 'C*', $_[0] ); return $fnv32; } 1; } # --- END Cpanel/Hash.pm { # --- BEGIN Cpanel/SafeFile/LockInfoCache.pm package Cpanel::SafeFile::LockInfoCache; use strict; use warnings; no warnings 'once'; # use Cpanel::SafeFileLock (); # perlpkg line 211 sub new { my ( $class, $pathname ) = @_; die 'need path!' if !$pathname; return bless { _path => $pathname }, $class; } sub get { my ( $self, $inode, $mtime ) = @_; die 'Need an inode & an mtime!' if !defined $inode || !defined $mtime; if ( !exists $self->{"_inode_${inode}_$mtime"} ) { my ( $pid, $name, $obj, $fh ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists( $self->{'_path'} ); if ($pid) { my ( $real_inode, $real_mtime ) = ( stat $fh )[ 1, 9 ]; $self->{"_inode_${real_inode}_$real_mtime"} = [ $pid, $name, $obj ]; } } return $self->{"_inode_${inode}_$mtime"} ||= undef; } 1; } # --- END Cpanel/SafeFile/LockInfoCache.pm { # --- BEGIN Cpanel/SafeFile/LockWatcher.pm package Cpanel::SafeFile::LockWatcher; use strict; use warnings; no warnings 'once'; use constant _ENOENT => 2; use constant _FILEHANDLE_TTL => 2; sub new { my ( $class, $lockfile ) = @_; my $self = bless { _path => $lockfile, _new => 1 }, $class; return $self->reload_from_disk(); } sub reload_from_disk { my ($self) = @_; my $old_inode = $self->{'inode'}; @{$self}{qw( inode uid size mtime)} = $self->_get_inode_uid_size_mtime(); if ( delete $self->{'_new'} ) { $self->{'changed'} = 0; } else { $self->{'changed'} = ( $self->{'inode'} || 0 ) != ( $old_inode || 0 ) ? 1 : 0; } return $self; } sub _get_inode_uid_size_mtime { my ($self) = @_; my ( $inode, $uid, $size, $mtime ); local $!; if ( open my $fh, '<', $self->{'_path'} ) { ( $inode, $uid, $size, $mtime ) = ( stat $fh )[ 1, 4, 7, 9 ]; $self->_add_fh_if_needed( $fh, $inode ); } elsif ( $! != _ENOENT ) { die "open(<, $self->{'_path'}): $!"; } return ( $inode, $uid, $size, $mtime ); } sub _add_fh_if_needed { my ( $self, $fh, $inode ) = @_; my $now = time; my $fhs_hr = $self->{'_time_fhs'} //= {}; my $seen_inode = 0; for my $time ( keys %$fhs_hr ) { if ( ( $now - $time ) > _FILEHANDLE_TTL() ) { delete $fhs_hr->{$time}; next; } if ( !$seen_inode ) { foreach my $entry ( @{ $fhs_hr->{$time} } ) { if ( $entry->[1] == $inode ) { $seen_inode = 1; last; } } } } return if $seen_inode; push @{ $fhs_hr->{ time() } }, [ $fh, $inode ]; return; } 1; } # --- END Cpanel/SafeFile/LockWatcher.pm { # --- BEGIN Cpanel/Autodie.pm package Cpanel::Autodie; use strict; use warnings; no warnings 'once'; sub _ENOENT { return 2; } sub _EEXIST { return 17; } sub _EINTR { return 4; } sub import { shift; _load_function($_) for @_; return; } our $AUTOLOAD; sub AUTOLOAD { substr( $AUTOLOAD, 0, 1 + rindex( $AUTOLOAD, ':' ) ) = q<>; _load_function($AUTOLOAD); goto &{ Cpanel::Autodie->can($AUTOLOAD) }; } sub _load_function { _require("Cpanel/Autodie/CORE/$_[0].pm"); return; } sub _require { local ( $!, $^E, $@ ); require $_[0]; return; } 1; } # --- END Cpanel/Autodie.pm { # --- BEGIN Cpanel/Context.pm package Cpanel::Context; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 sub must_be_list { return 1 if ( caller(1) )[5]; # 5 = wantarray my $msg = ( caller(1) )[3]; # 3 = subroutine $msg .= $_[0] if defined $_[0]; return _die_context( 'list', $msg ); } sub must_not_be_scalar { my ($message) = @_; my $wa = ( caller(1) )[5]; # 5 = wantarray if ( !$wa && defined $wa ) { _die_context( 'list or void', $message ); } return 1; } sub must_not_be_void { return if defined( ( caller 1 )[5] ); return _die_context('scalar or list'); } sub _die_context { my ( $context, $message ) = @_; local $Carp::CarpInternal{__PACKAGE__} if $INC{'Carp.pm'}; my $to_throw = length $message ? "Must be $context context ($message)!" : "Must be $context context!"; die Cpanel::Exception::create_raw( 'ContextError', $to_throw ); } 1; } # --- END Cpanel/Context.pm { # --- BEGIN Cpanel/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; no warnings 'once'; # use Cpanel::Autodie (); # perlpkg line 211 # use Cpanel::Context (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::Pack (); # perlpkg line 211 # use Cpanel::Syscall (); # perlpkg line 211 use constant POLL_SIZE => 65536; use constant READ_TEMPLATE => ( wd => 'i', #int Watch descriptor mask => 'I', #uint32_t Mask of events cookie => 'I', #uint32_t Unique cookie associating related events len => 'I', #uint32_t Size of “name” field ); my %add_flags; my %read_flags; my %init1_flag; my $UNPACK_OBJ; my $UNPACK_SIZE; sub new { my ( $class, %opts ) = @_; if ( !$UNPACK_OBJ ) { $UNPACK_OBJ = Cpanel::Pack->new( [ READ_TEMPLATE() ] ); $UNPACK_SIZE = $UNPACK_OBJ->sizeof(); _setup_flags(); } my @given_flags = $opts{'flags'} ? @{ $opts{'flags'} } : (); my $mask = 0; for my $f (@given_flags) { $mask |= $init1_flag{$f} || do { die Cpanel::Exception->create_raw("Invalid inotify_init1 flag: “$f”"); }; } my $fd = Cpanel::Syscall::syscall( 'inotify_init1', $mask ); my %self = ( _fd => $fd, ); Cpanel::Autodie::open( $self{'_fh'}, '<&=', $fd ); return bless \%self, $class; } sub add { my ( $self, $path, %opts ) = @_; my @flags = @{ $opts{'flags'} }; my $mask = 0; for my $f (@flags) { $mask |= $add_flags{$f} || do { die Cpanel::Exception->create_raw("Invalid inotify_add_watch flag: “$f”"); }; } my $wd = Cpanel::Syscall::syscall( 'inotify_add_watch', $self->{'_fd'}, $path, $mask, ); if ( $wd < 1 ) { die Cpanel::Exception->create_raw("inotify watch descriptor “$wd” means something is wrong?"); } $self->{'_watches'}{$wd} = $path; return $wd; } sub remove { my ( $self, $wd ) = @_; Cpanel::Syscall::syscall( 'inotify_rm_watch', $self->{'_fd'}, $wd ); return; } sub poll { my ($self) = @_; Cpanel::Context::must_be_list(); my $buf = q<>; Cpanel::Autodie::sysread_sigguard( $self->{'_fh'}, $buf, POLL_SIZE() ); my @events; while ( length $buf ) { my $evt = $UNPACK_OBJ->unpack_to_hashref( substr( $buf, 0, $UNPACK_SIZE, q<> ) ); $evt->{'name'} = substr( $buf, 0, delete( $evt->{'len'} ), q<> ); $evt->{'name'} =~ s<\0+\z><>; #trailing NULs $evt->{'flags'} = _mask_to_flags_ar( delete $evt->{'mask'} ); push @events, $evt; } return @events; } sub fileno { my ($self) = @_; return fileno( $self->{'_fh'} ); } sub _mask_to_flags_ar { my ($mask) = @_; my @flags; for my $k ( keys %read_flags ) { push @flags, $k if $mask & $read_flags{$k}; } @flags = sort @flags; return \@flags; } sub _setup_flags { my %flag_num = ( ACCESS => 0x1, # File was accessed MODIFY => 0x2, # File was modified ATTRIB => 0x4, # Metadata changed CLOSE_WRITE => 0x8, # File opened for writing was closed CLOSE_NOWRITE => 0x10, # File not opened for writing was closed OPEN => 0x20, # File was opened MOVED_FROM => 0x40, # File was moved from X MOVED_TO => 0x80, # File was moved to Y CREATE => 0x100, # Subfile was created DELETE => 0x200, # Subfile was deleted DELETE_SELF => 0x400, # Self was deleted MOVE_SELF => 0x800, # Self was moved ); %read_flags = ( %flag_num, UNMOUNT => 0x00002000, # Backing fs was unmounted Q_OVERFLOW => 0x00004000, # Event queued overflowed ('wd' is -1) IGNORED => 0x00008000, # Watch was removed ISDIR => 0x40000000, # event occurred against dir ); %add_flags = ( %flag_num, ONLYDIR => 0x01000000, # only watch the path if it is a directory DONT_FOLLOW => 0x02000000, # don't follow a sym link EXCL_UNLINK => 0x04000000, # exclude events on unlinked objects MASK_ADD => 0x20000000, # add to the mask of an already existing watch ONESHOT => 0x80000000, # only send event once CLOSE => $read_flags{'CLOSE_WRITE'} | $read_flags{'CLOSE_NOWRITE'}, MOVE => $read_flags{'MOVED_FROM'} | $read_flags{'MOVED_TO'}, ); my $mask = 0; $mask |= $_ for values %flag_num; $add_flags{'ALL_EVENTS'} = $mask; %init1_flag = ( CLOEXEC => $Cpanel::Fcntl::Constants::O_CLOEXEC, NONBLOCK => $Cpanel::Fcntl::Constants::O_NONBLOCK, ); return; } 1; } # --- END Cpanel/Inotify.pm { # --- BEGIN Cpanel/SafeFile.pm package Cpanel::SafeFile; use strict; use warnings; no warnings 'once'; # use Cpanel::TimeHiRes (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::SafeFileLock (); # perlpkg line 211 # use Cpanel::FHUtils::Tiny (); # perlpkg line 211 use constant { _EWOULDBLOCK => 11, _EACCES => 13, _EDQUOT => 122, _ENOENT => 2, _EINTR => 4, _EEXIST => 17, _ENOSPC => 28, _EPERM => 1, MAX_LOCK_CREATE_ATTEMPTS => 90, NO_PERM_TO_WRITE_TO_DOTLOCK_DIR => -1, INOTIFY_FILE_DISAPPEARED => 2, CREATE_FCNTL_VALUE => ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_EXCL | $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_NONBLOCK ), UNLOCK_FCNTL_VALUE => $Cpanel::Fcntl::Constants::LOCK_UN, LOCK_FILE_PERMS => 0644, DEFAULT_LOCK_WAIT_TIME => 196, MAX_LOCK_WAIT_TIME => 400, MAX_LOCK_FILE_LENGTH => 225, }; $Cpanel::SafeFile::VERSION = '5.0'; my $OVERWRITE_FCNTL_VALUE; my $verbose = 0; # initialized in safelock our $LOCK_WAIT_TIME; #allow lock wait time to be overwritten my $OPEN_LOCKS = 0; our $TIME_BETWEEN_DOTLOCK_CHECKS = 0.3; our $TIME_BETWEEN_FLOCK_CHECKS = 0.05; our $MAX_FLOCK_WAIT = 60; # allowed to be overwritten in tests our $_SKIP_DOTLOCK_WHEN_NO_PERMS = 0; our $_SKIP_WARN_ON_OPEN_FAIL = 0; my $DOUBLE_LOCK_DETECTED = 4096; sub safeopen { #fh, open()-style mode, path my ( $mode, $file ) = _get_open_args( @_[ 1 .. $#_ ] ); my $open_method_coderef = sub { my $ret = open( $_[0], $_[1], $_[2] ) || do { _log_warn("open($_[1], $_[2]): $!"); return undef; }; return $ret; }; return _safe_open( $_[0], $mode, $file, $open_method_coderef, 'safeopen' ); } sub safesysopen_no_warn_on_fail { local $_SKIP_WARN_ON_OPEN_FAIL = 1; return safesysopen(@_); } sub safesysopen_skip_dotlock_if_not_root { local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1; return safesysopen(@_); } sub safeopen_skip_dotlock_if_not_root { local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1; return safeopen(@_); } sub safelock_skip_dotlock_if_not_root { local $_SKIP_DOTLOCK_WHEN_NO_PERMS = $> == 0 ? 0 : 1; return safelock(@_); } sub safereopen { ##no critic qw(RequireArgUnpacking) my $fh = shift; if ( !$fh ) { require Cpanel::Carp; die Cpanel::Carp::safe_longmess("Undefined filehandle not allowed!"); } elsif ( !fileno $fh ) { require Cpanel::Carp; die Cpanel::Carp::safe_longmess("Closed filehandle ($fh) not allowed!"); } my ( $mode, $file ) = _get_open_args(@_); my $open_method_coderef = sub { return open( $_[0], $_[1], $_[2] ) || do { _log_warn("open($_[1], $_[2]): $!"); return undef; }; }; return _safe_re_open( $fh, $mode, $file, $open_method_coderef, 'safereopen' ); } sub safesysopen { ##no critic qw(RequireArgUnpacking) my ( $file, $open_mode, $custom_perms ) = ( @_[ 1 .. 3 ] ); my ( $sysopen_perms, $original_umask ); $open_mode = _sanitize_open_mode($open_mode); my $open_method_coderef = sub { return sysopen( $_[0], $_[2], $_[1], $sysopen_perms ) || do { _log_warn("open($_[2], $_[1], $sysopen_perms): $!") unless $_SKIP_WARN_ON_OPEN_FAIL; return undef; }; }; if ( defined $custom_perms ) { $custom_perms &= 0777; $original_umask = umask( $custom_perms ^ 07777 ); $sysopen_perms = $custom_perms; } else { $sysopen_perms = 0666; } my $lock_ref; local $@; my $ok = eval { $lock_ref = _safe_open( $_[0], $open_mode, $file, $open_method_coderef, 'safesysopen' ); 1; }; if ( defined $custom_perms ) { umask($original_umask); } die if !$ok; return $lock_ref; } sub safeclose { my ( $fh, $lockref, $do_something_before_releasing_lock ) = @_; if ( $do_something_before_releasing_lock && ref $do_something_before_releasing_lock eq 'CODE' ) { $do_something_before_releasing_lock->(); } my $success = 1; if ( $fh && defined fileno $fh ) { flock( $fh, UNLOCK_FCNTL_VALUE ) or _log_warn( "flock(LOCK_UN) on “" . $lockref->get_path() . "” failed with error: $!" ); # LOCK_UN $success = close $fh; } my $safe_unlock = safeunlock($lockref); $OPEN_LOCKS-- if ( $safe_unlock && $success ); return ( $safe_unlock && $success ); } sub safelock { my ($file) = @_; my $lock_obj = _safelock($file); return if !ref $lock_obj; return $lock_obj; } sub _safelock { my ($file) = @_; if ( !$file || $file =~ tr/\0// ) { _log_warn('safelock: Invalid arguments'); return; } $verbose ||= ( _verbose_flag_file_exists() ? 1 : -1 ); my $lockfile = _calculate_lockfile($file); my $safefile_lock = Cpanel::SafeFileLock->new_before_lock( $lockfile, $file ); my ( $lock_status, $lock_fh, $attempts, $last_err ); { local $@; while ( ++$attempts < MAX_LOCK_CREATE_ATTEMPTS ) { ( $lock_status, $lock_fh ) = _lock_wait( $file, $safefile_lock, $lockfile ); last if $lock_status; $last_err = $!; if ( $lock_fh && $lock_fh == $DOUBLE_LOCK_DETECTED ) { return 0; } } } if ( $lock_fh == 1 ) { return 1; } elsif ( $lock_status && $lock_fh ) { return $safefile_lock; } _log_warn( 'safelock: waited for lock (' . $lockfile . ') ' . $attempts . ' times' ); require Cpanel::Exception; die Cpanel::Exception::create( 'IO::FileCreateError', [ 'path' => $lockfile, 'error' => $last_err ] ); } sub _write_temp_lock_file { my ($lockfile) = @_; my $temp_file = sprintf( '%s-%x-%x-%x', $lockfile, substr( rand, 2 ), scalar( reverse time ), scalar( reverse $$ ), ); my ( $ok, $fh_or_err ) = _create_lockfile($temp_file); if ( !$ok ) { if ( $fh_or_err == _EPERM() || $fh_or_err == _EACCES() ) { local $!; my $lock_dir = _getdir($lockfile); if ( !-w $lock_dir ) { if ($_SKIP_DOTLOCK_WHEN_NO_PERMS) { # A hack to allow /etc/valiases to still be flock()ed until we can refactor return ( NO_PERM_TO_WRITE_TO_DOTLOCK_DIR, $fh_or_err ); } else { _log_warn("safelock: Failed to create a lockfile '$temp_file' in the directory '$lock_dir' that isn't writable: $fh_or_err"); } } } return ( 0, $fh_or_err ); } Cpanel::SafeFileLock::write_lock_contents( $fh_or_err, $temp_file ); return ( $temp_file, $fh_or_err ); } sub _try_to_install_lockfile { my ( $temp_file, $lockfile ) = @_; link( $temp_file => $lockfile ) or do { return 0 if $! == _EEXIST; require Cpanel::Exception; die Cpanel::Exception::create( 'IO::LinkError', [ oldpath => $temp_file, newpath => $lockfile, error => $! ] ); }; return 1; } sub safeunlock { my $lockref = shift; if ( !$lockref ) { _log_warn('safeunlock: Invalid arguments'); return; } elsif ( !ref $lockref ) { return 1 if $lockref eq '1'; # No lock file created so just succeed $lockref = Cpanel::SafeFileLock->new( $lockref, undef, undef ); if ( !$lockref ) { _log_warn("safeunlock: failed to generate a Cpanel::SafeFileLock object from a path"); return; } } my ( $lock_path, $fh, $lock_inode, $lock_mtime ) = $lockref->get_path_fh_inode_mtime(); my ( $filesys_lock_ino, $filesys_lock_mtime ) = ( lstat $lock_path )[ 1, 9 ]; if ( $fh && !defined fileno($fh) ) { return 1; } elsif ( !$filesys_lock_mtime ) { _log_warn( 'Lock on ' . $lockref->get_path_to_file_being_locked() . ' lost!' ); $lockref->close(); return; # return false on false } elsif ( $lock_inode && ( $lock_inode == $filesys_lock_ino ) && $lock_path && ( $lock_mtime == $filesys_lock_mtime ) ) { unlink $lock_path or do { _log_warn("Could not unlink lock file “$lock_path” as ($>/$)): $!\n"); $lockref->close(); return; # return false on false }; return $lockref->close(); } $lockref->close(); my ( $lock_pid, $lock_name, $lock_obj ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists($lock_path); if ($lock_pid) { if ( $lock_pid == $$ ) { unlink $lock_path; # best-effort; ignore failure return 1; } $lock_inode ||= 0; $lock_mtime ||= 0; _log_warn("[$$] Attempt to unlock file that was locked by another process [LOCK_PATH]=[$lock_path] [LOCK_PID]=[$lock_pid] [LOCK_PROCESS]=[$lock_name] [LOCK_INODE]=[$filesys_lock_ino] [LOCK_MTIME]=[$filesys_lock_mtime] -- [NON_LOCK_PID]=[$$] [NON_LOCK_PROCESS]=[$0] [NON_LOCK_INODE]=[$lock_inode] [NON_LOCK_MTIME]=[$lock_mtime]"); } return; } sub _safe_open { my ( undef, $open_mode, $file, $open_method_coderef, $open_method ) = @_; if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) { _log_warn('_safe_open: Invalid arguments'); return; } elsif ( defined $_[0] ) { my $fh_type = ref $_[0]; if ( !Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) { _log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'"); return; } } if ( my $lockref = _safelock($file) ) { if ( $open_method_coderef->( $_[0], $open_mode, $file ) ) { if ( my $err = _do_flock_or_return_exception( $_[0], $open_mode, $file ) ) { safeunlock($lockref); local $@ = $err; die; } $OPEN_LOCKS++; return $lockref; } else { local $!; safeunlock($lockref); return; } } else { _log_warn("safeopen: could not acquire a lock for '$file': $!"); return; } } my $_lock_ex_nb; my $_lock_sh_nb; sub _do_flock_or_return_exception { my ( $fh, $open_mode, $path ) = @_; my $flock_start_time; my $lock_op = _is_write_open_mode($open_mode) ? ( $_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB ) : ( $_lock_sh_nb //= $Cpanel::Fcntl::Constants::LOCK_SH | $Cpanel::Fcntl::Constants::LOCK_NB ); local $!; my $flock_err; my $flock_max_wait_time_is_whole_number = int($MAX_FLOCK_WAIT) == $MAX_FLOCK_WAIT; while ( !flock $fh, $lock_op ) { $flock_err = $!; if ( $flock_err == _EINTR || $flock_err == _EWOULDBLOCK ) { if ( !$flock_start_time ) { $flock_start_time = $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time(); next; } if ( ( ( $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time() ) - $flock_start_time ) > $MAX_FLOCK_WAIT ) { require Cpanel::Exception; return _timeout_exception( $path, $MAX_FLOCK_WAIT ); } else { Cpanel::TimeHiRes::sleep($TIME_BETWEEN_FLOCK_CHECKS); } next; } require Cpanel::Exception; return Cpanel::Exception::create( 'IO::FlockError', [ path => $path, error => $flock_err, operation => $lock_op ] ); } return undef; } sub _safe_re_open { my ( $fh, $open_mode, $file, $open_method_coderef, $open_method ) = @_; if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) { _log_warn('_safe_re_open: Invalid arguments'); return; } else { my $fh_type = ref $fh; if ( !Cpanel::FHUtils::Tiny::is_a($fh) ) { _log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'"); return; } } close $fh; if ( $open_method_coderef->( $fh, $open_mode, $file ) ) { if ( my $err = _do_flock_or_return_exception( $fh, $open_mode, $file ) ) { die $err; } return $fh; } return; } sub _log_warn { require Cpanel::Debug; goto &Cpanel::Debug::log_warn; } sub _get_open_args { my ( $mode, $file ) = @_; if ( !$file ) { ( $mode, $file ) = $mode =~ m/^([<>+|]+|)(.*)/; if ( $file && !$mode ) { $mode = '<'; } elsif ( !$file ) { return; } } $mode = $mode eq '<' ? '<' : $mode eq '>' ? '>' : $mode eq '>>' ? '>>' : $mode eq '+<' ? '+<' : $mode eq '+>' ? '+>' : $mode eq '+>>' ? '+>>' : return; return ( $mode, $file ); } sub _sanitize_open_mode { my ($mode) = @_; return if $mode =~ m/[^0-9]/; my $safe_mode = ( $mode & $Cpanel::Fcntl::Constants::O_RDONLY ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_RDWR ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_CREAT ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_EXCL ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_APPEND ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_TRUNC ); $safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_NONBLOCK ); return $safe_mode; } sub _calculate_lockfile { ## no critic qw(Subroutines::RequireArgUnpacking) my $lockfile = $_[0] =~ tr{<>}{} ? ( ( $_[0] =~ /^[><]*(.*)/ )[0] . '.lock' ) : $_[0] . '.lock'; return $lockfile if ( length $lockfile <= MAX_LOCK_FILE_LENGTH ); require File::Basename; my $lock_basename = File::Basename::basename($lockfile); return $lockfile if ( length $lock_basename <= MAX_LOCK_FILE_LENGTH ); require Cpanel::Hash; my $hashed_lock_basename = Cpanel::Hash::get_fastest_hash($lock_basename) . ".lock"; if ( $lockfile eq $lock_basename ) { return $hashed_lock_basename; } else { return File::Basename::dirname($lockfile) . '/' . $hashed_lock_basename; } } sub is_locked { my ($file) = @_; my $lockfile = _calculate_lockfile($file); my ( $lock_pid, $lock_name, $lock_obj ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists($lockfile); if ( _is_valid_pid($lock_pid) && _pid_is_alive($lock_pid) ) { return 1; } return 0; } sub _timeout_exception { my ( $path, $waited ) = @_; require Cpanel::Exception; return Cpanel::Exception::create( 'Timeout', 'The system failed to lock the file “[_1]” after [quant,_2,second,seconds].', [ $path, $waited ] ); } sub _die_if_file_is_flocked_cuz_already_waited_a_while { my ( $file, $waited ) = @_; if ( _open_to_write( my $fh, $file ) ) { $_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB; if ( flock( $fh, $_lock_ex_nb ) == 1 ) { flock $fh, UNLOCK_FCNTL_VALUE or die "Failed to unlock “$file” after having just locked it: $!"; } else { require Cpanel::Exception; if ( $! == _EWOULDBLOCK ) { die _timeout_exception( $file, $waited ); } else { die Cpanel::Exception::create( 'IO::FlockError', [ path => $file, error => $!, operation => $_lock_ex_nb ] ); } } } return; } sub _lock_wait { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $file, $safefile_lock, $lockfile ) = @_; my ( $temp_file, $fh ) = _write_temp_lock_file( $lockfile, $file ); if ( $temp_file eq NO_PERM_TO_WRITE_TO_DOTLOCK_DIR ) { return ( 1, 1 ); } if ( !$temp_file ) { return ( 0, $fh ); } $safefile_lock->set_filehandle_and_unlinker_after_lock( $fh, Cpanel::SafeFile::_temp->new($temp_file) ); return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile ); local $0 = ( $verbose == 1 ) ? "$0 - waiting for lock on $file" : "$0 - waiting for lock"; require Cpanel::SafeFile::LockInfoCache; require Cpanel::SafeFile::LockWatcher; my $watcher = Cpanel::SafeFile::LockWatcher->new($lockfile); my $waittime = _calculate_waittime_for_file($file); my ( $inotify_obj, $inotify_mask, $inotify_file_disappeared ); my $start_time = time; my $waited = 0; my $lockfile_cache = Cpanel::SafeFile::LockInfoCache->new($lockfile); my ( $inotify_inode, $inotify_mtime ); LOCK_WAIT: while (1) { $waited = ( time() - $start_time ); if ( $waited > $waittime ) { _die_if_file_is_flocked_cuz_already_waited_a_while( $file, $waited ); if ( defined $watcher->{'inode'} ) { require Cpanel::Debug; Cpanel::Debug::log_warn( sprintf "Replacing stale lock file: $lockfile. The kernel’s lock is gone, last modified %s seconds ago (mtime=$watcher->{'mtime'}), and waited over $waittime seconds.", time - $watcher->{'mtime'} ); } return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} ); die _timeout_exception( $file, $waittime ); } if ( $watcher->{'inode'} ) { my $lock_get = $lockfile_cache->get( @{$watcher}{ 'inode', 'mtime' } ); if ( !$lock_get ) { my $size_before_reload = $watcher->{'size'}; $watcher->reload_from_disk(); if ( $size_before_reload == 0 && $watcher->{'size'} == 0 ) { _log_warn("[$$] UID $> clobbering empty lock file “$lockfile” (UID $watcher->{'uid'}) written by “unknown” at $watcher->{'mtime'}"); return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} ); } next LOCK_WAIT; } my ( $lock_pid, $lock_name, $lock_obj ) = @$lock_get; if ( $lock_pid == $$ ) { $watcher->reload_from_disk(); _log_warn("[$$] Double locking detected by self [LOCK_PATH]=[$lockfile] [LOCK_PID]=[$lock_pid] [LOCK_OBJ]=[$lock_obj] [LOCK_PROCESS]=[$lock_name] [ACTUAL_INODE]=[$watcher->{'inode'}] [ACTUAL_MTIME]=[$watcher->{'mtime'}]"); return ( 0, $DOUBLE_LOCK_DETECTED ); } elsif ( !_pid_is_alive($lock_pid) ) { my $time = time(); if ( _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} ) ) { _log_warn("[$$] TIME $time UID $> clobbered stale lock file “$lockfile” (NAME “$lock_name”, UID $watcher->{'uid'}) written by PID $lock_pid at $watcher->{'mtime'}"); return ( 1, $fh ); } $watcher->reload_from_disk(); next LOCK_WAIT; } else { require Cpanel::Debug; Cpanel::Debug::log_info("[$$] Waiting for lock on $file held by $lock_name with pid $lock_pid") if $verbose == 1; } } return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile ); $watcher->reload_from_disk(); if ( !$inotify_obj || !$inotify_inode || !$watcher->{'inode'} || $inotify_inode != $watcher->{'inode'} || $inotify_mtime != $watcher->{'mtime'} ) { INOTIFY: { ( $inotify_obj, $inotify_mask, $inotify_file_disappeared ) = _generate_inotify_for_lock_file($lockfile); $watcher->reload_from_disk(); if ( $inotify_file_disappeared || !$watcher->{'inode'} ) { undef $inotify_obj; next LOCK_WAIT; } redo INOTIFY if $watcher->{'changed'}; ( $inotify_inode, $inotify_mtime ) = @{$watcher}{ 'inode', 'mtime' }; } } my $selected = _select( my $m = $inotify_mask, undef, undef, $TIME_BETWEEN_DOTLOCK_CHECKS ); if ( $selected == -1 ) { die "select() error: $!" if $! != _EINTR(); } elsif ($selected) { return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile ); $watcher->reload_from_disk(); () = $inotify_obj->poll(); } } return; } sub _select { return select( $_[0], $_[1], $_[2], $_[3] ); } sub _generate_inotify_for_lock_file { my ($file) = @_; require Cpanel::Inotify; my $inotify_obj; my $rin = ''; local $@; eval { $inotify_obj = Cpanel::Inotify->new( flags => ['NONBLOCK'] ); $inotify_obj->add( $file, flags => [ 'ATTRIB', 'DELETE_SELF' ] ); vec( $rin, $inotify_obj->fileno(), 1 ) = 1; }; if ($@) { my $err = $@; if ( eval { $err->isa('Cpanel::Exception::SystemCall') } ) { my $err = $err->get('error'); if ( $err == _ENOENT ) { return ( undef, undef, INOTIFY_FILE_DISAPPEARED ); } elsif ( $err != _EACCES ) { # Don’t warn if EACCES local $@ = $err; warn; } } else { local $@ = $err; warn; } return; } return ( $inotify_obj, $rin, 0 ); } sub _pid_is_alive { my ($pid) = @_; local $!; if ( kill( 0, $pid ) ) { return 1; } elsif ( $! == _EPERM ) { return !!( stat "/proc/$pid" )[0]; } return 0; } sub _calculate_waittime_for_file { my ($file) = @_; return $LOCK_WAIT_TIME if $LOCK_WAIT_TIME; my $waittime = DEFAULT_LOCK_WAIT_TIME; if ( -e $file ) { $waittime = int( ( stat _ )[7] / 10000 ); $waittime = $waittime > MAX_LOCK_WAIT_TIME ? MAX_LOCK_WAIT_TIME : $waittime < DEFAULT_LOCK_WAIT_TIME ? DEFAULT_LOCK_WAIT_TIME : $waittime; } return $waittime; } sub _is_valid_pid { my $pid = shift; return 0 unless defined $pid; return $pid =~ tr{0-9}{}c ? 0 : 1; } sub _getdir { my @path = split( /\/+/, $_[0] ); return join( '/', (@path)[ 0 .. ( $#path - 1 ) ] ) || '.'; } sub _create_lockfile { my $lock_fh; return sysopen( $lock_fh, $_[0], CREATE_FCNTL_VALUE, LOCK_FILE_PERMS ) ? ( 1, $lock_fh ) : ( 0, $! ); } sub _open_to_write { my $path = $_[1]; $OVERWRITE_FCNTL_VALUE ||= ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_NONBLOCK | $Cpanel::Fcntl::Constants::O_APPEND | $Cpanel::Fcntl::Constants::O_NOFOLLOW ); return sysopen( $_[0], $path, $OVERWRITE_FCNTL_VALUE, LOCK_FILE_PERMS ); } sub _overwrite_lockfile_if_inode_mtime_matches { my ( $temp_file, $lockfile, $lockfile_inode, $lockfile_mtime ) = @_; my ( $inode, $mtime ) = ( stat $lockfile )[ 1, 9 ]; if ( !$inode ) { die "stat($lockfile): $!" if $! != _ENOENT(); } if ( !$inode || ( $inode == $lockfile_inode && $mtime == $lockfile_mtime ) ) { rename( $temp_file, $lockfile ) or do { require Cpanel::Exception; die Cpanel::Exception::create( 'IO::RenameError', [ oldpath => $temp_file, newpath => $lockfile, error => $! ] ); }; return 1; } return 0; } sub _is_write_open_mode { my ($mode) = @_; if ( $mode =~ tr{0-9}{}c ) { if ( $mode && ( -1 != index( $mode, '>' ) || -1 != index( $mode, '+' ) ) ) { return 1; } } else { if ( $mode && ( ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY ) || ( $mode & $Cpanel::Fcntl::Constants::O_RDWR ) ) ) { return 1; } } return 0; } sub _verbose_flag_file_exists { return -e '/var/cpanel/safefile_verbose'; } package Cpanel::SafeFile::_temp; use constant _ENOENT => 2; sub new { return bless [ $_[1], $_SKIP_DOTLOCK_WHEN_NO_PERMS, $$ ], $_[0]; } sub DESTROY { local $!; unlink $_[0]->[0] or do { if ( !$_[0]->[1] && $! != _ENOENT && $_[0]->[2] == $$ ) { warn "unlink($_[0]->[0]): $!"; } }; return; } 1; } # --- END Cpanel/SafeFile.pm { # --- BEGIN Cpanel/Linux/Constants.pm package Cpanel::Linux::Constants; use strict; use warnings; no warnings 'once'; use constant { NAME_MAX => 255, PATH_MAX => 4096, }; 1; } # --- END Cpanel/Linux/Constants.pm { # --- BEGIN Cpanel/Validate/FilesystemNodeName.pm package Cpanel::Validate::FilesystemNodeName; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::Linux::Constants (); # perlpkg line 211 sub is_valid { my ($node) = @_; local $@; eval { validate_or_die($node); }; return $@ ? 0 : 1; } sub validate_or_die { my ($name) = @_; if ( !length $name ) { die Cpanel::Exception::create('Empty'); } elsif ( $name eq '.' || $name eq '..' ) { die Cpanel::Exception::create( 'Reserved', [ value => $name ] ); } elsif ( length $name > Cpanel::Linux::Constants::NAME_MAX() ) { die Cpanel::Exception::create( 'TooManyBytes', [ value => $name, maxlength => Cpanel::Linux::Constants::NAME_MAX() ] ); } elsif ( index( $name, '/' ) != -1 ) { die Cpanel::Exception::create( 'InvalidCharacters', [ value => $name, invalid_characters => ['/'] ] ); } elsif ( index( $name, "\0" ) != -1 ) { die Cpanel::Exception::create( 'InvalidCharacters', 'This value may not contain a [asis,NUL] byte.', [ value => $name, invalid_characters => ["\0"] ] ); } return 1; } 1; } # --- END Cpanel/Validate/FilesystemNodeName.pm { # --- BEGIN Cpanel/Notify.pm package Cpanel::Notify; use strict; use warnings; no warnings 'once'; # use Cpanel::Set (); # perlpkg line 211 # use Cpanel::Fcntl (); # perlpkg line 211 # use Cpanel::SafeFile (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 # use Cpanel::Validate::FilesystemNodeName (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 our $VERSION = '1.8'; my $DEFAULT_CONTENT_TYPE = 'text/plain; charset=utf-8'; our $NOTIFY_INTERVAL_STORAGE_DIR = '/var/cpanel/notifications'; sub notification_class { my (%args) = @_; if ( !defined $args{'interval'} ) { $args{'interval'} = 1; } if ( !defined $args{'status'} ) { $args{'status'} = 'No status set'; } foreach my $param (qw(application status class constructor_args)) { die Cpanel::Exception::create( 'MissingParameter', [ 'name' => $param ] ) if !defined $args{$param}; } if ( my @unwelcome_params = Cpanel::Set::difference( [ keys %args ], [qw(application status class constructor_args interval)] ) ) { die Cpanel::Exception::create_raw( 'InvalidParameters', "The following parameters don't belong as an argument to notification_class(); you may have meant to pass these in constructor_args instead: " . join( ' ', @unwelcome_params ) ); } my $constructor_args = { @{ $args{'constructor_args'} } }; if ( $constructor_args->{'skip_send'} ) { my $class = "Cpanel::iContact::Class::$args{'class'}"; Cpanel::LoadModule::load_perl_module($class); return $class->new(%$constructor_args); } return _notification_backend( $args{'application'}, $args{'status'}, $args{'interval'}, sub { my $class = "Cpanel::iContact::Class::$args{'class'}"; Cpanel::LoadModule::load_perl_module($class); return $class->new(%$constructor_args); }, ); } sub notification { my %AGS = @_; my $app = $AGS{'app'} || $AGS{'application'} || 'Notice'; return _notification_backend( $app, $AGS{'status'}, $AGS{'interval'} || 0, sub { my $module = "Cpanel::iContact"; Cpanel::LoadModule::load_perl_module($module); my $from = $AGS{'from'}; my $to = $AGS{'to'}; my $msgheader = $AGS{'msgheader'} || $AGS{'subject'}; my $message = $AGS{'message'}; my $plaintext_message = $AGS{'plaintext_message'}; my $priority = $AGS{'priority'} || 3; my $attach_files = $AGS{'attach_files'} || []; my $content_type = $AGS{'content-type'} || $DEFAULT_CONTENT_TYPE; "$module"->can('icontact')->( 'attach_files' => $attach_files, 'application' => $app, 'level' => $priority, 'from' => $from, 'to' => $to, 'subject' => $msgheader, 'message' => $message, 'plaintext_message' => $plaintext_message, 'content-type' => $content_type, ); } ); } sub _notification_backend { my ( $app, $status, $interval, $todo_cr ) = @_; my $is_ready = _checkstatusinterval( 'app' => $app, 'status' => $status, 'interval' => $interval, ); if ($is_ready) { return $todo_cr->(); } elsif ( $Cpanel::Debug::level > 3 ) { Cpanel::Debug::log_warn("not sending notify app=[$app] status=[$status] interval=[$interval]"); } return $is_ready ? 1 : 0; } sub notify_blocked { my %AGS = @_; my $app = $AGS{'app'}; my $status = $AGS{'status'}; my $interval = $AGS{'interval'}; return 0 if $interval <= 1; # Special Case (ignore interval check); $app =~ s{/}{_}g; # Its possible to have slashes in the app name $status =~ s{:}{_}g; # Its possible to have colons in the status my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app"; return 0 if !-e $db_file; my %notifications; my $notify_db_fh; if ( my $nlock = Cpanel::SafeFile::safesysopen( $notify_db_fh, $db_file, Cpanel::Fcntl::or_flags('O_RDONLY'), 0600 ) ) { local $/; %notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) ); Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock ); } else { Cpanel::Debug::log_warn("Could not open $db_file: $!"); return; } if ( $notifications{$status} && ( ( $notifications{$status} + $interval ) > time() ) ) { return 1; } return 0; } { no warnings 'once'; *update_notification_time_if_interval_reached = \&_checkstatusinterval; } sub _checkstatusinterval { my %AGS = @_; my $app = $AGS{'app'}; my $status = $AGS{'status'}; my $interval = $AGS{'interval'}; return 1 if $interval <= 1; # Special Case (ignore interval check); $app =~ s{/}{_}g; # Its possible to have slashes in the app name $status =~ s{:}{_}g; # Its possible to have colons in the status Cpanel::Validate::FilesystemNodeName::validate_or_die($app); my $notify = 0; if ( !-e $NOTIFY_INTERVAL_STORAGE_DIR ) { Cpanel::LoadModule::load_perl_module('Cpanel::SafeDir::MK'); Cpanel::SafeDir::MK::safemkdir( $NOTIFY_INTERVAL_STORAGE_DIR, '0700' ); if ( !-d $NOTIFY_INTERVAL_STORAGE_DIR ) { Cpanel::Debug::log_warn("Failed to setup notifications directory: $NOTIFY_INTERVAL_STORAGE_DIR: $!"); return; } } my %notifications; my $notify_db_fh; my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app"; if ( my $nlock = Cpanel::SafeFile::safesysopen( $notify_db_fh, $db_file, Cpanel::Fcntl::or_flags(qw( O_RDWR O_CREAT )), 0600 ) ) { local $/; %notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) ); if ( !exists $notifications{$status} || ( int( $notifications{$status} ) + int($interval) ) < time() ) { $notifications{$status} = time; $notify = 1; } seek( $notify_db_fh, 0, 0 ); print {$notify_db_fh} join( "\n", map { $_ . ':' . $notifications{$_} } sort keys %notifications ); truncate( $notify_db_fh, tell($notify_db_fh) ); Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock ); } else { Cpanel::Debug::log_warn("Could not open $db_file: $!"); return; } return $notify; } 1; } # --- END Cpanel/Notify.pm { # --- BEGIN Cpanel/Server/Utils.pm package Cpanel::Server::Utils; use strict; sub is_subprocess_of_cpsrvd { return 0 if $INC{'cpanel/cpsrvd.pm'}; # If we ARE cpsrvd we do not want this behavior return $ENV{'CPANEL'} ? 1 : 0; } 1; } # --- END Cpanel/Server/Utils.pm { # --- BEGIN Cpanel/Logger.pm package Cpanel::Logger; use strict; # use Cpanel::Time::Local (); # perlpkg line 211 my $is_sandbox; my $is_smoker; our $VERSION = 1.3; use constant TRACE_TOUCH_FILE => '/var/cpanel/log_stack_traces'; our $ENABLE_BACKTRACE; our $DISABLE_OUTPUT; # used by cpanminus our $ALWAYS_OUTPUT_TO_STDERR; our $STD_LOG_FILE = '/usr/local/cpanel/logs/error_log'; our $PANIC_LOG_FILE = '/usr/local/cpanel/logs/panic_log'; my ( $cached_progname, $cached_prog_pid, %singleton_stash ); sub new { my ( $class, $hr_args ) = @_; if ( $hr_args->{'open_now'} && $hr_args->{'use_no_files'} ) { die "“open_now” and “use_no_files” mutually exclude!"; } my $args_sig = 'no_args'; if ( $hr_args && ref($hr_args) eq 'HASH' ) { $args_sig = join( ',', map { $_ . '=>' . $hr_args->{$_} } sort keys %{$hr_args} ); # Storable::freeze($hr_args); } my $no_load_from_cache = $hr_args->{'no_load_from_cache'} ? 1 : 0; if ( exists $singleton_stash{$class}{$args_sig} and !$no_load_from_cache ) { $singleton_stash{$class}{$args_sig}->{'cloned'}++; } else { $singleton_stash{$class}{$args_sig} = bless( {}, $class ); if ( $hr_args && ref($hr_args) eq 'HASH' ) { foreach my $k ( keys %$hr_args ) { $singleton_stash{$class}{$args_sig}->{$k} = $hr_args->{$k}; } } } my $self = $singleton_stash{$class}{$args_sig}; if ( !$self->{'cloned'} ) { if ( $self->{'open_now'} && !$self->{'use_no_files'} ) { $self->_open_logfile(); } } $self->_set_backtrace( $ENABLE_BACKTRACE // $self->{'backtrace'} // _get_backtrace_touchfile() ); return $self; } sub __Logger_pushback { if ( @_ && index( ref( $_[0] ), __PACKAGE__ ) == 0 ) { return @_; } return ( __PACKAGE__->new(), @_ ); } sub invalid { my ( $self, @list ) = __Logger_pushback(@_); my %log = ( 'message' => $list[0], 'level' => 'invalid', 'output' => 0, 'service' => $self->find_progname(), 'backtrace' => $self->get_backtrace(), 'die' => 0, ); if ( is_sandbox() ) { if ( !-e '/var/cpanel/DEBUG' ) { $self->notify( 'invalid', \%log ); } $log{'output'} = _stdin_is_tty() ? 2 : 1; } return $self->logger( \%log ); } # end of invalid sub is_sandbox { return 0 if $INC{'B/C.pm'}; # avoid cache during compile return $is_sandbox if defined $is_sandbox; return ( $is_sandbox = -e '/var/cpanel/dev_sandbox' ? 1 : 0 ); } sub is_smoker { return 0 if $INC{'B/C.pm'}; # avoid cache during compile return $is_smoker if defined $is_smoker; return ( $is_smoker = -e '/var/cpanel/smoker' ? 1 : 0 ); } sub deprecated { ## no critic qw(Subroutines::RequireArgUnpacking) my ( $self, @list ) = __Logger_pushback(@_); my %log = ( 'message' => $list[0], 'level' => 'deprecated', 'output' => 0, 'service' => $self->find_progname(), 'backtrace' => $self->get_backtrace(), 'die' => 0, ); unless ( is_sandbox() ) { $self->logger( \%log ); return; } $self->notify( 'deprecated', \%log ); $log{'output'} = _stdin_is_tty() ? 2 : 1; $log{'die'} = 1; return $self->logger( \%log ); } sub debug { my ( $self, $message, $conf_hr ) = @_; # not appropriate for debug() : __Logger_pushback(@_); $self = $self->new() if !ref $self; $conf_hr ||= { 'force' => 0, 'backtrace' => 0, 'output' => 1, # Logger's debug level should output to STDOUT }; return unless $conf_hr->{'force'} || ( defined $Cpanel::Debug::level && $Cpanel::Debug::level ); ## PPI NO PARSE - avoid recursive use statements if ( !defined $message ) { my @caller = caller(); $message = "debug() at $caller[1] line $caller[2]."; } my %log = ( 'message' => $message, 'level' => 'debug', 'output' => $conf_hr->{'output'}, 'backtrace' => $conf_hr->{'backtrace'}, ); if ( ref $log{'message'} ) { my $outmsg = $log{'message'}; eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::YAML::Syck; $outmsg = YAML::Syck::Dump($outmsg);'; my @caller = caller(); $log{'message'} = "$log{'message'} at $caller[1] line $caller[2]:\n" . $outmsg; } elsif ( $log{'message'} =~ m/\A\d+(?:\.\d+)?\z/ ) { $log{'message'} = "debug() number $log{'message'}"; } $self->logger( \%log ); return \%log; } sub info { my ( $self, @list ) = __Logger_pushback(@_); return $self->logger( { 'message' => $list[0], 'level' => 'info', 'output' => $self->{'open_now'} ? 0 : 1, # FB#59177: info level should output to STDOUT 'backtrace' => 0 } ); } # end of info sub warn { my ( $self, @list ) = __Logger_pushback(@_); return $self->logger( { 'message' => $list[0], 'level' => 'warn', 'output' => _stdin_is_tty() ? 2 : 0, 'backtrace' => $self->get_backtrace() } ); } # end of warn sub error { my ( $self, @list ) = __Logger_pushback(@_); return $self->logger( { 'message' => $list[0], 'level' => 'error', 'output' => -t STDIN ? 2 : 0, 'backtrace' => $self->get_backtrace() } ); } # end of error sub die { my ( $self, @list ) = __Logger_pushback(@_); my %log = ( 'message' => $list[0], 'level' => 'die', 'output' => _stdin_is_tty() ? 2 : 0, 'backtrace' => $self->get_backtrace() ); return $self->logger( \%log ); } # end of die sub panic { my ( $self, @list ) = __Logger_pushback(@_); my %log = ( 'message' => $list[0], 'level' => 'panic', 'output' => 2, 'backtrace' => $self->get_backtrace() ); return $self->logger( \%log ); } # end of panic sub raw { return $_[0]->logger( { 'message' => $_[1], 'level' => 'raw', 'output' => 0, 'backtrace' => 0 } ); } sub cplog { my $msg = shift; my $loglevel = shift; my $service = shift; my $nostdout = shift; if ( !$nostdout ) { $nostdout = 1; } else { $nostdout = 0; } logger( { 'message' => $msg, 'level' => $loglevel, 'service' => $service, 'output' => $nostdout, 'backtrace' => $ENABLE_BACKTRACE // _get_backtrace_touchfile() } ); } # end of cplog (deprecated) sub _get_configuration_for_logger { my ( $self, $cfg_or_msg ) = @_; my $hr = ref($cfg_or_msg) eq 'HASH' ? $cfg_or_msg : { 'message' => $cfg_or_msg }; $hr->{'message'} ||= 'Something is wrong'; $hr->{'level'} ||= ''; $hr->{'output'} ||= 0; $hr->{'output'} = 0 if $DISABLE_OUTPUT; if ( !exists $hr->{'backtrace'} ) { $hr->{'backtrace'} = $self->get_backtrace(); } $hr->{'use_no_files'} ||= 0; $hr->{'use_fullmsg'} ||= 0; return $hr; } sub _write { return print { $_[0] } $_[1]; } sub get_backtrace { my ($self) = __Logger_pushback(@_); return $ENABLE_BACKTRACE // $self->{'backtrace'}; } sub _set_backtrace { my ( $self, @args ) = __Logger_pushback(@_); $self->{'backtrace'} = $args[0] ? 1 : 0; return; } sub _get_backtrace_touchfile { return -e TRACE_TOUCH_FILE ? 1 : 0; } sub get_fh { my ($self) = @_; return $self->{'log_fh'}; } sub set_fh { my ( $self, $fh ) = @_; $self->{'log_fh'} = $fh; return 1; } sub logger { ## no critic(RequireArgUnpacking) my ( $self, @list ) = __Logger_pushback(@_); my $hr = $self->_get_configuration_for_logger( $list[0] ); my ( $msg, $time, $status ); $status = 1; my ($msg_maybe_bt) = $hr->{'backtrace'} ? $self->backtrace( $hr->{'message'} ) : $hr->{'message'} . "\n"; if ( $hr->{'level'} eq 'raw' ) { $msg = $hr->{'message'}; } else { $time ||= Cpanel::Time::Local::localtime2timestamp(); $hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive if ( $self->{'log_pid'} ) { $msg = "[$time] $hr->{'level'} [$hr->{'service'}] [$$] $msg_maybe_bt"; } else { $msg = "[$time] $hr->{'level'} [$hr->{'service'}] $msg_maybe_bt"; } } unless ( $hr->{'use_no_files'} ) { local $self->{'log_fh'} = \*STDERR if $ALWAYS_OUTPUT_TO_STDERR; $self->_open_logfile() if !$self->{'log_fh'} || ( !eval { fileno( $self->{'log_fh'} ) } && !UNIVERSAL::isa( $self->{'log_fh'}, 'IO::Scalar' ) ); _write( $self->{'log_fh'}, $msg ) or $status = 0; if ( $hr->{'level'} eq 'panic' || $hr->{'level'} eq 'invalid' || $hr->{'level'} eq 'deprecated' ) { my $panic_fh; require Cpanel::FileUtils::Open; if ( Cpanel::FileUtils::Open::sysopen_with_real_perms( $panic_fh, $PANIC_LOG_FILE, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) { $time ||= Cpanel::Time::Local::localtime2timestamp(); $hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive _write( $panic_fh, "$time $hr->{level} [$hr->{'service'}] $msg_maybe_bt" ); close $panic_fh; } } } if ( $hr->{'output'} ) { $hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive my $out = "$hr->{level} [$hr->{'service'}] $hr->{'message'}\n"; if ( $self->{'timestamp_prefix'} ) { $out = "[$time] $out"; } $out = $msg if $hr->{'use_fullmsg'}; $status &&= $self->_write_message( $hr, $out ); } if ( ( $hr->{'level'} eq 'die' || $hr->{'level'} eq 'panic' || $hr->{'die'} ) ) { CORE::die "exit level [$hr->{'level'}] [pid=$$] ($hr->{'message'})\n"; # make sure we die if die is overwritten } return $status; } # end of logger sub _write_message { my ( $self, $hr, $out ) = @_; my $status = 1; if ( $hr->{'output'} == 3 ) { _write( \*STDOUT, $out ) or $status = 0; _write( \*STDERR, $out ) or $status = 0; } elsif ( $hr->{'output'} == 1 && ( $self->{'use_stdout'} || _stdout_is_tty() ) ) { _write( \*STDOUT, $out ) or $status = 0; } elsif ( $hr->{'output'} == 2 ) { _write( \*STDERR, $out ) or $status = 0; } return $status; } sub find_progname { if ( $cached_progname && $cached_prog_pid == $$ ) { return $cached_progname; } my $s = $0; if ( !length $s ) { # Someone _could_ set $0 = ''; my $i = 1; # 0 is always find_progname while ( my @service = caller( $i++ ) ) { last if ( $service[3] =~ /::BEGIN$/ ); $s = $service[1] if ( $service[1] ne '' ); } } $s =~ s@.+/(.+)$@$1@ if $s =~ tr{/}{}; $s =~ s@\..+$@@ if $s =~ tr{\.}{}; $s =~ s@ .*$@@ if $s =~ tr{ }{}; $cached_progname = $s; $cached_prog_pid = $$; return $s; } sub backtrace { ## no critic qw(Subroutines::RequireArgUnpacking) my ( $self, @list ) = __Logger_pushback(@_); if ( ref $list[0] ) { return $list[0] if scalar @list == 1; return (@list); } require Cpanel::Carp; local $_; # Protect surrounding program - just in case... local $Carp::Internal{ (__PACKAGE__) } = 1; local $Carp::Internal{'Cpanel::Debug'} = 1; return Cpanel::Carp::safe_longmess(@list); } sub redirect_stderr_to_error_log { return open( STDERR, '>>', $STD_LOG_FILE ); } sub notify { my ( $self, $call, $log_ref ) = @_; my $time = Cpanel::Time::Local::localtime2timestamp(); my ($bt) = $self->backtrace( $log_ref->{'message'} ); $log_ref->{'service'} //= ''; my $logfile = qq{$time [$log_ref->{'service'}] } . ( $bt // '' ); if ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact::Class::Logger::Notify'); 1; } ) { eval { require Cpanel::Notify; Cpanel::Notify::notification_class( 'class' => 'Logger::Notify', 'application' => 'Logger::Notify', 'constructor_args' => [ 'origin' => $log_ref->{'service'}, 'logger_call' => $call, 'attach_files' => [ { name => 'cpanel-logger-log.txt', content => \$logfile } ], 'subject' => $log_ref->{'subject'}, ] ); }; } elsif ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact'); 1; } ) { Cpanel::iContact::icontact( 'application' => $log_ref->{'service'}, 'subject' => $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}}, 'message' => $logfile, ); } else { CORE::warn( $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}} . ": $logfile" ); } return; } *fatal = *die; *out = *info; *success = *info; *throw = *die; *warning = *warn; sub _is_subprocess_of_cpsrvd { require Cpanel::Server::Utils; goto \&Cpanel::Server::Utils::is_subprocess_of_cpsrvd; } sub _open_logfile { my ($self) = @_; my $usingstderr = 0; my $log_fh; $self->{'alternate_logfile'} ||= $STD_LOG_FILE; if ( $STD_LOG_FILE eq $self->{'alternate_logfile'} && _is_subprocess_of_cpsrvd() ) { $log_fh = \*STDERR; $usingstderr = 1; } else { require Cpanel::FileUtils::Open; if ( !Cpanel::FileUtils::Open::sysopen_with_real_perms( $log_fh, $self->{'alternate_logfile'}, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) { ( $usingstderr, $log_fh ) = ( 1, \*STDERR ); } select( ( select($log_fh), $| = 1 )[0] ); ## no critic qw(Variables::RequireLocalizedPunctuationVars InputOutput::ProhibitOneArgSelect) -- Cpanel::FHUtils::Autoflush would be expensive to load every time } $self->{'log_fh'} = $log_fh; $self->{'usingstderr'} = $usingstderr; return 1; } sub _stdin_is_tty { local $@; return eval { -t STDIN }; } sub _stdout_is_tty { local $@; return eval { -t STDOUT }; } sub clear_singleton_stash { %singleton_stash = (); return; } 1; } # --- END Cpanel/Logger.pm { # --- BEGIN Cpanel/Debug.pm package Cpanel::Debug; use strict; use warnings; no warnings 'once'; our $HOOKS_DEBUG_FILE = '/var/cpanel/debughooks'; our $level = ( exists $ENV{'CPANEL_DEBUG_LEVEL'} && $ENV{'CPANEL_DEBUG_LEVEL'} ? int $ENV{'CPANEL_DEBUG_LEVEL'} : 0 ); my $debug_hooks_value; my $logger; sub debug_level { my ($level) = @_; $Cpanel::Debug::level = $level if defined $level; return $Cpanel::Debug::level; } sub logger { $logger = shift if (@_); # Set method for $logger if something is passed in. return $logger ||= do { local ( $@, $! ); require Cpanel::Logger; Cpanel::Logger->new(); }; } sub log_error { local $!; #prevent logger from overwriting $! return logger()->error( $_[0] ); } sub log_warn { local $!; #prevent logger from overwriting $! return logger()->warn( $_[0] ); } sub log_warn_no_backtrace { local $!; #prevent logger from overwriting $! my $logger = logger(); no warnings 'once'; local $Cpanel::Logger::ENABLE_BACKTRACE = 0; return $logger->warn( $_[0] ); } sub log_invalid { local $!; #prevent logger from overwriting $! return logger()->invalid( $_[0] ); } sub log_deprecated { local $!; #prevent logger from overwriting $! return logger()->deprecated( $_[0] ); } sub log_panic { local $!; #prevent logger from overwriting $! return logger()->panic( $_[0] ); } sub log_die { local $!; #prevent logger from overwriting $! return logger()->die( $_[0] ); } sub log_info { local $!; #prevent logger from overwriting $! return logger()->info( $_[0] ); } sub log_debug { local $!; #prevent logger from overwriting $! return logger()->debug( $_[0] ); } sub log_dump { require Data::Dumper; no warnings 'once'; local $Data::Dumper::Sortkeys = 1; return log_info( Data::Dumper::Dumper( $_[0] ) ); } sub debug_hooks_value { return $debug_hooks_value if defined $debug_hooks_value; return ( $debug_hooks_value = ( stat($HOOKS_DEBUG_FILE) )[7] || 0 ); } 1; } # --- END Cpanel/Debug.pm { # --- BEGIN Cpanel/Destruct.pm package Cpanel::Destruct; use strict; my $in_global_destruction = 0; my ( $package, $filename, $line, $subroutine ); # preallocate sub in_dangerous_global_destruction { if ( !$INC{'Test2/API.pm'} ) { return 1 if in_global_destruction() && $INC{'Cpanel/BinCheck.pm'}; } return 0; } sub in_global_destruction { return $in_global_destruction if $in_global_destruction; if ( defined( ${^GLOBAL_PHASE} ) ) { if ( ${^GLOBAL_PHASE} eq 'DESTRUCT' ) { $in_global_destruction = 1; } } else { local $SIG{'__WARN__'} = \&_detect_global_destruction_pre_514_WARN_handler; warn; } return $in_global_destruction; } sub _detect_global_destruction_pre_514_WARN_handler { if ( length $_[0] > 26 && rindex( $_[0], 'during global destruction.' ) == ( length( $_[0] ) - 26 ) ) { $in_global_destruction = 1; } return; } 1; } # --- END Cpanel/Destruct.pm { # --- BEGIN Cpanel/Finally.pm package Cpanel::Finally; use cPstrict; no warnings 'once'; # use Cpanel::Carp (); # perlpkg line 211 # use Cpanel::Destruct (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 sub new ( $class, @todo_crs ) { local $/ = "\n"; # Carp warns when $/ is undef, breaking tests return bless { 'pid' => $$, 'todo' => [@todo_crs], _from => Cpanel::Carp::safe_longmess() }, $class; } sub add ( $self, @new_crs ) { $self->{'todo'} //= []; push @{ $self->{'todo'} }, @new_crs; return; } sub skip ($self) { return delete $self->{'todo'}; } sub DESTROY ($self) { return if $$ != $self->{'pid'} || !$self->{'todo'}; if ( Cpanel::Destruct::in_dangerous_global_destruction() ) { Cpanel::Debug::log_die( qq[PROG $0 - Cpanel::Finally should never be triggered during global destruction\nCalled from ] . $self->{_from} ); } local $@; #prevent insidious clobber of error messages while ( @{ $self->{'todo'} } ) { my $ok = eval { while ( my $item = shift @{ $self->{'todo'} } ) { $item->(); } 1; }; warn $@ if !$ok; } return; } 1; } # --- END Cpanel/Finally.pm { # --- BEGIN Cpanel/Readlink.pm package Cpanel::Readlink; use strict; use warnings; no warnings 'once'; # use Cpanel::Autodie (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 use Cwd (); our $MAX_SYMLINK_DEPTH = 1024; sub deep { my ( $link, $provide_trailing_slash ) = @_; die Cpanel::Exception::create( 'MissingParameter', 'Provide a link path.' ) if !length $link; if ( length($link) > 1 && substr( $link, -1, 1 ) eq '/' ) { $link = substr( $link, 0, length($link) - 1 ); return deep( $link, 1 ); } if ( !-l $link ) { return $provide_trailing_slash ? qq{$link/} : $link; } my %is_link; $is_link{$link} = 1; my $depth = 0; my $base = _get_base_for($link); if ( substr( $link, 0, 1 ) ne '/' ) { $base = Cwd::abs_path() . '/' . $base; } while ( ( $is_link{$link} ||= -l $link ) && ++$depth <= $MAX_SYMLINK_DEPTH ) { $link = Cpanel::Autodie::readlink($link); if ( substr( $link, 0, 1 ) ne '/' ) { $link = $base . '/' . $link; } $base = _get_base_for($link); } return $provide_trailing_slash ? qq{$link/} : $link; } sub _get_base_for { my $basename = shift; my @path = split( '/', $basename ); pop(@path); return join( '/', @path ); } 1; } # --- END Cpanel/Readlink.pm { # --- BEGIN Cpanel/FileUtils/Write.pm package Cpanel::FileUtils::Write; use strict; use warnings; no warnings 'once'; # use Cpanel::Fcntl::Constants (); # perlpkg line 211 use Cpanel::Autodie ( 'rename', 'syswrite_sigguard', 'seek', 'print', 'truncate' ); # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::FileUtils::Open (); # perlpkg line 211 # use Cpanel::Finally (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 our $Errno_EEXIST = 17; our $MAX_TMPFILE_CREATE_ATTEMPTS = 1024; my $DEFAULT_PERMS = 0600; my $_WRONLY_CREAT_EXCL; sub write_fh { ##no critic qw(RequireArgUnpacking) my $fh = $_[0]; Cpanel::Autodie::seek( $fh, 0, 0 ); Cpanel::Autodie::print( $fh, $_[1] ); Cpanel::Autodie::truncate( $fh, tell($fh) ); return 1; } sub write { return _write_to_tmpfile( @_[ 0 .. 2 ], \&_write_finish ); } sub overwrite { return _write_to_tmpfile( @_[ 0 .. 2 ], \&_overwrite_finish ); } sub overwrite_no_exceptions { my $fh; local $@; eval { $fh = overwrite(@_); 1; } or Cpanel::Debug::log_warn("overwrite exception: $@"); return !!$fh; } sub _write_to_tmpfile { ##no critic qw(RequireArgUnpacking) my ( $filename, $perms_or_hr, $finish_cr ) = ( $_[0], $_[2], $_[3] ); if ( !defined $filename ) { exists $INC{'Carp.pm'} ? Carp::confess("write() called with undefined filename") : die("write() called with undefined filename"); } if ( ref $filename ) { die "Use write_fh to write to a file handle. ($filename is a filehandle, right?)"; } my ( $fh, $tmpfile_is_renamed ); if ( -l $filename ) { require Cpanel::Readlink; $filename = Cpanel::Readlink::deep($filename); } my ( $callback_cr, $tmp_perms ); if ( 'HASH' eq ref $perms_or_hr ) { $callback_cr = $perms_or_hr->{'before_installation'}; } else { $tmp_perms = $perms_or_hr; } $tmp_perms //= $DEFAULT_PERMS; my ( $tmpfile, $attempts ) = ( '', 0 ); while (1) { local $!; my $rand = rand(99999999); $rand = sprintf( '%x', substr( $rand, 2 ) ); my $last_slash_idx = rindex( $filename, '/' ); $tmpfile = $filename; substr( $tmpfile, 1 + $last_slash_idx, 0 ) = ".tmp.$rand."; last if Cpanel::FileUtils::Open::sysopen_with_real_perms( $fh, $tmpfile, ( $_WRONLY_CREAT_EXCL ||= ( $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_EXCL | $Cpanel::Fcntl::Constants::O_WRONLY ) ), $tmp_perms, ); if ( $! != $Errno_EEXIST ) { die Cpanel::Exception::create( 'IO::FileCreateError', [ error => $!, path => $tmpfile, permissions => $tmp_perms ] ); } ++$attempts; if ( $attempts >= $MAX_TMPFILE_CREATE_ATTEMPTS ) { die Cpanel::Exception::create_raw( 'IO::FileCreateError', "Too many ($MAX_TMPFILE_CREATE_ATTEMPTS) failed attempts to create a temp file as EUID $> and GID $) based on “$filename”! The last tried file was “$tmpfile”, and the last error was: $!" ); } } my $finally = Cpanel::Finally->new( sub { if ( !$tmpfile_is_renamed ) { Cpanel::Autodie::unlink_if_exists($tmpfile); } return; } ); if ( my $ref = ref $_[1] ) { if ( $ref eq 'SCALAR' ) { _write_fh( $fh, ${ $_[1] } ); } else { die Cpanel::Exception::create( 'InvalidParameter', 'Invalid content type “[_1]”, expect a scalar.', [$ref] ); } } else { _write_fh( $fh, $_[1] ); } $callback_cr->($fh) if $callback_cr; $tmpfile_is_renamed = $finish_cr->( $tmpfile, $filename ); if ( !$tmpfile_is_renamed ) { Cpanel::Autodie::unlink_if_exists($tmpfile); } $finally->skip(); return $fh; } *_syswrite = *Cpanel::Autodie::syswrite_sigguard; our $DEBUG_WRITE; sub _write_fh { if ( length $_[1] ) { my $pos = 0; do { local $SIG{'XFSZ'} = 'IGNORE' if $pos; $pos += _syswrite( $_[0], $_[1], length( $_[1] ), $pos ) || do { die "Zero bytes written, non-error!"; }; } while $pos < length( $_[1] ); } return; } sub _write_finish { Cpanel::Autodie::link(@_); return 0; } *_overwrite_finish = *Cpanel::Autodie::rename; 1; } # --- END Cpanel/FileUtils/Write.pm { # --- BEGIN Cpanel/FileUtils/Write/JSON/Lazy.pm package Cpanel::FileUtils::Write::JSON::Lazy; use strict; use warnings; no warnings 'once'; sub write_file { my ( $file_or_fh, $data, $perms ) = @_; if ( exists $INC{'Cpanel/JSON.pm'} && exists $INC{'JSON/XS.pm'} && ( my $Dump = 'Cpanel::JSON'->can('Dump') ) ) { # PPI NO PARSE -- check earlier - must be quoted or it ends up in the stash require Cpanel::FileUtils::Write if !$INC{'Cpanel/FileUtils/Write.pm'}; require Cpanel::FHUtils::Tiny if !$INC{'Cpanel/FHUtils/Tiny.pm'}; my $func = Cpanel::FHUtils::Tiny::is_a($file_or_fh) ? 'write_fh' : 'overwrite'; if ( $func eq 'write_fh' ) { if ( !defined $perms ) { $perms = 0600; } chmod( $perms, $file_or_fh ) or die "Failed to set permissions on the file handle passed to Cpanel::FileUtils::Write::JSON::Lazy::write_file because of an error: $!"; } return Cpanel::FileUtils::Write->can($func)->( $file_or_fh, $Dump->($data), $perms ); } return 0; } sub write_file_pretty { my ( $file_or_fh, $data, $perms ) = @_; if ( exists $INC{'Cpanel/JSON.pm'} && exists $INC{'JSON/XS.pm'} && ( my $Dump = 'Cpanel::JSON'->can('pretty_dump') ) ) { # PPI NO PARSE -- check earlier - must be quoted or it ends up in the stash require Cpanel::FileUtils::Write if !$INC{'Cpanel/FileUtils/Write.pm'}; require Cpanel::FHUtils::Tiny if !$INC{'Cpanel/FHUtils/Tiny.pm'}; my $func = Cpanel::FHUtils::Tiny::is_a($file_or_fh) ? 'write_fh' : 'overwrite'; if ( $func eq 'write_fh' ) { if ( !defined $perms ) { $perms = 0600; } chmod( $perms, $file_or_fh ) or die "Failed to set permissions on the file handle passed to Cpanel::FileUtils::Write::JSON::Lazy::write_file because of an error: $!"; } return Cpanel::FileUtils::Write->can($func)->( $file_or_fh, $Dump->($data), $perms ); } return 0; } 1; } # --- END Cpanel/FileUtils/Write/JSON/Lazy.pm { # --- BEGIN Cpanel/JSON/Unicode.pm package Cpanel::JSON::Unicode; use strict; use warnings; no warnings 'once'; use constant { _LEAD_SURROGATE_MIN => 0xd800, _TAIL_SURROGATE_MIN => 0xdc00, _SURROGATE_MASK => 0xfc00, _BACKSLASH_ORD => 0x5c, _DOUBLE_QUOTE_ORD => 0x22, }; my $UNICODE_ESCAPE_REGEXP = qr/ (?<!\x5c) ( (?:\x5c\x5c)* \x5c u ([0-9a-fA-F]{4}) ) /x; sub replace_unicode_escapes_with_utf8 { my ($json_sr) = @_; my $lead_surrogate; my $ret = $$json_sr =~ s<$UNICODE_ESCAPE_REGEXP>< _replacement(\$lead_surrogate, $json_sr, $+[0], @{^CAPTURE}) >ge; if ($lead_surrogate) { die sprintf "Incomplete surrogate pair (0x%04x)", $lead_surrogate; } return $ret; } sub _replacement { my ( $lead_surrogate_sr, $json_sr, $match_end, @captures ) = @_; my $num = hex $captures[1]; if ( ( $num & _SURROGATE_MASK ) == _TAIL_SURROGATE_MIN ) { if ($$lead_surrogate_sr) { my $utf8 = _decode_surrogates( $$lead_surrogate_sr, $num ); $$lead_surrogate_sr = undef; return $utf8; } die sprintf "Unpaired trailing surrogate (0x%04x)", $num; } elsif ( ( $num & _SURROGATE_MASK ) == _LEAD_SURROGATE_MIN ) { my $next2 = substr( $$json_sr, $match_end, 2 ); if ( !$next2 || $next2 ne '\\u' ) { die sprintf "Unpaired leading surrogate (0x%04x)", $num; } $$lead_surrogate_sr = $num; return q<>; } elsif ( $num < 0x20 || $num == _BACKSLASH_ORD || $num == _DOUBLE_QUOTE_ORD ) { return $captures[0]; } my $utf8 = chr $num; utf8::encode($utf8); return $utf8; } sub _decode_surrogates { my ( $lead, $tail ) = @_; my $uni = 0x10000 + ( ( $lead - 0xd800 ) << 10 ) + ( $tail - 0xdc00 ); my $un = chr $uni; utf8::encode($un); return $un; } 1; } # --- END Cpanel/JSON/Unicode.pm { # --- BEGIN Cpanel/LoadFile/ReadFast.pm package Cpanel::LoadFile::ReadFast; use strict; use warnings; no warnings 'once'; use constant READ_CHUNK => 1 << 18; # 262144 use constant _EINTR => 4; sub read_fast { $_[1] //= q<>; return ( @_ > 3 ? sysread( $_[0], $_[1], $_[2], $_[3] ) : sysread( $_[0], $_[1], $_[2] ) ) // do { goto \&read_fast if $! == _EINTR; die "Failed to read data: $!"; }; } my $_ret; sub read_all_fast { $_[1] //= q<>; $_ret = 1; while ($_ret) { $_ret = sysread( $_[0], $_[1], READ_CHUNK, length $_[1] ) // do { redo if $! == _EINTR; die "Failed to read data: $!"; } } return; } 1; } # --- END Cpanel/LoadFile/ReadFast.pm { # --- BEGIN Cpanel/Encoder/ASCII.pm package Cpanel::Encoder::ASCII; use strict; use warnings; no warnings 'once'; sub to_hex { my ($readable) = @_; $readable =~ s<\\><\\\\>g; $readable =~ s<([\0-\x{1f}\x{7f}-\x{ff}])><sprintf '\x{%02x}', ord $1>eg; return $readable; } 1; } # --- END Cpanel/Encoder/ASCII.pm { # --- BEGIN Cpanel/UTF8/Strict.pm package Cpanel::UTF8::Strict; use strict; use warnings; no warnings 'once'; sub decode { utf8::decode( $_[0] ) or do { local ( $@, $! ); require Cpanel::Encoder::ASCII; die sprintf "Invalid UTF-8 in string: “%s”", Cpanel::Encoder::ASCII::to_hex( $_[0] ); }; return $_[0]; } 1; } # --- END Cpanel/UTF8/Strict.pm { # --- BEGIN Cpanel/JSON.pm package Cpanel::JSON; use strict; # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::FHUtils::Tiny (); # perlpkg line 211 # use Cpanel::JSON::Unicode (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 use JSON::XS (); # use Cpanel::UTF8::Strict (); # perlpkg line 211 our $NO_DECODE_UTF8 = 0; our $DECODE_UTF8 = 1; our $LOAD_STRICT = 0; our $LOAD_RELAXED = 1; our $MAX_LOAD_LENGTH_UNLIMITED = 0; our $MAX_LOAD_LENGTH = 65535; our $MAX_PRIV_LOAD_LENGTH = 4194304; # four megs our $VERSION = '2.5'; my $copied_boolean = 0; sub DumpFile { return _dumpFile( @_, 0, 0 ); } sub DumpFilePretty { return _dumpFile( @_, 1, 0 ); } sub DumpFileCanonical { return _dumpFile( @_, 0, 1 ); } sub DumpFilePrettyCanonical { return _dumpFile( @_, 1, 1 ); } sub _dumpFile { my @args = @_; my %opts = map { $_ => shift @args } qw{file data pretty canon}; my $fh; $fh = $opts{'file'} if Cpanel::FHUtils::Tiny::is_a( $opts{'file'} ); if ( $fh || open( $fh, '>', $opts{'file'} ) ) { my %json_opts; $json_opts{'pretty'} = 1 if $opts{'pretty'}; $json_opts{'canonical'} = 1 if $opts{'canon'}; print {$fh} _create_new_json_object(%json_opts)->encode( $opts{'data'} ) or return 0; return 1; } return 0; } sub copy_boolean { if ( !$copied_boolean ) { *Types::Serialiser::Boolean:: = *JSON::PP::Boolean::; $copied_boolean = 1; } return; } sub _create_new_json_object { my (%opts) = @_; copy_boolean() if !$copied_boolean; my $obj = JSON::XS->new()->shrink(1)->allow_nonref(1)->convert_blessed(1); $obj->can($_)->( $obj, $opts{$_} ) for keys(%opts); return $obj; } 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] ); } sub canonical_dump { return _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 _create_new_json_object()->encode( $_[0] ); } sub Load { local $@; _replace_unicode_escapes_if_needed( \$_[0] ); return eval { _create_new_json_object()->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef ); } sub LoadRelaxed { local $@; _replace_unicode_escapes_if_needed( \$_[0] ); return eval { _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 { _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 { _create_new_no_set_utf8_json_object()->relaxed(1)->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef ); } sub _create_new_no_set_utf8_json_object { my $obj = _create_new_json_object(); if ( $obj->can('no_set_utf8') ) { $obj->no_set_utf8(1); } else { warn "JSON::XS is missing the no_set_utf8 flag"; } return $obj; } sub _replace_unicode_escapes_if_needed { my $json_r = shift; return unless defined $$json_r; if ( -1 != index( $$json_r, '\\u' ) ) { Cpanel::JSON::Unicode::replace_unicode_escapes_with_utf8($json_r); } return; } sub SafeLoadFile { # only allow a small bit of data to be loaded return _LoadFile( $_[0], $MAX_LOAD_LENGTH, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT ); } sub LoadFile { return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT ); } sub LoadFileRelaxed { return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_RELAXED ); } sub LoadFileNoSetUTF8 { return _LoadFile( $_[0], $_[1] || $MAX_LOAD_LENGTH_UNLIMITED, $DECODE_UTF8, $_[2], $LOAD_STRICT ); } sub _LoadFile { my ( $file, $max, $decode_utf8, $path, $relaxed ) = @_; my $data; if ( Cpanel::FHUtils::Tiny::is_a($file) ) { if ($max) { my $togo = $max; $data = ''; my $bytes_read; while ( $bytes_read = read( $file, $data, $togo, length $data ) && length $data < $max ) { $togo -= $bytes_read; } } else { Cpanel::LoadFile::ReadFast::read_all_fast( $file, $data ); } } else { local $!; open( my $fh, '<:stdio', $file ) or do { my $err = $!; require Cpanel::Carp; die Cpanel::Carp::safe_longmess("Cannot open “$file”: $err"); }; Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data ); if ( !length $data ) { require Cpanel::Carp; die Cpanel::Carp::safe_longmess("“$file” is empty."); } close $fh or warn "close($file) failed: $!"; } if ( $decode_utf8 && $decode_utf8 == $DECODE_UTF8 ) { Cpanel::UTF8::Strict::decode($data); return $relaxed ? LoadNoSetUTF8Relaxed( $data, $path || $file ) : LoadNoSetUTF8( $data, $path || $file ); } return $relaxed ? LoadRelaxed( $data, $path || $file ) : Load( $data, $path || $file ); } sub SafeDump { my $raw_json = _create_new_json_object()->encode( $_[0] ); $raw_json =~ s{\/}{\\/}g if $raw_json =~ tr{/}{}; # / fix for editors return $raw_json; } sub _fh_looks_like_json { my ($fh) = @_; my $bytes_read = 0; my $buffer = q{}; local $!; while ( $buffer !~ tr{ \t\r\n\f}{}c && !eof $fh ) { $bytes_read += ( read( $fh, $buffer, 1, length $buffer ) // die "read() failed: $!" ); } return ( _string_looks_like_json($buffer), \$buffer, ); } sub _string_looks_like_json { ##no critic qw(RequireArgUnpacking) return $_[0] =~ m/\A\s*[\[\{"0-9]/ ? 1 : 0; } sub looks_like_json { ##no critic qw(RequireArgUnpacking) if ( Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) { my $fh = $_[0]; my ( $looks_like_json, $fragment_ref ) = _fh_looks_like_json($fh); my $bytes_read = length $$fragment_ref; if ($bytes_read) { seek( $fh, -$bytes_read, $Cpanel::Fcntl::Constants::SEEK_CUR ) or die "seek() failed: $!"; } return $looks_like_json; } return _string_looks_like_json( $_[0] ); } sub to_bool { my ($val) = @_; $val = 0 if defined $val && $val eq 'false'; return !!$val ? true() : false(); } 1; } # --- END Cpanel/JSON.pm { # --- BEGIN Cpanel/AdminBin/Serializer.pm package Cpanel::AdminBin::Serializer; use strict; use warnings; no warnings 'once'; # use Cpanel::JSON (); # perlpkg line 211 our $VERSION = '2.4'; our $MAX_LOAD_LENGTH; our $MAX_PRIV_LOAD_LENGTH; BEGIN { *MAX_LOAD_LENGTH = \$Cpanel::JSON::MAX_LOAD_LENGTH; *MAX_PRIV_LOAD_LENGTH = \$Cpanel::JSON::MAX_PRIV_LOAD_LENGTH; *DumpFile = *Cpanel::JSON::DumpFile; } BEGIN { *Dump = *Cpanel::JSON::Dump; *SafeDump = *Cpanel::JSON::SafeDump; *LoadFile = *Cpanel::JSON::LoadFileNoSetUTF8; *Load = *Cpanel::JSON::Load; *looks_like_serialized_data = *Cpanel::JSON::looks_like_json; } sub SafeLoadFile { return Cpanel::JSON::_LoadFile( $_[0], $Cpanel::JSON::MAX_LOAD_LENGTH, $Cpanel::JSON::DECODE_UTF8, $_[1], $Cpanel::JSON::LOAD_STRICT ); } sub SafeLoad { utf8::decode( $_[0] ); return Cpanel::JSON::LoadNoSetUTF8(@_); } sub clone { return Cpanel::JSON::LoadNoSetUTF8( Cpanel::JSON::Dump( $_[0] ) ); } 1; } # --- END Cpanel/AdminBin/Serializer.pm { # --- BEGIN Cpanel/AdminBin/Serializer/FailOK.pm package Cpanel::AdminBin::Serializer::FailOK; use strict; use warnings; no warnings 'once'; sub LoadModule { local $@; return 1 if $INC{'Cpanel/AdminBin/Serializer.pm'}; my $load_ok = eval { local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache local $SIG{'__WARN__'}; # and since failure is ok to throw it away require Cpanel::AdminBin::Serializer; 1; }; if ( !$load_ok && !$ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == 0 ) { warn $@; } return $load_ok ? 1 : 0; } sub LoadFile { my ( $file_or_fh, $path ) = @_; return undef if !$INC{'Cpanel/AdminBin/Serializer.pm'}; return eval { local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache local $SIG{'__WARN__'}; # and since failure is ok to throw it away Cpanel::AdminBin::Serializer::LoadFile( $file_or_fh, undef, $path ); }; } 1; } # --- END Cpanel/AdminBin/Serializer/FailOK.pm { # --- BEGIN Cpanel/SV.pm package Cpanel::SV; use strict; use warnings; no warnings 'once'; sub untaint { return $_[0] unless ${^TAINT}; require # Cpanel::Static OK - we should not untaint variables as part of updatenow.static Taint::Util; Taint::Util::untaint( $_[0] ); return $_[0]; } 1; } # --- END Cpanel/SV.pm { # --- BEGIN Cpanel/Umask.pm package Cpanel::Umask; use strict; # use parent Cpanel::Finally (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::Finally); } sub new { my ( $class, $new ) = @_; my $old = umask(); umask($new); return $class->SUPER::new( sub { my $cur = umask(); if ( $cur != $new ) { my ( $cur_o, $old_o, $new_o ) = map { '0' . sprintf( '%o', $_ ) } ( $cur, $old, $new ); warn "I want to umask($old_o). I expected the current umask to be $new_o, but it’s actually $cur_o."; } umask($old); } ); } 1; } # --- END Cpanel/Umask.pm { # --- BEGIN Cpanel/Config/LoadConfig.pm package Cpanel::Config::LoadConfig; use strict; use warnings; no warnings 'once'; # use Cpanel::Hash::Stringify (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 # use Cpanel::AdminBin::Serializer::FailOK (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 # use Cpanel::HiRes (); # perlpkg line 211 # use Cpanel::SV (); # perlpkg line 211 use constant _ENOENT => 2; my $logger; our $PRODUCT_CONF_DIR = '/var/cpanel'; our $_DEBUG_SAFEFILE = 0; my %COMMON_CACHE_NAMES = ( ':__^\s*[#;]____0__' => 'default_colon', ':\s+__^\s*[#;]____0__' => 'default_colon_any_space', ': __^\s*[#;]____0__' => 'default_colon_with_one_space', '=__^\s*[#;]____0__skip_readable_check_____1' => 'default_skip_readable', '=__^\s*[#;]____0__' => 'default', '=__^\s*[#;]__(?^:\s+)__0__' => 'default_with_preproc_newline', '=__^\s*[#;]____1__' => 'default_allow_undef', '\s*[:]\s*__^\s*[#;]____0__' => 'default_colon_before_after_space', '\s*=\s*__^\s*[#;]____1__' => 'default_equal_before_after_space_allow_undef', '\s*[\=]\s*__^\s*[#]____0__use_reverse_____0' => 'default_equal_before_after_space', ': __^\s*[#;]____0__limit_____10000000000_____use_reverse_____0' => 'default_with_10000000000_limit', '\s*[:]\s*__^\s*[#;]____0__use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_use_hash_of_arr_refs', ': __^\s*[#;]____0__limit__________use_reverse_____0' => 'default_colon_single_space_no_limit', ': __^\s*[#;]____1__skip_keys_____nobody_____use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_colon_skip_nobody_no_limit', ': __^\s*[#;]____1__use_reverse_____1' => 'default_reverse_allow_undef', '\s+__^\s*[#;]____0__' => 'default_space_seperated_config', '\s*=\s*__^\s*[#;]__^\s*__0__' => 'default_equal_space_seperated_config', #ea4.conf ); my $DEFAULT_DELIMITER = '='; my $DEFAULT_COMMENT_REGEXP = '^\s*[#;]'; #Keep in sync with tr{} below!! my @BOOLEAN_OPTIONS = qw( allow_undef_values use_hash_of_arr_refs use_reverse ); my $CACHE_DIR_PERMS = 0700; sub _process_parse_args { my (%opts) = @_; if ( !defined $opts{'delimiter'} ) { $opts{'delimiter'} = $DEFAULT_DELIMITER; } $opts{'regexp_to_preprune'} ||= q{}; $opts{'comment'} ||= $DEFAULT_COMMENT_REGEXP; $opts{'comment'} = '' if $opts{'comment'} eq '0E0'; $opts{$_} ||= 0 for @BOOLEAN_OPTIONS; return %opts; } { no warnings 'once'; *get_homedir_and_cache_dir = *_get_homedir_and_cache_dir; } sub _get_homedir_and_cache_dir { my ( $homedir, $cache_dir ); if ( $> == 0 ) { $cache_dir = "$PRODUCT_CONF_DIR/configs.cache"; } else { { no warnings 'once'; $homedir = $Cpanel::homedir; } if ( !$homedir ) { eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::PwCache'; ## no critic qw(ProhibitStringyEval) # PPI USE OK - just after $homedir = Cpanel::PwCache::gethomedir() if $INC{'Cpanel/PwCache.pm'}; return unless $homedir; # undef for homedir and cache_dir avoid issues later when using undef as hash key } Cpanel::SV::untaint($homedir); $homedir =~ tr{/}{}s; return ( $homedir, undef ) if $homedir eq '/'; $cache_dir = undef; } 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); } $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 ( $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/FlushConfig.pm package Cpanel::Config::FlushConfig; use strict; use warnings; no warnings 'once'; # use Cpanel::FileUtils::Write (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 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/Update/Config.pm package Cpanel::Update::Config; use cPstrict; no warnings 'once'; # use Cpanel::Config::LoadConfig (); # perlpkg line 211 our $VERSION = '2.1'; our $cpanel_update_conf = '/etc/cpupdate.conf'; use constant DEFAULT_TIER => 'release'; sub _default_preferences { return { 'CPANEL' => DEFAULT_TIER, 'RPMUP' => 'daily', 'SARULESUP' => 'daily', 'UPDATES' => 'daily', 'SECURITY_UPDATES' => 'hourly', 'STAGING_DIR' => '/usr/local/cpanel', }; } sub valid_keys { return [qw/CPANEL RPMUP SARULESUP UPDATES SECURITY_UPDATES STAGING_DIR/]; } sub cadence_keys { return [qw/UPDATES RPMUP SARULESUP/]; } sub valid_cadence_values { return [qw/daily manual never/]; } sub is_valid_cadence ( $value = undef ) { return 0 if !defined $value; return scalar grep { lc($value) eq $_ } @{ valid_cadence_values() }; } sub valid_security_updates_values { return [qw/hourly never/]; } sub is_valid_security_updates ( $value = undef ) { return 0 if !defined $value; return scalar grep { lc($value) eq $_ } @{ valid_security_updates_values() }; } sub load { my $default_rUPCONF = _default_preferences(); if ( ${^GLOBAL_PHASE} && ${^GLOBAL_PHASE} eq 'START' && lc($0) ne '-e' ) { die q[FATAL: load is called during compile time. You should postpone this call.]; } if ( !-e $cpanel_update_conf ) { save($default_rUPCONF); return wantarray ? %{$default_rUPCONF} : $default_rUPCONF; } my $rUPCONF = Cpanel::Config::LoadConfig::loadConfig($cpanel_update_conf); my $changed = sanitize($rUPCONF); foreach my $key ( keys %{$default_rUPCONF} ) { if ( !exists $rUPCONF->{$key} ) { $changed++; $rUPCONF->{$key} = $default_rUPCONF->{$key}; } } save($rUPCONF) if $changed; return wantarray ? %{$rUPCONF} : $rUPCONF; } sub sanitize ( $conf_ref = undef, $die_on_failure = undef ) { return if ref $conf_ref ne 'HASH'; my $changed = 0; my %is_valid_key = map { $_ => 1 } @{ valid_keys() }; my %is_cadence_key = map { $_ => 1 } @{ cadence_keys() }; foreach my $key ( keys %{$conf_ref} ) { my $value = $conf_ref->{$key}; if ( !defined $value ) { $value = ''; $changed++; } else { $changed++ if ( $value =~ s/[\n\r]//g ); # Strip newline chars $changed++ if ( $value =~ s/^\s+// ); # Strip leading whitespace $changed++ if ( $value =~ s/\s+$// ); # Strip trailing whitespace } if ( !$is_valid_key{$key} ) { if ( !length $value ) { delete $conf_ref->{$key}; $changed++; next; } $conf_ref->{$key} = $value; next; } if ( $key eq 'CPANEL' && !$value ) { $value = _default_preferences()->{'CPANEL'}; $changed++; } if ($value) { $changed++ if ( $value ne '/' and $value =~ s{/+$}{} ); # Strip trailing slash. This is for STAGING_DIR but nothing else should have a slash in its value. if ( $key ne 'STAGING_DIR' ) { $changed++ if ( $value =~ tr/A-Z/a-z/ ); } if ( $key eq 'CPANEL' ) { my $new_value = _normalize_version($value); # Automatically add the 11 or strip the v when existing if ( $new_value ne $value ) { $value = $new_value; $changed++; } } } if ( $is_cadence_key{$key} and not is_valid_cadence($value) ) { $value = _default_preferences()->{$key}; $changed++; } if ( $key eq 'SECURITY_UPDATES' and not is_valid_security_updates($value) ) { $value = _default_preferences()->{'SECURITY_UPDATES'}; $changed++; } if ( $key eq 'STAGING_DIR' and not validate_staging_dir( $value, $die_on_failure ) ) { $value = _default_preferences()->{'STAGING_DIR'}; $changed++; # Flag for file save } $conf_ref->{$key} = $value; } return $changed; } sub _normalize_version ( $version = undef ) { return if !length $version; my $candidate = $version; $candidate =~ s/^v(?=[0-9])//; return $version if $candidate =~ tr/0-9.//c; return $candidate if rindex( $candidate, '11.', 0 ) == 0; return '11.' . $candidate; } sub _stat_directory { my $dir = shift; return stat($dir); } sub validate_staging_dir { my ( $value, $die_on_failure ) = @_; my $ulc = '/usr/local/cpanel'; my $ulc_dev = ( _stat_directory($ulc) )[0]; return if not $value; if ( !_is_valid_filepath($value) ) { die "'$value' is not a valid directory path\n" if $die_on_failure; return; } my @stat = _stat_directory($value) or return 1; if ( -e $value && !-d $value ) { die "'$value' exists on the file system, but is not a directory\n" if $die_on_failure; return; } if ( -e $value && ( !-d $value || !( -d $value && -w $value ) ) ) { die "'$value' exists on the file system, but is not a writable directory\n" if $die_on_failure; return; } if ( 0 != $stat[4] ) { die "'$value' exists on the file system, but is not owned by the root user\n" if $die_on_failure; return; } if ( $stat[0] == $ulc_dev && $value ne $ulc ) { die "'$value' is on the same file system as /usr/local/cpanel. Please use /usr/local/cpanel instead.\n" if $die_on_failure; return; } if ( $stat[2] & 022 ) { die "'$value' exists on the file system, but does not have the correct permissions. Directory must not have write permissions for group and non-root users\n" if $die_on_failure; return; } return 1; } sub save { my $conf_ref = shift; my $die_on_failure = shift; return if ref $conf_ref ne 'HASH'; return if ( $> != 0 ); sanitize( $conf_ref, $die_on_failure ); require Cpanel::Config::FlushConfig; if ( my $return = Cpanel::Config::FlushConfig::flushConfig( $cpanel_update_conf, $conf_ref, '=', undef, { 'sort' => 1 } ) ) { return $return; } else { die "Unable to save file, $cpanel_update_conf: $!\n" if $die_on_failure; return; } } sub get_tier { my ($update_config_ref) = @_; if ( !defined $update_config_ref ) { $update_config_ref = load(); } return if ref $update_config_ref ne 'HASH'; return $update_config_ref->{'CPANEL'}; } sub is_permitted { my $key = shift or return; my $up_conf = shift or return; ref $up_conf eq 'HASH' or return; $key = uc($key); # Force key case upper. my $key_value = $up_conf->{$key} or return; return if ( $key eq 'RPMUP' && $ENV{'CPANEL_BASE_INSTALL'} ); return if ( $key_value eq 'never' ); return if ( $ENV{'CPANEL_IS_CRON'} && $key_value eq 'manual' ); return 1; } sub get_update_type { my $rUPCONF = load(); return $rUPCONF->{'UPDATES'}; } sub _is_valid_filepath { my $filepath = shift; return 1 if index( $filepath, '/' ) == 0; # checking for / is the same as file_name_is_absolute return; } 1; } # --- END Cpanel/Update/Config.pm { # --- BEGIN Cpanel/FileUtils/Touch.pm package Cpanel::FileUtils::Touch; use strict; use warnings; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::Autodie (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 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; no warnings 'once'; # use parent Cpanel::Config::TouchFileBase (); # perlpkg line 238 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/SafeDir/MK.pm package Cpanel::SafeDir::MK; use strict; use warnings; no warnings 'once'; # use Cpanel::Debug (); # perlpkg line 211 my $DEFAULT_PERMISSIONS = 0755; sub safemkdir_or_die { my ( $dir, $mode, $created ) = @_; my $ok = safemkdir( $dir, $mode, $created ); if ( !$ok ) { my $error = $!; require Cpanel::Exception; die Cpanel::Exception::create( 'IO::DirectoryCreateError', [ path => $dir, error => $error, ] ); } return $ok; } sub safemkdir { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix my ( $dir, $mode, $errors, $created ) = @_; if ( defined $mode ) { if ( $mode eq '' ) { $mode = undef; } elsif ( index( $mode, '0' ) == 0 ) { if ( length $mode < 3 || $mode =~ tr{0-7}{}c || !defined oct $mode ) { $mode = $DEFAULT_PERMISSIONS; } else { $mode = oct($mode); } } elsif ( $mode =~ tr{0-9}{}c ) { $mode = $DEFAULT_PERMISSIONS; } } $dir =~ tr{/}{}s; my $default = ''; if ( index( $dir, '/' ) == 0 ) { $default = '/'; } elsif ( $dir eq '.' || $dir eq './' ) { if ( !-l $dir && defined $mode ) { return chmod $mode, $dir; } return 1; } else { substr( $dir, 0, 2, '' ) if index( $dir, './' ) == 0; } if ( _has_dot_dot($dir) ) { Cpanel::Debug::log_warn("Possible improper directory $dir specified"); my @dir_parts = split m{/}, $dir; my @good_parts; my $first; foreach my $part (@dir_parts) { next if ( !defined $part || $part eq '' ); next if $part eq '.'; if ( $part eq '..' ) { if ( !$first || !@good_parts ) { Cpanel::Debug::log_warn("Will not proceed above first directory part $first"); return 0; } if ( $first eq $good_parts[$#good_parts] ) { undef $first; } pop @good_parts; next; } elsif ( $part !~ tr{.}{}c ) { Cpanel::Debug::log_warn("Total stupidity found in directory $dir"); return 0; } push @good_parts, $part; if ( !$first ) { $first = $part } } $dir = $default . join '/', @good_parts; if ( !$dir ) { Cpanel::Debug::log_warn("Could not validate given directory"); return; } Cpanel::Debug::log_warn("Improper directory updated to $dir"); } if ( -d $dir ) { if ( !-l $dir && defined $mode ) { return chmod $mode, $dir; } return 1; } elsif ( -e _ ) { Cpanel::Debug::log_warn("$dir was expected to be a directory!"); require Errno; $! = Errno::ENOTDIR(); ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- for legacy reasons return 0; } my @dir_parts = split m{/}, $dir; if ( scalar @dir_parts > 100 ) { Cpanel::Debug::log_warn("Encountered excessive directory length. This should never happen."); return 0; } my $returnvalue; foreach my $i ( 0 .. $#dir_parts ) { my $newdir = join( '/', @dir_parts[ 0 .. $i ] ); next if $newdir eq ''; my $is_dir = -d $newdir; my $exists = -e _; if ( !$exists ) { my $local_mode = defined $mode ? $mode : $DEFAULT_PERMISSIONS; if ( mkdir( $newdir, $local_mode ) ) { push @{$created}, $newdir if $created; $returnvalue++; } else { Cpanel::Debug::log_warn("mkdir $newdir failed: $!"); return; } } elsif ( !$is_dir ) { Cpanel::Debug::log_warn("Encountered non-directory $newdir in path of $dir: $!"); require Errno; $! = Errno::ENOTDIR(); ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- for legacy reasons last; } } return $returnvalue; } sub _has_dot_dot { ## no critic qw(RequireArgUnpacking) return 1 if $_[0] eq '..'; return 1 if -1 != index( $_[0], '/../' ); return 1 if 0 == index( $_[0], '../' ); return 1 if ( length( $_[0] ) - 3 ) == rindex( $_[0], '/..' ); return 0; } 1; } # --- END Cpanel/SafeDir/MK.pm { # --- BEGIN Cpanel/FHUtils/Autoflush.pm package Cpanel::FHUtils::Autoflush; use strict; use warnings; no warnings 'once'; sub enable { select( ( select( $_[0] ), $| = 1 )[0] ); ## no critic qw(InputOutput::ProhibitOneArgSelect Variables::RequireLocalizedPunctuationVars) - aka $socket->autoflush(1) without importing IO::Socket return; } 1; } # --- END Cpanel/FHUtils/Autoflush.pm { # --- BEGIN Cpanel/Update/Logger.pm package Cpanel::Update::Logger; use strict; use warnings; no warnings 'once'; # use Cpanel::SafeDir::MK (); # perlpkg line 211 # use Cpanel::Time::Local (); # perlpkg line 211 # use Cpanel::FHUtils::Autoflush (); # perlpkg line 211 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/Version/Tiny.pm package Cpanel::Version::Tiny; use strict; our $VERSION = '11.134.0'; our $VERSION_BUILD = '11.134.0.56'; our $VERSION_TEXT = '134.0 (build 56)'; our $VERSION_DISPLAY = '134.0.56'; our $parent_version = 11; our $major_version = 134; our $minor_version = 0; our $build_number = 56; our $build_time_text = 'Thu Sep 10 13:30:56 2026'; our $buildtime = 1789065056; 1; } # --- END Cpanel/Version/Tiny.pm { # --- BEGIN Cpanel/Version/Full.pm package Cpanel::Version::Full; use strict; my $full_version; our $VERSION_FILE = '/usr/local/cpanel/version'; sub getversion { if ( !$full_version ) { if ( open my $ver_fh, '<', $VERSION_FILE ) { if ( read $ver_fh, $full_version, 32 ) { chomp($full_version); } elsif ($!) { warn "read($VERSION_FILE): $!"; } } else { warn "open($VERSION_FILE): $!"; } if ( !$full_version || $full_version =~ tr{.}{} < 3 ) { require Cpanel::Version::Tiny; $full_version = $Cpanel::Version::Tiny::VERSION_BUILD; } } return $full_version; } sub _clear_cache { undef $full_version; return; } 1; } # --- END Cpanel/Version/Full.pm { # --- BEGIN Cpanel/Version/Compare.pm package Cpanel::Version::Compare; use cPstrict; no warnings 'once'; my %modes = ( '>' => sub ( $check, $against ) { return if $check eq $against; # no need to continue if they are the same return ( cmp_versions( $check, $against ) > 0 ); }, '<' => sub ( $check, $against ) { return if $check eq $against; # no need to continue if they are the same return ( cmp_versions( $check, $against ) < 0 ); }, '==' => sub ( $check, $against ) { return ( $check eq $against || cmp_versions( $check, $against ) == 0 ); }, '!=' => sub ( $check, $against ) { return ( $check ne $against && cmp_versions( $check, $against ) != 0 ); }, '>=' => sub ( $check, $against ) { return 1 if $check eq $against; # no need to continue if they are the same return ( cmp_versions( $check, $against ) >= 0 ); }, '<=' => sub ( $check, $against ) { return 1 if $check eq $against; # no need to continue if they are the same return ( cmp_versions( $check, $against ) <= 0 ); }, '<=>' => sub ( $check, $against ) { return cmp_versions( $check, $against ); }, ); sub compare ( $check, $mode, $against ) { if ( !defined $mode || !exists $modes{$mode} ) { return; } foreach my $ver ( $check, $against ) { $ver //= ''; if ( $ver !~ m{ ^((?:\d+[._]){0,}\d+[a-z]?).*?$ }axms ) { return; } $ver = $1; } $check =~ s/_/\./g; $against =~ s/_/\./g; $check =~ s/([a-z])$/'.' . ord($1)/e; $against =~ s/([a-z])$/'.' . ord($1)/e; my @check_len = split( /[_\.]/, $check ); my @against_len = split( /[_\.]/, $against ); if ( @check_len > 4 ) { return; } elsif ( @check_len < 4 ) { for ( 1 .. 4 - @check_len ) { $check .= '.0'; } } if ( @against_len > 4 ) { return; } elsif ( @against_len < 4 ) { for ( 1 .. 4 - @against_len ) { $against .= '.0'; } } return if $check !~ m { \A \d+\.\d+\.\d+\.\d+ \z }axms; return if $against !~ m { \A \d+\.\d+\.\d+\.\d+ \z }axms; return $modes{$mode}->( $check, $against ); } sub cmp_versions ( $left, $right ) { my ( $maj, $min, $rev, $sup ) = split /[\._]/, $left; my ( $mj, $mn, $rv, $sp ) = split /[\._]/, $right; return $maj <=> $mj || $min <=> $mn || $rev <=> $rv || $sup <=> $sp; } sub get_major_release ( $version = '' ) { $version =~ s/\s*//g; my ( $major, $minor ); if ( $version =~ m/^([0-9]+)\.([0-9]+)/ ) { $major = int $1; $minor = int $2; } else { return; } $minor++ if $minor % 2; return "$major.$minor"; } sub compare_major_release ( $check, $mode, $against ) { return unless defined $check && defined $mode && defined $against; my $maj1 = get_major_release($check); return unless defined $maj1; my $maj2 = get_major_release($against); return unless defined $maj2; return $modes{$mode}->( $maj1, $maj2 ); } 1; } # --- END Cpanel/Version/Compare.pm { # --- BEGIN Cpanel/Alarm.pm package Cpanel::Alarm; use strict; use warnings; no warnings 'once'; # use Cpanel::Destruct (); # perlpkg line 211 sub new { my $class = shift or die("Cpanel::Alarm::new is a method call."); my $local_alarm_length = shift || 0; my $action = shift; my $self = bless( {}, $class ); $self->{'previous_alarm_time_left'} = $self->set($local_alarm_length); $self->{'creation_time'} = $self->{'local_alarm_start'}; $self->{'previous_action'} = $SIG{'ALRM'}; if ( defined $action ) { $SIG{'ALRM'} = $action; } return $self; } sub get_length { return shift->{'local_alarm_length'} } sub set { ## no critic qw(Unpack) $_[0] or die 'Need argument!'; $_[0]->{'local_alarm_length'} = $_[1]; $_[0]->{'local_alarm_start'} = time(); if ( $_[1] =~ tr<.><> ) { require Time::HiRes; return Time::HiRes::alarm( $_[1] ); } return alarm( $_[1] ); # This is the total length of the alarm since new() } sub get_remaining { my $self = shift or die; return ( $self->{'local_alarm_length'} - ( time - $self->{'local_alarm_start'} ) ); } sub DESTROY { my $self = shift or return; return if Cpanel::Destruct::in_dangerous_global_destruction(); $SIG{'ALRM'} = $self->{'previous_action'} || 'DEFAULT'; alarm(0); return if ( !$self->{'previous_alarm_time_left'} ); my $new_alarm = int( $self->{'previous_alarm_time_left'} - ( time() - $self->{'creation_time'} ) ); ( $new_alarm <= 0 ) ? alarm(1) : alarm($new_alarm); } 1; } # --- END Cpanel/Alarm.pm { # --- BEGIN Cpanel/Config/Sources.pm package Cpanel::Config::Sources; use strict; use warnings; no warnings 'once'; # use Cpanel::Config::LoadConfig (); # perlpkg line 211 use constant MY_IPV4_ENDPOINT => 'https://myip.cpanel.net/v1.0/'; our $cpsources_conf_file = '/etc/cpsources.conf'; sub get_source { my ($want_key) = @_; return unless length $want_key; my $conf = loadcpsources(); return $conf->{$want_key} // ''; } my $load_cpsources_cache; sub set_cache { return $load_cpsources_cache = shift; } sub loadcpsources { if ( !$load_cpsources_cache ) { if ( ${^GLOBAL_PHASE} && ${^GLOBAL_PHASE} eq 'START' && lc($0) ne '-e' ) { die q[FATAL: loadcpsources is called during compile time. You should postpone this call.]; } my $update_default = 'httpupdate.cpanel.net'; my %sources = ( 'NEWS' => 'web.cpanel.net', 'RSYNC' => 'rsync.cpanel.net', 'HTTPUPDATE' => $update_default, 'MYIP' => MY_IPV4_ENDPOINT, # URL to determine a local IP's public IP (1to1 NAT) 'STORE_SERVER_URL' => 'https://store.cpanel.net', 'TICKETS_SERVER_URL' => 'https://account.cpanel.net', 'VERIFY_URL' => 'https://verify.cpanel.net', 'MANAGE2_URL' => 'https://manage2.cpanel.net', ); if ( -e $cpsources_conf_file ) { Cpanel::Config::LoadConfig::loadConfig( $cpsources_conf_file, \%sources ); } foreach my $key ( keys %sources ) { next if ( !defined $sources{$key} ); $sources{$key} =~ s/^\s+//; $sources{$key} =~ s/\s+$//; } $load_cpsources_cache = \%sources; } return wantarray ? %$load_cpsources_cache : $load_cpsources_cache; } 1; } # --- END Cpanel/Config/Sources.pm { # --- BEGIN Cpanel/ArrayFunc/Shuffle.pm package Cpanel::ArrayFunc::Shuffle; use strict; use warnings; no warnings 'once'; sub shuffle { my $element_to_shuffle = scalar @{ $_[0] }; my $element_to_exchange; while ( $element_to_shuffle-- ) { $element_to_exchange = int rand( $element_to_shuffle + 1 ); @{ $_[0] }[ $element_to_shuffle, $element_to_exchange ] = @{ $_[0] }[ $element_to_exchange, $element_to_shuffle ]; } return $_[0]; } 1; } # --- END Cpanel/ArrayFunc/Shuffle.pm { # --- BEGIN Cpanel/JSON/FailOK.pm package Cpanel::JSON::FailOK; use strict; use warnings; no warnings 'once'; sub LoadJSONModule { local $@; my $load_ok = eval { local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache local $SIG{'__WARN__'}; # and since failure is ok to throw it away require Cpanel::JSON; # PPI NO PARSE - FailOK 1; }; if ( !$load_ok && !$ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == 0 ) { warn $@; } return $load_ok ? 1 : 0; } sub LoadFile { return undef if !$INC{'Cpanel/JSON.pm'}; return eval { local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache local $SIG{'__WARN__'}; # and since failure is ok to throw it away Cpanel::JSON::LoadFile(@_); # PPI NO PARSE - inc check above }; } 1; } # --- END Cpanel/JSON/FailOK.pm { # --- BEGIN Cpanel/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_CONF = '/etc/dovecot/dovecot.conf'; 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 $DOVECOT_AUTH_POLICY = '/etc/dovecot/auth_policy.conf'; 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/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 (); # perlpkg line 211 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; no warnings 'once'; 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; no warnings 'once'; 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 (); # perlpkg line 211 $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 # perlpkg line 211 @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 ) = @_; 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 = scalar( $handle->{'Locales.pm'}{'_main_'}->get_plural_form( $num, @forms ) ); if ( index( $string, '%s' ) > -1 ) { $string = sprintf( $string, $handle->numf( $num, $max_decimal_places ) ); } return $string; } 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 '"' ? '&quot;' : $chr_num eq '&' ? '&amp;' : $chr_num eq "'" ? '&#39;' : $chr_num eq '<' ? '&lt;' : $chr_num eq '>' ? '&gt;' : $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 ? '&quot;' : $chr_num == 38 ? '&amp;' : $chr_num == 39 || $chr_num == 145 || $chr_num == 146 ? '&#39;' : $chr_num == 60 ? '&lt;' : $chr_num == 62 ? '&gt;' : $chr_num == 173 ? '&shy;' : $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; no warnings 'once'; 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; no warnings 'once'; BEGIN { eval { require CDB_File; }; } # use Cpanel::Locale::Utils::Paths (); # perlpkg line 211 $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/Config/Constants.pm package Cpanel::Config::Constants; use strict; use warnings; no warnings 'once'; 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(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; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::SSL::KeyTypeLabel (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::SSL::DefaultKey::Constants (); # perlpkg line 211 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; no warnings 'once'; 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; no warnings 'once'; # use parent Cpanel::Hash::JSONable (); # perlpkg line 238 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/StringFunc/Trim.pm package Cpanel::StringFunc::Trim; use strict; use warnings; no warnings 'once'; $Cpanel::StringFunc::Trim::VERSION = '1.02'; my %ws_chars = ( "\r" => undef, "\n" => undef, " " => undef, "\t" => undef, "\f" => undef ); sub trim { my ( $str, $totrim ) = @_; $str = rtrim( ltrim( $str, $totrim ), $totrim ); return $str; } sub ltrim { my ( $str, $totrim ) = @_; $str =~ s/^$totrim*//; return $str; } sub rtrim { my ( $str, $totrim ) = @_; $str =~ s/$totrim*$//; return $str; } sub endtrim { my ( $str, $totrim ) = @_; if ( substr( $str, ( length($totrim) * -1 ), length($totrim) ) eq $totrim ) { return substr( $str, 0, ( length($str) - length($totrim) ) ); } return $str; } sub begintrim { my ( $str, $totrim ) = @_; if ( defined $str && defined $totrim # . && substr( $str, 0, length($totrim) ) eq $totrim ) { return substr( $str, length($totrim) ); } return $str; } sub ws_trim { my ($this) = @_; return unless defined $this; my $fix = ref $this eq 'SCALAR' ? $this : \$this; return unless defined $$fix; if ( $$fix =~ tr{\r\n \t\f}{} ) { ${$fix} =~ s/^\s+// if exists $ws_chars{ substr( $$fix, 0, 1 ) }; ${$fix} =~ s/\s+$// if exists $ws_chars{ substr( $$fix, -1, 1 ) }; } return ${$fix}; } sub ws_trim_array { my $ar = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; # [@_] :: copy @_ w/ out unpack first: !! not \@_ in this case !! foreach my $idx ( 0 .. scalar( @{$ar} ) - 1 ) { $ar->[$idx] = ws_trim( $ar->[$idx] ); } return wantarray ? @{$ar} : $ar; } sub ws_trim_hash_values { my $hr = ref $_[0] eq 'HASH' ? $_[0] : {@_}; # {@_} :: copy @_ w/ out unpack first: foreach my $key ( keys %{$hr} ) { $hr->{$key} = ws_trim( $hr->{$key} ); } return wantarray ? %{$hr} : $hr; } 1; } # --- END Cpanel/StringFunc/Trim.pm { # --- BEGIN Cpanel/Path/Normalize.pm package Cpanel::Path::Normalize; use strict; use warnings; no warnings 'once'; sub normalize { my $uncleanpath = shift || return; my $is_abspath = ( 0 == index( $uncleanpath, '/' ) ); my @pathdirs = split( m[/], $uncleanpath ); my @cleanpathdirs; my $leading_dot_dots = 0; foreach my $dir (@pathdirs) { next if !length $dir; #Remove extraneous "//" and leading "/" next if $dir eq '.'; if ( $dir eq '..' ) { if (@cleanpathdirs) { pop(@cleanpathdirs); } else { $leading_dot_dots++; } } else { push( @cleanpathdirs, $dir ); } } if ($is_abspath) { return ( '/' . join( '/', @cleanpathdirs ) ); } unshift @cleanpathdirs, ('..') x $leading_dot_dots; return join( '/', @cleanpathdirs ); } 1; } # --- END Cpanel/Path/Normalize.pm { # --- BEGIN Cpanel/Config/LoadWwwAcctConf.pm package Cpanel::Config::LoadWwwAcctConf; use strict; use warnings; no warnings 'once'; # use Cpanel::HiRes (); # perlpkg line 211 # use Cpanel::Path::Normalize (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::JSON::FailOK (); # perlpkg line 211 my $SYSTEM_CONF_DIR = '/etc'; my $wwwconf_cache; my $wwwconf_mtime = 0; my $has_serializer; our $wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf"; our $wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow"; sub import { my $this = shift; if ( !exists $INC{'Cpanel/JSON.pm'} ) { Cpanel::JSON::FailOK::LoadJSONModule(); } if ( $INC{'Cpanel/JSON.pm'} ) { $has_serializer = 1; } return Exporter::import( $this, @_ ); } sub loadwwwacctconf { ## no critic qw(Subroutines::ProhibitExcessComplexity) if ( $INC{'Cpanel/JSON.pm'} ) { $has_serializer = 1; } #something else loaded it my $filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconf) )[9]; return if !$filesys_mtime; if ( $filesys_mtime == $wwwconf_mtime && $wwwconf_cache ) { return wantarray ? %{$wwwconf_cache} : $wwwconf_cache; } my $wwwacctconf_cache = "$wwwacctconf.cache"; my $wwwacctconfshadow_cache = "$wwwacctconfshadow.cache"; my $is_root = $> ? 0 : 1; if ($has_serializer) { my $cache_file; my $cache_filesys_mtime; my $have_valid_cache = 1; if ( $is_root && -e $wwwacctconfshadow_cache ) { $cache_filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconfshadow_cache) )[9]; #shadow cache's mtime my $shadow_file_mtime = ( Cpanel::HiRes::stat $wwwacctconfshadow )[9] || 0; if ( $shadow_file_mtime < $cache_filesys_mtime ) { $cache_file = $wwwacctconfshadow_cache; } else { #don't use shadow cache if shadow file is newer $have_valid_cache = undef; } } elsif ( -e $wwwacctconf_cache && !( $is_root && -r $wwwacctconfshadow ) ) { $cache_filesys_mtime = ( Cpanel::HiRes::stat $wwwacctconf_cache )[9]; #regular cache's mtime $cache_file = $wwwacctconf_cache; } else { $have_valid_cache = undef; } my $now = Cpanel::HiRes::time(); if ( $Cpanel::Debug::level >= 5 ) { print STDERR __PACKAGE__ . "::loadwwwacctconf cache_filesys_mtime = $cache_filesys_mtime , filesys_mtime: $filesys_mtime , now : $now\n"; } if ( $have_valid_cache && $cache_filesys_mtime > $filesys_mtime && $cache_filesys_mtime < $now ) { my $wwwconf_ref; if ( open( my $conf_fh, '<', $cache_file ) ) { $wwwconf_ref = Cpanel::JSON::FailOK::LoadFile($conf_fh); close($conf_fh); } if ( $wwwconf_ref && ( scalar keys %{$wwwconf_ref} ) > 0 ) { if ( $Cpanel::Debug::level >= 5 ) { print STDERR __PACKAGE__ . "::loadwwwconf file system cache hit\n"; } $wwwconf_cache = $wwwconf_ref; $wwwconf_mtime = $filesys_mtime; return wantarray ? %{$wwwconf_ref} : $wwwconf_ref; } } } my @configfiles; push @configfiles, $wwwacctconf; if ($is_root) { push @configfiles, $wwwacctconfshadow; } #shadow file must be last as the cache gets written for each file with all the files before it in it my $can_write_cache; if ( $is_root && $has_serializer ) { $can_write_cache = 1; } my %CONF = ( 'ADDR' => undef, 'CONTACTEMAIL' => undef, 'DEFMOD' => undef, 'ETHDEV' => undef, 'HOST' => undef, 'NS' => undef, 'NS2' => undef, ); require Cpanel::Config::LoadConfig; foreach my $configfile (@configfiles) { Cpanel::Config::LoadConfig::loadConfig( $configfile, \%CONF, '\s+', undef, undef, undef, { 'nocache' => 1 } ); foreach ( keys %CONF ) { $CONF{$_} =~ s{\s+$}{} if defined $CONF{$_}; } $CONF{'HOMEMATCH'} =~ s{/+$}{} if defined $CONF{'HOMEMATCH'}; # Remove trailing slashes $CONF{'HOMEDIR'} = Cpanel::Path::Normalize::normalize( $CONF{'HOMEDIR'} ) if defined $CONF{'HOMEDIR'}; if ($can_write_cache) { my $cache_file = $configfile . '.cache'; require Cpanel::FileUtils::Write::JSON::Lazy; Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, \%CONF, ( $configfile eq $wwwacctconfshadow ) ? 0600 : 0644 ); } } $wwwconf_mtime = $filesys_mtime; $wwwconf_cache = \%CONF; return wantarray ? %CONF : \%CONF; } sub reset_mem_cache { ( $wwwconf_mtime, $wwwconf_cache ) = ( 0, undef ); } sub reset_has_serializer { $has_serializer = 0; } sub default_conf_dir { $SYSTEM_CONF_DIR = shift if @_; $wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf"; $wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow"; return $SYSTEM_CONF_DIR; } sub reset_caches { my @cache_files = map { "$_.cache" } ( $wwwacctconf, $wwwacctconfshadow ); for my $cache_file (@cache_files) { unlink $cache_file if -e $cache_file; } reset_mem_cache(); return; } 1; } # --- END Cpanel/Config/LoadWwwAcctConf.pm { # --- BEGIN Cpanel/Conf.pm package Cpanel::Conf; # use Cpanel::Config::Constants (); # perlpkg line 211 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; no warnings 'once'; use Try::Tiny; # use Cpanel::DB::Utils (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 # use Cpanel::AdminBin::Serializer::FailOK (); # perlpkg line 211 # use Cpanel::Config::Constants (); # perlpkg line 211 # use Cpanel::Config::CpUser::Defaults (); # perlpkg line 211 # use Cpanel::Config::CpUser::Object (); # perlpkg line 211 # use Cpanel::ConfigFiles (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 # use Cpanel::SV (); # perlpkg line 211 # use Cpanel::StringFunc::Trim (); # perlpkg line 211 our $VERSION = '0.83'; # 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 Cpanel::StringFunc::Trim::ws_trim($value); } elsif ( index( $key, 'DNS' ) == 0 && substr( $key, 3, 1 ) =~ tr{0-9}{} ) { $DOMAIN_MAP{ lc Cpanel::StringFunc::Trim::ws_trim($value) } = undef; } elsif ( index( $key, 'XDNS' ) == 0 && substr( $key, 4, 1 ) =~ tr{0-9}{} ) { $DEAD_DOMAIN_MAP{ lc Cpanel::StringFunc::Trim::ws_trim($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; no warnings 'once'; # use Cpanel::ConfigFiles (); # perlpkg line 211 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 (); # perlpkg line 211 # use Cpanel::Socket::UNIX::Micro (); # perlpkg line 211 our $CACHE_TTL = 600; my $last_check_time = 0; my $nscd_is_running_cache; sub nscd_is_running { my $now = time(); if ( $last_check_time && $last_check_time + $CACHE_TTL > $now ) { return $nscd_is_running_cache; } $last_check_time = $now; my $socket; if ( Cpanel::Socket::UNIX::Micro::connect( $socket, $Cpanel::NSCD::Constants::NSCD_SOCKET ) ) { return ( $nscd_is_running_cache = 1 ); } return ( $nscd_is_running_cache = 0 ); } 1; } # --- END Cpanel/NSCD/Check.pm { # --- BEGIN Cpanel/PwCache/Helpers.pm package Cpanel::PwCache::Helpers; use strict; use warnings; no warnings 'once'; my $skip_uid_cache = 0; sub no_uid_cache { $skip_uid_cache = 1; return } sub uid_cache { $skip_uid_cache = 0; return } sub skip_uid_cache { return $skip_uid_cache; } sub init { my ( $totie, $skip_uid_cache_value ) = @_; tiedto($totie); $skip_uid_cache = $skip_uid_cache_value; return; } { # debugging helpers sub confess { require Carp; return Carp::confess(@_) } sub cluck { require Carp; return Carp::cluck(@_) } } { # tie logic and cache my $pwcacheistied = 0; my $pwcachetie; sub istied { return $pwcacheistied } sub deinit { $pwcacheistied = 0; return; } sub tiedto { my $v = shift; if ( !defined $v ) { # get return $pwcacheistied ? $pwcachetie : undef; } else { # set $pwcacheistied = 1; $pwcachetie = $v; } return; } } { my $SYSTEM_CONF_DIR = '/etc'; my $PRODUCT_CONF_DIR = '/var/cpanel'; sub default_conf_dir { return $SYSTEM_CONF_DIR } sub default_product_dir { return $PRODUCT_CONF_DIR; } } 1; } # --- END Cpanel/PwCache/Helpers.pm { # --- BEGIN Cpanel/PwCache/Cache.pm package Cpanel::PwCache::Cache; use strict; use warnings; no warnings 'once'; my %_cache; my %_homedir_cache; use constant get_cache => \%_cache; use constant get_homedir_cache => \%_homedir_cache; our $pwcache_inited = 0; my $PWCACHE_IS_SAFE = 1; sub clear { # clear all %_cache = (); %_homedir_cache = (); $pwcache_inited = 0; return; } sub remove_key { my ($pwkey) = @_; return delete $_cache{$pwkey}; } sub replace { my $h = shift; %_cache = %$h if ref $h eq 'HASH'; return; } sub is_safe { $PWCACHE_IS_SAFE = $_[0] if defined $_[0]; return $PWCACHE_IS_SAFE; } sub pwmksafecache { return if $PWCACHE_IS_SAFE; $_cache{$_}{'contents'}->[1] = 'x' for keys %_cache; $PWCACHE_IS_SAFE = 1; return; } 1; } # --- END Cpanel/PwCache/Cache.pm { # --- BEGIN Cpanel/PwCache/Find.pm package Cpanel::PwCache::Find; use strict; # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 our $PW_CHUNK_SIZE = 1 << 17; sub field_with_value_in_pw_file { my ( $passwd_fh, $field, $value, $lc_flag ) = @_; return if ( $value =~ tr{\x{00}-\x{1f}\x{7f}:}{} ); my $needle = $field == 0 ? "\n${value}:" : ":${value}"; my $haystack; my $match_pos = 0; my $line_start; my $line_end; my $not_eof; my $data = "\n"; while ( ( $not_eof = Cpanel::LoadFile::ReadFast::read_fast( $passwd_fh, $data, $PW_CHUNK_SIZE, length $data ) ) || length($data) > 1 ) { $haystack = $not_eof ? substr( $data, 0, rindex( $data, "\n" ), '' ) : $data; if ( $lc_flag && $lc_flag == 1 ) { $haystack = lc $haystack; $needle = lc $needle; } while ( -1 < ( $match_pos = index( $haystack, $needle, $match_pos ) ) ) { $line_start = ( !$field ? $match_pos : rindex( $haystack, "\n", $match_pos ) ) + 1; if ( !$field || ( $field == ( substr( $haystack, $line_start, $match_pos - $line_start + 1 ) =~ tr{:}{} ) && ( length($haystack) == $match_pos + length($needle) || substr( $haystack, $match_pos + length($needle), 1 ) =~ tr{:\n}{} ) ) ) { $line_end = index( $haystack, "\n", $match_pos + length($needle) ); my $line = substr( $haystack, $line_start, ( $line_end > -1 ? $line_end : length($haystack) ) - $line_start ); return split( ':', $line ); } $match_pos += length($needle); } last unless $not_eof; } return; } 1; } # --- END Cpanel/PwCache/Find.pm { # --- BEGIN Cpanel/PwCache/Build.pm package Cpanel::PwCache::Build; use strict; use warnings; no warnings 'once'; # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::JSON::FailOK (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 # use Cpanel::PwCache::Helpers (); # perlpkg line 211 # use Cpanel::PwCache::Cache (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 my ( $MIN_FIELDS_FOR_VALID_ENTRY, $pwcache_has_uid_cache ) = ( 0, 6 ); sub pwmksafecache { return if Cpanel::PwCache::Cache::is_safe(); my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); $pwcache_ref->{$_}{'contents'}->[1] = 'x' for keys %{$pwcache_ref}; Cpanel::PwCache::Cache::is_safe(1); return; } sub pwclearcache { # also known as clear_this_process_cache $pwcache_has_uid_cache = undef; Cpanel::PwCache::Cache::clear(); return; } sub init_pwcache { Cpanel::PwCache::Cache::is_safe(0); return _build_pwcache(); } sub init_passwdless_pwcache { return _build_pwcache( 'nopasswd' => 1 ); } sub fetch_pwcache { init_passwdless_pwcache() unless pwcache_is_initted(); my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); if ( scalar keys %$pwcache_ref < 3 ) { die "The password cache unexpectedly had less than 3 entries"; } return [ map { $pwcache_ref->{$_}->{'contents'} } grep { substr( $_, 0, 1 ) eq '0' } keys %{$pwcache_ref} ]; } sub _write_json_cache { my ($cache_file) = @_; if ( !Cpanel::PwCache::Helpers::istied() && exists $INC{'Cpanel/JSON.pm'} ) { my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); if ( !ref $pwcache_ref || scalar keys %$pwcache_ref < 3 ) { die "The system failed build the password cache"; } Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, $pwcache_ref, 0600 ); } return; } sub _write_tied_cache { my ( $crypted_passwd_ref, $passwdmtime, $hpasswdmtime ) = @_; my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir(); local $!; if ( open( my $pwcache_passwd_fh, '<:stdio', "$SYSTEM_CONF_DIR/passwd" ) ) { local $/; my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); my $data = ''; Cpanel::LoadFile::ReadFast::read_all_fast( $pwcache_passwd_fh, $data ); die "The file “$SYSTEM_CONF_DIR/passwd” was unexpectedly empty" if !length $data; my @fields; my $skip_uid_cache = Cpanel::PwCache::Helpers::skip_uid_cache(); foreach my $line ( split( /\n/, $data ) ) { next unless length $line; @fields = split( /:/, $line ); next if scalar @fields < $MIN_FIELDS_FOR_VALID_ENTRY || $fields[0] =~ tr/[A-Z][a-z][0-9]._-//c; $pwcache_ref->{ '0:' . $fields[0] } = { 'cachetime' => $passwdmtime, 'hcachetime' => $hpasswdmtime, 'contents' => [ $fields[0], $crypted_passwd_ref->{ $fields[0] } || $fields[1], $fields[2], $fields[3], '', '', $fields[4], $fields[5], $fields[6], -1, -1, $passwdmtime, $hpasswdmtime ] }; next if $skip_uid_cache || !defined $fields[2] || exists $pwcache_ref->{ '2:' . $fields[2] }; $pwcache_ref->{ '2:' . $fields[2] } = $pwcache_ref->{ '0:' . $fields[0] }; } close($pwcache_passwd_fh); } else { die "The system failed to read $SYSTEM_CONF_DIR/passwd because of an error: $!"; } return; } sub _cache_ref_is_valid { my ( $cache_ref, $passwdmtime, $hpasswdmtime ) = @_; my @keys = qw/0:root 0:cpanel 0:bin/; return $cache_ref && ( scalar keys %{$cache_ref} ) > 2 && scalar @keys == grep { # $cache_ref->{$_}->{'hcachetime'} && $cache_ref->{$_}->{'hcachetime'} == $hpasswdmtime && $cache_ref->{$_}->{'cachetime'} && $cache_ref->{$_}->{'cachetime'} == $passwdmtime } @keys; } sub _build_pwcache { my %OPTS = @_; if ( $INC{'B/C.pm'} ) { Cpanel::PwCache::Helpers::confess("Cpanel::PwCache::Build::_build_pwcache cannot be run under B::C (see case 162857)"); } my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir(); my ( $cache_file, $passwdmtime, $cache_file_mtime, $crypted_passwd_ref, $crypted_passwd_file, $hpasswdmtime ) = ( "$SYSTEM_CONF_DIR/passwd.cache", ( stat("$SYSTEM_CONF_DIR/passwd") )[9] ); if ( $OPTS{'nopasswd'} ) { $hpasswdmtime = ( stat("$SYSTEM_CONF_DIR/shadow") )[9]; $cache_file = "$SYSTEM_CONF_DIR/passwd" . ( Cpanel::PwCache::Helpers::skip_uid_cache() ? '.nouids' : '' ) . '.cache'; } elsif ( -r "$SYSTEM_CONF_DIR/shadow" ) { Cpanel::PwCache::Cache::is_safe(0); $hpasswdmtime = ( stat(_) )[9]; $crypted_passwd_file = "$SYSTEM_CONF_DIR/shadow"; $cache_file = "$SYSTEM_CONF_DIR/shadow" . ( Cpanel::PwCache::Helpers::skip_uid_cache() ? '.nouids' : '' ) . '.cache'; } else { $hpasswdmtime = 0; } if ( !Cpanel::PwCache::Helpers::istied() && exists $INC{'Cpanel/JSON.pm'} ) { if ( open( my $cache_fh, '<:stdio', $cache_file ) ) { my $cache_file_mtime = ( stat($cache_fh) )[9] || 0; if ( $cache_file_mtime > $hpasswdmtime && $cache_file_mtime > $passwdmtime ) { my $cache_ref = Cpanel::JSON::FailOK::LoadFile($cache_fh); Cpanel::Debug::log_debug("[read pwcache from $cache_file]") if ( $Cpanel::Debug::level > 3 ); if ( _cache_ref_is_valid( $cache_ref, $passwdmtime, $hpasswdmtime ) ) { Cpanel::Debug::log_debug("[validated pwcache from $cache_file]") if ( $Cpanel::Debug::level > 3 ); my $memory_pwcache_ref = Cpanel::PwCache::Cache::get_cache(); @{$cache_ref}{ keys %$memory_pwcache_ref } = values %$memory_pwcache_ref; Cpanel::PwCache::Cache::replace($cache_ref); $Cpanel::PwCache::Cache::pwcache_inited = ( $OPTS{'nopasswd'} ? 1 : 2 ); return; } } } } if ($crypted_passwd_file) { $crypted_passwd_ref = _load_pws($crypted_passwd_file); } $Cpanel::PwCache::Cache::pwcache_inited = ( $OPTS{'nopasswd'} ? 1 : 2 ); $pwcache_has_uid_cache = ( Cpanel::PwCache::Helpers::skip_uid_cache() ? 0 : 1 ); _write_tied_cache( $crypted_passwd_ref, $passwdmtime, $hpasswdmtime ); _write_json_cache($cache_file) if $> == 0; return 1; } sub pwcache_is_initted { return ( $Cpanel::PwCache::Cache::pwcache_inited ? $Cpanel::PwCache::Cache::pwcache_inited : 0 ); } sub _load_pws { my $lookup_file = shift; if ( $INC{'B/C.pm'} ) { Cpanel::PwCache::Helpers::confess("Cpanel::PwCache::Build::_load_pws cannot be run under B::C (see case 162857)"); } my %PW; if ( open my $lookup_fh, '<:stdio', $lookup_file ) { my $data = ''; Cpanel::LoadFile::ReadFast::read_all_fast( $lookup_fh, $data ); die "The file “$lookup_file” was unexpectedly empty" if !length $data; %PW = map { ( split(/:/) )[ 0, 1 ] } split( /\n/, $data ); if ( index( $data, '#' ) > -1 ) { delete @PW{ '', grep { index( $_, '#' ) == 0 } keys %PW }; } else { delete $PW{''}; } close $lookup_fh; } return \%PW; } 1; } # --- END Cpanel/PwCache/Build.pm { # --- BEGIN Cpanel/PwCache.pm package Cpanel::PwCache; use strict; # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::NSCD::Check (); # perlpkg line 211 # use Cpanel::PwCache::Helpers (); # perlpkg line 211 # use Cpanel::PwCache::Cache (); # perlpkg line 211 # use Cpanel::PwCache::Find (); # perlpkg line 211 use constant DUMMY_PW_RETURNS => ( -1, -1, 0, 0 ); use constant DEBUG => 0; # Must set $ENV{'CPANEL_DEBUG_LEVEL'} = 5 as well our $VERSION = '4.2'; my %FIXED_KEYS = ( '0:root' => 1, '0:nobody' => 1, '0:cpanel' => 1, '0:cpanellogin' => 1, '0:mail' => 1, '2:0' => 1, '2:99' => 1 ); our $_WANT_ENCRYPTED_PASSWORD; sub getpwnam_noshadow { $_WANT_ENCRYPTED_PASSWORD = 0; goto &_getpwnam; } sub getpwuid_noshadow { $_WANT_ENCRYPTED_PASSWORD = 0; goto &_getpwuid; } sub getpwnam { $_WANT_ENCRYPTED_PASSWORD = !!wantarray; goto &_getpwnam; } sub getpwuid { $_WANT_ENCRYPTED_PASSWORD = !!wantarray; goto &_getpwuid; } sub gethomedir { my $uid_or_name = $_[0] // $>; my $hd = Cpanel::PwCache::Cache::get_homedir_cache(); unless ( exists $hd->{$uid_or_name} ) { $_WANT_ENCRYPTED_PASSWORD = 0; if ( $uid_or_name !~ tr{0-9}{}c ) { $hd->{$uid_or_name} = ( _getpwuid($uid_or_name) )[7]; } else { $hd->{$uid_or_name} = ( _getpwnam($uid_or_name) )[7]; } } return $hd->{$uid_or_name}; } sub getusername { my $uid = defined $_[0] ? $_[0] : $>; $_WANT_ENCRYPTED_PASSWORD = 0; return scalar _getpwuid($uid); } sub init_passwdless_pwcache { require Cpanel::PwCache::Build; *init_passwdless_pwcache = \&Cpanel::PwCache::Build::init_passwdless_pwcache; goto &Cpanel::PwCache::Build::init_passwdless_pwcache; } sub _getpwuid { ## no critic qw(Subroutines::RequireArgUnpacking) return unless ( length( $_[0] ) && $_[0] !~ tr/0-9//c ); my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); if ( !exists $pwcache_ref->{"2:$_[0]"} && $> != 0 && !Cpanel::PwCache::Helpers::istied() && Cpanel::NSCD::Check::nscd_is_running() ) { return CORE::getpwuid( $_[0] ) if !wantarray; my @ret = CORE::getpwuid( $_[0] ); return @ret ? ( @ret, DUMMY_PW_RETURNS() ) : (); } if ( my $pwref = _pwfunc( $_[0], 2 ) ) { return wantarray ? @$pwref : $pwref->[0]; } return; #important not to return 0 } sub _getpwnam { ## no critic qw(Subroutines::RequireArgUnpacking) return unless ( length( $_[0] ) && $_[0] !~ tr{\x{00}-\x{20}\x{7f}:/#}{} ); my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); if ( !exists $pwcache_ref->{"0:$_[0]"} && $> != 0 && !Cpanel::PwCache::Helpers::istied() && Cpanel::NSCD::Check::nscd_is_running() ) { return CORE::getpwnam( $_[0] ) if !wantarray; my @ret = CORE::getpwnam( $_[0] ); return @ret ? ( @ret, DUMMY_PW_RETURNS() ) : (); } if ( my $pwref = _pwfunc( $_[0], 0 ) ) { return wantarray ? @$pwref : $pwref->[2]; } return; #important not to return 0 } sub _pwfunc { ## no critic qw(Subroutines::RequireArgUnpacking) my ( $value, $field, $pwkey ) = ( $_[0], ( $_[1] || 0 ), $_[1] . ':' . ( $_[0] || 0 ) ); if ( Cpanel::PwCache::Helpers::istied() ) { Cpanel::Debug::log_debug("cache tie (tied) value[$value] field[$field]") if (DEBUG); my $pwcachetie = Cpanel::PwCache::Helpers::tiedto(); if ( ref $pwcachetie eq 'HASH' ) { my $cache = $pwcachetie->{$pwkey}; if ( ref $cache eq 'HASH' ) { return $pwcachetie->{$pwkey}->{'contents'}; } } return undef; } my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir(); my $lookup_encrypted_pass = 0; if ($_WANT_ENCRYPTED_PASSWORD) { $lookup_encrypted_pass = $> == 0 ? 1 : 0; } my ( $passwdmtime, $hpasswdmtime ); my $pwcache_ref = Cpanel::PwCache::Cache::get_cache(); if ( my $cache_entry = $pwcache_ref->{$pwkey} ) { Cpanel::Debug::log_debug("exists in cache value[$value] field[$field]") if (DEBUG); if ( ( exists( $cache_entry->{'contents'} ) && $cache_entry->{'contents'}->[1] ne 'x' ) # Has shadow entry || !$lookup_encrypted_pass # Or we do not need it ) { # If we are root and missing the password field we could fail authentication if ( $FIXED_KEYS{$pwkey} ) { # We assume root, nobody, and cpanellogin will never change during execution Cpanel::Debug::log_debug("cache (never change) hit value[$value] field[$field]") if (DEBUG); return $cache_entry->{'contents'}; } $passwdmtime = ( stat("$SYSTEM_CONF_DIR/passwd") )[9]; $hpasswdmtime = $lookup_encrypted_pass ? ( stat("$SYSTEM_CONF_DIR/shadow") )[9] : 0; if ( ( $lookup_encrypted_pass && $hpasswdmtime && $hpasswdmtime != $cache_entry->{'hcachetime'} ) || ( $passwdmtime && $passwdmtime != $cache_entry->{'cachetime'} ) ) { #timewarp safe DEBUG && Cpanel::Debug::log_debug( "cache miss value[$value] field[$field] pwkey[$pwkey] " . qq{hpasswdmtime: $hpasswdmtime != $cache_entry->{hcachetime} } . qq{passwdmtime: $passwdmtime != $cache_entry->{cachetime} } ); if ( defined $cache_entry && defined $cache_entry->{'contents'} ) { Cpanel::PwCache::Cache::clear(); #If the passwd file mtime changes everything is invalid } } else { Cpanel::Debug::log_debug("cache hit value[$value] field[$field]") if (DEBUG); return $cache_entry->{'contents'}; } } elsif (DEBUG) { Cpanel::Debug::log_debug( "cache miss pwkey[$pwkey] value[$value] field[$field] passwdmtime[$passwdmtime] pwcacheistied[" . Cpanel::PwCache::Helpers::istied() . "] hpasswdmtime[$hpasswdmtime]" ); } } elsif (DEBUG) { Cpanel::Debug::log_debug( "cache miss (no entry) pwkey[$pwkey] value[$value] field[$field] pwcacheistied[" . Cpanel::PwCache::Helpers::istied() . "]" ); } my $pwdata = _getpwdata( $value, $field, $passwdmtime, $hpasswdmtime, $lookup_encrypted_pass ); _cache_pwdata( $pwdata, $pwcache_ref ) if $pwdata && @$pwdata; return $pwdata; } sub _getpwdata { my ( $value, $field, $passwdmtime, $shadowmtime, $lookup_encrypted_pass ) = @_; return if ( !defined $value || !defined $field || $value =~ tr/\0// ); if ($lookup_encrypted_pass) { return [ _readshadow( $value, $field, $passwdmtime, $shadowmtime ) ]; } return [ _readpasswd( $value, $field, $passwdmtime, $shadowmtime ) ]; } sub _readshadow { ## no critic qw(Subroutines::RequireArgUnpacking) my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir(); my ( $value, $field, $passwdmtime, $shadowmtime ) = ( $_[0], ( $_[1] || 0 ), ( $_[2] || ( stat("$SYSTEM_CONF_DIR/passwd") )[9] ), ( $_[3] || ( stat("$SYSTEM_CONF_DIR/shadow") )[9] ) ); my @PW = _readpasswd( $value, $field, $passwdmtime, $shadowmtime ); return if !@PW; $value = $PW[0]; if ( open my $shadow_fh, '<', "$SYSTEM_CONF_DIR/shadow" ) { if ( my @SH = Cpanel::PwCache::Find::field_with_value_in_pw_file( $shadow_fh, 0, $value ) ) { ( $PW[1], $PW[9], $PW[10], $PW[11], $PW[12] ) = ( $SH[1], #encrypted pass $SH[5], #expire time $SH[2], #change time $passwdmtime, $shadowmtime ); close $shadow_fh; Cpanel::PwCache::Cache::is_safe(0); return @PW; } } else { Cpanel::PwCache::Helpers::cluck("Unable to open $SYSTEM_CONF_DIR/shadow: $!"); } Cpanel::PwCache::Helpers::cluck("Entry for $value missing in $SYSTEM_CONF_DIR/shadow"); return @PW; } sub _readpasswd { ## no critic qw(Subroutines::RequireArgUnpacking) my $SYSTEM_CONF_DIR = Cpanel::PwCache::Helpers::default_conf_dir(); my ( $value, $field, $passwdmtime, $shadowmtime, $block ) = ( $_[0], ( $_[1] || 0 ), ( $_[2] || ( stat("$SYSTEM_CONF_DIR/passwd") )[9] ), $_[3] ); if ( $INC{'B/C.pm'} ) { die("Cpanel::PwCache::_readpasswd cannot be run under B::C (see case 162857)"); } if ( open( my $passwd_fh, '<', "$SYSTEM_CONF_DIR/passwd" ) ) { if ( my @PW = Cpanel::PwCache::Find::field_with_value_in_pw_file( $passwd_fh, $field, $value ) ) { return ( $PW[0], $PW[1], $PW[2], $PW[3], '', '', $PW[4], $PW[5], $PW[6], -1, -1, $passwdmtime, ( $shadowmtime || $passwdmtime ) ); } close($passwd_fh); } else { Cpanel::PwCache::Helpers::cluck("open($SYSTEM_CONF_DIR/passwd): $!"); } return; } sub _cache_pwdata { my ( $pwdata, $pwcache_ref ) = @_; $pwcache_ref ||= Cpanel::PwCache::Cache::get_cache(); if ( $pwdata->[2] != 0 || $pwdata->[0] eq 'root' ) { # special case for multiple uid 0 users @{ $pwcache_ref->{ '2' . ':' . $pwdata->[2] } }{ 'cachetime', 'hcachetime', 'contents' } = ( $pwdata->[11], $pwdata->[12], $pwdata ); } @{ $pwcache_ref->{ '0' . ':' . $pwdata->[0] } }{ 'cachetime', 'hcachetime', 'contents' } = ( $pwdata->[11], $pwdata->[12], $pwdata ); return 1; } 1; } # --- END Cpanel/PwCache.pm { # --- BEGIN Cpanel/Locale/Utils/User.pm package Cpanel::Locale::Utils::User; use strict; # use Cpanel::Config::LoadCpUserFile (); # perlpkg line 211 # use Cpanel::Config::HasCpUserFile (); # perlpkg line 211 # use Cpanel::PwCache (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 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) // -1 ) ) ) { $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 ( $ENV{'TEAM_USER'} ) { my $team_user_locale = get_team_user_locale(); return ( $userlocale->{$user} = $team_user_locale ) if $team_user_locale; } 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}; } sub get_team_user_locale { Cpanel::LoadModule::load_perl_module('Cpanel::Team::Config'); my $locale = Cpanel::Team::Config->new( $ENV{'TEAM_OWNER'} )->load()->{users}->{ $ENV{'TEAM_USER'} }->{locale}; return $locale; } 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; no warnings 'once'; sub read_dir { my ( $dir, $coderef ) = @_; my @contents; if ( opendir my $dir_dh, $dir ) { @contents = grep { defined && $_ 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; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::ArrayFunc::Uniq (); # perlpkg line 211 sub get_charmap_list ( $root_says_to_make_symlinks = 0, $no_aliases = 0 ) { 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; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::Locale::Utils::Normalize (); # perlpkg line 211 # use Cpanel::Locale::Utils::Paths (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Config::LoadCpUserFile (); # perlpkg line 211 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/FileUtils/TouchFile.pm package Cpanel::FileUtils::TouchFile; use strict; use warnings; no warnings 'once'; use constant { _ENOENT => 2, }; my $logger; our $VERSION = '1.3'; sub _log { my ( $level, $msg ) = @_; require Cpanel::Logger; $logger ||= Cpanel::Logger->new(); $logger->$level($msg); return; } my $mtime; sub touchfile { my ( $file, $verbose, $fail_ok ) = @_; if ( !defined $file ) { _log( 'warn', "touchfile called with undefined file" ); return; } my $mtime; if ( utime undef, undef, $file ) { return 1; } elsif ( $! != _ENOENT() ) { _log( 'warn', "utime($file) as $>: $!" ); $mtime = -e $file ? ( stat _ )[9] : 0; # for warnings-safe numeric comparison if ( !$mtime && $! != _ENOENT ) { _log( 'warn', "Failed to stat($file) as $>: $!" ); return; } } $mtime = ( stat $file )[9] // 0; if ( open my $fh, '>>', $file ) { # append so we don't wipe out contents my $mtime_after_open = ( stat $fh )[9] || 0; # for warnings safe numeric comparison return 1 if $mtime != $mtime_after_open; # in case open does not change it, see comment below } else { _log( 'warn', "Failed to open(>> $file) as $>: $!" ) unless $fail_ok; } if ($fail_ok) { return; } my $at_this_point = ( stat $file )[9] || 0; # for warnings safe numeric comparison if ( $mtime == $at_this_point ) { my $new_at_this_point = ( stat $file )[9] || 0; # for warnings safe numeric comparison if ( $mtime == $new_at_this_point ) { if ($verbose) { _log( 'info', 'Trying to do system “touch” command!' ); } if ( system( 'touch', $file ) != 0 ) { if ($verbose) { _log( 'info', 'system method 1 failed.' ); } } } } if ( !-e $file ) { # obvisouly it didn't touch it if it doesn't exist... _log( 'warn', "Failed to create $file: $!" ); return; } else { my $after_all_that = ( stat $file )[9] || 0; # for warnings safe numeric comparison if ( $mtime && $mtime == $after_all_that ) { _log( 'warn', "mtime of “$file” not changed!" ); return; } return 1; } } 1; } # --- END Cpanel/FileUtils/TouchFile.pm { # --- BEGIN Cpanel/PwUtils.pm package Cpanel::PwUtils; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::PwCache (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::ArrayFunc::Uniq (); # perlpkg line 211 # use Cpanel::PwCache (); # perlpkg line 211 # use Cpanel::PwUtils (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 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; } 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] // die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] ) ); 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; no warnings 'once'; # use Cpanel::ArrayFunc::Uniq (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::AccessIds::Utils (); # perlpkg line 211 # use Cpanel::AccessIds::Normalize (); # perlpkg line 211 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 = bless { 'uid' => $>, 'gid' => $), 'new_uid' => $uid, 'new_gid' => join( q< >, @gids ), 'perl5lib' => $ENV{PERL5LIB}, 'had_perl5lib' => exists $ENV{PERL5LIB}, 'inc' => [@INC], # copy not ref }, $class; _reduce_privileges( $uid, @gids ); $PRIVS_REDUCED = 1; $ENV{PERL5LIB} = ""; local $Test::MockFile::STRICT_MODE_STATUS = Test::MockFile::STRICT_MODE_DISABLED() if $INC{"Test/MockFile.pm"}; @INC = grep { $_ eq "/usr/local/cpanel" || -r $_ } @INC; ## no critic qw(Variables::RequireLocalizedPunctuationVars) return $self; } sub DESTROY { my ($self) = @_; local ( $., $@, $!, $^E, $? ); my $check_err; eval { _allowed_to_restore_privileges( $self->{'new_uid'}, $self->{'new_gid'} ); 1 } or $check_err = $@; my $restore_err; eval { _restore_privileges( $self->{'uid'}, $self->{'gid'} ); 1 } or $restore_err = $@; my $env_err; eval { if ( $self->{'had_perl5lib'} ) { $ENV{PERL5LIB} = $self->{'perl5lib'} } else { delete $ENV{PERL5LIB} } @INC = @{ $self->{'inc'} } if $self->{'inc'}; ## no critic qw(Variables::RequireLocalizedPunctuationVars) 1; } or $env_err = $@; eval { Cpanel::Debug::log_warn( __PACKAGE__ . "::DESTROY: restore-state check failed: $check_err" ) if $check_err; Cpanel::Debug::log_warn( __PACKAGE__ . "::DESTROY: failed to restore privileges: $restore_err" ) if $restore_err; Cpanel::Debug::log_warn( __PACKAGE__ . "::DESTROY: failed to restore the include path: $env_err" ) if $env_err; 1; }; return 1; } 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 $want = wantarray; ## no critic qw(Community::Wantarray) my ( $saved_uid, $saved_gid ) = ( $>, $) ); my ( $scalar, @list ); my $ex; if ( !eval { _reduce_privileges( $uid, $gid, @supplemental_gids ); local $PRIVS_REDUCED = 1; local $ENV{PERL5LIB} = ""; local $Test::MockFile::STRICT_MODE_STATUS = Test::MockFile::STRICT_MODE_DISABLED() if $INC{"Test/MockFile.pm"}; local @INC = grep { $_ eq "/usr/local/cpanel" || -r $_ } @INC; if ($want) { @list = eval { $code->(); }; } elsif ( defined $want ) { $scalar = eval { $code->(); }; } else { #void context eval { $code->(); }; } $ex = $@; 1; } ) { $ex ||= $@; # the reduction or the environment scrub failed } my $restore_err; eval { _restore_privileges( $saved_uid, $saved_gid ); 1 } or do { $restore_err = $@; $PRIVS_REDUCED = 1; }; if ($ex) { eval { Cpanel::Debug::log_warn( __PACKAGE__ . "::call_as_user: failed to restore privileges: $restore_err" ); 1 } if $restore_err; die $ex; } die $restore_err if $restore_err; return $want ? @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 { !defined $_ } @_ ) { local $Cpanel::Logger::ENABLE_BACKTRACE = 1; Cpanel::Debug::log_die("Someone gave us an undefined value as program $0"); } if ( grep { !$_ } @_ ) { local $Cpanel::Logger::ENABLE_BACKTRACE = 1; Cpanel::Debug::log_die("Attempting to drop privileges to root as program $0"); } 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/YAML.pm package Cpanel::YAML; use strict; use YAML::Syck (); # use Cpanel::YAML::Syck (); # perlpkg line 211 BEGIN { *Load = *YAML::Syck::Load; *SafeDump = \&Dump; *DumpFile = *YAML::Syck::DumpFile; } our $MAX_LOAD_LENGTH = 65535; our $MAX_PRIV_LOAD_LENGTH = 4194304; # four megs sub _is_openhandle { my $h = shift; if ( my $isa = ref($h) ) { return 1 if ( $isa eq 'GLOB' ); return 1 if ( $isa =~ m/^IO::/ ); } return 1 if ( ref( \$h ) eq 'GLOB' ); return; } sub SafeLoadFile { # only allow a small bit of data to be loaded return LoadFile( $_[0], $MAX_LOAD_LENGTH ); } sub LoadFile { my $file = shift; my $max = shift; my $str_r; if ( _is_openhandle($file) ) { if ($max) { my $togo = $max; my $buffer = ''; my $bytes_read; while ( $bytes_read = read( $file, $buffer, $togo, length $buffer ) && length $buffer < $max ) { $togo -= $bytes_read; } $str_r = \$buffer; } else { $str_r = \do { local $/; <$file> }; } } else { if ( !-e $file || -z $file ) { require Carp; Carp::croak("'$file' is non-existent or empty"); } open( my $fh, '<', $file ) or do { require Carp; Carp::croak("Cannot read from $file: $!"); }; $str_r = \do { local $/; <$fh> }; } return YAML::Syck::LoadYAML($$str_r); } sub Dump { my ( $data, @extra ) = @_; $data = _convert_json_boolean( $data, {} ); return YAML::Syck::Dump( $data, @extra ); } sub _convert_json_boolean { my ( $data, $seen ) = @_; return unless defined $data; return $data if $seen->{"$data"}; if ( my $isa = ref($data) ) { if ( index( $isa, 'JSON::' ) == 0 ) { if ( $isa eq 'JSON::PP::Boolean' || $isa eq 'JSON::XS::Boolean' ) { return $data ? 1 : 0; # true / false: prefer 1/0 for roundtrip purpose } } $seen->{"$data"} = 1; if ( $isa eq 'HASH' ) { foreach my $key ( keys %$data ) { $data->{$key} = _convert_json_boolean( $data->{$key}, $seen ); } } elsif ( $isa eq 'ARRAY' ) { foreach my $i ( 0 .. $#$data ) { $data->[$i] = _convert_json_boolean( $data->[$i], $seen ); } } } return $data; } 1; } # --- END Cpanel/YAML.pm { # --- BEGIN Cpanel/DataStore.pm package Cpanel::DataStore; use strict; use warnings; no warnings 'once'; # use Cpanel::Debug (); # perlpkg line 211 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 ) = @_; my $file_is_ref = ref($file); return if ( !$file_is_ref && ( !-e $file || -z _ ) ); require Cpanel::YAML; $YAML::Syck::ImplicitTyping = 0; my $struct; if ($file_is_ref) { local $!; $struct = eval { local $/; local $SIG{__WARN__}; local $SIG{__DIE__}; ( Cpanel::YAML::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__}; ( Cpanel::YAML::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/LoadFile.pm package Cpanel::LoadFile; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 sub loadfileasarrayref { my $fileref = _load_file( shift, { 'array_ref' => 1 } ); return ref $fileref eq 'ARRAY' ? $fileref : undef; } sub loadbinfile { my $fileref = _load_file( shift, { 'binmode' => 1 } ); return ref $fileref eq 'SCALAR' ? $$fileref : undef; } sub slurpfile { my $fh = shift; my $fileref = _load_file(shift); if ( ref $fileref eq 'SCALAR' ) { print {$fh} $$fileref; } return; } sub loadfile { my $fileref = _load_file(@_); return ref $fileref eq 'SCALAR' ? $$fileref : undef; } sub loadfile_r { my ( $file, $arg_ref ) = @_; if ( open my $lf_fh, '<:stdio', $file ) { if ( $arg_ref->{'binmode'} ) { binmode $lf_fh; } my $data; if ( $arg_ref->{'array_ref'} ) { @{$data} = readline $lf_fh; close $lf_fh; return $data; } else { $data = ''; local $@; eval { Cpanel::LoadFile::ReadFast::read_all_fast( $lf_fh, $data ); }; return $@ ? undef : \$data; } } return; } *_load_file = *loadfile_r; sub _open { return _open_if_exists( $_[0] ) || die Cpanel::Exception::create( 'IO::FileNotFound', [ path => $_[0], error => _ENOENT() ] ); } sub _open_if_exists { local $!; open my $fh, '<:stdio', $_[0] or do { if ( $! == _ENOENT() ) { return undef; } die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $_[0], error => $!, mode => '<' ] ); }; return $fh; } sub load_if_exists { my $ref = _load_r( \&_open_if_exists, @_ ); return $ref ? $$ref : undef; } sub load_r_if_exists { return _load_r( \&_open_if_exists, @_ ); } sub load { return ${ _load_r( \&_open, @_ ) }; } sub load_r { return _load_r( \&_open, @_ ); } sub _load_r { my ( $open_coderef, $path, $offset, $length ) = @_; my $fh = $open_coderef->($path) or return undef; local $!; if ($offset) { sysseek( $fh, $offset, $Cpanel::Fcntl::Constants::SEEK_SET ); if ($!) { die Cpanel::Exception::create( 'IO::FileSeekError', [ path => $path, position => $offset, whence => $Cpanel::Fcntl::Constants::SEEK_SET, error => $!, ] ); } } my $data = q<>; if ( !defined $length ) { my $bytes_read = Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, Cpanel::LoadFile::ReadFast::READ_CHUNK ); if ( $bytes_read == Cpanel::LoadFile::ReadFast::READ_CHUNK ) { my $file_size = -f $fh && -s _; if ($file_size) { Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, $file_size, length $data ) // die _read_err($path); } } Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data ); } else { my $togo = $length; my $bytes_read; while ( $bytes_read = Cpanel::LoadFile::ReadFast::read_fast( $fh, $data, $togo, length $data ) && length $data < $length ) { $togo -= $bytes_read; } } if ($!) { die Cpanel::Exception::create( 'IO::FileReadError', [ path => $path, error => $! ] ); } close $fh or warn "The system failed to close the file “$path” because of an error: $!"; return \$data; } sub _ENOENT { return 2; } 1; } # --- END Cpanel/LoadFile.pm { # --- BEGIN Cpanel/Locale/Utils/3rdparty.pm package Cpanel::Locale::Utils::3rdparty; use strict; use warnings; no warnings 'once'; our %cpanel_provided = ( 'de' => 1, 'en' => 1, 'es_es' => 1, 'i_cpanel_snowmen' => 1, 'ru' => 1, 'pt_br' => 1, 'ja' => 1, 'tr' => 1, 'id', => 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/Config/LoadCpConf.pm package Cpanel::Config::LoadCpConf; use strict; use warnings; no warnings 'once'; # use Cpanel::Config::CpConfGuard (); # perlpkg line 211 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/Locale/Utils/Display.pm package Cpanel::Locale::Utils::Display; use warnings; no warnings 'once'; use strict; # use Cpanel::Locale::Utils::Paths (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Locale (); # perlpkg line 211 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/SafeRun/Simple.pm package Cpanel::SafeRun::Simple; use strict; # use Cpanel::FHUtils::Autoflush (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 # use Cpanel::SV (); # perlpkg line 211 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 (); # perlpkg line 211 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/FileUtils/Lines.pm package Cpanel::FileUtils::Lines; use strict; # use Cpanel::Debug (); # perlpkg line 211 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/Timezones.pm package Cpanel::Timezones; use cPstrict; no warnings 'once'; # use Cpanel::OS (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::SafeRun::Errors(); # perlpkg line 211 use Cwd (); use List::Util (); 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 _get_active_timezone { my @tz_data = Cpanel::SafeRun::Errors::saferunallerrors( '/usr/bin/timedatectl', 'show' ); my ( undef, $tz_name ) = split( q{=}, List::Util::first { /^timezone=/i } @tz_data ); return $tz_name; } sub _setup_clock_using_timedatectl ($tz) { 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/(?:Etc/)?}{}; } elsif ( -f $etc_localtime ) { 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; } } } else { $tz = _get_active_timezone(); my $tz_file_path = qq{$timezonedir/$tz}; if ( defined $tz && -e $tz_file_path && $> == 0 ) { symlink( $tz_file_path, $etc_localtime ); Cpanel::Timezones::set($tz); } } $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 (); # perlpkg line 211 # use Cpanel::Locale (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Autodie qw(exists); # perlpkg line 248 INIT { Cpanel::Autodie->import(qw{exists}); } # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 # use Cpanel::ConfigFiles (); # perlpkg line 211 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/Config/LoadUserDomains.pm package Cpanel::Config::LoadUserDomains; use strict; use warnings; no warnings 'once'; # use Cpanel::Config::LoadConfig (); # perlpkg line 211 # use Cpanel::Config::LoadUserDomains::Count (); # perlpkg line 211 # use Cpanel::Server::Type (); # perlpkg line 211 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 (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 # use Cpanel::Config::LoadUserDomains (); # perlpkg line 211 # use Cpanel::Config::LoadCpUserFile (); # perlpkg line 211 # use Cpanel::ConfigFiles (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 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/CpUser/Write.pm package Cpanel::Config::CpUser::Write; use cPstrict; no warnings 'once'; # use Cpanel::Config::CpUser (); # perlpkg line 211 # use Cpanel::Config::FlushConfig (); # perlpkg line 211 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; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::FileUtils::Open (); # perlpkg line 211 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; no warnings 'once'; # use Cpanel::Destruct (); # perlpkg line 211 # use Cpanel::Config::CpUser (); # perlpkg line 211 # use Cpanel::Config::CpUser::Write (); # perlpkg line 211 # use Cpanel::Config::LoadCpUserFile (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 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 data { my ($self) = @_; return $self->{'data'}; } 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; no warnings 'once'; # use Cpanel::PwCache (); # perlpkg line 211 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'); if ( $ENV{'TEAM_USER'} ) { Cpanel::LoadModule::load_perl_module('Cpanel::AdminBin::Call'); return Cpanel::AdminBin::Call::call( 'Cpanel', 'teamconfig', 'SET_LOCALE', $ENV{'TEAM_USER'}, $locale ); } 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/Locale.pm package Cpanel::Locale; use strict; BEGIN { $ENV{'IGNORE_WIN32_LOCALE'} = 1; } # use parent Cpanel::CPAN::Locale::Maketext::Utils (); # perlpkg line 238 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 # perlpkg line 211 # use Cpanel::Locale::Utils::Paths (); # perlpkg line 211 # use Cpanel::CPAN::Locale::Maketext (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 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; } 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; no warnings 'once'; use Socket (); # use Cpanel::Sys::Uname (); # perlpkg line 211 sub get_canonical_hostname { my @uname = Cpanel::Sys::Uname::get_uname_cached(); my ( $err, @results ) = Socket::getaddrinfo( $uname[1], 0, { flags => Socket::AI_CANONNAME() } ); if ( @results && $results[0]->{'canonname'} ) { return $results[0]->{'canonname'}; } return undef; } 1; } # --- END Cpanel/Sys/Hostname/Fallback.pm { # --- BEGIN Cpanel/Sys/Hostname.pm package Cpanel::Sys::Hostname; use strict; use warnings; no warnings 'once'; our $VERSION = 2.0; # use Cpanel::Sys::Uname (); # perlpkg line 211 our $cachedhostname = ''; sub gethostname { my $nocache = shift || 0; if ( !$nocache && length $cachedhostname ) { return $cachedhostname } my $hostname = _gethostname($nocache); if ( length $hostname ) { $hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn) $cachedhostname = $hostname; } return $hostname; } sub _gethostname { my $nocache = shift || 0; my $hostname; Cpanel::Sys::Uname::clearcache() if $nocache; my @uname = Cpanel::Sys::Uname::get_uname_cached(); if ( $uname[1] && index( $uname[1], '.' ) > -1 ) { $hostname = $uname[1]; $hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn) return $hostname; } eval { require Cpanel::Sys::Hostname::Fallback; $hostname = Cpanel::Sys::Hostname::Fallback::get_canonical_hostname(); }; if ($hostname) { $hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn) return $hostname; } require Cpanel::LoadFile; chomp( $hostname = Cpanel::LoadFile::loadfile( '/proc/sys/kernel/hostname', { 'skip_exists_check' => 1 } ) ); if ($hostname) { $hostname =~ tr{A-Z}{a-z}; # hostnames must be lowercase (see Cpanel::Sys::Hostname::Modify::make_hostname_lowercase_fqdn) $hostname =~ tr{\r\n}{}d; # chomp is not enough (not sure if this is required, however we cannot test all kernels so its safer to leave it in) return $hostname; } require Cpanel::Debug; Cpanel::Debug::log_warn('Unable to determine correct hostname'); return; } sub shorthostname { my $hostname = gethostname(); return $hostname if index( $hostname, '.' ) == -1; # Hostname is not a FQDN (this should never happen) return substr( $hostname, 0, index( $hostname, '.' ) ); } 1; } # --- END Cpanel/Sys/Hostname.pm { # --- BEGIN Cpanel/Hostname.pm package Cpanel::Hostname; use strict; use warnings; no warnings 'once'; # use Cpanel::Sys::Hostname (); # perlpkg line 211 our $VERSION = 2.0; { no warnings 'once'; *gethostname = *Cpanel::Sys::Hostname::gethostname; *shorthostname = *Cpanel::Sys::Hostname::shorthostname; } 1; } # --- END Cpanel/Hostname.pm { # --- BEGIN Cpanel/Config/CpConfGuard/CORE.pm package Cpanel::Config::CpConfGuard::CORE; use strict; use warnings; no warnings 'once'; # use Cpanel::ConfigFiles (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 # use Cpanel::Config::CpConfGuard (); # perlpkg line 211 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 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; no warnings 'once'; # use Cpanel::JSON::FailOK (); # perlpkg line 211 # use Cpanel::ConfigFiles (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::Destruct (); # perlpkg line 211 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/Crypt/GPG/Settings.pm package Cpanel::Crypt::GPG::Settings; use strict; # use Cpanel::Config::CpConfGuard (); # perlpkg line 211 # use Cpanel::Config::Sources (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 our $RELEASE_VALUE = 'Release Keyring Only'; our $DEVELOPMENT_VALUE = 'Release and Development Keyrings'; our $OFF_VALUE = 'Off'; our $OLD_DEVELOPMENT_VALUE = 'Release and Test Keyrings'; our $RELEASE_KEYRINGS = ['release']; our $DEVELOPMENT_KEYRINGS = [ 'release', 'development' ]; our $OFF_KEYRINGS = []; our $SIG_VALIDATION_CPCONF_KEY = 'signature_validation'; sub signature_validation_enabled { my $validation_setting = _load_cpconf_setting($SIG_VALIDATION_CPCONF_KEY); return ( $validation_setting eq $OFF_VALUE ) ? 0 : 1; } sub default_key_categories { my $validation_setting = shift || _load_cpconf_setting($SIG_VALIDATION_CPCONF_KEY); if ( $validation_setting eq $OFF_VALUE ) { return $OFF_KEYRINGS; } elsif ( $validation_setting eq $DEVELOPMENT_VALUE ) { return $DEVELOPMENT_KEYRINGS; } elsif ( $validation_setting eq $RELEASE_VALUE ) { return $RELEASE_KEYRINGS; } else { die Cpanel::Exception->create( 'Invalid signature validation setting: [_1]', [$validation_setting] ); } } sub allowed_digest_algorithms { return ('sha512'); } sub _load_cpconf_setting { my $setting = shift; my $conf = Cpanel::Config::CpConfGuard->new( 'loadcpconf' => 1 )->config_copy; if ( $setting eq $SIG_VALIDATION_CPCONF_KEY ) { return validation_setting_fixup( $conf->{$setting} ); } else { return $conf->{$setting}; } } sub validation_setting_fixup { my $current_setting = shift; if ( defined $current_setting && $current_setting eq $OLD_DEVELOPMENT_VALUE ) { return $DEVELOPMENT_VALUE; } elsif ( !defined $current_setting || $current_setting !~ /^(?:\Q$OFF_VALUE\E|\Q$RELEASE_VALUE\E|\Q$DEVELOPMENT_VALUE\E)$/ ) { return validation_setting_for_configured_mirror(); } return $current_setting; } sub validation_setting_for_configured_mirror { my $mirror = Cpanel::Config::Sources::loadcpsources(); if ( $mirror->{'HTTPUPDATE'} =~ /^(?:.*\.dev|qa-build|next)\.cpanel\.net$/ ) { return $DEVELOPMENT_VALUE; } return $RELEASE_VALUE; } 1; } # --- END Cpanel/Crypt/GPG/Settings.pm { # --- BEGIN Cpanel/FileUtils/Copy.pm package Cpanel::FileUtils::Copy; use strict; use warnings; no warnings 'once'; # use Cpanel::Fcntl (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 our $VERSION = '1.0'; my $COPY_CHUNK_SIZE = 131072; #2 ** 17 sub safecopy { ## no critic qw(Subroutines::ProhibitExcessComplexity) my $srcfile = shift; my $destfile = shift; my $normrfcomp = shift || 0; if ( !length $srcfile ) { Cpanel::Debug::log_warn("Source not specified for copy."); return 0; } if ( !length $destfile ) { Cpanel::Debug::log_warn("Destination not specified for copy."); return 0; } if ( !-r $srcfile && $srcfile !~ m/\*$/ ) { Cpanel::Debug::log_warn("Unable to read source for copy"); return 0; } my $is_file = -f $srcfile ? 1 : 0; my $srcfileinfo = q{}; my $unlinkdestsafe = 1; if ($is_file) { # Logic only for src files (not dirs). $srcfileinfo = join( '-', ( stat(_) )[ 0, 1 ] ); $unlinkdestsafe = 9; } my $src_lock; if ($is_file) { local $@; require Cpanel::SafeFile; $src_lock = eval { Cpanel::SafeFile::safelock_skip_dotlock_if_not_root($srcfile) }; } if ( !exists $INC{'File/Copy/Recursive.pm'} ) { Cpanel::LoadModule::lazy_load_module('File::Copy::Recursive'); } if ( !exists $INC{'Cpanel/Umask.pm'} ) { Cpanel::LoadModule::lazy_load_module('Cpanel::Umask'); } my $usefilecopyrecursive = ( exists $INC{'File/Copy/Recursive.pm'} && exists $INC{'Cpanel/Umask.pm'} ) ? 1 : 0; if ( !$usefilecopyrecursive ) { my $val = system( 'cp', '-rf', $srcfile, $destfile ); if ($is_file) { Cpanel::SafeFile::safeunlock($src_lock) } if ($val) { Cpanel::Debug::log_warn("Problem copying $srcfile to $destfile! : system = $val"); return 0; } return 1; } if ( $srcfileinfo ne '' && -f $destfile ) { my $destfileinfo = join( '-', ( stat(_) )[ 0, 1 ] ); if ( $srcfileinfo eq $destfileinfo ) { # files are the same Cpanel::SafeFile::safeunlock($src_lock) if $is_file; Cpanel::Debug::log_info("safecopy for $srcfile -> $destfile skipped. Target exists and has same size and inode number."); return 1; } if ( $unlinkdestsafe == 9 && !unlink($destfile) ) { $unlinkdestsafe = 0; } else { $unlinkdestsafe = 1; } } else { $unlinkdestsafe = 1; } { no warnings; $File::Copy::Recursive::RMTrgFil = $unlinkdestsafe; } if ( !$normrfcomp ) { $File::Copy::Recursive::CPRFComp = 1; } else { $File::Copy::Recursive::CPRFComp = 0; } undef $!; my $umask_obj = Cpanel::Umask->new(077); if ( File::Copy::Recursive::rcopy( $srcfile, $destfile ) ) { if ( $is_file && $src_lock ) { Cpanel::SafeFile::safeunlock($src_lock) } return 1; } else { my $err_msg; my $err_no; if ($!) { $err_no = int $!; $err_msg = "$!"; } else { $err_no = 85; $err_msg = 'Unknown copy failure'; } if ( $is_file && $src_lock ) { Cpanel::SafeFile::safeunlock($src_lock); } Cpanel::Debug::log_warn(qq{rcopy('$srcfile', '$destfile') failed: $err_msg}); $! = $err_no; ## no critic qw(Variables::RequireLocalizedPunctuationVars) return wantarray ? ( 0, $err_msg ) : 0; } } sub copy { my ( $source, $destination ) = @_; local $!; my ( $rfh, $wfh ); my ( $i_opened_the_source, $i_opened_the_destination ); if ( UNIVERSAL::isa( $source, 'GLOB' ) ) { if ( !fileno $source ) { return ( 0, "The source file handle is not open." ); } elsif ( fcntl( $source, $Cpanel::Fcntl::Constants::F_GETFL, 0 ) & 1 ) { return ( 0, "The source file handle is write-only." ); } $rfh = $source; } else { $i_opened_the_source = 1; open( $rfh, '<', $source ) or do { return ( 0, "The system failed to open the file “$source” for reading because of an error: $!" ); }; } my $buffer; read $rfh, $buffer, $COPY_CHUNK_SIZE or do { if ( length $! ) { return ( 0, "The system failed to read from the file “$source” because of an error: $!" ); } }; my $mode = ( stat $source )[2] & 07777; my $write_lock; if ( UNIVERSAL::isa( $destination, 'GLOB' ) ) { if ( !fileno $destination ) { return ( 0, "The destination file handle is not open." ); } elsif ( !( fcntl( $destination, $Cpanel::Fcntl::Constants::F_GETFL, 0 ) & 1 ) ) { return ( 0, "The destination file handle is read-only." ); } $wfh = $destination; } else { $i_opened_the_destination = 1; local $!; local $@; require Cpanel::SafeFile; $write_lock = eval { Cpanel::SafeFile::safesysopen( $wfh, $destination, Cpanel::Fcntl::or_flags(qw( O_WRONLY O_CREAT )), $mode ) } or do { return ( 0, "The system failed to open the file “$destination” for writing because of an error: " . ( $@ || $! ) ); }; } do { print {$wfh} $buffer or do { return ( 0, "The system failed to write to the file “$destination” because of an error: $!" ); }; } while read $rfh, $buffer, $COPY_CHUNK_SIZE; if ($!) { return ( 0, "The system failed to read from the file “$source” because of an error: $!" ); } truncate( $wfh, tell($wfh) ); if ($!) { return ( 0, "The system failed to truncate the file “$destination” because of an error: $!" ); } if ($i_opened_the_destination) { Cpanel::SafeFile::safeclose( $wfh, $write_lock ) or do { return ( 0, "The system failed to close the file “$destination” because of an error: $!" ); }; } if ($i_opened_the_source) { close $rfh or do { return ( 0, "The system failed to close the file “$source” because of an error: $!" ); }; } return 1; } 1; } # --- END Cpanel/FileUtils/Copy.pm { # --- BEGIN Cpanel/FHUtils/Blocking.pm package Cpanel::FHUtils::Blocking; use strict; use warnings; no warnings 'once'; # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::Autodie qw(fcntl); # perlpkg line 248 INIT { Cpanel::Autodie->import(qw{fcntl}); } sub set_non_blocking { return Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_SETFL, _get_fl_flags( $_[0] ) | $Cpanel::Fcntl::Constants::O_NONBLOCK ) && 1; } sub set_blocking { return Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_SETFL, _get_fl_flags( $_[0] ) & ~$Cpanel::Fcntl::Constants::O_NONBLOCK ) && 1; } sub is_set_to_block { return !( _get_fl_flags( $_[0] ) & $Cpanel::Fcntl::Constants::O_NONBLOCK ) ? 1 : 0; } sub _get_fl_flags { return int Cpanel::Autodie::fcntl( $_[0], $Cpanel::Fcntl::Constants::F_GETFL, 0 ); } 1; } # --- END Cpanel/FHUtils/Blocking.pm { # --- BEGIN Cpanel/Rand/Get.pm package Cpanel::Rand::Get; use strict; # use Cpanel::FHUtils::Blocking (); # perlpkg line 211 # use Cpanel::FHUtils::Tiny (); # perlpkg line 211 our $random_source = '/dev/urandom'; our %entropy_pool; our $getrandom_syscall_is_usable; my $last_entropy_pool_owner = $$; my %TR_CODE_CACHE_NUM_ACCEPTABLE; my %TR_CODE_CACHE_BAD_CHARS; my $DEFAULT_LENGTH = 10; my @DEFAULT_CHARACTERS = ( 0 .. 9, 'A' .. 'Z', 'a' .. 'z', '_', ); my $_default_want_chars_string; # a cache my $DEFAULT_PRELOAD_16TH = 200; my $MAX_READ_ATTEMPTS = 50; my $NUMBER_OF_ASCII_CHARS = 256; my $_EINTR = 4; my $_ENOSYS = 38; my $SYS_GETRANDOM = 318; my $GRND_NONBLOCK = 0x0001; my $srand_initialized = ''; # Used by _assemble_random_data_collection_without_random_device() sub getranddata { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $bytes_of_random_data_wanted, $my_chars_ar, $preloadcount ) = @_; use bytes; #will go away when we leave this context my $pid = $$; if ( $last_entropy_pool_owner != $pid ) { %entropy_pool = (); $last_entropy_pool_owner = $pid; } $preloadcount ||= $DEFAULT_PRELOAD_16TH; my $bytes_of_data_to_preload_into_entropy_pool = $preloadcount * 16; if ($bytes_of_random_data_wanted) { if ( $bytes_of_random_data_wanted =~ tr{0-9}{}c ) { require Cpanel::Exception; die Cpanel::Exception::create( 'InvalidParameter', '“[_1]” is not a valid number of bytes.', [$bytes_of_random_data_wanted] ); } } else { $bytes_of_random_data_wanted = $DEFAULT_LENGTH; } my $number_of_acceptable_characters; my $want_chars; if ( !$my_chars_ar ) { $my_chars_ar = \@DEFAULT_CHARACTERS; $want_chars = ( $_default_want_chars_string ||= join( '', @DEFAULT_CHARACTERS ) ); } if ( !ref $my_chars_ar && $my_chars_ar eq 'binary' ) { $number_of_acceptable_characters = $NUMBER_OF_ASCII_CHARS; $want_chars = ''; } else { $number_of_acceptable_characters = scalar @{$my_chars_ar}; if ( $number_of_acceptable_characters < 1 || $number_of_acceptable_characters > $NUMBER_OF_ASCII_CHARS ) { require Cpanel::Exception; die Cpanel::Exception::create( 'InvalidParameter', 'The number of desired characters must be at least 1 and at most 256.' ); } $want_chars ||= join( '', @{$my_chars_ar} ); } $entropy_pool{$want_chars} ||= ''; my $cur_entropy_pool_sr = \$entropy_pool{$want_chars}; my ( $code_ref_to_remove_chars_above_upper_limit, $code_ref_to_translate_acceptable_chars ) = _generate_random_data_code_refs( $want_chars, $my_chars_ar ); my ( $dummy, $failed_read_attempts, $rand_chars, $random_data_remaining, $entropy_pool_remaining ); my $random_data_collected = ''; my ( $rand_fh, $rand_fh_bitmask ); my $random_source_is_usable = 1; while ( length($random_data_collected) < $bytes_of_random_data_wanted ) { READ_FROM_RANDOM_SOURCE: while (1) { $random_data_remaining = $bytes_of_random_data_wanted - length($random_data_collected); last READ_FROM_RANDOM_SOURCE if !$random_source_is_usable; last READ_FROM_RANDOM_SOURCE if ( length($$cur_entropy_pool_sr) + length($random_data_collected) ) >= $bytes_of_random_data_wanted; $entropy_pool_remaining = $bytes_of_data_to_preload_into_entropy_pool - length($$cur_entropy_pool_sr); if ( !defined $getrandom_syscall_is_usable || $getrandom_syscall_is_usable > 0 ) { my $rand_count = $entropy_pool_remaining > $random_data_remaining ? $entropy_pool_remaining : $random_data_remaining; my $getrandom = _getrandom( $rand_count, \$rand_chars ); if ( $getrandom == -1 ) { if ( $! == $_EINTR ) { next READ_FROM_RANDOM_SOURCE; } else { $getrandom_syscall_is_usable = 0; if ( $! != $_ENOSYS ) { warn "getrandom() failed: $! - falling back to $random_source"; } } } else { $getrandom_syscall_is_usable = $getrandom ? 1 : 0; } } if ( !$getrandom_syscall_is_usable ) { if ( !$rand_fh ) { if ( open $rand_fh, '<:stdio', $random_source ) { $random_source_is_usable = -c $rand_fh ? 1 : 0; if ($random_source_is_usable) { Cpanel::FHUtils::Blocking::set_non_blocking($rand_fh); } else { warn "“$random_source” is unusable because it is not a character device!"; } } else { warn "Failed to open($random_source): $!"; $random_source_is_usable = 0; } last READ_FROM_RANDOM_SOURCE if !$random_source_is_usable; } sysread( $rand_fh, $rand_chars, $entropy_pool_remaining > $random_data_remaining ? $entropy_pool_remaining : $random_data_remaining ) or do { if ( ++$failed_read_attempts > $MAX_READ_ATTEMPTS ) { warn "Failed $MAX_READ_ATTEMPTS times to read from “$random_source”! Last failure was: $!"; $random_source_is_usable = 0; last READ_FROM_RANDOM_SOURCE; } $rand_fh_bitmask ||= Cpanel::FHUtils::Tiny::to_bitmask($rand_fh); select( $dummy = $rand_fh_bitmask, undef, undef, 0.0125 ); next READ_FROM_RANDOM_SOURCE; }; } $code_ref_to_remove_chars_above_upper_limit->( \$rand_chars ) if $code_ref_to_remove_chars_above_upper_limit; $code_ref_to_translate_acceptable_chars->( \$rand_chars ) if $code_ref_to_translate_acceptable_chars; $$cur_entropy_pool_sr .= $rand_chars; } if ( length $$cur_entropy_pool_sr ) { $random_data_collected .= substr( $$cur_entropy_pool_sr, 0, $random_data_remaining, '' ); # just take what we need } else { warn "Using slow randomization logic!"; $random_data_collected .= _assemble_random_data_collection_without_random_device( $number_of_acceptable_characters == $NUMBER_OF_ASCII_CHARS ? [ map { chr } 0 .. 255 ] : $my_chars_ar, $bytes_of_random_data_wanted - length($random_data_collected), ); } } close($rand_fh) if ref $rand_fh; return substr( $random_data_collected, 0, $bytes_of_random_data_wanted ); } sub _assemble_random_data_collection_without_random_device { my ( $my_chars_ar, $bytes_of_random_data_wanted ) = @_; my $process_fingerprint = "$>:$<:$):$$"; unless ( $srand_initialized eq $process_fingerprint ) { $srand_initialized = $process_fingerprint; srand(); } my $num_chars = @$my_chars_ar; my $random_data_collected = q<>; $random_data_collected .= $my_chars_ar->[ rand $num_chars ] for ( 1 .. $bytes_of_random_data_wanted ); return $random_data_collected; } sub clear_pool { %entropy_pool = (); return; } sub _generate_random_data_code_refs { my ( $want_chars, $my_chars_ar ) = @_; if ( !ref $my_chars_ar ) { return (); } my ( $code_ref_to_remove_chars_above_upper_limit, $code_ref_to_translate_acceptable_chars ); my $number_of_acceptable_characters = scalar @$my_chars_ar; my ( $last_good_value_hex, $last_good_value ); my $first_bad_value = $NUMBER_OF_ASCII_CHARS - ( $NUMBER_OF_ASCII_CHARS % $number_of_acceptable_characters ); if ( $first_bad_value != $NUMBER_OF_ASCII_CHARS ) { my $first_bad_value_hex = sprintf( '%02x', $first_bad_value ); $last_good_value = $first_bad_value - 1; $last_good_value_hex = sprintf( '%02x', $last_good_value ); $code_ref_to_remove_chars_above_upper_limit = $TR_CODE_CACHE_BAD_CHARS{$first_bad_value_hex} ||= eval 'sub { ${$_[0]} =~ tr/\x' . $first_bad_value_hex . '-\xff//d; }'; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) } else { $last_good_value_hex = 'ff'; $last_good_value = 255; } $code_ref_to_translate_acceptable_chars = $TR_CODE_CACHE_NUM_ACCEPTABLE{$want_chars} ||= eval 'sub { ${$_[0]} =~ tr/\x{0}-\x{' . $last_good_value_hex . '}/' . join( '', map { quotemeta( $my_chars_ar->[ $_ % $number_of_acceptable_characters ] ) } ( 0 .. $last_good_value ) ) . '/; }'; ## no critic qw(BuiltinFunctions::ProhibitStringyEval) return ( $code_ref_to_remove_chars_above_upper_limit, $code_ref_to_translate_acceptable_chars ); } sub _getrandom { my ( $rand_count, $rand_chars_sr ) = @_; return syscall( 0 + $SYS_GETRANDOM, ( $$rand_chars_sr = "\0" x $rand_count ), 0 + $rand_count, 0 + $GRND_NONBLOCK ); } 1; } # --- END Cpanel/Rand/Get.pm { # --- BEGIN Cpanel/SocketIP.pm package Cpanel::SocketIP; use strict; use warnings; no warnings 'once'; use Socket (); # use Cpanel::Alarm (); # perlpkg line 211 our $VERSION = '1.3'; sub resolveIpAddress { my ( $host, %p_options ) = @_; return if !$host; my $timeout = defined $p_options{'timeout'} && length $p_options{'timeout'} ? $p_options{'timeout'} : undef; my @trueaddresses; my $alarm; my @type = $p_options{'any_proto'} ? () : $p_options{'ipv6'} ? Socket::AF_INET6() : Socket::AF_INET(); eval { $alarm = Cpanel::Alarm->new( $timeout, sub { local $SIG{'__DIE__'}; die; } ) if $timeout; # this is not a fatal event so we shouldn't log the die. my %seen; my @addresses = Socket::getaddrinfo( $host, @type ); foreach my $r ( reverse @addresses ) { last if !$r; my $address; if ( ref($r) ne ref( {} ) ) { $address = Socket::inet_ntoa($r); } elsif ( $r->{'family'} == Socket::AF_INET6() ) { next if !$p_options{'ipv6'} && !$p_options{'any_proto'}; $address = Socket::inet_ntop( $r->{'family'}, ( Socket::unpack_sockaddr_in6( $r->{'addr'} ) )[1] ); } elsif ( $r->{'family'} == Socket::AF_INET ) { next if $p_options{'ipv6'} && !$p_options{'any_proto'}; $address = Socket::inet_ntop( $r->{'family'}, ( Socket::unpack_sockaddr_in( $r->{'addr'} ) )[1] ); } next if exists $seen{$address}; push @trueaddresses, $address; $seen{$address} = 1; } }; undef $alarm; if ( $#trueaddresses == -1 ) { return wantarray ? @trueaddresses : 0; } else { return wantarray ? @trueaddresses : $trueaddresses[0]; } } *_resolveIpAddress = \&resolveIpAddress; 1; } # --- END Cpanel/SocketIP.pm { # --- BEGIN Cpanel/URL.pm package Cpanel::URL; sub parse { my $url = shift; return {} if !$url; my ( $host, $uri ) = ( split m{/+}, $url, 3 )[ 1, 2 ]; $uri = '/' . ( $uri || '' ); $uri =~ s{[^/]+/+\.\./}{}g; $uri =~ s/\.\.//g; my ($filename) = $uri =~ m{/([^/]+)$}; return { 'file' => $filename, 'host' => $host, 'uri' => $uri }; } 1; } # --- END Cpanel/URL.pm { # --- BEGIN Cpanel/UrlTools.pm package Cpanel::UrlTools; use strict; # use Cpanel::Debug (); # perlpkg line 211 sub urltofile { my ($url) = @_; my (@URL) = split( /\//, $url ); return ( $URL[$#URL] ); } sub buildurlfromuri { my ( $rHOSTS, $uri ) = @_; if ( substr( $uri, 0, 1 ) ne '/' ) { $uri = '/' . $uri; } my (@URLS); foreach my $host ( @{$rHOSTS} ) { push @URLS, 'http://' . $host . $uri; } return wantarray ? @URLS : \@URLS; } sub extracthosts { my ($rURLS) = @_; my @HOSTS; foreach my $url ( @{$rURLS} ) { if ( $url =~ m/https?\:\/\/([^\/]+)\// ) { push @HOSTS, $1; } else { Cpanel::Debug::log_warn( 'Invalid URL: ' . $url ); } } return wantarray ? @HOSTS : \@HOSTS; } sub extract_host_uri { my ($url) = @_; if ( $url =~ m/https?\:\/\/([^\/]+)(\/.*)/ ) { return ( $1, $2 ); } else { Cpanel::Debug::log_warn( 'Invalid URL: ' . $url ); } return; } 1; } # --- END Cpanel/UrlTools.pm { # --- BEGIN Cpanel/CachedCommand/Utils.pm package Cpanel::CachedCommand::Utils; # use Cpanel::SV (); # perlpkg line 211 my ( $cached_datastore_myuid, $cached_datastore_dir ); sub destroy { my %OPTS = @_; my $cache_file = _get_datastore_filename( $OPTS{'name'}, ( $OPTS{'args'} ? @{ $OPTS{'args'} } : () ) ); if ( -e $cache_file ) { return unlink $cache_file; } else { return 1; } return; } *get_datastore_filename = *_get_datastore_filename; sub _get_datastore_filename { my ( $bin, @args ) = @_; my $file = join( '_', $bin, @args ); $file =~ tr{/}{_}; Cpanel::SV::untaint($file); my $datastore_dir = _get_datastore_dir($file); Cpanel::SV::untaint($datastore_dir); return $datastore_dir . '/' . $file; } sub _get_datastore_dir { my $file = shift; my $myuid = $>; if ( defined $cached_datastore_dir && length $cached_datastore_dir > 1 && defined $cached_datastore_myuid && $myuid == $cached_datastore_myuid ) { my $homedir = Cpanel::PwCache::gethomedir(); $cached_datastore_dir = "$homedir/$ENV{'TEAM_USER'}/.cpanel/datastore" if $ENV{'TEAM_USER'} && $file =~ /^AVAILABLE_APPLICATIONS_CACHE/; return $cached_datastore_dir; } require Cpanel::PwCache; $cached_datastore_dir = Cpanel::SV::untaint( Cpanel::PwCache::gethomedir() ); $cached_datastore_dir .= "/$ENV{'TEAM_USER'}" if $ENV{'TEAM_USER'} && $file =~ /^AVAILABLE_APPLICATIONS_CACHE/; if ( !-e $cached_datastore_dir . '/.cpanel/datastore' && $cached_datastore_dir ne '/' ) { # nobody's homedir is / require Cpanel::SafeDir::MK; Cpanel::SafeDir::MK::safemkdir( "$cached_datastore_dir/.cpanel/datastore", 0700 ) or warn "Failed to mkdir($cached_datastore_dir/.cpanel/datastore): $!"; } $cached_datastore_myuid = $myuid; $cached_datastore_dir .= '/.cpanel/datastore'; return $cached_datastore_dir; } sub invalidate_cache { my $ds_file = get_datastore_filename(@_); unlink $ds_file; return $ds_file; } sub clearcache { $cached_datastore_dir = undef; $cached_datastore_myuid = undef; return; } 1; } # --- END Cpanel/CachedCommand/Utils.pm { # --- BEGIN Cpanel/PublicSuffix.pm package Cpanel::PublicSuffix; use strict; use warnings; no warnings 'once'; # use parent IO::Socket::SSL::PublicSuffix (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(IO::Socket::SSL::PublicSuffix); } # use Cpanel::AdminBin::Serializer (); # perlpkg line 211 # use Cpanel::AdminBin::Serializer::FailOK (); # perlpkg line 211 our $VERSION = '1.2'; # must not end in zero for compat our $public_suffix_db; BEGIN { if ( !$INC{'Mozilla/PublicSuffix.pm'} ) { $INC{'Mozilla/PublicSuffix.pm'} = __FILE__; ## no critic qw(Variables::RequireLocalizedPunctuationVars) *Mozilla::PublicSuffix::public_suffix = sub { __PACKAGE__->get_io_socket_ssl_publicsuffix_handle()->public_suffix(@_); }; } } my %IS_SIMPLE_TLD = ( com => 1, net => 1, org => 1, info => 1, cloud => 1, arpa => 1, 'in-addr.arpa' => 1, 'ip6.arpa' => 1, ); sub domain_isa_tld { my ($domain) = @_; return 1 if ( $domain =~ tr/.// ) == 0; return 1 if $IS_SIMPLE_TLD{$domain}; return 1 if get_io_socket_ssl_publicsuffix_handle()->public_suffix($domain) eq $domain; return 0; } sub get_io_socket_ssl_publicsuffix_handle { return ( $public_suffix_db ||= bless {}, __PACKAGE__ ); } sub public_suffix { $_[0]->_ensure_loaded(); return $_[0]->SUPER::public_suffix( @_[ 1 .. $#_ ] ); } sub _ensure_loaded { if ( !scalar keys %{ $_[0] } ) { require IO::Socket::SSL::PublicSuffix; local $@; warn if !eval { # Try::Tiny will clobber $_[0] my $db = _load_cached_publicsuffix_db(); @{ $_[0] }{ keys %$db } = values %$db; 1; }; if ( scalar keys %{ $_[0] } ) { return; } my $db = IO::Socket::SSL::PublicSuffix->default(); die "Cold not load IO::Socket::SSL::PublicSuffix default database" if !$db; warn if !eval { _write_cached_publicsuffix_db($db); 1 }; @{ $_[0] }{ keys %$db } = values %$db; } return; } sub _DATASTORE_FILE { require Cpanel::CachedCommand::Utils; return Cpanel::CachedCommand::Utils::get_datastore_filename( __PACKAGE__, 'default' ); } sub _get_publicsuffix_size_mtime { if ( $INC{'IO/Socket/SSL/PublicSuffix.pm'} ) { return ( stat( $INC{'IO/Socket/SSL/PublicSuffix.pm'} ) )[ 7, 9 ]; } foreach my $path (@INC) { my ( $size, $mtime ) = ( stat("$path/IO/Socket/SSL/PublicSuffix.pm") )[ 7, 9 ]; return ( $size, $mtime ) if $size; } die "Cannot locate: IO/Socket/SSL/PublicSuffix.pm"; } sub _load_cached_publicsuffix_db { my $datastore_file = _DATASTORE_FILE(); if ( -e $datastore_file ) { my $datastore_mtime = ( stat(_) )[9]; my ( $public_suffix_size, $public_suffix_mtime ) = _get_publicsuffix_size_mtime(); return undef if !$public_suffix_size || !$public_suffix_mtime || $public_suffix_mtime > $datastore_mtime; my $cache = Cpanel::AdminBin::Serializer::FailOK::LoadFile($datastore_file); if ( ref $cache eq 'HASH' && $cache->{'VERSION'} && $cache->{'size'} && $cache->{'VERSION'} == $VERSION && $cache->{'size'} == $public_suffix_size ) { return $cache->{'data'}; } } return undef; } sub _write_cached_publicsuffix_db { my ($db) = @_; my $datastore_file = _DATASTORE_FILE(); my ( $public_suffix_size, $public_suffix_mtime ) = _get_publicsuffix_size_mtime(); my $unblessed = { %{$db} }; require Cpanel::FileUtils::Write; Cpanel::FileUtils::Write::overwrite( $datastore_file, Cpanel::AdminBin::Serializer::Dump( { 'VERSION' => $VERSION, 'size' => $public_suffix_size, 'data' => $unblessed } ), 0640 ); return 1; } sub clear_cache { my $datastore_file = _DATASTORE_FILE(); unlink $datastore_file; return; } 1; } # --- END Cpanel/PublicSuffix.pm { # --- BEGIN Cpanel/HTTP/Tiny/FastSSLVerify.pm package Cpanel::HTTP::Tiny::FastSSLVerify; use strict; use warnings; no warnings 'once'; # use parent HTTP::Tiny (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(HTTP::Tiny); } # use Cpanel::PublicSuffix (); # perlpkg line 211 my $orig_handle_connect = \&HTTP::Tiny::Handle::connect; our $VERSION = '1.0'; use constant NO_VERIFY_TOUCHFILE_PATH => '/var/cpanel/no_verify_SSL'; sub new { my ( $class, %opts ) = @_; my $connect_timeout = delete $opts{'connect_timeout'}; my $ssl_opts_hr = $opts{'SSL_options'}; $ssl_opts_hr &&= {%$ssl_opts_hr}; $ssl_opts_hr->{'SSL_verifycn_publicsuffix'} = Cpanel::PublicSuffix::get_io_socket_ssl_publicsuffix_handle(); my $verify_ssl = 1; if ( -f NO_VERIFY_TOUCHFILE_PATH ) { $verify_ssl = 0; } my $self = $class->SUPER::new( 'verify_SSL' => $verify_ssl, %opts, 'SSL_options' => $ssl_opts_hr, ); $self->{'connect_timeout'} = $connect_timeout if $connect_timeout; return $self; } sub request { my ( $self, @args ) = @_; no warnings 'redefine'; local *HTTP::Tiny::Handle::connect = sub { my ( $connect_self, @args ) = @_; local $connect_self->{'timeout'} = $self->{'connect_timeout'}; return $orig_handle_connect->( $connect_self, @args ); } if ( $self->{'connect_timeout'} ); use warnings 'redefine'; return $self->SUPER::request(@args); } 1; } # --- END Cpanel/HTTP/Tiny/FastSSLVerify.pm { # --- BEGIN Cpanel/Sync/Common.pm package Cpanel::Sync::Common; use strict; our $BZ_OK; our $BZ_STREAM_END; our $hasbzip2 = 0; eval { require Compress::Raw::Bzip2; $BZ_OK = Compress::Raw::Bzip2::BZ_OK(); $BZ_STREAM_END = Compress::Raw::Bzip2::BZ_STREAM_END(); $hasbzip2 = 1; }; our $BZIP2_CONSUME_INPUT = 1; our $BZIP2_OVERWRITE_OUTPUT = 0; our $BZIP2_APPEND_OUTPUT = 1; our $LZMA_OK; our $LZMA_STREAM_END; our $haslzma = 0; eval { require Compress::Raw::Lzma; $LZMA_OK = Compress::Raw::Lzma::LZMA_OK(); $LZMA_STREAM_END = Compress::Raw::Lzma::LZMA_STREAM_END(); $haslzma = 1; }; our $cpanelsync_excludes = '/etc/cpanelsync.exclude'; our $cpanelsync_chmod_excludes = '/etc/cpanelsync.no_chmod'; sub unbzip2 { my ($file) = @_; die "unbzip2 requires a file" if !length $file; lstat($file); die "$file is a symlink" if -l _; die "$file does not exist" unless -e _; die "$file is a directory" if -d _; die "$file is not a file" if !-f_; my $outfile = $file; $outfile =~ s/\.bz2$//; return if ( $outfile eq $file ); die "cannot decompress $file. $outfile is a directory" if -d $outfile; unlink $outfile if -e _; if ($hasbzip2) { my ( $out_fh, $in_fh ); open( $out_fh, '>', $outfile ) or die("cpanelsync: unbzip2: error opening $outfile for writing: $!"); open( $in_fh, '<', $file ) or die("cpanelsync: unbzip2: error opening $file for reading: $!"); my ( $bzip2, $err ) = Compress::Raw::Bunzip2->new( $BZIP2_APPEND_OUTPUT, $BZIP2_CONSUME_INPUT ); my ( $output, $status ); my $buf = ''; while ( read( $in_fh, $buf, 65535, length $buf ) ) { #65535 is about 35% faster then 512 $status = $bzip2->bzinflate( $buf, $output ); if ( $status != $BZ_OK && $status != $BZ_STREAM_END ) { die "Inflation Error: Failed to decompress $file. bzinflate failed with status: $status"; } print {$out_fh} $output; $output = ''; } close($out_fh); close($in_fh); unlink($file); } else { system( 'bzip2', '-df', $file ); if ( $? != 0 ) { die "Inflation Error: Failed to decompress $file. bzip2 exited with signal: " . ( $? & 127 ) . " and code: " . ( $? >> 8 ); } } return 1; } sub get_excludes { my ($file) = @_; return if ( !-e $file || -z _ ); my @excludes; open( EX, '<', $file ) or return; while (<EX>) { next if m/^\s*$/; chomp; s!/$!!; push @excludes, $_; } close(EX); return @excludes; } sub normalize_path { my ($path) = @_; $path =~ s{/\./}{/}g; $path =~ s{//+}{/}g; return $path; } sub get_digest_from_cache { my ( $cache_hr, $file_hr ) = @_; return undef if ( !( defined($file_hr) && defined($cache_hr) ) ); my $path = normalize_path( $file_hr->{'path'} ); return undef if ( !defined( $cache_hr->{$path} ) ); return undef if ( !$cache_hr->{$path}->{'md5'} ); for my $field (qw(size mtime)) { return undef if ( !defined( $cache_hr->{$path}->{$field} ) ); return undef if ( $cache_hr->{$path}->{$field} != $file_hr->{$field} ); } return $cache_hr->{$path}->{'md5'}; } 1; } # --- END Cpanel/Sync/Common.pm { # --- BEGIN Cpanel/URI/Escape/Fast.pm package Cpanel::URI::Escape::Fast; use strict; use warnings; no warnings 'once'; my %escapes; BEGIN { %escapes = map { chr($_) => sprintf( '%%%02x', $_ ) } ( 0 .. 47, 58 .. 64, 91 .. 94, 96, 123 .. 255 ); } sub uri_escape { return defined $_[0] && $_[0] =~ tr{A-Za-z0-9_.~-}{}c ? ( $_[0] =~ s/([^A-Za-z0-9\-_\.~])/$escapes{$1}/gr ) : $_[0]; } 1; } # --- END Cpanel/URI/Escape/Fast.pm { # --- BEGIN Cpanel/Encoder/URI.pm package Cpanel::Encoder::URI; use strict; use warnings; no warnings 'once'; BEGIN { eval { local $SIG{'__DIE__'}; local $ENV{'PERL_URI_XSESCAPE'} = 0; require # Cpanel::Static OK - optional package URI::XSEscape; }; if ($@) { require Cpanel::URI::Escape::Fast; *uri_encode_str = *Cpanel::URI::Escape::Fast::uri_escape; *uri_decode_str = *_uri_decode_str_slow; } else { *uri_encode_str = *_uri_encode_str_fast; *uri_decode_str = *_uri_decode_str_fast; } } our $VERSION = '1.2'; our $URI_SAFE_CHARS = 'A-Za-z0-9\-_.!~*'; sub _uri_encode_str_fast { return defined $_[0] ? URI::XSEscape::uri_escape( $_[0] . '' ) : undef; # force . '' is to force pOK } sub _uri_decode_str_slow { return defined $_[0] ? ( ( ( $_[0] =~ tr<+>< >r ) =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/egr ) ) : (); } sub _uri_decode_str_fast { return defined $_[0] ? URI::XSEscape::uri_unescape( $_[0] =~ tr<+>< >r ) : (); } sub uri_decode_str_noform { return if !defined $_[0]; return $_[0] =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/egr; } sub uri_encode_dirstr { return join( '/', ( map { uri_encode_str($_) } split( m{/}, shift ) ) ); } 1; } # --- END Cpanel/Encoder/URI.pm { # --- BEGIN Cpanel/IP/Loopback.pm package Cpanel::IP::Loopback; use strict; use warnings; no warnings 'once'; sub is_loopback { return ( length $_[0] && ( $_[0] eq 'localhost' # || $_[0] eq 'localhost.localdomain' # || $_[0] eq '0000:0000:0000:0000:0000:0000:0000:0001' # || index( $_[0], '0000:0000:0000:0000:0000:ffff:7f' ) == 0 # ipv4 inside of ipv6 match 127.* || index( $_[0], '::ffff:127.' ) == 0 # ipv4 inside of ipv6 match 127.* || index( $_[0], '127.' ) == 0 # ipv4 needs to match 127.* || $_[0] eq '0:0:0:0:0:0:0:1' # || $_[0] eq ':1' # || $_[0] eq '::1' # || $_[0] eq '(null)' # || $_[0] eq '(null):0000:0000:0000:0000:0000:0000:0000' # || $_[0] eq '0000:0000:0000:0000:0000:0000:0000:0000' # || $_[0] eq '0.0.0.0' ) # ) ? 1 : 0; } 1; } # --- END Cpanel/IP/Loopback.pm { # --- BEGIN Cpanel/HttpTimer.pm package Cpanel::HttpTimer; use strict; use warnings; no warnings 'once'; our $VERSION = 1.3; our $MAX_SIZE = 1024**2; our $TIMEOUT = 5; our $READ_TIMEOUT = 15; use Socket (); # use Cpanel::UrlTools (); # perlpkg line 211 # use Cpanel::SocketIP (); # perlpkg line 211 # use Cpanel::IP::Loopback (); # perlpkg line 211 # use Cpanel::TimeHiRes (); # perlpkg line 211 sub _setupsocket { my ( $self, $host, $addr, $port, $quiet ) = @_; if ( exists $self->{'httpsocket'} && $self->{'httpsocket'} ) { close $self->{'httpsocket'}; } my $connected = 0; eval { local $SIG{'__DIE__'} = 'DEFAULT'; local $SIG{'PIPE'} = local $SIG{'ALRM'} = sub { print STDERR "..Timeout on connect.." unless $quiet; die; }; alarm $TIMEOUT; my $proto = getprotobyname('tcp') || do { print "..Cannot resolve protocol tcp.." unless $quiet; die; }; socket( $self->{'httpsocket'}, Socket::AF_INET, Socket::SOCK_STREAM, $proto ) || do { print "..Cannot create socket.." unless $quiet; die; }; my $iaddr = Socket::inet_aton("$addr") || do { print "...Unable to translate IP address for host: ${host}..." unless $quiet; die; }; $port ||= getservbyname( 'http', 'tcp' ) || do { print "..Cannot lookup port for http.." unless $quiet; die; }; my $sin = Socket::sockaddr_in( $port, $iaddr ) || do { print "..ERROR: $! .." unless $quiet; die; }; connect( $self->{'httpsocket'}, $sin ) || die "Unable to connect: $!"; alarm 0; $connected = 1; }; alarm 0; return $connected; } sub timedrequest { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix my (%REQ) = @_; my $url = $REQ{'url'}; my ( $host, $uri ) = Cpanel::UrlTools::extract_host_uri($url); unless ( $host && $uri ) { print "Unable to extract host and URI from URL: $url\n" if !$REQ{'quiet'}; return { 'status' => 0, 'speed' => 0 }; } my $self = {}; bless $self, __PACKAGE__; my $addr; if ( $host =~ m/(\d+\.\d+\.d\+\d+)/ ) { $addr = $host; } else { $addr = Cpanel::SocketIP::_resolveIpAddress($host); if ( !$addr ) { print "Unable to resolve $host. Check /etc/resolv.conf\n" if !$REQ{'quiet'}; return { 'status' => 0, 'speed' => 0 }; } } if ( exists $REQ{'nolocal'} && Cpanel::IP::Loopback::is_loopback($addr) ) { return { 'status' => 0, 'speed' => 0 }; } if ( !$self->_setupsocket( $host, $addr, $REQ{'port'}, $REQ{'quiet'} ) ) { return { 'status' => 0, 'speed' => 0 }; } my $filename; my $storef_fh; if ( $REQ{'store'} ) { if ( !length $REQ{'filename'} ) { $filename = Cpanel::UrlTools::urltofile($uri); } else { $filename = $REQ{'filename'}; } open( $storef_fh, '>', $filename ) || die "Failed to open “$filename” for writing: $!"; } my $bytes = 0; my $start_time = Cpanel::TimeHiRes::time(); my $buffer = ''; eval { local $SIG{'__DIE__'} = 'DEFAULT'; local $SIG{'PIPE'} = local $SIG{'ALRM'} = sub { print STDERR '..Timeout on receive..' if !$REQ{'quiet'}; die; }; alarm($READ_TIMEOUT); #set alarm to prevent death send $self->{'httpsocket'}, "GET $uri HTTP/1.0\r\nConnection: close\r\nUser-Agent: Cpanel::HttpTimer/$VERSION\r\nHost: $host\r\n\r\n", 0; while ( read( $self->{'httpsocket'}, $buffer, 131072, length $buffer ) && length $buffer < $MAX_SIZE ) { } alarm(0); }; if ($@) { print "Error ($@) while fetching url ${url}\n" if !$REQ{'quiet'}; return { 'status' => 0, 'speed' => 0 }; } $bytes = length $buffer; my $end_time = Cpanel::TimeHiRes::time(); my $telap = ( $end_time - $start_time ); $telap ||= 0.00001; #clock drift my $bps = sprintf( "%.2f", ( $bytes / $telap ) ); my ( $headers, $body ) = split( /\r?\n\r?\n/, $buffer ); if ( $headers && ( $headers =~ m/SSL-enabled/ || $headers =~ m/location: https:\/\//i ) ) { } elsif ( $headers && $headers =~ /^HTTP\/\S+\s+(\d+)/ ) { my $status = $1; if ( $status =~ /^([345]\d+)/ ) { print "Error ($status) while fetching url ${url}\n" if !$REQ{'quiet'}; return { 'status' => 0, 'speed' => 0 }; } } else { print "Error (no valid headers) while fetching url ${url}\n" if !$REQ{'quiet'}; return { 'status' => 0, 'speed' => 0 }; } if ( $REQ{'store'} ) { print {$storef_fh} $body; close($storef_fh); } if ( $REQ{'return_body'} ) { return { 'status' => 1, 'speed' => $bps, 'body' => $body }; } else { return { 'status' => 1, 'speed' => $bps }; } } 1; } # --- END Cpanel/HttpTimer.pm { # --- BEGIN Cpanel/MirrorSearch.pm package Cpanel::MirrorSearch; use strict; # use Cpanel::HttpTimer (); # perlpkg line 211 use IO::Handle (); use Carp (); our $VERSION = '2.2'; sub remove_mirror { my %REQ = @_; my $key = $REQ{'key'}; my $addr = $REQ{'addr'}; $key =~ s/\///g; $addr =~ s/\///g; my $homedir = ( getpwuid($>) )[7]; unlink("$homedir/.MirrorSearch/$key/pingtimes/$addr"); if ( open( my $mspeeds_fh, '+<', "$homedir/.MirrorSearch/$key/mirrors.speeds" ) ) { my @mspeeds = grep( !/^\Q$addr\E=/, <$mspeeds_fh> ); seek( $mspeeds_fh, 0, 0 ); print {$mspeeds_fh} join( '', @mspeeds ); truncate( $mspeeds_fh, tell($mspeeds_fh) ); close($mspeeds_fh); } } sub findfastest { my (%REQ) = @_; my $now = time(); my $days = $REQ{'days'}; my $key = $REQ{'key'}; my $count = $REQ{'count'}; my @urls = @{ $REQ{'urls'} }; my $urllist = join( "\n", @urls ); die 'You must specify the number of days to cache a host speed (days)' if ( $days eq '' ); die 'You must specify a key to use for this host (key)' if ( $key eq '' ); die 'You must specify a number of hosts to return (count)' if ( $count eq '' ); die 'You must specify an array of urls to try (urls)' if ( $urllist eq '' ); $key =~ s/\///g; my %URLS; foreach my $url (@urls) { if ( $url =~ /(?:ftp|http)\:\/\/([^\/]+)\// ) { my $host = $1; $URLS{$host} = $url; } else { Carp::confess 'Invalid Url'; } } my @GOODURLS = _fetchgoodhosts( $key, $REQ{'port'}, $days, $count, {}, \%URLS, 1, $REQ{'port'} ); if ( $#GOODURLS >= ( $count - 1 ) ) { if ( !$REQ{'quiet'} ) { print "...loaded mirror speeds from cache..."; } return @GOODURLS; } my %PINGTIMES; my $homedir = ( getpwuid($>) )[7]; mkdir $homedir . '/.MirrorSearch', 0700 if !-e $homedir . '/.MirrorSearch'; mkdir $homedir . '/.MirrorSearch/' . $key, 0700 if !-e $homedir . '/.MirrorSearch/' . $key; my $need_pings = 0; foreach my $host ( keys %URLS ) { my $cache_mtime = ( stat("$homedir/.MirrorSearch/${key}/pingtimes/${host}") )[9] || 0; next if ( ( $cache_mtime + ( 86400 * $days ) ) > $now ); $need_pings++; $PINGTIMES{$host} = 1000; #if ping is broken } if ($need_pings) { local $^F = 1000; #prevent cloexec on pipe my $read_fd = IO::Handle->new(); my $write_fd = IO::Handle->new(); pipe( $read_fd, $write_fd ); syswrite( $write_fd, $urllist ); close($write_fd); if ( $REQ{'quiet'} ) { require Cpanel::SafeRun::Errors; Cpanel::SafeRun::Errors::saferunallerrors( '/usr/local/cpanel/scripts/MirrorSearch_pingtest', $key, $days, fileno $read_fd, $REQ{'port'} ); } else { print "Testing connection speed for $key ($need_pings servers)...(using fast method)..."; system '/usr/local/cpanel/scripts/MirrorSearch_pingtest', $key, $days, fileno $read_fd, $REQ{'port'}; print ".Done\n"; } close($read_fd); } opendir( PT, "$homedir/.MirrorSearch/${key}/pingtimes" ); while ( my $pt = readdir(PT) ) { next if ( $pt =~ /^\./ ); open( my $pingtimes_fh, '<', "$homedir/.MirrorSearch/$key/pingtimes/$pt" ); $PINGTIMES{$pt} = <$pingtimes_fh>; chomp $PINGTIMES{$pt}; close($pingtimes_fh); } closedir(PT); return _fetchgoodhosts( $key, $REQ{'port'}, $days, $count, \%PINGTIMES, \%URLS, 0, $REQ{'quiet'} ); } sub _fetchgoodhosts { my $key = shift; my $port = shift; my $days = shift; my $count = shift; my $PINGTIMES = shift; my $URLS = shift; my $cacheonly = shift; my $quiet = shift || 0; $key =~ s/\///g; my $now = time(); my %MIRRORSPEED; my %MIRRORTIME; my @GOODURLS; my $homedir = ( getpwuid($>) )[7]; if ( open my $mirrorspeeds_fh, '<', "$homedir/.MirrorSearch/${key}/mirrors.speeds" ) { while (<$mirrorspeeds_fh>) { chomp; my ( $mirror, $speed, $lastcheck ) = split( /=/, $_ ); next if ( $lastcheck < ( $now - ( 86400 * $days ) ) ); $MIRRORTIME{$mirror} = $lastcheck; $MIRRORSPEED{$mirror} = $speed; } close $mirrorspeeds_fh; } if ($cacheonly) { foreach my $host ( sort { $MIRRORSPEED{$b} <=> $MIRRORSPEED{$a} } keys %MIRRORSPEED ) { push( @GOODURLS, $$URLS{$host} ) if $$URLS{$host}; } } else { my $usable_mirror_count = 0; my %URLS_BY_SPEED; foreach my $host ( sort { $$PINGTIMES{$a} <=> $$PINGTIMES{$b} } keys %{$PINGTIMES} ) { if ( $$URLS{$host} ) { if ( !defined $MIRRORSPEED{$host} || $MIRRORSPEED{$host} eq '' ) { print "Ping:$$PINGTIMES{$host} (seconds) " if !$quiet; ( $MIRRORSPEED{$host} ) = _testmirrorspeed( $$URLS{$host}, $quiet, $port ); $MIRRORTIME{$host} = $now; } if ( $MIRRORSPEED{$host} > 1 ) { $URLS_BY_SPEED{ $$URLS{$host} } = $MIRRORSPEED{$host}; if ( ++$usable_mirror_count >= $count ) { print "$count usable mirrors located\n" if !$quiet; last; } } } } if ( $usable_mirror_count < $count ) { print "...$usable_mirror_count usable mirrors located. (less then expected)..." if !$quiet; } @GOODURLS = sort { $URLS_BY_SPEED{$b} <=> $URLS_BY_SPEED{$a} } keys %URLS_BY_SPEED; if ($usable_mirror_count) { # dump the cache so we retry next time around if ( open my $mirrorspeeds_fh, '>', "$homedir/.MirrorSearch/${key}/mirrors.speeds" ) { foreach my $mirror ( keys %MIRRORSPEED ) { print {$mirrorspeeds_fh} "${mirror}=$MIRRORSPEED{$mirror}=$MIRRORTIME{$mirror}\n"; } close $mirrorspeeds_fh; } else { warn "Unable to write $homedir/.MirrorSearch/${key}/mirrors.speeds: $!"; } } else { unlink("$homedir/.MirrorSearch/$key/mirrors.speeds"); } } return @GOODURLS; } sub _testmirrorspeed { my ( $url, $quiet, $port ) = @_; my ($host) = $url =~ /(?:ftp|http)\:\/\/([^\/]+)\//; Carp::confess( 'Invalid Url : ' . $url ) if !$host; print "Testing connection speed to $host using pureperl..." if !$quiet; my $RES = Cpanel::HttpTimer::timedrequest( 'url' => $url, 'port' => $port, 'nolocal' => 1, 'quiet' => 1 ); # fix hang on mirrors pointing to localhost if ( !$RES->{'speed'} ) { print "test failed...Done\n" if !$quiet; return 0; } else { print "($RES->{'speed'} bytes/s)...Done\n" if !$quiet; return $RES->{'speed'}; } } 1; } # --- END Cpanel/MirrorSearch.pm { # --- BEGIN Cpanel/Binaries.pm package Cpanel::Binaries; use strict; use warnings; no warnings 'once'; our @_OVERRIDES; our $VERBOSE = 1; # use Cpanel::OS (); # perlpkg line 211 use constant { PERL_MAJOR => 542, PERL_LEGACY_MAJOR => 536, PHP_MAJOR => 84, PHP_LEGACY_MAJOR => 83, THIRD_PARTY => q{/usr/local/cpanel/3rdparty}, }; use constant { THIRD_PARTY_BIN => THIRD_PARTY . q{/bin}, CPANEL_PERL => THIRD_PARTY . q{/perl/} . PERL_MAJOR(), CPANEL_PERL_LEGACY => THIRD_PARTY . q{/perl/} . PERL_LEGACY_MAJOR(), CPANEL_PHP => THIRD_PARTY . q{/php/} . PHP_MAJOR(), CPANEL_PHP_LEGACY => THIRD_PARTY . q{/php/} . PHP_LEGACY_MAJOR(), CPANEL_PHP_UNVERSIONED => THIRD_PARTY . q{/php/unversioned}, SYSTEM_BIN => q{/usr/bin}, SYSTEM_SBIN => q{/usr/sbin}, LOCAL_BIN => q{/usr/local/bin}, }; use constant { CPANEL_PERL_BIN => CPANEL_PERL . q{/bin}, CPANEL_PERL_SBIN => CPANEL_PERL . q{/sbin}, CPANEL_PHP_BIN => CPANEL_PHP . q{/bin}, CPANEL_PHP_LEGACY_BIN => CPANEL_PHP_LEGACY . q{/bin}, }; sub system_bin_locations { return { 'cloudlinux-awp-admin' => SYSTEM_BIN, 'cloudlinux-awp-user' => SYSTEM_BIN, 'identify' => SYSTEM_BIN, 'convert' => SYSTEM_BIN, 'mogrify' => SYSTEM_BIN, 'firewall-cmd' => SYSTEM_BIN, 'firewalld' => SYSTEM_SBIN, 'at' => SYSTEM_BIN, 'atq' => SYSTEM_BIN, 'atrm' => SYSTEM_BIN, 'chattr' => SYSTEM_BIN, 'chmod' => SYSTEM_BIN, 'crontab' => SYSTEM_BIN, 'curl' => SYSTEM_BIN, 'dig' => SYSTEM_BIN, 'doveadm' => SYSTEM_BIN, 'doveconf' => SYSTEM_BIN, 'dpkg-query' => SYSTEM_BIN, 'file' => SYSTEM_BIN, 'find' => SYSTEM_BIN, 'gcc' => SYSTEM_BIN, 'getfacl' => SYSTEM_BIN, 'gpg' => SYSTEM_BIN, 'gzip' => SYSTEM_BIN, 'host' => SYSTEM_BIN, 'iconv' => SYSTEM_BIN, 'ionice' => SYSTEM_BIN, 'iostat' => SYSTEM_BIN, 'ipcrm' => SYSTEM_BIN, 'ipcs' => SYSTEM_BIN, 'lsattr' => SYSTEM_BIN, 'lsof' => SYSTEM_BIN, 'make' => SYSTEM_BIN, 'mysql' => SYSTEM_BIN, 'mysql_config' => SYSTEM_BIN, 'mysql_upgrade' => SYSTEM_BIN, 'mysqladmin' => SYSTEM_BIN, 'mysqlcheck' => SYSTEM_BIN, 'mysqldump' => SYSTEM_BIN, 'nano' => SYSTEM_BIN, 'openssl' => SYSTEM_BIN, 'pdns_control' => SYSTEM_BIN, 'pdnsutil' => SYSTEM_BIN, 'perl' => SYSTEM_BIN, 'pigz' => SYSTEM_BIN, 'prlimit' => SYSTEM_BIN, 'ps' => SYSTEM_BIN, 'python3' => SYSTEM_BIN, 'quota' => SYSTEM_BIN, 'repoquery' => SYSTEM_BIN, 'rsync' => SYSTEM_BIN, 'setfacl' => SYSTEM_BIN, 'sqlite3' => SYSTEM_BIN, 'ssh-keygen' => SYSTEM_BIN, 'ssh-keyscan' => SYSTEM_BIN, 'strace' => SYSTEM_BIN, 'sudo' => SYSTEM_BIN, 'systemctl' => SYSTEM_BIN, 'tail' => SYSTEM_BIN, 'test' => SYSTEM_BIN, 'unzip' => SYSTEM_BIN, 'update-crypto-policies' => SYSTEM_BIN, 'vim' => SYSTEM_BIN, 'wall' => SYSTEM_BIN, 'xmlwf' => SYSTEM_BIN, 'yum' => SYSTEM_BIN, 'yum-config-manager' => SYSTEM_BIN, 'zip' => SYSTEM_BIN, 'atd' => SYSTEM_SBIN, 'convertquota' => SYSTEM_SBIN, 'dovecot' => SYSTEM_SBIN, 'edquota' => SYSTEM_SBIN, 'exim' => SYSTEM_SBIN, 'exim_dbmbuild' => SYSTEM_SBIN, 'exim_tidydb' => SYSTEM_SBIN, 'grubby' => SYSTEM_SBIN, 'ifconfig' => SYSTEM_SBIN, 'ip' => SYSTEM_SBIN, 'ip6tables' => SYSTEM_SBIN, 'ip6tables-save' => SYSTEM_SBIN, 'iptables' => SYSTEM_SBIN, 'iptables-save' => SYSTEM_SBIN, 'logrotate' => SYSTEM_SBIN, 'losetup' => SYSTEM_SBIN, 'mysqld' => SYSTEM_SBIN, 'named' => SYSTEM_SBIN, 'nft' => SYSTEM_SBIN, 'nscd' => SYSTEM_SBIN, 'pdns_server' => SYSTEM_SBIN, 'quotacheck' => SYSTEM_SBIN, 'quotaoff' => SYSTEM_SBIN, 'quotaon' => SYSTEM_SBIN, 'repquota' => SYSTEM_SBIN, 'rndc-confgen' => SYSTEM_SBIN, 'rsyslogd' => SYSTEM_SBIN, 'service' => SYSTEM_SBIN, 'sshd' => SYSTEM_SBIN, 'pkill' => SYSTEM_BIN, 'bash' => SYSTEM_BIN, 'cat' => SYSTEM_BIN, 'cp' => SYSTEM_BIN, 'date' => SYSTEM_BIN, 'dd' => SYSTEM_BIN, 'df' => SYSTEM_BIN, 'echo' => SYSTEM_BIN, 'false' => SYSTEM_BIN, 'grep' => SYSTEM_BIN, 'hostname' => SYSTEM_BIN, 'ls' => SYSTEM_BIN, 'mount' => SYSTEM_BIN, 'netstat' => SYSTEM_BIN, 'pwd' => SYSTEM_BIN, 'rm' => SYSTEM_BIN, 'rpm' => SYSTEM_BIN, 'sh' => SYSTEM_BIN, 'su' => SYSTEM_BIN, 'tar' => SYSTEM_BIN, 'true' => SYSTEM_BIN, 'umount' => SYSTEM_BIN, 'unlink' => SYSTEM_BIN, 'zcat' => SYSTEM_BIN, 'rsyslogd' => SYSTEM_SBIN, 'ip6tables' => SYSTEM_SBIN, 'ifconfig' => SYSTEM_SBIN, 'quotaoff' => SYSTEM_SBIN, 'losetup' => SYSTEM_SBIN, 'quotacheck' => SYSTEM_SBIN, 'ip' => SYSTEM_SBIN, 'quotaon' => SYSTEM_SBIN, 'iptables' => SYSTEM_SBIN, 'service' => SYSTEM_SBIN, 'cagefsctl' => SYSTEM_SBIN, }; } sub dynamic_bin_location { my $binary = shift or die 'dynamic_bin_location($binary)'; my %table = Cpanel::OS::binary_locations()->%*; return $table{$binary}; } sub thirdparty_binary_locations { return { %{ _get_thirdparty_binary_locations_static() }, %{ _get_thirdparty_binary_locations_dynamic() }, }; } our %dynamic_vars = ( 'pear' => 1, 'peardev' => 1, 'pecl' => 1, 'phar' => 1, 'php' => 1, 'php-cgi' => 1, 'php-config' => 1, 'phpize' => 1, ); our $cached_cleanup; # Don't do these checks more than once. sub _remove_server_type_specific_binaries { return if $cached_cleanup; return $cached_cleanup = 1; } sub _get_thirdparty_binary_location { my ($binary) = @_; _remove_server_type_specific_binaries(); return ( exists( $dynamic_vars{$binary} ) ) ? _get_thirdparty_binary_locations_dynamic()->{$binary} : _get_thirdparty_binary_locations_static()->{$binary}; } my $php_dir; sub _get_thirdparty_binary_locations_dynamic { if ( !defined($php_dir) ) { $php_dir = Cpanel::Binaries::get_php_3rdparty_dir() . "bin"; } _remove_server_type_specific_binaries(); return { map { $_ => $php_dir } keys(%dynamic_vars) }; } sub _get_thirdparty_binary_locations_static { return { 'spamd' => CPANEL_PERL_BIN, 'spamc' => CPANEL_PERL_BIN, 'spamassassin' => CPANEL_PERL_BIN, 'sa-compile' => CPANEL_PERL_BIN, 'sa-learn' => CPANEL_PERL_BIN, 'sa-update' => CPANEL_PERL_BIN, 'clamd' => THIRD_PARTY_BIN, 'clamdscan' => THIRD_PARTY_BIN, 'freshclam' => THIRD_PARTY_BIN, 'puttygen' => THIRD_PARTY_BIN, 're2c' => THIRD_PARTY_BIN, 'perl' => CPANEL_PERL_BIN, 'perlcc' => CPANEL_PERL_BIN, 'mysqldiff' => CPANEL_PERL_BIN, 'munin-cron' => CPANEL_PERL_BIN, 'munin-node' => CPANEL_PERL_SBIN, 'munin-node-configure' => CPANEL_PERL_SBIN, 'psql' => THIRD_PARTY_BIN, 'pg_dump' => THIRD_PARTY_BIN, 'pg_restore' => THIRD_PARTY_BIN, 'git' => THIRD_PARTY_BIN, 'git-receive-pack' => THIRD_PARTY_BIN, 'git-shell' => THIRD_PARTY_BIN, 'git-upload-archive' => THIRD_PARTY_BIN, 'git-upload-pack' => THIRD_PARTY_BIN, 'wp-toolkit' => LOCAL_BIN, 'imunify360-agent' => SYSTEM_BIN, @_OVERRIDES, }; } sub thirdparty_binary_names { return {}; } sub LOG { my ($msg) = @_; return unless $VERBOSE && defined $msg; print "$msg\n"; return; } sub optional_binaries { return qw/munin-cron munin-node munin-node-configure perlcc/; } sub path { my $binary = shift or return; if ( my $path = _get_thirdparty_binary_location($binary) ) { return $path . '/' . $binary; } my $bin_hash = system_bin_locations(); if ( $bin_hash->{$binary} ) { return $bin_hash->{$binary} . '/' . $binary; } if ( my $dynamic_location = dynamic_bin_location($binary) ) { return $dynamic_location . '/' . $binary; } require Carp; Carp::confess("Unknown binary: '$binary'; possible typo?"); } sub get_prefix { my $binary = shift or return; my $binloc = _get_thirdparty_binary_location($binary); return unless $binloc; $binloc =~ s{/bin$}{}; return $binloc; } sub get_php_version { my %args = @_; my $target_ver = _get_php_ver_only_for_testing('MAJOR'); if ( !-x CPANEL_PHP_BIN . "/php" ) { $target_ver = _get_php_ver_only_for_testing('LEGACY'); } return $target_ver if $args{flat}; return join '.', split( '', $target_ver, 2 ); } sub _get_php_ver_only_for_testing { return $_[0] eq 'MAJOR' ? PHP_MAJOR : PHP_LEGACY_MAJOR; } sub get_php_3rdparty_dir { my $ver = Cpanel::Binaries::get_php_version( 'flat' => 1 ); return THIRD_PARTY . "/php/$ver/"; } sub symlink_into_3rdparty_bin { my $bin_loc_hash = thirdparty_binary_locations(); my $optional = { map { $_ => 1 } optional_binaries() }; my $third_bin = THIRD_PARTY_BIN; my $ok = 1; foreach my $binary ( keys %$bin_loc_hash ) { next if ( $bin_loc_hash->{$binary} eq $third_bin ); next if ( $bin_loc_hash->{$binary} eq SYSTEM_BIN ); my $third_bin_names = thirdparty_binary_names(); my $real_binary = $third_bin_names->{$binary}; $real_binary ||= $binary; my $real_location = $bin_loc_hash->{$binary} . '/' . $real_binary; if ( !-e $real_location ) { LOG("WARNING: Unexpectedly missing $binary") unless $optional->{$binary}; next; } my $third_bin_loc = "$third_bin/$binary"; if ( -e $third_bin_loc || -l $third_bin_loc ) { my $points_to = readlink($third_bin_loc); next if ( $points_to && $points_to eq $real_location ); LOG( "Removing $third_bin_loc, which " . ( $points_to ? "unexpectedly pointed to $points_to" : "was not a symlink" ) ); unlink $third_bin_loc; } LOG("Linking $third_bin_loc -> $real_location"); $ok = 0 unless symlink( $real_location, $third_bin_loc ); } return $ok; } sub binaries_to_symlink_into_system_bin { return [qw/git git-receive-pack git-shell git-upload-archive git-upload-pack/]; } sub symlink_thirdparty_into_system_bin { my $ok = 1; my $to_link_ref = binaries_to_symlink_into_system_bin(); my $bin_loc_hash = thirdparty_binary_locations(); foreach my $binary (@$to_link_ref) { my $third_bin_loc = SYSTEM_BIN . qq{/$binary}; my $real_location = $bin_loc_hash->{$binary} . '/' . $binary; if ( !-e $third_bin_loc && -x $real_location ) { LOG("Linking $third_bin_loc -> $real_location"); $ok = 0 unless symlink( $real_location, $third_bin_loc ); } } return $ok; } 1; } # --- END Cpanel/Binaries.pm { # --- BEGIN Cpanel/Crypt/GPG/Base.pm package Cpanel::Crypt::GPG::Base; use strict; use warnings; no warnings 'once'; # use Cpanel::Binaries (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 sub new { my ( $class, $opts_hr ) = @_; $opts_hr = {} if !( $opts_hr && 'HASH' eq ref $opts_hr ); my $bin = _find_gpg_or_die(); my $obj = { 'bin' => $bin, %{$opts_hr}, }; return bless $obj, $class; } sub get_gpg_bin { my $self = shift; return $self->{bin}; } sub _find_gpg_or_die { my $bin = Cpanel::Binaries::path('gpg'); -x $bin or die Cpanel::Exception::create( 'Unsupported', 'Only servers with [asis,GPG] support this module.' ); return $bin; } 1; } # --- END Cpanel/Crypt/GPG/Base.pm { # --- BEGIN Cpanel/LocaleString.pm package Cpanel::LocaleString; use strict; use warnings; no warnings 'once'; sub DESTROY { } sub new { if ( !length $_[1] ) { die 'Must include at least a string!'; } return bless \@_, shift; } sub set_json_to_freeze { no warnings 'redefine'; *TO_JSON = \&_to_list_ref; return ( __PACKAGE__ . '::_JSON_MODE' )->new(); } sub thaw { if ( ref( $_[1] ) ne 'ARRAY' ) { die "Call thaw() on an ARRAY reference, not “$_[1]”!"; } return $_[0]->new( @{ $_[1] }[ 1 .. $#{ $_[1] } ] ); } sub is_frozen { { last if ref( $_[1] ) ne 'ARRAY'; last if !$_[1][0]->isa( $_[0] ); last if @{ $_[1] } < 2; return 1; } return 0; } sub to_string { return _locale()->makevar( @{ $_[0] } ); } sub to_en_string { return _locale()->makethis_base( @{ $_[0] } ); } sub clone_with_args { return ( ref $_[0] )->new( $_[0][0], #the phrase, currently stored in the object @_[ 1 .. $#_ ], #the new args, supplied by the caller ); } sub to_list { if ( !wantarray ) { require Cpanel::Context; Cpanel::Context::must_be_list(); } return @{ $_[0] }; } *TO_JSON = \&to_string; my $_locale; sub _locale { return $_locale if $_locale; local $@; eval 'require Cpanel::Locale;' or do { ## no critic qw(BuiltinFunctions::ProhibitStringyEval) warn "Failed to load Cpanel::Locale; falling back to substitute. Error was: $@"; }; eval { $_locale = Cpanel::Locale->get_handle() }; return $_locale || bless {}, 'Cpanel::LocaleString::_Cpanel_Locale_unavailable'; } sub _put_back { no warnings 'redefine'; *TO_JSON = \&to_string; return; } sub _to_list_ref { return [ ref( $_[0] ), @{ $_[0] } ]; } package Cpanel::LocaleString::_JSON_MODE; sub new { require Cpanel::Finally; # PPI USE OK - loaded only when needed return $_[0]->SUPER::new( \&Cpanel::LocaleString::_put_back ); } package Cpanel::LocaleString::_Cpanel_Locale_unavailable; BEGIN { *Cpanel::LocaleString::_Cpanel_Locale_unavailable::makethis_base = *Cpanel::LocaleString::_Cpanel_Locale_unavailable::makevar; } sub makevar { my ( $self, $str, @maketext_opts ) = @_; local ( $@, $! ); require Cpanel::Locale::Utils::Fallback; return Cpanel::Locale::Utils::Fallback::interpolate_variables( $str, @maketext_opts ); } 1; } # --- END Cpanel/LocaleString.pm { # --- BEGIN Cpanel/Errno.pm package Cpanel::Errno; use strict; my %_err_name_cache; sub get_name_for_errno_number { my ($number) = @_; if ( !$INC{'Errno.pm'} ) { local ( $@, $! ); require Errno; } die 'need number!' if !length $number; if ( !%_err_name_cache ) { my $s = scalar keys %Errno::; # init iterator foreach my $k ( sort keys %Errno:: ) { if ( Errno->EXISTS($k) ) { my $v = 'Errno'->can($k)->(); $_err_name_cache{$v} = $k; } } } return $_err_name_cache{$number}; } 1; } # --- END Cpanel/Errno.pm { # --- BEGIN Cpanel/Config/Constants/Perl.pm package Cpanel::Config::Constants::Perl; use strict; our $ABRT = 6; our $ALRM = 14; our $BUS = 7; our $CHLD = 17; our $CLD = 17; our $CONT = 18; our $FPE = 8; our $HUP = 1; our $ILL = 4; our $INT = 2; our $IO = 29; our $IOT = 6; our $KILL = 9; our $NUM32 = 32; our $NUM33 = 33; our $NUM35 = 35; our $NUM36 = 36; our $NUM37 = 37; our $NUM38 = 38; our $NUM39 = 39; our $NUM40 = 40; our $NUM41 = 41; our $NUM42 = 42; our $NUM43 = 43; our $NUM44 = 44; our $NUM45 = 45; our $NUM46 = 46; our $NUM47 = 47; our $NUM48 = 48; our $NUM49 = 49; our $NUM50 = 50; our $NUM51 = 51; our $NUM52 = 52; our $NUM53 = 53; our $NUM54 = 54; our $NUM55 = 55; our $NUM56 = 56; our $NUM57 = 57; our $NUM58 = 58; our $NUM59 = 59; our $NUM60 = 60; our $NUM61 = 61; our $NUM62 = 62; our $NUM63 = 63; our $PIPE = 13; our $POLL = 29; our $PROF = 27; our $PWR = 30; our $QUIT = 3; our $RTMAX = 64; our $RTMIN = 34; our $SEGV = 11; our $STKFLT = 16; our $STOP = 19; our $SYS = 31; our $TERM = 15; our $TRAP = 5; our $TSTP = 20; our $TTIN = 21; our $TTOU = 22; our $UNUSED = 31; our $URG = 23; our $USR1 = 10; our $USR2 = 12; our $VTALRM = 26; our $WINCH = 28; our $XCPU = 24; our $XFSZ = 25; our $ZERO = 0; our %SIGNAL_NAME = qw( 0 ZERO 1 HUP 10 USR1 11 SEGV 12 USR2 13 PIPE 14 ALRM 15 TERM 16 STKFLT 17 CHLD 18 CONT 19 STOP 2 INT 20 TSTP 21 TTIN 22 TTOU 23 URG 24 XCPU 25 XFSZ 26 VTALRM 27 PROF 28 WINCH 29 IO 3 QUIT 30 PWR 31 SYS 32 NUM32 33 NUM33 34 RTMIN 35 NUM35 36 NUM36 37 NUM37 38 NUM38 39 NUM39 4 ILL 40 NUM40 41 NUM41 42 NUM42 43 NUM43 44 NUM44 45 NUM45 46 NUM46 47 NUM47 48 NUM48 49 NUM49 5 TRAP 50 NUM50 51 NUM51 52 NUM52 53 NUM53 54 NUM54 55 NUM55 56 NUM56 57 NUM57 58 NUM58 59 NUM59 6 ABRT 60 NUM60 61 NUM61 62 NUM62 63 NUM63 64 RTMAX 7 BUS 8 FPE 9 KILL ); 1; } # --- END Cpanel/Config/Constants/Perl.pm { # --- BEGIN Cpanel/ChildErrorStringifier.pm package Cpanel::ChildErrorStringifier; use strict; # use Cpanel::LocaleString (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 sub new { my ( $class, $CHILD_ERROR, $PROGRAM_NAME ) = @_; return bless { _CHILD_ERROR => $CHILD_ERROR, _PROGRAM_NAME => $PROGRAM_NAME }, $class; } sub CHILD_ERROR { my ($self) = @_; return $self->{'_CHILD_ERROR'}; } sub error_code { my ($self) = @_; return undef if !$self->CHILD_ERROR(); return $self->CHILD_ERROR() >> 8; } sub error_name { my ($self) = @_; my $error_number = $self->error_code(); return '' if ( !defined $error_number ); # Can't index a hash with undef require Cpanel::Errno; return Cpanel::Errno::get_name_for_errno_number($error_number) || q<>; } sub dumped_core { my ($self) = @_; return $self->CHILD_ERROR() && ( $self->CHILD_ERROR() & 128 ) ? 1 : 0; } sub signal_code { my ($self) = @_; return if !$self->CHILD_ERROR(); return $self->CHILD_ERROR() & 127; } sub signal_name { my ($self) = @_; require Cpanel::Config::Constants::Perl; return $Cpanel::Config::Constants::Perl::SIGNAL_NAME{ $self->signal_code() }; } sub exec_failed { return $_[0]->{'_exec_failed'} ? 1 : 0; } sub program { my ($self) = @_; return $self->{'_PROGRAM_NAME'} || undef; } sub set_program { my ( $self, $program ) = @_; return ( $self->{'_PROGRAM_NAME'} = $program ); } sub autopsy { my ($self) = @_; return undef if !$self->CHILD_ERROR(); my @localized_strings = ( $self->error_code() ? $self->_ERROR_PHRASE() : $self->_SIGNAL_PHRASE(), $self->_core_dump_for_phrase_if_needed(), $self->_additional_phrases_for_autopsy(), ); return join ' ', map { $_->to_string() } @localized_strings; } sub terse_autopsy { my ($self) = @_; my $str; if ( $self->signal_code() ) { $str .= 'SIG' . $self->signal_name() . " (#" . $self->signal_code() . ")"; } elsif ( my $code = $self->error_code() ) { $str .= "exit $code"; } else { $str = 'OK'; } if ( $self->dumped_core() ) { $str .= ' (+core)'; } return $str; } sub die_if_error { my ($self) = @_; my $err = $self->to_exception(); die $err if $err; return $self; } sub to_exception { my ($self) = @_; if ( $self->signal_code() ) { return Cpanel::Exception::create( 'ProcessFailed::Signal', [ process_name => $self->program(), signal_code => $self->signal_code(), $self->_extra_error_args_for_die_if_error(), ], ); } if ( $self->error_code() ) { return Cpanel::Exception::create( 'ProcessFailed::Error', [ process_name => $self->program(), error_code => $self->error_code(), $self->_extra_error_args_for_die_if_error(), ], ); } return undef; } sub _extra_error_args_for_die_if_error { } sub _additional_phrases_for_autopsy { } sub _core_dump_for_phrase_if_needed { my ($self) = @_; if ( $self->dumped_core() ) { return Cpanel::LocaleString->new('The process dumped a core file.'); } return; } sub _ERROR_PHRASE { my ($self) = @_; if ( $self->program() ) { return Cpanel::LocaleString->new( 'The subprocess “[_1]” reported error number [numf,_2] when it ended.', $self->program(), $self->error_code() ); } return Cpanel::LocaleString->new( 'The subprocess reported error number [numf,_1] when it ended.', $self->error_code() ); } sub _SIGNAL_PHRASE { my ($self) = @_; if ( $self->program() ) { return Cpanel::LocaleString->new( 'The subprocess “[_1]” ended prematurely because it received the “[_2]” ([_3]) signal.', $self->program(), $self->signal_name(), $self->signal_code() ); } return Cpanel::LocaleString->new( 'The subprocess ended prematurely because it received the “[_1]” ([_2]) signal.', $self->signal_name(), $self->signal_code() ); } 1; } # --- END Cpanel/ChildErrorStringifier.pm { # --- BEGIN Cpanel/FHUtils/OS.pm package Cpanel::FHUtils::OS; use strict; use warnings; no warnings 'once'; my $fileno; sub is_os_filehandle { local $@; $fileno = eval { fileno $_[0] }; return ( defined $fileno ) && ( $fileno != -1 ); } 1; } # --- END Cpanel/FHUtils/OS.pm { # --- BEGIN Cpanel/IO/Flush.pm package Cpanel::IO::Flush; use strict; use warnings; no warnings 'once'; use constant { _EAGAIN => 11, _EINTR => 4, }; # use Cpanel::Exception (); # perlpkg line 211 use IO::SigGuard (); sub write_all { ##no critic qw( RequireArgUnpacking ) my ( $fh, $timeout ) = @_; # $_[2] = payload local ( $!, $^E ); my $offset = 0; { my $this_time = IO::SigGuard::syswrite( $fh, $_[2], length( $_[2] ), $offset ); if ($this_time) { $offset += $this_time; } elsif ( $! == _EAGAIN() ) { _wait_until_ready( $fh, $timeout ); } else { die Cpanel::Exception::create( 'IO::WriteError', [ error => $!, length => length( $_[2] ) - $offset ] ); } redo if $offset < length( $_[2] ); } return; } sub _wait_until_ready { my ( $fh, $timeout ) = @_; my $win; vec( $win, fileno($fh), 1 ) = 1; my $ready = select( undef, my $wout = $win, undef, $timeout ); if ( $ready == -1 ) { redo if $! == _EINTR(); die Cpanel::Exception::create( 'IO::SelectError', [ error => $! ] ); } elsif ( !$ready ) { die Cpanel::Exception::create_raw( 'Timeout', 'write timeout!' ); } return; } 1; } # --- END Cpanel/IO/Flush.pm { # --- BEGIN Cpanel/ReadMultipleFH.pm package Cpanel::ReadMultipleFH; use strict; use warnings; no warnings 'once'; # use Cpanel::FHUtils::Blocking (); # perlpkg line 211 # use Cpanel::FHUtils::OS (); # perlpkg line 211 # use Cpanel::IO::Flush (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 my $CHUNK_SIZE = 2 << 16; my $DEFAULT_TIMEOUT = 600; #10 minutes my $DEFAULT_READ_TIMEOUT = 0; sub new { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $class, %opts ) = @_; my %fh_buffer; my %output; my @fhs = @{ $opts{'filehandles'} }; my $read_input = ''; my $read_output = ''; my %fhmap; my %is_os_filehandle; for my $fh_buf_ar (@fhs) { if ( UNIVERSAL::isa( $fh_buf_ar, 'GLOB' ) ) { $fh_buf_ar = [$fh_buf_ar]; } elsif ( !UNIVERSAL::isa( $fh_buf_ar, 'ARRAY' ) ) { die 'items in “filehandles” must be either a filehandle or ARRAY'; } my $fh = $fh_buf_ar->[0]; Cpanel::FHUtils::Blocking::set_non_blocking($fh); $fhmap{ fileno($fh) } = $fh; vec( $read_input, fileno($fh), 1 ) = 1; if ( defined $fh_buf_ar->[1] && UNIVERSAL::isa( $fh_buf_ar->[1], 'SCALAR' ) ) { $fh_buffer{$fh} = $fh_buf_ar->[1]; } else { my $buf = q{}; $fh_buffer{$fh} = \$buf; if ( defined $fh_buf_ar->[1] && UNIVERSAL::isa( $fh_buf_ar->[1], 'GLOB' ) ) { $output{$fh} = $fh_buf_ar->[1]; $is_os_filehandle{$fh} = Cpanel::FHUtils::OS::is_os_filehandle( $fh_buf_ar->[1] ); } elsif ( defined $fh_buf_ar->[1] ) { die '2nd value in “filehandles” array member must be undef, SCALAR, or GLOB!'; } } } my $finished; my $self = { _fh_buffer => \%fh_buffer, _finished => 0, }; bless $self, $class; my ( $nfound, $select_time_left, $select_timeout ); my $overall_timeout = defined $opts{'timeout'} ? $opts{'timeout'} : $DEFAULT_TIMEOUT; my $read_timeout = defined $opts{'read_timeout'} ? $opts{'read_timeout'} : $DEFAULT_READ_TIMEOUT; my $has_overall_timeout = $overall_timeout ? 1 : 0; my $overall_time_left = $overall_timeout || undef; READ_LOOP: while ( !$finished && # has not finished ( !$has_overall_timeout || $overall_time_left > 0 ) # has not reached overall timeout ) { $select_timeout = _get_shortest_timeout( $overall_time_left, $read_timeout ); ( $nfound, $select_time_left ) = select( $read_output = $read_input, undef, undef, $select_timeout ); if ( !$nfound ) { $self->{'_timed_out'} = ( $select_timeout == $read_timeout ) ? $read_timeout : $overall_timeout; last; } elsif ( $nfound != -1 ) { # case 47309: If we get -1 it probably means we got interrupted by a signal for my $fileno ( grep { vec( $read_output, $_, 1 ) } keys %fhmap ) { my $fh = $fhmap{$fileno}; Cpanel::LoadFile::ReadFast::read_fast( $fh, ${ $fh_buffer{$fh} }, $CHUNK_SIZE, length ${ $fh_buffer{$fh} } ) or do { delete $fhmap{$fileno}; $finished = !( scalar keys %fhmap ); last READ_LOOP if $finished; vec( $read_input, $fileno, 1 ) = 0; next; }; if ( $output{$fh} ) { my $payload_sr = \substr( ${ $fh_buffer{$fh} }, 0, length ${ $fh_buffer{$fh} }, q<> ); if ( $is_os_filehandle{$fh} ) { Cpanel::IO::Flush::write_all( $output{$fh}, $read_timeout, $$payload_sr ); } else { print { $output{$fh} } $$payload_sr; } } } } $overall_time_left -= ( $select_timeout - $select_time_left ) if $has_overall_timeout; } delete $fh_buffer{$_} for keys %output; %fhmap = (); $self->{'_finished'} = $finished; if ( !$finished && defined $overall_time_left && $overall_time_left <= 0 ) { $self->{'_timed_out'} = $overall_timeout; } return $self; } sub _get_shortest_timeout { my ( $overall_time_left, $read_timeout ) = @_; return undef if ( !$overall_time_left && !$read_timeout ); return $read_timeout if !defined $overall_time_left; return ( !$read_timeout || $overall_time_left <= $read_timeout ) ? $overall_time_left : $read_timeout; } sub get_buffer { return $_[0]->{'_fh_buffer'}{ $_[1] }; } sub did_finish { return $_[0]->{'_finished'} ? 1 : 0; } sub timed_out { return defined $_[0]->{'_timed_out'} ? $_[0]->{'_timed_out'} : 0; } 1; } # --- END Cpanel/ReadMultipleFH.pm { # --- BEGIN Cpanel/ForkAsync.pm package Cpanel::ForkAsync; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 my $DEFAULT_ERROR_CODE = 127; #EKEYEXPIRED our $quiet = 0; our $no_warn = 0; sub do_in_child { my ( $code, @args ) = @_; local ( $!, $^E ); my $pid = fork(); die Cpanel::Exception::create( 'IO::ForkError', [ error => $! ] ) if !defined $pid; if ( !$pid ) { local $@; if ( !eval { $code->(@args); 1 } ) { my $err = $@; my $io_err = 0 + $!; _print($err) unless $quiet; exit( $io_err || $DEFAULT_ERROR_CODE ); } exit 0; } return $pid; } sub do_in_child_quiet { my ( $code, @args ) = @_; local $quiet = 1; return do_in_child( $code, @args ); } sub _print { my ($msg) = @_; warn $msg unless $no_warn; print STDERR $msg; return; } 1; } # --- END Cpanel/ForkAsync.pm { # --- BEGIN Cpanel/SafeRun/Object.pm package Cpanel::SafeRun::Object; use cPstrict; no warnings 'once'; # use parent Cpanel::ChildErrorStringifier (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::ChildErrorStringifier); } BEGIN { eval { require Proc::FastSpawn; }; } use IO::SigGuard (); # use Cpanel::Env (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::FHUtils::Autoflush (); # perlpkg line 211 # use Cpanel::FHUtils::OS (); # perlpkg line 211 # use Cpanel::ReadMultipleFH (); # perlpkg line 211 # use Cpanel::LoadModule (); # perlpkg line 211 # use Cpanel::LocaleString (); # perlpkg line 211 use constant _ENOENT => 2; my $CHUNK_SIZE = 2 << 16; my $DEFAULT_TIMEOUT = 3600; # 1 hour my $DEFAULT_READ_TIMEOUT = 0; our $SAFEKILL_TIMEOUT = 1; my @_allowed_env_vars_cache; sub new { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $class, %OPTS ) = @_; die "No “program”!" if !length $OPTS{'program'}; if ( !defined $OPTS{'timeout'} ) { $OPTS{'timeout'} = $DEFAULT_TIMEOUT; } if ( !defined $OPTS{'read_timeout'} ) { $OPTS{'read_timeout'} = $DEFAULT_READ_TIMEOUT; } if ( $OPTS{'program'} =~ tr{><*?[]`$()|;&#$\\\r\n\t }{} && !-e $OPTS{'program'} ) { die Cpanel::Exception::create( 'InvalidParameter', 'A value of “[_1]” is invalid for “[_2]” as it does not permit the following characters: “[_3]”', [ $OPTS{'program'}, 'program', '><*?[]`$()|;&#$\\\\\r\\n\\t' ] ); } my $args_ar = $OPTS{'args'} || []; die "“args” must be an arrayref" if defined $args_ar && ref $args_ar ne 'ARRAY'; die Cpanel::Exception::create( 'InvalidParameter', 'The “[_1]” argument is invalid.', ['logger'] ) if $OPTS{'logger'}; die "Undefined value given as argument! (@$args_ar)" if grep { !defined } @$args_ar; my $pump_stdin_filehandle_into_child; my ( %parent_read_fh, %child_write_fh ); my $merge_output_yn = $OPTS{'stdout'} && $OPTS{'stderr'} && ( $OPTS{'stdout'} eq $OPTS{'stderr'} ); local $!; for my $handle_name (qw(stdout stderr)) { my $custom_fh = $OPTS{$handle_name} && UNIVERSAL::isa( $OPTS{$handle_name}, 'GLOB' ) && $OPTS{$handle_name}; my $dupe_filehandle_will_work = $custom_fh && !tied(*$custom_fh) && ( fileno($custom_fh) > -1 ); if ( !$custom_fh && $OPTS{$handle_name} ) { die "“$handle_name” must be a filehandle or undef, not $OPTS{$handle_name}"; } if ($dupe_filehandle_will_work) { if ( fileno($custom_fh) < 3 ) { open my $copy, '>&', $custom_fh or die "dup($handle_name): $!"; $child_write_fh{$handle_name} = $copy; } else { $child_write_fh{$handle_name} = $custom_fh; } } elsif ( $merge_output_yn && $handle_name eq 'stderr' ) { $parent_read_fh{'stderr'} = $parent_read_fh{'stdout'}; $child_write_fh{'stderr'} = $child_write_fh{'stdout'}; } else { pipe $parent_read_fh{$handle_name}, $child_write_fh{$handle_name} # or die "pipe() failed: $!"; } } my ( $child_reads, $parent_writes ); my $close_child_reads = 0; if ( !defined $OPTS{'stdin'} || !length $OPTS{'stdin'} ) { open $child_reads, '<', '/dev/null' or die "open(<, /dev/null) failed: $!"; $close_child_reads = 1; } elsif ( UNIVERSAL::isa( $OPTS{'stdin'}, 'GLOB' ) ) { my $fileno = fileno $OPTS{'stdin'}; if ( !defined $fileno || $fileno == -1 ) { $pump_stdin_filehandle_into_child = 1; } else { $child_reads = $OPTS{'stdin'}; } } if ( !$child_reads ) { $close_child_reads = 1; pipe( $child_reads, $parent_writes ) or die "pipe() failed: $!"; } my $self = bless { _program => $OPTS{'program'}, _args => $OPTS{'args'} || [], }, $class; local $SIG{'CHLD'} = 'DEFAULT'; my $exec_failed_message = "exec($OPTS{'program'}) failed:"; my $used_fastspawn = 0; if ( $INC{'Proc/FastSpawn.pm'} # may not be available yet due to upcp.static or updatenow.static && !$OPTS{'before_exec'} && !$Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED # PPI NO PARSE - We not ever be set if its not loaded ) { $used_fastspawn = 1; my @env; if ( !$OPTS{'keep_env'} ) { if ( !@_allowed_env_vars_cache ) { @_allowed_env_vars_cache = ( split( m{ }, Cpanel::Env::get_safe_env_vars() ) ); } @env = map { exists $ENV{$_} ? ( $_ . '=' . ( $ENV{$_} // '' ) ) : () } @_allowed_env_vars_cache; } my $user = $OPTS{'user'}; my $homedir = $OPTS{'homedir'}; if ( !$user || !$homedir ) { my ( $pw_user, $pw_homedir ) = ( getpwuid $> )[ 0, 7 ]; $user ||= $pw_user; $homedir ||= $pw_homedir; } die "Invalid EUID: $>" if !$user || !$homedir; push @env, "HOME=$homedir", "USER=$user"; # need to always be set since we start clean and don't have before_exec push @env, "TMP=$homedir/tmp", "TEMP=$homedir/tmp" if !defined $ENV{'TMP'}; $self->{'_child_pid'} = Proc::FastSpawn::spawn_open3( fileno($child_reads), # stdin defined $child_write_fh{'stdout'} ? fileno( $child_write_fh{'stdout'} ) : -1, # stdout defined $child_write_fh{'stderr'} ? fileno( $child_write_fh{'stderr'} ) : -1, # stderr $OPTS{'program'}, # program [ $OPTS{'program'}, @$args_ar ], # args $OPTS{'keep_env'} ? () : \@env # env ); if ( !$self->{_child_pid} ) { $self->{'_CHILD_ERROR'} = $! << 8; $self->{'_exec_failed'} = 1; ${ $self->{'_stdout'} } = ''; ${ $self->{'_stderr'} } .= "$exec_failed_message $!"; } } else { require Cpanel::ForkAsync; $self->{'_child_pid'} = Cpanel::ForkAsync::do_in_child( sub { $SIG{'__DIE__'} = 'DEFAULT'; ## no critic qw(Variables::RequireLocalizedPunctuationVars) -- will never be unset if ( $parent_read_fh{'stdout'} ) { close $parent_read_fh{'stdout'} or die "child close parent stdout failed: $!"; } if ( $parent_read_fh{'stderr'} && !$merge_output_yn ) { close $parent_read_fh{'stderr'} or die "child close parent stderr failed: $!"; } if ($parent_writes) { close $parent_writes or die "close() failed: $!"; } open( *STDIN, '<&=' . fileno $child_reads ) or die "open(STDIN) failed: $!"; ##no critic qw(ProhibitTwoArgOpen) my $fileno_stdout = fileno \*STDOUT; if ( $fileno_stdout != fileno( $child_write_fh{'stdout'} ) ) { if ( $fileno_stdout != 1 ) { close *STDOUT or die "close(STDOUT) failed: $!"; open( *STDOUT, '>>&=1' ) or die "open(STDOUT, '>>&=1') failed: $!"; ##no critic qw(ProhibitTwoArgOpen) } open( *STDOUT, '>>&=' . fileno $child_write_fh{'stdout'} ) or die "open(STDOUT) failed: $!"; ##no critic qw(ProhibitTwoArgOpen) } my $fileno_stderr = fileno \*STDERR; if ( $fileno_stderr != fileno( $child_write_fh{'stderr'} ) ) { if ( $fileno_stderr != 2 ) { close *STDERR or die "close(STDOUT) failed: $!"; open( *STDERR, '>>&=2' ) or die "open(STDERR, '>>&=2') failed: $!"; ##no critic qw(ProhibitTwoArgOpen) } open( *STDERR, '>>&=' . fileno $child_write_fh{'stderr'} ) or die "open(STDERR) failed: $!"; ##no critic qw(ProhibitTwoArgOpen) } if ( !$OPTS{'keep_env'} ) { Cpanel::Env::clean_env(); } if ($Cpanel::AccessIds::ReducedPrivileges::PRIVS_REDUCED) { # PPI NO PARSE -- can't be reduced if the module isn't loaded my $target_euid = "$>"; my $target_egid = ( split( m{ }, "$)" ) )[0]; Cpanel::AccessIds::ReducedPrivileges::_restore_privileges( 0, 0 ); # PPI NO PARSE -- we will never get here if ReducedPrivileges wasn't loaded Cpanel::LoadModule::load_perl_module('Cpanel::Sys::Setsid::Fast') if !$INC{'Cpanel/Sys/Setsid/Fast.pm'}; Cpanel::Sys::Setsid::Fast::fast_setsid(); Cpanel::LoadModule::load_perl_module('Cpanel::AccessIds::SetUids') if !$INC{'Cpanel/AccessIds/SetUids.pm'}; Cpanel::AccessIds::SetUids::setuids( $target_euid, $target_egid ); } if ( $OPTS{'before_exec'} ) { $OPTS{'before_exec'}->(); } my $user = $OPTS{'user'}; my $homedir = $OPTS{'homedir'}; if ( !$user || !$homedir ) { Cpanel::LoadModule::load_perl_module('Cpanel::PwCache') if !$INC{'Cpanel/PwCache.pm'}; my ( $pw_user, $pw_homedir ) = ( Cpanel::PwCache::getpwuid_noshadow($>) )[ 0, 7 ]; $user ||= $pw_user; $homedir ||= $pw_homedir; } die "Invalid EUID: $>" if !$user || !$homedir; $ENV{'HOME'} = $homedir if !defined $ENV{'HOME'}; # always cleared by clean_env, but may be reset in before_exec $ENV{'USER'} = $user if !defined $ENV{'USER'}; # always cleared by clean_env, but may be reset in before_exec $ENV{'TMP'} = "$homedir/tmp" if !defined $ENV{'TMP'}; $ENV{'TEMP'} = "$homedir/tmp" if !defined $ENV{'TEMP'}; exec( $OPTS{'program'}, @$args_ar ) or die "$exec_failed_message $!"; } ); } if ( $OPTS{'after_fork'} ) { $OPTS{'after_fork'}->( $self->{'_child_pid'} ); } if ($close_child_reads) { #only close it if we opened it close $child_reads or die "close() failed: $!"; } if ( $parent_read_fh{'stdout'} ) { close $child_write_fh{'stdout'} or die "close() failed: $!"; } if ( !$merge_output_yn && $parent_read_fh{'stderr'} ) { close $child_write_fh{'stderr'} or die "close() failed: $!"; } if ($parent_writes) { if ( ref $OPTS{'stdin'} eq 'CODE' ) { $OPTS{'stdin'}->($parent_writes); } else { local $SIG{'PIPE'} = 'IGNORE'; Cpanel::FHUtils::Autoflush::enable($parent_writes); if ($pump_stdin_filehandle_into_child) { my $buffer; my $is_os_stdin = Cpanel::FHUtils::OS::is_os_filehandle( $OPTS{'stdin'} ); local $!; if ($is_os_stdin) { while ( IO::SigGuard::sysread( $OPTS{'stdin'}, $buffer, $CHUNK_SIZE ) ) { $self->_write_buffer_to_fh( $buffer, $parent_writes ); } } else { while ( read $OPTS{'stdin'}, $buffer, $CHUNK_SIZE ) { $self->_write_buffer_to_fh( $buffer, $parent_writes ); } } if ($!) { die Cpanel::Exception::create( 'IO::ReadError', 'The system failed to read up to [format_bytes,_1] from the filehandle that contains standard input for the process that is running the command “[_2]”. This failure happened because of an error: [_3]', [ $CHUNK_SIZE, "$OPTS{'program'} @$args_ar", "$!" ] ); } } else { my $to_print_r = ( ref $OPTS{'stdin'} eq 'SCALAR' ) ? $OPTS{'stdin'} : \$OPTS{'stdin'}; if ( length $$to_print_r ) { $self->_write_buffer_to_fh( $$to_print_r, $parent_writes ); } } } close $parent_writes or warn "close() failed: $!"; } my $reader; my $err_obj; my @filehandles = map { $parent_read_fh{$_} ? [ $parent_read_fh{$_}, $OPTS{$_} ] : () } qw( stdout stderr ); if (@filehandles) { local $@; eval { $reader = Cpanel::ReadMultipleFH->new( filehandles => \@filehandles, timeout => $OPTS{'timeout'}, read_timeout => $OPTS{'read_timeout'}, ); }; $err_obj = $@; } if ( $parent_read_fh{'stdout'} ) { close $parent_read_fh{'stdout'} or warn "parent close(stdout) failed: $!"; } if ( $parent_read_fh{'stderr'} && !$merge_output_yn ) { close $parent_read_fh{'stderr'} or warn "parent close(stderr) failed: $!"; } if ($err_obj) { $self->{'_CHILD_ERROR'} = $self->_safe_kill_child(); die $err_obj; } elsif ($reader) { if ( !$reader->did_finish() ) { $self->{'_timed_out_after'} = $reader->timed_out(); $self->{'_CHILD_ERROR'} = $self->_safe_kill_child(); } $self->{"_stdout"} = $parent_read_fh{stdout} && $reader->get_buffer( $parent_read_fh{stdout} ); if ( !$self->{"_stderr"} ) { $self->{"_stderr"} = $parent_read_fh{stderr} && $reader->get_buffer( $parent_read_fh{stderr} ); } } if ( !defined $self->{'_CHILD_ERROR'} ) { local $?; waitpid( $self->{'_child_pid'}, 0 ) if defined $self->{'_child_pid'}; $self->{'_CHILD_ERROR'} = $?; if ( $self->{'_CHILD_ERROR'} ) { $self->{'_exec_failed'} = 1; } } if ( $used_fastspawn && $self->{'_CHILD_ERROR'} == 32512 ) { $self->{'_CHILD_ERROR'} = _ENOENT() << 8; $self->{'_exec_failed'} = 1; ${ $self->{'_stderr'} } .= "$exec_failed_message $!"; } elsif ( !$used_fastspawn && $self->{'_stderr'} && $self->{'_CHILD_ERROR'} && ( $self->{'_CHILD_ERROR'} >> 8 ) == 2 && index( ${ $self->{'_stderr'} }, $exec_failed_message ) > -1 ) { $self->{'_exec_failed'} = 1; } return $self; } sub _write_buffer_to_fh ( $self, $buffer, $fh ) { while ( length $buffer ) { my $wrote = IO::SigGuard::syswrite( $fh, $buffer ) or die $self->_write_error( \$buffer, $! ); substr( $buffer, 0, $wrote, q<> ); } return; } sub new_or_die { my ( $class, @args ) = @_; return $class->new(@args)->die_if_error(); } sub to_exception { my ($self) = @_; if ( $self->timed_out() ) { return Cpanel::Exception::create( 'ProcessFailed::Timeout', [ process_name => $self->program(), ( $self->child_pid() ? ( pid => $self->child_pid() ) : () ), timeout => $self->timed_out(), $self->_extra_error_args_for_die_if_error(), ], ); } return $self->SUPER::to_exception(); } sub _extra_error_args_for_die_if_error { my ($self) = @_; return ( stdout => $self->{'_stdout'} ? $self->stdout() : '', stderr => $self->{'_stderr'} ? $self->stderr() : '', ); } sub _safe_kill_child { my ($self) = @_; Cpanel::LoadModule::load_perl_module('Cpanel::Kill::Single'); return 'Cpanel::Kill::Single'->can('safekill_single_pid')->( $self->{'_child_pid'}, $SAFEKILL_TIMEOUT ); # One second to die } sub stdout_r { if ( !$_[0]->{'_stdout'} ) { Cpanel::LoadModule::load_perl_module('Cpanel::Carp'); die 'Cpanel::Carp'->can('safe_longmess')->("STDOUT output went to filehandle!"); } return $_[0]->{'_stdout'}; } sub _additional_phrases_for_autopsy { if ( $_[0]->timed_out() ) { return Cpanel::LocaleString->new( 'The system aborted the subprocess because it reached the timeout of [quant,_1,second,seconds].', $_[0]->timed_out() ); } return; } sub stdout { return ${ $_[0]->stdout_r() }; } sub stderr_r { if ( !$_[0]->{'_stderr'} ) { Cpanel::LoadModule::load_perl_module('Cpanel::Carp'); die 'Cpanel::Carp'->can('safe_longmess')->("STDERR output went to filehandle!"); } return $_[0]->{'_stderr'}; } sub stderr { return ${ $_[0]->stderr_r() }; } sub child_pid { return $_[0]->{'_child_pid'}; } sub timed_out { return $_[0]->{'_timed_out_after'}; } sub program { return $_[0]->{'_program'}; } sub _program_with_args_str { my $args_ar = $_[0]->{'_args'}; return $_[0]->{'_program'} . ( ( $args_ar && ref $args_ar && scalar @$args_ar ) ? " @$args_ar" : '' ); } sub _ERROR_PHRASE { my ($self) = @_; return Cpanel::LocaleString->new( 'The “[_1]” command (process [_2]) reported error number [_3] when it ended.', $self->_program_with_args_str(), $self->{'_child_pid'}, $self->error_code() ); } sub _SIGNAL_PHRASE { my ($self) = @_; return Cpanel::LocaleString->new( 'The “[_1]” command (process [_2]) ended prematurely because it received the “[_3]” ([_4]) signal.', $self->_program_with_args_str(), $self->{'_child_pid'}, $self->signal_name(), $self->signal_code() ); } sub _write_error { my ( $self, $buffer_sr, $OS_ERROR ) = @_; my @cmd = ( $self->{'_program'}, @{ $self->{'_args'} } ); return Cpanel::Exception::create( 'IO::WriteError', 'The system failed to send [format_bytes,_1] to the process that is running the command “[_2]” because of an error: [_3]', [ length($$buffer_sr), "@cmd", $OS_ERROR ], { length => length($$buffer_sr), error => $OS_ERROR } ); } 1; } # --- END Cpanel/SafeRun/Object.pm { # --- BEGIN Cpanel/Rand.pm package Cpanel::Rand; use strict; use warnings; no warnings 'once'; # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::Rand::Get (); # perlpkg line 211 # use Cpanel::SV (); # perlpkg line 211 my $MAX_TMPFILE_CREATE_ATTEMPTS = 50; use constant WRONLY_CREAT_EXCL => $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_EXCL; our ( $DO_OPEN, $SKIP_OPEN, $TYPE_FILE, $TYPE_DIR ) = ( 0, 1, 0, 1 ); sub getranddata { require Cpanel::Rand::Get; goto \&Cpanel::Rand::Get::getranddata; } sub gettmpfile { return get_tmp_file_by_name('/tmp/cpanel.TMP'); } sub gettmpdir { return get_tmp_dir_by_name('/tmp/cpanel.TMP'); } sub api2_getranddata { my %CFG = @_; require Cpanel::Rand::Get; return { 'random' => Cpanel::Rand::Get::getranddata( $CFG{'length'} || 16 ) }; } our %API = ( getranddata => { allow_demo => 1 }, ); sub api2 { my ($func) = @_; return { %{ $API{$func} } } if $API{$func}; return; } sub get_tmp_dir_by_name { my $templatefile = shift; my $suffix = shift || '.work'; return get_tmp_file_by_name( $templatefile, $suffix, $TYPE_DIR, $DO_OPEN ); } sub get_tmp_file_by_name { my $templatefile = shift; my $suffix = shift || '.work'; my $type = shift || $TYPE_FILE; my $open = shift || $DO_OPEN; if ( index( $suffix, '.' ) != 0 ) { substr( $suffix, 0, 0, '.' ); } my $last_error; my $fh; my $randlength = 8; my $maxlength = 255 - $randlength - 1; my $root = $templatefile . $suffix; my $generate_tmpfile = sub { my (@path) = split( m{/+}, $root ); my $file = substr( pop @path, -$maxlength, $maxlength ); my $tmpfile = join( '/', @path, $file ) . '.' . _rand_trailer($randlength); Cpanel::SV::untaint($tmpfile); return $tmpfile; }; my $tmpfile = $generate_tmpfile->(); local $!; my $attempts = 0; { my $old = umask(0); # Cpanel::Umask was too slow here when creating many zone file while ( ++$attempts < $MAX_TMPFILE_CREATE_ATTEMPTS && ( ( $open != $DO_OPEN && -e $tmpfile ) || ( $open == $DO_OPEN ? ( $type == $TYPE_DIR ? !mkdir( $tmpfile, 0700 ) : !sysopen( $fh, $tmpfile, WRONLY_CREAT_EXCL, 0600 ) ) : 0 ) ) ) { $last_error = $!; $tmpfile = $generate_tmpfile->(); } umask($old); } if ( $attempts == $MAX_TMPFILE_CREATE_ATTEMPTS ) { die Cpanel::Exception::create( 'TempFileCreateError', [ path => $tmpfile, error => $last_error ] ); } return ( $tmpfile, $fh ) if wantarray && $type == $TYPE_FILE; return $tmpfile; # file will close when $fh leaves context } sub _rand_trailer { return Cpanel::Rand::Get::getranddata( $_[0] ); } 1; } # --- END Cpanel/Rand.pm { # --- BEGIN Cpanel/SafeDir/RM.pm package Cpanel::SafeDir::RM; use strict; use warnings; no warnings 'once'; sub safermdir { ## no critic qw(Subroutines::RequireArgUnpacking) return if !-d $_[0]; return 1 if rmdir( $_[0] ); if ( opendir( my $dh, $_[0] ) ) { while ( my $file = readdir($dh) ) { next if $file eq '.' || $file eq '..'; unlink("$_[0]/$file") or last; } } return 1 if rmdir( $_[0] ); require File::Path; File::Path::rmtree( $_[0] ); if ( !-d $_[0] ) { $? = 0; return 1; } return; } 1; } # --- END Cpanel/SafeDir/RM.pm { # --- BEGIN Cpanel/TempFile.pm package Cpanel::TempFile; use strict; use warnings; no warnings 'once'; # use Cpanel::Rand (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::SafeDir::MK (); # perlpkg line 211 # use Cpanel::SafeDir::RM (); # perlpkg line 211 # use Cpanel::Fcntl (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::Destruct (); # perlpkg line 211 use Cwd (); my $DO_OPEN = $Cpanel::Rand::DO_OPEN; my $SKIP_OPEN = $Cpanel::Rand::SKIP_OPEN; my $TYPE_DIR = $Cpanel::Rand::TYPE_DIR; my $TYPE_FILE = $Cpanel::Rand::TYPE_FILE; our $DEFAULT_PATH = '/var/tmp'; my $DEFAULT_SUFFIX = 'tmp'; sub get_safe_tmpfile { return get_safe_tmp_file_or_dir( $Cpanel::Rand::TYPE_FILE, @_ ); } sub get_safe_tmpdir { return get_safe_tmp_file_or_dir( $Cpanel::Rand::TYPE_DIR, @_ ); } sub get_safe_tmp_file_or_dir { ## no critic qw(Subroutines::RequireArgUnpacking) my $file_or_dir = shift; my $homedir = $Cpanel::homedir; if ( !$homedir ) { require Cpanel::PwCache; $homedir = Cpanel::PwCache::gethomedir(); } if ( !-d $homedir . '/tmp' ) { if ( !mkdir( $homedir . '/tmp', 0755 ) ) { Cpanel::Debug::log_warn("Failed to create $homedir/tmp"); return; } } return Cpanel::Rand::get_tmp_file_by_name( $homedir . '/tmp/Cpanel::TempFile', '.tmp', $file_or_dir, @_ ); # audit case 46806 ok } sub new { my ( $what, $opts ) = @_; my $class = ref $what || $what; my $self = {}; bless $self, $class; $self->set_opts($opts); $self->{"needunlink_$$"} = []; return $self; } sub dir { my ( $self, @other_args ) = @_; return $self->_dir_or_file( $TYPE_DIR, @other_args ); } sub file { my ( $self, @other_args ) = @_; return $self->_dir_or_file( $TYPE_FILE, @other_args ); } sub file_in_dir { my ( $self, @other_args ) = @_; my $dir = $self->dir(@other_args); my $opts = pop @other_args || {}; return $self->_dir_or_file( $TYPE_FILE, @other_args, { %$opts, 'path' => $dir } ); } sub file_readwrite { my ( $self, @other_args ) = @_; if ( !wantarray ) { $self->_warn("Calling file_readwrite() in scalar context makes no sense, since you will only get back a filename but no filehandle"); return; } my ( $fname, $fh ) = $self->file(@other_args); close $fh; undef $fh; my $mode = Cpanel::Fcntl::or_flags(qw( O_RDWR O_EXCL )); sysopen( $fh, $fname, $mode, 0600 ) or $self->_die("Could not sysopen $fname: $!\n"); return ( $fname, $fh ); } sub filename_only { my $self = shift; my $die_msg = "You must not call filename_only() to get a unique temp file name not backed by an actual"; $die_msg .= " file on disk. The subroutine is not implemented and with good reason; see case 48668"; $self->_die($die_msg); } sub set_opts { my ( $self, $opts ) = @_; my @valid_keys = qw( suffix prefix path debug mkdirs ); my $err; foreach my $key ( sort keys %{$opts} ) { next if grep { $key eq $_ } @valid_keys; $self->_warn("Disallowing invalid opt '$key' passed in opts hash"); $err = 1; } return if $err; $opts //= {}; $self->{'opts'} //= {}; my @debug; foreach my $k ( sort keys %{$opts} ) { my $v = $opts->{$k} // ''; $self->{'opts'}->{$k} = $v; push @debug, "Set opt $k = $v"; } $Cpanel::Debug::level = $self->{'opts'}->{'debug'} ? 1 : 0; $self->_debug($_) for (@debug); return 1; } sub _get_opt { my ( $self, $name, $opts ) = @_; return $opts->{$name} || $self->{'opts'}->{$name}; } sub _dir_or_file { # Main workhorse of this module my ( $self, $dir_or_file, @other_args ) = @_; my $opts = {}; my $last_arg = $other_args[$#other_args]; if ( ref $last_arg eq "HASH" ) { pop @other_args; $opts = $last_arg; } my $open = $DO_OPEN; my $prefix = $self->_get_opt( 'prefix', $opts ) || ""; if ( length $prefix ) { if ( $prefix =~ m{/} ) { $self->_warn("You must not specify a prefix containing '/' ; instead, use the 'path' option for that purpose"); return; } if ( $prefix =~ m{[^-.\w]} ) { $self->_warn("Bad prefix '$prefix', prefix must contain only '.', '-', and \\w characters"); return; } } my $caller = _callername(); substr $prefix, 0, 0, substr( $caller, length $caller > 40 ? -40 : 0 ) . '__' if $caller; substr $prefix, 0, 0, "$$" . '.'; my $path = $self->_get_opt( 'path', $opts ) || $DEFAULT_PATH; my $suffix = $self->_get_opt( 'suffix', $opts ) || $DEFAULT_SUFFIX; substr $prefix, 0, 0, "$path/"; if ( !-e $path ) { if ( $self->_get_opt( 'mkdirs', $opts ) ) { my @created; if ( Cpanel::SafeDir::MK::safemkdir( $path, undef, undef, \@created ) && -e $path ) { $self->_info("Have created path '$path'"); push @{ $self->{"needunlink_$$"} }, @created; } else { $self->_warn("Non-existent path '$path', could not create"); } } else { $self->_warn("Non-existent path '$path', will not create, because mkdirs option is not set"); } } my ( $fname, $fh ) = Cpanel::Rand::get_tmp_file_by_name( $prefix, $suffix, $dir_or_file, $open ); undef $fname if defined $fname && $fname eq "/dev/null"; $fname = $self->_make_suffix_rightmost( $fname, $suffix ); push @{ $self->{"needunlink_$$"} }, $fname if defined $fname; return ( $fname, $fh ) if wantarray; return $fname; } sub _make_suffix_rightmost { my ( $self, $fname, $suffix ) = @_; if ( defined $fname ) { my $orig = $fname; if ( $fname =~ s{ ^ (.*) [.] ($suffix) [.] (.*) }{ "$1.$3.$2" }ex ) { if ( -e $orig ) { if ( !rename $orig, $fname ) { $self->_warn("Could not rename '$orig' to '$fname' to shift suffix ('$suffix') to rightmost position, leaving as is"); $fname = $orig; } } } else { print STDERR "Regular expression substitution failed to adjust '$orig' to shift suffix ('$suffix') to rightmost position\n"; } } return $fname; } sub _info { my ( $self, $msg ) = @_; return Cpanel::Debug::log_info($msg); } sub _warn { my ( $self, $msg ) = @_; return Cpanel::Debug::log_warn($msg); } sub _debug { my ( $self, $msg ) = @_; return unless $Cpanel::Debug::level; return Cpanel::Debug::log_debug($msg); } sub _die { my ( $self, $msg ) = @_; return Cpanel::Debug::log_die($msg); } { my $caller; sub _callername { return $caller if defined $caller; ( $caller = $0 ) =~ s{\W}{_}g; $caller = uc $caller; return $caller; } BEGIN { _callername() } } sub cleanup { my $self = shift; return unless defined $self->{"needunlink_$$"} && ref $self->{"needunlink_$$"}; my @needunlink = reverse @{ $self->{"needunlink_$$"} }; for my $file (@needunlink) { if ( ( $file =~ tr/\/// ) < 1 ) { $self->_warn("Not removed: $file, as a temp file cannot be at top level"); # ok to not remove because invalid } elsif ( $file eq '/dev/null' ) { # at this writing we need this, unfortunately $self->_warn("Not removed: /dev/null, I flatly refuse to remove it"); } else { my $file_or_dir = -d $file ? "directory" : "file"; my $existed = -e _; if ( !$existed ) { $self->_debug("Not removing $file_or_dir $file, does not exist; perhaps already removed in a recursive dir cleanup, or by some other removal agent"); } else { if ( $file_or_dir eq 'directory' ) { local $?; my $old_dir = Cwd::abs_path( Cwd::getcwd($file) ); my $abs_path = Cwd::abs_path($file); if ( $old_dir eq $abs_path ) { $self->_warn("The cwd is temporary directory “$file”. The cwd was changed to “$file/..” in order to remove the temporary directory."); chdir("$file/..") or die "Failed to chdir('$file/..'): $!"; } Cpanel::SafeDir::RM::safermdir($file); } else { unlink($file); } my $intro = $existed && !-e $file ? "R" : "Not r"; $self->_debug("${intro}emoved: $file_or_dir $file"); } } } @{ $self->{"needunlink_$$"} } = (); return; } sub needunlink { my ( $self, $item ) = @_; push @{ $self->{"needunlink_$$"} }, $item; return; } sub DESTROY { my $self = shift; return if Cpanel::Destruct::in_dangerous_global_destruction(); $self->cleanup(); return; } 1; } # --- END Cpanel/TempFile.pm { # --- BEGIN Cpanel/Crypt/GPG/Import.pm package Cpanel::Crypt::GPG::Import; use strict; # use parent Cpanel::Crypt::GPG::Base (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::Crypt::GPG::Base); } # use Cpanel::SafeRun::Object (); # perlpkg line 211 # use Cpanel::TempFile (); # perlpkg line 211 sub new { my ( $class, $opts_hr ) = @_; $opts_hr = {} if !( $opts_hr && 'HASH' eq ref $opts_hr ); my $self = eval { $class->SUPER::new($opts_hr) }; if ( !$self ) { return wantarray ? ( undef, "Failed to find the GnuPG binary." ) : undef; } my $tmp = ( $opts_hr->{tmp} ) ? $opts_hr->{tmp} : Cpanel::TempFile->new(); $self->{tmp} = $tmp; return $self; } sub verify { my ( $self, %args ) = @_; my ( $sig, @files ); if ( $args{sig} ) { $sig = $args{sig}; } elsif ( $args{sig_data} ) { $sig = $self->_write_data_to_temp_file( $args{sig_data}, $self->{tmp} ); } else { return wantarray ? ( undef, "Arguments 'sig' or 'sig_data' must be provided." ) : undef; } if ( $args{files} ) { @files = ( ref( $args{files} ) eq 'ARRAY' ) ? @{ $args{files} } : ( $args{files} ); } elsif ( defined( $args{files_data} ) ) { for my $file ( ( ref( $args{files_data} ) eq 'ARRAY' ) ? @{ $args{files_data} } : ( $args{files_data} ) ) { push @files, $self->_write_data_to_temp_file( $file, $self->{tmp} ); } } else { return wantarray ? ( undef, "Arguments 'files' or 'files_data' must be provided." ) : undef; } my @args = ( '--logger-fd', '1', '--status-fd', '1', $self->{homedir} ? ( '--homedir' => $self->{homedir} ) : (), '--verify', $sig, @files, ); my $run = Cpanel::SafeRun::Object->new( program => $self->{bin}, args => \@args, timeout => _gpg_timeout(), ); if ( !$run ) { return wantarray ? ( undef, "Failed to invoke gpg." ) : undef; } my $sig_data = undef; my $status = "Failed to validate signature due to some unknown error."; my %notes; my $curnote; for my $l ( split /\n/, $run->stdout() ) { if ( $l =~ /^\[GNUPG:\] VALIDSIG ([A-F0-9]+) (\d+-\d+-\d+) (\d+) ([A-F0-9]+) ([A-F0-9]+) ([A-F0-9]+) ([A-F0-9]+) ([A-F0-9]+) ([A-F0-9]+) ([A-F0-9]+)$/ ) { $sig_data = { id => substr( $1, -16 ), create_time => $3, expire_time => $4, }; $status = "Valid signature."; } elsif ( $l =~ /^\[GNUPG:\] BADSIG ([A-F0-9]+) (.+)$/ ) { $status = "Invalid signature."; } elsif ( $l =~ /^\[GNUPG:\] NO_PUBKEY ([A-F0-9]+)$/ ) { $status = "Could not find public key in keychain."; } elsif ( $l =~ /^\[GNUPG:\] NODATA ([A-F0-9]+)$/ ) { $status = "Could not find a GnuPG signature in the signature file."; } elsif ( $l =~ /^\[GNUPG:\] NOTATION_NAME (.+)$/ ) { $curnote = $1; $notes{$curnote} = ''; } elsif ( $l =~ /^\[GNUPG:\] NOTATION_DATA (.+)$/ ) { $notes{$curnote} .= $1; } } if ($sig_data) { $sig_data->{notations} = \%notes; } return wantarray ? ( $sig_data, "$status (@files)" ) : $sig_data; } sub add_pub_key { my ( $self, %args ) = @_; if ( !$args{key} ) { return wantarray ? ( undef, "No key provided." ) : undef; } my @args = ( '--logger-fd', '1', '--status-fd', '1', $self->{homedir} ? ( '--homedir' => $self->{homedir} ) : (), '--import' ); my $run = Cpanel::SafeRun::Object->new( program => $self->{bin}, args => \@args, stdin => $args{key}, timeout => _gpg_timeout(), ); if ( !$run ) { return wantarray ? ( undef, "Failed to invoke gpg." ) : undef; } my @r = ( undef, "Failed to import key." ); for my $l ( split /\n/, $run->stdout() ) { if ( $l =~ /^\[GNUPG:\] IMPORT_OK \d+ ([A-F0-9]+)$/ ) { my $id = substr( $1, -16 ); @r = ( $id, "Successfully imported key." ); } } return wantarray ? @r : shift @r; } sub get_key_id { my ( $self, %args ) = @_; if ( !$args{key} ) { return wantarray ? ( undef, "No key provided." ) : undef; } my @r = ( undef, "Failed to parse key id." ); if ( my $id = $self->add_pub_key(%args) ) { @r = ( $id, "Successfully parsed key id." ); } return wantarray ? @r : shift @r; } sub _write_data_to_temp_file { my ( $self, $data ) = @_; my ( $name, $handle ) = $self->{tmp}->file(); binmode $handle; # We may be opening binary OpenPGP data. print {$handle} $data; close($handle); return $name; } sub _gpg_timeout { return 60; } 1; } # --- END Cpanel/Crypt/GPG/Import.pm { # --- BEGIN Cpanel/Crypt/GPG/Import/Temp.pm package Cpanel::Crypt::GPG::Import::Temp; use strict; use warnings; no warnings 'once'; # use parent Cpanel::Crypt::GPG::Import (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::Crypt::GPG::Import); } # use Cpanel::TempFile (); # perlpkg line 211 sub new { my ( $class, $opts_hr ) = @_; $opts_hr = {} if !( $opts_hr && 'HASH' eq ref $opts_hr ); my $tmp = Cpanel::TempFile->new; my $path = $tmp->dir(); $opts_hr->{tmp} = $tmp; $opts_hr->{homedir} = $path; my $self = $class->SUPER::new($opts_hr); return $self; } 1; } # --- END Cpanel/Crypt/GPG/Import/Temp.pm { # --- BEGIN Cpanel/CachedDataStore.pm package Cpanel::CachedDataStore; use strict; use Try::Tiny; # use Cpanel::AdminBin::Serializer (); # perlpkg line 211 # use Cpanel::LoadFile::ReadFast (); # perlpkg line 211 # use Cpanel::Fcntl::Constants (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::Exception (); # perlpkg line 211 use Time::HiRes (); use constant { WRONLY_CREAT_EXCL => ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_CREAT | $Cpanel::Fcntl::Constants::O_EXCL ), _EEXIST => 17, }; our $LOCK = 1; #const our $LAST_WRITE_CACHE_SERIALIZATION_ERROR; our $MAX_CACHE_ELEMENTS = 32768 + 1; my $MAX_CACHE_OBJECT_SIZE = 1024 * 512; # do not cache objects larger than 512k my $_iterations_since_last_cache_cleanup = 0; my %DATASTORE_CACHE; *_time = *Time::HiRes::time; *_utime = *Time::HiRes::utime; *_stat = *Time::HiRes::stat; sub store_ref { return savedatastore( $_[0], { 'data' => $_[1], ( ref $_[2] ? %{ $_[2] } : () ) } ); } sub fetch_ref { my ( $file, $is_array ) = @_; my $fetch_ref = loaddatastore($file); my $data_type = ref $fetch_ref->{'data'}; my $data = $data_type ? top_level_clone( $fetch_ref->{'data'} ) : 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, $opts_ref ) = @_; my $fetch_ref = loaddatastore( $file, 0, $into_ref, $opts_ref ); return $fetch_ref->{'data'}; } sub savedatastore { my ( $file, $opts ) = @_; require Cpanel::SafeFile; my $use_cache_file = !defined $opts->{'cache_file'} || $opts->{'cache_file'}; if ( !exists $opts->{'data'} || !defined $opts->{'data'} ) { Cpanel::Debug::log_warn("Expected data to be saved. \$opts->{'data'} was empty. $file has been left untouched."); if ( $opts->{'fh'} && $opts->{'safefile_lock'} ) { Cpanel::SafeFile::safeclose( $opts->{'fh'}, $opts->{'safefile_lock'} ); } elsif ( $opts->{'fh'} ) { close( $opts->{'fh'} ); } return; } my $use_memory_cache = !defined $opts->{'enable_memory_cache'} || $opts->{'enable_memory_cache'}; my $original_file = $file; substr( $file, -5, 5, '' ) if rindex( $file, '.yaml' ) == length($file) - 5; require Cpanel::YAML; my $output = Cpanel::YAML::Dump( $opts->{'data'} ); my $perms = exists $opts->{'mode'} ? $opts->{'mode'} & 00777 : undef; if ( !defined($perms) ) { if ( $opts->{'fh'} ) { die "Filehandle already closed!" if !defined fileno $opts->{'fh'}; $perms = ( stat $opts->{'fh'} )[2] & 0777; } elsif ( -e $original_file ) { $perms = ( stat _ )[2] & 0777; } else { $perms = 0644; } } require Cpanel::FileUtils::Write; my $fh = Cpanel::FileUtils::Write::overwrite( $original_file, $output, $perms ); @{$opts}{ 'inode', 'size', 'mtime' } = ( _stat($fh) )[ 1, 7, 9 ]; close $fh; if ($use_cache_file) { _write_cache_file( "$file.cache", $opts->{'data'}, $perms ); _utime( $opts->{'mtime'}, $opts->{'mtime'}, "$file.cache" ); } if ($use_memory_cache) { if ( $opts->{'size'} < $MAX_CACHE_OBJECT_SIZE ) { _cleanup_cache() if ++$_iterations_since_last_cache_cleanup > $MAX_CACHE_ELEMENTS && scalar keys %DATASTORE_CACHE >= $MAX_CACHE_ELEMENTS; @{ $DATASTORE_CACHE{$original_file} }{ 'cache', 'inode', 'mtime', 'size' } = @{$opts}{ 'data', 'inode', 'mtime', 'size' }; } else { delete $DATASTORE_CACHE{$original_file}; } } my $ok; if ( $opts->{'fh'} ) { if ( $opts->{'safefile_lock'} ) { $ok = Cpanel::SafeFile::safeclose( $opts->{'fh'}, $opts->{'safefile_lock'} ); } else { $ok = close( $opts->{'fh'} ); } } else { $ok = 1; } return $ok; } sub loaddatastore { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix my ( $datastore_file, $lock_required, $copy_data_ref, $opts ) = @_; my ( $loaded_data, $filesys_inode, $filesys_perms, $filesys_mtime, $filesys_size, $filesys_cache_mtime, $cache, $datastore_cache_file ); if ( !$datastore_file ) { Cpanel::Debug::log_warn('No datastore file specified'); return; } my $use_memory_cache = !defined $opts->{'enable_memory_cache'} || $opts->{'enable_memory_cache'}; my $custom_perms = exists $opts->{'mode'} ? $opts->{'mode'} & 00777 : undef; my $lock_datastore = 0; # default is to not lock if ( defined $lock_required ) { $lock_datastore = $lock_required ? 1 : 0; } elsif ( $opts->{'donotlock'} ) { $lock_datastore = 0; } if ( !$lock_datastore ) { ( $filesys_inode, $filesys_perms, $filesys_size, $filesys_mtime ) = ( _stat($datastore_file) )[ 1, 2, 7, 9 ]; if ( !$filesys_mtime ) { return; } if ( $use_memory_cache && exists $DATASTORE_CACHE{$datastore_file} # no-auto vivify && $DATASTORE_CACHE{$datastore_file}->{'mtime'} && $DATASTORE_CACHE{$datastore_file}->{'size'} && $filesys_mtime == $DATASTORE_CACHE{$datastore_file}->{'mtime'} && $filesys_size == $DATASTORE_CACHE{$datastore_file}->{'size'} && $filesys_inode == $DATASTORE_CACHE{$datastore_file}->{'inode'} ) { if ($copy_data_ref) { _copy_ref_data( $DATASTORE_CACHE{$datastore_file}->{'cache'}, $copy_data_ref, $datastore_file ); } if ( defined $custom_perms ) { if ( ( $filesys_perms & 0777 ) != $custom_perms ) { chmod $custom_perms, $datastore_file or do { warn sprintf( "chmod(0%03o, $datastore_file): $!", $custom_perms ); }; } } return bless { 'size' => $DATASTORE_CACHE{$datastore_file}->{'size'}, 'inode' => $DATASTORE_CACHE{$datastore_file}->{'inode'}, 'mtime' => $DATASTORE_CACHE{$datastore_file}->{'mtime'}, 'data' => $DATASTORE_CACHE{$datastore_file}->{'cache'}, 'file' => $datastore_file, }, __PACKAGE__; } } $datastore_cache_file = $datastore_file; if ( rindex( $datastore_cache_file, '.yaml' ) == length($datastore_cache_file) - 5 ) { substr( $datastore_cache_file, -5, 5, '.cache' ); } else { $datastore_cache_file .= '.cache'; } if ( !$lock_datastore ) { ( $filesys_cache_mtime, $cache ) = _load_datastore_cache_from_disk( $datastore_cache_file, $filesys_mtime, $datastore_file, $filesys_size, $filesys_inode ); if ( $filesys_cache_mtime && $filesys_cache_mtime >= $filesys_mtime && ref $cache ) { $loaded_data = $cache; } if ( $copy_data_ref && $loaded_data ) { _copy_ref_data( $loaded_data, $copy_data_ref, $datastore_file ); } if ($loaded_data) { if ( defined $custom_perms && ( $filesys_perms & 00777 ) != $custom_perms ) { chmod( $custom_perms, $datastore_file ) or do { warn( sprintf "chmod(0%o, %s) failed: %s", $custom_perms, $datastore_file, $! ); }; } if ($use_memory_cache) { if ( $filesys_size < $MAX_CACHE_OBJECT_SIZE ) { _cleanup_cache() if ++$_iterations_since_last_cache_cleanup > $MAX_CACHE_ELEMENTS && scalar keys %DATASTORE_CACHE >= $MAX_CACHE_ELEMENTS; @{ $DATASTORE_CACHE{$datastore_file} }{ 'inode', 'size', 'mtime', 'cache' } = ( $filesys_inode, $filesys_size, $filesys_mtime, $loaded_data ); } else { delete $DATASTORE_CACHE{$datastore_file}; } } return bless { 'inode' => $filesys_inode, 'size' => $filesys_size, 'mtime' => $filesys_mtime, 'data' => $loaded_data, 'file' => $datastore_file, }, __PACKAGE__; } } my $datastore_not_writable; my $data_fh; my $perms = defined $custom_perms ? $custom_perms : 0644; #0644 is the default my $orig_umask; if ( defined $perms ) { $orig_umask = umask( $perms ^ 07777 ); } my $created_datastore_file = 0; if ( !-e $datastore_file ) { if ( sysopen my $f, $datastore_file, WRONLY_CREAT_EXCL, $perms ) { $created_datastore_file = 1; } elsif ( $! != _EEXIST() ) { warn "Failed to create “$datastore_file” (EUID=$>): $!"; } } my $rlock; my $lock_failed; if ( !$lock_datastore ) { open( $data_fh, '<', $datastore_file ) or do { Cpanel::Debug::log_warn("Unable open $datastore_file for reading: $!"); undef $data_fh; }; $datastore_not_writable = 1; } else { my $open_mode = -w $datastore_file ? '+<' : '<'; require Cpanel::SafeFile; $rlock = Cpanel::SafeFile::safeopen( $data_fh, $open_mode, $datastore_file ); my $last_error = $@ || $!; $lock_failed = !$rlock || 1 == $rlock; if ($lock_failed) { Cpanel::Debug::log_warn("Unable get a lock on datastore $datastore_file: $last_error"); undef $data_fh; $datastore_not_writable = 1; } } umask($orig_umask) if defined $orig_umask; if ( !$created_datastore_file ) { my $data_fh_perms = ( _stat( $data_fh // $datastore_file ) )[2] || 0600; if ( defined $custom_perms && ( $data_fh_perms & 00777 ) != $custom_perms ) { chmod( $custom_perms, $data_fh ? $data_fh : $datastore_file ); $data_fh_perms = ( _stat( $data_fh // $datastore_file ) )[2] || 0600; } if ( $data_fh && fileno $data_fh ) { if ($lock_datastore) { ( $filesys_inode, $filesys_perms, $filesys_size, $filesys_mtime ) = ( _stat($data_fh) )[ 1, 2, 7, 9 ]; ( $filesys_cache_mtime, $cache ) = _load_datastore_cache_from_disk( $datastore_cache_file, $filesys_mtime, $datastore_file, $filesys_size, $filesys_inode ); } if ( $filesys_cache_mtime && ref $cache ) { $loaded_data = $cache; } else { $loaded_data = _load_inner_data( $datastore_file, $data_fh ); seek( $data_fh, 0, 0 ); } if ( $copy_data_ref && $loaded_data ) { _copy_ref_data( $loaded_data, $copy_data_ref, $datastore_file ); } } if ( !$lock_datastore || $datastore_not_writable ) { my @data_dir = split( /\/+/, $datastore_cache_file ); pop @data_dir; my $datastore_cache_file_dir = join( '/', @data_dir ); if ( $loaded_data && $filesys_mtime && ( !-e $datastore_cache_file || -w _ ) && ( _stat($datastore_cache_file_dir) )[4] == $> ) { _write_cache_file( $datastore_cache_file, $loaded_data, $data_fh_perms ) if !$filesys_cache_mtime; if ($use_memory_cache) { if ( $filesys_size < $MAX_CACHE_OBJECT_SIZE ) { _cleanup_cache() if ++$_iterations_since_last_cache_cleanup > $MAX_CACHE_ELEMENTS && scalar keys %DATASTORE_CACHE >= $MAX_CACHE_ELEMENTS; @{ $DATASTORE_CACHE{$datastore_file} }{ 'cache', 'inode', 'mtime', 'size' } = ( $loaded_data, $filesys_inode, $filesys_mtime, $filesys_size ); } else { delete $DATASTORE_CACHE{$datastore_file}; } } } } } if ( !$lock_datastore || $datastore_not_writable ) { if ( !$lock_datastore ) { close($data_fh); } else { require Cpanel::SafeFile; Cpanel::SafeFile::safeclose( $data_fh, $rlock ) unless $lock_failed; } $data_fh = undef; # data_fh is closed at this point $datastore_not_writable = 1; # if the datastore is closed, it isn't writable. } my %self = ( 'inode' => $filesys_inode, 'size' => $filesys_size, 'mtime' => $filesys_mtime, 'data' => $loaded_data, 'file' => $datastore_file, ); if ( !$datastore_not_writable ) { @self{ 'safefile_lock', 'fh' } = ( $rlock, $data_fh ); } return bless \%self, __PACKAGE__; } sub _load_datastore_cache_from_disk { my ( $datastore_cache_file, $filesys_mtime, $datastore_file, $filesys_size, $filesys_inode ) = @_; my $loaded_data; if ( open( my $datastore_cache_fh, '<:stdio', $datastore_cache_file ) ) { my $filesys_cache_mtime = ( _stat($datastore_cache_fh) )[9]; # stat the file handle to prevent a race condition if ( $filesys_size && $filesys_mtime && $filesys_cache_mtime >= $filesys_mtime && $filesys_cache_mtime <= _time() ) { 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 $loaded_data = Cpanel::AdminBin::Serializer::LoadFile($datastore_cache_fh); }; my ( $filesys_inode_after_read, $filesys_size_after_read, $filesys_mtime_after_read ) = ( _stat($datastore_file) )[ 1, 7, 9 ]; if ( $filesys_mtime_after_read == $filesys_mtime && $filesys_size_after_read == $filesys_size && $filesys_inode_after_read == $filesys_inode ) { return ( $filesys_cache_mtime, $loaded_data ) if ref $loaded_data; } } } elsif ( $! != _ENOENT() ) { #ok if the file does not exist warn "Failed to open “$datastore_cache_file” for reading: $!"; } return 0; } sub _write_cache_file { my ( $path, $data, $perms ) = @_; $LAST_WRITE_CACHE_SERIALIZATION_ERROR = undef; try { my $serialized; try { $serialized = Cpanel::AdminBin::Serializer::Dump($data); } catch { $LAST_WRITE_CACHE_SERIALIZATION_ERROR = Cpanel::Exception::get_string($_); }; if ($serialized) { require Cpanel::FileUtils::Write; Cpanel::FileUtils::Write::overwrite( $path, $serialized, $perms, ); } } catch { my $str = Cpanel::Exception::get_string($_); Cpanel::Debug::log_warn("Failed to write the cache file “$path” ($str); this file will not be saved."); }; return; } sub file { return $_[0]->{'file'}; } sub fh { return $_[0]->{'fh'}; } sub mtime { return $_[0]->{'mtime'}; } sub size { return $_[0]->{'size'}; } sub clear_data { $_[0]->{'data'} = undef; return; } sub data { if ( defined $_[1] ) { $_[0]->{'data'} = $_[1]; return 1; } return $_[0]->{'data'}; } sub save { return savedatastore( $_[0]->{'file'}, $_[0] ); } sub abort { return unlockdatastore( $_[0] ); } sub unlockdatastore { my ($datastore) = @_; return 0 if !$datastore->{'fh'} || !$datastore->{'safefile_lock'}; require Cpanel::SafeFile; return Cpanel::SafeFile::safeclose( $datastore->{'fh'}, $datastore->{'safefile_lock'} ); } sub _copy_ref_data { my ( $src_ref, $dest_ref, $file ) = @_; if ( ref $src_ref eq 'HASH' ) { local $@; eval { %{$dest_ref} = %{$src_ref}; }; } elsif ( ref $src_ref eq 'ARRAY' ) { local $@; eval { @{$dest_ref} = @{$src_ref}; }; } else { if ($file) { Cpanel::Debug::log_warn("YAML in '$file' is not a hash or array reference"); } else { Cpanel::Debug::log_warn('Asked to duplicate a reference that is not a hash or array'); } $dest_ref = $src_ref; } return; } sub get_cache { return \%DATASTORE_CACHE; } sub clear_cache { %DATASTORE_CACHE = (); return; } sub clear_one_cache { my ($file) = @_; delete $DATASTORE_CACHE{$file}; return; } sub verify { my ($file) = @_; my $fh; open( $fh, '<', $file ) or die "Failed to open $file: $!"; my $data = _load_inner_data( $file, $fh ); return ref $data ? 1 : 0; } sub _load_inner_data { my ( $name, $fh ) = @_; my $data = ''; Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data ); my $loaded_data; if ( length $data ) { local $@; eval { local $SIG{'__WARN__'}; local $SIG{'__DIE__'}; require Cpanel::YAML; $loaded_data = ( Cpanel::YAML::Load($data) )[0]; }; } $loaded_data = undef unless ref $loaded_data; return $loaded_data; } sub top_level_clone { my ($data) = @_; if ( ref $data eq 'HASH' ) { return { %{ $_[0] } }; } elsif ( ref $data eq 'ARRAY' ) { return [ @{ $_[0] } ]; } return $data; } sub _cleanup_cache { my @oldest_keys = sort { $DATASTORE_CACHE{$b}{'mtime'} <=> $DATASTORE_CACHE{$a}{'mtime'} } keys %DATASTORE_CACHE; splice( @oldest_keys, -1 * int( $MAX_CACHE_ELEMENTS / 2 ) ); delete @DATASTORE_CACHE{@oldest_keys}; $_iterations_since_last_cache_cleanup = 0; return 1; } sub _ENOENT { return 2; } 1; } # --- END Cpanel/CachedDataStore.pm { # --- BEGIN Cpanel/HTTP/Client/Response.pm package Cpanel::HTTP::Client::Response; use strict; use warnings; no warnings 'once'; # use parent HTTP::Tiny::UA::Response (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(HTTP::Tiny::UA::Response); } sub new { my ( $class, $opts_hr, @extra ) = @_; my $self = $class->SUPER::new( $opts_hr, @extra ); $self->{'_cp_redirects'} = $opts_hr->{'redirects'}; return $self; } sub redirects { my ($self) = @_; return [ map { ( ref $self )->new($_) } @{ $self->{'_cp_redirects'} } ]; } sub TO_JSON { my $json = { %{ $_[0] } }; $json->{redirects} = delete $json->{_cp_redirects}; return $json; } 1; } # --- END Cpanel/HTTP/Client/Response.pm { # --- BEGIN Cpanel/HTTP/Client.pm package Cpanel::HTTP::Client; use strict; my %MODULE_PARAMS; # use Cpanel::HTTP::Tiny::FastSSLVerify (); # perlpkg line 238 our @ISA; BEGIN { push @ISA, qw(Cpanel::HTTP::Tiny::FastSSLVerify); } # use Cpanel::Exception (); # perlpkg line 211 # use Cpanel::HTTP::Client::Response (); # perlpkg line 211 our $VERSION = '1.0'; sub new { my ( $class, @args ) = @_; my $self = $class->SUPER::new(@args); $MODULE_PARAMS{$self} = {}; return $self; } sub die_on_http_error { my ($self) = @_; $MODULE_PARAMS{$self}{'die_on_http_error'} = 1; return $self; } sub return_on_http_error { my ($self) = @_; $MODULE_PARAMS{$self}{'die_on_http_error'} = 0; return $self; } sub request { my ( $self, $method, $url, $args_hr ) = @_; local $@; my $resp = $self->SUPER::request( $method, $url, $args_hr || () ); my $resp_obj = Cpanel::HTTP::Client::Response->new($resp); if ( $resp_obj->status() == 599 ) { my $error = $resp_obj->content(); chomp($error) if $error && !ref $error; die Cpanel::Exception::create( 'HTTP::Network', [ method => $method, url => $url, error => $error, redirects => $resp_obj->redirects(), ] ); } if ( $MODULE_PARAMS{$self}{'die_on_http_error'} && $resp->{'status'} >= 400 ) { die Cpanel::Exception::create( 'HTTP::Server', [ method => $method, content_type => scalar( $resp_obj->header('Content-Type') ), ( map { ( $_ => $resp_obj->$_() ) } qw( content status reason url headers redirects ) ), ], ); } return $resp_obj; } sub set_default_header { my ( $self, $header, $value ) = @_; $header =~ tr/[A-Z]/[a-z]/; $self->{'default_headers'}{$header} = $value; return 1; } sub delete_default_header { my ( $self, $header ) = @_; $header =~ tr/[A-Z]/[a-z]/; return delete $self->{'default_headers'}{$header}; } sub DESTROY { my ($self) = @_; delete $MODULE_PARAMS{$self}; $self->SUPER::DESTROY() if $self->can('SUPER::DESTROY'); return; } 1; } # --- END Cpanel/HTTP/Client.pm { # --- BEGIN Cpanel/SecureDownload.pm package Cpanel::SecureDownload; use strict; use warnings; no warnings 'once'; sub fetch_url { my ( $url, %opts ) = @_; my @methods = ( [ 'Cpanel::HTTP::Client' => \&_try_with_http_client ], [ 'curl' => \&_try_with_curl ], [ 'wget' => \&_try_with_wget ] ); my $all_errors; foreach my $method (@methods) { my ( $name, $sub ) = @{$method}; local $@; my $contents = eval { $sub->( $url, %opts ); }; return ( 1, $contents ) if !$@; my $error = "Failed to fetch using $name: $@"; $all_errors .= $error . "\n"; } return ( 0, $all_errors ); } sub _try_with_http_client { my ( $url, %opts ) = @_; die "Cpanel::HTTP::Client unavailable during initial install" if $ENV{'CPANEL_BASE_INSTALL'}; require Cpanel::HTTP::Client; my $http = Cpanel::HTTP::Client->new()->die_on_http_error(); $http->timeout( $opts{'timeout'} ) if exists $opts{'timeout'}; my $content = $http->get($url)->content(); return $content unless exists $opts{'output-file'}; my $temp_file = $opts{'output-file'} . '.' . time . '.temp'; open my $fh, '>', $temp_file or die "Unable to open $temp_file: $!"; print {$fh} $content; close $fh; unlink $opts{'output-file'} if -e $opts{'output-file'}; rename $temp_file, $opts{'output-file'}; return 1; } sub _try_with_curl { my ( $url, %opts ) = @_; my $curl_bin = _find_curl_bin(); die "Unable to find curl" unless $curl_bin; my @cmd_args = _build_curl_cmd_line( $url, %opts ); return _execute_download_tool( $curl_bin, @cmd_args ); } sub _try_with_wget { my ( $url, %opts ) = @_; my $wget_bin = _find_wget_bin(); die "Unable to find wget" unless $wget_bin; my @cmd_args = _build_wget_cmd_line( $url, %opts ); return _execute_download_tool( $wget_bin, @cmd_args ); } sub _get_mozilla_ca_file { my $ca_file = eval { require # Cpanel::Static OK - inside an eval Mozilla::CA; Mozilla::CA::SSL_ca_file(); }; return if $@; return unless -e $ca_file; return $ca_file; } sub _find_curl_bin { for my $bin (qw(/usr/bin/curl /bin/curl /usr/local/bin/curl)) { next if ( !-e $bin ); next if ( !-x _ ); next if ( -z _ ); return $bin; } return undef; } sub _find_wget_bin { for my $bin (qw(/usr/bin/wget /bin/wget /usr/local/bin/wget)) { next if ( !-e $bin ); next if ( !-x _ ); next if ( -z _ ); return $bin; } return undef; } sub _build_curl_cmd_line { my ( $url, %opts ) = @_; my @cmd_args; if ( exists $opts{'tries'} ) { push @cmd_args, '--retry'; push @cmd_args, $opts{'tries'}; } if ( exists $opts{'retry-delay'} ) { push @cmd_args, '--retry-delay'; push @cmd_args, $opts{'retry-delay'}; } if ( exists $opts{'timeout'} ) { push @cmd_args, '--max-time'; push @cmd_args, $opts{'timeout'}; } if ( exists $opts{'no-check-certificate'} && $opts{'no-check-certificate'} ) { push @cmd_args, '-k'; } else { my $ca_file = _get_mozilla_ca_file(); if ($ca_file) { push @cmd_args, "--cacert"; push @cmd_args, $ca_file; } } push @cmd_args, '--silent'; push @cmd_args, '-o'; push @cmd_args, exists $opts{'output-file'} ? $opts{'output-file'} : '-'; push @cmd_args, $url; return @cmd_args; } sub _build_wget_cmd_line { my ( $url, %opts ) = @_; my @cmd_args; push @cmd_args, '-nv' if exists $opts{'not-verbose'}; push @cmd_args, '--no-dns-cache' if exists $opts{'no-dns-cache'}; push @cmd_args, '--tries=' . $opts{'tries'} if exists $opts{'tries'}; push @cmd_args, '--timeout=' . $opts{'timeout'} if exists $opts{'timeout'}; push @cmd_args, '--dns-timeout=' . $opts{'dns-timeout'} if exists $opts{'dns-timeout'}; push @cmd_args, '--read-timeout=' . $opts{'read-timeout'} if exists $opts{'read-timeout'}; push @cmd_args, '--waitretry=' . $opts{'retry-delay'} if exists $opts{'retry-delay'}; push @cmd_args, '--retry-connrefused' if exists $opts{'retry-connrefused'}; if ( exists $opts{'no-check-certificate'} && $opts{'no-check-certificate'} ) { push @cmd_args, '--no-check-certificate'; } else { my $ca_file = _get_mozilla_ca_file(); if ($ca_file) { push @cmd_args, "--ca-certificate=$ca_file"; } } push @cmd_args, '-O'; push @cmd_args, exists $opts{'output-file'} ? $opts{'output-file'} : '-'; push @cmd_args, $url; return @cmd_args; } sub _execute_download_tool { my ( $bin, @cmd_args ) = @_; if ( _try_load_saferun_object() ) { return _run_with_saferun_object( $bin, @cmd_args ); } elsif ( _try_load_ipc_open3() ) { return _run_with_ipc_open3( $bin, @cmd_args ); } else { die "Unable to find a suitable method to fetch the URL\n"; } return; } sub _try_load_saferun_object { eval { require Cpanel::SafeRun::Object; }; return $@ ? 0 : 1; } sub _try_load_ipc_open3 { eval { require IPC::Open3; }; return $@ ? 0 : 1; } sub _run_with_saferun_object { my ( $bin, @cmd_args ) = @_; my $run = Cpanel::SafeRun::Object->new( program => $bin, args => \@cmd_args, ); if ( !$run ) { die "Failed to invoke $bin binary."; } my $rc = $run->CHILD_ERROR() >> 8; if ( $rc != 0 ) { my $full_command = $bin . ' ' . join ' ', @cmd_args; my $stderr = "Error encountered while running $full_command command: " . $run->stderr(); die $stderr; } my $stdout = $run->stdout(); return $stdout; } sub _run_with_ipc_open3 { my ( $bin, @cmd_args ) = @_; my ( $out_fh, $err_fh ); my $pid = IPC::Open3::open3( undef, $out_fh, $err_fh, $bin, @cmd_args ); waitpid( $pid, 0 ); if ($?) { my $full_command = $bin . ' ' . join ' ', @cmd_args; my $stderr = "Error encountered while running $full_command command: "; while ( my $line = <$err_fh> ) { $stderr .= $line; } die $stderr; } my $stdout; while ( my $line = <$out_fh> ) { $stdout .= $line; } return $stdout; } 1; } # --- END Cpanel/SecureDownload.pm { # --- BEGIN Cpanel/Crypt/GPG/VendorKeys.pm package Cpanel::Crypt::GPG::VendorKeys; use strict; use warnings; no warnings 'once'; # use Cpanel::Crypt::GPG::Import::Temp (); # perlpkg line 211 # use Cpanel::CachedDataStore (); # perlpkg line 211 # use Cpanel::SecureDownload (); # perlpkg line 211 our $VERSION = 1; sub _get_config_file { return '/var/cpanel/gpg/vendorkeys.yaml'; } sub _get_vendor_keys { return Cpanel::CachedDataStore::fetch_ref( _get_config_file() ); } sub _save_vendor_keys { my ($vk_ref) = @_; require File::Basename; my $keydir = File::Basename::dirname( _get_config_file() ); if ( !-d $keydir ) { require Cpanel::SafeDir::MK; Cpanel::SafeDir::MK::safemkdir( $keydir, 0700 ); } return Cpanel::CachedDataStore::savedatastore( _get_config_file(), { mode => 0600, data => $vk_ref } ); } sub set_keys { my (%args) = @_; $args{interval} = defined( $args{interval} ) ? $args{interval} : 86400; # 1 day, in seconds. $args{enabled} = defined( $args{enabled} ) ? $args{enabled} : 1; for my $a (qw{vendor category url keys}) { if ( !$args{$a} ) { return wantarray ? ( undef, "Argument '$a' is required." ) : undef; } } my %new_keys; my @ckeys = ( ref( $args{keys} ) eq 'ARRAY' ) ? @{ $args{keys} } : ( $args{keys} ); my $gpg = Cpanel::Crypt::GPG::Import::Temp->new(); if ( !$gpg ) { return wantarray ? ( undef, "Failed to create GPG object." ) : undef; } for my $ckey (@ckeys) { while ( $ckey =~ /(-----BEGIN PGP PUBLIC KEY BLOCK-----.*?-----END PGP PUBLIC KEY BLOCK-----)/gs ) { my $skey = $1; my ( $key_id, $msg ) = $gpg->get_key_id( key => $skey ); if ( !$key_id ) { return wantarray ? ( undef, $msg ) : undef; } $new_keys{$key_id} = $skey; } } if ( !keys %new_keys ) { return wantarray ? ( undef, "No valid keys found." ) : undef; } my $vk_ref = _get_vendor_keys(); $vk_ref->{ $args{vendor} }->{ $args{category} } = { url => $args{url}, keychain => \%new_keys, enabled => $args{enabled}, interval => $args{interval}, noverify => $args{noverify}, last_updated => _get_current_time(), }; $vk_ref->{__VERSION} = $VERSION; if ( _save_vendor_keys($vk_ref) ) { return wantarray ? ( 1, 'Success' ) : 1; } return wantarray ? ( undef, "Failed to save key store." ) : undef; } sub _get_current_time { return int(time); } sub set_keys_from_url { my (%args) = @_; for my $a (qw{vendor category url}) { if ( !$args{$a} ) { return wantarray ? ( undef, "Argument '$a' is required." ) : undef; } } my $url = $args{url}; if ( ( !$args{noverify} ) && ( $url !~ /^https:\/\//i ) ) { return wantarray ? ( undef, "URL must use SSL." ) : undef; } my ( $ret, $download_data ) = Cpanel::SecureDownload::fetch_url( $url, ( 'timeout' => 60, 'no-check-certificate' => $args{noverify} ) ); if ( !$ret ) { return wantarray ? ( undef, $download_data ) : undef; } my ( $success, $msg ) = set_keys( vendor => $args{vendor}, category => $args{category}, url => $args{url}, keys => $download_data, enabled => $args{enabled}, interval => $args{interval}, noverify => $args{noverify}, ); if ( !$success ) { return wantarray ? ( undef, "Failure when adding key: $msg" ) : undef; } return wantarray ? ( 1, "Successfully added key." ) : 1; } sub get_keys { my (%args) = @_; if ( !$args{vendor} ) { return wantarray ? ( undef, "Argument 'vendor' is required." ) : undef; } if ( !( $args{category} || $args{categories} ) ) { return wantarray ? ( undef, "Argument 'category' or 'categories' is required." ) : undef; } if ( $args{category} && $args{categories} ) { return wantarray ? ( undef, "Both argument 'category' and 'categories' can not be used simultaneously." ) : undef; } my $argcat = $args{category} || $args{categories}; my @cats = ( ref($argcat) eq 'ARRAY' ) ? @{$argcat} : ($argcat); my $vk_ref = _get_vendor_keys(); if ( !$vk_ref->{ $args{vendor} } ) { return wantarray ? ( undef, "Keys for vendor '" . $args{vendor} . "' not found." ) : undef; } my %keys; for my $cat (@cats) { if ( !$vk_ref->{ $args{vendor} }->{$cat} ) { next; # skip over non-existent categories } if ( !$vk_ref->{ $args{vendor} }->{$cat}->{enabled} ) { next; # skip over disabled keychains } for my $key ( keys %{ $vk_ref->{ $args{vendor} }->{$cat}->{keychain} } ) { $keys{$key} = $vk_ref->{ $args{vendor} }->{$cat}->{keychain}->{$key}; } } return \%keys; } sub get_key_info { my ($keyid) = @_; my $keys = _get_vendor_keys(); foreach my $vendor ( keys %{$keys} ) { if ( index( $vendor, '__' ) == 0 ) { next; } foreach my $type ( keys %{ $keys->{$vendor} } ) { return ( $vendor, $type ) if grep { $keyid eq $_ } keys %{ $keys->{$vendor}->{$type}->{keychain} }; } } return ( 'UNKNOWN', 'UNKNOWN' ); } sub download_public_keys { my %opts = @_; require Cpanel::Logger; $opts{logger} ||= Cpanel::Logger->new(); my $warn = $opts{logger}->can("warn") ? 'warn' : 'warning'; my $error = $opts{logger}->can("error") ? 'error' : 'warn'; if ( $opts{noverify} ) { $opts{logger}->info("WARNING: Hostname verification is disabled!"); $opts{logger}->info("Can not ensure the legitimacy of downloaded keys."); } my $vk_ref = _get_vendor_keys(); my %update_keys; for my $vendor ( grep { index( $_, '__' ) != 0 } keys %{$vk_ref} ) { for my $category ( keys %{ $vk_ref->{$vendor} } ) { $update_keys{$vendor}->{$category}->{url} = $vk_ref->{$vendor}->{$category}->{url}; $update_keys{$vendor}->{$category}->{noverify} = $vk_ref->{$vendor}->{$category}->{noverify}; } } for my $key ( @{ _get_pubkey_defaults() } ) { my $vendor = $key->{vendor}; my $category = $key->{category}; my $url = $key->{url}; my $noverify = $key->{noverify}; $update_keys{$vendor}->{$category}->{url} = $url; $update_keys{$vendor}->{$category}->{noverify} = $noverify; } my @update_keys_list; for my $vendor ( keys %update_keys ) { for my $category ( keys %{ $update_keys{$vendor} } ) { my $key = { vendor => $vendor, category => $category, url => $update_keys{$vendor}->{$category}->{url}, noverify => $update_keys{$vendor}->{$category}->{noverify}, }; push @update_keys_list, $key; } } my $keys; if ( $opts{keys} ) { $keys = $opts{keys}; } else { $keys = \@update_keys_list; } my $success = 1; for my $key ( @{$keys} ) { my $interval = $vk_ref->{ $key->{vendor} }->{ $key->{category} }->{interval} || 0; my $last_updated = $vk_ref->{ $key->{vendor} }->{ $key->{category} }->{last_updated} || 0; my $current_time = _get_current_time(); next if ( !$opts{force} && defined $vk_ref->{__VERSION} && $vk_ref->{__VERSION} == $VERSION && $current_time <= ( $interval + $last_updated ) && $current_time >= $last_updated ); my ( $succ, $msg ) = set_keys_from_url( vendor => $key->{vendor}, category => $key->{category}, url => $key->{url}, noverify => $key->{noverify} || $opts{noverify}, ); if ($succ) { $opts{logger}->info("Retrieved public key from vendor: $key->{vendor}, category: $key->{category}, url: $key->{url}"); } else { $opts{logger}->$warn("Unable to download public key from vendor: $key->{vendor}, category: $key->{category}, url: $key->{url}"); $opts{logger}->info($msg); $success = 0; } } if ( !$success ) { $opts{logger}->$warn("Failed to download all specified public keys."); } return $success; } sub _get_pubkey_defaults { return [ { url => 'https://securedownloads.cpanel.net/cPanelPublicKey.asc', vendor => 'cpanel', category => 'release', }, { url => 'https://securedownloads.cpanel.net/cPanelDevelopmentKey.asc', vendor => 'cpanel', category => 'development', }, ]; } 1; } # --- END Cpanel/Crypt/GPG/VendorKeys.pm { # --- BEGIN Cpanel/Crypt/GPG/VendorKeys/TimestampCache.pm package Cpanel::Crypt::GPG::VendorKeys::TimestampCache; use strict; use warnings; no warnings 'once'; # use Cpanel::CachedDataStore (); # perlpkg line 211 sub _cache_file { return '/var/cpanel/gpg/timestamp.cache'; } sub new { my ($obj) = @_; my $self = {}; bless $self, $obj; $self->{'cache'} = _load_cache(); return $self; } sub _load_cache { return Cpanel::CachedDataStore::fetch_ref( _cache_file() ); } sub _save_cache { my ($cache_data) = @_; return Cpanel::CachedDataStore::savedatastore( _cache_file(), { mode => 0600, data => $cache_data } ); } sub update_cache { my ( $self, %args ) = @_; return 0 if !$args{'mirror'} || !$args{'url'}; $self->{'cache'}->{ $args{'mirror'} }{ $args{'url'} } = { date_downloaded => time, signature_date => $args{'create_time'} }; return _save_cache( $self->{'cache'} ); } sub check_cache_for_rollback { my ( $self, %args ) = @_; my $cached_time = $self->{'cache'}->{ $args{'mirror'} }{ $args{'url'} }{'signature_date'}; my $new_time = $args{'create_time'}; if ( defined $cached_time && $cached_time > $new_time ) { return 1; } else { return 0; } } sub cleanup_signature_cache { my ( $self, %args ) = @_; my $valid_time_window = exists $args{'valid_time_window'} ? $args{'valid_time_window'} : 7776000; my $current_time = time; my $cache = $self->{'cache'}; foreach my $mirror ( keys %{ $self->{'cache'} } ) { foreach my $file ( keys %{ $self->{'cache'}{$mirror} } ) { delete $cache->{$mirror}{$file} if $current_time - $self->{'cache'}{$mirror}{$file}{'date_downloaded'} >= $valid_time_window; } delete $cache->{$mirror} if !scalar keys %{ $cache->{$mirror} }; } return _save_cache($cache); } 1; } # --- END Cpanel/Crypt/GPG/VendorKeys/TimestampCache.pm { # --- BEGIN Cpanel/Crypt/GPG/VendorKeys/Verify.pm package Cpanel::Crypt::GPG::VendorKeys::Verify; use strict; # use Cpanel::Crypt::GPG::Import::Temp (); # perlpkg line 211 # use Cpanel::Crypt::GPG::VendorKeys (); # perlpkg line 211 # use Cpanel::Crypt::GPG::VendorKeys::TimestampCache (); # perlpkg line 211 sub new { my ( $class, %args ) = @_; if ( !$args{vendor} ) { return _result( undef, "Argument 'vendor' is required." ); } if ( !( $args{category} || $args{categories} ) ) { return _result( undef, "Argument 'category' or 'categories' is required." ); } if ( $args{category} && $args{categories} ) { return _result( undef, "Both argument 'category' and 'categories' can not be used simultaneously." ); } my $argcat = $args{category} || $args{categories}; my $keys = Cpanel::Crypt::GPG::VendorKeys::get_keys( vendor => $args{vendor}, category => $argcat ); if ( !keys %{$keys} ) { return _result( undef, "No keys found for vendor '" . $args{vendor} . "'" ); } my ( $pgp, $msg ) = Cpanel::Crypt::GPG::Import::Temp->new(); if ( !$pgp ) { return _result( undef, $msg ); } for my $key_id ( keys %{$keys} ) { my ( $success, $msg ) = $pgp->add_pub_key( key => $keys->{$key_id} ); if ( !$success ) { return _result( undef, "Failed to add key '$key_id' : " . $msg ); } } my $obj = { vendor => $args{vendor}, categories => ( ref($argcat) eq 'ARRAY' ) ? $argcat : [$argcat], keys => $keys, pgp => $pgp, }; bless $obj, $class; return _result( $obj, "Success" ); } sub files { my ( $self, %args ) = @_; if ( !( $args{sig} || $args{sig_data} ) ) { return _result( undef, "Arguments 'sig' or 'sig_data' must be provided." ); } if ( !( $args{files} || defined( $args{files_data} ) ) ) { return _result( undef, "Arguments 'files' or 'files_data' must be provided." ); } my ( $s, $m ) = $self->{pgp}->verify(%args); if ( !$s ) { return _result( $s, $m ); } ( $s, $m ) = _check_filename( $s, $m, \%args ); if ( !$s ) { return _result( $s, $m ); } ( $s, $m ) = _check_rollback( $s, $m, \%args ); if ( !$s ) { return _result( $s, $m ); } $m = "Successfully verified signature for " . $self->{vendor} . " (key types: " . join( ", ", @{ $self->{categories} } ) . ")."; return _result( $s, $m ); } sub _check_rollback { my ( $sig_data, $message, $args ) = @_; my $sig_cache = Cpanel::Crypt::GPG::VendorKeys::TimestampCache->new(); my $rollback = $sig_cache->check_cache_for_rollback( mirror => $args->{mirror}, url => $args->{url}, create_time => $sig_data->{create_time}, ); if ($rollback) { return _result( undef, 'Signature rollback detected.' ); } else { $sig_cache->update_cache( mirror => $args->{mirror}, url => $args->{url}, create_time => $sig_data->{create_time}, ); return _result( $sig_data, $message ); # Everything ok, pass data through to next check. } } sub _check_filename { my ( $sig_data, $message, $args ) = @_; if ( defined( $sig_data->{'notations'} ) && defined( $sig_data->{'notations'}->{'filename@gpg.notations.cpanel.net'} ) ) { my $file_note = $sig_data->{'notations'}->{'filename@gpg.notations.cpanel.net'}; my $url = $args->{url}; $url =~ s/\.bz2$//; if ( $file_note eq $url ) { return _result( $sig_data, $message ); # Everything ok, pass data through to next check. } else { return _result( undef, 'Filename notation (' . $file_note . ') does not match URL (' . $url . ').' ); } } else { return _result( undef, 'Signature does not contain a filename notation.' ); } } sub _result { my ( $success, $message ) = @_; return wantarray ? ( $success, $message ) : $success; } 1; } # --- END Cpanel/Crypt/GPG/VendorKeys/Verify.pm { # --- BEGIN Cpanel/HttpRequest.pm package Cpanel::HttpRequest; use strict; use warnings; no warnings 'once'; # use Cpanel::ArrayFunc::Shuffle (); # perlpkg line 211 # use Cpanel::Crypt::GPG::Settings (); # perlpkg line 211 # use Cpanel::FileUtils::Copy (); # perlpkg line 211 # use Cpanel::Hostname (); # perlpkg line 211 # use Cpanel::Debug (); # perlpkg line 211 # use Cpanel::Rand::Get (); # perlpkg line 211 # use Cpanel::SocketIP (); # perlpkg line 211 # use Cpanel::URL (); # perlpkg line 211 # use Cpanel::UrlTools (); # perlpkg line 211 # use Cpanel::Encoder::Tiny (); # perlpkg line 211 # use Cpanel::HTTP::Tiny::FastSSLVerify (); # perlpkg line 211 use Socket (); our $DEFAULT_TIMEOUT = 260; our $SIMULATE_FAILURE = 0; our $DEBUG = 0; our $VERSION = '3.0'; our $MAX_CONTENT_SIZE = ( 1024 * 1024 * 1024 * 1024 ); our $HTTP_RETRY_COUNT = 12; our $SIGNATURE_RETRY_COUNT = 4; our $MAX_RESOLVE_ATTEMPT = 65; my $buffer_size = 131070; my $has_cpanel_dnsRoots = 0; sub new { my ( $obj, %OPTS ) = @_; my $self = bless {}, $obj; $self->{'connectedHostAddress'} = ''; #ip of connected host $self->{'connectedHostname'} = ''; #hostname of connected host $self->{'connectedHostFailCount'} = {}; $self->{'connected'} = 0; $self->{'http_retry_count'} = $OPTS{'http_retry_count'} || $HTTP_RETRY_COUNT; $self->{'use_dns_cache'} = exists $OPTS{'use_dns_cache'} ? int $OPTS{'use_dns_cache'} : 1; #on by default $self->{'retry_dns'} = exists $OPTS{'retry_dns'} ? $OPTS{'retry_dns'} : 1; $self->{'use_mirror_addr_list'} = $OPTS{'use_mirror_addr_list'} || 0; $self->{'hideOutput'} = $OPTS{'hideOutput'} && $OPTS{'hideOutput'} eq '1' ? 1 : 0; $self->{'htmlOutput'} = $OPTS{'htmlOutput'} || 0; $self->{'dns_cache_ttl'} = exists $OPTS{'dns_cache_ttl'} ? int $OPTS{'dns_cache_ttl'} : 7200; $self->{'mirror_search_attempts'} = {}; $self->{'last_status'} = undef; $self->{'last_modified'} = undef; $self->{'die_on_404'} = $OPTS{'die_on_404'} || 0; $self->{'die_on_4xx_5xx'} = $OPTS{'die_on_4xx_5xx'} || 0; $self->{'die_on_error'} = $OPTS{'die_on_error'} || 0; $self->{'return_on_404'} = $OPTS{'return_on_404'} || 0; $self->{'return_on_error'} = $OPTS{'return_on_error'} || 0; $self->{'protocol'} = $OPTS{'protocol'} || 0; $self->{'timeout'} = $OPTS{'timeout'} || $DEFAULT_TIMEOUT; $self->{'level'} = 0; $self->{'logger'} = $OPTS{'logger'}; if ( !$self->{'logger'} ) { require Cpanel::Logger; $self->{'logger'} = Cpanel::Logger->new(); } $self->{'announce_mirror'} = $OPTS{'announce_mirror'}; $self->{'signed'} = $OPTS{'signed'}; $self->{'vendor'} = $OPTS{'vendor'} || 'cpanel'; $self->{'categories'} = $OPTS{'categories'} || Cpanel::Crypt::GPG::Settings::default_key_categories(); $self->{'signature_validation'} = $OPTS{'signature_validation'} || Cpanel::Crypt::GPG::Settings::signature_validation_enabled(); $self->{'signature_retry_count'} = $OPTS{'signature_retry_count'} || $SIGNATURE_RETRY_COUNT; $self->{'speed_test_enabled'} = exists $OPTS{'speed_test_enabled'} ? int( $OPTS{'speed_test_enabled'} ) : 1; $self->{'speed_test_file'} = $OPTS{'speed_test_file'} || '/speedcheck'; $self->{'sig_data'} = undef; return $self; } sub _output { my ( $self, $str ) = @_; return if $self->{'hideOutput'}; if ( $self->{'htmlOutput'} ) { $str = Cpanel::Encoder::Tiny::safe_html_encode_str($str); $str =~ s/\n/<br>/g; } return print $str; } sub request { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $self, %OPTS ) = @_; $OPTS{'uncompress'} = 1 if ( defined $OPTS{'uncompress_bzip2'} && length $OPTS{'uncompress_bzip2'} && $OPTS{'url'} =~ m{\.bz2$} ); my $check_signature = defined $OPTS{'signed'} ? $OPTS{'signed'} : $self->{'signed'}; my $uncompress = ( defined $OPTS{'uncompress'} && length $OPTS{'uncompress'} && $OPTS{'uncompress'} && $OPTS{'url'} =~ m/\.(bz2|xz)$/ ); if ( !$self->{'signature_validation'} ) { $check_signature = undef; } if ( Cpanel::Hostname::gethostname() =~ /^(autobuild|perlcc).*\.dev\.cpanel\.net$/ ) { $check_signature = undef; } if ( !$check_signature ) { return $self->_request_file(%OPTS); } my ( $gpg, $gpg_msg ) = $self->get_crypt_gpg_vendorkey_verify( vendor => $OPTS{'vendor'}, categories => $OPTS{'categories'} ); if ( !$gpg ) { $self->_sigerror_die("Failed to create gpg object: $gpg_msg"); } my $destfile = $OPTS{'destfile'}; my $file_url = $OPTS{'url'}; my $signature_url; if ( $OPTS{'signature_url'} ) { $signature_url = $OPTS{'signature_url'}; } elsif ($destfile) { $signature_url = $file_url; $signature_url =~ s/\.bz2$//; # xz files are not signed $signature_url = $signature_url . '.asc'; } else { $signature_url = $file_url . '.asc'; } my $signature_validation_failures = 0; my $signature_hostaddr; my $basefile_hostaddr; my $verification_data; my $verification_message; while ( $signature_validation_failures++ < $self->{'signature_retry_count'} ) { $OPTS{'url'} = $signature_url; delete $OPTS{'destfile'}; my $signature_data = $self->_request_file(%OPTS); if ( !$signature_data ) { $self->_die( "Failed to download signature at URL 'http://" . $OPTS{'host'} . $signature_url . "'." ); } $signature_hostaddr = $self->{'connectedHostAddress'}; if ($destfile) { if ( !$uncompress && $destfile =~ /\.(bz2|xz)$/ ) { my $compressed_ext = $1; my $basename = $destfile; $basename =~ s/\.\Q$compressed_ext\E$//; my $tmp_file_a = $basename . '_' . Cpanel::Rand::Get::getranddata(8) . ".$compressed_ext"; my $tmp_file_b = $basename . '_' . Cpanel::Rand::Get::getranddata(8) . ".$compressed_ext"; $OPTS{'url'} = $file_url; $OPTS{'destfile'} = $tmp_file_a; my $req = $self->_request_file(%OPTS); if ( !$req ) { $self->_die( "Failed to download file at URL 'http://" . $OPTS{'host'} . $file_url . "'." ); } $basefile_hostaddr = $self->{'connectedHostAddress'}; my $copy = Cpanel::FileUtils::Copy::safecopy( $tmp_file_a, $tmp_file_b ); if ( !$copy ) { unlink $tmp_file_a; $self->_die("Failed to make working copy of downloaded file."); } if ( $compressed_ext eq 'bz2' ) { require Cpanel::Sync::Common; Cpanel::Sync::Common::unbzip2($tmp_file_b); $tmp_file_b =~ s/\.bz2$//; } elsif ( $compressed_ext eq 'xz' ) { require Cpanel::SafeRun::Simple; Cpanel::SafeRun::Simple::saferun( qw{ unxz -f }, $tmp_file_b ) and die "failed to extract '$tmp_file_b': $!"; } ( $verification_data, $verification_message ) = $gpg->files( files => $tmp_file_b, sig_data => $signature_data, mirror => $OPTS{'host'}, url => $file_url ); if ($verification_data) { $self->{'logger'}->info($verification_message); $self->{'sig_data'} = $verification_data; unlink $destfile; rename $tmp_file_a, $destfile; unlink $tmp_file_b; return wantarray ? ($req) : $req; } else { unlink $tmp_file_a; unlink $tmp_file_b; } } else { my $tmp_file = $destfile . '_' . Cpanel::Rand::Get::getranddata(8); $OPTS{'url'} = $file_url; $OPTS{'destfile'} = $tmp_file; my $req = $self->_request_file(%OPTS); if ( !$req ) { $self->_die( "Failed to download file at URL 'http://" . $OPTS{'host'} . $file_url . "'." ); } $basefile_hostaddr = $self->{'connectedHostAddress'}; ( $verification_data, $verification_message ) = $gpg->files( files => $tmp_file, sig_data => $signature_data, mirror => $OPTS{'host'}, url => $file_url ); if ($verification_data) { $self->{'logger'}->info($verification_message); $self->{'sig_data'} = $verification_data; unlink $destfile; rename $tmp_file, $destfile; return wantarray ? ($req) : $req; } else { unlink $tmp_file; } } } else { $OPTS{'url'} = $file_url; my ( $file_data, $complete ) = $self->_request_file(%OPTS); if ( !$complete ) { $self->_die( "Failed to download URL 'http://" . $OPTS{'host'} . $file_url . "'." ); } $basefile_hostaddr = $self->{'connectedHostAddress'}; ( $verification_data, $verification_message ) = $gpg->files( files_data => $file_data, sig_data => $signature_data, mirror => $OPTS{'host'}, url => $file_url ); if ($verification_data) { $self->{'logger'}->info($verification_message); $self->{'sig_data'} = $verification_data; return wantarray ? ( $file_data, $complete ) : $file_data; } } $self->_output("Signature verification failed using file from IP ${basefile_hostaddr} and signature from IP ${signature_hostaddr}"); if ( $basefile_hostaddr eq $signature_hostaddr ) { $self->_skip_failed_mirror(); $self->disconnect(); } else { $self->_output("...retrying ${basefile_hostaddr}..."); } $self->_output("\n"); } $self->_sigerror_die( "Signature verification failed for URL 'http://" . $OPTS{'host'} . $file_url . "'. ${verification_message}" ); return 1; } sub _fetcher { my ( $self, $timeout, %params ) = @_; my $fetcher = $self->{fetcher}; return Cpanel::HTTP::Tiny::FastSSLVerify->new( timeout => $timeout, %params ) if !$fetcher || $fetcher->{timeout} != $timeout; return $fetcher; } sub _request_file { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $self, %OPTS ) = @_; my $host = $OPTS{'host'}; my $url = $OPTS{'url'}; my $destfile = $OPTS{'destfile'} || ''; my $http_retry_count = $OPTS{'http_retry_count'} || $self->{'http_retry_count'}; my $uncompress = ( defined $OPTS{'uncompress'} && length $OPTS{'uncompress'} && $OPTS{'uncompress'} && $OPTS{'url'} =~ m/\.(bz2|xz)$/ ); my $uncompress_ext = $uncompress ? $1 : undef; my $compress_raw_bzip2_obj; my $compress_raw_lzma_obj; my $fetcher = $self->{fetcher} = $self->_fetcher( $self->{'timeout'} ); if ($uncompress) { require Cpanel::Sync::Common; if ( !$Cpanel::Sync::Common::hasbzip2 && $uncompress_ext eq 'bz2' ) { $destfile .= '.bz2'; } } my $complete = 0; my $page = ''; my $quiet = $self->{'hideOutput'} || 0; $url =~ tr/\///s; # squash duplicate "/" ( $host, $OPTS{'port'} ) = split /:/, $host, 2 if !defined $OPTS{'port'} && $host =~ tr/://; die '[ARGUMENT] a host must be specified at ' . (caller)[0] . ' line ' . (caller)[2] . "\n" if !$host; die '[ARGUMENT] a URL must be specified at ' . (caller)[0] . ' line ' . (caller)[2] . "\n" if !$url; print STDERR "[request] $host/$url\n" if $DEBUG; $url = "/$url" unless $url =~ m{^/}; my $full_url = "http://$host" . ( $OPTS{'port'} ? ":$OPTS{'port'}" : "" ) . "$url"; $self->_output( ( "\t" x $self->{'level'}++ ) . "Fetching $full_url (connected:" . $self->{'connected'} . ')....' ); my $fh; my $addresses = $OPTS{'addresslist'}; { my $httptrycount = 0; HTTP_TRY: while ( !$complete && $httptrycount < $http_retry_count ) { # should be < then because we increment in the loop ++$httptrycount; if ($uncompress) { require Cpanel::Sync::Common; if ( $Cpanel::Sync::Common::hasbzip2 && $uncompress_ext eq 'bz2' ) { ($compress_raw_bzip2_obj) = Compress::Raw::Bunzip2->new( $Cpanel::Sync::Common::BZIP2_OVERWRITE_OUTPUT, $Cpanel::Sync::Common::BZIP2_CONSUME_INPUT ); } elsif ( $Cpanel::Sync::Common::haslzma && $uncompress_ext eq 'xz' ) { ($compress_raw_lzma_obj) = Compress::Raw::Lzma::StreamDecoder->new(); } } $self->_output("...(request attempt $httptrycount/$http_retry_count)..."); my $method = $OPTS{'method'} || 'GET'; my %reqargs; $reqargs{'headers'} = _convert_headers( $OPTS{'headers'} || {} ); $reqargs{'content'} = $OPTS{'body'} if $OPTS{'body'}; if ( length $destfile ) { my $callback; open( $fh, '>', $destfile ) or die "Can't open file: $!"; if ($compress_raw_bzip2_obj) { $callback = sub { my $status = $compress_raw_bzip2_obj->bzinflate( $_[0], my $output ); if ( $status != $Cpanel::Sync::Common::BZ_OK && $status != $Cpanel::Sync::Common::BZ_STREAM_END || !defined($output) ) { die "Decompressing chunked bzip2 data from $url to $destfile failed: $status"; } print {$fh} $output; }; } elsif ($compress_raw_lzma_obj) { $callback = sub { my $status = $compress_raw_lzma_obj->code( $_[0], my $output ); if ( $status != $Cpanel::Sync::Common::LZMA_OK && $status != $Cpanel::Sync::Common::LZMA_STREAM_END || !defined($output) ) { die "Decompressing chunked lzma data from $url to $destfile failed: $status"; } print {$fh} $output; }; } else { $callback = sub { print {$fh} $_[0]; }; } $reqargs{'data_callback'} = $callback; } else { $reqargs{'data_callback'} = sub { $page .= $_[0]; }; } my $actual_url = $self->_initrequest( host => $host, url => $url, port => $OPTS{'port'}, headers => $reqargs{'headers'}, addresslist => $OPTS{'addresslist'}, attempt => $httptrycount, max_attempts => $http_retry_count, destfile => $destfile, ) or next HTTP_TRY; $reqargs{'peer'} = $self->{'connectedHostAddress'}; $self->_output('...receiving...'); my $response = eval { $fetcher->request( $method, $actual_url, \%reqargs ); }; $response = { status => 599 } if $@; if ( $self->{die_on_4xx_5xx} && $response && $response->{status} =~ /^[45]/ ) { require Cpanel::Exception; die Cpanel::Exception::create( 'HTTP::Server', [ method => $method, url => $actual_url, status => $response->{status}, reason => $response->{reason}, headers => $response->{headers}, content => $response->{content}, ] ); } $complete = ( $response->{status} =~ /^2\d\d$/ ? 1 : 0 ); my $status = $self->{last_status} = $response->{status}; my $httpline = "$status $response->{reason}"; if ($complete) { my $lm = $response->{'headers'} ? $response->{'headers'}{'last-modified'} : undef; $lm = $lm->[-1] if ref $lm eq 'ARRAY'; $self->{'last_modified'} = $lm; } if ( $status == 304 ) { $self->_output("...not modified..."); $self->{'connected'} = 1; $self->{'level'}--; return q{}; } if ( $response->{status} == 599 ) { my $error = $response->{content}; chomp $error; $self->_output("...$error..."); $self->{'connected'} = 0; $self->_skip_failed_mirror(); next HTTP_TRY; } if ( $status !~ /^2/ ) { $self->_output("Error $status while fetching URL $full_url\n"); if ( length $destfile ) { close($fh); unlink $destfile; } $self->{'last_exception'} = "$status - $httpline - HTTP ERROR"; } if ($complete) { $self->{'connectedHostFailCount'}{ $self->{'connectedHostAddress'} } = 0; } else { $self->disconnect(); if ( ++$self->{'connectedHostFailCount'}{ $self->{'connectedHostAddress'} } < 3 ) { $self->_output("...server closed connection (failcount=$self->{'connectedHostFailCount'}{$self->{'connectedHostAddress'}})..."); if ( $self->{'last_exception'} && $self->{'last_exception'} =~ m{HTTP ERROR} ) { $self->_skip_failed_mirror(); } } else { $self->_output("...failover..."); $self->_remove_failed_mirror(); } if ( $self->{'last_status'} eq '404' && grep { $_->{'die_on_404'} } $self, \%OPTS ) { local $@ = $self->{'last_exception'}; die; } elsif ( $self->{'last_status'} eq '404' && grep { $_->{'return_on_404'} } $self, \%OPTS ) { $self->{'level'}--; return wantarray ? ( '', 0 ) : 0; } elsif ( $self->{'last_status'} eq '404' && grep { $_->{'exitOn404'} } $self, \%OPTS ) { $self->_output("...Distribution not required.\n"); exit; } } } } if ( !$complete && grep { $_->{'die_on_error'} } $self, \%OPTS ) { local $@ = $self->{'last_exception'}; die; } $self->_output("...request success...") if $complete; $self->_output("...Done\n"); if ( length $destfile ) { close($fh); if ( !$uncompress ) { } elsif ( !$Cpanel::Sync::Common::hasbzip2 && $uncompress_ext eq 'bz2' ) { Cpanel::Sync::Common::unbzip2($destfile); } elsif ( !$Cpanel::Sync::Common::haslzma && $uncompress_ext eq 'xz' ) { my $suffix = "__DEFLATE__$$"; rename $destfile, "$destfile.$suffix.xz" or die "Failed to rename temporary file '$destfile' to '$destfile.$suffix.xz': $!"; require Cpanel::SafeRun::Simple; Cpanel::SafeRun::Simple::saferun( 'unxz', '-f', "$destfile.$suffix.xz" ) and die "Failed to decompress XZ data from '$destfile'"; rename "$destfile.$suffix", $destfile or die "Failed to rename decompressed temporary file '$destfile.$suffix' to '$destfile': $!"; } } if ( $complete == 0 ) { $self->disconnect(); $self->{'fetcher'} = $fetcher = undef; } else { $self->{'connected'} = 1; } $self->{'level'}--; if ( length $destfile ) { return wantarray ? ($complete) : $complete; } return wantarray ? ( $page, $complete ) : $page; } sub disconnect { my ($self) = @_; $self->_socket_destroy(); return $self->{'connected'} = 0; } sub last_status { my ($self) = @_; return $self->{'last_status'}; } sub last_modified { my ($self) = @_; return $self->{'last_modified'}; } sub is_unmodified { my ( $self, %opts ) = @_; return 0 unless length $opts{'last_modified'}; my $ok = eval { my $alarm; if ( $opts{'timeout'} ) { require Cpanel::Alarm; $alarm = Cpanel::Alarm->new( $opts{'timeout'}, sub { die "Timeout during conditional request.\n" } ); } $self->request( 'host' => $opts{'host'}, 'url' => $opts{'url'}, 'headers' => { 'If-Modified-Since' => $opts{'last_modified'} }, ); 1; }; return ( $ok && ( $self->last_status() // 0 ) == 304 ) ? 1 : 0; } sub make_http_query_string { my ($query) = @_; return $query unless ref $query; # If query is a string, return it. require Cpanel::Encoder::URI; my ( $querystr, $delim, $enckey ) = ( '', '' ); if ( ref $query eq 'ARRAY' ) { if ( @{$query} & 1 ) { Cpanel::Debug::log_invalid('Query key with no value.'); return; } my $val; for ( my $i = 0; $i < $#{$query}; $i += 2 ) { ( $enckey, $val ) = ( Cpanel::Encoder::URI::uri_encode_str( $query->[$i] ), $query->[ $i + 1 ] ); next unless $enckey; #if we don't have a key, ignore it if ( ref $val eq 'ARRAY' ) { $querystr .= $delim . join( '&', map { "$enckey=" . ( Cpanel::Encoder::URI::uri_encode_str($_) // '' ) } @{$val} ); } else { $querystr .= "$delim$enckey=" . ( Cpanel::Encoder::URI::uri_encode_str($val) // '' ); } $delim ||= '&'; } } elsif ( ref $query eq 'HASH' ) { foreach my $key ( sort keys %{$query} ) { $enckey = Cpanel::Encoder::URI::uri_encode_str($key); next unless $enckey; #if we don't have a key, ignore it if ( ref $query->{$key} eq 'ARRAY' ) { $querystr .= $delim . join( '&', map { "$enckey=" . ( Cpanel::Encoder::URI::uri_encode_str($_) // '' ) } @{ $query->{$key} } ); } else { $querystr .= "$delim$enckey=" . ( Cpanel::Encoder::URI::uri_encode_str( $query->{$key} ) // '' ); } $delim ||= '&'; } } else { Cpanel::Debug::log_invalid('Unrecognized type for query parameter.'); return; } return $querystr; } sub http_post_req { my ( $self, $args_hr ) = @_; require Cpanel::Encoder::URI; my $query = $args_hr->{'query'}; if ( ref $args_hr->{'query'} eq 'HASH' ) { $query = ''; foreach my $key ( keys %{ $args_hr->{'query'} } ) { if ( ref $args_hr->{'query'}{$key} eq 'ARRAY' ) { for my $val ( @{ $args_hr->{'query'}{$key} } ) { $query .= $query ? "&$key=" . Cpanel::Encoder::URI::uri_encode_str($val) : "$key=" . Cpanel::Encoder::URI::uri_encode_str($val); } } else { $query .= $query ? "&$key=" . Cpanel::Encoder::URI::uri_encode_str( $args_hr->{'query'}{$key} ) : "$key=" . Cpanel::Encoder::URI::uri_encode_str( $args_hr->{'query'}{$key} ); } } } my $postdata_len = length($query); my $proto = getprotobyname('tcp'); return unless defined $proto; socket( my $socket_fh, &Socket::AF_INET, &Socket::SOCK_STREAM, $proto ); return unless $socket_fh; my $iaddr = gethostbyname( $args_hr->{'host'} ); my $port = $self->_socket_default_port(); return unless ( defined $iaddr && defined $port ); my $sin = Socket::sockaddr_in( $port, $iaddr ); return unless defined $sin; if ( connect( $socket_fh, $sin ) ) { send $socket_fh, "POST /$args_hr->{'uri'} HTTP/1.0\r\nContent-Length: $postdata_len\r\nHost: $args_hr->{'host'}\r\n\r\n$query", 0; if ( ref $args_hr->{'output_handler'} eq 'CODE' ) { my $in_header = 1; while (<$socket_fh>) { if ( /^\n$/ || /^\r\n$/ || /^$/ ) { $in_header = 0; next; } $args_hr->{'output_handler'}->( $_, $in_header ); } } } close $socket_fh; return; } sub download { my ( $self, $url, $file, $is_signed ) = @_; unlink $file if defined $file; $is_signed = defined $is_signed ? $is_signed : $self->{'signed'}; my $parsed_url = Cpanel::URL::parse($url); my $res = $self->request( 'host' => $parsed_url->{'host'}, 'url' => $parsed_url->{'uri'}, 'destfile' => $file, 'protocol' => 0, 'method' => 'GET', 'signed' => $is_signed, ); return $res; } sub http_request { my ( $self, $p_method, $p_host, $p_uri, %p_options ) = @_; die '[ARGUMENT] a host must be specified at ' . (caller)[0] . ' line ' . (caller)[2] . "\n" if !$p_host; die '[ARGUMENT] a URI must be specified at ' . (caller)[0] . ' line ' . (caller)[2] . "\n" if !$p_uri; my $method = $p_options{'method'} || $p_method; die '[ARGUMENT] a method must be specified at ' . (caller)[0] . ' line ' . (caller)[2] . "\n" if !$p_method; my $content_type = $p_options{'content_type'}; unlink $p_options{'file'} if defined $p_options{'file'}; my %OPTS = ( 'host' => $p_host, 'port' => $p_options{'port'}, 'url' => $p_uri, 'protocol' => 0, 'method' => $method, 'destfile' => $p_options{'file'} ); if ( defined $p_options{'content'} ) { $OPTS{'body'} = $p_options{'content'}; $content_type ||= 'text/plain'; } my %headers; %headers = %{ $p_options{'headers'} } if ref $p_options{'headers'} eq ref {}; $headers{'Content-Type'} = $content_type if $content_type; $OPTS{'headers'} = join( '', map { "$_: $headers{$_}\r\n" } keys %headers ) if keys %headers; return $self->request(%OPTS); } sub httpreq { my ( $self, $host, $url, $file, %p_options ) = @_; return $self->http_request( 'GET', $host, $url, 'file' => $file, %p_options ); } sub httpput { my ( $self, $host, $uri, $content, %p_options ) = @_; return $self->http_request( 'PUT', $host, $uri, 'content' => $content, %p_options ); } sub httppost { my ( $self, $host, $url, $qparms, $file, %p_options ) = @_; my $content; $content = make_http_query_string($qparms) if defined $qparms; return $self->http_request( 'POST', $host, $url, 'content' => $content, 'content_type' => 'application/x-www-form-urlencoded', 'file' => $file, %p_options ); } sub skiphost { my $self = shift; $self->disconnect(); $self->_remove_failed_mirror(); return; } sub _getAddressList { ## no critic(Subroutines::ProhibitExcessComplexity) -- Added with case SEC-398, out of scope for a TSR. my ( $self, $host, $port ) = @_; print STDERR "[_getAddressList][$host]\n" if $DEBUG; my $quiet = $self->{'hideOutput'} || 0; my $resolve_attempt_count = 1; my ( $cache_key, $homedir, @trueaddresses, $loaded_cache ); if ( $self->{'use_dns_cache'} ) { $homedir = ( getpwuid($>) )[7]; $cache_key = $host; $cache_key =~ s/\///g; if ( !-e $homedir . '/.HttpRequest' ) { mkdir $homedir . '/.HttpRequest', 0700; } if ( -e $homedir . '/.HttpRequest/' . $cache_key && ( ( stat(_) )[9] + $self->{'dns_cache_ttl'} ) > time() ) { if ( open( my $address_cache_fh, '<', $homedir . '/.HttpRequest/' . $cache_key ) ) { local $/; @trueaddresses = split( /\n/, readline($address_cache_fh) ); $loaded_cache = 1; close($address_cache_fh); $self->_output("Using dns cache file $homedir/.HttpRequest/$cache_key..."); } else { $self->_output("Loading dns cache file $homedir/.HttpRequest/$cache_key failed ($!)..."); } } } while ( !@trueaddresses ) { $loaded_cache = 0; $self->_output("Resolving $host...(resolve attempt $resolve_attempt_count/${MAX_RESOLVE_ATTEMPT})..."); @trueaddresses = Cpanel::SocketIP::_resolveIpAddress($host); last if (@trueaddresses); $self->_output("Resolving $host using backup method..."); eval 'require Cpanel::DnsRoots; $has_cpanel_dnsRoots=1' if !$has_cpanel_dnsRoots; @trueaddresses = 'Cpanel::DnsRoots'->can('resolveIpAddressBAMP')->($host) if $has_cpanel_dnsRoots; last if ( @trueaddresses || !$self->{'retry_dns'} || $resolve_attempt_count++ >= $MAX_RESOLVE_ATTEMPT ); $self->_output("Waiting for dns resolution to become available...."); sleep 1; } print STDERR "[finished address lookups]\n" if $DEBUG; if ($SIMULATE_FAILURE) { @trueaddresses = ( '1.1.1.1', '2.2.2.2' ); } Cpanel::ArrayFunc::Shuffle::shuffle( \@trueaddresses ); if ( !@trueaddresses ) { my $errormsg = "$host could not be resolved to an IP address. Please check your /etc/resolv.conf file.\n"; Cpanel::Debug::log_warn($errormsg); if ( $self->{'die_on_error'} ) { die $errormsg; } return wantarray ? () : []; } elsif ( !$self->{'speed_test_enabled'} ) { @trueaddresses = ( $trueaddresses[0] ); } elsif ( @trueaddresses > 1 ) { print STDERR "[has resolved, testing]\n" if $DEBUG; if ( !$loaded_cache ) { if ( $self->{'use_mirror_addr_list'} || $host eq 'httpupdate.cpanel.net' ) { $self->_output("\n"); my $mirror_addr_list = $self->request( 'level' => 1, 'addresslist' => \@trueaddresses, 'host' => $host, 'url' => '/mirror_addr_list', 'protocol' => 1, 'http_retry_count' => 3 ); my @mirror_addr_list_ADDR_LIST; if ($mirror_addr_list) { foreach my $line ( split( /\n/, $mirror_addr_list ) ) { chomp($line); my ($ipaddr) = split( /=/, $line ); push @mirror_addr_list_ADDR_LIST, $ipaddr if ( $ipaddr =~ /^[\d\.\:]+$/ ); } } if (@mirror_addr_list_ADDR_LIST) { $self->_output( "...found " . scalar @mirror_addr_list_ADDR_LIST . " host(s) from mirror_addr_list..." ); @trueaddresses = @mirror_addr_list_ADDR_LIST; } } if ( $self->{'use_dns_cache'} && @trueaddresses ) { if ( open( my $address_cache_fh, '>', $homedir . '/.HttpRequest/' . $cache_key ) ) { print {$address_cache_fh} join( "\n", @trueaddresses ); close($address_cache_fh); } } } if ( ++$self->{'mirror_search_attempts'}{$host} == 4 ) { # first time = loaded from cache die "$host did not have any working mirrors. Please check your internet connection or dns server."; } $self->_output( "...searching for mirrors (mirror search attempt " . $self->{'mirror_search_attempts'}{$host} . "/3)..." ); require Cpanel::MirrorSearch; my @goodurls = Cpanel::MirrorSearch::findfastest( 'days' => ( 2.0 / 24 ), 'key' => $host, 'count' => 10, 'urls' => [ Cpanel::UrlTools::buildurlfromuri( \@trueaddresses, $self->{'speed_test_file'} ) ], 'quiet' => $self->{'htmlOutput'} ? 1 : $quiet, 'port' => $port || $self->_socket_default_port() ); if ( @trueaddresses = Cpanel::UrlTools::extracthosts( \@goodurls ) ) { $self->_output("...mirror search success..."); $self->{'mirror_search_attempts'}{$host} = 0; } else { $self->_output("...mirror search failed..."); } if ( !@trueaddresses && $self->{'use_dns_cache'} ) { $self->_destroy_ip_cache($host); } } if ($SIMULATE_FAILURE) { return wantarray ? () : []; } return wantarray ? @trueaddresses : \@trueaddresses; } sub _remove_failed_mirror { my $self = shift; my $addr = $self->{'connectedHostAddress'}; #ip of connected host print STDERR "[_remove_failed_mirror] $addr\n" if $DEBUG; $self->_output("...removing $addr..."); if ( $self->{'host'} ) { @{ $self->{'hostIps'}{ $self->{'host'} } } = grep( !m/^\Q$addr\E$/, @{ $self->{'hostIps'}{ $self->{'host'} } } ); } require Cpanel::MirrorSearch; Cpanel::MirrorSearch::remove_mirror( 'key' => $self->{'connectedHostname'}, 'addr' => $addr ); if ( !$self->{'host'} || !@{ $self->{'hostIps'}{ $self->{'host'} } } && $self->{'use_dns_cache'} ) { $self->_destroy_ip_cache(); } return; } sub _skip_failed_mirror { my $self = shift; my $addr = $self->{'connectedHostAddress'}; #ip of connected host print STDERR "[_skip_failed_mirror] $addr\n" if $DEBUG; $self->_output("...skipping $addr..."); @{ $self->{'hostIps'}{ $self->{'host'} } } = grep( !m/^\Q$addr\E$/, @{ $self->{'hostIps'}{ $self->{'host'} } } ); push @{ $self->{'skipped_hostIps'}{ $self->{'host'} } }, $addr; # if ! grep( !m/^\Q$addr\E$/, @{ $self->{'skipped_hostIps'}{ $self->{'host'} } } );; if ( !@{ $self->{'hostIps'}{ $self->{'host'} } } && @{ $self->{'skipped_hostIps'}{ $self->{'host'} } } ) { @{ $self->{'hostIps'}{ $self->{'host'} } } = @{ $self->{'skipped_hostIps'}{ $self->{'host'} } }; $self->{'skipped_hostIps'}{ $self->{'host'} } = []; # important to clear out this since we moved them to hostIps } return; } sub _destroy_ip_cache { my $self = shift; my $cache_key = shift || $self->{'connectedHostname'}; my $homedir = ( getpwuid($>) )[7]; $cache_key =~ s/\///g; unlink("$homedir/.HttpRequest/$cache_key"); # Kill the cache if we run out of working hosts so it will rebuild return; } sub _convert_headers { my ($headers) = @_; if ( !ref $headers ) { my @lines = split /\r\n/, $headers; $headers = {}; foreach my $line (@lines) { last unless length $line; my ( $key, $value ) = split /:\s*/, $line, 2; next unless length $key; $headers->{$key} ||= []; push @{ $headers->{$key} }, $value; } } return $headers; } sub _socket_default_port { my $self = shift; return ( getservbyname( 'http', 'tcp' ) )[2]; } sub _socket_destroy { my $self = shift; delete $self->{'fetcher'}; return 1; } sub _initrequest { ## no critic qw(Subroutines::ProhibitExcessComplexity) my ( $self, %OPTS ) = @_; $self->{'last_status'} = undef; print STDERR "\n\n\n\n[_initrequest]\n" if $DEBUG; my $host = $OPTS{'host'}; $self->{'host'} = $host || die "Host is missing"; $self->{'hostIps'}{$host} ||= []; $self->{'skipped_hostIps'}{$host} ||= []; my $url = $OPTS{'url'}; my $http_protocol = $OPTS{'http_protocol'}; my $destfile = $OPTS{'destfile'}; my $headers = $OPTS{'headers'}; my $port = $OPTS{'port'}; my $method = $OPTS{'method'} || 'GET'; $self->{'connected'} = 0 if ( $self->{'connectedHostname'} ne $host ); my $has_an_addresslist = ( exists $OPTS{'addresslist'} && ref $OPTS{'addresslist'} ) ? 1 : 0; if ( ( $self->{'using_addresslist'}{$host} && !$has_an_addresslist ) || ( !$self->{'using_addresslist'}{$host} && $has_an_addresslist ) || $SIMULATE_FAILURE ) { delete $self->{'using_addresslist'}{$host}; $self->{'hostIps'}{$host} = $self->{'skipped_hostIps'}{$host} = []; $self->{'connected'} = 0; # We must also disconnect because we may not be connected } if ($DEBUG) { print STDERR "[about to get ips has_an_addresslist=($has_an_addresslist)]\n"; my $hostips_defined = @{ $self->{'hostIps'}{$host} } ? 1 : 0; my $skipped_hostips_defined = @{ $self->{'skipped_hostIps'}{$host} } ? 1 : 0; print "[HOSTIPS_DEFINED] $hostips_defined [SKIPPEDHOSTIPS_DEFINED] $skipped_hostips_defined\n"; } if ( !@{ $self->{'hostIps'}{$host} } && !@{ $self->{'skipped_hostIps'}{$host} } ) { print STDERR "[...doing address lookup block...]\n" if $DEBUG; if ( @{ $self->{'hostIps'}{$host} } = $has_an_addresslist ? @{ $OPTS{'addresslist'} } : $self->_getAddressList( $host, $port ) ) { if ($has_an_addresslist) { $self->{'using_addresslist'}{$host} = 1; } if ($DEBUG) { my $hostips_defined = @{ $self->{'hostIps'}{$host} } ? 1 : 0; print STDERR "[....addresslist load or getAddressList ok...] ($hostips_defined)\n"; } } else { print STDERR "[...failed to resolve $host...]\n" if $DEBUG; return; } } print STDERR "[init_req finished populating hostIps]\n" if $DEBUG; my $port_suffix = $OPTS{'port'} ? ":$OPTS{'port'}" : ""; $url =~ s/\s/\%20/g; $url ||= '/'; $headers->{Accept} ||= "text/html, text/plain, audio/mod, image/*, application/msword, application/pdf, application/postscript, text/sgml, */*;q=0.01"; foreach my $addr ( @{ $self->{'hostIps'}{$host} } ) { $self->{'connectedHostAddress'} = $addr; #must be set before we actually connect() in setupsocket $self->{'connectedHostname'} = $host; $self->{'connectedHostFailCount'}{$addr} ||= 0; $self->{'connected'} = 1; my $local_logger = $self->{'logger'}; if ( $self->{'announce_mirror'} && ( !defined $self->{'_previous_mirror_used'} || $self->{'_previous_mirror_used'} ne $addr ) ) { $self->{'_previous_mirror_used'} = $addr; $local_logger->info("Using mirror '${addr}' for host '${host}'."); } last; } $self->_output( '@' . $self->{'connectedHostAddress'} . '...' ); return "http://$host$port_suffix$url"; } sub _die { my ( $self, $msg ) = @_; if ( $self->{'logger'}->can('die') ) { return $self->{'logger'}->die($msg); } else { die "$msg\n"; } } sub _sigerror_die { my ( $self, $msg ) = @_; return $self->_die( $msg . ' Please see https://go.cpanel.net/sigerrors for further information about this error.' ); } sub get_crypt_gpg_vendorkey_verify { my ( $self, %opts ) = @_; my ( $gpg_vendor, $gpg_category ) = @opts{qw(vendor categories)}; $gpg_vendor ||= $self->{'vendor'}; $gpg_category ||= $self->{'categories'}; my $key = join( '__', $gpg_vendor, ref $gpg_category ? @$gpg_category : $gpg_category ); return $self->{'_gpg_verify'}{$key} if $self->{'_gpg_verify'}{$key}; require Cpanel::Crypt::GPG::VendorKeys::Verify; my ( $gpg, $gpg_msg ) = Cpanel::Crypt::GPG::VendorKeys::Verify->new( vendor => $gpg_vendor, categories => $gpg_category, ); return ( $gpg, $gpg_msg ) if !$gpg; $self->{'_gpg_verify'}{$key} = $gpg; return ( $gpg, $gpg_msg ); } 1; } # --- END Cpanel/HttpRequest.pm { # --- BEGIN Cpanel/Update/Tiers.pm package Cpanel::Update::Tiers; use cPstrict; no warnings 'once'; # use Cpanel::JSON (); # perlpkg line 211 # use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211 # use Cpanel::OS (); # perlpkg line 211 # use Cpanel::Update::Config (); # perlpkg line 211 # use Cpanel::Version::Full (); # perlpkg line 211 # use Cpanel::Version::Compare (); # perlpkg line 211 use Scalar::Util (); use constant TIERS_JSON_URI => '/cpanelsync/TIERS.json'; # source for the TIERS.json file use constant TIERS_JSON_FILE => '/etc/cpanel/TIERS.json'; # where to save the file sub new ( $class, %args ) { my $self = {}; $self->{'tiers_url'} = $args{'tiers_url'} || TIERS_JSON_URI; $self->{'tiers_path'} = $args{'tiers_path'} || TIERS_JSON_FILE; $self->{'cache_expiration_time'} = $args{'cache_expiration_time'} || $ENV{'CPANEL_BASE_INSTALL'} ? 6 * 3600 : 300; $self->{'logger'} = $args{'logger'} if $args{'logger'}; return bless $self, $class; } sub logger ($self) { require Cpanel::Logger; $self->{'logger'} ||= Cpanel::Logger->new(); if ( !Scalar::Util::blessed( $self->{'logger'} ) ) { $self->{'logger'} = Cpanel::Logger->new( { 'alternate_logfile' => '/dev/null', } ); } return $self->{'logger'}; } sub sync_tiers_file ($self) { my $remote_tiers_host = $self->_remote_tiers_host; my $http = $self->_http_request( 'die_on_404' => 1 ); my $tiers_json; { require Cpanel::Alarm; my $alarm = Cpanel::Alarm->new( 45, sub { die 'Timeout while fetching version information.' } ); $tiers_json = $http->request( 'host' => $remote_tiers_host, 'url' => $self->{'tiers_url'}, 'signed' => 1, ); } if ( !$tiers_json ) { die( "Error downloading ${remote_tiers_host}" . TIERS_JSON_URI ); } my $json_hr = Cpanel::JSON::Load($tiers_json) or die( "Could not load ${remote_tiers_host}" . TIERS_JSON_URI . ": $@" ); if ( !-e $self->{'tiers_path'} ) { require File::Basename; my ( $basename, $dirname, $suffix ) = File::Basename::fileparse( $self->{'tiers_path'} ); if ( !-e $dirname ) { require Cpanel::SafeDir::MK; Cpanel::SafeDir::MK::safemkdir( $dirname, 0755 ); } } return 0 unless Cpanel::FileUtils::Write::JSON::Lazy::write_file( $self->{'tiers_path'}, $json_hr, 0644 ); $self->_write_lastmod_cache( $http->last_modified() ); return 1; } sub _write_lastmod_cache ( $self, $last_modified ) { my $path = $self->{'tiers_path'} . '.lastmod'; if ( !length $last_modified ) { unlink $path; return; } require Cpanel::FileUtils::Write; Cpanel::FileUtils::Write::overwrite_no_exceptions( $path, $last_modified . "\n", 0644 ); return; } sub _read_lastmod_cache ($self) { my $path = $self->{'tiers_path'} . '.lastmod'; return unless -e $path && !-z _; open my $fh, '<', $path or return; my $val = readline $fh; close $fh; return unless defined $val; $val =~ s/\s+\z//; return length $val ? $val : undef; } sub _remote_tiers_is_unchanged ($self) { my $last_modified = $self->_read_lastmod_cache() or return 0; return 0 if !-e $self->{'tiers_path'} || -z _; return $self->_http_request()->is_unmodified( 'host' => $self->_remote_tiers_host, 'url' => $self->{'tiers_url'}, 'last_modified' => $last_modified, 'timeout' => 45, ); } sub _remote_tiers_host ($self) { require Cpanel::Config::Sources; return Cpanel::Config::Sources::get_source('HTTPUPDATE'); } sub _http_request ( $self, %extra ) { require Cpanel::HttpRequest; return Cpanel::HttpRequest->new( 'logger' => ( Scalar::Util::blessed( $self->logger() ) ? $self->logger() : undef ), # undef restores the legacy behavior 'hideOutput' => 1, 'retry_dns' => 0, %extra, ); } sub tiers_hash ( $self, %opts ) { return $self->{'tiers_hash'} if exists $self->{'tiers_hash'}; my $tiers_hr = eval { if ( $self->tiers_cache_expired() ) { $self->sync_tiers_file() unless $opts{'security_check'} && $self->_remote_tiers_is_unchanged(); } Cpanel::JSON::SafeLoadFile( $self->{'tiers_path'} ); }; if ($@) { my $error = 'Failed to load version ' . $self->{'tiers_path'} . ' file: ' . $@; if ( $self->logger->can('error') ) { $self->logger->error($error); } else { $self->logger->warn($error); } if ( -e $self->{'tiers_path'} ) { unlink $self->{'tiers_path'} or $self->logger->warn( 'Failed to unlink corrupt version file ' . $self->{'tiers_path'} . ": $!" ); } return; } $self->{'tiers_hash'} = $tiers_hr; return $self->{'tiers_hash'}; } sub tiers_cache_expired ($self) { if ( !-e $self->{'tiers_path'} || -z _ || ( ( stat(_) )[9] + $self->{'cache_expiration_time'} ) < time ) { return 1; } else { return 0; } } sub get_current_lts_expiration_status ($self) { my %results; $results{'full_version'} = Cpanel::Version::Full::getversion(); $results{'expiration'} = $self->get_expires_for_version( $results{'full_version'} ); return unless defined $results{'expiration'}; $results{'expires_in_next_three_months'} = 0; my $time = time; my $time_three_months_from_now = $time + 3600 * 24 * 90; if ( $results{'expiration'} && ($time_three_months_from_now) > $results{'expiration'} ) { $results{'expires_in_next_three_months'} = 1; } return \%results; } sub get_build_info ( $self, $version ) { return $self->_visit_major_builds_from_version( $version, sub { my ($build) = @_; return $build if $build && defined $build->{'build'} && $build->{'build'} eq $version; return; } ); } sub _visit_major_builds_from_version ( $self, $version, $visit ) { my ($major) = $version =~ m/^11\.([0-9]+)\.[0-9]+\.[0-9]+$/; $major or return; # Not a valid version. Obviously not stable :) $major += $major % 2; #Make it even. $major = "11.$major"; my $tiers_hr = $self->tiers_hash() or return; my $major_array = $tiers_hr->{'tiers'}->{$major} or return; return unless ref $major_array eq 'ARRAY'; foreach my $build (@$major_array) { my $got = $visit->($build); return $got if $got; } return; } sub get_expires_for_version ( $self, $version = undef ) { return unless defined $version; my $build_info = $self->get_build_info($version) or return; return $build_info->{'expires'} if defined $build_info->{'expires'}; return $self->_visit_major_builds_from_version( $version, sub { my ($build) = @_; return unless $build; if ( $build->{is_lts} && defined $build->{expires} ) { return $build->{expires}; } return; } ); } sub get_current_tier ($self) { return $self->{'current_update_tier'} if $self->{'current_update_tier'}; my $tier = Cpanel::Update::Config::load()->{'CPANEL'}; if ( $tier =~ m{^[0-9]+$} ) { $tier = '11.' . $tier; } return $self->{'current_update_tier'} = $tier; } sub is_explicit_version ( $self, $tier = undef ) { return unless defined $tier && length $tier; return ( $tier =~ m/^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/ ) ? 1 : 0; } sub get_remote_version_for_tier ( $self, $tier = undef ) { return unless defined $tier && length $tier; return $tier if $self->is_explicit_version($tier); my $tiers_hash = $self->tiers_hash; if ( $tier =~ m/^([0-9]+\.[0-9]+)$/ ) { my $LTS = "$1"; # Be sure to stringify it. ref $tiers_hash->{'tiers'} eq 'HASH' or return; my $major_versions = $tiers_hash->{'tiers'}->{$LTS}; ref $major_versions eq 'ARRAY' or return; foreach my $build (@$major_versions) { next unless $build->{'is_main'}; return $build->{'build'}; } return; # Couldn't find an is_main inside $LTS } if ( $tier =~ m/^([0-9]+\.[0-9]+\.[0-9]+)$/ ) { my $dev_branch = "$1"; # Be sure to stringify it. if ( ref $tiers_hash->{'branch'} eq 'HASH' ) { my $build = $tiers_hash->{'branch'}->{$dev_branch}; if ( $build && ref $build eq 'ARRAY' ) { if ( $build->[0] && ref $build->[0] eq 'HASH' ) { return $build->[0]->{'build'}; } } } } ref $tiers_hash->{'tiers'} eq 'HASH' or return; foreach my $versions_in_major ( values %{ $tiers_hash->{'tiers'} } ) { ref $versions_in_major eq 'ARRAY' or next; foreach my $release (@$versions_in_major) { ref $release eq 'HASH' or next; $release->{'named'} or next; ref $release->{'named'} eq 'ARRAY' or next; foreach my $name ( @{ $release->{'named'} } ) { return $release->{'build'} if $name eq $tier; } } } return; } sub get_is_main_build_for_tier ( $self, $tier = undef ) { return unless defined $tier && length $tier; return unless $tier =~ m/^([0-9]+\.[0-9]+)$/; my $LTS = "$1"; # Be sure to stringify it. my $tiers_hash = $self->tiers_hash; ref $tiers_hash->{'tiers'} eq 'HASH' or return; my $major_versions = $tiers_hash->{'tiers'}->{$LTS}; ref $major_versions eq 'ARRAY' or return; foreach my $build (@$major_versions) { next unless $build->{'is_main'}; return $build; } return; # No is_main build inside $LTS } sub check_for_security_version ( $self, $installed_version = undef ) { return unless length $installed_version; return if ( Cpanel::Update::Config::load()->{'SECURITY_UPDATES'} // 'hourly' ) eq 'never'; return if $ENV{'CPANEL_BASE_INSTALL'}; return if $self->is_explicit_version( $self->get_current_tier ); $self->tiers_hash( 'security_check' => 1 ); my $major = Cpanel::Version::Compare::get_major_release($installed_version) or return; my $build = $self->get_is_main_build_for_tier($major) or return; return if !$build->{'is_security'}; return if !defined $build->{'build'}; return if $build->{'build'} eq $installed_version; return $build->{'build'}; } sub check_for_package_update ($self) { return if $ENV{'CPANEL_BASE_INSTALL'}; my $tiers_hr = $self->tiers_hash( 'security_check' => 1 ) or return; return unless ref $tiers_hr->{'packages'} eq 'HASH'; my $published = $tiers_hr->{'packages'}->{'repos'}; return unless ref $published eq 'HASH'; my $recorded = $self->_read_packages_cache(); my $seeding = !%$recorded; my ( %seed, %candidate ); foreach my $repo ( sort keys %$published ) { next unless $repo =~ m{\A[A-Za-z0-9][A-Za-z0-9._:-]*\z}xms; my $token = $published->{$repo}; next if ref $token || !length $token; if ($seeding) { $seed{$repo} = $token; next; } next if exists $recorded->{$repo} && $token eq $recorded->{$repo}; $candidate{$repo} = $token; } $self->record_packages_updated( \%seed ) if %seed; return unless %candidate; my @actionable = _actionable_repos( [ sort keys %candidate ] ); return unless @actionable; return { map { $_ => $candidate{$_} } @actionable }; } sub _actionable_repos ($repos_ar) { my @repos = @{ $repos_ar || [] }; return @repos unless @repos; my $package_manager = Cpanel::OS::package_manager(); return @repos if $package_manager ne 'yum' && $package_manager ne 'dnf'; my $dir = Cpanel::OS::repo_dir(); my $suffix = '.' . Cpanel::OS::repo_suffix(); opendir my $dh, $dir or return (); my @repo_files = grep { $_ ne '.' && $_ ne '..' && substr( $_, -length $suffix ) eq $suffix } readdir $dh; closedir $dh; my %enabled; foreach my $repo_file (@repo_files) { open my $fh, '<', "$dir/$repo_file" or next; my $section; while ( my $line = readline $fh ) { if ( $line =~ m{\A \s* \[ ([^\]]+) \]}xms ) { $section = $1; $enabled{$section} //= 1; next; } next if !defined $section; if ( $line =~ m{\A \s* enabled \s* = \s* (\S+)}xmsi ) { $enabled{$section} = $1 =~ m{\A (?: 0 | false | no | off ) \z}xmsi ? 0 : 1; } } close $fh; } return grep { $enabled{$_} } @repos; } sub record_packages_updated ( $self, $repos_hr ) { ref $repos_hr eq 'HASH' or return; return unless %$repos_hr; my $recorded = $self->_read_packages_cache(); @{$recorded}{ keys %$repos_hr } = values %$repos_hr; $self->_write_packages_cache($recorded); return; } sub _write_packages_cache ( $self, $repos_hr ) { my $path = $self->{'tiers_path'} . '.packages'; local $@; eval { Cpanel::FileUtils::Write::JSON::Lazy::write_file( $path, $repos_hr, 0644 ); 1 } or $self->logger->warn("Failed to record the expedited package update state in $path: $@"); return; } sub _read_packages_cache ($self) { my $path = $self->{'tiers_path'} . '.packages'; return {} unless -e $path && !-z _; my $recorded = eval { Cpanel::JSON::SafeLoadFile($path) }; return ref $recorded eq 'HASH' ? $recorded : {}; } sub get_main_for_version ( $self, $current_version = undef ) { $current_version or return; $current_version =~ m{^11\.([0-9]+)\.[0-9]+\.[0-9]+$} or return; my $major_version = $1; $major_version++ if ( $major_version % 2 ); # Make it even if it's odd. my $tiers_hash = $self->tiers_hash; ref $tiers_hash->{'tiers'} eq 'HASH' or return; my $build_list = $tiers_hash->{'tiers'}->{"11.$major_version"} or return; ref $build_list eq 'ARRAY' or return; foreach my $build (@$build_list) { next unless $build->{'is_main'}; return $build->{'build'}; # We found the is_main for 11.76.0.4 (or whatver) } return; #If there's no LTS forwad of # } sub get_lts_for ( $self, $current_version = undef, $next = undef ) { $current_version or return; $current_version =~ m{^11\.(\d+)\.\d+\.\d+$} or return; my $major_version = $1; $major_version++ if ( $major_version % 2 ); # Make it even if it's odd. $major_version += 2 if ($next); # Find the next LTS , not the current one my $tiers_hash = $self->tiers_hash; ref $tiers_hash->{'tiers'} eq 'HASH' or return; foreach my $step ( 0 .. 50 ) { my $forward_major = sprintf( "11.%02d", $major_version + $step * 2 ); my $major_versions = $tiers_hash->{'tiers'}->{$forward_major} or next; ref $major_versions eq 'ARRAY' or next; foreach my $build (@$major_versions) { next unless $build->{'is_lts'}; return $build->{'build'}; } } return; #If there's no LTS forwad of # } sub get_update_availability ($self) { my $current_tier = $self->get_current_tier(); my $current_version = Cpanel::Version::Full::getversion(); my $newest_version = $self->get_remote_version_for_tier($current_tier); $current_version =~ s{^11\.}{}; $newest_version =~ s{^11\.}{} if defined $newest_version; return { 'tier' => $current_tier, 'current_version' => $current_version, 'newest_version' => $newest_version, 'update_available' => Cpanel::Version::Compare::compare( $newest_version, '>', $current_version ) ? 1 : 0, }; } sub is_slow_rollout_tier ( $self, $version = undef ) { $version or return; my $tiers_hr = $self->tiers_hash; ref $tiers_hr->{'tiers'} eq 'HASH' or return; my $build = $self->get_build_info($version) or return; return unless $build->{'named'}; return if ref $build->{'named'} ne 'ARRAY'; foreach my $tier ( @{ $build->{'named'} } ) { next unless $tier; return 1 if lc($tier) eq 'release'; } return; } sub get_flattened_hash ($self) { my %tiers; my $tiers_hr = $self->tiers_hash; ref $tiers_hr->{'tiers'} eq 'HASH' or return; foreach my $major ( keys %{ $tiers_hr->{'tiers'} } ) { my $versions_in_major = $tiers_hr->{'tiers'}->{$major}; ref $versions_in_major eq 'ARRAY' or next; foreach my $release (@$versions_in_major) { ref $release eq 'HASH' or next; if ( $release->{'is_main'} ) { $tiers{"$major"} = $release->{'build'}; } $release->{'named'} or next; ref $release->{'named'} eq 'ARRAY' or next; foreach my $name ( @{ $release->{'named'} } ) { $tiers{$name} = $release->{'build'}; } } } return \%tiers; } 1; } # --- END Cpanel/Update/Tiers.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; no warnings 'once'; # use Cpanel::LoadFile (); # perlpkg line 211 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/Maxmem.pm package Cpanel::Maxmem; use strict; use warnings; no warnings 'once'; # use Cpanel::Config::LoadUserDomains::Count (); # perlpkg line 211 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; no warnings 'once'; 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; no warnings 'once'; # use Cpanel::OSSys::Bits (); # perlpkg line 211 # use Cpanel::Pack (); # perlpkg line 211 # use Cpanel::Syscall (); # perlpkg line 211 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 (); # perlpkg line 211 # use Cpanel::Maxmem (); # perlpkg line 211 # use Cpanel::Sys::Rlimit (); # perlpkg line 211 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; # Copyright 2026 WebPros International, LLC # All rights reserved. # copyright@cpanel.net http://cpanel.net # This code is subject to the cPanel license. Unauthorized copying is prohibited. package scripts::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 # perlpkg line 289 # use Cpanel::HiRes ( preload => 'perl' ); # perlpkg line 289 # use Cpanel::Env (); # perlpkg line 289 # use Cpanel::Update::Config (); # perlpkg line 289 # use Cpanel::Update::IsCron (); # perlpkg line 289 # use Cpanel::Update::Logger (); # perlpkg line 289 # use Cpanel::Update::Tiers (); # perlpkg line 289 # use Cpanel::FileUtils::TouchFile (); # perlpkg line 289 # use Cpanel::LoadFile (); # perlpkg line 289 # use Cpanel::LoadModule (); # perlpkg line 289 # use Cpanel::Usage (); # perlpkg line 289 # use Cpanel::UPID (); # perlpkg line 289 use IO::Handle (); use POSIX (); # use Cpanel::Unix::PID::Tiny (); # perlpkg line 289 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 $security = 0; my $rlimit_max = 1024; # Expedited package update state, decided before the fork and acted on in the # child. $package_update_repos is a repository => token map covering every # repository to update, so they all go into one transaction. $packages_only # records that the package update is the only reason this run exists, so the # child can stop before the version-upgrade machinery. my $security_tiers; my $package_update_repos; my $packages_only = 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]] [--security] [--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. --security Apply expedited security updates, independent of the normal update schedule: a security release for the current major version, and packages from any repository cPanel has flagged as carrying a fix. Either can apply on its own. The version upgrade honors SECURITY_UPDATES in /etc/cpupdate.conf; the package update honors RPMUP. Runs hourly from cron; a silent no-op unless one of them applies. --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; } elsif ( $arg eq '--security' ) { $security = 1; } } # Expedited security mode: one cheap TIERS check up front, answering two # questions off the same fetch -- is there a security version to upgrade to, # and have any repositories published a new package token. On the common hourly # no-op we exit immediately -- before any fork, hook, log, or updatenow # call. Only when one of them applies do we fall through into the normal # flow, which fires the pre/post hooks, runs updatenow (with --security # passed through), and -- because a version change is critical -- runs # scripts/maintenance just like a normal upcp. The one thing --security # skips is the post-upgrade re-poll for a newer version (it is a single # same-major hop, not a tier chase). # # A packages-only run wants none of that: it forks and logs as usual, does # the package update, and stops (see $packages_only below). if ( $security && !$fromself ) { # Never expedite anything during a fresh install. Redundant with the # guards inside Cpanel::Update::Tiers, but strictly cheaper: no object # construction and no HTTP probe on a path we should never reach. return 0 if $ENV{'CPANEL_BASE_INSTALL'}; $security_tiers = Cpanel::Update::Tiers->new( 'logger' => 'disabled' ); # check_for_security_version returns early -- without syncing -- when # SECURITY_UPDATES=never, so drive the (single, conditional) fetch here. # Otherwise a server with the security channel turned off would never # observe the package update tokens. $security_tiers->tiers_hash( 'security_check' => 1 ); my $version_update = security_update_available($security_tiers); # Already filtered down to repositories this server actually has # configured, so a bumped repository it does not carry costs it nothing # from here on -- no fork, no log file, no failed transaction. $package_update_repos = $security_tiers->check_for_package_update(); return 0 if !$version_update && !$package_update_repos; $packages_only = ( $package_update_repos && !$version_update ) ? 1 : 0; } 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; # In --security mode, yield silently to any other running upcp (e.g. the # daily --cron). Never print "already running", never kill it; we simply # re-check next hour. if ( $security && $curpid && $curpid != $$ && $upid->is_pidfile_running($pidfile) ) { return 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; }; ############################################################################# # Expedited package update: TIERS.json published a new token for one or more # repositories. Done before any version upgrade and regardless of whether one # is also due -- the duplicate work is a near no-op for the package manager, # while skipping it in favor of the upgrade's maintenance pre-action would # skip the cache clean, which is the entire point of this channel. if ($package_update_repos) { run_expedited_package_update( $logger, $security_tiers, $package_update_repos ); if ($packages_only) { $logger->info( "\n\n\tExpedited package update completed\n\n", 1 ); $logger->info("A log of this update is available at $logfile_path\n\n"); $logger->update_pbar(100); unlink $pidfile; $logger->close_log(); return 0; } } ############################################################################# # 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 $updatenow_exit_code; 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' ); } # In --security mode updatenow makes the authoritative is_main/security # decision and selects the current-major target. if ($security) { push( @updatenow_args, '--security' ); } # 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 ) { $updatenow_exit_code = $exit_code; 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, ], ); } # 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. # Skipped for --security: an expedited security update is a single # same-major hop, so we must not re-poll updatenow and chase a further # version upgrade. Maintenance and hooks above still run regardless. if ( !$security ) { $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 { # Run sanity check scripts when no version change happened # This allows certain install scripts marked as "sanity" to run during regular upcp runs $logger->info("Running sanity check scripts"); $logger->close_log(); # Yield the log to bin/taskrun --sanity $save_last_logfile_position->(); # remember how many lines has the logfile before starting sanity scripts my $sanity_exit_status = run_sanity_install_scripts($logfile_path); $logger->open_log; # reopen the log to continue writing messages analyze_and_report_error( success_msg => "Sanity check scripts completed successfully", error_msg => "Sanity check scripts ended, however some did not exit cleanly. Please check the logs for an indication of what happened", type => 'upcp::SanityInstallScriptsFailed', exit_status => $sanity_exit_status, logfile => $logfile_path, last_logfile_position => $last_logfile_position, ); # Perform the return we used to do if updatenow failed: return ( $updatenow_exit_code >> 8 ) if defined $updatenow_exit_code && $updatenow_exit_code; 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(); }; # CPANEL-43452: Ensure consistent rlimit value between UI and CLI eval { local $SIG{__DIE__}; Cpanel::Rlimit::set_rlimit( $rlimit_max, [qw/NOFILE/] ); }; } ############################################################################# sub setup_updatelogs { return if ( -d '/var/cpanel/updatelogs' ); unlink('/var/cpanel/updatelogs'); mkdir( '/var/cpanel/updatelogs', 0700 ); } # Updates the repositories TIERS.json has flagged, as one transaction, and # stamps their tokens only once it has succeeded. $repos is the whole # repository => token map from check_for_package_update. sub run_expedited_package_update { my ( $logger, $tiers, $repos ) = @_; my @repos = sort keys %$repos; my $named = join ', ', @repos; # CPANEL_IS_CRON is already set for this run, so this honors RPMUP=manual for # the hourly cron and treats a hand run as the manual run it is. # load() returns a flattened hash in list context, which an argument # position is, so it has to be put in a scalar first for is_permitted to # see a hashref at all. my $update_conf = Cpanel::Update::Config::load(); if ( !Cpanel::Update::Config::is_permitted( 'RPMUP', $update_conf ) ) { # Leave the tokens unrecorded: they stay pending, so re-enabling # operating system package updates picks them up on the next run rather # than having silently missed them. $logger->info("An expedited package update is available for $named, but operating system package updates are disabled. Skipping the package update."); return 0; } $logger->info("An expedited package update is available. Updating packages from $named."); # Contained deliberately. Loading Cpanel::Update::Packages pulls in the # package manager stack, so a broken or half-synced tree can make this throw # rather than return false. Either way the tokens are left unstamped and the # next hourly check retries, by which point the daily update has likely # repaired whatever was wrong -- and a version upgrade due in this same run # must not be abandoned over a failed package update. my $updated = try { # The one deferred load in this script, and the only reason # Cpanel::Update::Packages is a module rather than a sub in here. # Loading it loads Cpanel::SysPkgs, which unconditionally pulls in all # three package manager backends -- ~110 modules, among them the XS # Proc::FastSpawn. upcp runs hourly on every server just to ask whether # there is anything to do, and the answer is almost always no, so the # load waits until we know there is. The split line keeps # Cpanel::ModuleDeps from seeing it, which is what keeps the stack out # of scripts/upcp.static as well as out of the hourly run. require # Hide Depend -- not needed in upcp.static Cpanel::Update::Packages; Cpanel::Update::Packages::update_repos( 'repos' => \@repos, 'clean' => 1, 'logger' => $logger ); } catch { $logger->warning("The expedited package update could not run: $_"); 0; }; if ( !$updated ) { $logger->warning('The expedited package update failed. The system will try again on the next update check.'); return 0; } # Stamp the whole set at once, and only once the update has succeeded, so a # failure is retried on the next check instead of being silently marked done. $tiers->record_packages_updated($repos); return 1; } # Cheap up-front check for --security mode: is an expedited security update # available for the current major version? A single Cpanel::Update::Tiers # lookup (which self-syncs TIERS.json when its cache is stale and fails # soft) lets the hourly cron exit immediately on the common no-op without # spinning up updatenow. The authoritative decision and target selection # still happen in Cpanel::Update::Now under --security when we proceed. sub security_update_available { # Optionally share the caller's object (and therefore its single, already # paid for TIERS.json fetch); construct one when called on its own. my $tiers = shift; my $installed = fetch_cpanel_version() or return 0; # Cpanel::Update::Tiers owns the entire skip decision: the # SECURITY_UPDATES=never config gate, the fresh-install guard, the # explicit-pin opt-out, is_main resolution, the security flag, and the # != installed check. tiers_hash() self-syncs when its cache is stale # and fails soft. $tiers ||= Cpanel::Update::Tiers->new( 'logger' => 'disabled' ); return defined $tiers->check_for_security_version($installed) ? 1 : 0; } 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; } sub run_sanity_install_scripts { my ($logfile_path) = @_; # Use bin/taskrun --sanity to execute sanity check install tasks require Cpanel::SafeRun::Object; print "Running sanity check scripts via taskrun\n"; my $saferun = Cpanel::SafeRun::Object->new_or_die( program => '/usr/local/cpanel/bin/taskrun', args => ['--sanity'], ); my $stdout = $saferun->stdout() // ''; my $stderr = $saferun->stderr() // ''; my $exit_status = $saferun->CHILD_ERROR() >> 8; # Print any output from taskrun print $stdout if $stdout; print STDERR $stderr if $stderr; if ( $exit_status == 0 ) { print "Sanity check scripts completed successfully\n"; } else { print "Sanity check scripts exited with status: $exit_status\n"; } return $exit_status; } #---------------------------------------------------------------------- # 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;