Category: perl

Get status of your servers with perl script.

Monitoring the servers could be well – “not difficult” but boring and monotonous. And since this is something that you should ideally do on daily basis, so why not have a script for the same.

You can’t possibly copy your ssh-keys to all the servers that you are monitoring, better if you can, then you need to do ssh to server with password. So, here is link to my github repo for monitoring servers with perl script. Preety straight forward script and you can schedule this in cron to get a daily mail.

Link to repo.

The script covers solaris and Linux ( i.e. Ubuntu/Fedora/Debian/ideally any distro)

Do let me know in comments, if you feel something is missnig.

Manage your servers the easy way with perl script over ssh with no remote client.

For a long time I have not posted any script. So, its not that I have not written anything new, but just that did not put them here in lack of time. So, here is one interesting one. The original idea came from one posted in one of the interesting blog here. But the problem with this one was that for every time, it ran in the cron, it would make multiple entries in the “last” output (about 10 or more with my modifications for differentiating between solaris and Linux). This is something which is not quite desirable. Hence I came up with this script which is based on html template and hence the output is also easier to manipulate. BTW, just the below script will not help, you would need to download the template files as well. In the list.txt file, you will have to put the usename, password and the server IP to monitor. The server could be any Linux or Solaris host.

list
Head
Tail
Template

You can get the files from https://github.com/raj77in/scripts/tree/master/server_status

#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Check the status of servers.
#Copyright (C) 2013 Amit Agarwal
#
#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
#
#
#-------------------------------------------------------------------------------

#===============================================================================
#
#         FILE: status.pl
#
#        USAGE: ./status.pl
#
#  DESCRIPTION: Check the status of servers.
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: ---
#       AUTHOR: Amit Agarwal(amit.agarwal@roamware.com)
# ORGANIZATION: Individual
#      VERSION: 1.0
#      CREATED: 05/02/2013 09:27:50 AM
#Last modified: Fri May 03, 2013  13:00PM
#     REVISION: ---
#===============================================================================
#
#

use strict;
use warnings;

#use Expect;
use Net::SSH::Perl;
use Data::Dumper;
use Net::Ping::External qw(ping);
use FindBin;

my $debug     = 0;
my $timeout   = 10;
my $GREEN     = '<font color="#00ff00">';
my $RED       = '<font color="#ff0000">';
my $NOC       = '</font>';
my $LOAD_WARN = 5.0;
my $PROC_WARN = 200;
my $DISK_WARN = 75;
my $RAM_WARN  = 40;
my $dir       = $FindBin::Bin;
my $listfile  = "$dir/list.txt";
#print "List file is $listfile n";

# Taken from http://stackoverflow.com/questions/4809728/perl-can-i-get-paths-related-to-where-a-script-resides-and-where-it-was-execut
# but FindBin seems to be better at doing this and hence not used.
sub find_currentDir {
    print "PWD: $ENV{PWD}n";
    print "$0: $0n";

    my $bin = $0;
    my $bin_path;

    $bin =~ s#^./##;                           # removing leading ./ (if any)

    # executed from working directory
    if ( $bin !~ m#^/|../# ) {
        $bin_path = "$ENV{PWD}/$bin";
    }

    # executed with full path name
    elsif ( $bin =~ m#^/# ) {
        $bin_path = $0;
    }

    # executed from relative path
    else {
        my @bin_path  = split m#/#, $bin;
        my @full_path = split m#/#, $ENV{PWD};

        for (@bin_path) {
            next if $_ eq ".";
            ( $_ eq ".." ) ? pop @full_path : push @full_path, $_;
        }
        $bin_path = join( "/", @full_path );
    }

    print "Script Path: $bin_pathn";
    return $bin_path;
}                                               ## --- end sub find_currentDir

