468 lines
12 KiB
Perl
468 lines
12 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
# A basic perl port of the bootchart renderer, SVG only
|
|
# (c) 2005 Vincent Caron <v.caron@zerodeux.net>
|
|
|
|
# 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.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
# BUGS
|
|
# - ignore number of CPUs (disk util.)
|
|
|
|
# 2005-06-29 - fixes
|
|
# - process name is latest sample argv value
|
|
# - sibling processes are properly PID-sorted from top to bottom
|
|
# - process start is now parsed from proc_ps
|
|
# - hiding bootchartd-related processes
|
|
#
|
|
# 2005-06-28
|
|
# - initial release
|
|
|
|
use strict;
|
|
|
|
my %headers;
|
|
my @disk_samples;
|
|
my @cpu_samples;
|
|
my %ps_info;
|
|
my %ps_by_parent;
|
|
|
|
my $chart_svg_template = `cat svg/bootchart.svg.template` || die;
|
|
my $process_svg_template = `cat svg/process.svg.template` || die;
|
|
my $svg_css_file = `cat svg/style.css` || die;
|
|
$svg_css_file =~ s/^/\t\t\t/mg;
|
|
$svg_css_file =~ s/^\s+//g;
|
|
|
|
my $HZ = 100;
|
|
my $min_img_w = 800;
|
|
my $sec_w = 25;
|
|
my $proc_h = 16;
|
|
my $header_h = 300;
|
|
my $img_w;
|
|
my $img_h;
|
|
my $t_begin;
|
|
my $t_end;
|
|
my $t_dur;
|
|
|
|
|
|
sub parse_logs {
|
|
my $logfile = shift;
|
|
my $tmp = "/tmp/bootchart-$$";
|
|
|
|
mkdir $tmp or die;
|
|
system "cd $tmp && tar xzf $logfile";
|
|
|
|
parse_log_header($tmp);
|
|
parse_log_cpu($tmp);
|
|
parse_log_disk($tmp);
|
|
parse_log_ps($tmp);
|
|
|
|
system('rm', '-rf', $tmp);
|
|
print STDERR "Disk samples: ".scalar(@disk_samples)."\n";
|
|
print STDERR "CPU samples : ".scalar(@cpu_samples)."\n";
|
|
print STDERR "Processes : ".scalar(keys %ps_info)."\n";
|
|
}
|
|
|
|
sub parse_log_header {
|
|
my $tmp = shift;
|
|
|
|
open(HEADER, "<$tmp/header");
|
|
while (<HEADER>) {
|
|
chomp;
|
|
my ($key, $val) = split /\s*=\s*/, $_, 2;
|
|
$headers{$key} = $val;
|
|
}
|
|
close HEADER;
|
|
}
|
|
|
|
sub parse_log_cpu {
|
|
my $tmp = shift;
|
|
|
|
# Reads in: time, user, system, iowait
|
|
my ($time, $ltime);
|
|
my (@timings, @ltimings);
|
|
|
|
open(PROC_STAT, "<$tmp/proc_stat.log");
|
|
while (<PROC_STAT>) {
|
|
chomp;
|
|
$time = $1, next if /^(\d+)$/;
|
|
|
|
if (/^$/) {
|
|
if (defined $ltime) {
|
|
my $dtime = ($time - $ltime) / $HZ; # in seconds
|
|
my $user = ($timings[0] + $timings[1]) - ($ltimings[0] + $ltimings[1]);
|
|
my $system = ($timings[2] + $timings[5] + $timings[6]) - ($ltimings[2] + $ltimings[5] + $ltimings[6]);
|
|
my $idle = $timings[3] - $ltimings[3];
|
|
my $iowait = $timings[4] - $ltimings[4];
|
|
my $sum = $user + $system + $idle + $iowait;
|
|
my %sample;
|
|
$sample{time} = $time;
|
|
$sample{user} = $user / $sum;
|
|
$sample{system} = $system / $sum;
|
|
$sample{iowait} = $iowait / $sum;
|
|
push @cpu_samples, \%sample;
|
|
}
|
|
|
|
$ltime = $time;
|
|
@ltimings = @timings;
|
|
next;
|
|
}
|
|
|
|
@timings = split /\s+/ if s/^cpu\s+//;
|
|
}
|
|
close(PROC_STAT);
|
|
}
|
|
|
|
sub parse_log_disk {
|
|
my $tmp = shift;
|
|
|
|
# Reads in: time, read, write, use
|
|
my ($time, $ltime);
|
|
my ($read, $write, $util) = (0, 0, 0);
|
|
my ($lread, $lwrite, $lutil);
|
|
|
|
open(DISK_STAT, "<$tmp/proc_diskstats.log");
|
|
while (<DISK_STAT>) {
|
|
chomp;
|
|
$time = $1, next if /^(\d+)$/;
|
|
|
|
if (/^$/) {
|
|
if (defined $ltime) {
|
|
my $dtime = ($time - $ltime) / $HZ; # in seconds
|
|
my $dutil = ($util - $lutil) / (1000 * $dtime);
|
|
|
|
my %sample;
|
|
$sample{time} = $time;
|
|
$sample{read} = ($read - $lread) / 2 / $dtime; # in KB/s
|
|
$sample{write} = ($write - $lwrite) / 2 / $dtime; # in KB/s
|
|
$sample{util} = ($dutil > 1 ? 1 : $dutil);
|
|
push @disk_samples, \%sample;
|
|
}
|
|
|
|
$ltime = $time;
|
|
$lread = $read, $read = 0;
|
|
$lwrite = $write, $write = 0;
|
|
$lutil = $util, $util = 0;
|
|
next;
|
|
}
|
|
|
|
s/\s+//;
|
|
my @tokens = split /\s+/;
|
|
next if scalar(@tokens) != 14 || not $tokens[2] =~ /hd|sd/;
|
|
|
|
$read += $tokens[5];
|
|
$write += $tokens[9];
|
|
$util += $tokens[12];
|
|
}
|
|
close(DISK_STAT);
|
|
}
|
|
|
|
sub parse_log_ps {
|
|
my $tmp = shift;
|
|
|
|
my $time;
|
|
|
|
open(PS_STAT, "<$tmp/proc_ps.log");
|
|
while (<PS_STAT>) {
|
|
chomp;
|
|
next if /^$/;
|
|
$time = $1, next if /^(\d+)$/;
|
|
|
|
my @tokens = split /\s+/;
|
|
my $pid = $tokens[0];
|
|
|
|
if (!defined $ps_info{$pid}) {
|
|
my %info;
|
|
my @empty;
|
|
my $ppid = $tokens[3];
|
|
my $start = $tokens[21];
|
|
$t_begin = $start if !defined $t_begin || $t_begin > $start;
|
|
|
|
$info{ppid} = $ppid;
|
|
$info{start} = $start;
|
|
$info{samples} = \@empty;
|
|
$ps_info{$pid} = \%info;
|
|
|
|
if (!defined $ps_by_parent{$ppid}) {
|
|
my @pidlist = ($pid);
|
|
$ps_by_parent{$ppid} = \@pidlist;
|
|
} else {
|
|
push @{$ps_by_parent{$ppid}}, $pid;
|
|
}
|
|
}
|
|
|
|
# argv may change, we'll store here the last sampled value
|
|
my $comm = $tokens[1];
|
|
$comm =~ s/[()]//g;
|
|
$ps_info{$pid}->{comm} = $comm;
|
|
|
|
my %sample;
|
|
$sample{time} = $time;
|
|
$sample{state} = $tokens[2];
|
|
$sample{sys} = $tokens[13];
|
|
$sample{user} = $tokens[14];
|
|
push @{$ps_info{$pid}->{samples}}, \%sample;
|
|
}
|
|
close PS_STAT;
|
|
}
|
|
|
|
sub unxml {
|
|
my $x = shift;
|
|
$x =~ s/</</g;
|
|
$x =~ s/>/>/g;
|
|
|
|
return $x;
|
|
}
|
|
|
|
sub render_svg {
|
|
my $t_init = $cpu_samples[0]->{time};
|
|
$t_end = $cpu_samples[-1]->{time};
|
|
$t_dur = $t_end - $t_begin;
|
|
$img_w = $t_dur / $HZ * $sec_w;
|
|
|
|
my @subst;
|
|
$subst[1] = $svg_css_file;
|
|
|
|
#
|
|
# Headers
|
|
#
|
|
|
|
my $cpu = $headers{'system.cpu'};
|
|
$cpu =~ s/model name\s*:\s*//;
|
|
$subst[2] = unxml($headers{title});
|
|
$subst[3] = "uname: ".unxml($headers{'system.uname'});
|
|
$subst[4] = "release: ".unxml($headers{'system.release'});
|
|
$subst[5] = "CPU: ".unxml($cpu);
|
|
$subst[6] = "kernel options: ".unxml($headers{'system.kernel.options'});
|
|
$subst[7] = "boot time: ".int($t_end / $HZ)." seconds";
|
|
|
|
#
|
|
# CPU I/O chart
|
|
#
|
|
|
|
my $bar_h = 50;
|
|
my $cpu_ticks = '';
|
|
for (my $i = 0; $i < $t_dur / $HZ; $i++) {
|
|
my $x = $i * $sec_w;
|
|
$cpu_ticks .= "<line ".($i % 5 ? "" : "class=\"Bold\" ")."x1=\"$x\" y1=\"0\" x2=\"$x\" y2=\"$bar_h\"/>\n";
|
|
}
|
|
$cpu_ticks =~ s/^/\t\t\t/mg; $cpu_ticks =~ s/^\s+//g;
|
|
|
|
my $io_points = '';
|
|
my $cpu_points = '';
|
|
|
|
if (@cpu_samples) {
|
|
my $last_x = 0;
|
|
|
|
for (@cpu_samples) {
|
|
my $time = $_->{time};
|
|
my $iowait = $_->{iowait};
|
|
my $usersys = $_->{user} + $_->{system};
|
|
|
|
my $pos_x = int(($time - $t_begin) * $img_w / $t_dur);
|
|
my $pos_y = int($bar_h - ($usersys + $iowait) * $bar_h);
|
|
$io_points .= "$pos_x,$bar_h" if $io_points eq '';
|
|
$io_points .= " $pos_x,$pos_y";
|
|
|
|
$pos_y = int($bar_h - $usersys * $bar_h);
|
|
$cpu_points .= "$pos_x,$bar_h" if $cpu_points eq '';
|
|
$cpu_points .= " $pos_x,$pos_y";
|
|
|
|
$last_x = $pos_x;
|
|
}
|
|
$io_points .= " $last_x,$bar_h";
|
|
$cpu_points .= " $last_x,$bar_h";
|
|
}
|
|
|
|
$subst[8] = $cpu_ticks;
|
|
$subst[9] = $io_points;
|
|
$subst[10] = $cpu_points;
|
|
|
|
#
|
|
# Disk usage chart
|
|
#
|
|
|
|
my $util_points = '';
|
|
my $read_points = '';
|
|
|
|
if (@disk_samples) {
|
|
my $max_tput = 0;
|
|
my $max_tput_label = '';
|
|
for (@disk_samples) {
|
|
my $put = $_->{read} + $_->{write};
|
|
$max_tput = $put if $put > $max_tput;
|
|
}
|
|
|
|
my $last_x = 0;
|
|
my $last_y = 0;
|
|
|
|
for (@disk_samples) {
|
|
my $time = $_->{time};
|
|
my $read = $_->{read};
|
|
my $write = $_->{write};
|
|
my $util = $_->{util};
|
|
|
|
my $pos_x = int(($time - $t_begin) * $img_w / $t_dur);
|
|
my $pos_y = int($bar_h - $util * $bar_h);
|
|
$util_points .= "$pos_x,$bar_h" if $util_points eq '';
|
|
$util_points .= " $pos_x,$pos_y";
|
|
|
|
$pos_y = int($bar_h - ($read + $write) / $max_tput * $bar_h);
|
|
if ($read_points ne '') {
|
|
$read_points .= "\t\t\t<line x1=\"$last_x\" y1=\"$last_y\" x2=\"$pos_x\" y2=\"$pos_y\"/>";
|
|
}
|
|
$read_points .= "\n";
|
|
|
|
if ($max_tput_label eq '' && $read + $write == $max_tput) {
|
|
my $label = int($max_tput / 1024)." MB/s";
|
|
$max_tput_label = "\t\t\t<text class=\"DiskLabel\" x=\"$pos_x\" y=\"0\" dx=\"-".(length($label) / 3)."em\" dy=\"-2px\">$label</text>\n";
|
|
}
|
|
|
|
$last_x = $pos_x;
|
|
$last_y = $pos_y;
|
|
}
|
|
$util_points .= " $last_x,$bar_h";
|
|
$read_points .= $max_tput_label;
|
|
}
|
|
|
|
$subst[11] = $cpu_ticks;
|
|
$subst[12] = $util_points;
|
|
$subst[13] = $read_points;
|
|
$subst[14] = ''; # open_points, no openfile parser implemented
|
|
|
|
#
|
|
# Process tree
|
|
#
|
|
|
|
my $tree_h = scalar(@cpu_samples) * $proc_h;
|
|
my $axis = '';
|
|
my $proc_ticks = '';
|
|
for (my $i = 0; $i < $t_dur / $HZ; $i++) {
|
|
my $x = $i * $sec_w;
|
|
$proc_ticks .= "<line ".($i % 5 ? "" : "class=\"Bold\" ")."x1=\"$x\" y1=\"0\" x2=\"$x\" y2=\"$tree_h\"/>\n";
|
|
if ($i > 0 && $i % 5 == 0) {
|
|
my $label = $i.'s';
|
|
$axis .= "<text class=\"AxisLabel\" x=\"$x\" y=\"0\" dx=\"-".(length($label) / 4)."\" dy=\"-3\">$label</text>\n";
|
|
}
|
|
}
|
|
$proc_ticks =~ s/^/\t\t\t/mg; $proc_ticks =~ s/^\s+//g;
|
|
$axis =~ s/^/\t\t\t/mg; $axis =~ s/^\s+//g;
|
|
|
|
my $proc_tree = '';
|
|
my @init = (1);
|
|
my $ps_count = 0;
|
|
$proc_tree = render_proc_tree(\@init, \$ps_count);
|
|
|
|
$subst[15] = $axis;
|
|
$subst[16] = $proc_ticks;
|
|
$subst[17] = $proc_tree;
|
|
|
|
$img_h = $proc_h * $ps_count + $header_h;
|
|
$subst[0] = 'width="'.($img_w > $min_img_w ? $img_w : $min_img_w).'px" height="'.($img_h + 1).'px"';
|
|
|
|
print template_subst($chart_svg_template, @subst);
|
|
}
|
|
|
|
sub render_proc_tree {
|
|
my $ps_list = shift;
|
|
my $ps_count = shift;
|
|
my $level = shift || 0;
|
|
|
|
my $proc_tree = '';
|
|
for (sort {$a <=> $b} @{$ps_list}) {
|
|
# Hide bootchartd and its children processes
|
|
next if $ps_info{$_}->{comm} eq 'bootchartd';
|
|
|
|
my $children = $ps_by_parent{$_};
|
|
$proc_tree .= render_proc($_, $ps_count, $level);
|
|
$proc_tree .= render_proc_tree($children, $ps_count, $level + 1) if defined $children;
|
|
}
|
|
return $proc_tree;
|
|
}
|
|
|
|
sub render_proc {
|
|
my $pid = shift;
|
|
my $ps_count = shift;
|
|
my $level = shift;
|
|
|
|
my $info = $ps_info{$pid};
|
|
return '' if defined $info->{done}; # Draw once
|
|
|
|
my @samples = @{$info->{samples}};
|
|
return '' if scalar(@samples) < 2; # Skip processes with only 1 sample
|
|
|
|
my $p_begin = ($pid == 1) ? $samples[0]->{time} : $info->{start};
|
|
my $p_period = $samples[1]->{time} - $p_begin;
|
|
my $p_end = $samples[-1]->{time};
|
|
my $p_dur = $p_end - $p_begin + $p_period;
|
|
|
|
my $x = ($p_begin - $t_begin) * $sec_w / $HZ;
|
|
my $y = ${$ps_count} * $proc_h;
|
|
my $w = $p_dur * $sec_w / $HZ;
|
|
|
|
my $position = "$x,$y";
|
|
my $border = "width=\"$w\" height=\"$proc_h\"";
|
|
my $timeline = "<rect class=\"Sleeping\" x=\"0\" y=\"0\" $border/>\n";
|
|
|
|
my ($last_tx, $last_sample);
|
|
for my $sample (@samples) {
|
|
my $time = $sample->{time};
|
|
my $state = $sample->{state};
|
|
my $tx = ($time - $p_begin) * $sec_w / $HZ;
|
|
$tx = 0 if $tx < 0;
|
|
|
|
if (defined $last_sample) {
|
|
my $tw = $tx - $last_tx;
|
|
|
|
if ($state ne 'S') {
|
|
my $sys = ($sample->{sys} - $last_sample->{sys}) / $HZ;
|
|
my $user = ($sample->{user} - $last_sample->{user}) / $HZ;
|
|
|
|
my %class = ('D' => 'UnintSleep', 'R' => 'Running', 'T' => 'Traced', 'Z' => 'Zombie');
|
|
my $opacity = ($state eq 'R') ? ' fill-opacity="'.($sys + $user).'"' : '';
|
|
$timeline .= "<rect class=\"$class{$state}\"$opacity x=\"$last_tx\" y=\"0\" width=\"$tw\" height=\"$proc_h\"/>\n";
|
|
}
|
|
}
|
|
|
|
$last_tx = $tx;
|
|
$last_sample = $sample;
|
|
}
|
|
$timeline =~ s/^/\t\t/mg; $timeline =~ s/^\s+//g;
|
|
|
|
my $label = $info->{comm};
|
|
my $label_pos = ($w < 200 && ($x + $w + 200) < $img_w) ?
|
|
"dx=\"2\" dy=\"".($proc_h - 1)."\" x=\"".($w + 1)."\" y=\"0\"" :
|
|
"dx=\"".($w / 2)."\" dy=\"".($proc_h - 1)."\" x=\"0\" y=\"0\"";
|
|
|
|
my @subst = ($position, $timeline, $border, '', $label_pos, $label, '');
|
|
|
|
$info->{done} = 1;
|
|
${$ps_count}++;
|
|
return template_subst($process_svg_template, @subst);
|
|
}
|
|
|
|
sub template_subst {
|
|
my $template = shift;
|
|
|
|
my $i = 0;
|
|
for(@_) {
|
|
$template =~ s/\Q{$i}\E/$_[$i]/g;
|
|
$i++;
|
|
}
|
|
return $template;
|
|
}
|
|
|
|
|
|
parse_logs('/var/log/bootchart.tgz');
|
|
render_svg();
|