system("/bin/rm $lock_file");
[download]

unlink($lock_file);
[download]

One algorithmic problem with your lockfile approach is that if your process dies (for whatever reason) without removing the lockfile all subsequent runs of the program will think there's already an instance running; even though there isn't.

one last thing.... use strict. Learn what it is and start using it. It will save you much pain as you continue to learn and use perl.

Good point on the algorithmic problem. I inherited that functionality from the previous script, thinking about duplicate processes not premature death. /me is reading up on strict. ty

Also, replace system touch.. with just

open DUH, ">/tmp/some.file";
close DUH;
[download]

And, you really don't want to use a sentinel file like that. See my Highlander - allow only one invocation at a time of an expensive CGI script as a model to use flock with a sentinel file.

-- Randal L. Schwartz, Perl hacker

Actually ">>/tmp/some.file" is better.

Opening the file by writing to it can lead to issues of people, waiting for your process to start, then placing a symlink to another file. It isn't easy and there is definitely an element of luck, but keep trying and you will hit it eventually. So create with an append, then test for the symlink if you are paranoid.

Incidentally another model to look at for sentinal files is Simple Locking.

I was wondering about that (">" vs. ">>"). I actually got to learn about the symbolic link problem in /tmp through someone else's misfortune. Thanks for the link on Simple locking too.

Thanks for advice on the private directory...and the replacements for the system calls. I think I'll devote some time to grok highlander...ty.

I thought about that too, why I was continuing to use the lock file that is. It was in the script I was trying to improve. I had asked someone familiar with the history of that script why it was being used, and they said somthing to the effect that at one time something prevented mailx from completing and reexecution of the script just caused more mailx instances and more script instances. But thinking about it as I type this, the $nlfile should prevent that problem from reoccuring, if it still exists. I will dig into Net::Ping, so many modules-so little time.=) Thanks for looking.

That's a very good point. Since most of the boxen I use are "open", I'd like to make my scripts user proof...to prevent them from being a sort of "attractive nusance". But I should certainly gather the info if a user does manage to impair the function of an admin script. I think in its current form I will be sent email from cron if something fails, but I might add something in the script to send info on directory/file ownership if it fails.

#!/usr/bin/perl -w
# Run this perl code from cron every 5 minutes
# 0,5,10,15,20,25,30,35,40,45,50,55 * * * * /.ping_hosts.pl 2>&1 
#

use strict;
use Net::Ping;
my $private_dir = "/tmp/ping_hosts_dir";

