Skip to content

Instantly share code, notes, and snippets.

@goyalankit

goyalankit/t.pl

Created Feb 9, 2018
Embed
What would you like to do?
#!/usr/bin/perl
# Copyright Ben Maurer
# you can distribute this under the MIT/X11 License
my $pid=shift @ARGV;
unless ($pid) {
print "./smem.pl <pid>\n";
exit 1;
}
my $map=Linux::Smaps->new($pid);
my @VMAs = $map->vmas;
format STDOUT =
VMSIZE: @######## kb
$map->size
RSS: @######## kb total
$map->rss
@######## kb shared
$map->shared_clean + $map->shared_dirty
@######## kb private clean
$map->private_clean
@######## kb private dirty
$map->private_dirty
.
write;
printPrivateMappings ();
printSharedMappings ();
sub sharedMappings () {
return grep { ($_->shared_clean + $_->shared_dirty) > 0 } @VMAs;
}
sub privateMappings () {
return grep { ($_->private_clean + $_->private_dirty) > 0 } @VMAs;
}
sub printPrivateMappings ()
{
$TYPE = "PRIVATE MAPPINGS";
$^ = 'SECTION_HEADER';
$~ = 'SECTION_ITEM';
$- = 0;
$= = 100000000;
foreach $vma (sort {-($a->private_dirty <=> $b->private_dirty)} privateMappings ()) {
$size = $vma->size;
$dirty = $vma->private_dirty;
$clean = $vma->private_clean;
$file = $vma->file_name;
write;
}
}
sub printSharedMappings ()
{
$TYPE = "SHARED MAPPINGS";
$^ = 'SECTION_HEADER';
$~ = 'SECTION_ITEM';
$- = 0;
$= = 100000000;
foreach $vma (sort {-(($a->shared_clean + $a->shared_dirty)
<=>
($b->shared_clean + $b->shared_dirty))}
sharedMappings ()) {
$size = $vma->size;
$dirty = $vma->shared_dirty;
$clean = $vma->shared_clean;
$file = $vma->file_name;
write;
}
}
format SECTION_HEADER =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$TYPE
@>>>>>>>>>> @>>>>>>>>>> @>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
"vmsize", "rss clean", "rss dirty", "file"
.
format SECTION_ITEM =
@####### kb @####### kb @####### kb @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$size, $clean, $dirty, $file
.
package Linux::Smaps;
use 5.008;
use strict;
use warnings FATAL=>'all';
no warnings qw(uninitialized portable);
use Errno qw/EACCES/;
my $min_vma_off;
BEGIN {
package Linux::Smaps::VMA;
use strict;
BEGIN {
our @attributes=qw(vma_start vma_end r w x mayshare file_off
dev_major dev_minor inode file_name is_deleted _line);
# it seems a bit faster (~4%) if _line is placed at the end of
# @attributes.
my $line_idx=$#attributes;
our %attributes;
for( my $i=0; $i<@attributes; $i++ ) {
no strict 'refs';
my $n=$i;
*{__PACKAGE__.'::'.$attributes[$n]}=
$attributes{$attributes[$n]}=
sub : lvalue {
my $I=$_[0];
if( @_>1 ) {
$I->[$n]=$_[1];
} elsif( defined($I->[$n]) || !defined($I->[$line_idx]) ) {
$I->[$n];
} else {
$I->_parse if defined $I->[$line_idx];
$I->[$n];
}
};
my $const=sub () {$n};
*{__PACKAGE__.'::V_'.$attributes[$n]}=$const;
*{'Linux::Smaps::V_'.$attributes[$n]}=$const;
$Linux::Smaps::VMA::attr_idx{$attributes[$n]}=$n;
}
$min_vma_off=@attributes;
our %special=
(
vmflags=>sub {my @l=split /\s+/, $_[0]; shift @l; \@l},
);
our @special;
}
sub new {bless [@_[1..$#_]]=>(ref $_[0] ? ref $_[0] : $_[0])}
sub _parse {
my ($I)=@_;
@{$I}[V_vma_start..V_is_deleted]=(hex($1), hex($2), ($3 eq 'r'),
($4 eq 'w'), ($5 eq 'x'), ($6 eq 's'),
hex($7), hex($8), hex($9), $10, $11,
defined($12))
if $I->[V__line]=~/^
([\da-f]+)-([\da-f]+)\s # range
([r\-])([w\-])([x\-])([sp])\s # access mode
([\da-f]+)\s # page offset in file
([\da-f]+):([\da-f]+)\s # device
(\d+)\s* # inode
(.*?) # file name
(\s\(deleted\))? # is deleted?
$
/xi;
undef $I->[V__line]; # eval it only once
return;
}
}
BEGIN {
our @attributes=qw{pid lasterror filename procdir _elem};
our %attributes;
for( my $i=0; $i<@attributes; $i++ ) {
my $n=$i;
die "Internal Error" # should not happen
if exists $Linux::Smaps::VMA::attributes{$attributes[$n]};
no strict 'refs';
*{__PACKAGE__.'::'.$attributes[$n]}=
$attributes{$attributes[$n]}=
sub : lvalue {@_>1 ? $_[0]->[$n]=$_[1] : $_[0]->[$n]};
*{__PACKAGE__.'::M_'.$attributes[$n]}=sub () {$n};
}
}
our $VERSION = '0.11';
sub new {
my $class=shift;
$class=ref($class) if( ref($class) );
my $I=bless []=>$class;
my %h;
$I->[M_procdir]='/proc';
$I->[M_pid]='self';
if( @_==1 ) {
$I->[M_pid]=shift;
} else {
our @attributes;
our %attributes;
%h=@_;
foreach my $k (@attributes) {
$attributes{$k}->($I, $h{$k}) if exists $h{$k};
}
}
return $I if( $h{uninitialized} );
my $rc=$I->update;
die __PACKAGE__.": ".$I->[M_lasterror]."\n" unless( $rc );
return $rc;
}
sub clear_refs {
my ($I)=@_;
my $name=$I->[M_procdir].'/'.$I->[M_pid].'/clear_refs';
open my $f, '>', $name or do {
$I->[M_lasterror]="Cannot open $name: $!";
return;
};
print $f "1\n";
close $f;
return $I;
}
my ($cnt1, $fmt1)=(0);
sub update {
my ($I)=@_;
my $name;
# this way one can use one object to loop through a list of processes like:
# foreach (@pids) {
# $smaps->pid=$_; $smaps->update;
# process($smaps);
# }
if( defined $I->[M_filename] ) {
$name=$I->[M_filename];
} else {
$name=$I->[M_procdir].'/'.$I->[M_pid].'/smaps';
}
# Normally, access permissions for a file are checked when it is opened.
# /proc/PID/smaps is different. Here permissions are checked by the read
# syscall.
open my $f, '<', $name or do {
$I->[M_lasterror]="Cannot open $name: $!";
return;
};
my $current;
$I->[M__elem]=[];
my %cache;
my ($l, $tmp, $m);
my $current_off=@Linux::Smaps::VMA::attributes;
$!=0;
while( defined($l=<$f>) ) {
if( $current_off<@Linux::Smaps::VMA::attributes ) {
if( $tmp=$Linux::Smaps::VMA::special[$current_off] ) {
$current->[$current_off++]=$tmp->($l);
} else {
no warnings qw(numeric);
$current->[$current_off++]=0+(unpack $fmt1, $l)[0];
}
} elsif( $l=~/^(\w+):\s*(\d+) kB$/ ) {
$m=lc $1;
if( exists $Linux::Smaps::VMA::attributes{$m} ) {
$I->[M_lasterror]="Linux::Smaps::VMA::$m method is already defined";
return;
}
if( exists $Linux::Smaps::attributes{$m} ) {
$I->[M_lasterror]="Linux::Smaps::$m method is already defined";
return;
}
$current->[$current_off++]=0+$2;
push @Linux::Smaps::VMA::attributes, $m;
{
no strict 'refs';
my $n=$#Linux::Smaps::VMA::attributes;
*{'Linux::Smaps::VMA::'.$m}=
$Linux::Smaps::VMA::attributes{$m}=
sub : lvalue {@_>1 ? $_[0]->[$n]=$_[1] : $_[0]->[$n]};
$Linux::Smaps::VMA::attr_idx{$m}=$n;
}
{
no strict 'refs';
my $attr_nr=$#Linux::Smaps::VMA::attributes;
*{__PACKAGE__."::$m"}=$Linux::Smaps::attributes{$m}=sub {
my ($I, $n)=@_;
my $rc=0;
foreach my $el (length $n
? grep(
{
$_->_parse if(!defined($_->[V_file_name]) and
defined($_->[V__line]));
$_->[V_file_name] eq $n;
} @{$I->[M__elem]}
)
: @{$I->[M__elem]}) {
$rc+=$el->[$attr_nr];
}
return $rc;
};
}
if( length($m)>$cnt1 ) {
$cnt1=length($m);
$fmt1="x".($cnt1+1)."A*";
}
} elsif( $l=~/^(\w+):.+$/ and $tmp=$Linux::Smaps::VMA::special{$m=lc $1} ) {
if( exists $Linux::Smaps::VMA::attributes{$m} ) {
$I->[M_lasterror]="Linux::Smaps::VMA::$m method is already defined";
return;
}
$Linux::Smaps::VMA::special[$current_off]=$tmp;
$current->[$current_off++]=$tmp->($l);
push @Linux::Smaps::VMA::attributes, $m;
{
no strict 'refs';
my $n=$#Linux::Smaps::VMA::attributes;
*{'Linux::Smaps::VMA::'.$m}=
$Linux::Smaps::VMA::attributes{$m}=
sub : lvalue {@_>1 ? $_[0]->[$n]=$_[1] : $_[0]->[$n]};
$Linux::Smaps::VMA::attr_idx{$m}=$n;
}
} elsif( $l=~/^([\da-f]+-[\da-f]+)\s/i ) {
# the rest of the line is lazily parsed
@{$current=bless [], 'Linux::Smaps::VMA'}[V__line]=$l;
# use %cache to work around a bug in some implementations,
# VMAs may be reported twice.
push @{$I->[M__elem]}, $current unless $cache{$1}++;
$current_off=$min_vma_off;
} else {
$I->[M_lasterror]="$name($.): not parsed: $l";
return;
}
}
if( $!==EACCES and !defined $current ) {
$I->[M_lasterror]="$name: read failed: $!";
close $f;
return;
}
close $f;
return $I;
}
BEGIN {
foreach my $n (qw{heap stack vdso vsyscall}) {
no strict 'refs';
my $name=$n;
my $s="[$n]";
*{__PACKAGE__.'::'.$name}=sub {
foreach my $el (@{$_[0]->[M__elem]}) {
$el->_parse if !defined($el->[V_file_name]) and defined($el->[V__line]);
return $el if $s eq $el->[V_file_name];
}
};
}
}
sub unnamed {
my $I=shift;
if( wantarray ) {
return grep {
$_->_parse if !defined($_->[V_file_name]) and defined($_->[V__line]);
!length $_->[V_file_name];
} @{$I->[M__elem]};
} else {
my @idx=@Linux::Smaps::VMA::attr_idx{qw/size rss shared_clean shared_dirty
private_clean private_dirty/};
my $sum=Linux::Smaps::VMA->new((0)x@Linux::Smaps::VMA::attributes);
foreach my $el (@{$I->[M__elem]}) {
$el->_parse if !defined($el->[V_file_name]) and defined($el->[V__line]);
next if( length $el->[V_file_name] );
foreach my $idx (@idx) {$sum->[$idx]+=$el->[$idx]}
}
return $sum;
}
}
sub named {
my $I=shift;
if( wantarray ) {
return grep {
$_->_parse if !defined($_->[V_file_name]) and defined($_->[V__line]);
length $_->[V_file_name];
} @{$I->[M__elem]};
} else {
my @idx=@Linux::Smaps::VMA::attr_idx{qw/size rss shared_clean shared_dirty
private_clean private_dirty/};
my $sum=Linux::Smaps::VMA->new((0)x@Linux::Smaps::VMA::attributes);
foreach my $el (@{$I->[M__elem]}) {
$el->_parse if !defined($el->[V_file_name]) and defined($el->[V__line]);
next if( !length $el->[V_file_name] );
foreach my $idx (@idx) {$sum->[$idx]+=$el->[$idx]}
}
return $sum;
}
}
sub all {
my $I=shift;
if( wantarray ) {
return @{$I->[M__elem]};
} else {
my @idx=@Linux::Smaps::VMA::attr_idx{qw/size rss shared_clean shared_dirty
private_clean private_dirty/};
my $sum=Linux::Smaps::VMA->new((0)x@Linux::Smaps::VMA::attributes);
foreach my $el (@{$I->[M__elem]}) {
foreach my $idx (@idx) {$sum->[$idx]+=$el->[$idx]}
}
return $sum;
}
}
sub names {
my $I=shift;
local $_;
my %h;
undef @h{map {
$_->_parse if !defined($_->[V_file_name]) and defined($_->[V__line]);
$_->[V_file_name];
} @{$I->[M__elem]}};
delete @h{'',qw/[heap] [stack] [vdso] [vsyscall]/};
return keys %h;
}
sub diff {
my $I=shift;
my @my_special;
my @my=map {
$_->_parse if !defined($_->[V_file_name]) and defined($_->[V__line]);
if( $_->[V_file_name]=~/\[\w+\]/ ) {
push @my_special, $_;
();
} else {
$_;
}
} @{$I->[M__elem]};
my %other_special;
my %other=map {
$_->_parse if !defined($_->[V_file_name]) and defined($_->[V__line]);
if( $_->[V_file_name]=~/^(\[\w+\])$/ ) {
$other_special{$1}=$_;
();
} else {
($_->[V_vma_start]=>$_);
}
} @{shift->[M__elem]};
my @new;
my @diff;
my @old;
foreach my $vma (@my_special) {
if( exists $other_special{$vma->[V_file_name]} ) {
my $x=delete $other_special{$vma->[V_file_name]};
push @diff, [$vma, $x]
if( $vma->[V_vma_start] != $x->[V_vma_start] or
$vma->[V_vma_end] != $x->[V_vma_end] or
$vma->shared_clean != $x->shared_clean or
$vma->shared_dirty != $x->shared_dirty or
$vma->private_clean != $x->private_clean or
$vma->private_dirty != $x->private_dirty or
$vma->[V_dev_major] != $x->[V_dev_major] or
$vma->[V_dev_minor] != $x->[V_dev_minor] or
$vma->[V_r] != $x->[V_r] or
$vma->[V_w] != $x->[V_w] or
$vma->[V_x] != $x->[V_x] or
$vma->[V_file_off] != $x->[V_file_off] or
$vma->[V_inode] != $x->[V_inode] or
$vma->[V_mayshare] != $x->[V_mayshare] );
} else {
push @new, $vma;
}
}
@old=values %other_special;
foreach my $vma (@my) {
if( exists $other{$vma->[V_vma_start]} ) {
my $x=delete $other{$vma->[V_vma_start]};
push @diff, [$vma, $x]
if( $vma->[V_vma_end] != $x->[V_vma_end] or
$vma->shared_clean != $x->shared_clean or
$vma->shared_dirty != $x->shared_dirty or
$vma->private_clean != $x->private_clean or
$vma->private_dirty != $x->private_dirty or
$vma->[V_dev_major] != $x->[V_dev_major] or
$vma->[V_dev_minor] != $x->[V_dev_minor] or
$vma->[V_r] != $x->[V_r] or
$vma->[V_w] != $x->[V_w] or
$vma->[V_x] != $x->[V_x] or
$vma->[V_file_off] != $x->[V_file_off] or
$vma->[V_inode] != $x->[V_inode] or
$vma->[V_mayshare] != $x->[V_mayshare] or
$vma->[V_file_name] ne $x->[V_file_name] );
} else {
push @new, $vma;
}
}
push @old, sort {$a->[V_vma_start] <=> $b->[V_vma_start]} values %other;
return \@new, \@diff, \@old;
}
sub vmas {return @{$_[0]->_elem};}
{
my $once;
sub import {
my $class=shift;
unless( $once ) {
$once=1;
eval {$class->new(@_)};
}
}
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment