#!/usr/bin/perl # Author: Kevin P. Inscoe . # File: check_web_sites.pl # Date of creation: February 11, 2004. # Warranty: None expressed or implied. # License: The Open Software License. V1.1 http://www.opensource.org/licenses/osl.php # # OSI Certified Open Source Software. http://www.opensource.org/licenses/ # # Prerequisites: Perl 5.004 (minimum). require 5.004; # The purpose of this program is # # Reads in a list of web sites from a CSV file and check the dns, content and http result code. # Added check services for smtp, dns, web, ssl and ftp. # #Turn off Perl buffering $| = 1; use Text::ParseWords; # Do the CSV parsing use LWP::UserAgent; use HTTP::Request; use IO::Socket; use Socket; use Net::DNS; use diagnostics; use strict; # Declare subroutines sub parse_csv; sub check_site_http; sub get_dns; sub check_services; # Debug flag - set to 1 to turn on. $main::debug = 0; # Variables my $domainfile = "Should be monitored.csv"; my $rptfile = "check_web_sites_report.txt"; my $prob_rptfile = "check_web_sites_problems.txt"; my $datafile = "check_web_sites_valid.dat"; my $domain; my @rec; my $datetime = localtime(); my @norev; my @nons; my @domains; my $domname; my @domainslist; $main::warnings; $main::errors; $main::httpc; $main::sslc; $main::ftpc; $main::smtpc; $main::bindc; $main::recs; $main::rejects; $main::readc; open(IN, "<$domainfile") or die "Error opening $domainfile\n"; open(RPT, ">$rptfile") or die "Error opening $rptfile for output\n"; open(PRB, ">$prob_rptfile") or die "Error opening $prob_rptfile for output\n"; open(DAT, ">$datafile") or die "Error opening $datafile for output\n"; # Print headers print "$datetime\n\n"; print RPT " check_web_sites.pl Report at $datetime\n\n"; print PRB " check_web_sites.pl Problems at $datetime\n\n"; while () { $main::readc++; chomp; if ($main::debug) { print "DBG: [main] =================\n"; } if ($main::debug) { print "DBG: [main] buf=$_\n"; } # substitute any non-alphanumeric, commas, dashes or dots s/[^0-9a-zA-Z\-\.\,]//g; # Parse the CSV line, grab the first column if ($main::debug) { print "DBG: [main] edited buf=$_\n"; } @rec = &parse_csv($_); if ($main::debug) { print "DBG: [main] rec=@rec\n"; } $domain = $rec[0]; if ( $domain =~ m/\s/ ) { $domain = "" } if ($main::debug) { print "DBG: [main] domain=$domain\n"; } # Is this a valid domain - Consult the Book of Armaments, Chap. 3 vs. 2 - http://www.faqs.org/rfcs/rfc1035.html if ( $domain =~ m/^(-?[0-9A-Za-z\-]+)(\.)(-?[A-Za-z][A-Za-z]+)/ ) { if ($main::debug) { print "DBG: [main] VALID domain=$domain\n"; } my @tmp = grep {$domain} @domainslist; if ($main::debug) { print "DBG: [main] tmp=@tmp\n"; } if ($main::debug) { print "DBG: [main] domainslist=@domainslist\n"; } if ( @tmp eq "" ) { if ($main::debug) { print "DBG: [main] Already visited domain: $domain\n"; } } else { # Check www. first if not already called by that name my @domains = ""; my $domname = ""; if ( substr($domain, 0, 4) eq "www." ) { push @domains, $domain; push @domains, substr($domain, 4, length($domain)-3); if ($main::debug) { print "DBG: [main] www found: domains=@domains\n"; } } else { push @domains, $domain; push @domains, "www." . $domain; if ($main::debug) { print "DBG: [main] www NOT found: domains=@domains\n"; } } # Now do a service check on both www and rooted domains foreach $domname (@domains) { if ( $domname ne "" ) { my @svclist = &check_services($domname); foreach my $svc (@svclist) { if ( $svc ne "" ) { print DAT "$svc\n"; } } } } # Remember this domain so we don't visit it again push @domainslist, $domain; } } else { $main::rejects++; print PRB "Bad domain: $domain\n"; if ($main::debug) { print "DBG: [main] Bad domain: $domain\n"; } } } # Close out the files $datetime = localtime(); # Stats print "\n---------------------------------------------------------------------------------------------\n\n"; print RPT "\n---------------------------------------------------------------------------------------------\n\n"; print "$main::readc input record(s) read from $domainfile.\n\n"; print RPT "$main::readc input record(s) read from $domainfile.\n\n"; print "$main::httpc web sites were found.\n"; print RPT "$main::httpc web sites were found.\n"; print "$main::sslc SSL sites were found.\n"; print RPT "$main::sslc SSL sites were found.\n"; print "$main::ftpc ftp sites were found.\n"; print RPT "$main::ftpc ftp sites were found.\n"; print "$main::smtpc SMTP servers were found.\n"; print RPT "$main::smtpc SMTP servers were found.\n"; print "$main::bindc name servers were found.\n\n"; print RPT "$main::bindc name servers were found.\n\n"; print "$main::recs records were written to $datafile for import into Nagios.\n\n"; print RPT "$main::recs records were written to $datafile for import into Nagios.\n\n"; # Problems found print RPT "$main::rejects input records were rejected from $domainfile.\nConsult $prob_rptfile.\n\n"; print "$main::rejects input records were rejected from $domainfile.\n\n"; print PRB "\n$main::rejects input records were rejected from $domainfile.\n"; print "$main::errors errors and $main::warnings warnings were found consult $prob_rptfile.\n\n"; print RPT "$main::errors errors and $main::warnings warnings were found consult $prob_rptfile.\n\n"; print PRB "\n\n$main::errors errors and $main::warnings warnings were found.\n\n"; # Close out print "check_web_sites.pl completed at $datetime\n\n"; print RPT "check_web_sites.pl Report completed at $datetime\n\n"; print PRB "check_web_sites.pl Problems completed at $datetime\n\n"; close(IN); close(RPT); close(PRB); close(DAT); # Parse the CSV line sub parse_csv { return "ewords(",",1,$_[0]); } # Resolve the FQDN into an address and report name server sub get_dns { my ($fqdn) = @_; if ($main::debug) { print "DBG: +++ Entering get_dns...\n"; } chomp($fqdn); my $char; if ($main::debug) { print "DBG: [get_dns] dump of fqdn: ["; my @ascii = unpack("C*", $fqdn); foreach my $ord (@ascii) { $char = chr($ord); print "$char\{$ord\}"; } print "]\n"; } # Define your name servers # Earthlink my $ns1="207.69.188.185"; my $rr; my $ip = ""; my $host = ""; my $msg; my $nsname; my $mxpref; my $mxexch; # We should not get here... if ( $fqdn eq "" ) { if ($main::debug) { print "DBG: [get_dns] ERROR: fqdn is blank\!\n"; print "DBG: --- Leaving get_dns...\n"; }; return ($ip, $host); } if ($main::debug) { print "DBG: [get_dns] fqdn=$fqdn\n"; } # Print the address my $res = Net::DNS::Resolver->new; $res->nameservers($ns1); my $query = $res->search($fqdn); if ($query) { print RPT "Address="; foreach my $rr ($query->answer) { # Get address if ( $rr->type eq "A" ) { $ip = $rr->address; } # Get reverse my $rev = Net::DNS::Resolver->new; $rev->nameservers($ns1); my $arpa = join('.', reverse split(/\./, $ip)).".in-addr.arpa"; if ($main::debug) { print "DBG: [get_dns] arpa=$arpa\n"; } my $q = $rev->query($arpa, "PTR"); if ($q) { my $ptr = ($q->answer)[0]; if ( $ptr->type eq "PTR" ) { $host = $ptr->rdatastr; $host =~ s/\.$//g; } } # Print address and reverse print RPT "$ip (host: $host)\n"; if ($main::debug) { print "DBG: [get_dns] ip=$ip, host=$host\n"; } } } else { $main::errors++; $msg = "ERROR: address query failed for $fqdn\n"; print PRB $msg; } # Print the name server $res = Net::DNS::Resolver->new; $res->nameservers($ns1); $query = $res->query($fqdn, "NS"); if ($query) { print RPT "Name server(s)={"; foreach $rr (grep { $_->type eq 'NS' } $query->answer) { $nsname = $rr->nsdname; print RPT "$nsname "; } print RPT "}\n"; } else { $main::warnings++; $msg = "WARNING: name service query failed for $fqdn "; print PRB "$msg\n"; } # Get any MX records for domain $res = Net::DNS::Resolver->new; $res->nameservers($ns1); my @mx = mx($res, $fqdn); if (@mx) { print RPT "MX record(s) point to: {"; foreach $rr (@mx) { $mxpref = $rr->preference; $mxexch = $rr->exchange; print RPT "$mxpref $mxexch "; } print RPT "}\n"; } else { $main::warnings++; $msg = "WARNING: Can't find MX records for $fqdn "; print PRB "$msg\n";} if ($main::debug) { print "DBG: --- Leaving get_dns...\n"; } return ($ip, $host); } # Check the services running on domain. Check services for smtp, dns, web, ssl and ftp. sub check_services { my ($domain) = @_; if ($main::debug) { print "DBG: +++ Entering check_services...\n"; } my $result; my $content; my $response_code; my $files; my @svclist; if ( $domain eq "" ) { return (@svclist); } print RPT "*******************************\nDomain:$domain, "; # Check the DNS my ($ip, $host) = &get_dns($domain); print RPT "\n"; # Check HTTP protcol, get the content and results ($result, $content, $response_code) = &check_site_http($domain); # if web result is a 200 then add to our domain list if ( $response_code eq "200" ) { print RPT "http://$domain:\n"; print RPT "HTTP Response: \n$result\n\n$content\n\n"; push @svclist, "h,http://$domain,$ip,$host"; $main::httpc++; $main::recs++; } # Check for SSL on this host ($result, $content, $response_code) = &check_site_ssl($domain); # if web result is a 200 then add to our domain list if ( $response_code eq "200" ) { print RPT "https://$domain:\n"; print RPT "SSL Response: \n$result\n\n$content\n\n"; push @svclist, "s,https://$domain,$ip,$host"; $main::sslc++; $main::recs++; } # Check for ftp running on this host ($files, $response_code) = &check_site_ftp($domain); # if ftp result is not 500 then add to our domain list if ( $response_code ne "500" ) { print RPT "ftp://$domain:\n"; if ( $response_code ne "401" ) { print RPT "Files:\n$files\n\n"; } push @svclist, "f,ftp://$domain,$ip,$host"; $main::ftpc++; $main::recs++; } # Check for name server running on this host if ( &check_site_bind($domain) ) { print RPT "\n$domain is an DNS server\n\n"; push @svclist, "d,$domain,$ip,$host"; $main::bindc++; $main::recs++; } # Check for smtp running on this host. if ( &check_site_smtp($domain) ) { print RPT "\n$domain is an SMTP server\n\n"; push @svclist, "m,$domain,$ip,$host"; $main::smtpc++; $main::recs++; } if ($main::debug) { print "DBG: --- Leaving check_services...\n"; } print RPT "\n"; return (@svclist); } # Pull $numbytes bytes of the HTTP server output sub check_site_http { my ($param) = @_; if ($main::debug) { print "DBG: +++ Entering check_site_http...\n"; } my $numbytes = 75; # Number of bytes to pull from site my $tail; my $cnt = 0; my $result; my $head; my $url = "http://" . $param; if ($main::debug) { print "DBG: [check_site_http] url = $url\n"; } my $request; my $ua; my $response; my $response_code; my $response_message; my $count; my $bytes; my $out; my $title; $request = new HTTP::Request("GET", $url); $ua = new LWP::UserAgent; $response = $ua->request($request); $response_code = $response->code; $response_message = $response->message; $result = " Code: $response_code\n Message: $response_message"; my $content = $response->content(); $bytes = length $content; $count = ($content =~ tr/\n/\n/); $head = substr($content, 0, $numbytes); $title = $response->title(); $out = "Content: ($count lines, $bytes bytes)\n\nTitle: $title\n\nBody: {$head}\n\n"; if ($main::debug) { print "DBG: --- Leaving check_site_http...\n"; } return ($result, $out, $response_code, $bytes, $count); } # See if ftp service is running and pull results code. If anonymous get a directory listing. sub check_site_ftp { my ($param) = @_; if ($main::debug) { print "DBG: +++ Entering check_site_ftp...\n"; } # # $ua = new LWP::UserAgent; #$url = "ftp://ftp.census.gov/pub/datamap/www/map/10.map"; # #$request = HTTP::Request->new('GET', $url); #$response = $ua->request($request); # #unless ($response->is_success) { # print "Cannot get $url (status ", # $response->code, " ", $response->message,")\n"; #} # my $url = "ftp://" . $param; if ($main::debug) { print "DBG: [check_site_ftp] url = $url\n"; } my $request; my $ua; my $response; my $response_code; my $response_message; my $head; my $numbytes = 600; $request = new HTTP::Request("GET", $url); $ua = new LWP::UserAgent; $response = $ua->request($request); $response_code = $response->code; $response_message = $response->message; my $content = $response->content(); $head = substr($content, 0, $numbytes); if ($main::debug) { print "DBG: --- Leaving check_site_ftp...\n"; } return ($head, $response_code); } # Pull $numbytes bytes of the HTTP server output sub check_site_ssl { my ($param) = @_; if ($main::debug) { print "DBG: +++ Entering check_site_ssl...\n"; } my $numbytes = 75; # Number of bytes to pull from site my $tail; my $cnt = 0; my $result; my $head; my $url = "https://" . $param; if ($main::debug) { print "DBG: [check_site_ssl] url = $url\n"; } my $request; my $ua; my $response; my $response_code; my $response_message; my $count; my $bytes; my $out; my $title; $request = new HTTP::Request("GET", $url); $ua = new LWP::UserAgent; $response = $ua->request($request); $response_code = $response->code; $response_message = $response->message; $result = " Code: $response_code\n Message: $response_message"; my $content = $response->content(); $bytes = length $content; $count = ($content =~ tr/\n/\n/); $head = substr($content, 0, $numbytes); $title = $response->title(); $out = "Content: ($count lines, $bytes bytes)\n\nTitle: $title\n\nBody: {$head}\n\n"; if ($main::debug) { print "DBG: --- Leaving check_site_ssl...\n"; } return ($result, $out, $response_code, $bytes, $count); } # Check if this server has SMTP service sub check_site_smtp { my ($domain) = @_; if ($main::debug) { print "DBG: +++ Entering check_site_smtp...\n"; } my $result = 0; my $sock = new IO::Socket::INET ( PeerAddr => $domain, PeerPort => '25', Proto => 'tcp', ); if ( $sock ) { close($sock); $result = 1; } if ($main::debug) { print "DBG: --- Leaving check_site_smtp...\n"; } return ($result); } # Check if this server has SMTP service sub check_site_bind { my ($domain) = @_; if ($main::debug) { print "DBG: +++ Entering check_site_bind...\n"; } my $result = 0; my $sock = new IO::Socket::INET ( PeerAddr => $domain, PeerPort => '53', Proto => 'tcp', ); if ( $sock ) { close($sock); $result = 1; } if ($main::debug) { print "DBG: --- Leaving check_site_bind...\n"; } return ($result); }