mirror of
https://github.com/pandorafms/pandorafms.git
synced 2025-07-29 08:45:12 +02:00
Tools.pm definition retrieved from 5575
This commit is contained in:
fbsanchez
parent
32538e659a
commit
0282dae05a
@ -1,8 +1,8 @@
|
||||
package PandoraFMS::Tools;
|
||||
########################################################################
|
||||
################################################################################
|
||||
# Tools Package
|
||||
# Pandora FMS. the Flexible Monitoring System. http://www.pandorafms.org
|
||||
########################################################################
|
||||
################################################################################
|
||||
# Copyright (c) 2005-2011 Artica Soluciones Tecnologicas S.L
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
@ -15,7 +15,7 @@ package PandoraFMS::Tools;
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##########################################################################
|
||||
################################################################################
|
||||
|
||||
use warnings;
|
||||
use Time::Local;
|
||||
@ -109,8 +109,11 @@ our @EXPORT = qw(
|
||||
float_equal
|
||||
sqlWrap
|
||||
is_numeric
|
||||
is_enabled
|
||||
is_metaconsole
|
||||
is_offline
|
||||
is_empty
|
||||
is_in_array
|
||||
to_number
|
||||
clean_blank
|
||||
credential_store_get_key
|
||||
@ -128,6 +131,7 @@ our @EXPORT = qw(
|
||||
pandora_ping
|
||||
pandora_ping_latency
|
||||
pandora_block_ping
|
||||
ping
|
||||
resolve_hostname
|
||||
ticks_totime
|
||||
safe_input
|
||||
@ -147,6 +151,7 @@ our @EXPORT = qw(
|
||||
get_enabled_servers
|
||||
dateTimeToTimestamp
|
||||
get_user_agent
|
||||
ui_get_full_url
|
||||
);
|
||||
|
||||
# ID of the different servers
|
||||
@ -361,9 +366,9 @@ my @ServerThreads;
|
||||
# Keep threads running.
|
||||
our $THRRUN :shared = 1;
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
## Reads a file and returns entire content or undef if error.
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub read_file {
|
||||
my $path = shift;
|
||||
|
||||
@ -383,9 +388,9 @@ sub read_file {
|
||||
}
|
||||
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Sets user:group owner for the given file
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub set_file_permissions($$;$) {
|
||||
my ($pa_config, $file, $grants) = @_;
|
||||
if ($^O !~ /win/i ) { # Only for Linux environments
|
||||
@ -410,10 +415,10 @@ sub set_file_permissions($$;$) {
|
||||
}
|
||||
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
## SUB pandora_trash_ascii
|
||||
# Generate random ascii strings with variable lenght
|
||||
########################################################################
|
||||
################################################################################
|
||||
|
||||
sub pandora_trash_ascii {
|
||||
my $config_depth = $_[0];
|
||||
@ -426,9 +431,9 @@ sub pandora_trash_ascii {
|
||||
return $output
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
## Convert the $value encode in html entity to clear char string.
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub safe_input($) {
|
||||
my $value = shift;
|
||||
|
||||
@ -439,9 +444,9 @@ sub safe_input($) {
|
||||
return $value;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
## Convert the html entities to value encode to rebuild char string.
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub safe_output($) {
|
||||
my $value = shift;
|
||||
|
||||
@ -452,10 +457,10 @@ sub safe_output($) {
|
||||
return $value;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# Sub daemonize ()
|
||||
# Put program in background (for daemon mode)
|
||||
########################################################################
|
||||
################################################################################
|
||||
|
||||
sub pandora_daemonize {
|
||||
my $pa_config = $_[0];
|
||||
@ -492,13 +497,13 @@ sub pandora_daemonize {
|
||||
# Pandora other General functions |
|
||||
# -------------------------------------------+
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# SUB credential_store_get_key
|
||||
# Retrieve all information related to target identifier.
|
||||
# param1 - config hash
|
||||
# param2 - dbh link
|
||||
# param3 - string identifier
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub credential_store_get_key($$$) {
|
||||
my ($pa_config, $dbh, $identifier) = @_;
|
||||
|
||||
@ -520,7 +525,7 @@ sub credential_store_get_key($$$) {
|
||||
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# SUB pandora_sendmail
|
||||
# Send a mail, connecting directly to MTA
|
||||
# param1 - config hash
|
||||
@ -528,7 +533,7 @@ sub credential_store_get_key($$$) {
|
||||
# param3 - Email subject
|
||||
# param4 - Email Message body
|
||||
# param4 - Email content type
|
||||
########################################################################
|
||||
################################################################################
|
||||
|
||||
sub pandora_sendmail {
|
||||
|
||||
@ -584,10 +589,10 @@ sub pandora_sendmail {
|
||||
};
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# SUB is_numeric
|
||||
# Return TRUE if given argument is numeric
|
||||
##########################################################################
|
||||
################################################################################
|
||||
|
||||
sub is_numeric {
|
||||
my $val = $_[0];
|
||||
@ -610,10 +615,73 @@ sub is_numeric {
|
||||
}
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# SUB is_enabled
|
||||
# Return TRUE if given argument is defined, number and greater than 1.
|
||||
################################################################################
|
||||
sub is_enabled {
|
||||
my $value = shift;
|
||||
|
||||
if ((defined ($value)) && is_numeric($value) && ($value > 0)){
|
||||
# return true
|
||||
return 1;
|
||||
}
|
||||
#return false
|
||||
return 0;
|
||||
|
||||
}
|
||||
|
||||
################################################################################
|
||||
# SUB is_empty
|
||||
# Return TRUE if given argument is an empty string/array/hash or undefined.
|
||||
################################################################################
|
||||
sub is_empty {
|
||||
my $str = shift;
|
||||
|
||||
if (! (defined ($str)) ){
|
||||
return 1;
|
||||
}
|
||||
|
||||
if(looks_like_number($str)){
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (ref ($str) eq "ARRAY") {
|
||||
return (($#{$str}<0)?1:0);
|
||||
}
|
||||
|
||||
if (ref ($str) eq "HASH") {
|
||||
my @tmp = keys %{$str};
|
||||
return (($#tmp<0)?1:0);
|
||||
}
|
||||
|
||||
if ($str =~ /^\ *[\n\r]{0,2}\ *$/) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
################################################################################
|
||||
# Check if a value is in an array
|
||||
################################################################################
|
||||
sub is_in_array {
|
||||
my ($array, $value) = @_;
|
||||
|
||||
if (is_empty($value)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
my %params = map { $_ => 1 } @{$array};
|
||||
if (exists($params{$value})) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
################################################################################
|
||||
# SUB md5check (param_1, param_2)
|
||||
# Verify MD5 file .checksum
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# param_1 : Name of data file
|
||||
# param_2 : Name of md5 file
|
||||
|
||||
@ -647,10 +715,10 @@ sub md5check {
|
||||
}
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# SUB logger (pa_config, message, level)
|
||||
# Log to file
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub logger ($$;$) {
|
||||
my ($pa_config, $message, $level) = @_;
|
||||
|
||||
@ -701,10 +769,10 @@ sub logger ($$;$) {
|
||||
}
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# SUB pandora_rotate_log (pa_config)
|
||||
# Log to file
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub pandora_rotate_logfile ($) {
|
||||
my ($pa_config) = @_;
|
||||
|
||||
@ -720,9 +788,9 @@ sub pandora_rotate_logfile ($) {
|
||||
}
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# limpia_cadena (string) - Purge a string for any forbidden characters (esc, etc)
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub limpia_cadena {
|
||||
my $micadena;
|
||||
$micadena = $_[0];
|
||||
@ -736,9 +804,9 @@ sub limpia_cadena {
|
||||
}
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# clean_blank (string) - Remove leading and trailing blanks
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub clean_blank {
|
||||
my $input = $_[0];
|
||||
$input =~ s/^\s+//g;
|
||||
@ -746,10 +814,10 @@ sub clean_blank {
|
||||
return $input;
|
||||
}
|
||||
|
||||
########################################################################################
|
||||
################################################################################
|
||||
# sub sqlWrap(texto)
|
||||
# Elimina comillas y caracteres problematicos y los sustituye por equivalentes
|
||||
########################################################################################
|
||||
################################################################################
|
||||
|
||||
sub sqlWrap {
|
||||
my $toBeWrapped = shift(@_);
|
||||
@ -760,21 +828,21 @@ sub sqlWrap {
|
||||
}
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# sub float_equal (num1, num2, decimals)
|
||||
# This function make possible to compare two float numbers, using only x decimals
|
||||
# in comparation.
|
||||
# Taken from Perl Cookbook, O'Reilly. Thanks, guys.
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub float_equal {
|
||||
my ($A, $B, $dp) = @_;
|
||||
return sprintf("%.${dp}g", $A) eq sprintf("%.${dp}g", $B);
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# Tries to load the PandoraEnterprise module. Must be called once before
|
||||
# enterprise_hook ().
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub enterprise_load ($) {
|
||||
my $pa_config = shift;
|
||||
|
||||
@ -809,9 +877,9 @@ sub enterprise_load ($) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# Tries to call a PandoraEnterprise function. Returns undef if unsuccessful.
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub enterprise_hook ($$) {
|
||||
my $func = shift;
|
||||
my @args = @{shift ()};
|
||||
@ -840,19 +908,19 @@ sub enterprise_hook ($$) {
|
||||
return $output;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# Prints a message to STDOUT at the given log level.
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub print_message ($$$) {
|
||||
my ($pa_config, $message, $log_level) = @_;
|
||||
|
||||
print STDOUT $message . "\n" if ($pa_config->{'verbosity'} >= $log_level);
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
# Returns the value of an XML tag from a hash returned by XMLin (one level
|
||||
# depth).
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub get_tag_value ($$$;$) {
|
||||
my ($hash_ref, $tag, $def_value, $all_array) = @_;
|
||||
$all_array = 0 unless defined ($all_array);
|
||||
@ -871,10 +939,10 @@ sub get_tag_value ($$$;$) {
|
||||
return $def_value;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
# Initialize some variables needed by the MD5 algorithm.
|
||||
# See http://en.wikipedia.org/wiki/MD5#Pseudocode.
|
||||
########################################################################
|
||||
################################################################################
|
||||
my (@R, @K);
|
||||
sub md5_init () {
|
||||
|
||||
@ -890,10 +958,10 @@ sub md5_init () {
|
||||
}
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Return the MD5 checksum of the given string.
|
||||
# Pseudocode from http://en.wikipedia.org/wiki/MD5#Pseudocode.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub md5 ($) {
|
||||
my $str = shift;
|
||||
|
||||
@ -981,18 +1049,18 @@ sub md5 ($) {
|
||||
return unpack ("H*", pack ("V", $h0)) . unpack ("H*", pack ("V", $h1)) . unpack ("H*", pack ("V", $h2)) . unpack ("H*", pack ("V", $h3));
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# MD5 leftrotate function. See http://en.wikipedia.org/wiki/MD5#Pseudocode.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub leftrotate ($$) {
|
||||
my ($x, $c) = @_;
|
||||
|
||||
return (0xFFFFFFFF & ($x << $c)) | ($x >> (32 - $c));
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
## Convert a date (yyy-mm-ddThh:ii:ss) to Timestamp.
|
||||
##########################################################################
|
||||
################################################################################
|
||||
sub dateTimeToTimestamp {
|
||||
$_[0] =~ /(\d{4})-(\d{2})-(\d{2})([ |T])(\d{2}):(\d{2}):(\d{2})/;
|
||||
my($year, $mon, $day, $GMT, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6, $7);
|
||||
@ -1002,10 +1070,10 @@ sub dateTimeToTimestamp {
|
||||
#print "BST\t" . mktime($sec, $min, $hour, $day, $mon - 1, $year - 1900, 0, 0) . "\n";
|
||||
}
|
||||
|
||||
##############################################################################
|
||||
################################################################################
|
||||
# Below some "internal" functions for automonitoring feature
|
||||
# TODO: Implement the same for other systems like Solaris or BSD
|
||||
##############################################################################
|
||||
################################################################################
|
||||
|
||||
sub disk_free ($) {
|
||||
my $target = $_[0];
|
||||
@ -1082,10 +1150,10 @@ sub free_mem {
|
||||
return $free_mem;
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
################################################################################
|
||||
## SUB ticks_totime
|
||||
# Transform a snmp timeticks count in a date
|
||||
##########################################################################
|
||||
################################################################################
|
||||
|
||||
sub ticks_totime ($){
|
||||
|
||||
@ -1109,7 +1177,7 @@ sub ticks_totime ($){
|
||||
return "$days days, $hours hours, $minutes minutes, $seconds seconds";
|
||||
}
|
||||
|
||||
##############################################################################
|
||||
################################################################################
|
||||
=head2 C<< pandora_ping (I<$pa_config>, I<$host>) >>
|
||||
|
||||
Ping the given host.
|
||||
@ -1118,7 +1186,7 @@ Returns:
|
||||
0 otherwise.
|
||||
|
||||
=cut
|
||||
##############################################################################
|
||||
################################################################################
|
||||
sub pandora_ping ($$$$) {
|
||||
my ($pa_config, $host, $timeout, $retries) = @_;
|
||||
|
||||
@ -1236,13 +1304,13 @@ sub pandora_ping ($$$$) {
|
||||
return $output;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
=head2 C<< pandora_ping_latency (I<$pa_config>, I<$host>) >>
|
||||
|
||||
Ping the given host. Returns the average round-trip time. Returns undef if fails.
|
||||
|
||||
=cut
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub pandora_ping_latency ($$$$) {
|
||||
my ($pa_config, $host, $timeout, $retries) = @_;
|
||||
|
||||
@ -1375,32 +1443,120 @@ sub pandora_ping_latency ($$$$) {
|
||||
return $output;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
=head2 C<< pandora_block_ping (I<$pa_config>, I<$hosts>) >>
|
||||
|
||||
Ping all given hosts. Returns an array with all hosts detected as alive.
|
||||
|
||||
=cut
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub pandora_block_ping($@) {
|
||||
my ($pa_config, @hosts) = @_;
|
||||
my ($cmd, $output);
|
||||
|
||||
# fping timeout in milliseconds
|
||||
my $cmd = $pa_config->{'fping'} . " -a -q -t " . (1000 * $pa_config->{'networktimeout'}) . " " . (join (' ', @hosts));
|
||||
return () if is_empty(@hosts);
|
||||
|
||||
my @output = `$cmd 2>$DEVNULL`;
|
||||
if (-x $pa_config->{'fping'}) {
|
||||
# fping timeout in milliseconds
|
||||
$cmd = $pa_config->{'fping'} . " -a -q -t " . (1000 * $pa_config->{'networktimeout'}) . " " . (join (' ', @hosts));
|
||||
@output = `$cmd 2>$DEVNULL`;
|
||||
} else {
|
||||
# Ping scan
|
||||
foreach my $host (@hosts) {
|
||||
if (ping($pa_config, $host) > 0) {
|
||||
push @output, $host;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return @output;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
################################################################################
|
||||
=head2 C<< ping (I<$pa_config>, I<$hosts>) >>
|
||||
|
||||
Ping the given host. Returns 1 if the host is alive, 0 otherwise.
|
||||
|
||||
=cut
|
||||
################################################################################
|
||||
sub ping ($$) {
|
||||
my ($pa_config, $host) = @_;
|
||||
my ($timeout, $retries, $packets) = (
|
||||
$pa_config->{'networktimeout'},
|
||||
$pa_config->{'icmp_checks'},
|
||||
1
|
||||
);
|
||||
|
||||
# Windows
|
||||
if (($^O eq "MSWin32") || ($^O eq "MSWin32-x64") || ($^O eq "cygwin")){
|
||||
$timeout *= 1000; # Convert the timeout to milliseconds.
|
||||
for (my $i = 0; $i < $retries; $i++) {
|
||||
my $output = `ping -n $packets -w $timeout $host`;
|
||||
return 1 if ($output =~ /TTL/);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Solaris
|
||||
if ($^O eq "solaris"){
|
||||
my $ping_command = $host =~ /\d+:|:\d+/ ? "ping -A inet6" : "ping";
|
||||
for (my $i = 0; $i < $retries; $i++) {
|
||||
|
||||
# Note: There is no timeout option.
|
||||
`$ping_command -s -n $host 56 $packets >$DEVNULL 2>&1`;
|
||||
return 1 if ($? == 0);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# FreeBSD
|
||||
if ($^O eq "freebsd"){
|
||||
my $ping_command = $host =~ /\d+:|:\d+/ ? "ping6" : "ping -t $timeout";
|
||||
for (my $i = 0; $i < $retries; $i++) {
|
||||
|
||||
# Note: There is no timeout option for ping6.
|
||||
`$ping_command -q -n -c $packets $host >$DEVNULL 2>&1`;
|
||||
return 1 if ($? == 0);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# NetBSD
|
||||
if ($^O eq "netbsd"){
|
||||
my $ping_command = $host =~ /\d+:|:\d+/ ? "ping6" : "ping -w $timeout";
|
||||
for (my $i = 0; $i < $retries; $i++) {
|
||||
|
||||
# Note: There is no timeout option for ping6.
|
||||
`$ping_command -q -n -c $packets $host >$DEVNULL 2>&1`;
|
||||
if ($? == 0) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Assume Linux by default.
|
||||
my $ping_command = $host =~ /\d+:|:\d+/ ? "ping6" : "ping";
|
||||
for (my $i = 0; $i < $retries; $i++) {
|
||||
`$ping_command -q -W $timeout -n -c $packets $host >$DEVNULL 2>&1`;
|
||||
return 1 if ($? == 0);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
################################################################################
|
||||
=head2 C<< month_have_days (I<$month>, I<$year>) >>
|
||||
|
||||
Pass a $month (as january 0 number and each month with numbers) and the year
|
||||
as number (for example 1981). And return the days of this month.
|
||||
|
||||
=cut
|
||||
########################################################################
|
||||
################################################################################
|
||||
sub month_have_days($$) {
|
||||
my $month= shift(@_);
|
||||
my $year= @_ ? shift(@_) : (1900 + (localtime())[5]);
|
||||
@ -1428,9 +1584,9 @@ sub month_have_days($$) {
|
||||
return $monthDays[$month];
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Convert a text obj tag to an OID and update the module configuration.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub translate_obj ($$$) {
|
||||
my ($pa_config, $dbh, $obj) = @_;
|
||||
|
||||
@ -1448,9 +1604,9 @@ sub translate_obj ($$$) {
|
||||
return $oid;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Get the number of seconds left to the next execution of the given cron entry.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_next_execution {
|
||||
my ($cron, $interval) = @_;
|
||||
|
||||
@ -1482,18 +1638,18 @@ sub cron_next_execution {
|
||||
|
||||
return $nex_time - $cur_time;
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Get the number of seconds left to the next execution of the given cron entry.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_check_syntax ($) {
|
||||
my ($cron) = @_;
|
||||
|
||||
return 0 if !defined ($cron);
|
||||
return ($cron =~ m/^(\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+$/);
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Check if a value is inside an interval.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_check_interval {
|
||||
my ($elem_cron, $elem_curr_time) = @_;
|
||||
|
||||
@ -1515,9 +1671,9 @@ sub cron_check_interval {
|
||||
|
||||
return 1;
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Get the next execution date for the given cron entry in seconds since epoch.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_next_execution_date {
|
||||
my ($cron, $cur_time, $interval) = @_;
|
||||
|
||||
@ -1646,11 +1802,11 @@ sub cron_next_execution_date {
|
||||
|
||||
return $nex_time;
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns if a date is in a cron. Recursive.
|
||||
# Needs the cron like an array reference and
|
||||
# current time in cron format to works properly
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_is_in_cron {
|
||||
my ($elems_cron, $elems_curr_time) = @_;
|
||||
|
||||
@ -1687,11 +1843,11 @@ sub cron_get_next_time_element {
|
||||
? $floor_data
|
||||
: $elem_down;
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns the interval of a cron element. If there is not a range,
|
||||
# returns an array with the first element in the first place of array
|
||||
# and the second place undefined.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_get_interval {
|
||||
my ($element) = @_;
|
||||
|
||||
@ -1702,10 +1858,10 @@ sub cron_get_interval {
|
||||
|
||||
return ($1, $2);
|
||||
}
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns the closest number to the target inside the given range (including
|
||||
# the target itself).
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_get_closest_in_range ($$) {
|
||||
my ($target, $range) = @_;
|
||||
|
||||
@ -1727,9 +1883,9 @@ sub cron_get_closest_in_range ($$) {
|
||||
return $target;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Check if a date is valid to get timelocal
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub cron_valid_date {
|
||||
my ($min, $hour, $mday, $month, $year) = @_;
|
||||
my $utime;
|
||||
@ -1743,9 +1899,9 @@ sub cron_valid_date {
|
||||
return $utime;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Attempt to resolve the given hostname.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub resolve_hostname ($) {
|
||||
my ($hostname) = @_;
|
||||
|
||||
@ -1755,9 +1911,9 @@ sub resolve_hostname ($) {
|
||||
return inet_ntoa($resolved_hostname);
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns 1 if the given regular expression is valid, 0 otherwise.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub valid_regex ($) {
|
||||
my $regex = shift;
|
||||
|
||||
@ -1773,9 +1929,9 @@ sub valid_regex ($) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns 1 if a valid metaconsole license is configured, 0 otherwise.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub is_metaconsole ($) {
|
||||
my ($pa_config) = @_;
|
||||
|
||||
@ -1788,9 +1944,9 @@ sub is_metaconsole ($) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns 1 if a valid offline license is configured, 0 otherwise.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub is_offline ($) {
|
||||
my ($pa_config) = @_;
|
||||
|
||||
@ -1802,9 +1958,9 @@ sub is_offline ($) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Check if a given variable contents a number
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub to_number($) {
|
||||
my $n = shift;
|
||||
if ($n =~ /[\d+,]*\d+\.\d+/) {
|
||||
@ -1956,10 +2112,10 @@ sub generate_agent_name_hash {
|
||||
return sha256(join('|', ($agent_alias, $server_ip, time(), sprintf("%04d", rand(10000)))));
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Return the SHA256 checksum of the given string as a hex string.
|
||||
# Pseudocode from: http://en.wikipedia.org/wiki/SHA-2#Pseudocode
|
||||
###############################################################################
|
||||
################################################################################
|
||||
my @K2 = (
|
||||
0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1,
|
||||
0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,
|
||||
@ -2079,34 +2235,34 @@ sub sha256 {
|
||||
unpack ("H*", pack ("N", $h7));
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Rotate a 32-bit number a number of bits to the right.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub rightrotate {
|
||||
my ($x, $c) = @_;
|
||||
|
||||
return (0xFFFFFFFF & ($x << (32 - $c))) | ($x >> $c);
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns IP address(v4) in longint format
|
||||
###############################################################################
|
||||
sub ip_to_long {
|
||||
################################################################################
|
||||
sub ip_to_long($) {
|
||||
my $ip_str = shift;
|
||||
return unpack "N", inet_aton($ip_str);
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns IP address(v4) in longint format
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub long_to_ip {
|
||||
my $ip_long = shift;
|
||||
return inet_ntoa pack("N", ($ip_long));
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
################################################################################
|
||||
# Returns a list with enabled servers.
|
||||
###############################################################################
|
||||
################################################################################
|
||||
sub get_enabled_servers {
|
||||
my $conf = shift;
|
||||
|
||||
@ -2178,12 +2334,24 @@ sub get_user_agent {
|
||||
return $ua;
|
||||
}
|
||||
|
||||
################################################################################
|
||||
# Returns 'valid' url relative to current pandora_console installation.
|
||||
################################################################################
|
||||
sub ui_get_full_url {
|
||||
my ($pa_config, $url) = @_;
|
||||
|
||||
if (is_empty($pa_config->{'console_api_url'})) {
|
||||
# Do not relativize if console_api_url is empty.
|
||||
return $url;
|
||||
}
|
||||
|
||||
my $console_url = $pa_config->{'console_api_url'};
|
||||
|
||||
$console_url =~ s/include\/api.php$//;
|
||||
|
||||
return $console_url.$url;
|
||||
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user