Perl Script to Test URI Status

This Perl script was a little test to see the URI status for multiple URIs, related services, status codes, and response times. The purpose of this Perl script is for base-lining multiple websites and generating a before and after reports, automating your URI status testing.

For example, if we do a firewall change we want to know if all ports and sites are still accessible. This script can tell us quickly the status of all URIs in the list.

Please give credit for it’s creation. It tests a few things, mostly as a demonstration of what can easily be scripted in a few hours of Perl. If you would like a custom script created for you, please contact us for custom Perl programming.

Here are a few of the things this URI Testing script demonstrates:

• HTTP Status codes

• Windows ANSI Terminal Colors

• Response load time (doesn’t include all images, only HTTP)

• HTTP Response size (for baselining)

• Specific Text on the HTTP/S page

• Open Ports

• Additional HTTP Status Messages

As written, it could be used for both server checks and website status checks, but a good improvement would be to add a mail feature or other similar log so you can run your URI tests on a cron schedule.

Please let use know if you use it. If you want help with your Perl scripting or have an idea for something you want written in Perl, please contact us Perl Development.

#!/usr/bin/perl

# please give credit to somesite.com

use strict;
use warnings;

use URI;                    # to strip domain from uri
use HTTP::Tiny;             # get html, check status, headers
use Data::Validate::URI;    # verify it's a URI
use Time::HiRes qw (time);  # for timing response, and net ping response
use Win32::Console::ANSI;   # colors on prompt
use Term::ANSIColor;        # colors on prompt
use IO::Socket::PortState qw(check_ports);

# don't spit it out all at once, but as we get the info update screen
$|++;

# what exact string are we looking for on the page?
my $textcheck = 'contact-form-7';

# list of uris to check
# note, it converts to hosts for most checks
my @uris = qw(
    http://somesite.com:80
    http://somesite.com/404erroh
    http://aquaponics-system.com
    http://jse.co.za/
    https://mybroadband.co.za
    http://www.junkmail.co.za
    http://1.0.0.1:565
);

# when is something considered "dead"?
my $timeout = 4;

# what ports do we care about?
my %check = (
   tcp => {
      '22'  => { name => 'SSH', },
      '80'  => { name => 'HTTP', },
      '443' => { name => 'HTTPS', },
   },
);

# loop over each URI to see if they are even valid
foreach my $uri (@uris) {
    # only allow valid urls in test, exit early
    my $uriValidator = new Data::Validate::URI();
    unless ($uriValidator->is_web_uri($uri) ) {
        print color("bright_red"),"FAIL: '$uri' is not a valid URI\n", color("reset");
        exit;
    }
}

# loop over each URI, again now that we know they are valid
foreach my $uri (@uris) {

    # extract domain from uri
    my $url = URI->new( $uri );
    my $domain = $url->host;

    # start timer
    my $t0 = time;

    # new instance of HTTP::Tiny from $ARGV
    my $http = HTTP::Tiny->new(timeout => $timeout);
    my $response = $http->get($uri);

    # end timer
    my $t1 = time - $t0;
    my $time = sprintf("%.3f", $t1);  # 3 decimal places

    # HTTP response test
    if ($response->{success}) {
        # wordpress DB error?
        my $html = $response->{content};
        if ($html =~ m/Error establishing a database connection/) {
            print color("bright_green"),"HTTP: DBERR, \t";   # basically a '200 check' (passed)
        } else {
            print color("bright_green"),"HTTP: GOOD, \t";   # basically a '200 check' (passed)
        }
    } else {
        print color("bright_red"),"HTTP: FAIL, \t";
    }

    # time
    if ($time < .5) { print color("bright_green"),"TIME: $time, ", color("reset"); } else { print color("bright_red"),"TIME: $time, ", color("reset"); } # http status code if ($response->{status} =~ m/^2/) {
        print color("bright_green"),"CODE: " . $response->{status} . ",  ", color("reset");
    } elsif ($response->{status} =~ m/^3/) {
        print color("bright_yellow"),"CODE: " . $response->{status} . ",  ", color("reset");
    } else {
        print color("bright_red"),"CODE: " . $response->{status} . ",  ", color("reset");
    }

    #tell us the length
    if (length $response->{content}) {
        print "SIZE: " . length $response->{content};
        print", \t";
    } else {
        print "SIZE: 00000, \t";
    }

    # check for specific text on the page
    my $html = $response->{content};
    if ($html =~/$textcheck/) {
        print color("bright_green"),"TEXT: PASS, ", color("reset");
    } else {
        print color("bright_red"),"TEXT: FAIL, ", color("reset");
    }

   # check open ports from %check
    check_ports($domain,$timeout,\%check);
    my $portcheck =  "PORTS: ";
    foreach my $proto (keys %check){
        foreach my $key (keys %{ $check{$proto} }) {
            if ($check{$proto}{$key}->{open}) {
                $portcheck .=  $check{$proto}{$key}->{name} . ",";
            }
        }
    }

    printf "%-20s\t", $portcheck;

    # which URI we tested, and give it a 35 space block to land in
    printf "%-35s\t", $uri . ",";

    # any other messages that might be helpful
    my $msg = "";
       $msg .= $response->{reason};
    print "MESG: '" . $msg . "'\n";
    print color("reset");
}