home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
linuxmafia.com 2013
/
2013.06.linuxmafia.com
/
linuxmafia.com
/
pub
/
linux
/
network
/
domain-check-1.6
< prev
next >
Wrap
Text File
|
2007-07-03
|
10KB
|
328 lines
#!/usr/bin/perl -ws
# Created by Ben Okopnik on Thu Jun 28 09:11:52 EDT 2007
#
# Copyright (C) 2007 Ben Okopnik <ben@okopnik.com>
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
=pod
################################## Changelog ##############################
07/03/07 1:27 - v1.6
* Added a rate limiter (4/minute) for .org domains
06/30/07 18:34 - v1.5
* Added a "domain not parseable; please report" warning
* Added an "Unable to read 'whois' info" warning for the 'fgets: connection
reset by peer' error.
* All expiration warnings are now sent as one email instead of one per
domain; ditto the expired domains notifications.
* The 'printf' for the 'SKIPPED' error was ignoring the '-q' option; fixed
06/30/07 8:19 - v1.4
* Removed dependency on File::Find; searching PATH 'manually'
* Added an 'exit 1' to the silent failure mode of 'croak'
06/30/07 7:06 - v1.3
* Improved the date-parsing regexes (the numerical months part can now only
match '01-12' instead of 'any two digits'); this should increase the
reliability of resolving 'dd-mm-yyyy' vs. 'mm-dd-yyyy' somewhat.
* More accurate reporting for the 'SKIPPED' error (now shows exact reason)
* Fixed the regexes that I screwed up while adding the Dotster extension
* Added a '-v' option
06/29/07 18:54 - v1.2
* Got rid of an unnecessary system dependency ('which') - 'File::Find' is a
bit clunky, but better than depending on unknowns...
* Another date-processing regex (ISOC-IL: 'validity: 29-06-2007')
06/29/07 17:07 - v1.1
* Modified output format to include both exp. date and days remaining
* Added another date-processing regex (DOTSTER: 'Expires on: 29-Jun-07')
06/29/07 15:06 - v1.0
I'm finally willing to admit that this script is usable. :) Recent changes
include:
* Parsing routine for "2007/08/12" date format
* 'croak' notifies admin of problems encountered in silent mode
* Added a fallback email address for 'croak'
* Fixed GMT parsing routine miscalc (thanks to Rick Moen for the heads up)
###########################################################################
=cut
use strict;
use Time::Local;
$|++;
# Command-line variables
our ($d, $e, $F, $h, $q, $s, $v, $x);
### FALLBACK ADDRESS FOR NOTIFICATION ############
my $address = 'root@localhost';
##################################################
my ($name) = $0 =~ /([^\/]+)$/;
my $usage =<<"+EoT+";
Usage: $name [-e=email] [-x=expir_days] [-q] [-h] <-d=domain_name|-F=domainfile>
-d=domain : Domain to analyze
-e=email_address : Send a warning message by email
-F=domain_list : File with a list of domains, one per line
-h : Print this message
-q : Don't print to the console (REQUIRES '-e' OPTION)
-s=whois server : Use alternate whois server
-v : Display current version of this script
-x=days : Change default (30d) expiration interval (REQUIRES '-e' OPTION)
+EoT+
# Locate 'whois'
my ($whois) = grep -e, map "$_/whois", split /:/, $ENV{PATH};
die "'whois' not found in current path.\n" unless $whois;
# Find a mail client (mutt or mailx)
my ($mail) = grep -e, map "$_/mutt", split /:/, $ENV{PATH};
# Switch Mutt into 'mailx' mode if found
if ($mail){
$mail .= " -x";
}
else {
($mail) = grep -e, map "$_/mailx", split /:/, $ENV{PATH};
}
die "No mail client found in current path.\n" unless $mail;
# Read the version number at the top of the changelog
if ($v){
seek DATA, 0, 0;
while (<DATA>){
if (m[^\d+/\d+/\d+[^v]+v([0-9.]+)]){
print "Version: $1\nCopyright (C) 2007 Ben Okopnik <ben\@okopnik.com>\n\n";
exit 0;
}
}
}
# Email admin if '-q' is on; otherwise, just exit with the error
sub croak {
if ($q){
# If '-x' wasn't specified, use the fallback address
$e ||= $address;
# No place to send an error if this fails... :)
open Mail, "|$mail -s 'WARNING: $name script error' $e";
print Mail "$name [" . localtime() . "]: ", $_[0];
close Mail;
exit 1;
}
else {
die $_[0];
}
}
# Display the help output if requested or in case of incorrect usage
die "$usage\n" if $h;
die "\n*ERROR: '$name' requires an email address with the '-q' and the '-x' options*\n\n$usage" if ($q || $x) && ! $e;
die "\n*ERROR: '$name' requires either a domain name or a domain list as an argument*\n\n$usage" if ! $d && ! $F;
# Set default notification interval to 30 days
if ($x){
croak "Expiration interval must be specified in days (0-9999).\n"
unless $x =~ /^\d{1,4}$/;
}
else {
$x = 30;
}
# Add the server to the "whois" command if it's been specified
$whois .= " -h $s" if $s;
# Read the domain list file
my @domains;
if ($F){
croak "$F is not a regular file\n" unless -f $F;
croak "Can't read $F\n" unless -r _;
# Open the file if it exists
open F or croak "$F: $!\n";
while (<F>){
# Skip blank lines; ignore comments
next if /^\s*(?:#|$)/;
# Strip preceding and following blanks
s/^\s*(.*?)\s*$/$1/;
# Strip URI method
s#^.*://##;
push @domains, $_;
}
close F;
}
# Having a '-F' AND a '-d' is explicitly not excluded
if ($d){
# Strip URI method
$d =~ s#^.*://##;
push @domains, $d;
}
# Trim strings to specified length; return '**UNKNOWN**' if undef
sub trim {
defined $_[0] || return "**UNKNOWN**";
substr($_[0], 0, $_[1]);
}
# Lookup list for month number->name conversion
my %mth;
@mth{map sprintf("%02d", $_), 1..12}= qw/jan feb mar apr may jun jul aug sep oct nov dec/;
########################## DATA COLLECTION SECTION #############################
# Process the domain list
my ($snap, %list);
for my $host (@domains){
# Delay to avoid triggering PIRs rate limiter
my $delay;
if ($host =~ /\.org$/){
if (defined $snap){
my $diff = timegm(gmtime) - $snap;
$delay = 30 - $diff if $diff < 30;
}
$snap = timegm(gmtime);
}
my $msg = $delay ? " (waiting $delay seconds: 4 query/minute limit on .org domains)\n" : "\n";
$q || print "Processing $host$msg";
sleep $delay if $delay;
# Execute the query
my $out;
open Who, "$whois $host|" or croak "Error executing $whois: $!\n";
{
# Read in the entire output of 'whois' as a single string
local $/;
$out = <Who>;
}
close Who;
# 'fgets: connection reset by peer' - bloody annoying response!
if (!$out || $out !~ /domain/i){
print "Unable to read 'whois' info for $host. Skipping...\n";
next;
}
# Freak out and run away if there's no match
if ($out =~ /no match/i){
$q||print "No match for $host!\n";
next;
}
# Ditto for bad hostnames
if ($out =~ /No whois server is known for this kind of object/i){
$q||print "'whois' doesn't recognize this kind of object.\n";
next;
}
# Convert multi-line 'labeled block' output to 'Label: value'
$out =~ s/:\n(?!\n)/: /gsm if $out =~ /registrar:\n/i;
# Date preprocessing
# 'Fri Jun 29 15:16:00 EDT 2007' => '29-Jun-2007'
$out =~ s/(date:\s*| on:\s*)[A-Z][a-z]+\s+(...)\s+(\d+).*?(\d+)\s*$/$1$3-$2-$4/igsm;
# '29-Jun-07' => '29-Jun-2007'
$out =~ s/(date:\s*| on:\s*)(\d{2})[\/-](...)[\/-](\d{2})$/$1$2-$3-20$4/igsm;
# '2007-Jun-29' => '29-Jun-2007'
$out =~ s/(date:\s*| on:\s*)(\d{4})[\/-](...)[\/-](\d{2})$/$1$4-$3-$2/igsm;
# 2007/06/29 => '29-Jun-2007'
$out =~ s/(date:\s*| on:\s*)(\d{4})[\/-](0[1-9]|1[0-2])[\/-](\d{2})\s*$/$1$4-$mth{$3}-$2/igsm;
# YOIKS... 'validity: 29-06-2007' => 'Expiration date: 29-Jun-2007'
$out =~ s/validity:\s*(\d{2})[\/-](0[1-9]|1[0-2])[\/-](\d{4})\s*$/Expiration date: $1-$mth{$2}-$3/igsm;
# Collect the data from each query
for (split /\n/, $out){
# Clip pre- and post- blanks
s/^\s*(.*?)\s*$/$1/;
# Squash repeated tabs and spaces
s/\s+/ /g;
# This is where it all happens - regexes to capture registrar and expiration
$list{$host}{Registrar} ||= $1 if /registrar\s*(?:name)?:\s*(.*)$/i;
$list{$host}{Expires} ||= $1 if /(?:expires(?: on)?|expiration date|renewal[- ]date):\s*(\d+-\w+-\d+)/i;
# print "Registrar: $list{$host}{Registrar}\nExpires: $list{$host}{Expires}\n";
}
croak "The 'whois' format for $host is not parseable by '$name'. Please report this domain to the author!\n"
unless defined $list{$host};
}
########################## DATA ANALYSIS SECTION #############################
# Get current time snapshot in UTC
my $now = timegm(gmtime);
# Convert dates to UTC epoch seconds; *will* fail on 19 Jan 2038. :)
my %months;
@months{qw/jan feb mar apr may jun jul aug sep oct nov dec/} = 0..11;
# Print the header if '$q' is off and there's content in %list
$q || %list && printf "%-24s%-36s%s\n%s\n", "Host", "Registrar", "Exp.date/Days left", "=" x 78;
# Process the collected data
my (%exp, %end);
for my $k (sort keys %list){
unless (defined $list{$k}{Registrar} && defined $list{$k}{Expires}){
my $msg = "*** SKIPPED (missing ";
$msg .= ! defined($list{$k}{Registrar}) ? "reg. name) ***" : "exp. date) ***";
$q || printf "%-32s%s\n", trim($k, 31), $msg;
delete $list{$k};
next;
}
my @chunks = split /-/, $list{$k}{Expires};
my $epoch = timegm(0, 0, 0, $chunks[0], $months{lc $chunks[1]}, $chunks[2] - 1900);
my $diff = int(($epoch - $now) / 86400);
$q || printf "%-24s%-36s%-12s/%5s\n", trim($k, 23), trim($list{$k}{Registrar}, 35),
$list{$k}{Expires}, $diff;
# Prepare alerts if domain is expired or the expiration date is <= $x days
if ($e && ($diff <= $x)){
if ($diff <= 0){
$exp{$k} = -$diff;
}
else {
$end{$k} = $diff;
}
}
}
# Report expired domains
if (%exp){
open Mail, "|$mail -s '$name: Expired domains' $e" or croak "$mail: $!\n";
print Mail "According to 'whois', the following domains have expired:\n\n";
for my $x (sort { $exp{$a} <=> $exp{$b} } keys %exp){
my $s = $exp{$x} == 1 ? "" : "s";
print Mail "$x ($exp{$x} day$s ago)\n";
}
close Mail;
}
# Report domains that will expire within the '-x' period
if (%end){
open Mail, "|$mail -s '$name: Domain expiration warning ($x day cutoff)' $e" or croak "$mail: $!\n";
print Mail "According to 'whois', these domains will expire soon:\n\n";
for my $d (sort { $end{$a} <=> $end{$b} } keys %end){
my $s = $end{$d} == 1 ? "" : "s";
print Mail "$d (in $end{$d} day$s)\n";
}
close Mail;
}
__END__