Webmin System stats git

#!/usr/bin/perl -w
###############################################################################
#    Webmin Sysstats - ping-lib.pl
#
#    Webmin Sysstats Module
#    Copyright (C) 2003 by Eric Gerbier
#    Bug reports to: gerbier@users.sourceforge.net
#    $Id$
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
###############################################################################
# this webminstats module needs the Net::Ping perl module
# which comes with perl standard distribution

use strict;
use warnings;

use English qw(-no_match_vars);

unset_warnings();
require RRDs;
set_warnings();

# from web-lib.pl
## no critic (ProhibitPackageVars)
use vars qw(%config %text %in $in %access $cb $tb );
## use critic

my $fscript = 'ping.pl';
my $pre     = 'ping';

my @protocols = ( 'icmp', 'tcp', 'udp', );

my $EMPTY = EMPTY();
my $COMMA = COMMA();

###############################################################################
sub install_module($$) {
	my ( $minfo, $defaults ) = ( $_[0], $_[1] );
	debug_sub_begin();

	my @colors = generate_colors();

	my %my_config = init_module_config( 'ping', 1 );
	$my_config{'runstop'} = 1;    # stopped by default
	$my_config{'keep'}    = 1;    # manual

	write_config( $minfo, \%my_config );
	install_script( $minfo, $fscript );

	# test Net::Ping perl module
	eval { require Net::Ping };
	if ($EVAL_ERROR) {
		warning("WARNING : the ping module needs the Net::Ping perl module\n");
	}

	# test Time::HiRes perl module
	eval { require Time::HiRes };
	if ($EVAL_ERROR) {
		warning(
"WARNING : the ping module works better with the Time::HiRes perl module\n"
		);
	}

	debug_sub_end();
	return 1;
}

###############################################################################

sub graph_data($$) {
	my ( $minfo, $my_config ) = ( $_[0], $_[1] );
	debug_sub_begin();

	my $cf = $my_config->{'cf'};

	# take care of cgi parameters
	my ( $graph_type, $c_display ) = get_cgi_graph($my_config);

	my @rrd_detals;
	gprint_title( 'ping', 'host', \@rrd_detals );

	my $ping_num    = 1;
	my $first_graph = 1;
  VOL: while ( defined $my_config->{ $pre . $ping_num } ) {
		my $ping_nb = $pre . $ping_num;

		my (
			$ping_id,     $ping_name, $ping_proto, $ping_host,
			$ping_config, $runstop,   $display
		) = unpack_config( $my_config->{$ping_nb} );

		if ($runstop) {
			$ping_num++;
			next VOL;
		}

		if ( $display == $c_display ) {

			add_def( \@rrd_detals, $ping_nb, $minfo->{'dbtables'} . $ping_id,
				'ping', $cf );
			if ( $graph_type == 0 ) {

				# histograms
				my $type;
				if ($first_graph) {
					$first_graph = 0;
					$type        = 'AREA';
				}
				else {
					$type = 'STACK';
				}
				gprint_param( \@rrd_detals, $ping_nb, $ping_name, $ping_config,
					$type );
			}
			else {

				# lines
				gprint_param( \@rrd_detals, $ping_nb, $ping_name,
					$ping_config );
			}
		}
		$ping_num++;
	}
	graph_common( $minfo, $my_config, @rrd_detals );
	debug_sub_end();
	return;
}

###############################################################################