sub check_private_dir {
    unless (-e $private_dir){ mkdir($private_dir, 0700) or die "Can't 
+mkdir $private_dir\n" }
    if (-d $private_dir) {  
        my $dec_mode = (stat($private_dir))[2];
        my $oct_mode = sprintf "%lo", $dec_mode;
        if (-O $private_dir and ($oct_mode == 40700)) { return }
        elsif (-O $private_dir and ($oct_mode != 40700)) { 
            chmod(0700, $private_dir);
            return;
        }
        else { die "We don't own the directory\n" }
    }
    else { die "$private_dir exists and is not a directory\n"; }
}

sub ping_hosts {
    my $ws;
    my $timeout = 2;
    my @hosts = qw(host1 host2 host3 host4); 
    my $ping_obj = Net::Ping->new("icmp");
    foreach $ws (@hosts) {
        unless ($ping_obj->ping($ws, $timeout)) {
            print "$ws did not respond to ping within the $timeout sec
+ond timeout period\n";
            notify_admins($ws);
        }
        sleep(1); # To prevent flooding
    }
    $ping_obj->close(); # Redundant since open network conn is auto-cl
+osed when leaving sub
}

sub notify_admins { # Called from ping_hosts()
    my $ws = shift(@_);
    my $nfile = "${ws}.notify";
    my $admins = "admin1\@mailhost.com, " .
                "18005551212\@page.com, " .
                "admin2\@mailhost.com, " .
                "19005551212\@page.com";
    unless (-e "${private_dir}/${nfile}") {
        open(NOTIFY, ">>${private_dir}/${nfile}") or die "Can't create
+ notify file\n";
        close(NOTIFY);
        open(MAIL, "|mailx $admins") or die "Can't fork for mailx: $!\
+n";
        print MAIL "$ws doesn't respond to ping\n";
        close(MAIL);
    }    
}

### MAIN ###
check_private_dir();
ping_hosts();
[download]

This code scares me a bit:

        my $oct_mode = sprintf "%lo", $dec_mode; 
        if (-O $private_dir and ($oct_mode == 40700)) { return } 
        elsif (-O $private_dir and ($oct_mode != 40700)) {
[download]

You are probably lucky that 40,700 decimal is a nice integer value. Why not leave it at octal?

    if (-O $private_dir and ($dec_mode == 040700)) { return }
    elsif (-O $private_dir) {
[download]

And that value isn't really a "decimal" mode. It's the value of "the mode", which usually prints out as decimal. Internally, it's binary, unless you have a BCD-coded machine (not likely {grin}).

The other scary code here is your use of mailx. While the content of your message cannot possibly contain a line that begins with tilde, you might get complacent some day and permit such a line, and then you can say buh-bye to security. Get in the right groove by looking at Mail::Mailer pretty durn quick.

-- Randal L. Schwartz, Perl hacker

So, what you are trying to say is that perl stores the value that stat returns as a binary, but when I printed it out perl converted it to decimal. OK I think I got that now, but this other bit of code you left, I'm not sure I fully understand. Is that leading character a zero in 040700 and if so what does it do? presumably it causes an octal comparison? I guess where I got the code I came up with was by

 
mkdir($private_dir, 0700);
$mode = (stat($private_dir))[2];
print "stat[2] returned $mode for a value\n"
[download]

the value returned was 16832 which clearly wasn't an octal value. Could you explain to me a little bit about arbitrary base comparisons? I can't find any examples that I recognise. Also thank you for the bit o' wisdom on mailx, I didn't know it had that vunerability(sp).

#!/usr/bin/perl -w
# Run this perl code from cron every 5 minutes
# Output from 'print' and 'die' will be sent to owner of the cron proc
+ess by cron.

use strict;
use Net::Ping;
use Net::SMTP;

my $private_dir = "/tmp/ping_hosts_dir";

sub check_private_dir { # Used to prevent notify files from being crea
+ted by non-superusers
    unless (-e $private_dir){ mkdir($private_dir, 0700) or die "Can't 
+mkdir $private_dir\n" }
    if (-d $private_dir) {  
        my $mode = (stat($private_dir))[2];
        if (-O $private_dir and ($mode == 040700)) { return }
        elsif (-O $private_dir and ($mode != 040700)) { 
            chmod(0700, $private_dir);
            return;
        }
        else { die "We don't own $private_dir\n" }
    }
    else { die "$private_dir exists and is not a directory\n"; }
}

sub ping_hosts {
    my $ws;
    my $alive;
    my $count;
    my $timeout = 3;
    my @hosts = qw(host1 host2 host3 host4);
    
    # Following uses perl module Net::Ping to prevent spawning externa
+l process 
    my $ping_obj = Net::Ping->new("icmp");
    foreach $ws (@hosts) {
        $alive = 0;
        $count = 5;
        while ($count > 0){
            $alive += $ping_obj->ping($ws, $timeout);
            last if ($alive);
            $count--;
        }
        unless (-e "${private_dir}/${ws}.notify") {
            unless ($alive) {
                print "$ws did not respond to ping\n";
                notify_admins($ws, "is_down");
            }
        }
        elsif ($alive) {
                print "$ws is back up\n";
                notify_admins($ws, "is_up");
        }
        sleep(1); # To prevent flooding
    }
    $ping_obj->close(); # Redundant since open network conn is auto-cl
+osed when leaving sub
}

sub notify_admins { # Called from ping_hosts() with host and changed s
+tatus as arg
    my $ws = shift(@_);
    my $state = shift(@_);
    my $nfile = "${private_dir}/${ws}.notify";
    my @admins = qw(8005551212@page.metrocall.com 8885551212@page.metr
+ocall.com);
    my $message;

    if ( "$state" eq "is_down" ) {
        # Following replaces system(touch $nfile) to prevent spawning 
+external process
        open(NOTIFY, ">>$nfile") or die "Can't create notify file\n";
        close(NOTIFY);
        $message = "$ws does not respond to ping\n";
    }
    else {
        unlink ($nfile);
        $message = "$ws is back up\n";
    }

    # Following replaces forking mailx to prevent spawning external pr
+ocess 
    # Note: Net::SMTP, part of the libnet collection of modules is not
+ part of standard pkg
    my $smtp = Net::SMTP->new('mailhost', HELLO => 'corp.com') or die 
+"Can't connect to mailhost for SMTP\n";
    #$smtp->mail($ENV{USER}.'@corp.com');
    $smtp->mail('root@corp.com');
    $smtp->to(@admins);
    $smtp->data($message);
    $smtp->quit;
}

### MAIN ###
check_private_dir();
# Use $private_dir/hold.notify as a way of disabling notification durr
+ing controlled reboots
ping_hosts() unless (-e "$private_dir/hold.notify");
[download]