gistfile1.pl

#!/usr/bin/env perl
# findswappers --- A script that identifies swapped processes
# Copyright (C) 2013  Eric MSP Veith <eveith@gnyu-linux.org>
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or 
# without modification, are permitted provided that the following 
# conditions are met:
#
# 1. Redistributions of source code must retain the above 
# copyright notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above 
# copyright notice, this list of conditions and the following disclaimer 
# in the documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.


use strict;
use warnings;

use IO::File;
use File::Spec;
use Data::Dumper;


# Color codes:

my $COLOR_RESET = "\e[0;37;40m";
my $COLOR_CYAN  = "\e[1;36;40m";
my $COLOR_WHITE = "\e[1;37;40m";
my $COLOR_GREEN = "\e[1;32;40m";
my $COLOR_YELLOW = "\e[1;33;40m";
my $COLOR_RED   = "\e[1;31;40m";


# Data variables:

my $sum_kb_swapped = 0;
my $sum_kb_swapspace = 0;
my @swappers;


### Reads all necessary information for a proc dir:
sub read_proc {
    my $dirname = shift;

    return undef unless($dirname && -d $dirname);

    # First, read swap values.

    my $process_overall = 0;
    
    my $smaps_fh = IO::File->new($dirname . '/smaps', 'r');
    while (<$smaps_fh>) {
        next unless(/^Swap:\s+(\d+) kB/);
        $process_overall += $1;
    }
    $smaps_fh->close;

    # Read statistics/filename:

    my @dirparts = File::Spec->splitdir($dirname);
    my $pid = $dirparts[-1];

    my $cmdline_fh = IO::File->new($dirname . '/cmdline', 'r');
    my @argv = split(/\0/, (<$cmdline_fh>));
    $cmdline_fh->close;

    return {
        pid     => $pid,
        argv    => \@argv,
        swap    => $process_overall
    };
}


# Collect all processes that actually swap:

foreach my $dir (</proc/*>) {
    next unless(-d $dir && $dir =~ /\d+$/);
    print "Reading " . $COLOR_CYAN . $dir . $COLOR_RESET . "...\r";
    
    my $proc_data = read_proc($dir);

    $sum_kb_swapped += $proc_data->{'swap'};
    push(@swappers, $proc_data) if ($proc_data->{'swap'} > 0);
}

# Sort processes by swap:

@swappers = sort({ $b->{'swap'} <=> $a->{'swap'} } @swappers);

# Read total swap space:

{
    my $swaps_fh = IO::File->new('/proc/swaps', 'r');
    while (<$swaps_fh>) {
        my @cols = split(/\s+/);
        $sum_kb_swapspace += $cols[2] if ($cols[2] =~ /^\d+$/);
    }
}

# Print total:

my $number_color = $COLOR_GREEN;
if ($sum_kb_swapped / $sum_kb_swapspace > 0.9) {
    $number_color = $COLOR_RED;
} elsif ($sum_kb_swapped > 0) {
    $number_color = $COLOR_YELLOW;
} else {
    $number_color = $COLOR_GREEN;
}

printf(
        $COLOR_RESET . "A total of " .
            $number_color . "%i kB" . $COLOR_RESET . 
            ' (' . 
            $number_color . "%i\%" . $COLOR_RESET .
            ') ' .
            "is swapped.\n",
        $sum_kb_swapped,
        ($sum_kb_swapped / $sum_kb_swapspace * 100.0));

# Print swappers:

my $number_length = length($sum_kb_swapped);
foreach my $swapper (@swappers) {
    my @argv = @{ $swapper->{'argv'} };

    printf(
            $COLOR_WHITE . "%" . $number_length . "i kB" .
                $COLOR_RESET . "\t" . $COLOR_CYAN . "%s" .
                $COLOR_RESET . " %s\n",
            $swapper->{'swap'},
            $argv[0],
            join(' ', @argv[1 .. $#argv]));
}