sub mod_config($$$) {
	my ( $minfo, $my_config, $defaults ) = ( $_[0], $_[1], $_[2] );
	debug_sub_begin();
	my (
		$ping_id,     $ping_name, $ping_proto, $ping_host,
		$ping_colour, $runstop,   $display
	);

	#debug_hash( '%in', %in );

	mod_config_opt( $minfo, $my_config, $pre );

	begin_html_config(1);

	# title general
	change_database( $minfo, $my_config );
	change_local_params($my_config);
	change_display($my_config);
	change_scale( $minfo, $my_config );
	change_default( $my_config->{'graph_type'} );

	my @columns = (
		'module_display_name',       'module_cmdname',
		'word_subtitle_disp_colour', 'word_subtitle_controls',
	);
	end_html_config(@columns);

	my $ping_num = 1;
	while ( defined $my_config->{ $pre . $ping_num } ) {
		my (
			$ping_id,     $ping_name, $ping_proto, $ping_host,
			$ping_config, $runstop,   $display
		) = unpack_config( $my_config->{ $pre . $ping_num } );

		my ( $ping_colour, $ping_line ) = get_line_config($ping_config);

		print "<tr $cb>\n";
		print
"<td><strong><a href=\"edit_module.cgi?idx=$in{'idx'}&opt=edit&ping_num=$ping_num\">$ping_name</a></strong></td>\n";

		#print "<td>$ping_name</td>\n";
		print "<td>$ping_host</td>\n";
		print "<td><font color=\"#$ping_colour\"><strong>";
		print $text{ 'colour_' . $ping_colour }
		  ? $text{ 'colour_' . $ping_colour }
		  : "<pre>#$ping_colour </pre>";
		print "</strong></font></td>\n";
		print '<td align=right>';

		display_parameter_line( $ping_num, $runstop, $display, $my_config,
			$pre );

		print "</td>\n";
		$ping_num++;
	}
	print "</tr>\n";
	end_table();

	if ( ( exists $in{'opt'} ) and ( $in{'opt'} eq 'edit' ) ) {

		# edit old element
		my (
			$ping_id,     $ping_name, $ping_proto, $ping_host,
			$ping_config, $runstop,   $display
		) = unpack_config( $my_config->{ $pre . $in{'ping_num'} } );

		my ( $ping_colour, $ping_line ) = get_line_config($ping_config);

		begin_table( 'edition', 'border' );
		print "<tr $tb><td><strong>"
		  . $text{'module_ping'}
		  . "</strong></td></tr>\n";
		print "<tr $cb>";
		print '<td>';
		print '<form action="save_config.cgi">';
		print '<table ' . w100() . ">\n";
		print "<tr>\n";

		title_row( $text{'module_display_name'} );
		print
"<td><input type=text name=\"ping_name_def\" size=16 maxlength=32 value=\"$ping_name\">";
		print "</td></tr>\n<tr>";

		# hostname
		title_row( $text{'module_cmdname'} );
		print
"<td><input type=text name=\"ping_hostname_def\" size=32 maxlength=128 value=\"$ping_host\">";
		print "</td></tr>\n";

		# colour
		modify_colour( $ping_config, $display, $runstop, $my_config, $pre );

		# protocol
		print '<tr>';
		title_row( $text{'module_cmdname'} );
		print "<td><select name=\"ping_proto_def\">\n";
		foreach my $p (@protocols) {
			my $selected = ( $p eq $ping_proto ) ? 'selected' : $EMPTY;
			print '<option value="' . $p . "\" $selected>$p\n";
		}
		print "</select></td></tr>\n";

		print '<tr>';
		print '<td align=left>';
		print '<input type=hidden name=idx value="' . $in{'idx'} . '">';
		print '<input type=hidden name=opt value="update_ping">';
		print '<input type=hidden name=ping value="' . $in{'ping_num'} . '">';
		print "<input type=submit value=\"$text{'word_update'}\">";
		print "</td>\n";
		print "</tr>\n";
		print "</table>\n";
		print "</form>\n";
		print "</td>\n";
		print "</tr>\n";
		end_table();
	}
	else {

		# new element
		my $i = 0;
		begin_table( 'new_config', 'border' );
		print "<tr $tb><td><strong>"
		  . $text{'module_new_ping'}
		  . "</strong></td></tr>\n";
		print "<tr $cb>";
		print '<td>';
		print '<form action="save_config.cgi">';
		print '<table ' . w100() . ">\n";
		print "<tr>\n";
		title_row( $text{'module_word_ping'}, w15() );

		print "</tr>\n";

		modify_colour( '00ff00', 0, 0, $my_config, $pre );

		print '<tr>';
		title_row( $text{'module_display_name'} );
		print
'<td><input type=text name="new_ping_name_def" size=16 maxlength=32 value="">';
		print "</td>\n<tr>";

		# host name
		title_row( $text{'module_cmdname'} );
		print
'<td><input type=text name="new_ping_hostname_def" size=32 maxlength=128 value="">';
		print "</td>\n<tr>";

		# network protocol
		title_row( $text{'module_protocol'} );
		print '<td>';
		print "<select name=\"new_ping_proto\">\n";
		foreach my $p (@protocols) {
			my $selected = ( $p eq 'icmp' ) ? 'selected' : $EMPTY;
			print '<option value="' . $p . "\" $selected>$p\n";
		}
		print '</select>';
		print "</td>\n";

		print '</tr>';

		print '<tr>';
		print '<td align=left>';
		print '<input type=hidden name=idx value="' . $in{'idx'} . '">';
		print '<input type=hidden name=opt value="new_ping">';
		print '<input type=hidden name=ping value="' . $ping_num . '">';
		print "<input type=submit value=\"$text{'word_addnew'}\">";
		print "</td>\n";
		print "</tr>\n";
		print "</table>\n";
		print "</form>\n";
		print "</td>\n";
		print "</tr>\n";
		end_table();
	}
	end_table();
	print "</table>\n";
	debug_sub_end();
	return;
}

