Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

How do I check a webserver's availabilty via script

Posted on 2009-04-29
15
Medium Priority
?
223 Views
Last Modified: 2013-11-05
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
0
Comment
Question by:s1162282
  • 7
  • 4
  • 3
  • +1
15 Comments
 
LVL 5

Expert Comment

by:louislietaer
ID: 24262398
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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24262450
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
 
LVL 39

Accepted Solution

by:
Adam314 earned 2000 total points
ID: 24262722
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 39

Expert Comment

by:Adam314
ID: 24262732
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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24262849
True, leave the URLs up to the system administrator.
0
 
LVL 1

Author Comment

by:s1162282
ID: 24263162
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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24263404
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
 
LVL 39

Expert Comment

by:Adam314
ID: 24263437

##### 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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24263443
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
 
LVL 1

Author Comment

by:s1162282
ID: 24263754
Adam314, that seemed to work flawlessly.  Thank you both for your help on this.  I really appreciate it.  You guys were great.  Cudos.   :-)
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24263842
>>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
 
LVL 1

Author Comment

by:s1162282
ID: 24263891
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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24263946
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
 
LVL 39

Expert Comment

by:Adam314
ID: 24264251
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
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24264305
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

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In the distant past (last year) I hacked together a little toy that would allow a couple of Manager types to query, preview, and extract data from a number of MongoDB instances, to their tool of choice: Excel (http://dilbert.com/strips/comic/2007-08…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans
Suggested Courses

571 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question