1package PandoraFMS::Tools;
2########################################################################
3# Tools Package
4# Pandora FMS. the Flexible Monitoring System. http://www.pandorafms.org
5########################################################################
6# Copyright (c) 2005-2011 Artica Soluciones Tecnologicas S.L
7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU Lesser General Public License
10# as published by the Free Software Foundation; version 2
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15# You should have received a copy of the GNU General Public License
16# along with this program; if not, write to the Free Software
17# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
18##########################################################################
19
20use warnings;
21use Time::Local;
22use POSIX qw(setsid strftime);
23use POSIX;
24use PandoraFMS::Sendmail;
25use HTML::Entities;
26use Encode;
27use Socket qw(inet_ntoa inet_aton);
28use Sys::Syslog;
29
30# New in 3.2. Used to sendmail internally, without external scripts
31# use Module::Loaded;
32
33# Used to calculate the MD5 checksum of a string
34use constant MOD232 => 2**32;
35
36# UTF-8 flags deletion from multibyte characters when files are opened.
37use open OUT => ":utf8";
38use open ":std";
39
40require Exporter;
41
42our @ISA = ("Exporter");
43our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
44our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
45our @EXPORT = qw(
46	DATASERVER
47	NETWORKSERVER
48	SNMPCONSOLE
49	RECONSERVER
50	PLUGINSERVER
51	PREDICTIONSERVER
52	WMISERVER
53	EXPORTSERVER
54	INVENTORYSERVER
55	WEBSERVER
56	EVENTSERVER
57	ICMPSERVER
58	SNMPSERVER
59	SATELLITESERVER
60	METACONSOLE_LICENSE
61	$DEVNULL
62	RECOVERED_ALERT
63	FIRED_ALERT
64    cron_get_closest_in_range
65	cron_next_execution
66	cron_next_execution_date
67	cron_check_syntax
68	pandora_daemonize
69	logger
70	pandora_rotate_logfile
71	limpia_cadena
72	md5check
73	float_equal
74	sqlWrap
75	is_numeric
76	is_metaconsole
77	clean_blank
78	pandora_sendmail
79	pandora_trash_ascii
80	enterprise_hook
81	enterprise_load
82	print_message
83	get_tag_value
84	disk_free
85	load_average
86	free_mem
87	md5
88	md5_init
89	pandora_ping
90	pandora_ping_latency
91	resolve_hostname
92	ticks_totime
93	safe_input
94	safe_output
95	month_have_days
96	translate_obj
97	valid_regex
98);
99
100# ID of the different servers
101use constant DATASERVER => 0;
102use constant NETWORKSERVER => 1;
103use constant SNMPCONSOLE => 2;
104use constant RECONSERVER => 3;
105use constant PLUGINSERVER => 4;
106use constant PREDICTIONSERVER => 5;
107use constant WMISERVER => 6;
108use constant EXPORTSERVER => 7;
109use constant INVENTORYSERVER => 8;
110use constant WEBSERVER => 9;
111use constant EVENTSERVER => 10;
112use constant ICMPSERVER => 11;
113use constant SNMPSERVER => 12;
114use constant SATELLITESERVER => 13;
115
116# Value for a metaconsole license type
117use constant METACONSOLE_LICENSE => 0x01;
118
119# Alert modes
120use constant RECOVERED_ALERT => 0;
121use constant FIRED_ALERT => 1;
122
123# /dev/null
124our $DEVNULL = ($^O eq 'MSWin32') ? '/Nul' : '/dev/null';
125
126########################################################################
127## SUB pandora_trash_ascii
128# Generate random ascii strings with variable lenght
129########################################################################
130
131sub pandora_trash_ascii {
132	my $config_depth = $_[0];
133	my $a;
134	my $output;
135
136	for ($a=0;$a<$config_depth;$a++){
137		$output = $output.chr(int(rand(25)+97));
138	}
139	return $output
140}
141
142########################################################################
143## Convert the $value encode in html entity to clear char string.
144########################################################################
145sub safe_input($) {
146	my $value = shift;
147
148	$value = encode_entities ($value, "<>&");
149
150	#//Replace the character '\' for the equivalent html entitie
151	$value =~ s/\\/&#92;/gi;
152
153	#// First attempt to avoid SQL Injection based on SQL comments
154	#// Specific for MySQL.
155	$value =~ s/\/\*/&#47;&#42;/gi;
156	$value =~ s/\*\//&#42;&#47;/gi;
157
158	#//Replace ' for the html entitie
159	$value =~ s/\"/&quot;/gi;
160
161	#//Replace ' for the html entitie
162	$value =~ s/\'/&#039;/gi;
163
164	#//Replace ( for the html entitie
165	$value =~ s/\(/&#40;/gi;
166
167	#//Replace ( for the html entitie
168	$value =~ s/\)/&#41;/gi;
169
170	#//Replace some characteres for html entities
171	for (my $i=0;$i<33;$i++) {
172		my $pattern = chr($i);
173		my $hex = ascii_to_html($i);
174		$value =~ s/$pattern/$hex/gi;
175	}
176
177	for (my $i=128;$i<191;$i++) {
178		my $pattern = chr($i);
179		my $hex = ascii_to_html($i);
180		$value =~ s/$pattern/$hex/gi;
181	}
182
183	#//Replace characteres for tildes and others
184	my $trans = get_html_entities();
185
186	foreach(keys(%$trans))
187	{
188		my $pattern = chr($_);
189		$value =~ s/$pattern/$trans->{$_}/g;
190	}
191
192	return $value;
193}
194
195########################################################################
196## Convert the html entities to value encode to rebuild char string.
197########################################################################
198sub safe_output($) {
199	my $value = shift;
200
201	$value = decode_entities ($value);
202
203	#//Replace the character '\' for the equivalent html entitie
204	$value =~ s/&#92;/\\/gi;
205
206	#// First attempt to avoid SQL Injection based on SQL comments
207	#// Specific for MySQL.
208	$value =~ s/&#47;&#42;/\/\*/gi;
209	$value =~ s/&#42;&#47;/\*\//gi;
210
211	#//Replace ( for the html entitie
212	$value =~ s/&#40;/\(/gi;
213
214	#//Replace ( for the html entitie
215	$value =~ s/&#41;/\)/gi;
216
217	#//Replace ' for the html entitie
218	$value =~ s/&#039;/')/gi;
219
220	#//Replace " for the html entitie
221	$value =~ s/&quot;/")/gi;
222
223	#//Replace some characteres for html entities
224	for (my $i=0;$i<33;$i++) {
225		my $pattern = chr($i);
226		my $hex = ascii_to_html($i);
227		$value =~ s/$hex/$pattern/gi;
228	}
229
230	for (my $i=128;$i<191;$i++) {
231		my $pattern = chr($i);
232		my $hex = ascii_to_html($i);
233		$value =~ s/$hex/$pattern/gi;
234	}
235
236	#//Replace characteres for tildes and others
237	my $trans = get_html_entities();
238
239	foreach(keys(%$trans))
240	{
241		my $pattern = chr($_);
242		$value =~ s/$trans->{$_}/$pattern/g;
243	}
244
245	return $value;
246}
247
248##########################################################################
249# SUB get_html_entities
250# Returns a hash table with the acute and special html entities
251# Usefull for future chars addition:
252# http://cpansearch.perl.org/src/GAAS/HTML-Parser-3.68/lib/HTML/Entities.pm
253##########################################################################
254
255sub get_html_entities {
256	my %trans = (
257		225 => '&aacute;',
258		233 => '&eacute;',
259		237 => '&iacute;',
260		243 => '&oacute;',
261		250 => '&uacute;',
262		193 => '&Aacute;',
263		201 => '&Eacute;',
264		205 => '&Iacute;',
265		211 => '&Oacute;',
266		218 => '&Uacute;',
267		228 => '&auml;',
268		235 => '&euml;',
269		239 => '&iuml;',
270		246 => '&ouml;',
271		252 => '&uuml;',
272		196 => '&Auml;',
273		203 => '&Euml;',
274		207 => '&Iuml;',
275		214 => '&Ouml;',
276		220 => '&Uuml;',
277		241 => '&ntilde;',
278		209 => '&Ntilde;'
279	);
280
281	return \%trans;
282}
283########################################################################
284# SUB ascii_to_html (string)
285# Convert an ascii string to hexadecimal
286########################################################################
287
288sub ascii_to_html($) {
289	my $ascii = shift;
290
291	return "&#x".substr(unpack("H*", pack("N", $ascii)),6,3).";";
292}
293
294########################################################################
295# Sub daemonize ()
296# Put program in background (for daemon mode)
297########################################################################
298
299sub pandora_daemonize {
300	my $pa_config = $_[0];
301	open STDIN, "$DEVNULL"		or die "Can't read $DEVNULL: $!";
302	open STDOUT, ">>$DEVNULL"	or die "Can't write to $DEVNULL: $!";
303	open STDERR, ">>$DEVNULL"	or die "Can't write to $DEVNULL: $!";
304	chdir '/tmp'					or die "Can't chdir to /tmp: $!";
305	defined(my $pid = fork)		or die "Can't fork: $!";
306	exit if $pid;
307	setsid							or die "Can't start a new session: $!";
308
309	# Store PID of this process in file presented by config token
310	if ($pa_config->{'PID'} ne "") {
311		if ( -e $pa_config->{'PID'} && open (FILE, $pa_config->{'PID'})) {
312			$pid = <FILE> + 0;
313			close FILE;
314
315			# check if pandora_server is running
316			if (kill (0, $pid)) {
317				die "[FATAL] pandora_server already running, pid: $pid.";
318			}
319			logger ($pa_config, '[W] Stale PID file, overwriting.', 1);
320		}
321		umask 022;
322		open (FILE, "> ".$pa_config->{'PID'}) or die "[FATAL] Cannot open PIDfile at ".$pa_config->{'PID'};
323		print FILE "$$";
324		close (FILE);
325	}
326	umask 0;
327}
328
329
330# -------------------------------------------+
331# Pandora other General functions |
332# -------------------------------------------+
333
334
335########################################################################
336# SUB pandora_sendmail
337# Send a mail, connecting directly to MTA
338# param1 - config hash
339# param2 - Destination email addres
340# param3 - Email subject
341# param4 - Email Message body
342# param4 - Email content type
343########################################################################
344
345sub pandora_sendmail {
346
347	my $pa_config = $_[0];
348	my $to_address = $_[1];
349	my $subject = $_[2];
350	my $message = $_[3];
351	my $content_type = $_[4];
352
353	$subject = decode_entities ($subject);
354
355	# If content type is defined, the message will be custom
356	if (! defined($content_type)) {
357		$message = decode_entities ($message);
358	}
359
360	my %mail = ( To	=> $to_address,
361		Message		=> $message,
362		Subject		=> encode('MIME-Header', $subject),
363		'X-Mailer'	=> "Pandora FMS",
364		Smtp		=> $pa_config->{"mta_address"},
365		Port		=> $pa_config->{"mta_port"},
366		From		=> $pa_config->{"mta_from"},
367	);
368
369	if (defined($content_type)) {
370		$mail{'Content-Type'} = $content_type;
371	}
372
373	# Check if message has non-ascii chars.
374	# non-ascii chars should be encoded in UTF-8.
375	if ($message =~ /[^[:ascii:]]/o && !defined($content_type)) {
376		$mail{Message} = encode("UTF-8", $mail{Message});
377		$mail{'Content-Type'} = 'text/plain; charset="UTF-8"';
378	}
379
380	if ($pa_config->{"mta_user"} ne ""){
381		$mail{auth} = {user=>$pa_config->{"mta_user"}, password=>$pa_config->{"mta_pass"}, method=>$pa_config->{"mta_auth"}, required=>1 };
382	}
383
384	if (sendmail %mail) {
385		return;
386	}
387	else {
388		logger ($pa_config, "[ERROR] Sending email to $to_address with subject $subject", 1);
389		if (defined($Mail::Sendmail::error)){
390			logger ($pa_config, "ERROR Code: $Mail::Sendmail::error", 5);
391		}
392	}
393}
394
395##########################################################################
396# SUB is_numeric
397# Return TRUE if given argument is numeric
398##########################################################################
399
400sub is_numeric {
401	my $val = $_[0];
402
403	if (!defined($val)){
404		return 0;
405	}
406	# Replace "," for "."
407	$val =~ s/\,/\./;
408
409	my $DIGITS = qr{ \d+ (?: [.] \d*)? | [.] \d+ }xms;
410	my $SIGN   = qr{ [+-] }xms;
411	my $NUMBER = qr{ ($SIGN?) ($DIGITS) }xms;
412	if ( $val !~ /^${NUMBER}$/ ) {
413		return 0;   #Non-numeric
414	}
415	else {
416		return 1;   #Numeric
417	}
418}
419
420##########################################################################
421# SUB md5check (param_1, param_2)
422# Verify MD5 file .checksum
423##########################################################################
424# param_1 : Name of data file
425# param_2 : Name of md5 file
426
427sub md5check {
428	my $buf;
429	my $buf2;
430	my $file = $_[0];
431	my $md5file = $_[1];
432	open(FILE, $file) or return 0;
433	binmode(FILE);
434	my $md5 = Digest::MD5->new;
435	while (<FILE>) {
436		$md5->add($_);
437	}
438	close(FILE);
439	$buf2 = $md5->hexdigest;
440	open(FILE,$md5file) or return 0;
441	while (<FILE>) {
442		$buf = $_;
443	}
444	close (FILE);
445	$buf=uc($buf);
446	$buf2=uc($buf2);
447	if ($buf =~ /$buf2/ ) {
448		#print "MD5 Correct";
449		return 1;
450	}
451	else {
452		#print "MD5 Incorrect";
453		return 0;
454	}
455}
456
457########################################################################
458# SUB logger (pa_config, message, level)
459# Log to file
460########################################################################
461sub logger ($$;$) {
462	my ($pa_config, $message, $level) = @_;
463
464	# Clean any string and ready to be printed in screen/file
465	$message = safe_output ($message);
466
467	$level = 1 unless defined ($level);
468	return if ($level > $pa_config->{'verbosity'});
469
470	if (!defined($pa_config->{'logfile'})) {
471		print strftime ("%Y-%m-%d %H:%M:%S", localtime()) . " [V". $level ."] " . $message . "\n";
472		return;
473	}
474
475	# Get the log file (can be a regular file or 'syslog')
476	my $file = $pa_config->{'logfile'};
477
478	# Syslog
479	if ($file eq 'syslog') {
480
481		# Set the security level
482		my $security_level = 'info';
483		if ($level < 2) {
484			$security = 'crit';
485		} elsif ($level < 5) {
486			$security = 'warn';
487		}
488
489		openlog('pandora_server', 'ndelay', 'daemon');
490		syslog($security_level, $message);
491		closelog();
492	} else {
493		open (FILE, ">> $file") or die "[FATAL] Could not open logfile '$file'";
494		# Get an exclusive lock on the file (LOCK_EX)
495		flock (FILE, 2);
496		print FILE strftime ("%Y-%m-%d %H:%M:%S", localtime()) . " " . $pa_config->{'servername'} . $pa_config->{'servermode'} . " [V". $level ."] " . $message . "\n";
497		close (FILE);
498	}
499}
500
501########################################################################
502# SUB pandora_rotate_log (pa_config)
503# Log to file
504########################################################################
505sub pandora_rotate_logfile ($) {
506	my ($pa_config) = @_;
507
508	my $file = $pa_config->{'logfile'};
509
510	# Log File Rotation
511	if ($file ne 'syslog' && -e $file && (stat($file))[7] > $pa_config->{'max_log_size'}) {
512		foreach my $i (reverse 1..$pa_config->{'max_log_generation'}) {
513			rename ($file . "." . ($i - 1), $file . "." . $i);
514		}
515		rename ($file, "$file.0");
516
517	}
518}
519
520########################################################################
521# limpia_cadena (string) - Purge a string for any forbidden characters (esc, etc)
522########################################################################
523sub limpia_cadena {
524	my $micadena;
525	$micadena = $_[0];
526	if (defined($micadena)){
527		$micadena =~ s/[^\-\:\;\.\,\_\s\a\*\=\(\)a-zA-Z0-9]//g;
528		$micadena =~ s/[\n\l\f]//g;
529		return $micadena;
530	}
531	else {
532		return "";
533	}
534}
535
536########################################################################
537# clean_blank (string) - Remove leading and trailing blanks
538########################################################################
539sub clean_blank {
540	my $input = $_[0];
541	$input =~ s/^\s+//g;
542	$input =~ s/\s+$//g;
543	return $input;
544}
545
546########################################################################################
547# sub sqlWrap(texto)
548# Elimina comillas y caracteres problematicos y los sustituye por equivalentes
549########################################################################################
550
551sub sqlWrap {
552	my $toBeWrapped = shift(@_);
553	if (defined $toBeWrapped){
554		$toBeWrapped =~ s/\'/\\\'/g;
555		$toBeWrapped =~ s/\"/\\\'/g; # " This is for highlighters that don't understand escaped quotes
556		return "'".$toBeWrapped."'";
557	}
558}
559
560##########################################################################
561# sub float_equal (num1, num2, decimals)
562# This function make possible to compare two float numbers, using only x decimals
563# in comparation.
564# Taken from Perl Cookbook, O'Reilly. Thanks, guys.
565##########################################################################
566sub float_equal {
567	my ($A, $B, $dp) = @_;
568	return sprintf("%.${dp}g", $A) eq sprintf("%.${dp}g", $B);
569}
570
571##########################################################################
572# Tries to load the PandoraEnterprise module. Must be called once before
573# enterprise_hook ().
574##########################################################################
575sub enterprise_load ($) {
576	my $pa_config = shift;
577
578	# Check dependencies
579
580	# Already loaded
581	#return 1 if (is_loaded ('PandoraFMS::Enterprise'));
582
583	# Try to load the module
584	if ($^O eq 'MSWin32') {
585		# If the Windows service dies the service is stopped, even inside an eval ($RUN is set to 0)!
586		eval 'local $SIG{__DIE__}; require PandoraFMS::Enterprise;';
587	}
588	else {
589		eval 'require PandoraFMS::Enterprise;';
590	}
591
592
593
594	# Ops
595	if ($@) {
596		# Enterprise.pm not found.
597		return 0 if ($@ =~ m/PandoraFMS\/Enterprise\.pm.*\@INC/);
598
599		open (STDERR, ">> " . $pa_config->{'errorlogfile'});
600		print STDERR $@;
601		close (STDERR);
602		return 0;
603	}
604
605	# Initialize the enterprise module.
606	PandoraFMS::Enterprise::init($pa_config);
607
608	return 1;
609}
610
611##########################################################################
612# Tries to call a PandoraEnterprise function. Returns undef if unsuccessful.
613##########################################################################
614sub enterprise_hook ($$) {
615	my $func = shift;
616	my @args = @{shift ()};
617
618	# Temporarily disable strict refs
619	no strict 'refs';
620
621	# Prepend the package name
622	$func = 'PandoraFMS::Enterprise::' . $func;
623
624	# undef is returned only if the enterprise function was not found
625	return undef unless (defined (&$func));
626
627	# Try to call the function
628	my $output = eval { &$func (@args); };
629
630	# Check for errors
631	#return undef if ($@);
632	return '' unless defined ($output);
633
634	return $output;
635}
636
637########################################################################
638# Prints a message to STDOUT at the given log level.
639########################################################################
640sub print_message ($$$) {
641	my ($pa_config, $message, $log_level) = @_;
642
643	print STDOUT $message . "\n" if ($pa_config->{'verbosity'} >= $log_level);
644}
645
646##########################################################################
647# Returns the value of an XML tag from a hash returned by XMLin (one level
648# depth).
649##########################################################################
650sub get_tag_value ($$$;$) {
651	my ($hash_ref, $tag, $def_value, $all_array) = @_;
652	$all_array = 0 unless defined ($all_array);
653
654	return $def_value unless defined ($hash_ref->{$tag}) and ref ($hash_ref->{$tag});
655
656	# If all array is required, returns the array
657	return $hash_ref->{$tag} if ($all_array == 1);
658	# Return the first found value
659	foreach my $value (@{$hash_ref->{$tag}}) {
660
661		# If the tag is defined but has no value a ref to an empty hash is returned by XML::Simple
662		return $value unless ref ($value);
663	}
664
665	return $def_value;
666}
667
668########################################################################
669# Initialize some variables needed by the MD5 algorithm.
670# See http://en.wikipedia.org/wiki/MD5#Pseudocode.
671########################################################################
672my (@R, @K);
673sub md5_init () {
674
675	# R specifies the per-round shift amounts
676	@R = (7, 12, 17, 22,  7, 12, 17, 22,  7, 12, 17, 22,  7, 12, 17, 22,
677		  5,  9, 14, 20,  5,  9, 14, 20,  5,  9, 14, 20,  5,  9, 14, 20,
678		  4, 11, 16, 23,  4, 11, 16, 23,  4, 11, 16, 23,  4, 11, 16, 23,
679		  6, 10, 15, 21,  6, 10, 15, 21,  6, 10, 15, 21,  6, 10, 15, 21);
680
681	# Use binary integer part of the sines of integers (radians) as constants
682	for (my $i = 0; $i < 64; $i++) {
683		$K[$i] = floor(abs(sin($i + 1)) * MOD232);
684	}
685}
686
687###############################################################################
688# Return the MD5 checksum of the given string.
689# Pseudocode from http://en.wikipedia.org/wiki/MD5#Pseudocode.
690###############################################################################
691sub md5 ($) {
692	my $str = shift;
693
694	if (!defined($str)){
695		return "";
696	}
697
698	# Initialize once.
699	md5_init() if (!defined($R[0]));
700
701	# Note: All variables are unsigned 32 bits and wrap modulo 2^32 when calculating
702
703	# Initialize variables
704	my $h0 = 0x67452301;
705	my $h1 = 0xEFCDAB89;
706	my $h2 = 0x98BADCFE;
707	my $h3 = 0x10325476;
708
709	# Pre-processing
710	my $msg = unpack ("B*", pack ("A*", $str));
711	my $bit_len = length ($msg);
712
713	# Append "1" bit to message
714	$msg .= '1';
715
716	# Append "0" bits until message length in bits ≡ 448 (mod 512)
717	$msg .= '0' while ((length ($msg) % 512) != 448);
718
719	# Append bit /* bit, not byte */ length of unpadded message as 64-bit little-endian integer to message
720	$msg .= unpack ("B64", pack ("VV", $bit_len));
721
722	# Process the message in successive 512-bit chunks
723	for (my $i = 0; $i < length ($msg); $i += 512) {
724
725		my @w;
726		my $chunk = substr ($msg, $i, 512);
727
728		# Break chunk into sixteen 32-bit little-endian words w[i], 0 <= i <= 15
729		for (my $j = 0; $j < length ($chunk); $j += 32) {
730			push (@w, unpack ("V", pack ("B32", substr ($chunk, $j, 32))));
731		}
732
733		# Initialize hash value for this chunk
734		my $a = $h0;
735		my $b = $h1;
736		my $c = $h2;
737		my $d = $h3;
738		my $f;
739		my $g;
740
741		# Main loop
742		for (my $y = 0; $y < 64; $y++) {
743			if ($y <= 15) {
744				$f = $d ^ ($b & ($c ^ $d));
745				$g = $y;
746			}
747			elsif ($y <= 31) {
748				$f = $c ^ ($d & ($b ^ $c));
749				$g = (5 * $y + 1) % 16;
750			}
751			elsif ($y <= 47) {
752				$f = $b ^ $c ^ $d;
753				$g = (3 * $y + 5) % 16;
754			}
755			else {
756				$f = $c ^ ($b | (0xFFFFFFFF & (~ $d)));
757				$g = (7 * $y) % 16;
758			}
759
760			my $temp = $d;
761			$d = $c;
762			$c = $b;
763			$b = ($b + leftrotate (($a + $f + $K[$y] + $w[$g]) % MOD232, $R[$y])) % MOD232;
764			$a = $temp;
765		}
766
767		# Add this chunk's hash to result so far
768		$h0 = ($h0 + $a) % MOD232;
769		$h1 = ($h1 + $b) % MOD232;
770		$h2 = ($h2 + $c) % MOD232;
771		$h3 = ($h3 + $d) % MOD232;
772	}
773
774	# Digest := h0 append h1 append h2 append h3 #(expressed as little-endian)
775	return unpack ("H*", pack ("V", $h0)) . unpack ("H*", pack ("V", $h1)) . unpack ("H*", pack ("V", $h2)) . unpack ("H*", pack ("V", $h3));
776}
777
778###############################################################################
779# MD5 leftrotate function. See http://en.wikipedia.org/wiki/MD5#Pseudocode.
780###############################################################################
781sub leftrotate ($$) {
782	my ($x, $c) = @_;
783
784	return (0xFFFFFFFF & ($x << $c)) | ($x >> (32 - $c));
785}
786
787##########################################################################
788## Convert a date (yyy-mm-ddThh:ii:ss) to Timestamp.
789##########################################################################
790sub dateTimeToTimestamp {
791	$_[0] =~ /(\d{4})-(\d{2})-(\d{2})([ |T])(\d{2}):(\d{2}):(\d{2})/;
792	my($year, $mon, $day, $GMT, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6, $7);
793	#UTC
794	return timegm($sec, $min, $hour, $day, $mon - 1, $year - 1900);
795	#BST
796	#print "BST\t" . mktime($sec, $min, $hour, $day, $mon - 1, $year - 1900, 0, 0) . "\n";
797}
798
799##############################################################################
800# Below some "internal" functions for automonitoring feature
801# TODO: Implement the same for other systems like Solaris or BSD
802##############################################################################
803
804sub disk_free ($) {
805	my $target = $_[0];
806
807	# Try to use df command with Posix parameters...
808	my $command = "df -k -P ".$target." | tail -1 | awk '{ print \$4/1024}'";
809	my $output = `$command`;
810	return $output;
811}
812
813sub load_average {
814	my $load_average;
815
816	my $OSNAME = $^O;
817
818	if ($OSNAME =~ /^(freebsd|dragonfly)$/){
819		$load_average = ((split(/\s+/, `/sbin/sysctl -n vm.loadavg`))[1]);
820	}
821	# by default LINUX calls
822	else {
823		$load_average = `cat /proc/loadavg | awk '{ print \$1 }'`;
824	}
825	return $load_average;
826}
827
828sub free_mem {
829	my $free_mem;
830
831	my $OSNAME = $^O;
832
833	if ($OSNAME =~ /^(freebsd|dragonfly)$/){
834		my ($pages_free, $page_size) = `/sbin/sysctl -n vm.stats.vm.v_page_size vm.stats.vm.v_free_count`;
835		# in kilobytes
836		$free_mem = $pages_free * $page_size / 1024;
837
838	}
839	elsif ($OSNAME eq "netbsd"){
840		$free_mem = `cat /proc/meminfo | grep MemFree | awk '{ print \$2 }'`;
841	}
842	# by default LINUX calls
843	else {
844		$free_mem = `free | grep Mem | awk '{ print \$4 }'`;
845	}
846	return $free_mem;
847}
848
849##########################################################################
850## SUB ticks_totime
851	# Transform a snmp timeticks count in a date
852##########################################################################
853
854sub ticks_totime ($){
855
856	# Calculate ticks per second, minute, hour, and day
857	my $TICKS_PER_SECOND = 100;
858	my $TICKS_PER_MINUTE = $TICKS_PER_SECOND * 60;
859	my $TICKS_PER_HOUR   = $TICKS_PER_MINUTE * 60;
860	my $TICKS_PER_DAY    = $TICKS_PER_HOUR * 24;
861
862	my $ticks   = shift;
863
864	if (!defined($ticks)){
865			return "";
866	}
867
868	my $seconds = int($ticks / $TICKS_PER_SECOND) % 60;
869	my $minutes = int($ticks / $TICKS_PER_MINUTE) % 60;
870	my $hours   = int($ticks / $TICKS_PER_HOUR)   % 24;
871	my $days    = int($ticks / $TICKS_PER_DAY);
872
873	return "$days days, $hours hours, $minutes minutes, $seconds seconds";
874}
875
876##############################################################################
877=head2 C<< pandora_ping (I<$pa_config>, I<$host>) >>
878
879Ping the given host.
880Returns:
881 1 if the host is alive
882 0 otherwise.
883
884=cut
885##############################################################################
886sub pandora_ping ($$$$) {
887	my ($pa_config, $host, $timeout, $retries) = @_;
888
889	# Adjust timeout and retry values
890	if ($timeout == 0) {
891		$timeout = $pa_config->{'networktimeout'};
892	}
893	if ($retries == 0) {
894		$retries = $pa_config->{'icmp_checks'};
895	}
896	my $packets = defined($pa_config->{'icmp_packets'}) ? $pa_config->{'icmp_packets'} : 1;
897
898	my $output = 0;
899	my $i;
900
901	# See codes on http://perldoc.perl.org/perlport.html#PLATFORMS
902	my $OSNAME = $^O;
903
904	# Windows XP .. Windows 7
905	if (($OSNAME eq "MSWin32") || ($OSNAME eq "MSWin32-x64") || ($OSNAME eq "cygwin")){
906		my $ms_timeout = $timeout * 1000;
907		for ($i=0; $i < $retries; $i++) {
908			$output = `ping -n $packets -w $ms_timeout $host`;
909			if ($output =~ /TTL/){
910				return 1;
911			}
912			sleep 1;
913		}
914		return 0;
915	}
916
917	elsif ($OSNAME eq "solaris"){
918		my $ping_command = "ping";
919
920		if ($host =~ /\d+:|:\d+/ ) {
921			$ping_command = "ping -A inet6"
922		}
923
924		# Note: timeout option is not implemented in ping.
925		# 'networktimeout' is not used by ping on Solaris.
926
927		# Ping the host
928		for ($i=0; $i < $retries; $i++) {
929			`$ping_command -s -n $host 56 $packets >$DEVNULL 2>&1`;
930			if ($? == 0) {
931				return 1;
932			}
933			sleep 1;
934		}
935		return 0;
936	}
937
938	elsif ($OSNAME =~ /^(freebsd|dragonfly)$/){
939		my $ping_command = "ping -t $timeout";
940
941		if ($host =~ /\d+:|:\d+/ ) {
942			$ping_command = "ping6";
943		}
944
945		# Note: timeout(-t) option is not implemented in ping6.
946		# 'networktimeout' is not used by ping6 on FreeBSD.
947
948		# Ping the host
949		for ($i=0; $i < $retries; $i++) {
950			`$ping_command -q -n -c $packets $host >$DEVNULL 2>&1`;
951			if ($? == 0) {
952				return 1;
953			}
954			sleep 1;
955		}
956		return 0;
957	}
958
959        elsif ($OSNAME eq "netbsd"){
960		my $ping_command = "ping -w $timeout";
961
962		if ($host =~ /\d+:|:\d+/ ) {
963			$ping_command = "ping6";
964		}
965
966		# Note: timeout(-w) option is not implemented in ping6.
967		# 'networktimeout' is not used by ping6 on NetBSD.
968
969		# Ping the host
970		for ($i=0; $i < $retries; $i++) {
971			`$ping_command -q -n -c $packets $host >$DEVNULL 2>&1`;
972			if ($? == 0) {
973				return 1;
974			}
975			sleep 1;
976		}
977		return 0;
978	}
979
980	# by default LINUX calls
981	else {
982
983		my $ping_command = "ping";
984
985		if ($host =~ /\d+:|:\d+/ ) {
986			$ping_command = "ping6";
987		}
988
989		# Ping the host
990		for ($i=0; $i < $retries; $i++) {
991			`$ping_command -q -W $timeout -n -c $packets $host >$DEVNULL 2>&1`;
992			if ($? == 0) {
993				return 1;
994			}
995			sleep 1;
996		}
997		return 0;
998	}
999
1000	return $output;
1001}
1002
1003########################################################################
1004=head2 C<< pandora_ping_latency (I<$pa_config>, I<$host>) >>
1005
1006Ping the given host. Returns the average round-trip time. Returns undef if fails.
1007
1008=cut
1009########################################################################
1010sub pandora_ping_latency ($$$$) {
1011	my ($pa_config, $host, $timeout, $retries) = @_;
1012
1013	# Adjust timeout and retry values
1014	if ($timeout == 0) {
1015		$timeout = $pa_config->{'networktimeout'};
1016	}
1017	if ($retries == 0) {
1018		$retries = $pa_config->{'icmp_checks'};
1019	}
1020
1021	my $output = 0;
1022
1023	# See codes on http://perldoc.perl.org/perlport.html#PLATFORMS
1024	my $OSNAME = $^O;
1025
1026	# Windows XP .. Windows 2008, I assume Win7 is the same
1027	if (($OSNAME eq "MSWin32") || ($OSNAME eq "MSWin32-x64") || ($OSNAME eq "cygwin")){
1028
1029		# System ping reports in different languages, but with the same format:
1030		# Mínimo = xxms, Máximo = xxms, Media = XXms
1031		# Minimun = xxms, Mamimun = xxms, Average = XXms
1032
1033		# If this fails, ping can be replaced by fping which also have the same format
1034		# but always in english
1035
1036		my $ms_timeout = $timeout * 1000;
1037		$output = `ping -n $retries -w $ms_timeout $host`;
1038
1039		if ($output =~ m/\=\s([0-9]+)ms$/){
1040			return $1;
1041		} else {
1042			return undef;
1043		}
1044
1045	}
1046
1047	elsif ($OSNAME eq "solaris"){
1048		my $ping_command = "ping";
1049
1050		if ($host =~ /\d+:|:\d+/ ) {
1051			$ping_command = "ping -A inet6";
1052		}
1053
1054		# Note: timeout option is not implemented in ping.
1055		# 'networktimeout' is not used by ping on Solaris.
1056
1057		# Ping the host
1058		my @output = `$ping_command -s -n $host 56 $retries 2>$DEVNULL`;
1059
1060		# Something went wrong
1061		return undef if ($? != 0);
1062
1063		# Parse the output
1064		my $stats = pop (@output);
1065		return undef unless ($stats =~ m/([\d\.]+)\/([\d\.]+)\/([\d\.]+)\/([\d\.]+) +ms/);
1066		return $2;
1067	}
1068
1069	elsif ($OSNAME =~ /^(freebsd|dragonfly)$/){
1070		my $ping_command = "ping -t $timeout";
1071
1072		if ($host =~ /\d+:|:\d+/ ) {
1073			$ping_command = "ping6";
1074		}
1075
1076		# Note: timeout(-t) option is not implemented in ping6.
1077		# timeout(-t) and waittime(-W) options in ping are not the same as
1078		# Linux. On latency, there are no way to set timeout.
1079		# 'networktimeout' is not used on FreeBSD.
1080
1081		# Ping the host
1082		my @output = `$ping_command -q -n -c $retries $host 2>$DEVNULL`;
1083
1084		# Something went wrong
1085		return undef if ($? != 0);
1086
1087		# Parse the output
1088		my $stats = pop (@output);
1089		return undef unless ($stats =~ m/([\d\.]+)\/([\d\.]+)\/([\d\.]+)\/([\d\.]+) +ms/);
1090		return $2;
1091	}
1092
1093        elsif ($OSNAME eq "netbsd"){
1094		my $ping_command = "ping -w $timeout";
1095
1096		if ($host =~ /\d+:|:\d+/ ) {
1097			$ping_command = "ping6";
1098		}
1099
1100		# Note: timeout(-w) option is not implemented in ping6.
1101		# timeout(-w) and waittime(-W) options in ping are not the same as
1102		# Linux. On latency, there are no way to set timeout.
1103		# 'networktimeout' is not used on NetBSD.
1104
1105		# Ping the host
1106		my @output = `$ping_command -q -n -c $retries $host >$DEVNULL 2>&1`;
1107
1108		# Something went wrong
1109		return undef in ($? != 0);
1110
1111		# Parse the output
1112		my $stats = pop (@output);
1113		return undef unless ($stats =~ m/([\d\.]+)\/([\d\.]+)\/([\d\.]+)\/([\d\.]+) +ms/);
1114		return $2;
1115	}
1116
1117	# by default LINUX calls
1118	else {
1119		my $ping_command = "ping";
1120
1121		if ($host =~ /\d+:|:\d+/ ) {
1122			$ping_command = "ping6";
1123		}
1124
1125
1126		# Ping the host
1127		my @output = `$ping_command -q -W $timeout -n -c $retries $host 2>$DEVNULL`;
1128
1129		# Something went wrong
1130		return undef if ($? != 0);
1131
1132		# Parse the output
1133		my $stats = pop (@output);
1134		return undef unless ($stats =~ m/([\d\.]+)\/([\d\.]+)\/([\d\.]+)\/([\d\.]+) +ms/);
1135		return $2;
1136	}
1137
1138	# If no valid get values until now, just return with empty value (not valid)
1139	return $output;
1140}
1141
1142########################################################################
1143=head2 C<< month_have_days (I<$month>, I<$year>) >>
1144
1145Pass a $month (as january 0 number and each month with numbers) and the year
1146as number (for example 1981). And return the days of this month.
1147
1148=cut
1149########################################################################
1150sub month_have_days($$) {
1151	my $month= shift(@_);
1152	my $year= @_ ? shift(@_) : (1900 + (localtime())[5]);
1153
1154	my @monthDays= qw( 31 28 31 30 31 30 31 31 30 31 30 31 );
1155
1156	if (  $year <= 1752  ) {
1157		# Note:  Although September 1752 only had 19 days,
1158		# they were numbered 1,2,14..30!
1159		if (1752 == $year  &&  9 == $month) {
1160			return 19;
1161		}
1162		if (2 == $month  &&  0 == $year % 4) {
1163			return 29;
1164		}
1165	}
1166	else {
1167		#Check if Leap year
1168		if (2 == $month && 0 == $year % 4 && 0 == $year%100
1169			|| 0 == $year%400) {
1170			return 29;
1171		}
1172	}
1173
1174	return $monthDays[$month];
1175}
1176
1177###############################################################################
1178# Convert a text obj tag to an OID and update the module configuration.
1179###############################################################################
1180sub translate_obj ($$$) {
1181	my ($pa_config, $dbh, $obj) = @_;
1182
1183	# Pandora FMS's console MIB directory
1184	my $mib_dir = $pa_config->{'attachment_dir'} . '/mibs';
1185
1186	# Translate!
1187	my $oid = `snmptranslate -On -mALL -M+"$mib_dir" $obj 2>$DEVNULL`;
1188
1189	if ($? != 0) {
1190		return undef;
1191	}
1192	chomp($oid);
1193
1194	return $oid;
1195}
1196
1197###############################################################################
1198# Get the number of seconds left to the next execution of the given cron entry.
1199###############################################################################
1200sub cron_next_execution ($) {
1201	my ($cron) = @_;
1202
1203	# Check cron conf format
1204	if ($cron !~ /^((\*|(\d+(-\d+){0,1}))\s*){5}$/) {
1205		return 300;
1206	}
1207
1208	# Get day of the week and month from cron config
1209	my ($mday, $wday) = (split (/\s/, $cron))[2, 4];
1210
1211	# Get current time and day of the week
1212	my $cur_time = time();
1213	my $cur_wday = (localtime ($cur_time))[6];
1214
1215	# Any day of the week
1216	if ($wday eq '*') {
1217		my $nex_time = cron_next_execution_date ($cron,  $cur_time);
1218		return $nex_time - time();
1219	}
1220	# A range?
1221	else {
1222		$wday = cron_get_closest_in_range ($cur_wday, $wday);
1223	}
1224
1225	# A specific day of the week
1226	my $count = 0;
1227	my $nex_time = $cur_time;
1228	do {
1229		$nex_time = cron_next_execution_date ($cron, $nex_time);
1230		my $nex_time_wd = $nex_time;
1231		my ($nex_mon, $nex_wday) = (localtime ($nex_time_wd))[4, 6];
1232		my $nex_mon_wd;
1233		do {
1234			# Check the day of the week
1235			if ($nex_wday == $wday) {
1236				return $nex_time_wd - time();
1237			}
1238
1239			# Move to the next day of the month
1240			$nex_time_wd += 86400;
1241			($nex_mon_wd, $nex_wday) = (localtime ($nex_time_wd))[4, 6];
1242		} while ($mday eq '*' && $nex_mon_wd == $nex_mon);
1243		$count++;
1244	} while ($count < 60);
1245
1246	# Something went wrong, default to 5 minutes
1247	return 300;
1248}
1249###############################################################################
1250# Get the number of seconds left to the next execution of the given cron entry.
1251###############################################################################
1252sub cron_check_syntax ($) {
1253	my ($cron) = @_;
1254
1255	return 0 if !defined ($cron);
1256	return ($cron =~ m/^(\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+ (\d|\*|-)+$/);
1257}
1258###############################################################################
1259# Get the next execution date for the given cron entry in seconds since epoch.
1260###############################################################################
1261sub cron_next_execution_date ($$) {
1262	my ($cron, $cur_time) = @_;
1263
1264	# Get cron configuration
1265	my ($min, $hour, $mday, $mon, $wday) = split (/\s/, $cron);
1266
1267	# Months start from 0
1268	if($mon ne '*') {
1269		$mon -= 1;
1270	}
1271
1272	# Get current time
1273	if (! defined ($cur_time)) {
1274		$cur_time = time();
1275	}
1276	my ($cur_min, $cur_hour, $cur_mday, $cur_mon, $cur_year) = (localtime ($cur_time))[1, 2, 3, 4, 5];
1277
1278	# Parse intervals
1279	$min = cron_get_closest_in_range ($cur_min, $min);
1280	$hour = cron_get_closest_in_range ($cur_hour, $hour);
1281	$mday = cron_get_closest_in_range ($cur_mday, $mday);
1282	$mon = cron_get_closest_in_range ($cur_mon, $mon);
1283
1284	# Get first next date candidate from cron configuration
1285	my ($nex_min, $nex_hour, $nex_mday, $nex_mon, $nex_year) = ($min, $hour, $mday, $mon, $cur_year);
1286
1287	# Replace wildcards
1288	if ($min eq '*') {
1289		if ($hour ne '*' || $mday ne '*' || $wday ne '*' || $mon ne '*') {
1290			$nex_min = 0;
1291		}
1292		else {
1293			$nex_min = $cur_min;
1294		}
1295	}
1296	if ($hour eq '*') {
1297		if ($mday ne '*' || $wday ne '*' ||$mon ne '*') {
1298			$nex_hour = 0;
1299		}
1300		else {
1301			$nex_hour = $cur_hour;
1302		}
1303	}
1304	if ($mday eq '*') {
1305		if ($mon ne '*') {
1306			$nex_mday = 1;
1307		}
1308		else {
1309			$nex_mday = $cur_mday;
1310		}
1311	}
1312	if ($mon eq '*') {
1313		$nex_mon = $cur_mon;
1314	}
1315
1316	# Find the next execution date
1317	my $count = 0;
1318	do {
1319		my $next_time = timelocal(0, $nex_min, $nex_hour, $nex_mday, $nex_mon, $nex_year);
1320		if ($next_time > $cur_time) {
1321			return $next_time;
1322		}
1323		if ($min eq '*' && $hour eq '*' && $wday eq '*' && $mday eq '*' && $mon eq '*') {
1324			($nex_min, $nex_hour, $nex_mday, $nex_mon, $nex_year) = (localtime ($next_time + 60))[1, 2, 3, 4, 5];
1325		}
1326		elsif ($hour eq '*' && $wday eq '*' && $mday eq '*' && $mon eq '*') {
1327			($nex_min, $nex_hour, $nex_mday, $nex_mon, $nex_year) = (localtime ($next_time + 3600))[1, 2, 3, 4, 5];
1328		}
1329		elsif ($mday eq '*' && $mon eq '*') {
1330			($nex_min, $nex_hour, $nex_mday, $nex_mon, $nex_year) = (localtime ($next_time + 86400))[1, 2, 3, 4, 5];
1331		}
1332		elsif ($mon eq '*') {
1333			$nex_mon = $nex_mon + 1;
1334			if ($nex_mon > 11) {
1335				$nex_mon = 0;
1336				$nex_year++;
1337			}
1338		}
1339		else {
1340			$nex_year++;
1341		}
1342		$count++;
1343	} while ($count < 60);
1344
1345	# Something went wrong, default to 5 minutes
1346	return $cur_time + 300;
1347}
1348
1349###############################################################################
1350# Returns the closest number to the target inside the given range (including
1351# the target itself).
1352###############################################################################
1353sub cron_get_closest_in_range ($$) {
1354	my ($target, $range) = @_;
1355
1356	# Not a range
1357	if ($range !~ /(\d+)\-(\d+)/) {
1358		return $range;
1359	}
1360
1361	# Search the closes number to the target in the given range
1362	my $range_start = $1;
1363	my $range_end = $2;
1364
1365	# Outside the range
1366	if ($target <= $range_start || $target > $range_end) {
1367		return $range_start;
1368	}
1369
1370	# Inside the range
1371	return $target;
1372}
1373
1374###############################################################################
1375# Attempt to resolve the given hostname.
1376###############################################################################
1377sub resolve_hostname ($) {
1378	my ($hostname) = @_;
1379
1380	$resolved_hostname = inet_aton($hostname);
1381	return $hostname if (! defined ($resolved_hostname));
1382
1383	return inet_ntoa($resolved_hostname);
1384}
1385
1386###############################################################################
1387# Returns 1 if the given regular expression is valid, 0 otherwise.
1388###############################################################################
1389sub valid_regex ($) {
1390	my $regex = shift;
1391
1392	eval {
1393		local $SIG{'__DIE__'};
1394		qr/$regex/
1395	};
1396
1397	# Invalid regex
1398	return 0 if ($@);
1399
1400	# Valid regex
1401	return 1;
1402}
1403
1404###############################################################################
1405# Returns 1 if a valid metaconsole license is configured, 0 otherwise.
1406###############################################################################
1407sub is_metaconsole ($) {
1408	my ($pa_config) = @_;
1409
1410	if (defined($pa_config->{"license_type"}) && $pa_config->{"license_type"} == METACONSOLE_LICENSE) {
1411		return 1;
1412	}
1413
1414	return 0;
1415}
1416
1417# End of function declaration
1418# End of defined Code
1419
14201;
1421__END__
1422
1423