tokuhirom's blog

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


Created: 2017-03-12 04:26:27 +0000
Updated: 2017-03-12 04:26:27 +0000