Apache-VMonitor
view release on metacpan or search on metacpan
lib/Apache/VMonitor.pm view on Meta::CPAN
}
push @items, qw(end_html);
for my $item (@items) {
my $tmpl_block = "tmpl_$item";
my $data_sub = $self->can("data_$item");
my $data = $data_sub ? $self->$data_sub : {};
if (MP2 || $] >= 5.008) {
$tt->process($tmpl_block, $data) or warn $tt->error();
}
else {
# mp1 && perl < 5.008 can't handle the above
my $x;
$tt->process($tmpl_block, $data, \$x) or warn $tt->error();
print $x;
}
}
}
### start_html ###
sub data_start_html {
my $self = shift;
# return {};
my $url = $self->{url};
my $cfg = $self->{cfg};
my @rates = map {
[$_, ($cfg->{refresh} == $_ ? '' : fixup_url($url, 'refresh', $_)) ];
} qw(0 1 5 10 20 30 60);
return {
rate => $cfg->{refresh},
rates => \@rates,
};
}
sub tmpl_start_html {
return \ <<'EOT';
<html>
<head>
<title>Apache::VMonitor</title>
<style type="text/css">
body {
color: #000;
background-color: #fff;
border: 0px;
padding: 0px 0px 0px 0px;
margin: 5px 5px 5px 5px;
font-size: 0.8em;
}
p.hdr {
background-color: #ddd;
border: 2px outset;
padding: 3px;
width: 99%;
}
span.item_even {
background-color: #dddddd;
color: #000000;
}
span.item_odd {
background-color: #ffffff;
color: #000000;
}
span.normal {
color: #000000;
}
span.warn {
color: #ff99cc;
}
span.alert {
color: #ff0000;
}
</style>
</head>
<body bgcolor="white">
<b><font size=+1 color="#339966">Apache::VMonitor</font></b>
Refresh rate:
[%-
IF rates.size;
FOREACH item = rates;
IF item.1;
"<a href=\"${item.1}\">[ ${item.0} ]</a> ";
ELSE;
"[ ${item.0} ] ";
END;
END;
END;
-%]
<br>
EOT
}
### end_html ###
# not needed
sub data_end_html { {} }
sub tmpl_end_html {
return \ <<'EOT';
</body>
</html>
EOT
}
### nav_bar ###
sub data_nav_bar {
my $self = shift;
my $url = $self->{url};
my $cfg = $self->{cfg};
my %hide = ();
my %show = ();
for (@sects) {
if ($cfg->{$_}) {
$hide{$_} = fixup_url($url, $_, 0);
}
else {
$show{$_} = fixup_url($url, $_, 1);
}
}
return {
show => \%show,
hide => \%hide,
};
}
sub tmpl_nav_bar {
return \ <<'EOT';
<hr>
<font size=-1>
[% IF show.size %]
Show:
[%- FOREACH item = show -%]
[ <a href="[% item.value %]">[% item.key %]</a> ]
[%- END -%]
<br>
[% END %]
[% IF hide.size %]
Hide:
[%- FOREACH item = hide -%]
[ <a href="[% item.value %]">[% item.key %]</a> ]
[%- END -%]
<br>
[% END %]
</font><hr>
EOT
}
### system ###
sub data_system {
my $self = shift;
# uptime and etc...
my($min, $hour, $day, $mon, $year) = (localtime)[1..5];
my %date = (
min => $min,
hour => $hour,
day => $day,
month => $mon + 1,
year => $year + 1900,
);
unless ($gtop)
{
return { date => \%date, };
}
my $loadavg = $gtop->loadavg;
my $data = {
date => \%date,
uptime => format_time($gtop->uptime->uptime),
loadavg => \@{ $loadavg->loadavg },
};
if ($^O eq 'linux') {
$data->{tasks} = [ $loadavg->nr_tasks, $loadavg->nr_running ];
}
# total CPU stats
my $cpu = $gtop->cpu;
my $total = $cpu->total;
$data->{cpu} = {
map { $_ => ( $total ? ($cpu->$_() * 100 / $total) : 0 ) }
qw(user nice sys idle)
};
# total mem stats
my $mem = $gtop->mem;
$data->{mem} = {
map { $_ => size_string($mem->$_()) }
qw(total used free shared buffer)
};
# total swap stats
my $swap = $gtop->swap();
my $swap_total = $swap->total();
my $swap_used = $swap->used();
$data->{swap} = {
usage => ($swap_total ? ($swap_used * 100 / $swap_total) : 0),
used => $swap_used,
map({ ("f$_" => size_string($swap->$_)) }
qw(total used free)),
map({ ("f$_" => format_counts($swap->$_)) }
qw(pagein pageout)),
};
return $data;
}
sub tmpl_system {
return \ <<'EOT';
<hr>
<pre>
[%-
# date/time/load
USE format_date = format("%d/%.2d/%d");
fdate = format_date(date.month, date.day, date.year);
USE format_time = format("%d:%.2d%s");
pam = date.hour > 11 ? "pm" : "am";
date.hour = date.hour - 12 IF date.hour > 11;
ftime = format_time(date.hour, date.min, pam);
USE format_load = format("%.2f %.2f %.2f");
floadavg = format_load(loadavg.0, loadavg.1, loadavg.2,);
USE format_run_procs = format(", %d processes/threads: %d running");
frun_procs = tasks
? format_run_procs(tasks.0, tasks.1)
: "";
USE format_line_time_load =
format("<b>%s %s up %s, load average: %s%s</b>\n");
format_line_time_load(fdate, ftime, uptime, floadavg, frun_procs);
# CPU
USE format_line_cpu =
format("<b>CPU: %2.1f%% user, %2.1f%% nice, %2.1f%% sys, %2.1f%% idle</b>\n");
format_line_cpu(cpu.user, cpu.nice, cpu.sys, cpu.idle);
# Memory
USE format_line_mem =
format("<b>Mem: %5s av, %5s used, %5s free, %5s shared, %5s buff</b>\n");
format_line_mem(mem.total, mem.used, mem.free, mem.shared, mem.buffer);
# Swap
# visual alert on swap usage:
# 1) 5Mb < swap < 10 MB color: light red
# 2) 20% < swap (swapping is bad!) color: red
# 3) 70% < swap (swap almost used!) color: red
format_swap_data = "%5s av, %5s used, %5s free, %5s pagein, %5s pageout";
IF 5000 < swap.used AND swap.used < 10000;
USE format_line_swap = format("<b>Swap: <font color=\"#ff99cc\">$format_swap_data</font></b>\n");
ELSIF swap.usage >= 20;
USE format_line_swap = format("<b>Swap: <font color=\"#ff0000\">$format_swap_data</font></b>\n");
ELSIF swap.usage >= 70;
# swap on fire!
USE format_line_swap = format("<b>Swap: <font color=\"#ff0000\">$format_swap_data</font></b>\n");
ELSE;
USE format_line_swap = format("<b>Swap: $format_swap_data</b>\n");
END;
format_line_swap(swap.ftotal, swap.fused, swap.ffree, swap.fpagein, swap.fpageout);
-%]
</pre>
EOT
}
### apache ###
sub scoreboard_image {
MP2 ? Apache::Scoreboard->image(shift->{r}->pool)
: Apache::Scoreboard->image();
}
sub data_apache {
my $self = shift;
if (MP2 && $Apache::Scoreboard::VERSION < 2.0) {
die "Apache::Scoreboard 2.0 or higher is wanted, " .
"this is only version $Apache::Scoreboard::VERSION";
}
my $image = $self->scoreboard_image();
# total memory usage stats
my %mem_total = map { $_ => 0 } qw(size real max_shared);
my %cols = (
# WIDTH # LABEL # SORT
pid => [ 3, 'PID' , 'd'],
size => [ 5, 'Size' , 'd'],
share => [ 5, 'Share' , 'd'],
vsize => [ 5, 'VSize' , 'd'],
rss => [ 5, 'Rss' , 'd'],
mode => [ 1, 'M' , 's'],
elapsed => [ 7, 'Elapsed' , 'd'],
lastreq => [ 7, 'LastReq' , 'd'],
served => [ 4, 'Srvd' , 'd'],
client => [15, 'Client' , 's'],
vhost => [15, 'Virtual Host' , 's'],
request => [27, 'Request (first 64 chars)', 's'],
);
my @cols_sorted = qw(pid size share vsize rss mode elapsed lastreq served
client);
push @cols_sorted, "vhost" if HAS_VHOSTS;
push @cols_sorted, "request";
my $sort_field = lc($cfg{apache_sort_by}) || 'size';
$sort_field = 'size' unless $cols{$sort_field};
my $sort_ascend = $Apache::VMonitor::Config{apache_sort_by_ascend} || 0;
#warn "SORT field: $sort_field, ascending $sort_ascend\n";
lib/Apache/VMonitor.pm view on Meta::CPAN
my $i = $fs{$path};
my $fsusage = $gtop->fsusage($entries->mountdir($i));
my $total_blocks = $fsusage->blocks / 2;
my $su_avail_blocks = $fsusage->bfree / 2 ;
my $user_avail_blocks = $fsusage->bavail / 2;
my $used_blocks = $total_blocks - $su_avail_blocks;
my $usage_blocks = $total_blocks
? ($total_blocks - $user_avail_blocks)* 100 / $total_blocks
: 0;
my $total_files = $fsusage->files;
my $free_files = $fsusage->ffree;
my $usage_files = $total_files
? ($total_files - $free_files) * 100 / $total_files
: 0;
push @items, {
path => $path,
blocks => {
total => $total_blocks,
used => $used_blocks,
user_avail => $user_avail_blocks,
usage => $usage_blocks,
},
files => {
total => $total_files,
free => $free_files,
usage => $usage_files,
},
};
}
return {
max_fs_name_len => $max_fs_name_len,
items => \@items,
};
}
sub tmpl_fs_usage {
return \ <<'EOT';
<hr>
<pre>
[%-
fs_name_len = max_fs_name_len - 4;
USE format_header = format("%-${fs_name_len}s %14s %9s %9s %3s %12s %7s %5s\n");
format_header("FS", "1k Blks: Total", "SU Avail", "User Avail", "Usage",
" Files: Total", "Avail", "Usage");
format_blocks = "%9d %9d %10d %4d%% ";
format_files = " %7d %7d %4d%%";
format_fs = "%-${max_fs_name_len}s ";
FOR item = items;
# visual alert on filesystems of 90% usage!
IF item.blocks.usage >= 90 AND item.files.usage >= 90;
USE format_item = format("<b><font color=\"#ff0000\">$format_fs $format_blocks $format_files</font></b>\n");
ELSIF item.blocks.usage >= 90;
USE format_item = format("<b><font color=\"#ff0000\">$format_fs $format_blocks</font></b> $format_files\n");
ELSIF item.files.usage >= 90;
USE format_item = format("<b><font color=\"#ff0000\">$format_fs</font></b> $format_blocks <b><font color=\"#ff0000\">$format_files</font></b>\n");
ELSE;
USE format_item = format("$format_fs $format_blocks $format_files\n");
END;
format_item(item.path,
item.blocks.total,
item.blocks.used,
item.blocks.user_avail,
item.blocks.usage,
item.files.total,
item.files.free,
item.files.usage
);
END;
-%]
</pre>
EOT
}
### mount ###
sub data_mount {
my $self = shift;
#return {};
my @records = qw(devname mountdir type);
my($mountlist, $entries) = $gtop->mountlist(1);
my $fs_number = $mountlist->number;
my %len = map { $_ => 0 } @records;
my @items = ();
for (my $i=0; $i < $fs_number; $i++) {
push @items, {
map {
my $val = $entries->$_($i);
$len{$_} = length $val if length $val > $len{$_};
$_ => $val;
} @records
};
}
# sort by device name
@items = sort { $a->{devname} cmp $b->{devname} } @items;
return {
items => \@items,
len => \%len,
};
}
sub tmpl_mount {
return \ <<'EOT';
<hr>
<pre>
[%-
header = "%-${len.devname}s %-${len.mountdir}s %-${len.type}s";
lib/Apache/VMonitor.pm view on Meta::CPAN
memory, we will get all the memory that is actually used by all
mod_perl processes, but the parent process.
=back
Please note that this might be incorrect for your system, so you
should use this number on your own risk. We have verified this number
on the Linux OS, by taken the number reported by C<Apache::VMonitor>,
then stopping mod_perl and looking at the system memory usage. The
system memory went down approximately by the number reported by the
tool. Again, use this number wisely!
If you don't want the mod_perl processes section to be displayed set:
$Apache::VMonitor::Config{apache} = 0;
The default is to display this section.
=item top(1) emulation (any processes)
This section, just like the mod_perl processes section, displays the
information in a top(1) fashion. To enable this section you have to
set:
$Apache::VMonitor::Config{procs} = 1;
The default is not to display this section.
Now you need to specify which processes are to be monitored. The
regular expression that will match the desired processes is required
for this section to work. For example if you want to see all the
processes whose name include any of these strings: I<http>, I<mysql>
and I<squid>, the following regular expression is to be used:
$Apache::VMonitor::PROC_REGEX = join "\|", qw(httpd mysql squid);
=item mount(1) emulation
This section reports about mounted filesystems, the same way as if you
have called mount(1) with no parameters.
If you want the mount(1) section to be displayed set:
$Apache::VMonitor::Config{mount} = 1;
The default is NOT to display this section.
=item df(1) emulation
This section completely reproduces the df(1) utility. For each mounted
filesystem it reports the number of total and available blocks (for
both superuser and user), and usage in percents.
In addition it reports about available and used file inodes in numbers
and percents.
This section has a capability of visual alert which is being triggered
when either some filesystem becomes more than 90% full or there are
less than 10% of free file inodes left. When this event happens the
filesystem related report row will be displayed in the bold font and
in the red color.
If you don't want the df(1) section to be displayed set:
$Apache::VMonitor::Config{fs_usage} = 0;
The default is to display this section.
=item abbreviations and hints
The monitor uses many abbreviations, which might be knew for you. If
you enable the VERBOSE mode with:
$Apache::VMonitor::Config{verbose} = 1;
this section will reveal all the full names of the abbreviations at
the bottom of the report.
The default is NOT to display this section.
=back
=head1 CONFIGURATION
To enable this module you should modify a configuration in
B<httpd.conf>, if you add the following configuration:
<Location /system/vmonitor>
SetHandler perl-script
PerlHandler Apache::VMonitor
</Location>
The monitor will be displayed when you request
http://localhost/system/vmonitor or alike.
You probably want to protect this location, from unwanted visitors. If
you are accessing this location from the same IP address, you can use
a simple host based authentication:
<Location /system/vmonitor>
SetHandler perl-script
PerlHandler Apache::VMonitor
order deny, allow
deny from all
allow from 132.123.123.3
</Location>
Alternatively you may use the Basic or other authentication schemes
provided by Apache and various extensions.
You can control the behavior of this module by configuring the
following variables in the startup file or inside the
C<E<lt>PerlE<gt>> section.
Module loading:
use Apache::VMonitor();
Monitor reporting behavior:
( run in 0.575 second using v1.01-cache-2.11-cpan-ceb78f64989 )