###############################################################################

sub mod_config_save($$$) {
	my ( $minfo, $my_config, $defaults ) = ( $_[0], $_[1], $_[2] );
	debug_sub_begin();

	#debug_hash( '%in', %in );

	if ( $in{'opt'} eq 'new_ping' ) {
		if (

			( $in{'new_ping_name_def'} eq $EMPTY )
			or (    ( $in{'ping_colour1_def'} eq 'nocolour' )
				and ( $in{'ping_colour2_def'} eq $EMPTY ) )
		  )
		{
			error( $text{'save_einvaled_selection'} );
		}

		my $type = 'GAUGE';

		#		if ( $in{'dst'} == 1 ) {
		#			$type = 'GAUGE';
		#		}
		#		else {
		#			$type = 'DERIVE';
		#		}

		create_base( $minfo, $my_config, $type );

		# tester la validite des noms de fichiers saisis
		my $command = $in{'new_ping_hostname_def'};
		my $runstop = 0;

		$my_config->{ $pre . $in{$pre} } = pack_config(
			$my_config->{'db_uid'}++,
			$in{'new_ping_name_def'},
			$in{'new_ping_proto'},
			$command,
			set_line_config(
				get_colourselect( 'ping_colour', $EMPTY ),
				get_lineselect('ping_line')
			),
			$runstop,
			$in{'display_def'}
		);

		# some tests
		# lancer l'acquisition si db_uid > 1
		$my_config->{'runstop'} = 0 if ( $my_config->{'db_uid'} > 1 );

		write_config( $minfo, $my_config );
		myredirect("edit_module.cgi?idx=$in{'idx'}");
	}
	elsif ( $in{'opt'} eq 'update_ping' ) {
		my $ping_num = $in{$pre};

		if (    ( $in{'ping_colour1_def'} eq 'nocolour' )
			and ( $in{'ping_colour2_def'} eq $EMPTY ) )
		{
			error( $text{'save_einvaled_selection'} );
		}

		# tester la validite des noms de fichiers saisis
		my $mod_runstop = $in{'runstop_def'};

		my (
			$ping_id,     $ping_name, $ping_proto, $ping_host,
			$ping_colour, $runstop,   $display
		) = unpack_config( $my_config->{ $pre . $in{$pre} } );

		$my_config->{ $pre . $in{$pre} } = pack_config(
			$ping_id,
			$in{'ping_name_def'},
			$in{'ping_proto_def'},
			$in{'ping_hostname_def'},
			set_line_config(
				get_colourselect( 'ping_colour', $EMPTY ),
				get_lineselect('ping_line')
			),
			$mod_runstop,
			$in{'display_def'}
		);

		# test for display : force to create an dummy label
		test_for_new_display($my_config);

		write_config( $minfo, $my_config );

		myredirect("edit_module.cgi?idx=$in{'idx'}");
	}
	elsif ( $in{'opt'} eq 'general' ) {
		test_database_change( $minfo, $my_config );
		test_local_params($my_config);
		test_display_change($my_config);
		test_scale_change( $minfo, $my_config );
		test_default_change($my_config);

		write_config( $minfo, $my_config );
	}
	else {
		error($in);
	}
	debug_sub_end();
	return;
}

