Preview: updatenow.static
Size: 2.02 MB
//scripts/updatenow.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/updatenow.static';
$INC{'HTTP/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Try/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'cPstrict.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ExceptionMessage.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Fallback.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ExceptionMessage/Raw.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadModule/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ScalarUtil.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/CORE.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Context.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Destruct.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Time/Local.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Fcntl/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Fcntl.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Open.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parser/Vars.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Encoder/Tiny/Rare.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Encoder/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Regex.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Carp.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Set.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TimeHiRes.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFileLock.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FHUtils/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Hash.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFile/LockInfoCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFile/LockWatcher.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pack.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Syscall.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Inotify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadModule.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Linux/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/FilesystemNodeName.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Notify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Logger.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Debug.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Finally.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LocaleString.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Errno.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Constants/Perl.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ChildErrorStringifier.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/AdminBinError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/AbstractClass.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/AttributeNotSet.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/AttributeReadOnly.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/System/RequiredRoleDisabled.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Caller.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Caller.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/I18N/LangTags.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/I18N/LangTags/Detect.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locale/Maketext.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Normalize.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/Legacy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/DB/LocaleDisplayPattern/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/DB/CharacterOrientation/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/Compile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locale/Maketext/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Paths.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/DB/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Readlink.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Write.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Write/JSON/Lazy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/JSON/Unicode.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadFile/ReadFast.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Encoder/ASCII.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/UTF8/Strict.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/JSON.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AdminBin/Serializer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AdminBin/Serializer/FailOK.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Imports.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SSL/KeyTypeLabel.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SSL/DefaultKey/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpUser/Defaults.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Hash/JSONable.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpUser/Object.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ConfigFiles.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SV.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Struct/Common/Time.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Struct/timespec.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NanoStat.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NanoUtime.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HiRes.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Path/Normalize.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/JSON/FailOK.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Hash/Stringify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Umask.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadConfig.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadWwwAcctConf.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Conf.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadCpUserFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/HasCpUserFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NSCD/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Socket/UNIX/Micro.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NSCD/Check.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwCache/Helpers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwCache/Cache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwCache/Find.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwCache/Build.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/User.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Cookies.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeDir/Read.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ArrayFunc/Uniq.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Charmap.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/StringFunc/Case.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Legacy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadCpUserFile/CurrentUser.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/YAML/Syck.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/TouchFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PwUtils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AccessIds/Normalize.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AccessIds/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AccessIds/ReducedPrivileges.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/DataStore.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/StringFunc/Trim.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeDir/MK.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/3rdparty.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/JS/Variations.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Uname.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Hostname/Fallback.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Hostname.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Hostname.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpConfGuard/CORE.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpConfGuard.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadCpConf.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Display.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/Api1.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/SysPerlBootstrap.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Linux.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rhel.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Almalinux.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rhel8.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Almalinux8.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rhel9.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Almalinux9.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Type.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Cloudlinux.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Cloudlinux8.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Cloudlinux9.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rocky.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rocky8.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Rocky9.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Ubuntu.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/Ubuntu22.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS/All.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OS.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FHUtils/Autoflush.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Simple.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Errors.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Lines.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Timezones.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/DateTime.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Time/ISO.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadUserDomains/Count.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadUserDomains.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpUser.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/FlushConfig.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpUser/Write.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LinkedNode/Worker/Storage.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFile/Replace.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/CpUserGuard.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Utils/User/Modify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Version/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Version/Full.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Version/Compare.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Version.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Collection.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/CommandAlreadyRunning.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ConnectionFailed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ContextError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/SchemaOutdated.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/DatabaseCreationFailed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/DatabaseMissing.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/Error.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/ServerTime.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/TableCorruption.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/TableCreationFailed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/TableInsertionFailed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/UserMissing.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/CpuserNotInMap.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/DatabaseCreationInProgress.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/DatabaseNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Database/UserNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/EntryAlreadyExists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DnsEntryAlreadyExists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainAlreadyExists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainDoesNotExist.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainHasUnknownNameservers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainNameNotAllowed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainNameNotRfcCompliant.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainNotRegistered.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/DomainOwnership.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Email/AccountNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/InvalidParameter.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Empty.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/EntryDoesNotExist.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/FeatureNotEnabled.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/FeaturesNotEnabled.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ForbiddenInDemoMode.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/FunctionNotImplemented.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/URI/Password.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Base/HasUrl.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/HTTP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/HTTP/Network.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/HTTP/Server.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/InvalidCharacters.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/InvalidParameters.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/InvalidUsername.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ErrnoBase.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IOError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/CloseError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ChdirError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ChownError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ChrootError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryCloseError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryCreateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryDeleteError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryOpenError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryReadError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/DirectoryRewindError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ExecError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FcntlError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileCloseError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileCopyError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileOpenError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ReadError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileReadError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileSeekError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileTruncateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/WriteError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileWriteError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FlockError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ForkError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/LinkError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/RenameError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SelectError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SocketOpenError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SocketWriteError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/StatError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SymlinkCreateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SymlinkReadError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/UnlinkError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Socket/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Socket/Micro.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/SocketConnectError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/ChmodError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileCreateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/JSONParseError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/MissingMethod.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/MissingParameter.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/MissingParameters.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ModSecurity/DuplicateQueueItem.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ModuleLoadError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Netlink.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ProcessFailed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ProcessFailed/Error.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ProcessFailed/Signal.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ProcessFailed/Timeout.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Reserved.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ReservedSubdomain.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/ResourceLimitReached.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/RootProhibited.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/SMTP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/SMTP/FailedRecipient.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/TempCreateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/TempFileCreateError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Timeout.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/TooManyBytes.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Unsupported.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/UserNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/AccessDeniedToAccount.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/SystemCall.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/Services/Unknown.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/UserdataLookupFailure.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/RemoteMySQL/UnsupportedAuthPlugin.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/RemoteMySQL/InsufficientPrivileges.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/RecordNotFound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/NameConflict.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/IO/FileLockError.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Exception/UpdateNow.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Locale/Context.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeDir/RM.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Sources.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/Settings.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Logger.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Merge.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Env.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FHUtils/OS.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FHUtils/Blocking.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IO/Flush.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ReadMultipleFH.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ForkAsync.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Object.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Rand/Get.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Rand.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TempFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/Import.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/Import/Temp.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/YAML.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CachedDataStore.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CachedCommand/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PublicSuffix.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HTTP/Tiny/FastSSLVerify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HTTP/Client/Response.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HTTP/Client.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SecureDownload.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/VendorKeys.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Copy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Math.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parallelizer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Link.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/File/YAML.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Config.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/AlwaysInstalled.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/AnyAllMatcher.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/StatCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FindBin.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CachedCommand/Valid.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CachedCommand/Save.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Env.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CachedCommand.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/GlobalCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IP/Loopback.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/IP/v4.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/IP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/Domain/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/DB/Prefix/Conf.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IO.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Whostmgr/Transfers/State.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/Username/Mode.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/Username/Core.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/Username.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MariaDB.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MysqlUtils/Version.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Transaction/File/Read/JSON.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Transaction/File/BaseReader.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OrDie.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Signal/Defer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Chattr.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Attr.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Access.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Transaction/File/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Transaction/File/JSON.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Transaction/File/JSONReader.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MysqlUtils/Versions.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/StateFile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeFile/FileLocker.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Task.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Processor.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/URI/Escape/Fast.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Encoder/URI.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Serializer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Wait/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Scheduler.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Scheduler/DupeSupport.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/PluginManager.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/TaskQueue/Loader.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Logger/Persistent.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoggerAdapter.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoggerAdapter/Lazy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ServerTasks.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Whostmgr/Templates/Command/Directory.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MysqlUtils/RemoteMySQL/ProfileManager.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MysqlUtils/MyCnf/Basic.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/LoadConfig/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/GreyList/Config.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Hulk.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Chkservd/Config.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Chkservd/Config/Drivers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PHPFPM/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ProcessInfo.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PHPFPM/Controller.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/LinkTest.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadModule/Name.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LoadModule/Custom.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Type/Profile/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Type/Profile.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Type/Profile/Roles.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/List.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Server/Type/License.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Httpd/EA4.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/DbUtils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/Installed.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/exists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/exists_nofollow.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/More/Lite.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/Enabled/Spamd.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Dovecot/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/Enabled.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileLookup.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AcctUtils/DomainOwner/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/FileUtils/Read.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/EventImportance/Legacy.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/EventImportance.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/Providers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/EmailLocalPart.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/WildcardDomain/Tiny.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/EmailCpanel.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/Domain.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/VirtualUsername.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Time/HTTP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Email/Object.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/Email.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Whostmgr/UI.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AcctUtils/Domain.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/userdata/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AcctUtils/Account.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AcctUtils/Lookup/Webmail.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AcctUtils/Lookup.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sereal/Decoder.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sereal/Encoder.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/JSON/Sanitize.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/UntrustedException.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ForkSync.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pack/Template.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Id.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AccessIds/SetUids.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Setsid/Fast.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/AccessIds.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Reseller.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Features/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Team/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Features/Load.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Features/Cpanel.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Features/Custom.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/App.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Themes/Get.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/EmailRFC.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ContactInfo/Email.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/FilesystemPath.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MultiUserDirStore.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MultiUserDirStore/TimeIndexedData.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MultiUserDirStore/VirtualUser.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MultiUserDirStore/VirtualUser/TimeIndexedData.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/History.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/Directory.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Fuser.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/IO/Callback/Write.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Destruct/DestroyDetector.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IOCallbackWriteLine/Buffer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IOCallbackWriteLine.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Extra.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Role/Cmd.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Role/Debian.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/Dpkg.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/DpkgQuery.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parser/DpkgQuery.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeChdir.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/Pkgr/DEB.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Gpg.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Rpm.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/Pkgr/RPM.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/Pkgr.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sync/Digest.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/URL.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/OSSys/Env.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Hardware/Memory/Linux.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Hardware/Memory/Vzzo.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Hardware/Memory.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Cpu.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ConfigFiles/RpmVersions.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ArrayFunc/Shuffle.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Alarm.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SocketIP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/UrlTools.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sync/Common.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HttpTimer.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/MirrorSearch.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/VendorKeys/TimestampCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Crypt/GPG/VendorKeys/Verify.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/HttpRequest.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Services/Running.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Chdir.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SafeRun/Full.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Hooks.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/RPM/Versions/File.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Fcntl/Types.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sync/v2.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Mkdir.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/Apt.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/AptCache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/AptGet.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Debian/AptMark.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parser/Line.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parser/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Parser/Callback.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/APT/Preferences.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/APT/Preferences/ExcludePackages.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/EA4/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pkgr/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Slurper.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pkgr/Apt.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/RepoQuery.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pkgr/Yum.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Pkgr.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Terminal.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/UTF8.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/StringFunc/Fmt.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted/Plain.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted/Terminal.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/APT.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Yum.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Repos/Utils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Multi.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/TimeStamp.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted/TimeStamp.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted/TerminalTimeStamp.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Output/Formatted/TimestampedPlain.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Install/Utils/Logger.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/YUM.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Binaries/Dnf.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs/DNF.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysPkgs.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Yum/Vars.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/EA4/Install.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sysup.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Proc/Bin.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Proc/Basename.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Info.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Sys/Uptime.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SysConf/Constants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PsParser/SysInfo.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PsParser/Fallback.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PsParser.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Signal/Numbers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Kill.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Signal.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/Base.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IP/NonlocalBind/Cache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Validate/IP/Expand.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IP/Expand.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Linux/Netlink.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Linux/NetlinkConstants.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Linux/RtNetlink.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IP/Configured.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/IP/Bound.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NAT/Object.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/NAT.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/DIp/MainIP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/CpanelConfig.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/Constants/MySQL.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/MySQL.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/RemoteMySQL.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LinkedNode/Privileged/Configuration.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LinkedNode/Index.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/LinkedNode/Index/Read.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Data/Result.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/PromiseUtils.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/WorkerNodes.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Version/Compare/Package.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ConfigFiles/Apache.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Config/Httpd/Vendor.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/Always.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker/LTS.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Blocker.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Tiers.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Usage.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Update/Now.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/DB/Territory/en.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/CPAN/Locales/DB/Language/en.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SMTP.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/SMTP/Singleton.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Email/Send.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/ServiceAuth.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/Provider.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/iContact/Provider/Email.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/chmod.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/chmod_if_exists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/close.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/fcntl.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/link.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/open.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/print.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/read.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/readlink.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/readlink_if_exists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/rename.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/seek.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/stat.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/sysread.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/sysread_sigguard.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/syswrite.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/syswrite_sigguard.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/truncate.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/CORE/unlink_if_exists.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
$INC{'Cpanel/Autodie/UpdateNow.pm'} = '/usr/local/cpanel/scripts/updatenow.static';
}
{ # --- BEGIN File::Path::Tiny
package File::Path::Tiny;
use strict;
use warnings;
use Cwd qw(cwd chdir);
use Carp ();
$File::Path::Tiny::VERSION = "1.0";
sub mk {
my ( $path, $mask ) = @_;
return 2 if -d $path;
if ( -e $path ) { $! = 20; return; }
$mask ||= '0777'; # Perl::Critic == Integer with leading zeros at ...
$mask = oct($mask) if substr( $mask, 0, 1 ) eq '0';
require File::Spec;
my ( $vol, $directories ) = File::Spec->splitpath( $path, 1 );
my @dirs = File::Spec->splitdir($directories);
my @list;
while ( my ($_dir) = shift @dirs ) {
last if not defined $_dir;
push @list, $_dir;
next if ( $_dir eq '' );
my $progressive = File::Spec->catpath( $vol, File::Spec->catdir(@list), '' );
if ( !-d $progressive ) {
mkdir( $progressive, $mask ) or -d $progressive or return;
}
}
return 1 if -d $path;
return;
}
sub rm {
my ( $path, $fast ) = @_;
my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ];
if ( -e _ && !-d _ ) { $! = 20; return; }
return 2 if !-d _;
empty_dir( $path, $fast ) or return;
_bail_if_changed( $path, $orig_dev, $orig_ino );
rmdir($path) or !-e $path or return;
return 1;
}
sub empty_dir {
my ( $path, $fast ) = @_;
my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ];
if ( -e _ && !-d _ ) { $! = 20; return; }
my ( $starting_point, $starting_dev, $starting_ino );
if ( !$fast ) {
$starting_point = cwd();
( $starting_dev, $starting_ino ) = ( lstat $starting_point )[ 0, 1 ];
chdir($path) or Carp::croak("Failed to change directory to “$path”: $!");
$path = '.';
_bail_if_changed( $path, $orig_dev, $orig_ino );
}
opendir( my $dh, $path ) or return;
my @contents = grep { $_ ne '.' && $_ ne '..' } readdir($dh);
closedir $dh;
_bail_if_changed( $path, $orig_dev, $orig_ino );
require File::Spec if @contents;
for my $thing (@contents) {
my $long = File::Spec->catdir( $path, $thing );
if ( !-l $long && -d _ ) {
_bail_if_changed( $path, $orig_dev, $orig_ino );
rm( $long, $fast ) or !-e $long or return;
}
else {
_bail_if_changed( $path, $orig_dev, $orig_ino );
unlink $long or !-e $long or return;
}
}
_bail_if_changed( $path, $orig_dev, $orig_ino );
if ( !$fast ) {
chdir($starting_point) or Carp::croak("Failed to change directory to “$starting_point”: $!");
_bail_if_changed( ".", $starting_dev, $starting_ino );
}
return 1;
}
sub mk_parent {
my ( $path, $mode ) = @_;
$path =~ s{/+$}{};
require File::Spec;
my ( $v, $d, $f ) = File::Spec->splitpath( $path, 1 );
my @p = File::Spec->splitdir($d);
# pop() is probably cheaper here, benchmark? $d = File::Spec->catdir(@p[0--$#p-1]);
pop @p;
$d = File::Spec->catdir(@p);
my $parent = File::Spec->catpath( $v, $d, $f );
return mk( $parent, $mode );
}
sub _bail_if_changed {
my ( $path, $orig_dev, $orig_ino ) = @_;
my ( $cur_dev, $cur_ino ) = ( lstat $path )[ 0, 1 ];
if ( !defined $cur_dev || !defined $cur_ino ) {
$cur_dev ||= "undef(path went away?)";
$cur_ino ||= "undef(path went away?)";
}
else {
$path = Cwd::abs_path($path);
}
if ( $orig_dev ne $cur_dev || $orig_ino ne $cur_ino ) {
local $Carp::CarpLevel += 1;
Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting");
}
}
1;
} # --- END File::Path::Tiny
{ # --- BEGIN HTTP::Tiny
# vim: ts=4 sts=4 sw=4 et:
package HTTP::Tiny;
use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client
our $VERSION = '0.080';
sub _croak { require Carp; Carp::croak(@_) }
#pod =method new
#pod
#pod $http = HTTP::Tiny->new( %attributes );
#pod
#pod This constructor returns a new HTTP::Tiny object. Valid attributes include:
#pod
#pod =for :list
#pod * C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If
#pod C<agent> — ends in a space character, the default user-agent string is
#pod appended.
#pod * C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class
#pod that supports the C<add> and C<cookie_header> methods
#pod * C<default_headers> — A hashref of default headers to apply to requests
#pod * C<local_address> — The local IP address to bind to
#pod * C<keep_alive> — Whether to reuse the last connection (if for the same
#pod scheme, host and port) (defaults to 1)
#pod * C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
#pod * C<max_size> — Maximum response size in bytes (only when not using a data
#pod callback). If defined, requests with responses larger than this will return
#pod a 599 status code.
#pod * C<http_proxy> — URL of a proxy server to use for HTTP connections
#pod (default is C<$ENV{http_proxy}> — if set)
#pod * C<https_proxy> — URL of a proxy server to use for HTTPS connections
#pod (default is C<$ENV{https_proxy}> — if set)
#pod * C<proxy> — URL of a generic proxy server for both HTTP and HTTPS
#pod connections (default is C<$ENV{all_proxy}> — if set)
#pod * C<no_proxy> — List of domain suffixes that should not be proxied. Must
#pod be a comma-separated string or an array reference. (default is
#pod C<$ENV{no_proxy}> —)
#pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
#pod read or write takes longer than the timeout, the request response status code
#pod will be 599.
#pod * C<verify_SSL> — A boolean that indicates whether to validate the SSL
#pod certificate of an C<https> — connection (default is false)
#pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to
#pod L<IO::Socket::SSL>
#pod
#pod An accessor/mutator method exists for each attribute.
#pod
#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
#pod prevent getting the corresponding proxies from the environment.
#pod
#pod Errors during request execution will result in a pseudo-HTTP status code of 599
#pod and a reason of "Internal Exception". The content field in the response will
#pod contain the text of the error.
#pod
#pod The C<keep_alive> parameter enables a persistent connection, but only to a
#pod single destination scheme, host and port. If any connection-relevant
#pod attributes are modified via accessor, or if the process ID or thread ID change,
#pod the persistent connection will be dropped. If you want persistent connections
#pod across multiple destinations, use multiple HTTP::Tiny objects.
#pod
#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
#pod
#pod =cut
my @attributes;
BEGIN {
@attributes = qw(
cookie_jar default_headers http_proxy https_proxy keep_alive
local_address max_redirect max_size proxy no_proxy
SSL_options verify_SSL
);
my %persist_ok = map {; $_ => 1 } qw(
cookie_jar default_headers max_redirect max_size
);
no strict 'refs';
no warnings 'uninitialized';
for my $accessor ( @attributes ) {
*{$accessor} = sub {
@_ > 1
? do {
delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
$_[0]->{$accessor} = $_[1]
}
: $_[0]->{$accessor};
};
}
}
sub agent {
my($self, $agent) = @_;
if( @_ > 1 ){
$self->{agent} =
(defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
}
return $self->{agent};
}
sub timeout {
my ($self, $timeout) = @_;
if ( @_ > 1 ) {
$self->{timeout} = $timeout;
if ($self->{handle}) {
$self->{handle}->timeout($timeout);
}
}
return $self->{timeout};
}
sub new {
my($class, %args) = @_;
my $self = {
max_redirect => 5,
timeout => defined $args{timeout} ? $args{timeout} : 60,
keep_alive => 1,
verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
no_proxy => $ENV{no_proxy},
};
bless $self, $class;
$class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
for my $key ( @attributes ) {
$self->{$key} = $args{$key} if exists $args{$key}
}
$self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
$self->_set_proxies;
return $self;
}
sub _set_proxies {
my ($self) = @_;
# get proxies from %ENV only if not provided; explicit undef will disable
# getting proxies from the environment
# generic proxy
if (! exists $self->{proxy} ) {
$self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
}
if ( defined $self->{proxy} ) {
$self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
}
else {
delete $self->{proxy};
}
# http proxy
if (! exists $self->{http_proxy} ) {
# under CGI, bypass HTTP_PROXY as request sets it from Proxy header
local $ENV{HTTP_PROXY} = ($ENV{CGI_HTTP_PROXY} || "") if $ENV{REQUEST_METHOD};
$self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
}
if ( defined $self->{http_proxy} ) {
$self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
$self->{_has_proxy}{http} = 1;
}
else {
delete $self->{http_proxy};
}
# https proxy
if (! exists $self->{https_proxy} ) {
$self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
}
if ( $self->{https_proxy} ) {
$self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
$self->{_has_proxy}{https} = 1;
}
else {
delete $self->{https_proxy};
}
# Split no_proxy to array reference if not provided as such
unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
$self->{no_proxy} =
(defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
}
return;
}
#pod =method get|head|put|post|patch|delete
#pod
#pod $response = $http->get($url);
#pod $response = $http->get($url, \%options);
#pod $response = $http->head($url);
#pod
#pod These methods are shorthand for calling C<request()> for the given method. The
#pod URL must have unsafe characters escaped and international domain names encoded.
#pod See C<request()> for valid options and a description of the response.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX.
#pod
#pod =cut
for my $sub_name ( qw/get head put post patch delete/ ) {
my $req_method = uc $sub_name;
no strict 'refs';
eval <<"HERE"; ## no critic
sub $sub_name {
my (\$self, \$url, \$args) = \@_;
\@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
return \$self->request('$req_method', \$url, \$args || {});
}
HERE
}
#pod =method post_form
#pod
#pod $response = $http->post_form($url, $form_data);
#pod $response = $http->post_form($url, $form_data, \%options);
#pod
#pod This method executes a C<POST> request and sends the key/value pairs from a
#pod form data hash or array reference to the given URL with a C<content-type> of
#pod C<application/x-www-form-urlencoded>. If data is provided as an array
#pod reference, the order is preserved; if provided as a hash reference, the terms
#pod are sorted on key and value for consistency. See documentation for the
#pod C<www_form_urlencode> method for details on the encoding.
#pod
#pod The URL must have unsafe characters escaped and international domain names
#pod encoded. See C<request()> for valid options and a description of the response.
#pod Any C<content-type> header or content in the options hashref will be ignored.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX.
#pod
#pod =cut
sub post_form {
my ($self, $url, $data, $args) = @_;
(@_ == 3 || @_ == 4 && ref $args eq 'HASH')
or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
my $headers = {};
while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
$headers->{lc $key} = $value;
}
delete $args->{headers};
return $self->request('POST', $url, {
%$args,
content => $self->www_form_urlencode($data),
headers => {
%$headers,
'content-type' => 'application/x-www-form-urlencoded'
},
}
);
}
#pod =method mirror
#pod
#pod $response = $http->mirror($url, $file, \%options)
#pod if ( $response->{success} ) {
#pod print "$file is up to date\n";
#pod }
#pod
#pod Executes a C<GET> request for the URL and saves the response body to the file
#pod name provided. The URL must have unsafe characters escaped and international
#pod domain names encoded. If the file already exists, the request will include an
#pod C<If-Modified-Since> header with the modification timestamp of the file. You
#pod may specify a different C<If-Modified-Since> header yourself in the C<<
#pod $options->{headers} >> hash.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX
#pod or if the status code is 304 (unmodified).
#pod
#pod If the file was modified and the server response includes a properly
#pod formatted C<Last-Modified> header, the file modification time will
#pod be updated accordingly.
#pod
#pod =cut
sub mirror {
my ($self, $url, $file, $args) = @_;
@_ == 3 || (@_ == 4 && ref $args eq 'HASH')
or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
if ( exists $args->{headers} ) {
my $headers = {};
while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
$headers->{lc $key} = $value;
}
$args->{headers} = $headers;
}
if ( -e $file and my $mtime = (stat($file))[9] ) {
$args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
}
my $tempfile = $file . int(rand(2**31));
require Fcntl;
sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
binmode $fh;
$args->{data_callback} = sub { print {$fh} $_[0] };
my $response = $self->request('GET', $url, $args);
close $fh
or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
if ( $response->{success} ) {
rename $tempfile, $file
or _croak(qq/Error replacing $file with $tempfile: $!\n/);
my $lm = $response->{headers}{'last-modified'};
if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
utime $mtime, $mtime, $file;
}
}
$response->{success} ||= $response->{status} eq '304';
unlink $tempfile;
return $response;
}
#pod =method request
#pod
#pod $response = $http->request($method, $url);
#pod $response = $http->request($method, $url, \%options);
#pod
#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
#pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
#pod international domain names encoded.
#pod
#pod B<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification.
#pod Don't use C<get> when you really want C<GET>. See L<LIMITATIONS> for
#pod how this applies to redirection.
#pod
#pod If the URL includes a "user:password" stanza, they will be used for Basic-style
#pod authorization headers. (Authorization headers will not be included in a
#pod redirected request.) For example:
#pod
#pod $http->request('GET', 'http://Aladdin:open [email protected]/');
#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:[email protected]/');
#pod
#pod A hashref of options may be appended to modify the request.
#pod
#pod Valid options are:
#pod
#pod =for :list
#pod * C<headers> —
#pod A hashref containing headers to include with the request. If the value for
#pod a header is an array reference, the header will be output multiple times with
#pod each value in the array. These headers over-write any default headers.
#pod * C<content> —
#pod A scalar to include as the body of the request OR a code reference
#pod that will be called iteratively to produce the body of the request
#pod * C<trailer_callback> —
#pod A code reference that will be called if it exists to provide a hashref
#pod of trailing headers (only used with chunked transfer-encoding)
#pod * C<data_callback> —
#pod A code reference that will be called for each chunks of the response
#pod body received.
#pod * C<peer> —
#pod Override host resolution and force all connections to go only to a
#pod specific peer address, regardless of the URL of the request. This will
#pod include any redirections! This options should be used with extreme
#pod caution (e.g. debugging or very special circumstances). It can be given as
#pod either a scalar or a code reference that will receive the hostname and
#pod whose response will be taken as the address.
#pod
#pod The C<Host> header is generated from the URL in accordance with RFC 2616. It
#pod is a fatal error to specify C<Host> in the C<headers> option. Other headers
#pod may be ignored or overwritten if necessary for transport compliance.
#pod
#pod If the C<content> option is a code reference, it will be called iteratively
#pod to provide the content body of the request. It should return the empty
#pod string or undef when the iterator is exhausted.
#pod
#pod If the C<content> option is the empty string, no C<content-type> or
#pod C<content-length> headers will be generated.
#pod
#pod If the C<data_callback> option is provided, it will be called iteratively until
#pod the entire response body is received. The first argument will be a string
#pod containing a chunk of the response body, the second argument will be the
#pod in-progress response hash reference, as described below. (This allows
#pod customizing the action of the callback based on the C<status> or C<headers>
#pod received prior to the content body.)
#pod
#pod The C<request> method returns a hashref containing the response. The hashref
#pod will have the following keys:
#pod
#pod =for :list
#pod * C<success> —
#pod Boolean indicating whether the operation returned a 2XX status code
#pod * C<url> —
#pod URL that provided the response. This is the URL of the request unless
#pod there were redirections, in which case it is the last URL queried
#pod in a redirection chain
#pod * C<status> —
#pod The HTTP status code of the response
#pod * C<reason> —
#pod The response phrase returned by the server
#pod * C<content> —
#pod The body of the response. If the response does not have any content
#pod or if a data callback is provided to consume the response body,
#pod this will be the empty string
#pod * C<headers> —
#pod A hashref of header fields. All header field names will be normalized
#pod to be lower case. If a header is repeated, the value will be an arrayref;
#pod it will otherwise be a scalar string containing the value
#pod * C<protocol> -
#pod If this field exists, it is the protocol of the response
#pod such as HTTP/1.0 or HTTP/1.1
#pod * C<redirects>
#pod If this field exists, it is an arrayref of response hash references from
#pod redirects in the same order that redirections occurred. If it does
#pod not exist, then no redirections occurred.
#pod
#pod On an error during the execution of the request, the C<status> field will
#pod contain 599, and the C<content> field will contain the text of the error.
#pod
#pod =cut
my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
sub request {
my ($self, $method, $url, $args) = @_;
@_ == 3 || (@_ == 4 && ref $args eq 'HASH')
or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
$args ||= {}; # we keep some state in this during _request
# RFC 2616 Section 8.1.4 mandates a single retry on broken socket
my $response;
for ( 0 .. 1 ) {
$response = eval { $self->_request($method, $url, $args) };
last unless $@ && $idempotent{$method}
&& $@ =~ m{^(?:Socket closed|Unexpected end|SSL read error)};
}
if (my $e = $@) {
# maybe we got a response hash thrown from somewhere deep
if ( ref $e eq 'HASH' && exists $e->{status} ) {
$e->{redirects} = delete $args->{_redirects} if @{ $args->{_redirects} || []};
return $e;
}
# otherwise, stringify it
$e = "$e";
$response = {
url => $url,
success => q{},
status => 599,
reason => 'Internal Exception',
content => $e,
headers => {
'content-type' => 'text/plain',
'content-length' => length $e,
},
( @{$args->{_redirects} || []} ? (redirects => delete $args->{_redirects}) : () ),
};
}
return $response;
}
#pod =method www_form_urlencode
#pod
#pod $params = $http->www_form_urlencode( $data );
#pod $response = $http->get("http://example.com/query?$params");
#pod
#pod This method converts the key/value pairs from a data hash or array reference
#pod into a C<x-www-form-urlencoded> string. The keys and values from the data
#pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
#pod array reference, the key will be repeated with each of the values of the array
#pod reference. If data is provided as a hash reference, the key/value pairs in the
#pod resulting string will be sorted by key and value for consistent ordering.
#pod
#pod =cut
sub www_form_urlencode {
my ($self, $data) = @_;
(@_ == 2 && ref $data)
or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
(ref $data eq 'HASH' || ref $data eq 'ARRAY')
or _croak("form data must be a hash or array reference\n");
my @params = ref $data eq 'HASH' ? %$data : @$data;
@params % 2 == 0
or _croak("form data reference must have an even number of terms\n");
my @terms;
while( @params ) {
my ($key, $value) = splice(@params, 0, 2);
_croak("form data keys must not be undef")
if !defined($key);
if ( ref $value eq 'ARRAY' ) {
unshift @params, map { $key => $_ } @$value;
}
else {
push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
}
}
return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
}
#pod =method can_ssl
#pod
#pod $ok = HTTP::Tiny->can_ssl;
#pod ($ok, $why) = HTTP::Tiny->can_ssl;
#pod ($ok, $why) = $http->can_ssl;
#pod
#pod Indicates if SSL support is available. When called as a class object, it
#pod checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
#pod When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
#pod is set in C<SSL_options>, it checks that a CA file is available.
#pod
#pod In scalar context, returns a boolean indicating if SSL is available.
#pod In list context, returns the boolean and a (possibly multi-line) string of
#pod errors indicating why SSL isn't available.
#pod
#pod =cut
sub can_ssl {
my ($self) = @_;
my($ok, $reason) = (1, '');
# Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
local @INC = @INC;
pop @INC if $INC[-1] eq '.';
unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
$ok = 0;
$reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
}
# Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
$ok = 0;
$reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
}
# If an object, check that SSL config lets us get a CA if necessary
if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
my $handle = HTTP::Tiny::Handle->new(
SSL_options => $self->{SSL_options},
verify_SSL => $self->{verify_SSL},
);
unless ( eval { $handle->_find_CA_file; 1 } ) {
$ok = 0;
$reason .= "$@";
}
}
wantarray ? ($ok, $reason) : $ok;
}
#pod =method connected
#pod
#pod $host = $http->connected;
#pod ($host, $port) = $http->connected;
#pod
#pod Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
#pod option.
#pod
#pod In scalar context, returns the peer host and port, joined with a colon, or
#pod C<undef> (if no peer is connected).
#pod In list context, returns the peer host and port or an empty list (if no peer
#pod is connected).
#pod
#pod B<Note>: This method cannot reliably be used to discover whether the remote
#pod host has closed its end of the socket.
#pod
#pod =cut
sub connected {
my ($self) = @_;
if ( $self->{handle} ) {
return $self->{handle}->connected;
}
return;
}
#--------------------------------------------------------------------------#
# private methods
#--------------------------------------------------------------------------#
my %DefaultPort = (
http => 80,
https => 443,
);
sub _agent {
my $class = ref($_[0]) || $_[0];
(my $default_agent = $class) =~ s{::}{-}g;
my $version = $class->VERSION;
$default_agent .= "/$version" if defined $version;
return $default_agent;
}
sub _request {
my ($self, $method, $url, $args) = @_;
my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
if ($scheme ne 'http' && $scheme ne 'https') {
die(qq/Unsupported URL scheme '$scheme'\n/);
}
my $request = {
method => $method,
scheme => $scheme,
host => $host,
port => $port,
host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
uri => $path_query,
headers => {},
};
my $peer = $args->{peer} || $host;
# Allow 'peer' to be a coderef.
if ('CODE' eq ref $peer) {
$peer = $peer->($host);
}
# We remove the cached handle so it is not reused in the case of redirect.
# If all is well, it will be recached at the end of _request. We only
# reuse for the same scheme, host and port
my $handle = delete $self->{handle};
if ( $handle ) {
unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) {
$handle->close;
undef $handle;
}
}
$handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer );
$self->_prepare_headers_and_cb($request, $args, $url, $auth);
$handle->write_request($request);
my $response;
do { $response = $handle->read_response_header }
until (substr($response->{status},0,1) ne '1');
$self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
my @redir_args = $self->_maybe_redirect($request, $response, $args);
my $known_message_length;
if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
# response has no message body
$known_message_length = 1;
}
else {
# Ignore any data callbacks during redirection.
my $cb_args = @redir_args ? +{} : $args;
my $data_cb = $self->_prepare_data_cb($response, $cb_args);
$known_message_length = $handle->read_body($data_cb, $response);
}
if ( $self->{keep_alive}
&& $handle->connected
&& $known_message_length
&& $response->{protocol} eq 'HTTP/1.1'
&& ($response->{headers}{connection} || '') ne 'close'
) {
$self->{handle} = $handle;
}
else {
$handle->close;
}
$response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
$response->{url} = $url;
# Push the current response onto the stack of redirects if redirecting.
if (@redir_args) {
push @{$args->{_redirects}}, $response;
return $self->_request(@redir_args, $args);
}
# Copy the stack of redirects into the response before returning.
$response->{redirects} = delete $args->{_redirects}
if @{$args->{_redirects}};
return $response;
}
sub _open_handle {
my ($self, $request, $scheme, $host, $port, $peer) = @_;
my $handle = HTTP::Tiny::Handle->new(
timeout => $self->{timeout},
SSL_options => $self->{SSL_options},
verify_SSL => $self->{verify_SSL},
local_address => $self->{local_address},
keep_alive => $self->{keep_alive}
);
if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
return $self->_proxy_connect( $request, $handle );
}
else {
return $handle->connect($scheme, $host, $port, $peer);
}
}
sub _proxy_connect {
my ($self, $request, $handle) = @_;
my @proxy_vars;
if ( $request->{scheme} eq 'https' ) {
_croak(qq{No https_proxy defined}) unless $self->{https_proxy};
@proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
if ( $proxy_vars[0] eq 'https' ) {
_croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
}
}
else {
_croak(qq{No http_proxy defined}) unless $self->{http_proxy};
@proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
}
my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
$self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
}
$handle->connect($p_scheme, $p_host, $p_port, $p_host);
if ($request->{scheme} eq 'https') {
$self->_create_proxy_tunnel( $request, $handle );
}
else {
# non-tunneled proxy requires absolute URI
$request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
}
return $handle;
}
sub _split_proxy {
my ($self, $type, $proxy) = @_;
my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
unless(
defined($scheme) && length($scheme) && length($host) && length($port)
&& $path_query eq '/'
) {
_croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
}
return ($scheme, $host, $port, $auth);
}
sub _create_proxy_tunnel {
my ($self, $request, $handle) = @_;
$handle->_assert_ssl;
my $agent = exists($request->{headers}{'user-agent'})
? $request->{headers}{'user-agent'} : $self->{agent};
my $connect_request = {
method => 'CONNECT',
uri => "$request->{host}:$request->{port}",
headers => {
host => "$request->{host}:$request->{port}",
'user-agent' => $agent,
}
};
if ( $request->{headers}{'proxy-authorization'} ) {
$connect_request->{headers}{'proxy-authorization'} =
delete $request->{headers}{'proxy-authorization'};
}
$handle->write_request($connect_request);
my $response;
do { $response = $handle->read_response_header }
until (substr($response->{status},0,1) ne '1');
# if CONNECT failed, throw the response so it will be
# returned from the original request() method;
unless (substr($response->{status},0,1) eq '2') {
die $response;
}
# tunnel established, so start SSL handshake
$handle->start_ssl( $request->{host} );
return;
}
sub _prepare_headers_and_cb {
my ($self, $request, $args, $url, $auth) = @_;
for ($self->{default_headers}, $args->{headers}) {
next unless defined;
while (my ($k, $v) = each %$_) {
$request->{headers}{lc $k} = $v;
$request->{header_case}{lc $k} = $k;
}
}
if (exists $request->{headers}{'host'}) {
die(qq/The 'Host' header must not be provided as header option\n/);
}
$request->{headers}{'host'} = $request->{host_port};
$request->{headers}{'user-agent'} ||= $self->{agent};
$request->{headers}{'connection'} = "close"
unless $self->{keep_alive};
# Some servers error on an empty-body PUT/POST without a content-length
if ( $request->{method} eq 'PUT' || $request->{method} eq 'POST' ) {
if (!defined($args->{content}) || !length($args->{content}) ) {
$request->{headers}{'content-length'} = 0;
}
}
if ( defined $args->{content} ) {
if ( ref $args->{content} eq 'CODE' ) {
if ( exists $request->{'content-length'} && $request->{'content-length'} == 0 ) {
$request->{cb} = sub { "" };
}
else {
$request->{headers}{'content-type'} ||= "application/octet-stream";
$request->{headers}{'transfer-encoding'} = 'chunked'
unless exists $request->{headers}{'content-length'}
|| $request->{headers}{'transfer-encoding'};
$request->{cb} = $args->{content};
}
}
elsif ( length $args->{content} ) {
my $content = $args->{content};
if ( $] ge '5.008' ) {
utf8::downgrade($content, 1)
or die(qq/Wide character in request message body\n/);
}
$request->{headers}{'content-type'} ||= "application/octet-stream";
$request->{headers}{'content-length'} = length $content
unless $request->{headers}{'content-length'}
|| $request->{headers}{'transfer-encoding'};
$request->{cb} = sub { substr $content, 0, length $content, '' };
}
$request->{trailer_cb} = $args->{trailer_callback}
if ref $args->{trailer_callback} eq 'CODE';
}
### If we have a cookie jar, then maybe add relevant cookies
if ( $self->{cookie_jar} ) {
my $cookies = $self->cookie_jar->cookie_header( $url );
$request->{headers}{cookie} = $cookies if length $cookies;
}
# if we have Basic auth parameters, add them
if ( length $auth && ! defined $request->{headers}{authorization} ) {
$self->_add_basic_auth_header( $request, 'authorization' => $auth );
}
return;
}
sub _add_basic_auth_header {
my ($self, $request, $header, $auth) = @_;
require MIME::Base64;
$request->{headers}{$header} =
"Basic " . MIME::Base64::encode_base64($auth, "");
return;
}
sub _prepare_data_cb {
my ($self, $response, $args) = @_;
my $data_cb = $args->{data_callback};
$response->{content} = '';
if (!$data_cb || $response->{status} !~ /^2/) {
if (defined $self->{max_size}) {
$data_cb = sub {
$_[1]->{content} .= $_[0];
die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
if length $_[1]->{content} > $self->{max_size};
};
}
else {
$data_cb = sub { $_[1]->{content} .= $_[0] };
}
}
return $data_cb;
}
sub _update_cookie_jar {
my ($self, $url, $response) = @_;
my $cookies = $response->{headers}->{'set-cookie'};
return unless defined $cookies;
my @cookies = ref $cookies ? @$cookies : $cookies;
$self->cookie_jar->add( $url, $_ ) for @cookies;
return;
}
sub _validate_cookie_jar {
my ($class, $jar) = @_;
# duck typing
for my $method ( qw/add cookie_header/ ) {
_croak(qq/Cookie jar must provide the '$method' method\n/)
unless ref($jar) && ref($jar)->can($method);
}
return;
}
sub _maybe_redirect {
my ($self, $request, $response, $args) = @_;
my $headers = $response->{headers};
my ($status, $method) = ($response->{status}, $request->{method});
$args->{_redirects} ||= [];
if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))
and $headers->{location}
and @{$args->{_redirects}} < $self->{max_redirect}
) {
my $location = ($headers->{location} =~ /^\//)
? "$request->{scheme}://$request->{host_port}$headers->{location}"
: $headers->{location} ;
return (($status eq '303' ? 'GET' : $method), $location);
}
return;
}
sub _split_url {
my $url = pop;
# URI regex adapted from the URI module
my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
or die(qq/Cannot parse URL: '$url'\n/);
$scheme = lc $scheme;
$path_query = "/$path_query" unless $path_query =~ m<\A/>;
my $auth = '';
if ( (my $i = index $host, '@') != -1 ) {
# user:pass@host
$auth = substr $host, 0, $i, ''; # take up to the @ for auth
substr $host, 0, 1, ''; # knock the @ off the host
# userinfo might be percent escaped, so recover real auth info
$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
}
my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
: $scheme eq 'http' ? 80
: $scheme eq 'https' ? 443
: undef;
return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
}
# Date conversions adapted from HTTP::Date
my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
sub _http_date {
my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
substr($DoW,$wday*4,3),
$mday, substr($MoY,$mon*4,3), $year+1900,
$hour, $min, $sec
);
}
sub _parse_http_date {
my ($self, $str) = @_;
require Time::Local;
my @tl_parts;
if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
@tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
}
elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
@tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
}
elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
@tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
}
return eval {
my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
$t < 0 ? undef : $t;
};
}
# URI escaping adapted from URI::Escape
# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
$escapes{' '}="+";
my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
sub _uri_escape {
my ($self, $str) = @_;
return "" if !defined $str;
if ( $] ge '5.008' ) {
utf8::encode($str);
}
else {
$str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
if ( length $str == do { use bytes; length $str } );
$str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
}
$str =~ s/($unsafe_char)/$escapes{$1}/g;
return $str;
}
package
HTTP::Tiny::Handle; # hide from PAUSE/indexers
use strict;
use warnings;
use Errno qw[EINTR EPIPE];
use IO::Socket qw[SOCK_STREAM];
use Socket qw[SOL_SOCKET SO_KEEPALIVE];
# PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
# behavior if someone is unable to boostrap CPAN from a new perl install; it is
# not intended for general, per-client use and may be removed in the future
my $SOCKET_CLASS =
$ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.32) } ? 'IO::Socket::IP' :
'IO::Socket::INET';
sub BUFSIZE () { 32768 } ## no critic
my $Printable = sub {
local $_ = shift;
s/\r/\\r/g;
s/\n/\\n/g;
s/\t/\\t/g;
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
$_;
};
my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;
sub new {
my ($class, %args) = @_;
return bless {
rbuf => '',
timeout => 60,
max_line_size => 16384,
max_header_lines => 64,
verify_SSL => 0,
SSL_options => {},
%args
}, $class;
}
sub timeout {
my ($self, $timeout) = @_;
if ( @_ > 1 ) {
$self->{timeout} = $timeout;
if ( $self->{fh} && $self->{fh}->can('timeout') ) {
$self->{fh}->timeout($timeout);
}
}
return $self->{timeout};
}
sub connect {
@_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
my ($self, $scheme, $host, $port, $peer) = @_;
if ( $scheme eq 'https' ) {
$self->_assert_ssl;
}
$self->{fh} = $SOCKET_CLASS->new(
PeerHost => $peer,
PeerPort => $port,
$self->{local_address} ?
( LocalAddr => $self->{local_address} ) : (),
Proto => 'tcp',
Type => SOCK_STREAM,
Timeout => $self->{timeout},
) or die(qq/Could not connect to '$host:$port': $@\n/);
binmode($self->{fh})
or die(qq/Could not binmode() socket: '$!'\n/);
if ( $self->{keep_alive} ) {
unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
CORE::close($self->{fh});
die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
}
}
$self->start_ssl($host) if $scheme eq 'https';
$self->{scheme} = $scheme;
$self->{host} = $host;
$self->{peer} = $peer;
$self->{port} = $port;
$self->{pid} = $$;
$self->{tid} = _get_tid();
return $self;
}
sub connected {
my ($self) = @_;
if ( $self->{fh} && $self->{fh}->connected ) {
return wantarray
? ( $self->{fh}->peerhost, $self->{fh}->peerport )
: join( ':', $self->{fh}->peerhost, $self->{fh}->peerport );
}
return;
}
sub start_ssl {
my ($self, $host) = @_;
# As this might be used via CONNECT after an SSL session
# to a proxy, we shut down any existing SSL before attempting
# the handshake
if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
unless ( $self->{fh}->stop_SSL ) {
my $ssl_err = IO::Socket::SSL->errstr;
die(qq/Error halting prior SSL connection: $ssl_err/);
}
}
my $ssl_args = $self->_ssl_args($host);
IO::Socket::SSL->start_SSL(
$self->{fh},
%$ssl_args,
SSL_create_ctx_callback => sub {
my $ctx = shift;
Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
},
);
unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
my $ssl_err = IO::Socket::SSL->errstr;
die(qq/SSL connection failed for $host: $ssl_err\n/);
}
}
sub close {
@_ == 1 || die(q/Usage: $handle->close()/ . "\n");
my ($self) = @_;
CORE::close($self->{fh})
or die(qq/Could not close socket: '$!'\n/);
}
sub write {
@_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
my ($self, $buf) = @_;
if ( $] ge '5.008' ) {
utf8::downgrade($buf, 1)
or die(qq/Wide character in write()\n/);
}
my $len = length $buf;
my $off = 0;
local $SIG{PIPE} = 'IGNORE';
while () {
$self->can_write
or die(qq/Timed out while waiting for socket to become ready for writing\n/);
my $r = syswrite($self->{fh}, $buf, $len, $off);
if (defined $r) {
$len -= $r;
$off += $r;
last unless $len > 0;
}
elsif ($! == EPIPE) {
die(qq/Socket closed by remote server: $!\n/);
}
elsif ($! != EINTR) {
if ($self->{fh}->can('errstr')){
my $err = $self->{fh}->errstr();
die (qq/Could not write to SSL socket: '$err'\n /);
}
else {
die(qq/Could not write to socket: '$!'\n/);
}
}
}
return $off;
}
sub read {
@_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
my ($self, $len, $allow_partial) = @_;
my $buf = '';
my $got = length $self->{rbuf};
if ($got) {
my $take = ($got < $len) ? $got : $len;
$buf = substr($self->{rbuf}, 0, $take, '');
$len -= $take;
}
# Ignore SIGPIPE because SSL reads can result in writes that might error.
# See "Expecting exactly the same behavior as plain sockets" in
# https://metacpan.org/dist/IO-Socket-SSL/view/lib/IO/Socket/SSL.pod#Common-Usage-Errors
local $SIG{PIPE} = 'IGNORE';
while ($len > 0) {
$self->can_read
or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
my $r = sysread($self->{fh}, $buf, $len, length $buf);
if (defined $r) {
last unless $r;
$len -= $r;
}
elsif ($! != EINTR) {
if ($self->{fh}->can('errstr')){
my $err = $self->{fh}->errstr();
die (qq/Could not read from SSL socket: '$err'\n /);
}
else {
die(qq/Could not read from socket: '$!'\n/);
}
}
}
if ($len && !$allow_partial) {
die(qq/Unexpected end of stream\n/);
}
return $buf;
}
sub readline {
@_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
my ($self) = @_;
while () {
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
return $1;
}
if (length $self->{rbuf} >= $self->{max_line_size}) {
die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
}
$self->can_read
or die(qq/Timed out while waiting for socket to become ready for reading\n/);
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
if (defined $r) {
last unless $r;
}
elsif ($! != EINTR) {
if ($self->{fh}->can('errstr')){
my $err = $self->{fh}->errstr();
die (qq/Could not read from SSL socket: '$err'\n /);
}
else {
die(qq/Could not read from socket: '$!'\n/);
}
}
}
die(qq/Unexpected end of stream while looking for line\n/);
}
sub read_header_lines {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
my ($self, $headers) = @_;
$headers ||= {};
my $lines = 0;
my $val;
while () {
my $line = $self->readline;
if (++$lines >= $self->{max_header_lines}) {
die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
}
elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
my ($field_name) = lc $1;
if (exists $headers->{$field_name}) {
for ($headers->{$field_name}) {
$_ = [$_] unless ref $_ eq "ARRAY";
push @$_, $2;
$val = \$_->[-1];
}
}
else {
$val = \($headers->{$field_name} = $2);
}
}
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
$val
or die(qq/Unexpected header continuation line\n/);
next unless length $1;
$$val .= ' ' if length $$val;
$$val .= $1;
}
elsif ($line =~ /\A \x0D?\x0A \z/x) {
last;
}
else {
die(q/Malformed header line: / . $Printable->($line) . "\n");
}
}
return $headers;
}
sub write_request {
@_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
my($self, $request) = @_;
$self->write_request_header(@{$request}{qw/method uri headers header_case/});
$self->write_body($request) if $request->{cb};
return;
}
# Standard request header names/case from HTTP/1.1 RFCs
my @rfc_request_headers = qw(
Accept Accept-Charset Accept-Encoding Accept-Language Authorization
Cache-Control Connection Content-Length Expect From Host
If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer
Transfer-Encoding Upgrade User-Agent Via
);
my @other_request_headers = qw(
Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin
X-XSS-Protection
);
my %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers;
# to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
# combine writes.
sub write_header_lines {
(@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n");
my($self, $headers, $header_case, $prefix_data) = @_;
$header_case ||= {};
my $buf = (defined $prefix_data ? $prefix_data : '');
# Per RFC, control fields should be listed first
my %seen;
for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) {
next unless exists $headers->{$k};
$seen{$k}++;
my $field_name = $HeaderCase{$k};
my $v = $headers->{$k};
for (ref $v eq 'ARRAY' ? @$v : $v) {
$_ = '' unless defined $_;
$buf .= "$field_name: $_\x0D\x0A";
}
}
# Other headers sent in arbitrary order
while (my ($k, $v) = each %$headers) {
my $field_name = lc $k;
next if $seen{$field_name};
if (exists $HeaderCase{$field_name}) {
$field_name = $HeaderCase{$field_name};
}
else {
if (exists $header_case->{$field_name}) {
$field_name = $header_case->{$field_name};
}
else {
$field_name =~ s/\b(\w)/\u$1/g;
}
$field_name =~ /\A $Token+ \z/xo
or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
$HeaderCase{lc $field_name} = $field_name;
}
for (ref $v eq 'ARRAY' ? @$v : $v) {
# unwrap a field value if pre-wrapped by user
s/\x0D?\x0A\s+/ /g;
die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n")
unless $_ eq '' || /\A $Field_Content \z/xo;
$_ = '' unless defined $_;
$buf .= "$field_name: $_\x0D\x0A";
}
}
$buf .= "\x0D\x0A";
return $self->write($buf);
}
# return value indicates whether message length was defined; this is generally
# true unless there was no content-length header and we just read until EOF.
# Other message length errors are thrown as exceptions
sub read_body {
@_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
my ($self, $cb, $response) = @_;
my $te = $response->{headers}{'transfer-encoding'} || '';
my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
return $chunked
? $self->read_chunked_body($cb, $response)
: $self->read_content_body($cb, $response);
}
sub write_body {
@_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
my ($self, $request) = @_;
if (exists $request->{headers}{'content-length'}) {
return unless $request->{headers}{'content-length'};
return $self->write_content_body($request);
}
else {
return $self->write_chunked_body($request);
}
}
sub read_content_body {
@_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
my ($self, $cb, $response, $content_length) = @_;
$content_length ||= $response->{headers}{'content-length'};
if ( defined $content_length ) {
my $len = $content_length;
while ($len > 0) {
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
$cb->($self->read($read, 0), $response);
$len -= $read;
}
return length($self->{rbuf}) == 0;
}
my $chunk;
$cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
return;
}
sub write_content_body {
@_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
my ($self, $request) = @_;
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
while () {
my $data = $request->{cb}->();
defined $data && length $data
or last;
if ( $] ge '5.008' ) {
utf8::downgrade($data, 1)
or die(qq/Wide character in write_content()\n/);
}
$len += $self->write($data);
}
$len == $content_length
or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
return $len;
}
sub read_chunked_body {
@_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
my ($self, $cb, $response) = @_;
while () {
my $head = $self->readline;
$head =~ /\A ([A-Fa-f0-9]+)/x
or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
my $len = hex($1)
or last;
$self->read_content_body($cb, $response, $len);
$self->read(2) eq "\x0D\x0A"
or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
}
$self->read_header_lines($response->{headers});
return 1;
}
sub write_chunked_body {
@_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
my ($self, $request) = @_;
my $len = 0;
while () {
my $data = $request->{cb}->();
defined $data && length $data
or last;
if ( $] ge '5.008' ) {
utf8::downgrade($data, 1)
or die(qq/Wide character in write_chunked_body()\n/);
}
$len += length $data;
my $chunk = sprintf '%X', length $data;
$chunk .= "\x0D\x0A";
$chunk .= $data;
$chunk .= "\x0D\x0A";
$self->write($chunk);
}
$self->write("0\x0D\x0A");
if ( ref $request->{trailer_cb} eq 'CODE' ) {
$self->write_header_lines($request->{trailer_cb}->())
}
else {
$self->write("\x0D\x0A");
}
return $len;
}
sub read_response_header {
@_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
my ($self) = @_;
my $line = $self->readline;
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) (?: [\x09\x20]+ ([^\x0D\x0A]*) )? \x0D?\x0A/x
or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
$reason = "" unless defined $reason;
die (qq/Unsupported HTTP protocol: $protocol\n/)
unless $version =~ /0*1\.0*[01]/;
return {
status => $status,
reason => $reason,
headers => $self->read_header_lines,
protocol => $protocol,
};
}
sub write_request_header {
@_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
my ($self, $method, $request_uri, $headers, $header_case) = @_;
return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
}
sub _do_timeout {
my ($self, $type, $timeout) = @_;
$timeout = $self->{timeout}
unless defined $timeout && $timeout >= 0;
my $fd = fileno $self->{fh};
defined $fd && $fd >= 0
or die(qq/select(2): 'Bad file descriptor'\n/);
my $initial = time;
my $pending = $timeout;
my $nfound;
vec(my $fdset = '', $fd, 1) = 1;
while () {
$nfound = ($type eq 'read')
? select($fdset, undef, undef, $pending)
: select(undef, $fdset, undef, $pending) ;
if ($nfound == -1) {
$! == EINTR
or die(qq/select(2): '$!'\n/);
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
$nfound = 0;
}
last;
}
$! = 0;
return $nfound;
}
sub can_read {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
my $self = shift;
if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
return 1 if $self->{fh}->pending;
}
return $self->_do_timeout('read', @_)
}
sub can_write {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
my $self = shift;
return $self->_do_timeout('write', @_)
}
sub _assert_ssl {
my($ok, $reason) = HTTP::Tiny->can_ssl();
die $reason unless $ok;
}
sub can_reuse {
my ($self,$scheme,$host,$port,$peer) = @_;
return 0 if
$self->{pid} != $$
|| $self->{tid} != _get_tid()
|| length($self->{rbuf})
|| $scheme ne $self->{scheme}
|| $host ne $self->{host}
|| $port ne $self->{port}
|| $peer ne $self->{peer}
|| eval { $self->can_read(0) }
|| $@ ;
return 1;
}
# Try to find a CA bundle to validate the SSL cert,
# prefer Mozilla::CA or fallback to a system file
sub _find_CA_file {
my $self = shift();
my $ca_file =
defined( $self->{SSL_options}->{SSL_ca_file} )
? $self->{SSL_options}->{SSL_ca_file}
: $ENV{SSL_CERT_FILE};
if ( defined $ca_file ) {
unless ( -r $ca_file ) {
die qq/SSL_ca_file '$ca_file' not found or not readable\n/;
}
return $ca_file;
}
local @INC = @INC;
pop @INC if $INC[-1] eq '.';
return Mozilla::CA::SSL_ca_file()
if eval { require Mozilla::CA; 1 };
# cert list copied from golang src/crypto/x509/root_unix.go
foreach my $ca_bundle (
"/etc/ssl/certs/ca-certificates.crt", # Debian/Ubuntu/Gentoo etc.
"/etc/pki/tls/certs/ca-bundle.crt", # Fedora/RHEL
"/etc/ssl/ca-bundle.pem", # OpenSUSE
"/etc/openssl/certs/ca-certificates.crt", # NetBSD
"/etc/ssl/cert.pem", # OpenBSD
"/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
"/etc/pki/tls/cacert.pem", # OpenELEC
"/etc/certs/ca-certificates.crt", # Solaris 11.2+
) {
return $ca_bundle if -e $ca_bundle;
}
die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
. qq/Try installing Mozilla::CA from CPAN\n/;
}
# for thread safety, we need to know thread id if threads are loaded
sub _get_tid {
no warnings 'reserved'; # for 'threads'
return threads->can("tid") ? threads->tid : 0;
}
sub _ssl_args {
my ($self, $host) = @_;
my %ssl_args;
# This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
# added until IO::Socket::SSL 1.84
if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
$ssl_args{SSL_hostname} = $host, # Sane SNI support
}
if ($self->{verify_SSL}) {
$ssl_args{SSL_verifycn_scheme} = 'http'; # enable CN validation
$ssl_args{SSL_verifycn_name} = $host; # set validation hostname
$ssl_args{SSL_verify_mode} = 0x01; # enable cert validation
$ssl_args{SSL_ca_file} = $self->_find_CA_file;
}
else {
$ssl_args{SSL_verifycn_scheme} = 'none'; # disable CN validation
$ssl_args{SSL_verify_mode} = 0x00; # disable cert validation
}
# user options override settings from verify_SSL
for my $k ( keys %{$self->{SSL_options}} ) {
$ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
}
return \%ssl_args;
}
1;
} # --- END HTTP::Tiny
{ # --- BEGIN Try::Tiny
package Try::Tiny; # git description: v0.30-11-g1b81d0a
use 5.006;
# ABSTRACT: Minimal try/catch with proper preservation of $@
our $VERSION = '0.31';
use strict;
use warnings;
BEGIN {
use Exporter 5.57 'import';
our @EXPORT = our @EXPORT_OK = qw(try catch finally);
use Carp;
$Carp::Internal{+__PACKAGE__}++;
if ($INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname ) {
*_subname = \&Sub::Util::set_subname;
*_HAS_SUBNAME = sub {1};
}
elsif( $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) } ){
*_subname = \&Sub::Name::subname;
*_HAS_SUBNAME = sub {1};
}
else {
*_HAS_SUBNAME = sub {0};
}
}
my %_finally_guards;
# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
# context & not a scalar one
sub try (&;@) {
my ( $try, @code_refs ) = @_;
# we need to save this here, the eval block will be in scalar context due
# to $failed
my $wantarray = wantarray;
# work around perl bug by explicitly initializing these, due to the likelyhood
# this will be used in global destruction (perl rt#119311)
my ( $catch, @finally ) = ();
# find labeled blocks in the argument list.
# catch and finally tag the blocks by blessing a scalar reference to them.
foreach my $code_ref (@code_refs) {
if ( ref($code_ref) eq 'Try::Tiny::Catch' ) {
croak 'A try() may not be followed by multiple catch() blocks'
if $catch;
$catch = ${$code_ref};
} elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) {
push @finally, ${$code_ref};
} else {
croak(
'try() encountered an unexpected argument ('
. ( defined $code_ref ? $code_ref : 'undef' )
. ') - perhaps a missing semi-colon before or'
);
}
}
# FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
# not perfect, but we could provide a list of additional errors for
# $catch->();
# name the blocks if we have Sub::Name installed
_subname(caller().'::try {...} ' => $try)
if _HAS_SUBNAME;
# set up scope guards to invoke the finally blocks at the end.
# this should really be a function scope lexical variable instead of
# file scope + local but that causes issues with perls < 5.20 due to
# perl rt#119311
local $_finally_guards{guards} = [
map Try::Tiny::ScopeGuard->_new($_),
@finally
];
# save the value of $@ so we can set $@ back to it in the beginning of the eval
# and restore $@ after the eval finishes
my $prev_error = $@;
my ( @ret, $error );
# failed will be true if the eval dies, because 1 will not be returned
# from the eval body
my $failed = not eval {
$@ = $prev_error;
# evaluate the try block in the correct context
if ( $wantarray ) {
@ret = $try->();
} elsif ( defined $wantarray ) {
$ret[0] = $try->();
} else {
$try->();
};
return 1; # properly set $failed to false
};
# preserve the current error and reset the original value of $@
$error = $@;
$@ = $prev_error;
# at this point $failed contains a true value if the eval died, even if some
# destructor overwrote $@ as the eval was unwinding.
if ( $failed ) {
# pass $error to the finally blocks
push @$_, $error for @{$_finally_guards{guards}};
# if we got an error, invoke the catch block.
if ( $catch ) {
# This works like given($error), but is backwards compatible and
# sets $_ in the dynamic scope for the body of C<$catch>
for ($error) {
return $catch->($error);
}
# in case when() was used without an explicit return, the C<for>
# loop will be aborted and there's no useful return value
}
return;
} else {
# no failure, $@ is back to what it was, everything is fine
return $wantarray ? @ret : $ret[0];
}
}
sub catch (&;@) {
my ( $block, @rest ) = @_;
croak 'Useless bare catch()' unless wantarray;
_subname(caller().'::catch {...} ' => $block)
if _HAS_SUBNAME;
return (
bless(\$block, 'Try::Tiny::Catch'),
@rest,
);
}
sub finally (&;@) {
my ( $block, @rest ) = @_;
croak 'Useless bare finally()' unless wantarray;
_subname(caller().'::finally {...} ' => $block)
if _HAS_SUBNAME;
return (
bless(\$block, 'Try::Tiny::Finally'),
@rest,
);
}
{
package # hide from PAUSE
Try::Tiny::ScopeGuard;
use constant UNSTABLE_DOLLARAT => ("$]" < '5.013002') ? 1 : 0;
sub _new {
shift;
bless [ @_ ];
}
sub DESTROY {
my ($code, @args) = @{ $_[0] };
local $@ if UNSTABLE_DOLLARAT;
eval {
$code->(@args);
1;
} or do {
warn
"Execution of finally() block $code resulted in an exception, which "
. '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. '
. 'Your program will continue as if this event never took place. '
. "Original exception text follows:\n\n"
. (defined $@ ? $@ : '$@ left undefined...')
. "\n"
;
}
}
}
1;
} # --- END Try::Tiny
{ # --- BEGIN cPstrict
package cPstrict;
# Copyright 2024 WebPros International, LLC
# All rights reserved.
# [email protected] 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/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/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/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/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{ < }{<}xmsg;
$string =~ s{ > }{>}xmsg;
return $string;
}
sub decode_utf8_html_entities {
my $str = shift;
$str =~ s/&\#(\d{4})\;/chr($1);/eg;
return $str;
}
my %uri_encoding_cache = (
'"' => '%22',
q{'} => '%27',
'(' => '%28',
')' => '%29',
q{ } => '%20',
"\t" => '%09',
);
sub css_encode_str {
my $str = shift;
$str =~ s{([\(\)\s"'])}{
$uri_encoding_cache{$1}
|| require Cpanel::Encoder::URI && Cpanel::Encoder::URI::uri_encode_str($1)
}ge;
return $str;
}
1;
} # --- END Cpanel/Encoder/Tiny/Rare.pm
{ # --- BEGIN Cpanel/Encoder/Tiny.pm
package Cpanel::Encoder::Tiny;
use strict;
my %XML_ENCODE_MAP = ( '&' => '&', '<' => '<', '>' => '>', '"' => '"', "'" => ''' );
my %HTML_ENCODE_MAP = ( '&' => '&', '<' => '<', '>' => '>', '"' => '"', "'" => ''' );
my %HTML_DECODE_MAP = ( 'amp' => '&', 'lt' => '<', 'gt' => '>', 'quot' => '"', 'apos' => q{'}, '#39' => q{'} );
my $decode_regex = do { my $tmp = join( '|', keys %HTML_DECODE_MAP ); "&($tmp);"; };
sub angle_bracket_encode {
my ($string) = @_;
$string =~ s{<}{<}xmsg;
$string =~ s{>}{>}xmsg;
return $string;
}
sub safe_xml_encode_str {
my $data = join( '', @_ );
return $data if $data !~ tr/&<>"'//;
$data =~ s/([&<>"'])/$XML_ENCODE_MAP{$1}/sg;
return $data;
}
sub safe_html_encode_str {
return $_[0] if !defined $_[0] || ( !defined $_[1] && $_[0] !~ tr/&<>"'// );
my $data = defined $_[1] ? join( '', @_ ) : $_[0];
return $data if $data !~ tr/&<>"'//;
$data =~ s/([&<>"'])/$HTML_ENCODE_MAP{$1}/sg;
return $data;
}
sub safe_html_decode_str {
return undef if !defined $_[0];
my $data = join( '', @_ );
$data =~ s/$decode_regex/$HTML_DECODE_MAP{$1}/g;
return $data;
}
sub css_encode_str {
require Cpanel::Encoder::Tiny::Rare;
*css_encode_str = *Cpanel::Encoder::Tiny::Rare::css_encode_str;
goto \&Cpanel::Encoder::Tiny::Rare::css_encode_str;
}
1;
} # --- END Cpanel/Encoder/Tiny.pm
{ # --- BEGIN Cpanel/Regex.pm
package Cpanel::Regex;
use strict;
our $VERSION = '0.2.5';
my $dblquotedstr = q{"([^\\\\"]*(?:\\\\.[^\\\\"]*)*)"};
my $sglquotedstr = $dblquotedstr;
$sglquotedstr =~ tr{"}{'};
my $zero_through_255 = '(?:25[0-5]|2[0-4][0-9]|1[0-9]{2}|[1-9][0-9]?|0)';
our %regex = (
'emailaddr' => '[a-zA-Z0-9!#\$\-=?^_{}~]+(?:\.[a-zA-Z0-9!#\$\-=?^_{}~]+)*(?:\+[a-zA-Z0-9 \.=\-\_]+)*\@[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?(?:\.[\da-zA-Z](?:[-\da-zA-Z]*[\da-zA-Z])?)*',
'oneplusdot' => '\.+',
'oneplusspacetab' => '[\s\t]+',
'multipledot' => '\.{2,}',
'commercialat' => '\@',
'plussign' => '\+',
'singledot' => '\.',
'newline' => '\n',
'doubledot' => '\.\.',
'lineofdigits' => '^\d+$',
'lineofnonprintingchars' => '^[\s\t]*$',
'getemailtransport' => '^from\s+.*\s+by\s+\S+\s+with\s+(\S+)',
'getreceivedfrom' => '^from\s+(.*)\s+by\s+',
'emailheaderterminator' => '^[\r\n]*$',
'forwardslash' => '\/',
'backslash' => chr(92) x 4,
'singlequote' => q('),
'doublequote' => '"',
'allspacetabchars' => '[\s\t]*',
'beginswithspaceortabs' => '^[\s\t]',
doublequotedstring => $dblquotedstr,
singlequotedstring => $sglquotedstr,
DUNS => '[0-9]{2}(?:-[0-9]{3}-[0-9]{4}|[0-9]{7})',
YYYY_MM_DD => '[0-9]{4}-(?:1[012]|0[1-9])-(?:3[01]|[12][0-9]|0[1-9])',
ipv4 => "(?:$zero_through_255\.){3}$zero_through_255",
iso_z_time => '[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}Z',
);
1;
} # --- END Cpanel/Regex.pm
{ # --- BEGIN Cpanel/Carp.pm
package Cpanel::Carp;
use strict;
# use Cpanel::Parser::Vars (); # perlpkg line 211
our ( $SHOW_TRACE, $OUTPUT_FORMAT, $VERBOSE ) = ( 1, 'text', 0 );
my $__CALLBACK_AFTER_DIE_SPEW; # Set when we need to run a code ref after spewing on die
my $error_count = 0;
sub import { return enable(); }
sub enable {
my (
$callback_before_warn_or_die_spew, # Runs before the spew on warn or die, currently used in cpanel to ensure we emit headers before body in the event of a warn or die spew
$callback_before_die_spew, # Runs before the spew on die, not currently used
$callback_after_die_spew, # Runs after the spew on die, currently used in whostmgr to ensure we emit the javascript footer when we die to avoid the UI breaking
) = @_;
$SIG{'__WARN__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars)
my @caller = caller(1);
return if defined $caller[3] && index( $caller[3], 'eval' ) > -1; # Case 35335: Quiet spurious warn errors from evals
++$error_count;
my $time = time();
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time);
my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ];
my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday );
my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 );
my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz );
my $longmess;
my $ignorable;
if ( UNIVERSAL::isa( $_[0], 'Cpanel::Exception' ) ) {
$longmess = Cpanel::Carp::safe_longmess( $_[0]->to_locale_string() );
}
elsif ( ref $_[0] eq 'Template::Exception' ) {
$longmess = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $_[0]->[0] . "]\n\t[INFO]=[" . $_[0]->[1] . "]\n\t[TEXT]=[" . ( ref $_[0]->[2] eq 'SCALAR' ? ${ $_[0]->[2] } : $_[0]->[2] ) . "]\n" );
}
else {
$longmess = Cpanel::Carp::safe_longmess(@_);
$ignorable = 1 if index( $_[0], 'Use of uninitialized value' ) == 0;
}
my $error_container_text = 'A warning occurred while processing this directive.';
my $current_file = $Cpanel::Parser::Vars::file || 'unknown';
print STDERR "[$error_timestamp] warn [Internal Warning while parsing $current_file $$] $longmess\n\n";
return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} );
return if $ignorable && !$VERBOSE;
_run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew;
if ( $OUTPUT_FORMAT eq 'html' ) {
if ($SHOW_TRACE) {
_print_without_die_handler( _generate_html_error_message( 'warn', $error_container_text, $longmess ) );
}
else {
_print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>});
}
}
elsif ( $OUTPUT_FORMAT eq 'xml' ) {
_print_without_die_handler("<error>$error_container_text</error>");
}
else {
_print_without_die_handler("[$error_container_text]\n");
}
};
$SIG{'__DIE__'} = sub { ## no critic qw(Variables::RequireLocalizedPunctuationVars)
return if $^S;
die $_[0] unless defined $^S;
delete $SIG{'__DIE__'};
_run_callback_without_die_handler($callback_before_warn_or_die_spew) if $callback_before_warn_or_die_spew;
_run_callback_without_die_handler($callback_before_die_spew) if $callback_before_die_spew;
$__CALLBACK_AFTER_DIE_SPEW = $callback_after_die_spew;
goto \&spew_on_die;
};
return 1;
}
sub spew_on_die { ## no critic qw(Subroutines::RequireArgUnpacking)
my ($err) = @_;
++$error_count;
my $time = time();
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time);
my ( $gmmin, $gmhour, $gmday ) = ( gmtime($time) )[ 1, 2, 3 ];
my $gmoffset = ( $hour * 60 + $min ) - ( $gmhour * 60 + $gmmin ) + 1440 * ( $mday <=> $gmday );
my $tz = sprintf( '%+03d%02d', int( $gmoffset / 60 ), $gmoffset % 60 );
my $error_timestamp = sprintf( '%04d-%02d-%02d %02d:%02d:%02d %s', $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $tz );
my $error_text;
if ( UNIVERSAL::isa( $err, 'Cpanel::Exception' ) ) {
$error_text = Cpanel::Carp::safe_longmess( $err->to_locale_string() );
}
elsif ( UNIVERSAL::isa( $err, 'Template::Exception' ) ) {
$error_text = Cpanel::Carp::safe_longmess( "Template::Exception:\n\t[TYPE]=[" . $err->type() . "]\n\t[INFO]=[" . $err->info() . "]\n\t[TEXT]=[" . $err->text() . "]\n" );
}
else {
$error_text = Cpanel::Carp::safe_longmess(@_);
}
my $current_file = $Cpanel::Parser::Vars::file || 'unknown';
print STDERR "[$error_timestamp] die [Internal Death while parsing $current_file $$] $error_text\n\n";
return if ( $OUTPUT_FORMAT eq 'suppress' || $OUTPUT_FORMAT eq 'supress' || $ENV{'CPANEL_PHPENGINE'} );
my $error_container_text = 'A fatal error or timeout occurred while processing this directive.';
if ( $OUTPUT_FORMAT eq 'html' ) {
if ($SHOW_TRACE) {
_print_without_die_handler( _generate_html_error_message( 'error', $error_container_text, $error_text ) );
}
else {
_print_without_die_handler(qq{<span class="error" style="cursor:hand;cursor:pointer;">[$error_container_text]</span>});
}
}
elsif ( $OUTPUT_FORMAT eq 'xml' ) {
_print_without_die_handler("<error>[$error_container_text]</error>");
}
else {
_print_without_die_handler("[$error_container_text]\n");
}
_run_callback_without_die_handler($__CALLBACK_AFTER_DIE_SPEW) if $__CALLBACK_AFTER_DIE_SPEW;
return;
}
my @SAFE_LONGMESS_KEY_REGEXP_ITEMS = (
'(?<![a-zA-Z0-9_])pw(?![a-zA-Z0-9_])',
qw(
hash
pass
auth
root
key
fullbackup
),
);
my @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS = (
@SAFE_LONGMESS_KEY_REGEXP_ITEMS,
'__ANON__',
);
sub _print_without_die_handler {
my ($text) = @_;
local $SIG{'__WARN__'} = sub { };
local $SIG{'__DIE__'} = 'DEFAULT';
return print $text;
}
sub _run_callback_without_die_handler {
my ($callback) = @_;
local $SIG{'__WARN__'} = sub { };
local $SIG{'__DIE__'} = 'DEFAULT';
return $callback->();
}
sub _generate_html_error_message {
my ( $type, $error_container_message, $error_message ) = @_;
require Cpanel::Encoder::Tiny;
my $safe_error_message = Cpanel::Encoder::Tiny::safe_html_encode_str($error_message);
return qq[
<style type="text/css">.cpanel_internal_message_container {display: inline-block; margin: 10px; width: auto;} .cpanel_internal_message { border: 1px solid #fff; outline-style: solid; outline-width: 1px; outline-color: #aaa; padding: 5px; } .cpanel_internal_error_warn { background-color: #FFF6CF; } .cpanel_internal_error_error { background-color: #F8E7E6; }</style>
<div id="cpanel_notice_item_$error_count" class="cjt-pagenotice-container cjt-notice-container cpanel_internal_message_container internal-error-container">
<div class="yui-module cjt-notice cjt-pagenotice cjt-notice-$type">
<div class="cpanel_internal_message cpanel_internal_error_$type bd">
<div class="cjt-notice-content" style="width: 420px;">
<span>
$error_container_message
<a
class="error"
style="cursor:hand;cursor:pointer;"
onClick="document.getElementById('cpanel_internal_error_$error_count').style.display='';this.style.display='none'; return false;">
[show]
</a>
<a
class="error"
style="cursor:hand;cursor:pointer;"
onClick="document.getElementById('cpanel_notice_item_$error_count').style.display='none'; return false;">
[close]
</a>
</span>
<div id="cpanel_internal_error_$error_count" style="display:none;">
<textarea class="cpanel_internal_error_$type" style="font-weight:900; height:200px; width:410px; color: black;">$safe_error_message</textarea>
</div>
</div>
</div>
</div>
</div>
];
}
sub safe_longmess {
require Carp;
$Carp::Internal{'Cpanel::Carp'} = 1;
return sanitize_longmess( scalar Carp::longmess(@_) );
}
my ( $key_regexp, $key_regexp_double, $function_regexp );
sub sanitize_longmess {
_build_regexes() if !$key_regexp;
return join(
"\n",
map {
( tr{'"}{} && ( m{$key_regexp}o || m{$key_regexp_double}o || ( ( $_ =~ m{^[ \t]*([^\(]+)\(} )[0] || '' ) =~ m{$function_regexp}o ) ) # matches a line that needs to be sanitized
&& _sanitize_line($_); # sanitize
$_
} split( m{\n}, $_[0] )
) . "\n";
}
sub error_count {
return $error_count;
}
sub _sanitize_line { # Operates directly on $_[0] for speed
if ( !$INC{'Cpanel/Regex.pm'} ) { # PPI NO PARSE - inc check
local $@;
eval {
local $SIG{__DIE__};
local $SIG{__WARN__};
require Cpanel::Regex; # PPI NO PARSE - inc check
};
}
$_[0] =~ s/$Cpanel::Regex::regex{'singlequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{'} ) != -1;
$_[0] =~ s/$Cpanel::Regex::regex{'doublequotedstring'}/__CPANEL_HIDDEN__/go if index( $_[0], q{"} ) != -1;
return 1;
}
sub _build_regexes {
my $key_regexp_items = join '|', @SAFE_LONGMESS_KEY_REGEXP_ITEMS;
$key_regexp = qr<
'
.*?
(?:
$key_regexp_items
)
.*?
'
\s*
,
>x;
$key_regexp_double = $key_regexp;
$key_regexp_double =~ tr{'}{"}; # "' fix for poor editors
my $function_regexp_items = join '|', @SAFE_LONGMESS_FUNCTION_REGEXP_ITEMS;
$function_regexp = qr<
::
.*?
(?:
$function_regexp_items
)
.*?
$
>x;
return 1;
}
1;
} # --- END Cpanel/Carp.pm
{ # --- BEGIN Cpanel/Set.pm
package Cpanel::Set;
use strict;
use warnings;
no warnings 'once';
sub difference {
my ($super_ar) = @_;
my %lookup;
@lookup{ map { @$_ } @_[ 1 .. $#_ ] } = ();
return grep { !exists $lookup{$_} } @$super_ar;
}
sub intersection {
my ( $super_ar, $sub_ar ) = @_;
my %lookup;
@lookup{@$sub_ar} = ();
return grep { exists $lookup{$_} } @$super_ar;
}
1;
} # --- END Cpanel/Set.pm
{ # --- BEGIN Cpanel/TimeHiRes.pm
package Cpanel::TimeHiRes;
use strict;
use warnings;
no warnings 'once';
use constant {
_gettimeofday => 96,
_clock_gettime => 228,
_CLOCK_REALTIME => 0,
_EINTR => 4,
_PACK_TEMPLATE => 'L!L!',
};
sub clock_gettime {
my $timeval = pack( _PACK_TEMPLATE, () );
_get_time_from_syscall(
_clock_gettime,
_CLOCK_REALTIME,
$timeval,
);
return unpack( _PACK_TEMPLATE, $timeval );
}
sub time {
my ( $secs, $nsecs ) = clock_gettime();
return $secs + ( $nsecs / 1_000_000_000 );
}
sub sleep {
my ($secs) = @_;
local $!;
my $retval = select( undef, undef, undef, $secs );
if ( $retval == -1 && $! != _EINTR ) {
require Cpanel::Exception;
die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to suspend command execution for [quant,_1,second,seconds] because of an error: [_2]', [ $secs, $! ] );
}
return $secs;
}
sub gettimeofday {
my $timeval = pack( _PACK_TEMPLATE, () );
_get_time_from_syscall(
_gettimeofday,
$timeval,
undef,
);
return unpack( _PACK_TEMPLATE, $timeval );
}
sub _get_time_from_syscall { ##no critic qw(RequireArgUnpacking)
my $syscall_num = shift;
local $!;
my $retval = syscall( $syscall_num, @_ );
if ( $retval == -1 ) {
require Cpanel::Exception;
die 'Cpanel::Exception'->can('create')->( 'SystemCall', 'The system failed to retrieve the time because of an error: [_1]', [$!] );
}
return;
}
1;
} # --- END Cpanel/TimeHiRes.pm
{ # --- BEGIN Cpanel/SafeFileLock.pm
package Cpanel::SafeFileLock;
use strict;
use warnings;
no warnings 'once';
use constant {
_ENOENT => 2,
_EDQUOT => 122,
DEBUG => 0,
MAX_LOCKFILE_SIZE => 8192,
};
sub new {
my ( $class, $path_to_lockfile, $fh, $path_to_file_being_locked ) = @_;
if ( scalar @_ != 4 ) {
die 'Usage: Cpanel::SafeFileLock->new($path_to_lockfile, $fh, $path_to_file_being_locked)';
}
if ($fh) {
write_lock_contents( $fh, $path_to_lockfile ) or return;
}
my $self = bless [
$path_to_lockfile,
$fh,
$path_to_file_being_locked,
], $class;
push @$self, @{ $self->stat_ar() }[ 1, 9 ];
return $self;
}
sub new_before_lock {
my ( $class, $path_to_lockfile, $path_to_file_being_locked ) = @_;
if ( scalar @_ != 3 ) {
die 'Usage: Cpanel::SafeFileLock->new_before_lock($path_to_lockfile, $path_to_file_being_locked)';
}
return bless [
$path_to_lockfile,
undef,
$path_to_file_being_locked,
], $class;
}
sub set_filehandle_and_unlinker_after_lock {
$_[0][1] = $_[1];
push @{ $_[0] }, @{ $_[0]->stat_ar() }[ 1, 9 ];
$_[0][5] = $_[2];
return $_[0];
}
sub get_path {
return $_[0]->[0];
}
sub get_path_to_file_being_locked {
return $_[0]->[2] // die "get_path_to_file_being_locked requires the object to be instantiated with the path_to_file_being_locked";
}
sub set_filehandle {
$_[0][1] = $_[1];
return $_[0];
}
sub get_filehandle {
return $_[0]->[1];
}
sub get_inode {
return $_[0]->[3];
}
sub get_mtime {
return $_[0]->[4];
}
sub get_path_fh_inode_mtime {
return @{ $_[0] }[ 0, 1, 3, 4 ];
}
sub stat_ar {
return [ stat( ( $_[0]->[1] && fileno( $_[0]->[1] ) ) ? $_[0]->[1] : $_[0]->[0] ) ];
}
sub lstat_ar {
return [ $_[0]->[1] && fileno( $_[0]->[1] ) ? stat( $_[0]->[1] ) : lstat( $_[0]->[0] ) ];
}
sub close {
return close $_[0]->[1] if ref $_[0]->[1];
$_[0]->[5] = undef;
return;
}
sub write_lock_contents { ## no critic qw(Subroutines::RequireArgUnpacking) -- only unpack on the failure case
local $!;
if (DEBUG) {
require Cpanel::Carp;
return 1 if syswrite( $_[0], "$$\n$0\n" . Cpanel::Carp::safe_longmess() . "\n" );
}
return 1 if syswrite( $_[0], "$$\n$0\n" );
my ( $fh, $path_to_lockfile ) = @_;
my $write_error = $!;
CORE::close($fh);
unlink $path_to_lockfile;
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::FileWriteError', [ 'path' => $path_to_lockfile, 'error' => $write_error ] );
}
sub fetch_lock_contents_if_exists {
my ($lockfile) = @_;
die 'Need lock file!' if !$lockfile;
open my $lockfile_fh, '<:stdio', $lockfile or do {
return if $! == _ENOENT();
die "open($lockfile): $!";
};
my $buffer;
my $read_result = read( $lockfile_fh, $buffer, MAX_LOCKFILE_SIZE );
if ( !defined $read_result ) {
die "read($lockfile): $!";
}
my ( $pid_line, $lock_name, $lock_obj ) = split( /\n/, $buffer, 3 );
chomp($lock_name) if length $lock_name;
my ($lock_pid) = $pid_line && ( $pid_line =~ m/(\d+)/ );
return ( $lock_pid, $lock_name || 'unknown', $lock_obj || 'unknown', $lockfile_fh );
}
1;
} # --- END Cpanel/SafeFileLock.pm
{ # --- BEGIN Cpanel/FHUtils/Tiny.pm
package Cpanel::FHUtils::Tiny;
use strict;
use warnings;
no warnings 'once';
sub is_a {
return !ref $_[0] ? 0 : ( ref $_[0] eq 'IO::Handle' || ref $_[0] eq 'GLOB' || UNIVERSAL::isa( $_[0], 'GLOB' ) ) ? 1 : 0;
}
sub are_same {
my ( $fh1, $fh2 ) = @_;
return 1 if $fh1 eq $fh2;
if ( fileno($fh1) && ( fileno($fh1) != -1 ) && fileno($fh2) && ( fileno($fh2) != -1 ) ) {
return 1 if fileno($fh1) == fileno($fh2);
}
return 0;
}
sub to_bitmask {
my @fhs = @_;
my $mask = q<>;
for my $fh (@fhs) {
vec( $mask, ref($fh) ? fileno($fh) : $fh, 1 ) = 1;
}
return $mask;
}
1;
} # --- END Cpanel/FHUtils/Tiny.pm
{ # --- BEGIN Cpanel/Hash.pm
package Cpanel::Hash;
use strict;
*get_fastest_hash = \&fnv1a_32;
use constant FNV1_32A_INIT => 0x811c9dc5;
use constant FNV_32_PRIME => 0x01000193;
use constant FNV_32_MOD => 2**32; # AKA 0x100000000 but that it non-portable;
sub fnv1a_32 {
my $fnv32 = FNV1_32A_INIT();
( $fnv32 = ( ( $fnv32 ^ $_ ) * FNV_32_PRIME() ) % FNV_32_MOD ) for unpack( 'C*', $_[0] );
return $fnv32;
}
1;
} # --- END Cpanel/Hash.pm
{ # --- BEGIN Cpanel/SafeFile/LockInfoCache.pm
package Cpanel::SafeFile::LockInfoCache;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::SafeFileLock (); # perlpkg line 211
sub new {
my ( $class, $pathname ) = @_;
die 'need path!' if !$pathname;
return bless { _path => $pathname }, $class;
}
sub get {
my ( $self, $inode, $mtime ) = @_;
die 'Need an inode & an mtime!' if !defined $inode || !defined $mtime;
if ( !exists $self->{"_inode_${inode}_$mtime"} ) {
my ( $pid, $name, $obj, $fh ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists( $self->{'_path'} );
if ($pid) {
my ( $real_inode, $real_mtime ) = ( stat $fh )[ 1, 9 ];
$self->{"_inode_${real_inode}_$real_mtime"} = [ $pid, $name, $obj ];
}
}
return $self->{"_inode_${inode}_$mtime"} ||= undef;
}
1;
} # --- END Cpanel/SafeFile/LockInfoCache.pm
{ # --- BEGIN Cpanel/SafeFile/LockWatcher.pm
package Cpanel::SafeFile::LockWatcher;
use strict;
use warnings;
no warnings 'once';
use constant _ENOENT => 2;
use constant _FILEHANDLE_TTL => 2;
sub new {
my ( $class, $lockfile ) = @_;
my $self = bless { _path => $lockfile, _new => 1 }, $class;
return $self->reload_from_disk();
}
sub reload_from_disk {
my ($self) = @_;
my $old_inode = $self->{'inode'};
@{$self}{qw( inode uid size mtime)} = $self->_get_inode_uid_size_mtime();
if ( delete $self->{'_new'} ) {
$self->{'changed'} = 0;
}
else {
$self->{'changed'} = ( $self->{'inode'} || 0 ) != ( $old_inode || 0 ) ? 1 : 0;
}
return $self;
}
sub _get_inode_uid_size_mtime {
my ($self) = @_;
my ( $inode, $uid, $size, $mtime );
local $!;
if ( open my $fh, '<', $self->{'_path'} ) {
( $inode, $uid, $size, $mtime ) = ( stat $fh )[ 1, 4, 7, 9 ];
$self->_add_fh_if_needed( $fh, $inode );
}
elsif ( $! != _ENOENT ) {
die "open(<, $self->{'_path'}): $!";
}
return ( $inode, $uid, $size, $mtime );
}
sub _add_fh_if_needed {
my ( $self, $fh, $inode ) = @_;
my $now = time;
my $fhs_hr = $self->{'_time_fhs'} //= {};
my $seen_inode = 0;
for my $time ( keys %$fhs_hr ) {
if ( ( $now - $time ) > _FILEHANDLE_TTL() ) {
delete $fhs_hr->{$time};
next;
}
if ( !$seen_inode ) {
foreach my $entry ( @{ $fhs_hr->{$time} } ) {
if ( $entry->[1] == $inode ) {
$seen_inode = 1;
last;
}
}
}
}
return if $seen_inode;
push @{ $fhs_hr->{ time() } }, [ $fh, $inode ];
return;
}
1;
} # --- END Cpanel/SafeFile/LockWatcher.pm
{ # --- BEGIN Cpanel/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/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) {
$lock_inode ||= 0;
$lock_mtime ||= 0;
_log_warn("[$$] Attempt to unlock file that was locked by another process [LOCK_PATH]=[$lock_path] [LOCK_PID]=[$lock_pid] [LOCK_PROCESS]=[$lock_name] [LOCK_INODE]=[$filesys_lock_ino] [LOCK_MTIME]=[$filesys_lock_mtime] -- [NON_LOCK_PID]=[$$] [NON_LOCK_PROCESS]=[$0] [NON_LOCK_INODE]=[$lock_inode] [NON_LOCK_MTIME]=[$lock_mtime]");
}
return;
}
sub _safe_open {
my ( undef, $open_mode, $file, $open_method_coderef, $open_method ) = @_;
if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) {
_log_warn('_safe_open: Invalid arguments');
return;
}
elsif ( defined $_[0] ) {
my $fh_type = ref $_[0];
if ( !Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) {
_log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'");
return;
}
}
if ( my $lockref = _safelock($file) ) {
if ( $open_method_coderef->( $_[0], $open_mode, $file ) ) {
if ( my $err = _do_flock_or_return_exception( $_[0], $open_mode, $file ) ) {
safeunlock($lockref);
local $@ = $err;
die;
}
$OPEN_LOCKS++;
return $lockref;
}
else {
local $!;
safeunlock($lockref);
return;
}
}
else {
_log_warn("safeopen: could not acquire a lock for '$file': $!");
return;
}
}
my $_lock_ex_nb;
my $_lock_sh_nb;
sub _do_flock_or_return_exception {
my ( $fh, $open_mode, $path ) = @_;
my $flock_start_time;
my $lock_op =
_is_write_open_mode($open_mode)
? ( $_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB )
: ( $_lock_sh_nb //= $Cpanel::Fcntl::Constants::LOCK_SH | $Cpanel::Fcntl::Constants::LOCK_NB );
local $!;
my $flock_err;
my $flock_max_wait_time_is_whole_number = int($MAX_FLOCK_WAIT) == $MAX_FLOCK_WAIT;
while ( !flock $fh, $lock_op ) {
$flock_err = $!;
if ( $flock_err == _EINTR || $flock_err == _EWOULDBLOCK ) {
if ( !$flock_start_time ) {
$flock_start_time = $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time();
next;
}
if ( ( ( $flock_max_wait_time_is_whole_number ? time() : Cpanel::TimeHiRes::time() ) - $flock_start_time ) > $MAX_FLOCK_WAIT ) {
require Cpanel::Exception;
return _timeout_exception( $path, $MAX_FLOCK_WAIT );
}
else {
Cpanel::TimeHiRes::sleep($TIME_BETWEEN_FLOCK_CHECKS);
}
next;
}
require Cpanel::Exception;
return Cpanel::Exception::create( 'IO::FlockError', [ path => $path, error => $flock_err, operation => $lock_op ] );
}
return undef;
}
sub _safe_re_open {
my ( $fh, $open_mode, $file, $open_method_coderef, $open_method ) = @_;
if ( !defined $open_mode || !$open_method_coderef || !$file || $file =~ tr/\0// ) {
_log_warn('_safe_re_open: Invalid arguments');
return;
}
else {
my $fh_type = ref $fh;
if ( !Cpanel::FHUtils::Tiny::is_a($fh) ) {
_log_warn("Invalid file handle type '$fh_type' provided for $open_method of '$file'");
return;
}
}
close $fh;
if ( $open_method_coderef->( $fh, $open_mode, $file ) ) {
if ( my $err = _do_flock_or_return_exception( $fh, $open_mode, $file ) ) {
die $err;
}
return $fh;
}
return;
}
sub _log_warn {
require Cpanel::Debug;
goto &Cpanel::Debug::log_warn;
}
sub _get_open_args {
my ( $mode, $file ) = @_;
if ( !$file ) {
( $mode, $file ) = $mode =~ m/^([<>+|]+|)(.*)/;
if ( $file && !$mode ) {
$mode = '<';
}
elsif ( !$file ) {
return;
}
}
$mode =
$mode eq '<' ? '<'
: $mode eq '>' ? '>'
: $mode eq '>>' ? '>>'
: $mode eq '+<' ? '+<'
: $mode eq '+>' ? '+>'
: $mode eq '+>>' ? '+>>'
: return;
return ( $mode, $file );
}
sub _sanitize_open_mode {
my ($mode) = @_;
return if $mode =~ m/[^0-9]/;
my $safe_mode = ( $mode & $Cpanel::Fcntl::Constants::O_RDONLY );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_RDWR );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_CREAT );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_EXCL );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_APPEND );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_TRUNC );
$safe_mode |= ( $mode & $Cpanel::Fcntl::Constants::O_NONBLOCK );
return $safe_mode;
}
sub _calculate_lockfile { ## no critic qw(Subroutines::RequireArgUnpacking)
my $lockfile = $_[0] =~ tr{<>}{} ? ( ( $_[0] =~ /^[><]*(.*)/ )[0] . '.lock' ) : $_[0] . '.lock';
return $lockfile if ( length $lockfile <= MAX_LOCK_FILE_LENGTH );
require File::Basename;
my $lock_basename = File::Basename::basename($lockfile);
return $lockfile if ( length $lock_basename <= MAX_LOCK_FILE_LENGTH );
require Cpanel::Hash;
my $hashed_lock_basename = Cpanel::Hash::get_fastest_hash($lock_basename) . ".lock";
if ( $lockfile eq $lock_basename ) {
return $hashed_lock_basename;
}
else {
return File::Basename::dirname($lockfile) . '/' . $hashed_lock_basename;
}
}
sub is_locked {
my ($file) = @_;
my $lockfile = _calculate_lockfile($file);
my ( $lock_pid, $lock_name, $lock_obj ) = Cpanel::SafeFileLock::fetch_lock_contents_if_exists($lockfile);
if ( _is_valid_pid($lock_pid) && _pid_is_alive($lock_pid) ) {
return 1;
}
return 0;
}
sub _timeout_exception {
my ( $path, $waited ) = @_;
require Cpanel::Exception;
return Cpanel::Exception::create( 'Timeout', 'The system failed to lock the file “[_1]” after [quant,_2,second,seconds].', [ $path, $waited ] );
}
sub _die_if_file_is_flocked_cuz_already_waited_a_while {
my ( $file, $waited ) = @_;
if ( _open_to_write( my $fh, $file ) ) {
$_lock_ex_nb //= $Cpanel::Fcntl::Constants::LOCK_EX | $Cpanel::Fcntl::Constants::LOCK_NB;
if ( flock( $fh, $_lock_ex_nb ) == 1 ) {
flock $fh, UNLOCK_FCNTL_VALUE or die "Failed to unlock “$file” after having just locked it: $!";
}
else {
require Cpanel::Exception;
if ( $! == _EWOULDBLOCK ) {
die _timeout_exception( $file, $waited );
}
else {
die Cpanel::Exception::create( 'IO::FlockError', [ path => $file, error => $!, operation => $_lock_ex_nb ] );
}
}
}
return;
}
sub _lock_wait { ## no critic qw(Subroutines::ProhibitExcessComplexity)
my ( $file, $safefile_lock, $lockfile ) = @_;
my ( $temp_file, $fh ) = _write_temp_lock_file( $lockfile, $file );
if ( $temp_file eq NO_PERM_TO_WRITE_TO_DOTLOCK_DIR ) {
return ( 1, 1 );
}
if ( !$temp_file ) {
return ( 0, $fh );
}
$safefile_lock->set_filehandle_and_unlinker_after_lock( $fh, Cpanel::SafeFile::_temp->new($temp_file) );
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
local $0 = ( $verbose == 1 ) ? "$0 - waiting for lock on $file" : "$0 - waiting for lock";
require Cpanel::SafeFile::LockInfoCache;
require Cpanel::SafeFile::LockWatcher;
my $watcher = Cpanel::SafeFile::LockWatcher->new($lockfile);
my $waittime = _calculate_waittime_for_file($file);
my ( $inotify_obj, $inotify_mask, $inotify_file_disappeared );
my $start_time = time;
my $waited = 0;
my $lockfile_cache = Cpanel::SafeFile::LockInfoCache->new($lockfile);
my ( $inotify_inode, $inotify_mtime );
LOCK_WAIT:
while (1) {
$waited = ( time() - $start_time );
if ( $waited > $waittime ) {
_die_if_file_is_flocked_cuz_already_waited_a_while( $file, $waited );
if ( defined $watcher->{'inode'} ) {
require Cpanel::Debug;
Cpanel::Debug::log_warn( sprintf "Replacing stale lock file: $lockfile. The kernel’s lock is gone, last modified %s seconds ago (mtime=$watcher->{'mtime'}), and waited over $waittime seconds.", time - $watcher->{'mtime'} );
}
return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} );
die _timeout_exception( $file, $waittime );
}
if ( $watcher->{'inode'} ) {
my $lock_get = $lockfile_cache->get( @{$watcher}{ 'inode', 'mtime' } );
if ( !$lock_get ) {
my $size_before_reload = $watcher->{'size'};
$watcher->reload_from_disk();
if ( $size_before_reload == 0 && $watcher->{'size'} == 0 ) {
_log_warn("[$$] UID $> clobbering empty lock file “$lockfile” (UID $watcher->{'uid'}) written by “unknown” at $watcher->{'mtime'}");
return ( 1, $fh ) if _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} );
}
next LOCK_WAIT;
}
my ( $lock_pid, $lock_name, $lock_obj ) = @$lock_get;
if ( $lock_pid == $$ ) {
$watcher->reload_from_disk();
_log_warn("[$$] Double locking detected by self [LOCK_PATH]=[$lockfile] [LOCK_PID]=[$lock_pid] [LOCK_OBJ]=[$lock_obj] [LOCK_PROCESS]=[$lock_name] [ACTUAL_INODE]=[$watcher->{'inode'}] [ACTUAL_MTIME]=[$watcher->{'mtime'}]");
return ( 0, $DOUBLE_LOCK_DETECTED );
}
elsif ( !_pid_is_alive($lock_pid) ) {
my $time = time();
if ( _overwrite_lockfile_if_inode_mtime_matches( $temp_file, $lockfile, $watcher->{'inode'}, $watcher->{'mtime'} ) ) {
_log_warn("[$$] TIME $time UID $> clobbered stale lock file “$lockfile” (NAME “$lock_name”, UID $watcher->{'uid'}) written by PID $lock_pid at $watcher->{'mtime'}");
return ( 1, $fh );
}
$watcher->reload_from_disk();
next LOCK_WAIT;
}
else {
require Cpanel::Debug;
Cpanel::Debug::log_info("[$$] Waiting for lock on $file held by $lock_name with pid $lock_pid") if $verbose == 1;
}
}
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
$watcher->reload_from_disk();
if ( !$inotify_obj || !$inotify_inode || !$watcher->{'inode'} || $inotify_inode != $watcher->{'inode'} || $inotify_mtime != $watcher->{'mtime'} ) {
INOTIFY: {
( $inotify_obj, $inotify_mask, $inotify_file_disappeared ) = _generate_inotify_for_lock_file($lockfile);
$watcher->reload_from_disk();
if ( $inotify_file_disappeared || !$watcher->{'inode'} ) {
undef $inotify_obj;
next LOCK_WAIT;
}
redo INOTIFY if $watcher->{'changed'};
( $inotify_inode, $inotify_mtime ) = @{$watcher}{ 'inode', 'mtime' };
}
}
my $selected = _select( my $m = $inotify_mask, undef, undef, $TIME_BETWEEN_DOTLOCK_CHECKS );
if ( $selected == -1 ) {
die "select() error: $!" if $! != _EINTR();
}
elsif ($selected) {
return ( 1, $fh ) if _try_to_install_lockfile( $temp_file, $lockfile );
$watcher->reload_from_disk();
() = $inotify_obj->poll();
}
}
return;
}
sub _select {
return select( $_[0], $_[1], $_[2], $_[3] );
}
sub _generate_inotify_for_lock_file {
my ($file) = @_;
require Cpanel::Inotify;
my $inotify_obj;
my $rin = '';
local $@;
eval {
$inotify_obj = Cpanel::Inotify->new( flags => ['NONBLOCK'] );
$inotify_obj->add( $file, flags => [ 'ATTRIB', 'DELETE_SELF' ] );
vec( $rin, $inotify_obj->fileno(), 1 ) = 1;
};
if ($@) {
my $err = $@;
if ( eval { $err->isa('Cpanel::Exception::SystemCall') } ) {
my $err = $err->get('error');
if ( $err == _ENOENT ) {
return ( undef, undef, INOTIFY_FILE_DISAPPEARED );
}
elsif ( $err != _EACCES ) { # Don’t warn if EACCES
local $@ = $err;
warn;
}
}
else {
local $@ = $err;
warn;
}
return;
}
return ( $inotify_obj, $rin, 0 );
}
sub _pid_is_alive {
my ($pid) = @_;
local $!;
if ( kill( 0, $pid ) ) {
return 1;
}
elsif ( $! == _EPERM ) {
return !!( stat "/proc/$pid" )[0];
}
return 0;
}
sub _calculate_waittime_for_file {
my ($file) = @_;
return $LOCK_WAIT_TIME if $LOCK_WAIT_TIME;
my $waittime = DEFAULT_LOCK_WAIT_TIME;
if ( -e $file ) {
$waittime = int( ( stat _ )[7] / 10000 );
$waittime = $waittime > MAX_LOCK_WAIT_TIME ? MAX_LOCK_WAIT_TIME : $waittime < DEFAULT_LOCK_WAIT_TIME ? DEFAULT_LOCK_WAIT_TIME : $waittime;
}
return $waittime;
}
sub _is_valid_pid {
my $pid = shift;
return 0 unless defined $pid;
return $pid =~ tr{0-9}{}c ? 0 : 1;
}
sub _getdir {
my @path = split( /\/+/, $_[0] );
return join( '/', (@path)[ 0 .. ( $#path - 1 ) ] ) || '.';
}
sub _create_lockfile {
my $lock_fh;
return sysopen( $lock_fh, $_[0], CREATE_FCNTL_VALUE, LOCK_FILE_PERMS ) ? ( 1, $lock_fh ) : ( 0, $! );
}
sub _open_to_write {
my $path = $_[1];
$OVERWRITE_FCNTL_VALUE ||= ( $Cpanel::Fcntl::Constants::O_WRONLY | $Cpanel::Fcntl::Constants::O_NONBLOCK | $Cpanel::Fcntl::Constants::O_APPEND | $Cpanel::Fcntl::Constants::O_NOFOLLOW );
return sysopen( $_[0], $path, $OVERWRITE_FCNTL_VALUE, LOCK_FILE_PERMS );
}
sub _overwrite_lockfile_if_inode_mtime_matches {
my ( $temp_file, $lockfile, $lockfile_inode, $lockfile_mtime ) = @_;
my ( $inode, $mtime ) = ( stat $lockfile )[ 1, 9 ];
if ( !$inode ) {
die "stat($lockfile): $!" if $! != _ENOENT();
}
if ( !$inode || ( $inode == $lockfile_inode && $mtime == $lockfile_mtime ) ) {
rename( $temp_file, $lockfile ) or do {
require Cpanel::Exception;
die Cpanel::Exception::create( 'IO::RenameError', [ oldpath => $temp_file, newpath => $lockfile, error => $! ] );
};
return 1;
}
return 0;
}
sub _is_write_open_mode {
my ($mode) = @_;
if ( $mode =~ tr{0-9}{}c ) {
if ( $mode && ( -1 != index( $mode, '>' ) || -1 != index( $mode, '+' ) ) ) {
return 1;
}
}
else {
if ( $mode && ( ( $mode & $Cpanel::Fcntl::Constants::O_WRONLY ) || ( $mode & $Cpanel::Fcntl::Constants::O_RDWR ) ) ) {
return 1;
}
}
return 0;
}
sub _verbose_flag_file_exists {
return -e '/var/cpanel/safefile_verbose';
}
package Cpanel::SafeFile::_temp;
use constant _ENOENT => 2;
sub new { return bless [ $_[1], $_SKIP_DOTLOCK_WHEN_NO_PERMS, $$ ], $_[0]; }
sub DESTROY {
local $!;
unlink $_[0]->[0] or do {
if ( !$_[0]->[1] && $! != _ENOENT && $_[0]->[2] == $$ ) {
warn "unlink($_[0]->[0]): $!";
}
};
return;
}
1;
} # --- END Cpanel/SafeFile.pm
{ # --- BEGIN Cpanel/LoadModule.pm
package Cpanel::LoadModule;
use strict;
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::LoadModule::Utils (); # perlpkg line 211
my $logger;
my $has_perl_dir = 0;
sub _logger_warn {
my ( $msg, $fail_ok ) = @_;
return if $fail_ok && $ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == -1;
if ( $INC{'Cpanel/Logger.pm'} ) {
$logger ||= 'Cpanel::Logger'->new();
$logger->warn($msg);
}
return warn $msg;
}
sub _reset_has_perl_dir {
$has_perl_dir = 0;
return;
}
sub load_perl_module { ## no critic qw(Subroutines::RequireArgUnpacking)
if ( -1 != index( $_[0], q<'> ) ) {
die Cpanel::Exception::create_raw( 'InvalidParameter', "Module names with single-quotes are prohibited. ($_[0])" );
}
return $_[0] if Cpanel::LoadModule::Utils::module_is_loaded( $_[0] );
my ( $mod, @LIST ) = @_;
local ( $!, $@ );
if ( !is_valid_module_name($mod) ) {
die Cpanel::Exception::create( 'InvalidParameter', '“[_1]” is not a valid name for a Perl module.', [$mod] );
}
my $args_str;
if (@LIST) {
$args_str = join ',', map {
die "Only scalar arguments allowed in LIST! (@LIST)" if ref;
_single_quote($_);
} @LIST;
}
else {
$args_str = q<>;
}
eval "use $mod ($args_str);"; ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
if ($@) {
die Cpanel::Exception::create( 'ModuleLoadError', [ module => $mod, error => $@ ] );
}
return $mod;
}
*module_is_loaded = *Cpanel::LoadModule::Utils::module_is_loaded;
*is_valid_module_name = *Cpanel::LoadModule::Utils::is_valid_module_name;
sub loadmodule {
return 1 if cpanel_namespace_module_is_loaded( $_[0] );
return _modloader( $_[0] );
}
sub lazy_load_module {
my $mod = shift;
my $mod_path = $mod;
$mod_path =~ s{::}{/}g;
if ( exists $INC{ $mod_path . '.pm' } ) {
return;
}
if ( !is_valid_module_name($mod) ) {
_logger_warn("Cpanel::LoadModule: Invalid module name ($mod)");
return;
}
eval "use $mod ();";
if ($@) {
delete $INC{ $mod_path . '.pm' };
_logger_warn( "Cpanel::LoadModule:: Failed to load module $mod - $@", 1 );
return;
}
return 1;
}
sub cpanel_namespace_module_is_loaded {
my ($modpart) = @_;
$modpart =~ s{::}{/}g;
return exists $INC{"Cpanel/$modpart.pm"} ? 1 : 0;
}
sub _modloader {
my $module = shift;
if ( !$module ) {
_logger_warn("Empty module name passed to modloader");
return;
}
if ( !is_valid_module_name($module) ) {
_logger_warn("Invalid module name ($module) passed to modloader");
return;
}
eval qq[ use Cpanel::${module}; Cpanel::${module}::${module}_init() if "Cpanel::${module}"->can("${module}_init"); ]; # PPI USE OK - This looks like usage of the Cpanel module and it's not.
if ($@) {
_logger_warn("Error loading module $module - $@");
return;
}
return 1;
}
sub _single_quote {
local ($_) = $_[0];
s/([\\'])/\\$1/g;
return qq('$_');
}
1;
} # --- END Cpanel/LoadModule.pm
{ # --- BEGIN Cpanel/Linux/Constants.pm
package Cpanel::Linux::Constants;
use strict;
use warnings;
no warnings 'once';
use constant {
NAME_MAX => 255,
PATH_MAX => 4096,
};
1;
} # --- END Cpanel/Linux/Constants.pm
{ # --- BEGIN Cpanel/Validate/FilesystemNodeName.pm
package Cpanel::Validate::FilesystemNodeName;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Linux::Constants (); # perlpkg line 211
sub is_valid {
my ($node) = @_;
local $@;
eval { validate_or_die($node); };
return $@ ? 0 : 1;
}
sub validate_or_die {
my ($name) = @_;
if ( !length $name ) {
die Cpanel::Exception::create('Empty');
}
elsif ( $name eq '.' || $name eq '..' ) {
die Cpanel::Exception::create( 'Reserved', [ value => $name ] );
}
elsif ( length $name > Cpanel::Linux::Constants::NAME_MAX() ) {
die Cpanel::Exception::create( 'TooManyBytes', [ value => $name, maxlength => Cpanel::Linux::Constants::NAME_MAX() ] );
}
elsif ( index( $name, '/' ) != -1 ) {
die Cpanel::Exception::create( 'InvalidCharacters', [ value => $name, invalid_characters => ['/'] ] );
}
elsif ( index( $name, "\0" ) != -1 ) {
die Cpanel::Exception::create( 'InvalidCharacters', 'This value may not contain a [asis,NUL] byte.', [ value => $name, invalid_characters => ["\0"] ] );
}
return 1;
}
1;
} # --- END Cpanel/Validate/FilesystemNodeName.pm
{ # --- BEGIN Cpanel/Notify.pm
package Cpanel::Notify;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Set (); # perlpkg line 211
# use Cpanel::Fcntl (); # perlpkg line 211
# use Cpanel::SafeFile (); # perlpkg line 211
# use Cpanel::LoadModule (); # perlpkg line 211
# use Cpanel::Validate::FilesystemNodeName (); # perlpkg line 211
# use Cpanel::Exception (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
our $VERSION = '1.8';
my $DEFAULT_CONTENT_TYPE = 'text/plain; charset=utf-8';
our $NOTIFY_INTERVAL_STORAGE_DIR = '/var/cpanel/notifications';
sub notification_class {
my (%args) = @_;
if ( !defined $args{'interval'} ) {
$args{'interval'} = 1;
}
if ( !defined $args{'status'} ) {
$args{'status'} = 'No status set';
}
foreach my $param (qw(application status class constructor_args)) {
die Cpanel::Exception::create( 'MissingParameter', [ 'name' => $param ] ) if !defined $args{$param};
}
if ( my @unwelcome_params = Cpanel::Set::difference( [ keys %args ], [qw(application status class constructor_args interval)] ) ) {
die Cpanel::Exception::create_raw(
'InvalidParameters',
"The following parameters don't belong as an argument to notification_class(); you may have meant to pass these in constructor_args instead: " . join( ' ', @unwelcome_params )
);
}
my $constructor_args = { @{ $args{'constructor_args'} } };
if ( $constructor_args->{'skip_send'} ) {
my $class = "Cpanel::iContact::Class::$args{'class'}";
Cpanel::LoadModule::load_perl_module($class);
return $class->new(%$constructor_args);
}
return _notification_backend(
$args{'application'},
$args{'status'},
$args{'interval'},
sub {
my $class = "Cpanel::iContact::Class::$args{'class'}";
Cpanel::LoadModule::load_perl_module($class);
return $class->new(%$constructor_args);
},
);
}
sub notification {
my %AGS = @_;
my $app = $AGS{'app'} || $AGS{'application'} || 'Notice';
return _notification_backend(
$app,
$AGS{'status'},
$AGS{'interval'} || 0,
sub {
my $module = "Cpanel::iContact";
Cpanel::LoadModule::load_perl_module($module);
my $from = $AGS{'from'};
my $to = $AGS{'to'};
my $msgheader = $AGS{'msgheader'} || $AGS{'subject'};
my $message = $AGS{'message'};
my $plaintext_message = $AGS{'plaintext_message'};
my $priority = $AGS{'priority'} || 3;
my $attach_files = $AGS{'attach_files'} || [];
my $content_type = $AGS{'content-type'} || $DEFAULT_CONTENT_TYPE;
"$module"->can('icontact')->(
'attach_files' => $attach_files,
'application' => $app,
'level' => $priority,
'from' => $from,
'to' => $to,
'subject' => $msgheader,
'message' => $message,
'plaintext_message' => $plaintext_message,
'content-type' => $content_type,
);
}
);
}
sub _notification_backend {
my ( $app, $status, $interval, $todo_cr ) = @_;
my $is_ready = _checkstatusinterval(
'app' => $app,
'status' => $status,
'interval' => $interval,
);
if ($is_ready) {
return $todo_cr->();
}
elsif ( $Cpanel::Debug::level > 3 ) {
Cpanel::Debug::log_warn("not sending notify app=[$app] status=[$status] interval=[$interval]");
}
return $is_ready ? 1 : 0;
}
sub notify_blocked {
my %AGS = @_;
my $app = $AGS{'app'};
my $status = $AGS{'status'};
my $interval = $AGS{'interval'};
return 0 if $interval <= 1; # Special Case (ignore interval check);
$app =~ s{/}{_}g; # Its possible to have slashes in the app name
$status =~ s{:}{_}g; # Its possible to have colons in the status
my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app";
return 0 if !-e $db_file;
my %notifications;
my $notify_db_fh;
if (
my $nlock = Cpanel::SafeFile::safesysopen(
$notify_db_fh, $db_file, Cpanel::Fcntl::or_flags('O_RDONLY'),
0600
)
) {
local $/;
%notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) );
Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock );
}
else {
Cpanel::Debug::log_warn("Could not open $db_file: $!");
return;
}
if ( $notifications{$status} && ( ( $notifications{$status} + $interval ) > time() ) ) {
return 1;
}
return 0;
}
{
no warnings 'once';
*update_notification_time_if_interval_reached = \&_checkstatusinterval;
}
sub _checkstatusinterval {
my %AGS = @_;
my $app = $AGS{'app'};
my $status = $AGS{'status'};
my $interval = $AGS{'interval'};
return 1 if $interval <= 1; # Special Case (ignore interval check);
$app =~ s{/}{_}g; # Its possible to have slashes in the app name
$status =~ s{:}{_}g; # Its possible to have colons in the status
Cpanel::Validate::FilesystemNodeName::validate_or_die($app);
my $notify = 0;
if ( !-e $NOTIFY_INTERVAL_STORAGE_DIR ) {
Cpanel::LoadModule::load_perl_module('Cpanel::SafeDir::MK');
Cpanel::SafeDir::MK::safemkdir( $NOTIFY_INTERVAL_STORAGE_DIR, '0700' );
if ( !-d $NOTIFY_INTERVAL_STORAGE_DIR ) {
Cpanel::Debug::log_warn("Failed to setup notifications directory: $NOTIFY_INTERVAL_STORAGE_DIR: $!");
return;
}
}
my %notifications;
my $notify_db_fh;
my $db_file = "$NOTIFY_INTERVAL_STORAGE_DIR/$app";
if ( my $nlock = Cpanel::SafeFile::safesysopen( $notify_db_fh, $db_file, Cpanel::Fcntl::or_flags(qw( O_RDWR O_CREAT )), 0600 ) ) {
local $/;
%notifications = map { ( split( /:/, $_, 2 ) )[ 0, 1 ] } split( m{\n}, readline($notify_db_fh) );
if ( !exists $notifications{$status} || ( int( $notifications{$status} ) + int($interval) ) < time() ) {
$notifications{$status} = time;
$notify = 1;
}
seek( $notify_db_fh, 0, 0 );
print {$notify_db_fh} join( "\n", map { $_ . ':' . $notifications{$_} } sort keys %notifications );
truncate( $notify_db_fh, tell($notify_db_fh) );
Cpanel::SafeFile::safeclose( $notify_db_fh, $nlock );
}
else {
Cpanel::Debug::log_warn("Could not open $db_file: $!");
return;
}
return $notify;
}
1;
} # --- END Cpanel/Notify.pm
{ # --- BEGIN Cpanel/Server/Utils.pm
package Cpanel::Server::Utils;
use strict;
sub is_subprocess_of_cpsrvd {
return 0 if $INC{'cpanel/cpsrvd.pm'}; # If we ARE cpsrvd we do not want this behavior
return $ENV{'CPANEL'} ? 1 : 0;
}
1;
} # --- END Cpanel/Server/Utils.pm
{ # --- BEGIN Cpanel/Logger.pm
package Cpanel::Logger;
use strict;
# use Cpanel::Time::Local (); # perlpkg line 211
my $is_sandbox;
my $is_smoker;
our $VERSION = 1.3;
use constant TRACE_TOUCH_FILE => '/var/cpanel/log_stack_traces';
our $ENABLE_BACKTRACE;
our $DISABLE_OUTPUT; # used by cpanminus
our $ALWAYS_OUTPUT_TO_STDERR;
our $STD_LOG_FILE = '/usr/local/cpanel/logs/error_log';
our $PANIC_LOG_FILE = '/usr/local/cpanel/logs/panic_log';
my ( $cached_progname, $cached_prog_pid, %singleton_stash );
sub new {
my ( $class, $hr_args ) = @_;
if ( $hr_args->{'open_now'} && $hr_args->{'use_no_files'} ) {
die "“open_now” and “use_no_files” mutually exclude!";
}
my $args_sig = 'no_args';
if ( $hr_args && ref($hr_args) eq 'HASH' ) {
$args_sig = join( ',', map { $_ . '=>' . $hr_args->{$_} } sort keys %{$hr_args} ); # Storable::freeze($hr_args);
}
my $no_load_from_cache = $hr_args->{'no_load_from_cache'} ? 1 : 0;
if ( exists $singleton_stash{$class}{$args_sig} and !$no_load_from_cache ) {
$singleton_stash{$class}{$args_sig}->{'cloned'}++;
}
else {
$singleton_stash{$class}{$args_sig} = bless( {}, $class );
if ( $hr_args && ref($hr_args) eq 'HASH' ) {
foreach my $k ( keys %$hr_args ) {
$singleton_stash{$class}{$args_sig}->{$k} = $hr_args->{$k};
}
}
}
my $self = $singleton_stash{$class}{$args_sig};
if ( !$self->{'cloned'} ) {
if ( $self->{'open_now'} && !$self->{'use_no_files'} ) {
$self->_open_logfile();
}
}
$self->_set_backtrace( $ENABLE_BACKTRACE // $self->{'backtrace'} // _get_backtrace_touchfile() );
return $self;
}
sub __Logger_pushback {
if ( @_ && index( ref( $_[0] ), __PACKAGE__ ) == 0 ) {
return @_;
}
return ( __PACKAGE__->new(), @_ );
}
sub invalid {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'invalid',
'output' => 0,
'service' => $self->find_progname(),
'backtrace' => $self->get_backtrace(),
'die' => 0,
);
if ( is_sandbox() ) {
if ( !-e '/var/cpanel/DEBUG' ) {
$self->notify( 'invalid', \%log );
}
$log{'output'} = _stdin_is_tty() ? 2 : 1;
}
return $self->logger( \%log );
} # end of invalid
sub is_sandbox {
return 0 if $INC{'B/C.pm'}; # avoid cache during compile
return $is_sandbox if defined $is_sandbox;
return ( $is_sandbox = -e '/var/cpanel/dev_sandbox' ? 1 : 0 );
}
sub is_smoker {
return 0 if $INC{'B/C.pm'}; # avoid cache during compile
return $is_smoker if defined $is_smoker;
return ( $is_smoker = -e '/var/cpanel/smoker' ? 1 : 0 );
}
sub deprecated { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'deprecated',
'output' => 0,
'service' => $self->find_progname(),
'backtrace' => $self->get_backtrace(),
'die' => 0,
);
unless ( is_sandbox() ) {
$self->logger( \%log );
return;
}
$self->notify( 'deprecated', \%log );
$log{'output'} = _stdin_is_tty() ? 2 : 1;
$log{'die'} = 1;
return $self->logger( \%log );
}
sub debug {
my ( $self, $message, $conf_hr ) = @_; # not appropriate for debug() : __Logger_pushback(@_);
$self = $self->new() if !ref $self;
$conf_hr ||= {
'force' => 0,
'backtrace' => 0,
'output' => 1, # Logger's debug level should output to STDOUT
};
return unless $conf_hr->{'force'} || ( defined $Cpanel::Debug::level && $Cpanel::Debug::level ); ## PPI NO PARSE - avoid recursive use statements
if ( !defined $message ) {
my @caller = caller();
$message = "debug() at $caller[1] line $caller[2].";
}
my %log = (
'message' => $message,
'level' => 'debug',
'output' => $conf_hr->{'output'},
'backtrace' => $conf_hr->{'backtrace'},
);
if ( ref $log{'message'} ) {
my $outmsg = $log{'message'};
eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::YAML::Syck; $outmsg = YAML::Syck::Dump($outmsg);';
my @caller = caller();
$log{'message'} = "$log{'message'} at $caller[1] line $caller[2]:\n" . $outmsg;
}
elsif ( $log{'message'} =~ m/\A\d+(?:\.\d+)?\z/ ) {
$log{'message'} = "debug() number $log{'message'}";
}
$self->logger( \%log );
return \%log;
}
sub info {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'info',
'output' => $self->{'open_now'} ? 0 : 1, # FB#59177: info level should output to STDOUT
'backtrace' => 0
}
);
} # end of info
sub warn {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'warn',
'output' => _stdin_is_tty() ? 2 : 0,
'backtrace' => $self->get_backtrace()
}
);
} # end of warn
sub error {
my ( $self, @list ) = __Logger_pushback(@_);
return $self->logger(
{
'message' => $list[0],
'level' => 'error',
'output' => -t STDIN ? 2 : 0,
'backtrace' => $self->get_backtrace()
}
);
} # end of error
sub die {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'die',
'output' => _stdin_is_tty() ? 2 : 0,
'backtrace' => $self->get_backtrace()
);
return $self->logger( \%log );
} # end of die
sub panic {
my ( $self, @list ) = __Logger_pushback(@_);
my %log = (
'message' => $list[0],
'level' => 'panic',
'output' => 2,
'backtrace' => $self->get_backtrace()
);
return $self->logger( \%log );
} # end of panic
sub raw {
return $_[0]->logger(
{
'message' => $_[1],
'level' => 'raw',
'output' => 0,
'backtrace' => 0
}
);
}
sub cplog {
my $msg = shift;
my $loglevel = shift;
my $service = shift;
my $nostdout = shift;
if ( !$nostdout ) {
$nostdout = 1;
}
else {
$nostdout = 0;
}
logger( { 'message' => $msg, 'level' => $loglevel, 'service' => $service, 'output' => $nostdout, 'backtrace' => $ENABLE_BACKTRACE // _get_backtrace_touchfile() } );
} # end of cplog (deprecated)
sub _get_configuration_for_logger {
my ( $self, $cfg_or_msg ) = @_;
my $hr = ref($cfg_or_msg) eq 'HASH' ? $cfg_or_msg : { 'message' => $cfg_or_msg };
$hr->{'message'} ||= 'Something is wrong';
$hr->{'level'} ||= '';
$hr->{'output'} ||= 0;
$hr->{'output'} = 0 if $DISABLE_OUTPUT;
if ( !exists $hr->{'backtrace'} ) {
$hr->{'backtrace'} = $self->get_backtrace();
}
$hr->{'use_no_files'} ||= 0;
$hr->{'use_fullmsg'} ||= 0;
return $hr;
}
sub _write {
return print { $_[0] } $_[1];
}
sub get_backtrace {
my ($self) = __Logger_pushback(@_);
return $ENABLE_BACKTRACE // $self->{'backtrace'};
}
sub _set_backtrace {
my ( $self, @args ) = __Logger_pushback(@_);
$self->{'backtrace'} = $args[0] ? 1 : 0;
return;
}
sub _get_backtrace_touchfile {
return -e TRACE_TOUCH_FILE ? 1 : 0;
}
sub get_fh {
my ($self) = @_;
return $self->{'log_fh'};
}
sub set_fh {
my ( $self, $fh ) = @_;
$self->{'log_fh'} = $fh;
return 1;
}
sub logger { ## no critic(RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
my $hr = $self->_get_configuration_for_logger( $list[0] );
my ( $msg, $time, $status );
$status = 1;
my ($msg_maybe_bt) = $hr->{'backtrace'} ? $self->backtrace( $hr->{'message'} ) : $hr->{'message'} . "\n";
if ( $hr->{'level'} eq 'raw' ) {
$msg = $hr->{'message'};
}
else {
$time ||= Cpanel::Time::Local::localtime2timestamp();
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
if ( $self->{'log_pid'} ) {
$msg = "[$time] $hr->{'level'} [$hr->{'service'}] [$$] $msg_maybe_bt";
}
else {
$msg = "[$time] $hr->{'level'} [$hr->{'service'}] $msg_maybe_bt";
}
}
unless ( $hr->{'use_no_files'} ) {
local $self->{'log_fh'} = \*STDERR if $ALWAYS_OUTPUT_TO_STDERR;
$self->_open_logfile() if !$self->{'log_fh'} || ( !eval { fileno( $self->{'log_fh'} ) } && !UNIVERSAL::isa( $self->{'log_fh'}, 'IO::Scalar' ) );
_write( $self->{'log_fh'}, $msg ) or $status = 0;
if ( $hr->{'level'} eq 'panic' || $hr->{'level'} eq 'invalid' || $hr->{'level'} eq 'deprecated' ) {
my $panic_fh;
require Cpanel::FileUtils::Open;
if ( Cpanel::FileUtils::Open::sysopen_with_real_perms( $panic_fh, $PANIC_LOG_FILE, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) {
$time ||= Cpanel::Time::Local::localtime2timestamp();
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
_write( $panic_fh, "$time $hr->{level} [$hr->{'service'}] $msg_maybe_bt" );
close $panic_fh;
}
}
}
if ( $hr->{'output'} ) {
$hr->{'service'} ||= $self->find_progname(); # only compute the service name if we HAVE to do so as it can be expensive
my $out = "$hr->{level} [$hr->{'service'}] $hr->{'message'}\n";
if ( $self->{'timestamp_prefix'} ) {
$out = "[$time] $out";
}
$out = $msg if $hr->{'use_fullmsg'};
$status &&= $self->_write_message( $hr, $out );
}
if ( ( $hr->{'level'} eq 'die' || $hr->{'level'} eq 'panic' || $hr->{'die'} ) ) {
CORE::die "exit level [$hr->{'level'}] [pid=$$] ($hr->{'message'})\n"; # make sure we die if die is overwritten
}
return $status;
} # end of logger
sub _write_message {
my ( $self, $hr, $out ) = @_;
my $status = 1;
if ( $hr->{'output'} == 3 ) {
_write( \*STDOUT, $out ) or $status = 0;
_write( \*STDERR, $out ) or $status = 0;
}
elsif ( $hr->{'output'} == 1 && ( $self->{'use_stdout'} || _stdout_is_tty() ) ) {
_write( \*STDOUT, $out ) or $status = 0;
}
elsif ( $hr->{'output'} == 2 ) {
_write( \*STDERR, $out ) or $status = 0;
}
return $status;
}
sub find_progname {
if ( $cached_progname && $cached_prog_pid == $$ ) {
return $cached_progname;
}
my $s = $0;
if ( !length $s ) { # Someone _could_ set $0 = '';
my $i = 1; # 0 is always find_progname
while ( my @service = caller( $i++ ) ) {
last if ( $service[3] =~ /::BEGIN$/ );
$s = $service[1] if ( $service[1] ne '' );
}
}
$s =~ s@.+/(.+)$@$1@ if $s =~ tr{/}{};
$s =~ s@\..+$@@ if $s =~ tr{\.}{};
$s =~ s@ .*$@@ if $s =~ tr{ }{};
$cached_progname = $s;
$cached_prog_pid = $$;
return $s;
}
sub backtrace { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $self, @list ) = __Logger_pushback(@_);
if ( ref $list[0] ) {
return $list[0] if scalar @list == 1;
return (@list);
}
require Cpanel::Carp;
local $_; # Protect surrounding program - just in case...
local $Carp::Internal{ (__PACKAGE__) } = 1;
local $Carp::Internal{'Cpanel::Debug'} = 1;
return Cpanel::Carp::safe_longmess(@list);
}
sub redirect_stderr_to_error_log {
return open( STDERR, '>>', $STD_LOG_FILE );
}
sub notify {
my ( $self, $call, $log_ref ) = @_;
my $time = Cpanel::Time::Local::localtime2timestamp();
my ($bt) = $self->backtrace( $log_ref->{'message'} );
$log_ref->{'service'} //= '';
my $logfile = qq{$time [$log_ref->{'service'}] } . ( $bt // '' );
if ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact::Class::Logger::Notify'); 1; } ) {
eval {
require Cpanel::Notify;
Cpanel::Notify::notification_class(
'class' => 'Logger::Notify',
'application' => 'Logger::Notify',
'constructor_args' => [
'origin' => $log_ref->{'service'},
'logger_call' => $call,
'attach_files' => [ { name => 'cpanel-logger-log.txt', content => \$logfile } ],
'subject' => $log_ref->{'subject'},
]
);
};
}
elsif ( eval { require Cpanel::LoadModule; Cpanel::LoadModule::load_perl_module('Cpanel::iContact'); 1; } ) {
Cpanel::iContact::icontact(
'application' => $log_ref->{'service'},
'subject' => $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}},
'message' => $logfile,
);
}
else {
CORE::warn( $log_ref->{'subject'} ? $log_ref->{'subject'} : qq{Cpanel::Logger::$call called in $log_ref->{'service'}} . ": $logfile" );
}
return;
}
*fatal = *die;
*out = *info;
*success = *info;
*throw = *die;
*warning = *warn;
sub _is_subprocess_of_cpsrvd {
require Cpanel::Server::Utils;
goto \&Cpanel::Server::Utils::is_subprocess_of_cpsrvd;
}
sub _open_logfile {
my ($self) = @_;
my $usingstderr = 0;
my $log_fh;
$self->{'alternate_logfile'} ||= $STD_LOG_FILE;
if ( $STD_LOG_FILE eq $self->{'alternate_logfile'} && _is_subprocess_of_cpsrvd() ) {
$log_fh = \*STDERR;
$usingstderr = 1;
}
else {
require Cpanel::FileUtils::Open;
if ( !Cpanel::FileUtils::Open::sysopen_with_real_perms( $log_fh, $self->{'alternate_logfile'}, 'O_WRONLY|O_APPEND|O_CREAT', 0600 ) ) {
( $usingstderr, $log_fh ) = ( 1, \*STDERR );
}
select( ( select($log_fh), $| = 1 )[0] ); ## no critic qw(Variables::RequireLocalizedPunctuationVars InputOutput::ProhibitOneArgSelect) -- Cpanel::FHUtils::Autoflush would be expensive to load every time
}
$self->{'log_fh'} = $log_fh;
$self->{'usingstderr'} = $usingstderr;
return 1;
}
sub _stdin_is_tty {
local $@;
return eval { -t STDIN };
}
sub _stdout_is_tty {
local $@;
return eval { -t STDOUT };
}
sub clear_singleton_stash {
%singleton_stash = ();
return;
}
1;
} # --- END Cpanel/Logger.pm
{ # --- BEGIN Cpanel/Debug.pm
package Cpanel::Debug;
use strict;
use warnings;
no warnings 'once';
our $HOOKS_DEBUG_FILE = '/var/cpanel/debughooks';
our $level = ( exists $ENV{'CPANEL_DEBUG_LEVEL'} && $ENV{'CPANEL_DEBUG_LEVEL'} ? int $ENV{'CPANEL_DEBUG_LEVEL'} : 0 );
my $debug_hooks_value;
my $logger;
sub debug_level {
my ($level) = @_;
$Cpanel::Debug::level = $level if defined $level;
return $Cpanel::Debug::level;
}
sub logger {
$logger = shift if (@_); # Set method for $logger if something is passed in.
return $logger ||= do {
local ( $@, $! );
require Cpanel::Logger;
Cpanel::Logger->new();
};
}
sub log_error {
local $!; #prevent logger from overwriting $!
return logger()->error( $_[0] );
}
sub log_warn {
local $!; #prevent logger from overwriting $!
return logger()->warn( $_[0] );
}
sub log_warn_no_backtrace {
local $!; #prevent logger from overwriting $!
my $logger = logger();
no warnings 'once';
local $Cpanel::Logger::ENABLE_BACKTRACE = 0;
return $logger->warn( $_[0] );
}
sub log_invalid {
local $!; #prevent logger from overwriting $!
return logger()->invalid( $_[0] );
}
sub log_deprecated {
local $!; #prevent logger from overwriting $!
return logger()->deprecated( $_[0] );
}
sub log_panic {
local $!; #prevent logger from overwriting $!
return logger()->panic( $_[0] );
}
sub log_die {
local $!; #prevent logger from overwriting $!
return logger()->die( $_[0] );
}
sub log_info {
local $!; #prevent logger from overwriting $!
return logger()->info( $_[0] );
}
sub log_debug {
local $!; #prevent logger from overwriting $!
return logger()->debug( $_[0] );
}
sub log_dump {
require Data::Dumper;
no warnings 'once';
local $Data::Dumper::Sortkeys = 1;
return log_info( Data::Dumper::Dumper( $_[0] ) );
}
sub debug_hooks_value {
return $debug_hooks_value if defined $debug_hooks_value;
return ( $debug_hooks_value = ( stat($HOOKS_DEBUG_FILE) )[7] || 0 );
}
1;
} # --- END Cpanel/Debug.pm
{ # --- BEGIN Cpanel/Finally.pm
package Cpanel::Finally;
use cPstrict;
no warnings 'once';
# use Cpanel::Destruct (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
sub new ( $class, @todo_crs ) {
return bless { 'pid' => $$, 'todo' => [@todo_crs] }, $class;
}
sub add ( $self, @new_crs ) {
$self->{'todo'} //= [];
push @{ $self->{'todo'} }, @new_crs;
return;
}
sub skip ($self) {
return delete $self->{'todo'};
}
sub DESTROY ($self) {
if ( Cpanel::Destruct::in_dangerous_global_destruction() ) {
Cpanel::Debug::log_die(q[Cpanel::Finally should never be triggered during global destruction\n]);
}
return if $$ != $self->{'pid'} || !$self->{'todo'};
local $@; #prevent insidious clobber of error messages
while ( @{ $self->{'todo'} } ) {
my $ok = eval {
while ( my $item = shift @{ $self->{'todo'} } ) {
$item->();
}
1;
};
warn $@ if !$ok;
}
return;
}
1;
} # --- END Cpanel/Finally.pm
{ # --- BEGIN Cpanel/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/Exception/AdminBinError.pm
package Cpanel::Exception::AdminBinError;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
# use Cpanel::ChildErrorStringifier (); # perlpkg line 238
BEGIN { push @ISA, qw(Cpanel::ChildErrorStringifier); }
# use Cpanel::LocaleString (); # perlpkg line 211
sub _default_phrase {
my ($self) = @_;
if ( $self->signal_code() ) {
if ( length $self->{'_metadata'}{'message_from_subprocess'} ) {
return Cpanel::LocaleString->new(
'The administrative request ended prematurely because it received the “[_1]” ([_2]) signal. It gave the following output: [_3]',
$self->signal_name(),
$self->signal_code(),
$self->{'_metadata'}{'message_from_subprocess'},
);
}
else {
return Cpanel::LocaleString->new(
'The administrative request ended prematurely because it received the “[_1]” ([_2]) signal.',
$self->signal_name(),
$self->signal_code(),
);
}
}
if ( $self->error_code() ) {
my $err_display = ( $self->error_name() ? $self->error_name() . '/' : q<> ) . $self->error_code();
if ( length $self->{'_metadata'}{'message_from_subprocess'} ) {
return Cpanel::LocaleString->new(
'The administrative request failed because of an error ([_1]) with output: [_2]',
$err_display,
$self->{'_metadata'}{'message_from_subprocess'},
);
}
else {
return Cpanel::LocaleString->new(
'The administrative request failed because of an error ([_1]).',
$err_display,
);
}
}
}
sub CHILD_ERROR {
my ($self) = @_;
return $self->{'_metadata'}{'CHILD_ERROR'};
}
1;
} # --- END Cpanel/Exception/AdminBinError.pm
{ # --- BEGIN Cpanel/Exception/AbstractClass.pm
package Cpanel::Exception::AbstractClass;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
# use Cpanel::LocaleString (); # perlpkg line 211
sub _default_phrase {
my ( $class, $mt_args_ar ) = @_;
return Cpanel::LocaleString->new(
'“[_1]” is an abstract base class. Please use an implementation!',
$mt_args_ar->[0],
);
}
1;
} # --- END Cpanel/Exception/AbstractClass.pm
{ # --- BEGIN Cpanel/Exception/AttributeNotSet.pm
package Cpanel::Exception::AttributeNotSet;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
1;
} # --- END Cpanel/Exception/AttributeNotSet.pm
{ # --- BEGIN Cpanel/Exception/AttributeReadOnly.pm
package Cpanel::Exception::AttributeReadOnly;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
# use Cpanel::LocaleString (); # perlpkg line 211
sub _default_phrase {
my ($self) = @_;
return Cpanel::LocaleString->new(
'You cannot set the attribute “[_1]” because it is read-only.',
$self->get('name'),
);
}
1;
} # --- END Cpanel/Exception/AttributeReadOnly.pm
{ # --- BEGIN Cpanel/Exception/System/RequiredRoleDisabled.pm
package Cpanel::Exception::System::RequiredRoleDisabled;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
sub _default_phrase {
my ($self) = @_;
require Cpanel::LocaleString;
if ($>) {
return Cpanel::LocaleString->new('This server does not support this functionality.');
}
my $role = $self->get('role');
my @roles = ( ref $role ) ? @$role : $role;
return Cpanel::LocaleString->new( 'This functionality is not available because the [list_and_quoted,_1] [numerate,_2,role is,roles are] disabled on this server.', \@roles, 0 + @roles );
}
1;
} # --- END Cpanel/Exception/System/RequiredRoleDisabled.pm
{ # --- BEGIN Cpanel/Caller.pm
package Cpanel::Caller;
use strict;
my %PROPERTY_INDEX;
sub _get {
my ( $property, $frames_back_count ) = @_;
if ( !%PROPERTY_INDEX ) {
my @PROPERTIES_ORDER = qw(
package
filename
line
subroutine
hasargs
wantarray
evaltext
is_require
hints__NOT_USED__
bitmask__NOT_USED__
hinthash
);
%PROPERTY_INDEX = map { $PROPERTIES_ORDER[$_] => $_ } ( 0 .. $#PROPERTIES_ORDER );
}
$frames_back_count ||= 0;
$frames_back_count += 2;
return scalar( ( caller $frames_back_count )[ $PROPERTY_INDEX{$property} ] );
}
sub evaltext { return _get( 'evaltext', @_ ) }
sub filename { return _get( 'filename', @_ ) }
sub hasargs { return _get( 'hasargs', @_ ) }
sub hinthash { return _get( 'hinthash', @_ ) }
sub is_require { return _get( 'is_require', @_ ) }
sub line { return _get( 'line', @_ ) }
sub package { return _get( 'package', @_ ) }
sub subroutine { return _get( 'subroutine', @_ ) }
sub wantarray { return _get( 'wantarray', @_ ) }
1;
} # --- END Cpanel/Caller.pm
{ # --- BEGIN Cpanel/Exception/Caller.pm
package Cpanel::Exception::Caller;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Exception (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Exception); }
# use Cpanel::Caller (); # perlpkg line 211
my @CALLERS_TO_EXCLUDE_FROM_MESSAGE = (
q<Whostmgr::API::1::Utils::get[a-z_]+argument>,
q<Cpanel::JSON::>
);
sub _get_caller_name {
my $i = 0;
my $caller_name;
while ( my $sub = Cpanel::Caller::subroutine( $i++ ) ) {
last if ( $sub =~ m{::BEGIN$} );
next if $sub eq 'Cpanel::Exception::__ANON__'; # do not advertise anonymous sub from Cpanel::Exception
$caller_name = $sub;
next if index( $caller_name, '::_' ) > -1 || grep { $caller_name =~ m<$_> } @CALLERS_TO_EXCLUDE_FROM_MESSAGE;
last if ( $caller_name !~ m{^Cpanel::Exception} );
}
return $caller_name;
}
1;
} # --- END Cpanel/Exception/Caller.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 '"' ? '"'
: $chr_num eq '&' ? '&'
: $chr_num eq "'" ? '''
: $chr_num eq '<' ? '<'
: $chr_num eq '>' ? '>'
: $chr_num;
}
return if $chr_num !~ m/$FORCE_REGEX_LAZY\A\d+\z/o;
my $chr = chr($chr_num);
if ( $chr_num > 127 ) {
if ( !defined $has_encode ) {
$has_encode = 0;
eval { require Encode; $has_encode = 1; };
}
if ($has_encode) {
$chr = Encode::encode( $lh->encoding(), $chr );
}
else {
$chr = eval '"\x{' . sprintf( '%04X', $chr_num ) . '}"';
}
}
if ( !$lh->context_is_html() ) {
return $chr;
}
else {
return
$chr_num == 34 || $chr_num == 147 || $chr_num == 148 ? '"'
: $chr_num == 38 ? '&'
: $chr_num == 39 || $chr_num == 145 || $chr_num == 146 ? '''
: $chr_num == 60 ? '<'
: $chr_num == 62 ? '>'
: $chr_num == 173 ? '­'
: $chr;
}
}
sub output_class {
my ( $lh, $string, @classes ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if $lh->context_is_plain();
return $lh->context_is_ansi() ? "\e[1m$string\e[0m" : qq{<span class="@classes">$string</span>};
}
sub output_asis_for_tests {
my ( $lh, $string ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string;
}
sub __make_attr_str_from_ar {
my ( $attr_ar, $strip_hr, $addin ) = @_;
if ( ref($attr_ar) eq 'HASH' ) {
$strip_hr = $attr_ar;
$attr_ar = [];
}
my $attr = '';
my $general_hr = ref( $attr_ar->[-1] ) eq 'HASH' ? pop( @{$attr_ar} ) : undef;
my $idx = 0;
my $ar_len = @{$attr_ar};
$idx = 1 if $ar_len % 2; # handle “Odd number of elements” …
my $did_addin;
while ( $idx < $ar_len ) {
if ( exists $strip_hr->{ $attr_ar->[$idx] } ) {
$idx += 2;
next;
}
my $atr = $attr_ar->[$idx];
my $val = $attr_ar->[ ++$idx ];
if ( exists $addin->{$atr} ) {
$val = "$addin->{$atr} $val";
$did_addin->{$atr}++;
}
$attr .= qq{ $atr="$val"};
$idx++;
}
if ($general_hr) {
for my $k ( keys %{$general_hr} ) {
next if exists $strip_hr->{$k};
if ( exists $addin->{$k} ) {
$general_hr->{$k} = "$addin->{$k} $general_hr->{$k}";
$did_addin->{$k}++;
}
$attr .= qq{ $k="$general_hr->{$k}"};
}
}
for my $r ( keys %{$addin} ) {
if ( !exists $did_addin->{$r} ) {
$attr .= qq{ $r="$addin->{$r}"};
}
}
return $attr;
}
sub output_inline {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if !$lh->context_is_html();
my $attr = __make_attr_str_from_ar( \@attrs );
return qq{<span$attr>$string</span>};
}
*output_attr = \&output_inline;
sub output_block {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if !$lh->context_is_html();
my $attr = __make_attr_str_from_ar( \@attrs );
return qq{<div$attr>$string</div>};
}
sub output_img {
my ( $lh, $src, $alt, @attrs ) = @_;
if ( !defined $alt || $alt eq '' ) {
$alt = $src;
}
else {
$alt = __proc_string_with_embedded_under_vars( $alt, 1 );
}
return $alt if !$lh->context_is_html();
my $attr = __make_attr_str_from_ar( \@attrs, { 'alt' => 1, 'src' => 1 } );
return qq{<img src="$src" alt="$alt"$attr/>};
}
sub output_abbr {
my ( $lh, $abbr, $full, @attrs ) = @_;
return !$lh->context_is_html()
? "$abbr ($full)"
: qq{<abbr title="$full"} . __make_attr_str_from_ar( \@attrs, { 'title' => 1 } ) . qq{>$abbr</abbr>};
}
sub output_acronym {
my ( $lh, $acronym, $full, @attrs ) = @_;
return !$lh->context_is_html()
? "$acronym ($full)"
: qq{<abbr title="$full"} . __make_attr_str_from_ar( \@attrs, { 'title' => 1 }, { 'class' => 'initialism' } ) . qq{>$acronym</abbr>};
}
sub output_sup {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return !$lh->context_is_html() ? $string : qq{<sup} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</sup>};
}
sub output_sub {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return !$lh->context_is_html() ? $string : qq{<sub} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</sub>};
}
sub output_underline {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if $lh->context_is_plain();
return $lh->context_is_ansi() ? "\e[4m$string\e[0m" : qq{<span style="text-decoration: underline"} . __make_attr_str_from_ar( \@attrs ) . qq{>$string</span>};
}
sub output_strong {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if $lh->context_is_plain();
return $lh->context_is_ansi() ? "\e[1m$string\e[0m" : '<strong' . __make_attr_str_from_ar( \@attrs ) . ">$string</strong>";
}
sub output_em {
my ( $lh, $string, @attrs ) = @_;
$string = __proc_string_with_embedded_under_vars( $string, 1 );
return $string if $lh->context_is_plain();
return $lh->context_is_ansi() ? "\e[3m$string\e[0m" : '<em' . __make_attr_str_from_ar( \@attrs ) . ">$string</em>";
}
sub output_url {
my ( $lh, $url, @args ) = @_;
$url ||= ''; # carp() ?
my $arb_args_hr = ref $args[-1] eq 'HASH' ? pop(@args) : {};
my ( $url_text, %output_config ) = @args % 2 ? @args : ( undef, @args );
my $return = $url;
if ( !$lh->context_is_html() ) {
if ($url_text) {
return "$url_text ($url)";
}
if ( exists $output_config{'plain'} ) {
$output_config{'plain'} ||= $url;
my $orig = $output_config{'plain'};
$output_config{'plain'} = __proc_string_with_embedded_under_vars( $output_config{'plain'}, 1 );
$return = $orig ne $output_config{'plain'} && $output_config{'plain'} =~ m/\Q$url\E/ ? $output_config{'plain'} : "$output_config{'plain'} $url";
}
}
else {
if ( exists $output_config{'html'} ) {
$output_config{'html'} = __proc_string_with_embedded_under_vars( $output_config{'html'}, 1 );
}
$output_config{'html'} ||= $url_text || $url;
my $attr = __make_attr_str_from_ar(
[ @args, $arb_args_hr ],
{
'html' => 1,
'plain' => 1,
'_type' => 1,
}
);
$return = exists $output_config{'_type'}
&& $output_config{'_type'} eq 'offsite' ? qq{<a$attr target="_blank" class="offsite" href="$url">$output_config{'html'}</a>} : qq{<a$attr href="$url">$output_config{'html'}</a>};
}
return $return;
}
sub set_context_html {
my ($lh) = @_;
my $cur = $lh->get_context();
$lh->set_context('html');
return if !$lh->context_is_html();
return $cur;
}
sub set_context_ansi {
my ($lh) = @_;
my $cur = $lh->get_context();
$lh->set_context('ansi');
return if !$lh->context_is_ansi();
return $cur;
}
sub set_context_plain {
my ($lh) = @_;
my $cur = $lh->get_context();
$lh->set_context('plain');
return if !$lh->context_is_plain();
return $cur;
}
my %contexts = (
'plain' => undef(),
'ansi' => 1,
'html' => 0,
);
sub set_context {
my ( $lh, $context ) = @_;
if ( !$context ) {
$lh->{'-t-STDIN'} = -t *STDIN ? 1 : 0;
}
elsif ( exists $contexts{$context} ) {
$lh->{'-t-STDIN'} = $contexts{$context};
}
else {
require Carp;
local $Carp::CarpLevel = 1;
Carp::carp("Given context '$context' is unknown.");
$lh->{'-t-STDIN'} = $context;
}
}
sub context_is_html {
return $_[0]->get_context() eq 'html';
}
sub context_is_ansi {
return $_[0]->get_context() eq 'ansi';
}
sub context_is_plain {
return $_[0]->get_context() eq 'plain';
}
sub context_is {
return $_[0]->get_context() eq $_[1];
}
sub get_context {
$_[0]->set_context() if !exists $_[0]->{'-t-STDIN'};
return
!defined $_[0]->{'-t-STDIN'} ? 'plain'
: $_[0]->{'-t-STDIN'} ? 'ansi'
: 'html';
}
sub maketext_html_context {
my ( $lh, @mt_args ) = @_;
my $cur = $lh->set_context_html();
my $res = $lh->maketext(@mt_args);
$lh->set_context($cur);
return $res;
}
sub maketext_ansi_context {
my ( $lh, @mt_args ) = @_;
my $cur = $lh->set_context_ansi();
my $res = $lh->maketext(@mt_args);
$lh->set_context($cur);
return $res;
}
sub maketext_plain_context {
my ( $lh, @mt_args ) = @_;
my $cur = $lh->set_context_plain();
my $res = $lh->maketext(@mt_args);
$lh->set_context($cur);
return $res;
}
1;
} # --- END Cpanel/CPAN/Locale/Maketext/Utils.pm
{ # --- BEGIN Cpanel/Locale/Utils/Paths.pm
package Cpanel::Locale::Utils::Paths;
use strict;
use warnings;
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/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 $XS_ConvertBlessed_obj;
our $XS_RelaxedConvertBlessed_obj;
our $XS_NoSetUTF8RelaxedConvertBlessed_obj;
our $XS_NoSetUTF8ConvertBlessed_obj;
our $VERSION = '2.5';
my $copied_boolean = 0;
sub DumpFile {
my ( $file, $data ) = @_;
if ( Cpanel::FHUtils::Tiny::is_a($file) ) {
print {$file} Dump($data) || return 0;
}
else {
if ( open( my $fh, '>', $file ) ) {
print {$fh} Dump($data);
close($fh);
}
else {
return 0;
}
}
return 1;
}
sub copy_boolean {
if ( !$copied_boolean ) {
*Types::Serialiser::Boolean:: = *JSON::PP::Boolean::;
$copied_boolean = 1;
}
return;
}
sub _create_new_json_object {
copy_boolean() if !$copied_boolean;
return JSON::XS->new()->shrink(1)->allow_nonref(1)->convert_blessed(1);
}
sub true {
copy_boolean() if !$copied_boolean;
my $x = 1;
return bless \$x, 'Types::Serialiser::Boolean';
}
sub false {
copy_boolean() if !$copied_boolean;
my $x = 0;
return bless \$x, 'Types::Serialiser::Boolean';
}
sub pretty_dump {
return _create_new_json_object()->pretty(1)->encode( $_[0] );
}
my $XS_Canonical_obj;
sub canonical_dump {
return ( $XS_Canonical_obj ||= _create_new_json_object()->canonical(1) )->encode( $_[0] );
}
sub pretty_canonical_dump {
return _create_new_json_object()->canonical(1)->indent->space_before->space_after->encode( $_[0] );
}
sub Dump {
return ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->encode( $_[0] );
}
sub Load {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub LoadRelaxed {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_RelaxedConvertBlessed_obj ||= _create_new_json_object()->relaxed(1) )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub _throw_json_error {
my ( $exception, $path, $dataref ) = @_;
local $@;
require Cpanel::Exception;
die $exception if $@;
die 'Cpanel::Exception'->can('create')->( 'JSONParseError', { 'error' => $exception, 'path' => $path, 'dataref' => $dataref } );
}
sub LoadNoSetUTF8 {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_NoSetUTF8ConvertBlessed_obj ||= _create_new_no_set_utf8_json_object() )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub LoadNoSetUTF8Relaxed {
local $@;
_replace_unicode_escapes_if_needed( \$_[0] );
return eval { ( $XS_NoSetUTF8RelaxedConvertBlessed_obj ||= _create_new_no_set_utf8_json_object()->relaxed(1) )->decode( $_[0] ); } // ( ( $@ && _throw_json_error( $@, $_[1], \$_[0] ) ) || undef );
}
sub _create_new_no_set_utf8_json_object {
my $obj = _create_new_json_object();
if ( $obj->can('no_set_utf8') ) {
$obj->no_set_utf8(1);
}
else {
warn "JSON::XS is missing the no_set_utf8 flag";
}
return $obj;
}
sub _replace_unicode_escapes_if_needed {
my $json_r = shift;
return unless defined $$json_r;
if ( -1 != index( $$json_r, '\\u' ) ) {
Cpanel::JSON::Unicode::replace_unicode_escapes_with_utf8($json_r);
}
return;
}
sub SafeLoadFile { # only allow a small bit of data to be loaded
return _LoadFile( $_[0], $MAX_LOAD_LENGTH, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT );
}
sub LoadFile {
return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_STRICT );
}
sub LoadFileRelaxed {
return _LoadFile( $_[0], $MAX_LOAD_LENGTH_UNLIMITED, $_[2] || $NO_DECODE_UTF8, $_[1], $LOAD_RELAXED );
}
sub LoadFileNoSetUTF8 {
return _LoadFile( $_[0], $_[1] || $MAX_LOAD_LENGTH_UNLIMITED, $DECODE_UTF8, $_[2], $LOAD_STRICT );
}
sub _LoadFile {
my ( $file, $max, $decode_utf8, $path, $relaxed ) = @_;
my $data;
if ( Cpanel::FHUtils::Tiny::is_a($file) ) {
if ($max) {
my $togo = $max;
$data = '';
my $bytes_read;
while ( $bytes_read = read( $file, $data, $togo, length $data ) && length $data < $max ) {
$togo -= $bytes_read;
}
}
else {
Cpanel::LoadFile::ReadFast::read_all_fast( $file, $data );
}
}
else {
local $!;
open( my $fh, '<:stdio', $file ) or do {
my $err = $!;
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("Cannot open “$file”: $err");
};
Cpanel::LoadFile::ReadFast::read_all_fast( $fh, $data );
if ( !length $data ) {
require Cpanel::Carp;
die Cpanel::Carp::safe_longmess("“$file” is empty.");
}
close $fh or warn "close($file) failed: $!";
}
if ( $decode_utf8 && $decode_utf8 == $DECODE_UTF8 ) {
Cpanel::UTF8::Strict::decode($data);
return $relaxed ? LoadNoSetUTF8Relaxed( $data, $path || $file ) : LoadNoSetUTF8( $data, $path || $file );
}
return $relaxed ? LoadRelaxed( $data, $path || $file ) : Load( $data, $path || $file );
}
sub SafeDump {
my $raw_json = ( $XS_ConvertBlessed_obj ||= _create_new_json_object() )->encode( $_[0] );
$raw_json =~ s{\/}{\\/}g if $raw_json =~ tr{/}{};
return $raw_json;
}
sub _fh_looks_like_json {
my ($fh) = @_;
my $bytes_read = 0;
my $buffer = q{};
local $!;
while ( $buffer !~ tr{ \t\r\n\f}{}c && !eof $fh ) {
$bytes_read += ( read( $fh, $buffer, 1, length $buffer ) // die "read() failed: $!" );
}
return (
_string_looks_like_json($buffer),
\$buffer,
);
}
sub _string_looks_like_json { ##no critic qw(RequireArgUnpacking)
return $_[0] =~ m/\A\s*[\[\{"0-9]/ ? 1 : 0;
}
sub looks_like_json { ##no critic qw(RequireArgUnpacking)
if ( Cpanel::FHUtils::Tiny::is_a( $_[0] ) ) {
my $fh = $_[0];
my ( $looks_like_json, $fragment_ref ) = _fh_looks_like_json($fh);
my $bytes_read = length $$fragment_ref;
if ($bytes_read) {
seek( $fh, -$bytes_read, $Cpanel::Fcntl::Constants::SEEK_CUR ) or die "seek() failed: $!";
}
return $looks_like_json;
}
return _string_looks_like_json( $_[0] );
}
sub to_bool {
my ($val) = @_;
$val = 0 if defined $val && $val eq 'false';
return !!$val ? true() : false();
}
1;
} # --- END Cpanel/JSON.pm
{ # --- BEGIN Cpanel/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/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/ConfigFiles.pm
package Cpanel::ConfigFiles;
use strict;
our $VERSION = '1.4';
our $cpanel_users = '/var/cpanel/users';
our $cpanel_users_cache = '/var/cpanel/users.cache';
our $backup_config_touchfile = '/var/cpanel/config/backups/metadata_disabled';
our $backup_config_touchfile_dir = '/var/cpanel/config/backups/';
our $backup_config = '/var/cpanel/backups/config';
our $cpanel_config_file = '/var/cpanel/cpanel.config';
our $cpanel_config_cache_file = '/var/cpanel/cpanel.config.cache';
our $cpanel_config_defaults_file = '/usr/local/cpanel/etc/cpanel.config';
our $features_cache_dir = "/var/cpanel/features.cache";
our $BASE_INSTALL_IN_PROGRESS_FILE = '/root/installer.lock';
our $CPSRVD_CHECK_CPLISC_FILE = q{/var/cpanel/cpsrvd_check_license};
our $ROOT_CPANEL_HOMEDIR = '/var/cpanel/userhomes/cpanel';
our $RESELLERS_FILE = '/var/cpanel/resellers';
our $RESELLERS_NAMESERVERS_FILE = '/var/cpanel/resellers-nameservers';
our $ACCOUNTING_LOG_FILE = '/var/cpanel/accounting.log';
our $FEATURES_DIR = '/var/cpanel/features';
our $BANDWIDTH_LIMIT_DIR = '/var/cpanel/bwlimited';
our $CUSTOM_PERL_MODULES_DIR = '/var/cpanel/perl';
our $PACKAGES_DIR; #defined below
our $DEDICATED_IPS_FILE = '/etc/domainips';
our $DELEGATED_IPS_DIR = '/var/cpanel/dips';
our $MAIN_IPS_DIR = '/var/cpanel/mainips';
our $RESERVED_IPS_FILE = '/etc/reservedips';
our $RESERVED_IP_REASONS_FILE = '/etc/reservedipreasons';
our $IP_ADDRESS_POOL_FILE = '/etc/ipaddrpool';
our $ACL_LISTS_DIR = '/var/cpanel/acllists';
our $OUTGOING_MAIL_SUSPENDED_USERS_FILE = '/etc/outgoing_mail_suspended_users';
our $OUTGOING_MAIL_HOLD_USERS_FILE = '/etc/outgoing_mail_hold_users';
our $TRUEUSEROWNERS_FILE = '/etc/trueuserowners';
our $TRUEUSERDOMAINS_FILE = '/etc/trueuserdomains';
our $USERDOMAINS_FILE = '/etc/userdomains';
our $DBOWNERS_FILE = '/etc/dbowners';
our $DOMAINUSERS_FILE = '/etc/domainusers';
our $LOCALDOMAINS_FILE = '/etc/localdomains';
our $REMOTEDOMAINS_FILE = '/etc/remotedomains';
our $SECONDARYMX_FILE = '/etc/secondarymx';
our $MANUALMX_FILE = '/etc/manualmx';
our $USERBWLIMITS_FILE = '/etc/userbwlimits';
our $MAILIPS_FILE = '/etc/mailips';
our $MAILHELO_FILE = '/etc/mailhelo';
our $NEIGHBOR_NETBLOCKS_FILE = '/etc/neighbor_netblocks';
our $CPANEL_MAIL_NETBLOCKS_FILE = '/etc/cpanel_mail_netblocks';
our $GREYLIST_TRUSTED_NETBLOCKS_FILE = '/etc/greylist_trusted_netblocks';
our $GREYLIST_COMMON_MAIL_PROVIDERS_FILE = '/etc/greylist_common_mail_providers';
our $RECENT_RECIPIENT_MAIL_SERVER_IPS_FILE = '/etc/recent_recipient_mail_server_ips';
our $DEMOUSERS_FILE = '/etc/demousers';
our $APACHE_CONFIG_DIR = '/var/cpanel/conf/apache';
our $APACHE_PRIMARY_VHOSTS_FILE = '/var/cpanel/conf/apache/primary_virtual_hosts.conf';
our $MYSQL_CNF = '/etc/my.cnf';
our $SERVICEAUTH_DIR = '/var/cpanel/serviceauth';
our $DORMANT_SERVICES_DIR = '/var/cpanel/dormant_services';
our $DOMAIN_KEYS_ROOT = '/var/cpanel/domain_keys';
our $USER_NOTIFICATIONS_DIR = '/var/cpanel/user_notifications';
our $DATABASES_INFO_DIR = '/var/cpanel/databases';
our $CPANEL_ROOT = '/usr/local/cpanel';
our $MAILMAN_ROOT = "$CPANEL_ROOT/3rdparty/mailman";
our $FPM_CONFIG_ROOT = "/var/cpanel/php-fpm.d";
our $FPM_ROOT = "/var/cpanel/php-fpm";
our $MAILMAN_LISTS_DIR = "$MAILMAN_ROOT/lists";
our $MAILMAN_USER = 'mailman';
our $FTP_PASSWD_DIR = '/etc/proftpd';
our $FTP_SYMLINKS_DIR = '/etc/pure-ftpd';
our $VALIASES_DIR = '/etc/valiases';
our $VDOMAINALIASES_DIR = '/etc/vdomainaliases';
our $VFILTERS_DIR = '/etc/vfilters';
our $JAILSHELL_PATH = '/usr/local/cpanel/bin/jailshell';
our @COMMONDOMAINS_FILES = qw{/usr/local/cpanel/etc/commondomains /var/cpanel/commondomains};
our $BANDWIDTH_DIRECTORY = '/var/cpanel/bandwidth';
our $BANDWIDTH_CACHE_DIRECTORY = '/var/cpanel/bandwidth.cache';
our $BANDWIDTH_USAGE_CACHE_DIRECTORY = '/var/cpanel/bwusagecache';
our $TEMPLATE_COMPILE_DIR = '/var/cpanel/template_compiles';
our $DOVECOT_SNI_CONF = '/etc/dovecot/sni.conf';
our $DOVECOT_SSL_CONF = '/etc/dovecot/ssl.conf';
our $DOVECOT_SSL_KEY = '/etc/dovecot/ssl/dovecot.key';
our $DOVECOT_SSL_CRT = '/etc/dovecot/ssl/dovecot.crt';
our $GOOGLE_AUTH_TEMPFILE_PREFIX = '/var/cpanel/backups/google_oauth_tempfile_';
our $APACHE_LOGFILE_CLEANUP_QUEUE = '/var/cpanel/apache_logfile_cleanup.json';
our $SKIP_REPO_SETUP_FLAG = '/var/cpanel/skip-repo-setup';
our $ACCOUNT_ENHANCEMENTS_DIR = '/var/cpanel/account_enhancements';
our $ACCOUNT_ENHANCEMENTS_CONFIG_DIR = $Cpanel::ConfigFiles::ACCOUNT_ENHANCEMENTS_DIR . '/config';
our $ACCOUNT_ENHANCEMENTS_INSTALL_FILE = $Cpanel::ConfigFiles::ACCOUNT_ENHANCEMENTS_CONFIG_DIR . '/installed.json';
BEGIN {
$PACKAGES_DIR = '/var/cpanel/packages';
}
1;
} # --- END Cpanel/ConfigFiles.pm
{ # --- BEGIN Cpanel/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/Struct/Common/Time.pm
package Cpanel::Struct::Common::Time;
use strict;
use warnings;
no warnings 'once';
use constant PACK_TEMPLATE => 'L!L!';
my %CLASS_PRECISION;
sub float_to_binary {
return pack(
PACK_TEMPLATE(),
int( $_[1] ),
int( 0.5 + ( $_[0]->_PRECISION() * $_[1] ) - ( $_[0]->_PRECISION() * int( $_[1] ) ) ),
);
}
sub binary_to_float {
return $_[0]->_binary_to_float( PACK_TEMPLATE(), $_[1] )->[0];
}
sub binaries_to_floats_at {
return $_[0]->_binary_to_float(
"\@$_[3] " . ( PACK_TEMPLATE() x $_[2] ),
$_[1],
);
}
my ( $i, $precision, @sec_psec_pairs );
sub _binary_to_float { ## no critic qw(RequireArgUnpacking)
@sec_psec_pairs = unpack( $_[1], $_[2] );
$i = 0;
my @floats;
$precision = $CLASS_PRECISION{ $_[0] } ||= $_[0]->_PRECISION();
while ( $i < @sec_psec_pairs ) {
push @floats, 0 + ( q<> . ( $sec_psec_pairs[$i] + ( $sec_psec_pairs[ $i + 1 ] / $precision ) ) );
$i += 2;
}
return \@floats;
}
1;
} # --- END Cpanel/Struct/Common/Time.pm
{ # --- BEGIN Cpanel/Struct/timespec.pm
package Cpanel::Struct::timespec;
use strict;
use warnings;
no warnings 'once';
# use parent Cpanel::Struct::Common::Time (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Struct::Common::Time); }
use constant {
_PRECISION => 1_000_000_000, # nanoseconds
};
1;
} # --- END Cpanel/Struct/timespec.pm
{ # --- BEGIN Cpanel/NanoStat.pm
package Cpanel::NanoStat;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Struct::timespec (); # perlpkg line 211
use constant {
_NR_stat => 4,
_NR_fstat => 5,
_NR_lstat => 6,
};
use constant _PACK_TEMPLATE => q<
Q # st_dev
Q # st_ino
@24 L # st_mode
@16 Q # st_nlink
@28
L # st_uid
L # st_gid
x![Q]
Q # st_rdev
Q # st_size
Q # st_blksize
Q # st_blocks
>;
my $pre_times_pack_len = length pack _PACK_TEMPLATE();
my $buf = ( "\0" x 144 );
sub stat {
return _syscall( _NR_stat(), $_[0] );
}
sub lstat {
return _syscall( _NR_lstat(), $_[0] );
}
sub fstat {
return _syscall( _NR_fstat(), 0 + ( ref( $_[0] ) ? fileno( $_[0] ) : $_[0] ) );
}
sub _syscall { ## no critic qw(RequireArgUnpacking)
my $arg_dupe = $_[1];
return undef if -1 == syscall( $_[0], $arg_dupe, $buf );
my @vals = unpack _PACK_TEMPLATE(), $buf;
splice(
@vals, 8, 0,
@{ Cpanel::Struct::timespec->binaries_to_floats_at( $buf, 3, $pre_times_pack_len ) },
);
return @vals;
}
1;
} # --- END Cpanel/NanoStat.pm
{ # --- BEGIN Cpanel/NanoUtime.pm
package Cpanel::NanoUtime;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Struct::timespec (); # perlpkg line 211
use constant {
_NR_utimensat => 280,
_AT_FDCWD => -100,
_AT_SYMLINK_NOFOLLOW => 0x100,
};
sub utime {
return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 );
}
sub futime {
return _syscall(
0 + ( ref( $_[2] ) ? fileno( $_[2] ) : $_[2] ),
undef,
@_[ 0, 1 ],
0,
);
}
sub lutime {
return _syscall( 0 + _AT_FDCWD(), $_[2], @_[ 0, 1 ], 0 + _AT_SYMLINK_NOFOLLOW() );
}
my ( $path, $buf ) = @_;
sub _syscall {
if ( defined $_[-3] ) {
if ( defined $_[-2] ) {
$buf = Cpanel::Struct::timespec->float_to_binary( $_[-3] ) . Cpanel::Struct::timespec->float_to_binary( $_[-2] );
}
else {
die "atime is “$_[-3]”, but mtime is undef!";
}
}
elsif ( defined $_[-2] ) {
die "atime is undef, but mtime is “$_[-2]”!";
}
else {
$buf = undef;
}
$path = $_[1];
return undef if -1 == syscall( 0 + _NR_utimensat(), $_[0], $path // undef, $buf // undef, $_[-1] );
return 1;
}
1;
} # --- END Cpanel/NanoUtime.pm
{ # --- BEGIN Cpanel/HiRes.pm
package Cpanel::HiRes;
use strict;
use warnings;
no warnings 'once';
my %_routes = (
'fstat' => [ 'NanoStat', 'fstat', 'stat', 1 ],
'lstat' => [ 'NanoStat', 'lstat', 'lstat', 1 ],
'stat' => [ 'NanoStat', 'stat', 'stat', 1 ],
'time' => [ 'TimeHiRes', 'time', 'time' ],
'utime' => [ 'NanoUtime', 'utime', 'utime' ],
'futime' => [ 'NanoUtime', 'futime', 'utime' ],
'lutime' => [ 'NanoUtime', 'lutime', undef ],
);
my $preloaded;
sub import {
my ( $class, %opts ) = @_;
if ( my $preload = $opts{'preload'} ) {
if ( $preload eq 'xs' ) {
require Time::HiRes;
}
elsif ( $preload eq 'perl' ) {
if ( !$preloaded ) {
require Cpanel::TimeHiRes; # PPI USE OK - preload
require Cpanel::NanoStat; # PPI USE OK - preload
require Cpanel::NanoUtime; # PPI USE OK - preload
}
}
else {
die "Unknown “preload”: “$preload”";
}
$preloaded = $preload;
}
return;
}
our $AUTOLOAD;
sub AUTOLOAD { ## no critic qw(Subroutines::RequireArgUnpacking)
substr( $AUTOLOAD, 0, 1 + rindex( $AUTOLOAD, ':' ) ) = q<>;
if ( !$AUTOLOAD || !$_routes{$AUTOLOAD} ) {
die "Unknown function in Cpanel::HiRes::$_[0]";
}
my $function = $AUTOLOAD;
undef $AUTOLOAD;
my ( $pp_module, $pp_function, $xs_function, $xs_needs_closure ) = @{ $_routes{$function} };
no strict 'refs';
if ( $INC{'Time/HiRes.pm'} && $xs_function ) {
*$function = *{"Time::HiRes::$xs_function"};
return Time::HiRes->can($xs_function)->(@_);
}
else {
_require("Cpanel/${pp_module}.pm") if !$INC{"Cpanel/${pp_module}.pm"};
my $pp_cr = "Cpanel::${pp_module}"->can($pp_function);
if ($xs_function) {
*$function = sub {
if ( $INC{'Time/HiRes.pm'} ) {
*$function = *{"Time::HiRes::$xs_function"};
return Time::HiRes->can($xs_function)->(@_);
}
goto &$pp_cr;
};
}
else {
*$function = $pp_cr;
}
}
goto &$function;
}
sub _require {
local ( $!, $^E, $@ );
require $_[0];
return;
}
1;
} # --- END Cpanel/HiRes.pm
{ # --- BEGIN Cpanel/Path/Normalize.pm
package Cpanel::Path::Normalize;
use strict;
use warnings;
no warnings 'once';
sub normalize {
my $uncleanpath = shift || return;
my $is_abspath = ( 0 == index( $uncleanpath, '/' ) );
my @pathdirs = split( m[/], $uncleanpath );
my @cleanpathdirs;
my $leading_dot_dots = 0;
foreach my $dir (@pathdirs) {
next if !length $dir; #Remove extraneous "//" and leading "/"
next if $dir eq '.';
if ( $dir eq '..' ) {
if (@cleanpathdirs) {
pop(@cleanpathdirs);
}
else {
$leading_dot_dots++;
}
}
else {
push( @cleanpathdirs, $dir );
}
}
if ($is_abspath) {
return ( '/' . join( '/', @cleanpathdirs ) );
}
unshift @cleanpathdirs, ('..') x $leading_dot_dots;
return join( '/', @cleanpathdirs );
}
1;
} # --- END Cpanel/Path/Normalize.pm
{ # --- BEGIN Cpanel/JSON/FailOK.pm
package Cpanel::JSON::FailOK;
use strict;
use warnings;
no warnings 'once';
sub LoadJSONModule {
local $@;
my $load_ok = eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
require Cpanel::JSON; # PPI NO PARSE - FailOK
1;
};
if ( !$load_ok && !$ENV{'CPANEL_BASE_INSTALL'} && index( $^X, '/usr/local/cpanel' ) == 0 ) {
warn $@;
}
return $load_ok ? 1 : 0;
}
sub LoadFile {
return undef if !$INC{'Cpanel/JSON.pm'};
return eval {
local $SIG{'__DIE__'}; # Suppress spewage as we may be reading an invalid cache
local $SIG{'__WARN__'}; # and since failure is ok to throw it away
Cpanel::JSON::LoadFile(@_); # PPI NO PARSE - inc check above
};
}
1;
} # --- END Cpanel/JSON/FailOK.pm
{ # --- BEGIN Cpanel/Hash/Stringify.pm
package Cpanel::Hash::Stringify;
use strict;
use warnings;
no warnings 'once';
sub sorted_hashref_string {
my ($hashref) = @_;
return (
( scalar keys %$hashref )
? join(
'_____', map { $_, ( ref $hashref->{$_} eq 'HASH' ? sorted_hashref_string( $hashref->{$_} ) : ref $hashref->{$_} eq 'ARRAY' ? join( '_____', @{ $hashref->{$_} } ) : defined $hashref->{$_} ? $hashref->{$_} : '' ) }
sort keys %$hashref
)
: ''
); #sort is important for order;
}
1;
} # --- END Cpanel/Hash/Stringify.pm
{ # --- BEGIN Cpanel/Umask.pm
package Cpanel::Umask;
use strict;
# use parent Cpanel::Finally (); # perlpkg line 238
our @ISA;
BEGIN { push @ISA, qw(Cpanel::Finally); }
sub new {
my ( $class, $new ) = @_;
my $old = umask();
umask($new);
return $class->SUPER::new(
sub {
my $cur = umask();
if ( $cur != $new ) {
my ( $cur_o, $old_o, $new_o ) = map { '0' . sprintf( '%o', $_ ) } ( $cur, $old, $new );
warn "I want to umask($old_o). I expected the current umask to be $new_o, but it’s actually $cur_o.";
}
umask($old);
}
);
}
1;
} # --- END Cpanel/Umask.pm
{ # --- BEGIN Cpanel/Config/LoadConfig.pm
package Cpanel::Config::LoadConfig;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::Hash::Stringify (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::FileUtils::Write::JSON::Lazy (); # perlpkg line 211
# use Cpanel::AdminBin::Serializer::FailOK (); # perlpkg line 211
# use Cpanel::LoadFile::ReadFast (); # perlpkg line 211
# use Cpanel::HiRes (); # perlpkg line 211
# use Cpanel::SV (); # perlpkg line 211
use constant _ENOENT => 2;
my $logger;
our $PRODUCT_CONF_DIR = '/var/cpanel';
our $_DEBUG_SAFEFILE = 0;
my %COMMON_CACHE_NAMES = (
':__^\s*[#;]____0__' => 'default_colon',
':\s+__^\s*[#;]____0__' => 'default_colon_any_space',
': __^\s*[#;]____0__' => 'default_colon_with_one_space',
'=__^\s*[#;]____0__skip_readable_check_____1' => 'default_skip_readable',
'=__^\s*[#;]____0__' => 'default',
'=__^\s*[#;]__(?^:\s+)__0__' => 'default_with_preproc_newline',
'=__^\s*[#;]____1__' => 'default_allow_undef',
'\s*[:]\s*__^\s*[#;]____0__' => 'default_colon_before_after_space',
'\s*=\s*__^\s*[#;]____1__' => 'default_equal_before_after_space_allow_undef',
'\s*[\=]\s*__^\s*[#]____0__use_reverse_____0' => 'default_equal_before_after_space',
': __^\s*[#;]____0__limit_____10000000000_____use_reverse_____0' => 'default_with_10000000000_limit',
'\s*[:]\s*__^\s*[#;]____0__use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_use_hash_of_arr_refs',
': __^\s*[#;]____0__limit__________use_reverse_____0' => 'default_colon_single_space_no_limit',
': __^\s*[#;]____1__skip_keys_____nobody_____use_hash_of_arr_refs_____0_____use_reverse_____0' => 'default_colon_skip_nobody_no_limit',
': __^\s*[#;]____1__use_reverse_____1' => 'default_reverse_allow_undef',
'\s+__^\s*[#;]____0__' => 'default_space_seperated_config',
'\s*=\s*__^\s*[#;]__^\s*__0__' => 'default_equal_space_seperated_config', #ea4.conf
);
my $DEFAULT_DELIMITER = '=';
my $DEFAULT_COMMENT_REGEXP = '^\s*[#;]'; #Keep in sync with tr{} below!!
my @BOOLEAN_OPTIONS = qw(
allow_undef_values
use_hash_of_arr_refs
use_reverse
);
my $CACHE_DIR_PERMS = 0700;
sub _process_parse_args {
my (%opts) = @_;
if ( !defined $opts{'delimiter'} ) {
$opts{'delimiter'} = $DEFAULT_DELIMITER;
}
$opts{'regexp_to_preprune'} ||= q{};
$opts{'comment'} ||= $DEFAULT_COMMENT_REGEXP;
$opts{'comment'} = '' if $opts{'comment'} eq '0E0';
$opts{$_} ||= 0 for @BOOLEAN_OPTIONS;
return %opts;
}
{
no warnings 'once';
*get_homedir_and_cache_dir = *_get_homedir_and_cache_dir;
}
sub _get_homedir_and_cache_dir {
my ( $homedir, $cache_dir );
if ( $> == 0 ) {
$cache_dir = "$PRODUCT_CONF_DIR/configs.cache";
}
else {
{
no warnings 'once';
$homedir = $Cpanel::homedir;
}
if ( !$homedir ) {
eval 'local $SIG{__DIE__}; local $SIG{__WARN__}; require Cpanel::PwCache'; ## no critic qw(ProhibitStringyEval) # PPI USE OK - just after
$homedir = Cpanel::PwCache::gethomedir() if $INC{'Cpanel/PwCache.pm'};
return unless $homedir; # undef for homedir and cache_dir avoid issues later when using undef as hash key
}
Cpanel::SV::untaint($homedir);
$homedir =~ tr{/}{}s;
return ( $homedir, undef ) if $homedir eq '/';
if ( $ENV{'TEAM_USER'} ) {
$cache_dir = "$homedir/$ENV{'TEAM_USER'}/.cpanel/caches/config";
}
else {
$cache_dir = "$homedir/.cpanel/caches/config";
}
}
return ( $homedir, $cache_dir );
}
sub loadConfig { ## no critic qw(Subroutines::ProhibitExcessComplexity Subroutines::ProhibitManyArgs)
my ( $file, $conf_ref, $delimiter, $comment, $regexp_to_preprune, $allow_undef_values, $arg_ref ) = @_;
$conf_ref ||= -1;
my %processed_positional_args = _process_parse_args(
delimiter => $delimiter,
comment => $comment,
regexp_to_preprune => $regexp_to_preprune,
allow_undef_values => $allow_undef_values,
$arg_ref ? %$arg_ref : (),
);
my $empty_is_invalid = ( defined $arg_ref ) ? delete $arg_ref->{'empty_is_invalid'} : undef;
my ( $use_reverse, $use_hash_of_arr_refs );
( $delimiter, $comment, $regexp_to_preprune, $allow_undef_values, $use_reverse, $use_hash_of_arr_refs ) = @processed_positional_args{
qw(
delimiter
comment
regexp_to_preprune
allow_undef_values
use_reverse
use_hash_of_arr_refs
)
};
if ( !$file || $file =~ tr/\0// ) {
_do_logger( 'warn', 'loadConfig requires valid filename' );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "loadConfig requires valid filename" );
}
return;
}
my $filesys_mtime = ( Cpanel::HiRes::stat($file) )[9] or do {
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "Unable to stat $file: $!" );
}
return;
};
my $load_into_conf_ref = ( !ref $conf_ref && $conf_ref == -1 ) ? 0 : 1;
if ($load_into_conf_ref) {
$conf_ref = _hashify_ref($conf_ref);
}
my ( $homedir, $cache_dir ) = _get_homedir_and_cache_dir();
my $cache_file;
Cpanel::AdminBin::Serializer::FailOK::LoadModule() if !$INC{'Cpanel/AdminBin/Serializer.pm'};
if ( $cache_dir && $INC{'Cpanel/JSON.pm'} && ( !defined $arg_ref || !ref $arg_ref || !exists $arg_ref->{'nocache'} && !$arg_ref->{'keep_locked_open'} ) ) {
$cache_file = get_cache_file(
'file' => $file,
'cache_dir' => $cache_dir,
'delimiter' => $delimiter,
'comment' => $comment,
'regexp_to_preprune' => $regexp_to_preprune,
'allow_undef_values' => $allow_undef_values,
'arg_ref' => $arg_ref,
);
my ( $cache_valid, $ref ) = load_from_cache_if_valid(
'file' => $file,
'cache_file' => $cache_file,
'filesys_mtime' => $filesys_mtime,
'conf_ref' => $conf_ref,
'load_into_conf_ref' => $load_into_conf_ref,
'empty_is_invalid' => $empty_is_invalid,
);
if ($cache_valid) {
return $ref;
}
}
$conf_ref = {} if !$load_into_conf_ref;
my $conf_fh;
my $conflock;
my $locked;
if ( $arg_ref->{'keep_locked_open'} || $arg_ref->{'rw'} ) {
require Cpanel::SafeFile;
$locked = 1;
$conflock = Cpanel::SafeFile::safeopen( $conf_fh, '+<', $file );
}
else {
$conflock = open( $conf_fh, '<', $file );
}
if ( !$conflock ) {
my $open_err = $! || '(unspecified error)';
local $_DEBUG_SAFEFILE = 1;
require Cpanel::Logger;
my $is_root = ( $> == 0 ? 1 : 0 );
if ( !$is_root && !$arg_ref->{'skip_readable_check'} ) {
if ( !-r $file ) {
my $msg;
if ( my $err = $! ) {
$msg = "$file’s readability check failed: $err";
}
else {
my $euser = getpwuid $>;
$msg = "$file is not readable as $euser.";
}
_do_logger( 'warn', $msg );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, $msg );
}
return;
}
}
my $verb = ( $locked ? 'lock/' : q<> ) . 'open';
my $msg = "Unable to $verb $file as UIDs $</$>: $open_err";
Cpanel::Logger::cplog( $msg, 'warn', __PACKAGE__ );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, $msg );
}
return;
}
my ( $parse_ok, $parsed ) = _parse_from_filehandle(
$conf_fh,
comment => $comment,
delimiter => $delimiter,
regexp_to_preprune => $regexp_to_preprune,
allow_undef_values => $allow_undef_values,
use_reverse => $use_reverse,
use_hash_of_arr_refs => $use_hash_of_arr_refs,
$arg_ref ? %$arg_ref : (),
);
if ( $locked && !$arg_ref->{'keep_locked_open'} ) {
require Cpanel::SafeFile;
Cpanel::SafeFile::safeclose( $conf_fh, $conflock );
}
if ( !$parse_ok ) {
require Cpanel::Logger;
Cpanel::Logger::cplog( "Unable to parse $file: $parsed", 'warn', __PACKAGE__ );
if ( $arg_ref->{'keep_locked_open'} ) {
return ( undef, undef, undef, "Unable to parse $file: $parsed" );
}
return;
}
@{$conf_ref}{ keys %$parsed } = values %$parsed;
if ($cache_file) {
write_cache(
'cache_dir' => $cache_dir,
'cache_file' => $cache_file,
'homedir' => $homedir,
'is_root' => ( $> == 0 ? 1 : 0 ),
'data' => $parsed,
);
}
if ( $arg_ref->{'keep_locked_open'} ) {
return $conf_ref, $conf_fh, $conflock, "open success";
}
return $conf_ref;
}
sub load_from_cache_if_valid {
my (%opts) = @_;
my $cache_file = $opts{'cache_file'} or die "need cache_file!";
my $file = $opts{'file'};
my $conf_ref = $opts{'conf_ref'};
my $load_into_conf_ref = $opts{'load_into_conf_ref'};
my $filesys_mtime = $opts{'filesys_mtime'} || ( Cpanel::HiRes::stat($file) )[9];
open( my $cache_fh, '<:stdio', $cache_file ) or do {
my $err = $!;
my $msg = "non-fatal error: open($cache_file): $err";
warn $msg if $! != _ENOENT();
return ( 0, $msg );
};
my ( $cache_filesys_mtime, $now, $cache_conf_ref ) = ( ( Cpanel::HiRes::fstat($cache_fh) )[9], Cpanel::HiRes::time() ); # stat the file after we have it open to avoid a race condition
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig file:$file, cache_file:$cache_file, cache_filesys_mtime:$cache_filesys_mtime, filesys_mtime:$filesys_mtime, now:$now\n";
}
if ( $filesys_mtime && _greater_with_same_precision( $cache_filesys_mtime, $filesys_mtime ) && _greater_with_same_precision( $now, $cache_filesys_mtime ) ) {
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig using cache_file:$cache_file\n";
}
Cpanel::AdminBin::Serializer::FailOK::LoadModule() if !$INC{'Cpanel/AdminBin/Serializer.pm'};
if ( $cache_conf_ref = Cpanel::AdminBin::Serializer::FailOK::LoadFile($cache_fh) ) { #zero keys is a valid file still it may just be all comments or empty
close($cache_fh);
if ( $opts{'empty_is_invalid'} && scalar keys %$cache_conf_ref == 0 ) {
return ( 0, 'Cache is empty' );
}
my $ref_to_return;
if ($load_into_conf_ref) {
@{$conf_ref}{ keys %$cache_conf_ref } = values %$cache_conf_ref;
$ref_to_return = $conf_ref;
}
else {
$ref_to_return = $cache_conf_ref;
}
return ( 1, $ref_to_return );
}
elsif ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig failed to load cache_file:$cache_file\n";
}
}
else {
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) {
print STDERR __PACKAGE__ . "::loadConfig NOT using cache_file:$cache_file\n";
}
}
return ( 0, 'Cache not valid' );
}
sub _greater_with_same_precision {
my ( $float1, $float2 ) = @_;
my ( $int1, $int2 ) = ( int($float1), int($float2) );
if ( $float1 == $int1 or $float2 == $int2 ) {
return $int1 > $int2;
}
return $float1 > $float2;
}
sub get_cache_file { ## no critic qw(Subroutines::RequireArgUnpacking) - Args unpacked by _process_parse_args
my %opts = _process_parse_args(@_);
die 'need cache_dir!' if !$opts{'cache_dir'};
my $stringified_args = join(
'__',
@opts{qw(delimiter comment regexp_to_preprune allow_undef_values)}, ( scalar keys %{ $opts{'arg_ref'} } ? Cpanel::Hash::Stringify::sorted_hashref_string( $opts{'arg_ref'} ) : '' )
);
if ( ( $Cpanel::Debug::level || 0 ) >= 5 ) { # PPI NO PARSE - ok missing
print STDERR __PACKAGE__ . "::loadConfig stringified_args[$stringified_args]\n";
}
my $safe_filename = $opts{'file'};
$safe_filename =~ tr{/}{_};
return $opts{'cache_dir'} . '/' . $safe_filename . '___' . ( $COMMON_CACHE_NAMES{$stringified_args} || _get_fastest_hash($stringified_args) );
}
sub _get_fastest_hash {
require Cpanel::Hash;
goto \&Cpanel::Hash::get_fastest_hash;
}
sub write_cache {
my (%opts) = @_;
my $cache_file = $opts{'cache_file'};
my $cache_dir = $opts{'cache_dir'};
my $homedir = $opts{'homedir'};
my $is_root = $opts{'is_root'};
my $parsed = $opts{'data'};
my @dirs = ($cache_dir);
if ( !$is_root ) {
if ( $ENV{'TEAM_USER'} ) {
unshift @dirs, "$homedir/$ENV{'TEAM_USER'}", "$homedir/$ENV{'TEAM_USER'}/.cpanel", "$homedir/$ENV{'TEAM_USER'}/.cpanel/caches";
}
else {
unshift @dirs, "$homedir/.cpanel", "$homedir/.cpanel/caches";
}
}
foreach my $dir (@dirs) {
Cpanel::SV::untaint($dir);
chmod( $CACHE_DIR_PERMS, $dir ) or do {
if ( $! == _ENOENT() ) {
require Cpanel::Umask;
my $umask = Cpanel::Umask->new(0);
mkdir( $dir, $CACHE_DIR_PERMS ) or do {
_do_logger( 'warn', "Failed to create dir “$dir”: $!" );
};
}
else {
_do_logger( 'warn', "chmod($dir): $!" );
}
};
}
my $wrote_ok = eval { Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, $parsed, 0600 ) };
my $error = $@;
$error ||= "Unknown error" if !defined $wrote_ok;
if ($error) {
_do_logger( 'warn', "Could not create cache file “$cache_file”: $error" );
unlink $cache_file; #outdated
}
if ( ( $Cpanel::Debug::level || 0 ) > 4 ) { # PPI NO PARSE - ok missing
print STDERR __PACKAGE__ . "::loadConfig [lazy write cache file] [$cache_file] wrote_ok:[$wrote_ok]\n";
}
return 1;
}
sub _do_logger {
my ( $action, $msg ) = @_;
require Cpanel::Logger;
$logger ||= Cpanel::Logger->new();
return $logger->$action($msg);
}
sub parse_from_filehandle {
my ( $conf_fh, %opts ) = @_;
return _parse_from_filehandle( $conf_fh, _process_parse_args(%opts) );
}
sub _parse_from_filehandle {
my ( $conf_fh, %opts ) = @_;
my ( $comment, $limit, $regexp_to_preprune, $delimiter, $allow_undef_values, $use_hash_of_arr_refs, $skip_keys, $use_reverse ) = @opts{
qw(
comment
limit
regexp_to_preprune
delimiter
allow_undef_values
use_hash_of_arr_refs
skip_keys
use_reverse
)
};
my $conf_ref = {};
my $parser_code;
my ( $k, $v ); ## no critic qw(Variables::ProhibitUnusedVariables)
my $keys = 0;
my $key_value_text = $use_reverse ? '1,0' : '0,1';
my $cfg_txt = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $conf_fh, $cfg_txt );
my $has_cr = index( $cfg_txt, "\r" ) > -1 ? 1 : 0;
_remove_comments_from_text( \$cfg_txt, $comment, \$has_cr ) if $cfg_txt && $comment;
my $split_on = $has_cr ? '\r?\n' : '\n';
if ( !$limit && !$regexp_to_preprune && !$use_hash_of_arr_refs && length $delimiter ) {
if ($allow_undef_values) {
$parser_code = qq<
\$conf_ref = {
map {
(split(m/> . $delimiter . qq</, \$_, 2))[$key_value_text]
} split(/> . $split_on . qq</, \$cfg_txt)
};
>;
}
else {
$parser_code = ' $conf_ref = { map { ' . '($k,$v) = (split(m/' . $delimiter . '/, $_, 2))[' . $key_value_text . ']; ' . 'defined($v) ? ($k,$v) : () ' . '} split(/' . $split_on . '/, $cfg_txt ) }';
}
}
else {
if ( ( $Cpanel::Debug::level || 0 ) > 4 ) { # PPI NO PARSE - ok if not there
$limit ||= 0;
print STDERR __PACKAGE__ . "::parse_from_filehandle [slow LoadConfig parser used] LIMIT:[!$limit] REGEXP_TO_DELETE[!$regexp_to_preprune] USE_HASH_OF_ARR_REFS[$use_hash_of_arr_refs)]\n";
}
$parser_code = 'foreach (split(m/' . $split_on . '/, $cfg_txt)) {' . "\n" #
. q{next if !length;} . "\n" #
. ( $limit ? q{last if $keys++ == } . $limit . ';' : '' ) . "\n" . ( $regexp_to_preprune ? q{ s/} . $regexp_to_preprune . q{//g;} : '' ) . "\n" #
. (
length $delimiter ? #
(
q{( $k, $v ) = (split( /} . $delimiter . q{/, $_, 2 ))[} . $key_value_text . q{];} . "\n" . #
( !$allow_undef_values ? q{ next if !defined($v); } : '' ) . "\n" . #
( $use_hash_of_arr_refs ? q{ push @{ $conf_ref->{$k} }, $v; } : q{ $conf_ref->{$k} = $v; } ) . "\n" #
)
: q{$conf_ref->{$_} = 1; } . "\n"
) . '};';
}
$parser_code .= "; 1";
$parser_code =~ tr{\n}{\r}; ## no critic qw(Cpanel::TransliterationUsage)
eval($parser_code) or do { ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
$parser_code =~ tr{\r}{\n}; ## no critic qw(Cpanel::TransliterationUsage)
_do_logger( 'panic', "Failed to parse :: $parser_code: $@" );
return ( 0, "$@\n$parser_code" );
};
delete $conf_ref->{''} if !defined( $conf_ref->{''} );
if ($skip_keys) {
my $skip_keys_ar;
if ( ref $skip_keys eq 'ARRAY' ) {
$skip_keys_ar = $skip_keys;
}
elsif ( ref $skip_keys eq 'HASH' ) {
$skip_keys_ar = [ keys %$skip_keys ];
}
else {
return ( 0, 'skip_keys must be an ARRAY or HASH reference' );
}
delete @{$conf_ref}{@$skip_keys_ar};
}
return ( 1, $conf_ref );
}
sub _hashify_ref {
my $conf_ref = shift;
if ( !defined($conf_ref) ) {
$conf_ref = {};
return $conf_ref;
}
unless ( ref $conf_ref eq 'HASH' ) {
if ( ref $conf_ref ) {
require Cpanel::Logger;
Cpanel::Logger::cplog( 'hashifying non-HASH reference', 'warn', __PACKAGE__ );
${$conf_ref} = {};
$conf_ref = ${$conf_ref};
}
else {
require Cpanel::Logger;
Cpanel::Logger::cplog( 'defined value encountered where reference expected', 'die', __PACKAGE__ );
}
}
return $conf_ref;
}
sub default_product_dir {
$PRODUCT_CONF_DIR = shift if @_;
return $PRODUCT_CONF_DIR;
}
sub _remove_comments_from_text {
my ( $cfg_txt_sr, $comment, $has_cr_sr ) = @_;
if ($$has_cr_sr) {
$$cfg_txt_sr = join( "\n", grep ( !m/$comment/, split( m{\r?\n}, $$cfg_txt_sr ) ) );
$$has_cr_sr = 0;
}
elsif ( $comment eq $DEFAULT_COMMENT_REGEXP ) {
if ( rindex( $$cfg_txt_sr, '#', 0 ) == 0 && index( $$cfg_txt_sr, "\n" ) > -1 ) {
substr( $$cfg_txt_sr, 0, index( $$cfg_txt_sr, "\n" ) + 1, '' );
}
$$cfg_txt_sr =~ s{$DEFAULT_COMMENT_REGEXP.*}{}omg if $$cfg_txt_sr =~ tr{#;}{};
}
else {
$$cfg_txt_sr =~ s{$comment.*}{}mg;
}
return 1;
}
1;
} # --- END Cpanel/Config/LoadConfig.pm
{ # --- BEGIN Cpanel/Config/LoadWwwAcctConf.pm
package Cpanel::Config::LoadWwwAcctConf;
use strict;
use warnings;
no warnings 'once';
# use Cpanel::HiRes (); # perlpkg line 211
# use Cpanel::Path::Normalize (); # perlpkg line 211
# use Cpanel::Debug (); # perlpkg line 211
# use Cpanel::JSON::FailOK (); # perlpkg line 211
my $SYSTEM_CONF_DIR = '/etc';
my $wwwconf_cache;
my $wwwconf_mtime = 0;
my $has_serializer;
our $wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf";
our $wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow";
sub import {
my $this = shift;
if ( !exists $INC{'Cpanel/JSON.pm'} ) {
Cpanel::JSON::FailOK::LoadJSONModule();
}
if ( $INC{'Cpanel/JSON.pm'} ) {
$has_serializer = 1;
}
return Exporter::import( $this, @_ );
}
sub loadwwwacctconf { ## no critic qw(Subroutines::ProhibitExcessComplexity)
if ( $INC{'Cpanel/JSON.pm'} ) { $has_serializer = 1; } #something else loaded it
my $filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconf) )[9];
return if !$filesys_mtime;
if ( $filesys_mtime == $wwwconf_mtime && $wwwconf_cache ) {
return wantarray ? %{$wwwconf_cache} : $wwwconf_cache;
}
my $wwwacctconf_cache = "$wwwacctconf.cache";
my $wwwacctconfshadow_cache = "$wwwacctconfshadow.cache";
my $is_root = $> ? 0 : 1;
if ($has_serializer) {
my $cache_file;
my $cache_filesys_mtime;
my $have_valid_cache = 1;
if ( $is_root && -e $wwwacctconfshadow_cache ) {
$cache_filesys_mtime = ( Cpanel::HiRes::stat($wwwacctconfshadow_cache) )[9]; #shadow cache's mtime
my $shadow_file_mtime = ( Cpanel::HiRes::stat $wwwacctconfshadow )[9] || 0;
if ( $shadow_file_mtime < $cache_filesys_mtime ) {
$cache_file = $wwwacctconfshadow_cache;
}
else { #don't use shadow cache if shadow file is newer
$have_valid_cache = undef;
}
}
elsif ( -e $wwwacctconf_cache && !( $is_root && -r $wwwacctconfshadow ) ) {
$cache_filesys_mtime = ( Cpanel::HiRes::stat $wwwacctconf_cache )[9]; #regular cache's mtime
$cache_file = $wwwacctconf_cache;
}
else {
$have_valid_cache = undef;
}
my $now = Cpanel::HiRes::time();
if ( $Cpanel::Debug::level >= 5 ) {
print STDERR __PACKAGE__ . "::loadwwwacctconf cache_filesys_mtime = $cache_filesys_mtime , filesys_mtime: $filesys_mtime , now : $now\n";
}
if ( $have_valid_cache && $cache_filesys_mtime > $filesys_mtime && $cache_filesys_mtime < $now ) {
my $wwwconf_ref;
if ( open( my $conf_fh, '<', $cache_file ) ) {
$wwwconf_ref = Cpanel::JSON::FailOK::LoadFile($conf_fh);
close($conf_fh);
}
if ( $wwwconf_ref && ( scalar keys %{$wwwconf_ref} ) > 0 ) {
if ( $Cpanel::Debug::level >= 5 ) { print STDERR __PACKAGE__ . "::loadwwwconf file system cache hit\n"; }
$wwwconf_cache = $wwwconf_ref;
$wwwconf_mtime = $filesys_mtime;
return wantarray ? %{$wwwconf_ref} : $wwwconf_ref;
}
}
}
my @configfiles;
push @configfiles, $wwwacctconf;
if ($is_root) { push @configfiles, $wwwacctconfshadow; } #shadow file must be last as the cache gets written for each file with all the files before it in it
my $can_write_cache;
if ( $is_root && $has_serializer ) {
$can_write_cache = 1;
}
my %CONF = (
'ADDR' => undef,
'CONTACTEMAIL' => undef,
'DEFMOD' => undef,
'ETHDEV' => undef,
'HOST' => undef,
'NS' => undef,
'NS2' => undef,
);
require Cpanel::Config::LoadConfig;
foreach my $configfile (@configfiles) {
Cpanel::Config::LoadConfig::loadConfig( $configfile, \%CONF, '\s+', undef, undef, undef, { 'nocache' => 1 } );
foreach ( keys %CONF ) {
$CONF{$_} =~ s{\s+$}{} if defined $CONF{$_};
}
$CONF{'HOMEMATCH'} =~ s{/+$}{} if defined $CONF{'HOMEMATCH'}; # Remove trailing slashes
$CONF{'HOMEDIR'} = Cpanel::Path::Normalize::normalize( $CONF{'HOMEDIR'} ) if defined $CONF{'HOMEDIR'};
if ($can_write_cache) {
my $cache_file = $configfile . '.cache';
require Cpanel::FileUtils::Write::JSON::Lazy;
Cpanel::FileUtils::Write::JSON::Lazy::write_file( $cache_file, \%CONF, ( $configfile eq $wwwacctconfshadow ) ? 0600 : 0644 );
}
}
$wwwconf_mtime = $filesys_mtime;
$wwwconf_cache = \%CONF;
return wantarray ? %CONF : \%CONF;
}
sub reset_mem_cache {
( $wwwconf_mtime, $wwwconf_cache ) = ( 0, undef );
}
sub reset_has_serializer {
$has_serializer = 0;
}
sub default_conf_dir {
$SYSTEM_CONF_DIR = shift if @_;
$wwwacctconf = "$SYSTEM_CONF_DIR/wwwacct.conf";
$wwwacctconfshadow = "$SYSTEM_CONF_DIR/wwwacct.conf.shadow";
return $SYSTEM_CONF_DIR;
}
sub reset_caches {
my @cache_files = map { "$_.cache" } ( $wwwacctconf, $wwwacctconfshadow );
for my $cache_file (@cache_files) {
unlink $cache_file if -e $cache_file;
}
reset_mem_cache();
return;
}
1;
} # --- END Cpanel/Config/LoadWwwAcctConf.pm
{ # --- BEGIN Cpanel/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
our $VERSION = '0.82'; # DO NOT CHANGE THIS FROM A DECIMAL
sub _cpuser_defaults {
return @Cpanel::Config::CpUser::Defaults::DEFAULTS_KV;
}
my %should_never_be_on_disk = map { $_ => undef } qw(
DBOWNER
DOMAIN
DOMAINS
DEADDOMAINS
HOMEDIRLINKS
);
my $logger;
sub load_or_die {
return ( _load( $_[0], undef, if_missing => 'die' ) )[2];
}
sub load_if_exists {
return ( _load( $_[0], undef, if_missing => 'return' ) )[2] // undef;
}
sub load_file {
my ($file) = @_;
return parse_cpuser_file( _open_cpuser_file( '<', $file ) );
}
sub _open_cpuser_file_locked {
my ( $mode, $file ) = @_;
local $!;
my $cpuser_fh;
require Cpanel::SafeFile;
my $lock_obj = Cpanel::SafeFile::safeopen( $cpuser_fh, $mode, $file ) or do {
die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $file, error => $!, mode => $mode ] );
};
return ( $lock_obj, $cpuser_fh );
}
sub _open_cpuser_file {
my ( $mode, $file ) = @_;
local $!;
my $cpuser_fh;
open( $cpuser_fh, $mode, $file ) or do {
die Cpanel::Exception::create( 'IO::FileOpenError', [ path => $file, error => $!, mode => $mode ] );
};
return $cpuser_fh;
}
sub parse_cpuser_file {
my ($cpuser_fh) = @_;
my $buffer = '';
Cpanel::LoadFile::ReadFast::read_all_fast( $cpuser_fh, $buffer );
return parse_cpuser_file_buffer($buffer);
}
sub parse_cpuser_file_buffer {
my ($buffer) = @_;
my %cpuser = _cpuser_defaults();
my %DOMAIN_MAP;
my %DEAD_DOMAIN_MAP;
my %HOMEDIRLINKS_MAP;
local ( $!, $_ );
foreach ( split( m{\n}, $buffer ) ) {
next if index( $_, '#' ) > -1 && m/^\s*#/;
my ( $key, $value ) = split( /\s*=/, $_, 2 );
if ( !defined $value || exists $should_never_be_on_disk{$key} ) {
next;
}
elsif ( $key eq 'DNS' ) {
$cpuser{'DOMAIN'} = lc $value;
}
elsif ( index( $key, 'DNS' ) == 0 && substr( $key, 3, 1 ) =~ tr{0-9}{} ) {
$DOMAIN_MAP{ lc $value } = undef;
}
elsif ( index( $key, 'XDNS' ) == 0 && substr( $key, 4, 1 ) =~ tr{0-9}{} ) {
$DEAD_DOMAIN_MAP{ lc $value } = undef;
}
elsif ( index( $key, 'HOMEDIRPATHS' ) == 0 && $key =~ m{ \A HOMEDIRPATHS \d* \z }xms ) {
$HOMEDIRLINKS_MAP{$value} = undef;
}
else {
$cpuser{$key} = $value;
}
}
delete @DEAD_DOMAIN_MAP{ keys %DOMAIN_MAP };
delete $DOMAIN_MAP{ $cpuser{'DOMAIN'} };
if ($!) {
die Cpanel::Exception::create( 'IO::FileReadError', [ error => $! ] );
}
if ( exists $cpuser{'USER'} ) {
$cpuser{'DBOWNER'} = Cpanel::DB::Utils::username_to_dbowner( $cpuser{'USER'} );
}
if ( !length $cpuser{'RS'} ) {
require Cpanel::Conf;
my $cp_defaults = Cpanel::Conf->new();
$cpuser{'RS'} = $cp_defaults->cpanel_theme;
}
if ( !$cpuser{'LOCALE'} ) {
$cpuser{'LOCALE'} = 'en';
$cpuser{'__LOCALE_MISSING'} = 1;
}
$cpuser{'DOMAINS'} = [ sort keys %DOMAIN_MAP ]; # Sorted here so they can be tested with TM::is_deeply
$cpuser{'DEADDOMAINS'} = [ sort keys %DEAD_DOMAIN_MAP ]; # Sorted here so they can be tested with TM::is_deeply
$cpuser{'HOMEDIRLINKS'} = [ sort keys %HOMEDIRLINKS_MAP ];
return _wrap_cpuser( \%cpuser );
}
sub _wrap_cpuser {
return Cpanel::Config::CpUser::Object->adopt(shift);
}
sub _logger {
return $logger ||= do {
require Cpanel::Logger;
Cpanel::Logger->new();
};
}
sub load {
my ( $user, $opts ) = @_;
my $cpuser = ( _load( $user, $opts ) )[2];
if ( !ref $cpuser ) {
_logger()->warn( "Failed to load cPanel user file for '" . ( $user || '' ) . "'" ) unless $opts->{'quiet'};
return wantarray ? () : bless( {}, 'Cpanel::Config::CpUser::Object' );
}
return wantarray ? %$cpuser : $cpuser;
}
sub _load_locked {
my ($user) = @_;
my ( $fh, $lock_fh, $cpuser ) = _load( $user, { lock => 1 } );
return unless $fh && $lock_fh && $cpuser;
return {
'file' => $fh,
'lock' => $lock_fh,
'data' => $cpuser,
};
}
sub clear_cache {
my ($user) = @_;
return unlink "$Cpanel::ConfigFiles::cpanel_users.cache/$user";
}
sub _load { ## no critic(Subroutines::ProhibitExcessComplexity) -- Refactoring this function is a project, not a bug fix
my ( $user, $load_opts_ref, %internal_opts ) = @_;
if ( !$user || $user =~ tr</\0><> ) { #no eq '' needed as !$user covers this
_logger()->warn("Invalid username (falsy or forbidden character) given to loadcpuserfile.");
if ( $internal_opts{'if_missing'} ) {
die Cpanel::Exception::create( 'UserNotFound', [ name => '' ] );
}
return;
}
my ( $now, $has_serializer, $user_file, $user_cache_file ) = (
time(), #now
( exists $INC{'Cpanel/JSON.pm'} ? 1 : 0 ), #has_serializer
$load_opts_ref->{'file'} || "$Cpanel::ConfigFiles::cpanel_users/$user", # user_file
"$Cpanel::ConfigFiles::cpanel_users.cache/$user", # user_cache_file
);
my ( $cpuid, $cpgid, $size, $mtime ) = ( stat($user_file) )[ 4, 5, 7, 9 ];
if ( not defined($size) and my $if_missing = $internal_opts{'if_missing'} ) {
if ( $! == _ENOENT() ) {
if ( $if_missing eq 'return' ) {
return;
}
die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] );
}
die Cpanel::Exception->create( 'The system failed to find the file “[_1]” because of an error: [_2]', [ $user_file, $! ] );
}
$mtime ||= 0;
my $lock_fh;
my $cpuser_fh;
if ( $load_opts_ref->{'lock'} ) {
my $mode = $mtime ? '+<' : '+>';
try {
( $lock_fh, $cpuser_fh ) = _open_cpuser_file_locked( $mode, $user_file );
}
catch {
if ( my $if_missing = $internal_opts{'if_missing'} ) {
die $_ if $if_missing ne 'return';
}
else {
_logger()->warn($_);
}
};
return if !$lock_fh;
}
elsif ( !$size ) {
if ( $user eq 'cpanel' ) {
my $result = _load_cpanel_user();
_wrap_cpuser($result);
return ( $cpuser_fh, $lock_fh, $result );
}
else {
_logger()->warn("User file '$user_file' is empty or non-existent.") unless $load_opts_ref->{'quiet'};
return;
}
}
if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded
_logger()->debug("load cPanel user file [$user]");
}
if ($has_serializer) {
Cpanel::SV::untaint($user_cache_file); # case CPANEL-11199
if ( open( my $cache_fh, '<:stdio', $user_cache_file ) ) { #ok if the file is not there
my $cache_mtime = ( stat($cache_fh) )[9]; # Check the mtime after we have opened the file to prevent a race condition
if ( $cache_mtime >= $mtime && $cache_mtime <= $now ) {
my $cpuser_ref = Cpanel::AdminBin::Serializer::FailOK::LoadFile($cache_fh);
if ( $cpuser_ref && ref $cpuser_ref eq 'HASH' ) {
if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded
_logger()->debug("load cache hit user[$user] now[$now] mtime[$mtime] cache_mtime[$cache_mtime]");
}
$cpuser_ref->{'MTIME'} = $mtime;
if ( ( $cpuser_ref->{'__CACHE_DATA_VERSION'} // 0 ) == $VERSION ) {
_wrap_cpuser($cpuser_ref);
return ( $cpuser_fh, $lock_fh, $cpuser_ref );
}
else {
unlink $user_cache_file; # force a re-cache of the latest data set
}
}
}
else {
if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded
_logger()->debug("load cache miss user[$user] now[$now] mtime[$mtime] cache_mtime[$cache_mtime]");
}
}
close($cache_fh);
}
else {
if ( $Cpanel::Debug::level && $Cpanel::Debug::level > 3 ) { # PPI NO PARSE - This doesn't need to be loaded
_logger()->debug("load cache miss user[$user] now[$now] mtime[$mtime] cache_mtime[0]");
}
}
}
if ( !$lock_fh ) {
try {
$cpuser_fh = _open_cpuser_file( '<', $user_file );
}
catch {
die $_ if $internal_opts{'if_missing'};
_logger()->warn($_);
};
return if !$cpuser_fh;
}
my $cpuser_hr;
try {
$cpuser_hr = parse_cpuser_file($cpuser_fh);
}
catch {
_logger()->warn("Failed to read “$user_file”: $_");
};
return if !$cpuser_hr;
$cpuser_hr->{'USER'} = $user;
$cpuser_hr->{'DBOWNER'} = Cpanel::DB::Utils::username_to_dbowner($user);
$cpuser_hr->{'__CACHE_DATA_VERSION'} = $VERSION; # set this before the cache is written so that it will be included in the cache
if ( $> == 0 ) {
create_users_cache_dir();
if ( $has_serializer && Cpanel::FileUtils::Write::JSON::Lazy::write_file( $user_cache_file, $cpuser_hr, 0640 ) ) {
chown 0, $cpgid, $user_cache_file if $cpgid; # this is ok if the chown happens after as we fall though to reading the non-cache on a failed open
}
else {
unlink $user_cache_file; #outdated
}
}
$cpuser_hr->{'MTIME'} = ( stat($cpuser_fh) )[9];
if ( $load_opts_ref->{'lock'} ) {
seek( $cpuser_fh, 0, 0 );
}
else {
if ($lock_fh) {
require Cpanel::SafeFile;
Cpanel::SafeFile::safeclose( $cpuser_fh, $lock_fh );
}
$cpuser_fh = $lock_fh = undef;
}
return ( $cpuser_fh, $lock_fh, $cpuser_hr );
}
sub loadcpuserfile {
return load( $_[0] );
}
sub _load_cpanel_user {
my %cpuser = (
_cpuser_defaults(),
'DEADDOMAINS' => [],
'DOMAIN' => 'domain.tld',
'DOMAINS' => [],
'HASCGI' => 1,
'HOMEDIRLINKS' => [],
'LOCALE' => 'en',
'MAXADDON' => 'unlimited',
'MAXPARK' => 'unlimited',
'RS' => $Cpanel::Config::Constants::DEFAULT_CPANEL_THEME,
'USER' => 'cpanel',
);
return wantarray ? %cpuser : \%cpuser;
}
sub create_users_cache_dir {
my $uc = "$Cpanel::ConfigFiles::cpanel_users.cache";
if ( -f $uc || -l $uc ) {
my $bad = "$uc.bad";
unlink $bad if -e $bad;
rename $uc, $bad;
}
if ( !-e $uc ) {
mkdir $uc;
}
return;
}
sub _ENOENT { return 2; }
1;
} # --- END Cpanel/Config/LoadCpUserFile.pm
{ # --- BEGIN Cpanel/Config/HasCpUserFile.pm
package Cpanel::Config::HasCpUserFile;
use strict;
use warnings;
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 { $_ 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;
if ( scalar @groups == 1 && $groups[0] !~ tr{0-9}{}c ) { # we already have a gid
return ( $uid, $groups[0] );
}
}
elsif ( !scalar @groups ) {
( $uid, @groups ) = ( Cpanel::PwCache::getpwnam_noshadow($user) )[ 2, 3 ];
if ( !defined $uid ) {
die Cpanel::Exception::create( 'UserNotFound', [ name => $user ] );
}
return ( $uid, @groups );
}
else {
$uid = Cpanel::PwUtils::normalize_to_uid($user);
}
my @gids =
@groups
? ( map { !tr{0-9}{}c ? $_ : scalar( ( getgrnam $_ )[2] ) } @groups )
: ( ( Cpanel::PwCache::getpwuid_noshadow($uid) )[3] );
if ( scalar @gids > 2 ) {
return ( $uid, Cpanel::ArrayFunc::Uniq::uniq(@gids) );
}
elsif ( scalar @gids == 2 && $gids[0] eq $gids[1] ) {
return ( $uid, $gids[0] );
}
return ( $uid, @gids );
}
sub normalize_code_user_groups {
my @args = @_;
my $code_index;
for my $i ( 0 .. $#args ) {
if ( ref $args[$i] eq 'CODE' ) {
$code_index = $i;
last;
}
}
die "No coderef found!" if !defined $code_index;
my $code = splice( @args, $code_index, 1 );
return ( $code, normalize_user_and_groups( grep { defined } @args ) );
}
1;
} # --- END Cpanel/AccessIds/Normalize.pm
{ # --- BEGIN Cpanel/AccessIds/Utils.pm
package Cpanel::AccessIds::Utils;
use strict;
use warnings;
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 = {
'uid' => $>,
'gid' => $),
'new_uid' => $uid,
'new_gid' => join( q< >, @gids ),
};
_reduce_privileges( $uid, @gids );
$PRIVS_REDUCED = 1;
return bless $self;
}
sub DESTROY {
my ($self) = @_;
_allowed_to_restore_privileges( $self->{'new_uid'}, $self->{'new_gid'} );
return _restore_privileges( $self->{'uid'}, $self->{'gid'} );
}
sub call_as_user { ## no critic qw(Subroutines::RequireArgUnpacking)
my ( $code, $uid, $gid, @supplemental_gids ) = Cpanel::AccessIds::Normalize::normalize_code_user_groups(@_);
_prevent_dropping_to_root( $uid, $gid );
if ( !$code ) {
Cpanel::Debug::log_die("No code reference supplied.");
}
_allowed_to_reduce_privileges();
my ( $saved_uid, $saved_gid ) = ( $>, $) );
_reduce_privileges( $uid, $gid, @supplemental_gids );
local $PRIVS_REDUCED = 1;
my ( $scalar, @list );
if (wantarray) { #list context
@list = eval { $code->(); };
}
elsif ( defined wantarray ) { #scalar context
$scalar = eval { $code->(); };
}
else { #void context
eval { $code->(); };
}
my $ex = $@;
_restore_privileges( $saved_uid, $saved_gid );
die $ex if $ex;
return wantarray ? @list : $scalar;
}
sub _allowed_to_reduce_privileges {
if ( $< != 0 ) {
Cpanel::Debug::log_die("Attempting to drop privileges as a normal user with RUID $<");
}
if ( $> != 0 ) {
Cpanel::Debug::log_die("Attempting to drop privileges as a normal user with EUID $>");
}
return 1;
}
sub _reduce_privileges {
my ( $uid, $gid, @supplemental_gids ) = @_;
Cpanel::AccessIds::Utils::set_egid( $gid, @supplemental_gids );
Cpanel::AccessIds::Utils::set_euid($uid);
return 1;
}
sub _prevent_dropping_to_root {
if ( grep { !$_ } @_ ) {
Cpanel::Debug::log_die("Attempting to drop privileges to root.");
}
return 1;
}
sub _allowed_to_restore_privileges {
my ( $uid, $gid ) = @_;
if ( $< != 0 ) {
Cpanel::Debug::log_die("Attempting to restore privileges as a normal user with RUID $<");
}
if ( $> != $uid ) {
Cpanel::Debug::log_warn("EUID ($>) does not match expected reduced user ($uid)");
}
my ( $first_egid, $first_given_gid ) = ( $), $gid );
$_ = ( split m{ } )[0] for ( $first_egid, $first_given_gid );
if ( int $first_egid != int $first_given_gid ) {
Cpanel::Debug::log_warn("EGID ($)) does not match expected reduced user ($gid)");
}
}
sub _restore_privileges {
my ( $saved_uid, $saved_gid ) = @_;
Cpanel::AccessIds::Utils::set_euid($saved_uid);
Cpanel::AccessIds::Utils::set_egid( split m{ }, $saved_gid );
$PRIVS_REDUCED = 0;
return 1;
}
1;
} # --- END Cpanel/AccessIds/ReducedPrivileges.pm
{ # --- BEGIN Cpanel/DataStore.pm
package Cpanel::DataStore;
use strict;
use warnings;
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::Syck;
$YAML::Syck::ImplicitTyping = 0;
my $struct;
if ($file_is_ref) {
local $!;
$struct = eval {
local $/;
local $SIG{__WARN__};
local $SIG{__DIE__};
( YAML::Syck::Load(<$file>) )[0];
};
Cpanel::Debug::log_warn("Error loading YAML data: $!") if ( !$struct );
}
elsif ( open my $yaml_in, '<', $file ) {
local $!;
$struct = eval {
local $/;
local $SIG{__WARN__};
local $SIG{__DIE__};
( YAML::Syck::Load(<$yaml_in>) )[0];
};
Cpanel::Debug::log_warn("Error loading YAML data: $!") if ( !$struct );
close $yaml_in;
}
else {
my $err = $!;
Cpanel::Debug::log_warn("Could not open file '$file' for reading: $err");
return;
}
if ( !$struct ) {
Cpanel::Debug::log_warn("Failed to load YAML data from file $file");
return;
}
if ( defined $into_ref ) {
my $type = ref $into_ref;
my $yaml_type = ref $struct;
if ( $yaml_type ne $type ) {
Cpanel::Debug::log_warn("Invalid data type from file $file! YAML type $yaml_type does not match expected type $type. Data ignored!");
return; # if we want an empty ref on failure use fetch_ref()
}
if ( $yaml_type eq 'HASH' ) {
%{$into_ref} = %{$struct};
}
elsif ( $yaml_type eq 'ARRAY' ) {
@{$into_ref} = @{$struct};
}
else {
Cpanel::Debug::log_warn("YAML in '$file' is not a hash or array reference");
return; # if we want an empty ref on failure use fetch_ref()
}
return $into_ref;
}
return $struct;
}
sub edit_datastore {
my ( $file, $editor_cr, $is_array ) = @_;
if ( ref $editor_cr ne 'CODE' ) {
Cpanel::Debug::log_warn('second arg needs to be a coderef');
return;
}
my $ref = $is_array ? [] : {};
if ( !-e $file ) {
Cpanel::Debug::log_info("Data store file $file does not exist. Attempting to create empty datastore.");
store_ref( $file, $ref );
}
if ( load_ref( $file, $ref ) ) {
if ( $editor_cr->($ref) ) {
if ( !store_ref( $file, $ref ) ) {
Cpanel::Debug::log_warn("Modifications to file $file could not be saved");
return;
}
}
}
else {
Cpanel::Debug::log_warn("Could not l
Showing 512.00 KB of 2.02 MB. Use Edit/Download for full content.
Directory Contents
Dirs: 2 × Files: 448