How do I check a webserver's availabilty via script

I have a PERL script that I pulled off of a website (freeware) that I would like to modify, however I know zero about PERL programming.  The script runs a test to see if a webserver and/or smtp server is up.  I would like to modify it to also check for a webserver on an alternate port (i.e. 8080).

Other pertinent info: there is a file "urls2.txt" that has the listing of urls to check (you can have the script check and return results from any number of servers).

I have included the code below and attached the txt files that came with the program, that support it.  Also, if somebody has a better way to tackle the problem.  I don't mind starting over.

Thanks so much for assisting me with this.  I really appreciate it.

Chris    :-)
#!/usr/bin/perl -w
# PLEASE READ THE ENTIRE README.txt FILE FIRST!
# THIS FILE IS FROM checkwebsite.org - please check for updates.
use warnings;
use strict;
use Tie::File;
use Net::SMTP;
use LWP::UserAgent;
 
#################################################################
#             Program  Settings
#
my $error_log  = 'Responser_errors.txt';  # File to store errors of program
my $input_file = 'urls2.txt';             # From where program will read WEB Addresses
my $smtp_file  = 'SMTP_Settings.txt';     # File for SMTP Settings
my $send_mail  = 1;                       # my $send_mail  = 1; ->SMTP option is ON,
                                          # my $send_mail  = 0; ->SMTP option is OFF
