Tools.pm definition retrieved from 5575

This commit is contained in:
fbsanchez 2020-04-14 09:57:01 +02:00
parent 32538e659a
commit 0282dae05a

View File

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