open( FILE, "<$listfile" );
print "Reading the list of servers from list.txtn" if $debug;
my @AServerList = <FILE>;
my @ServerList = grep { $_ !~ /^#/ } @AServerList;
close(FILE);
print Dumper @ServerList if $debug;
my @cmds = (
    'ruptime=$(uptime);
    if $(echo $ruptime | egrep -v  "day" >/dev/null); then
    echo $ruptime | sed s/,//g| awk '{ print $3 "(hh:mm)"}'
    else
    echo $ruptime | awk '{ print $3 " days " $5 "(HH:MM)"}'
    fi',
    q( free -mto | grep Mem: | awk '{ print $2"," $3"," $4}'
),

    #'df -kh | egrep -v "^Filesystem|shm|tmpfs"| awk 'BEGIN{print "<ul>"}{w=sprintf("%d",$6);print " <li>" $5" - "$7  " " $6  "(" $2 ")" $4"/"$3 "</li>"}END{ print "</ul> "}'',
    'df -kh | egrep -v "^Filesystem|shm|tmpfs"',
    'ps -eaf | egrep -v "^USER|grep|ps" | wc -l',
);

use HTML::Template;
my $now = localtime;
my $template = HTML::Template->new( filename => "$dir/head.tmpl" );
$template->param( date => `date` );
print 'From: Amit-status<amit.agarwal@roamware.com>
To: amit.agarwal@roamware.com
Subject: Stuatus of the servers ';
print "$now n";

print "Content-Type: text/htmlnn", $template->output;
foreach (@ServerList) {
    print STDERR "Going for $_" if $debug;
    $template = HTML::Template->new( filename => "$dir/html.tmpl" );
    chomp;
    ( my $user, my $password, my $host ) = split / /;
    my $cmd = "";

    #ping
    my $alive = ping( host => "$host" );
    if ( !$alive ) {
        print "Return value from ping is $?n" if $debug;
        print "Ping failedn"                  if $debug;
        $template->param( hostip => $host );
        $template->param( pingst => "$RED Failed $NOC" );
        print $template->output;
        next;
    }
    else {
        $template->param( pingst => "$GREEN Ok $NOC" );
    }

    print "Getting details for server $_n"    if $debug;
    print "Using the params for ssh - $hostn" if $debug;
    $cmd = "ssh $host";
    my $ssh = Net::SSH::Perl->new( $host, debug => 0 ) or next;
    $ssh->login( $user, $password );

    #my $read = $exp->exp_before();
    #chomp $read;
    #print "Data receeived n" if $debug;
    #print Dumper($read) if $debug;

    #my $out=$exp->send( "ls -lar");
    #print Dumper $out if $debug;
    #
    my ( $read, $out, $err ) = $ssh->cmd("uname");
    if ( $read =~ /SunOS/ ) {

        #$cmds[0]="uptime";
        $cmds[1] = q(/usr/sbin/swap -s|sed 's/k / /g'|awk '{ print ($9+$11)"," $2 "," $11 }');
        $cmds[2] = 'df -hk -F ufs | egrep -v "^Filesystem|shm"';
        print "This is solaris hostn" if $debug;
        $template->param( osname => "SunOS" );
    }
    else {
        print "OS is $readn" if $debug;
        $template->param( osname => "$read" );
    }

    ( $read, $out, $err ) = $ssh->cmd("hostname");
    chomp $read;
    $read = substr( $read, 0, 7 );

    $template->param( hostname => $read );
    $template->param( hostip   => $host );

    ( $read, $out, $err ) = $ssh->cmd("daten");
    chomp $read;
    $template->param( date => $read );

    #uptime
    ( $read, $out, $err ) = $ssh->cmd("$cmds[0]|sed 's/,//'n");
    chomp $read;
    print "Executing $cmds[0]n" if $debug;
    print "Output is -- $readn" if $debug;
    $template->param( uptime => $read );

    # Load averavge
    $cmd = q(uptime |sed 's/.*average://'|sed 's/,/ /g'|sed 's/^ //g');
    ( $read, $out, $err ) = $ssh->cmd("$cmdn");
    chomp $read;
    print "Loadavg - Output is --$read--n" if $debug;
    my @loads = split( / +/, $read );
    print Dumper @loads if $debug;
    if ( $loads[0] >= $LOAD_WARN ) {
        $template->param( loadavg => "$RED $loads[0]/$loads[1]/$loads[2] (High) $NOCn" );
    }
    else {
        $template->param( loadavg => "$GREEN $loads[0]/$loads[1]/$loads[2] (Ok) $NOCn" );
    }

    #Running Processes
    print "Executing $cmds[3]n" if $debug;
    ( $read, $out, $err ) = $ssh->cmd("$cmds[3]n");
    chomp $read;
    if ( $read <= $PROC_WARN ) {
        $template->param( runningProcs => "$GREEN $read (Ok) $NOC" );
    }
    else {
        $template->param( runningProcs => "$RED $read (High) $NOC" );

    }

    # Disk usage
    print "Executing $cmds[2]n" if $debug;
    ( $read, $out, $err ) = $ssh->cmd("$cmds[2]n");
    if ( defined $read and $read !~ /^$/ ) {
        chomp $read;
        my @disks = split( /n/, $read );
        my $disk = "";
        foreach (@disks) {
            my @parts = split / +/;
            print Dumper @parts if $debug;
            print "OUTPUT :: $_n" if $debug;
            $parts[4] =~ s/%//;
            if ( $parts[4] <= $DISK_WARN ) {
                $disk = "$diskn<li>$GREEN $parts[5] - Total($parts[1]) - $parts[4]%$NOC</li>";
            }
            else {
                $disk = "$diskn<li>$RED $parts[5] - Total($parts[1]) - $parts[4]%$NOC</li>";
            }
        }
        $template->param( diskst => "$disk" );
    }

    # Total users
    $cmd = q(who |awk '{print $1}'|sort |uniq -c|sort -nr |tr 'n' ',' );
    ( $read, $out, $err ) = $ssh->cmd("$cmdn");
    if ( defined $read and $read !~ /^$/ ) {
        chomp $read;
        print "Output for total users - $read- n" if $debug;
        $template->param( usertot => "$read" );
    }

    #Last log
    $cmd = q(last|head -5);
    ( $read, $out, $err ) = $ssh->cmd("$cmdn");
    print "Output for last  - $read- n" if $debug;
    my $lastst = "";
    foreach ( split /n/, $read ) {
        $lastst = "<li>$_</li>n$lastst";
    }
    $template->param( lastst => "$lastst" );

    #RAM Usage
    print "Executing $cmds[1]n" if $debug;
    ( $read, $out, $err ) = $ssh->cmd("$cmds[1]n");
    if ( defined $read and $read !~ /^$/ ) {
        my @parts = split( /,/, $read );
        my $post  = "Kb";
        my $pert  = $parts[1] / $parts[0] * 100;
        for ( my $i = 0; $i <= 2; $i++ ) {
            if ( $parts[$i] > 1024 ) { $parts[$i] /= 1024; $post = "Kb"; }
            if ( $parts[$i] > 1024 ) { $parts[$i] /= 1024; $post = "Gb"; }
            $parts[$i] = sprintf( "%.3f %s", $parts[$i], $post );
        }
        print "Total = $parts[0], used =$parts[1], percentage = $pert%n" if $debug;
        $pert = sprintf( "%.2f", $pert );
        print "Total = $parts[0], used =$parts[1], percentage = $pert%n" if $debug;
        print Dumper @parts                                               if $debug;
        print "Output for last  - $read- n"                              if $debug;
        if ( $pert > $RAM_WARN ) {
            $read = sprintf("$RED Total - $parts[0] - Used - $pert%% $NOCn");
        }
        else {
            $read = sprintf("$GREEN Total - $parts[0] - Used - $pert%% $NOCn");
        }
        $template->param( ramst => "$read" );
    }
    print $template->output;
    undef $ssh;

}

$template = HTML::Template->new( filename => "$dir/tail.tmpl" );
print $template->output;
Enhanced by Zemanta

perl is faster than bash in some cases.

Some days back, I had to generate some data to be uploaded to a database. As usual I assumed that bash should be faster and hence wrote the script to create the files in bash. But I found that even after 5 hours I was only 10% done with the data generation. Now that would mean that it would take around 50 hours to complete the data generation. Something did not look correct to me and I asked one of my colleague. He suggested I do a strace.

A quick strace command on the PID was shocking but very clear on what was happening.

1
strace  -p &lt;PID&gt;

Here’s a explanation of what was happening:

We saw that for every write there was

write(1, “a\n”, 2)                      = 2
dup2(10, 1)                             = 1
fcntl64(10, F_GETFD)                    = 0x1 (flags FD_CLOEXEC)
close(10)                               = 0

We knew that these are very costly calls for CPU and immediately understood what we should do. What was actually happening was that for each of the echo command the FD was being opened, file appended and then FD closed. This made it very clear why the script was running so slow. So, I quickly did some test to very that this will fix the issue I was facing.

I wrote one bash and one perl script to test this and did the time on these. Here are the programs and the output of time on them.

1
2
3
4
5
echo a > test
echo a > test
echo a > test
echo a > test
echo a > test

time output:

real    0m0.020s
user    0m0.004s
sys    0m0.005s

1
2
3
4
5
6
7
open FILE, "&gt;test";
print FILE "test";
print FILE "test";
print FILE "test";
print FILE "test";
print FILE "test";
close FILE;

time output:

real    0m0.035s
user    0m0.001s
sys    0m0.008s

one more test to confirm the result

1
2
3
4
5
echo a >> test
echo a >> test
echo a >> test
echo a >> test
echo a >> test

time output:

real    0m0.018s
user    0m0.006s
sys    0m0.003s

As you can see the perl script took a lot lesser user time on the CPU and that is because the file was opened only once and then once all the output was written to the file, the file was closed so file operations in perl are much less than that in the similar bash script. The time taken in the bash script can be decreased drastically if we use open in the bash script also. So, the lesson that I learned was if there are some operations that you can remove from your script, even if they do not seem to be serious issue in the begining, you can improve the performance greatly.

Enhanced by Zemanta