pidstat で見れるような数字を perl で取ってみる
pid ファイルを読んで procfs からバーンと取って集計とるようなやつを書いてみた。 1secごとに60回データを取って、平均を取るみたいなのを子プロセス含めてバーンとヤる感じをやってみた。 書きながらオーバーヘッドがどうかな〜とか考え始めちゃって、結局こういうの、go で書いたほうが良いなということを感じる。
use strict;
use warnings;
use v5.10.0;
use Getopt::Long;
use Pod::Usage;
use warnings FATAL => 'recursion';
{
package ProcStat::Stat;
use File::Basename qw/basename/;
use List::Util qw/sum0/;
sub new {
my $class = shift;
bless {
}, $class;
}
sub read {
my ($self) = @_;
open my $fh, '<', '/proc/stat' or die "Cannot read /proc/stat: $!";
my $line = <$fh>;
$line =~ /^cpu\s+(.*)/;
return sum0(split / /, $1);
}
}
{
package ProcStat::Process;
use File::Basename qw/basename/;
use List::Util qw/sum0/;
# https://linuxjm.osdn.jp/html/LDP_man-pages/man5/proc.5.html
use constant {
PROC_UTIME => 13,
PROC_STIME => 14,
PROC_CUTIME => 15,
PROC_CSTIME => 16,
IO_RCHAR => 0,
IO_WCHAR => 1,
IO_SYSCR => 2,
IO_SYSCW => 3,
IO_READ_BYTES => 4,
IO_WRITE_BYTES => 5,
PREV_STAT => 0,
PREV_IO => 1,
PREV_SMAPS => 2,
};
sub new {
my ($class, $pid_file, $logger) = @_;
my $self = bless {
pid_file => $pid_file,
history => [],
logger => $logger,
}, $class;
$self->{name} = $self->_build_name();
return $self;
}
sub pid_file { shift->{pid_file} }
sub name { shift->{name} }
sub logger { shift->{logger} }
sub _build_name {
my $self = shift;
my $name = basename($self->pid_file);
$name =~ s/\.pid$//;
$name;
}
sub read_pid {
my $self = shift;
local $/;
open my $fh, '<', $self->pid_file
or do {
$self->logger->warnf("Cannot read pid file: $self->{pid_file}: $!");
return;
};
my $s = <$fh>;
$s =~ s/\s+//g;
$s;
}
sub clear_history {
my ($self) = @_;
$self->{history} = [];
}
sub aggregate {
my ($self, $elapsed, $child_mgr) = @_;
$self->logger->infof("Now loading %s", $self->pid_file);
my $pid = $self->read_pid
or return;
my $proc_stat = $self->read_stat($pid)
or return;
my @pids = ($pid, $self->child_pids($pid));
my $current_io = $self->aggregate_io(@pids);
my $current_smaps = $self->aggregate_smaps($pid);
if ($self->{prev}) {
my $utime = $proc_stat->[PROC_UTIME] - $self->{prev}->[PREV_STAT]->[PROC_UTIME];
my $stime = $proc_stat->[PROC_STIME] - $self->{prev}->[PREV_STAT]->[PROC_STIME];
my $cutime = $proc_stat->[PROC_CUTIME] - $self->{prev}->[PREV_STAT]->[PROC_CUTIME];
my $cstime = $proc_stat->[PROC_CSTIME] - $self->{prev}->[PREV_STAT]->[PROC_CSTIME];
my $rchar = $current_io->[IO_RCHAR] - $self->{prev}->[PREV_IO]->[IO_RCHAR];
my $wchar = $current_io->[IO_WCHAR] - $self->{prev}->[PREV_IO]->[IO_WCHAR];
my $read_bytes = $current_io->[IO_READ_BYTES] - $self->{prev}->[PREV_IO]->[IO_READ_BYTES];
my $write_bytes = $current_io->[IO_WRITE_BYTES] - $self->{prev}->[PREV_IO]->[IO_WRITE_BYTES];
my $pss = $current_smaps;
push @{$self->{history}}, [
($utime+$cutime)/$elapsed,
($stime+$cstime)/$elapsed,
$rchar,
$wchar,
$read_bytes,
$write_bytes,
$pss,
];
}
$self->{prev} = [$proc_stat, $current_io, $current_smaps];
}
sub aggregate_smaps {
my ($self, @pids) = @_;
return sum0 grep { defined $_ } map { $self->read_smaps($_) } @pids;
}
sub read_smaps {
my ($self, $pid) = @_;
open my $fh, '<', "/proc/$pid/smaps"
or return;
my $pss = 0;
my $src = do { local $/; <$fh> };
unless (defined $src) {
warn "Cannot red /proc/$pid/smaps: $!";
return;
}
$src =~ s/Pss:\s+(\d+)/$pss += $1/gesm;
return $pss;
}
sub aggregate_io {
my ($self, @pids) = @_;
my @io = grep { $_ } map { $self->read_io($_) } @pids;
my @retval = (0,0,0,0,0,0);
for my $row (@io) {
for my $i (0..@$row-1) {
$retval[$i] += $row->[$i];
}
}
return \@retval;
}
sub read_io {
my ($self, $pid) = @_;
open my $fh, '<', "/proc/$pid/io"
or return;
my $src = do { local $/; <$fh>; };
if ($src =~ /rchar: (\d+)\nwchar: (\d+)\nsyscr: (\d+)\nsyscw: (\d+)\nread_bytes: (\d+)\nwrite_bytes: (\d+)/) {
return [$1, $2, $3, $4, $5, $6];
} else {
return;
}
}
sub child_pids {
my ($self, $pid) = @_;
my @retval;
# /proc/[pid]/task/[tid]/children since Linux 3.5
LOOP:
for my $children (glob("/proc/$pid/task/*/children")) {
open my $fh, '<', $children
or do {
$self->logger->info("Cannot read $children: $!");
next LOOP;
};
local $/;
my @pids = split / /, <$fh>;
push @retval, @pids;
push @retval, map { $self->child_pids($_) } @pids;
}
return @retval;
}
sub result {
my ($self) = @_;
if (@{$self->{history}}) {
return [map { $self->sum_history($_) } 0..6];
} else {
return [0,0,0,0,0,0,0];
}
}
sub sum_history {
my ($self, $idx) = @_;
return (sum0 map { $_->[$idx] } @{$self->{history}}) / @{$self->{history}};
}
sub read_stat {
my ($self, $pid) = @_;
my $statfile = "/proc/$pid/stat";
open my $fh, '<', $statfile
or do {
$self->logger->warnf("Cannot read %s: %s", $statfile, $!);
return;
};
return [split / /, <$fh>];
}
}
{
package ProcStat::Logger;
use Time::Piece qw/localtime/;
sub new {
my ($class, $level) = @_;
$level = lc($level);
bless {
debug => $level eq 'debug',
info => $level eq 'debug' || $level eq 'info',
warn => $level eq 'debug' || $level eq 'info' || $level eq 'warn',
}, $class;
}
sub warnf {
my $self = shift;
$self->_log('WARN', @_) if $self->{warn};
}
sub infof {
my $self = shift;
$self->_log('INFO', @_) if $self->{info};
}
sub debugf {
my $self = shift;
$self->_log('DEBUG', @_) if $self->{debug};
}
sub _log {
my ($self, $level, $fmt, @args) = @_;
my $body = sprintf($fmt, @args);
$body =~ s/\n/\\n/g;
print {*STDERR} localtime->strftime("[%Y-%m-%dT%H:%M:%S%Z] [$level] $body\n");
}
}
{
package ProcStat::ChildProcessManager;
sub new {
my $class = shift;
my $self = bless {
}, $class;
$self->{ppid2pids} = $self->_build_ppid2pids;
$self;
}
sub _build_ppid2pids {
my $self = shift;
my %ppid2pids;
for my $file (glob("/proc/*/stat")) {
local $/;
open my $fh, '<', $file
or next;
my $line = <$fh> // next;
my @stat = split / /, $line;
my $pid = $stat[0];
my $ppid = $stat[3];
push @{$ppid2pids{$ppid}}, $pid;
}
return \%ppid2pids;
}
}
{
package ProcStat;
use File::Basename qw/basename/;
use Time::HiRes ();
sub new {
my $class = shift;
my %args = @_;
bless {
pid_dir => $args{pid_dir},
interval => $args{interval},
freq => $args{freq} // 60,
logger => $args{logger},
procs => +{}, # pid file name => proc obj
counter => 0,
prev_stat => undef,
stat => ProcStat::Stat->new(),
}, $class;
}
sub logger { shift->{logger} }
sub stat { shift->{stat} }
sub run {
my $self = shift;
while (1) {
my $result = $self->aggregate();
if ($self->{counter}++ % $self->{freq} == 0) {
$self->send($result);
}
Time::HiRes::sleep($self->{interval});
}
}
sub aggregate {
my $self = shift;
my $current = $self->stat->read;
if ($self->{prev}) {
my $child_mgr = ProcStat::ChildProcessManager->new;
my $elapsed = $current - $self->{prev};
my @proc_files = glob("$self->{pid_dir}/*.pid");
for my $proc_file (@proc_files) {
my $proc = ($self->{procs}->{$proc_file} //= ProcStat::Process->new($proc_file, $self->logger));
$proc->aggregate($elapsed, $child_mgr);
}
}
$self->{prev} = $current;
}
sub send {
my ($self) = @_;
$self->logger->infof("Sending information");
for my $proc (values %{$self->{procs}}) {
my $commify = sub {
local $_ = shift;
1 while s/^([-+]?\d+)(\d\d\d)/$1,$2/;
$_;
};
my $name = $proc->name;
my $pid = $proc->read_pid;
my $result = $proc->result;
my $user = sprintf '%.2f', $result->[0] * 100;
my $sys = sprintf '%.2f', $result->[1] * 100;
my $rchar = $commify->($result->[2]);
my $wchar = $commify->($result->[3]);
my $read_bytes = $commify->($result->[4]);
my $write_bytes = $commify->($result->[5]);
my $pss = $commify->($result->[6]);
printf("%-10d %-10s %6s %6s %15s %15s %15s %15s %15s [kb]\n", $pid, $name, $user, $sys, $rchar, $wchar, $read_bytes, $write_bytes, $pss);
$proc->clear_history;
}
}
}
my $interval = 1.0;
my $freq = 60;
GetOptions(
'pid-dir=s' => \my $pid_dir,
'interval=i' => \$interval,
'f|freq=i' => \$freq,
'd|debug!' => \my $debug,
'q|quiet!' => \my $quiet,
);
$pid_dir // pod2usage();
ProcStat->new(
pid_dir => $pid_dir,
interval => $interval,
freq => $freq,
logger => ProcStat::Logger->new(
$debug ? 'debug' : ($quiet ? 'warn' : 'info'),
),
)->run;
__END__
=head1 SYNOPSIS
procstatd - Read process status. And send it to mackerel.
=head1 DESCRIPTION