###############################################################################
sub create_base($$$) {
	debug_sub_begin();
	my $minfo     = shift @_;    # name
	my $my_config = shift @_;
	my $type      = shift @_;    # DERIVE or GAUGE

	my $base      = $minfo->{'dbtables'} . $my_config->{'db_uid'} . '.rrd';
	my $cf        = $my_config->{'cf'};
	my $heartbeat = compute_heartbeat(1);
	create_rrd( $base, "DS:ping:$type:$heartbeat:0:U", $cf );

	debug_sub_end();
	return;
}
###############################################################################
sub write_config($$) {
	my ( $minfo, $my_config ) = ( $_[0], $_[1] );
	debug_sub_begin();

	common_write_config( $minfo, $my_config );
	debug_sub_end();
	return;
}
###############################################################################
sub upgrade($$$) {
	my ( $minfo, $my_config, $defaults ) = ( $_[0], $_[1], $_[2] );
	debug_sub_begin();

	my $changes = 0;

	# version 0.5.0
	# change old parameter order
	# old order was
	# $ping_id,  $ping_proto,   $ping_name,  $ping_host ...
	# but common tools to check config want the order
	# $ping_id, $ping_name,  $ping_proto, $ping_host
  KEY: foreach my $key ( keys %{$my_config} ) {
		debug("config key $key");
		my $vol = is_vol( $key, $my_config->{$key} );
		if ( defined $vol ) {
			my @tab = split /,/, $my_config->{$key};

			# search if second elem is a proto
		  PROTO: foreach my $proto (@protocols) {
				if ( $tab[1] eq $proto ) {
					$changes++;

					# invert field 1 and 2
					my $name = $tab[2];
					$tab[2] = $tab[1];
					$tab[1] = $name;
					my $new = join $COMMA, @tab;
					my $old = $my_config->{$key};
					info("ping : change order from $old to $new");
					$my_config->{$key} = $new;
					next KEY;
				}
			}
		}
		else {
			debug('not a vol');
		}
	}
	write_config( $minfo, $my_config ) if ($changes);

	debug_sub_end();
	return;
}
###############################################################################
# get/set_display/runstop must be defined to allow mod_config_opt to work
sub toggle_display($) {
	my $line = shift @_;

	my (
		$ping_id,     $ping_name, $ping_proto, $ping_host,
		$ping_config, $runstop,   $display
	) = unpack_config($line);

	$display = toggle_param_display($display);

	$line = pack_config(
		$ping_id,     $ping_name, $ping_proto, $ping_host,
		$ping_config, $runstop,   $display
	);

	return $line;
}
###############################################################################
sub toggle_runstop($) {
	my $line = shift @_;

	my (
		$ping_id,     $ping_name, $ping_proto, $ping_host,
		$ping_config, $runstop,   $display
	) = unpack_config($line);

	$runstop = toggle_param_runstop($runstop);

	$line = pack_config(
		$ping_id,     $ping_name, $ping_proto, $ping_host,
		$ping_config, $runstop,   $display
	);

	return $line;
}
###############################################################################

1;