##################################################################
#                      END OF SETTINGS
# Do not edit bellow if you dont understand it.
##################################################################
die "File $input_file is not exist\n" unless (-e $input_file);
die "SMTP is ON, but file $smtp_file is not exist\n" unless (-e $smtp_file);
my @hostInfo;
my $localtime = localtime;
our @errors;
my ($day,$month,$date,$hour,$year) = split /\s+/,scalar localtime;
my $output_file = 'report-'.$date.'.'.$month.'.'.$year.'.txt';
my ($smtp_host,$recipient,$reverse_path, @all_addr) = ();
tie @all_addr, 'Tie::File', $input_file or error("Cant open $input_file to read addresses");
if (-e $output_file) {
   open(OUT,">> $output_file") or error("Cant open exist file $output_file for append");
} else {
   open(OUT,"> $output_file") or error("Cant open new file $output_file for writting");
}
my @smtp_settings;
if ($^O =~ /win/i) {
        tie @smtp_settings, 'Tie::File', $smtp_file,, recsep => "\012" or error("Cant open $smtp_file to read SMTP settings");
} else {
tie @smtp_settings, 'Tie::File', $smtp_file,autochomp => '0'                  or error("Cant open $smtp_file to read SMTP settings");
}
for (@smtp_settings) {
   chomp;
   next if /^#/;
   next if /^$/;
 if (/^(\w+)\s=\s'(\S+)'/) {
   $smtp_host     = $2 if ($1 eq 'SMTPHost');
   $recipient     = $2 if ($1 eq 'Recipient');
   $reverse_path  = $2 if ($1 eq 'Reverse');
 }
}
print OUT "\n+" .('-' x 84) . "+\n";
print OUT   "|", ' ' x 30,"Time: $hour",' ' x 40,"|\n";
print OUT   "|",' 'x 10,'HOST',' ' x 37,'STATUS',' ' x 7,"RESPONSE            |\n";
print OUT   "+" .('-' x 84) . "+\n";
for (0 .. $#all_addr) {
 
 
 chop $all_addr[$_] if ($all_addr[$_] =~ /\s+$/);
 next if ($all_addr[$_] =~ /^#/ ); # ignore comments and
 next if ($all_addr[$_] =~ /^$/ ); # empty lines
 
 @hostInfo = split(/\t/, $all_addr[$_]);
 if ($hostInfo[0] =~ /^http:\/\/\S+\.\w{2,4}$/) {  #address will beginnig with "http://", next some string
                                                    # finish with point and 2 to 4 letters
   check_url(@hostInfo);    #call subroutine check_url()
 } 
 elsif ($hostInfo[0] =~ /^smtp:\S+\.\w{2,4}$/) {  #address will beginnig with "smtp:" ,next some string
                                                    # finish with point and 2 to 4 letters
   check_smtp(@hostInfo);    #call subroutine check_smtp()
 }
 else {
   my $out_format = sprintf "| %-50.50s %-10s  %-20s|\n", $hostInfo[0], "WRONG", "N/A";
   printf OUT $out_format;
   printf $out_format;
         push @errors, "$hostInfo[0] is WRONG Address.";
 }
}
 
my $err = join "\015\012",@errors;
my $err_num = scalar @errors;  # How match DOWN + WRONG Sites have
$send_mail = 0 unless $err_num;
untie @all_addr or error("Unable to close file $input_file");
if ($send_mail) {
 my $smtp = Net::SMTP->new($smtp_host,
                           -Debug=>1,
                           -Timeout=>20,
                           -Hello=>"$smtp_host") or error("Cant connect to $smtp_host");
# Begin Compare mail message
my $msg = <<__END_OF_MAIL__;
To: $recipient
Subject: $err_num Error Sites | $localtime .
$localtime
$err
 
__END_OF_MAIL__
# End Compare
 
 $smtp->mail("$reverse_path") or error("Failed to specify a reverse-path");#  If all is OK
 $smtp->to($recipient) or error("Failed to specify a recipient");          #  that will
 $smtp->data([$msg]) or error("Failed to send a message");                 #  send mail
 $smtp->quit or error("Failed to quit");                                   #  to You
} else {
  print "Send Mail is OFF\n" if $err_num;          # If you do not wish to receive mail
}
 
close OUT or error("Unable to close file $output_file");
print "\nProcess FINISH\n";
 
 
sub check_url {  # subroutine who check given URL
        (my $target, my $response_slow, my $response_timeout)  = @_;
	
        my $ua = LWP::UserAgent->new;
        $ua->agent("$0/0.1 " . $ua->agent);
        $ua->timeout($response_timeout); # connection timeout
        my $req = HTTP::Request->new(GET => "$target");
        $req->header('Accept' => 'text/html');          #Accept HTML Page
        # send request
        my $start = time;      # Start timer
        my $res = $ua->request($req);
        # check the outcome
        if ($res->is_success) {# Success....all content of page has been received
		my $time = time;     # End timer
		$time = ($time - $start); # Result of timer
		running_message("web", $target, $time, $response_slow);
        } else {
		# Error .... Site is DOWN and script send e-mail to you..
		down_message("web", $target);
    	}
}
 
sub check_smtp { #subroutine to check smtp servers
	(my $hostInfo, my $response_slow, my $response_timeout)  = @_;
 
	my @hostName = split(/:/, $hostInfo);
        my $target = $hostName[1];
 
	my $start = time;
	my $smtp = Net::SMTP->new($target,
                           -Debug=>1,
                           -Timeout=> $response_timeout,
                           -Hello=>"$target"); 
        if ($! == 0) {
          my $time = time; 
	  $time = ($time - $start); # Result of timer
	  running_message("mail", $target, $time, $response_slow);
	  $smtp->quit();
	} else {
	   down_message("mail", $target);
        }
	
}
 
sub running_message {
	(my $type, my $target, my $time, my $response_slow) = @_;
	my $out_format;
 
	if ($response_slow && ($response_slow <= $time)) {
		push(@errors, "Slow response from ($type) $target\: $time seconds");
		$out_format = sprintf "| %-4s %-50.50s %-10s %-20s |\n", $type, $target, "SLOW", "Response $time seconds";
	} else {
		$out_format = sprintf "| %-4s %-50.50s %-10s %-20s |\n", $type, $target, "ACCESSED", "Response $time seconds";
	}
	print OUT $out_format; # write to file
	print $out_format;     # print to console
}
 
sub down_message {
	(my $type, my $target) = @_;
 
	my $out_format = sprintf "| %-4s %-50.50s %-10s %-20s |\n", $type, $target, "DOWN", " N/A";
	push(@errors, "($type) $target is DOWN.") or error("Cannot push error for DOWN");
	print OUT $out_format; # write to file
        print $out_format;     # print to console
}
 
sub error {      # subroutine who print in Error Log
  my $error_msg = shift;
  open ERR,">> $error_log" or die "Cannot open log file $error_log : $!\n";
  print ERR "$localtime\: $error_msg : $!\n";
  close ERR or die "Cannot close log file $error_log : $!\n";
}

Open in new window

urls2.txt
SMTP-Settings.txt
README2.txt
LVL 1
s1162282Asked:
Who is Participating?
 
Adam314Commented:
Even that check is un-necessary, if you assume the urls file will be correct... you really just need to check anything with http:// on the beginning.  Also, this is a good place for using something other than / as the qualifier, to make it easier to read.

if($hostInfo[0] =~ m|^http://|) {
  check_url(@hostInfo);    #call subroutine check_url()
} 

Open in new window

0
 
louislietaerCommented:
I think you dont have to change the .pl file only url.txt and smtp.txt.

Are your web and smtp sites accessible from internet ? if so send me th urls.

I will run the script from my computer and send you back the files
0
 
mrjoltcolaCommented:
Change this section starting at line 64. The author put a needless check into the URL pattern which limits the types of URL address you can specify. So make this change.

Then in your urls2.txt you can add urls like:

http://localhost
http://foo.com:8080



Change old code
 
 if ($hostInfo[0] =~ /^http:\/\/\S+\.\w{2,4}$/) {  #address will beginnig with "http://", next some string
                                                    # finish with point and 2 to 4 letters
   check_url(@hostInfo);    #call subroutine check_url()
 } 
 
 
To this
 
 #address will beginnig with "http://" assume the rest of the URL is valid
 if ($hostInfo[0] =~ /^http:\/\/\S+(:(\d+))?$/) {
   check_url(@hostInfo);    #call subroutine check_url()
 } 

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
Adam314Commented:
Or, if you want to be able to check secure severs also:

if($hostInfo[0] =~ m|^https?://|) {
  check_url(@hostInfo);    #call subroutine check_url()
} 

Open in new window

0
 
mrjoltcolaCommented:
True, leave the URLs up to the system administrator.
0
 
s1162282Author Commented:
You guys are awesome!  Both of those worked flawlessly.

Adam314, one question, though.  I actually would like to add the ability for https as well, so thank you for that.  How do I code it, to add it into the script?  I have added it (see below), but it seems to double check some sites.  Thanks again for your help.   :-)
if($hostInfo[0] =~ m|^http://|) {
  check_url(@hostInfo);    #call subroutine check_url()
} 
if($hostInfo[0] =~ m|^https?://|) {
  check_url(@hostInfo);    #call subroutine check_url()
}
 elsif ($hostInfo[0] =~ /^smtp:\S+\.\w{2,4}$/) {  #address will beginnig with "smtp:" ,next some string
                                                    # finish with point and 2 to 4 letters
   check_smtp(@hostInfo);    #call subroutine check_smtp()

Open in new window

0
 
mrjoltcolaCommented:
You'll need to add SSL support so LWP will use it, then it will handle https urls, I think I normally install Crypt::SSLEAY

http://cpan.uwinnipeg.ca/htdocs/Crypt-SSLeay/Crypt/SSLeay.html
0
 
Adam314Commented:

##### Instead of this:
if($hostInfo[0] =~ m|^http://|) {
  check_url(@hostInfo);    #call subroutine check_url()
} 
if($hostInfo[0] =~ m|^https?://|) {
  check_url(@hostInfo);    #call subroutine check_url()
}
elsif ($hostInfo[0] =~ /^smtp:\S+\.\w{2,4}$/) {  #address will beginnig with "smtp:" ,next some string
 
 
##### Use this
if($hostInfo[0] =~ m|^https?://|) {
  check_url(@hostInfo);    #call subroutine check_url()
}
elsif ($hostInfo[0] =~ /^smtp:\S+\.\w{2,4}$/) {  #address will beginnig with "smtp:" ,next some string

Open in new window

0
 
mrjoltcolaCommented:
Oops, sorry I forgot you said you are a perl beginner. Use CPAN

As root, if on UNIX run: cpan

Then, at the cpan prompt, type:  install Crypt::SSLeay

Follow the prompts. An OpenSSL library is required for this to work, you'll know if it finds one or not.
0
 
s1162282Author Commented:
Adam314, that seemed to work flawlessly.  Thank you both for your help on this.  I really appreciate it.  You guys were great.  Cudos.   :-)
0
 
mrjoltcolaCommented:
>>Thank you both for your help on this.  I really appreciate it. You guys were great.  Cudos.   :-)

Well, a point would have been nice. But thanks for the cudos anyway.
0
 
s1162282Author Commented:
mrjoltcola.  I'm sorry.  am I able to give points to multiple people?  I didn't mean to stiff you.  Sorry.  I have been a user for a while, but only asked a few questions, and the last time was years ago.  Sorry about that.   :-(

Is there a way to give you points now?
0
 
mrjoltcolaCommented:
Don't worry about it, if it was an honest mistake, no worries. For the future, yes you can accept multiple solutions. For the record, Adam's simplification of the regex pattern is cleaner, though mine also worked, so it is really up to you who you award points to.
0
 
Adam314Commented:
When the question is still open, there is a link for "accept multiple answers".  When you click that, you are given a page where you assign points to each possible answer.  You assign the points based on how helpful you found each answer.

If mrjoltcola wants, you can have the question re-opened by posting a question in community support, explaining what happened.  
0
 
mrjoltcolaCommented:
Sure, that is up to s1162282. Points in the Perl zone are hard to come by with Adam and ozo around so I'm usually scrambling for crumbs ;)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.