home *** CD-ROM | disk | FTP | other *** search
/ linuxmafia.com 2016 / linuxmafia.com.tar / linuxmafia.com / pub / linux / network / domain-check-1.6 < prev    next >
Text File  |  2007-07-02  |  10KB  |  328 lines
  1. #!/usr/bin/perl -ws
  2. # Created by Ben Okopnik on Thu Jun 28 09:11:52 EDT 2007
  3. #
  4. # Copyright (C) 2007 Ben Okopnik <ben@okopnik.com>
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. # GNU General Public License for more details.
  14.  
  15. =pod
  16. ################################## Changelog ##############################
  17.  
  18. 07/03/07  1:27 - v1.6
  19. * Added a rate limiter (4/minute) for .org domains
  20.  
  21. 06/30/07 18:34 - v1.5
  22. * Added a "domain not parseable; please report" warning
  23. * Added an "Unable to read 'whois' info" warning for the 'fgets: connection
  24.     reset by peer' error.
  25. * All expiration warnings are now sent as one email instead of one per
  26.     domain; ditto the expired domains notifications.
  27. * The 'printf' for the 'SKIPPED' error was ignoring the '-q' option; fixed
  28.  
  29. 06/30/07  8:19 - v1.4
  30. * Removed dependency on File::Find; searching PATH 'manually'
  31. * Added an 'exit 1' to the silent failure mode of 'croak'
  32.  
  33. 06/30/07  7:06 - v1.3
  34. * Improved the date-parsing regexes (the numerical months part can now only
  35.     match '01-12' instead of 'any two digits'); this should increase the
  36.     reliability of resolving 'dd-mm-yyyy' vs. 'mm-dd-yyyy' somewhat.
  37. * More accurate reporting for the 'SKIPPED' error (now shows exact reason)
  38. * Fixed the regexes that I screwed up while adding the Dotster extension
  39. * Added a '-v' option
  40.  
  41. 06/29/07 18:54 - v1.2
  42. * Got rid of an unnecessary system dependency ('which') - 'File::Find' is a
  43.     bit clunky, but better than depending on unknowns...
  44. * Another date-processing regex (ISOC-IL: 'validity: 29-06-2007')
  45.  
  46. 06/29/07 17:07 - v1.1
  47. * Modified output format to include both exp. date and days remaining
  48. * Added another date-processing regex (DOTSTER: 'Expires on: 29-Jun-07')
  49.  
  50. 06/29/07 15:06 - v1.0
  51. I'm finally willing to admit that this script is usable. :) Recent changes
  52. include:
  53.  
  54. * Parsing routine for "2007/08/12" date format
  55. * 'croak' notifies admin of problems encountered in silent mode
  56. * Added a fallback email address for 'croak'
  57. * Fixed GMT parsing routine miscalc (thanks to Rick Moen for the heads up)
  58.  
  59. ###########################################################################
  60. =cut
  61.  
  62. use strict;
  63. use Time::Local;
  64. $|++;
  65.  
  66. # Command-line variables
  67. our ($d, $e, $F, $h, $q, $s, $v, $x);
  68.  
  69. ### FALLBACK ADDRESS FOR NOTIFICATION ############
  70. my $address = 'root@localhost';
  71. ##################################################
  72.  
  73. my ($name) = $0 =~ /([^\/]+)$/;
  74.  
  75. my $usage =<<"+EoT+";
  76. Usage: $name [-e=email] [-x=expir_days] [-q] [-h] <-d=domain_name|-F=domainfile>
  77.  
  78.   -d=domain        : Domain to analyze
  79.   -e=email_address : Send a warning message by email
  80.   -F=domain_list   : File with a list of domains, one per line
  81.   -h               : Print this message
  82.   -q               : Don't print to the console (REQUIRES '-e' OPTION)
  83.   -s=whois server  : Use alternate whois server
  84.   -v               : Display current version of this script
  85.   -x=days          : Change default (30d) expiration interval (REQUIRES '-e' OPTION)
  86.  
  87. +EoT+
  88.  
  89. # Locate 'whois'
  90. my ($whois) = grep -e, map "$_/whois", split /:/, $ENV{PATH};
  91. die "'whois' not found in current path.\n" unless $whois;
  92.  
  93. # Find a mail client (mutt or mailx)
  94. my ($mail) = grep -e, map "$_/mutt", split /:/, $ENV{PATH};
  95. # Switch Mutt into 'mailx' mode if found
  96. if ($mail){
  97.     $mail .= " -x";
  98. }
  99. else {
  100.     ($mail) = grep -e, map "$_/mailx", split /:/, $ENV{PATH};
  101. }
  102. die "No mail client found in current path.\n" unless $mail;
  103.  
  104. # Read the version number at the top of the changelog
  105. if ($v){
  106.     seek DATA, 0, 0;
  107.     while (<DATA>){
  108.         if (m[^\d+/\d+/\d+[^v]+v([0-9.]+)]){
  109.             print "Version: $1\nCopyright (C) 2007 Ben Okopnik <ben\@okopnik.com>\n\n";
  110.             exit 0;
  111.         }
  112.     }
  113. }
  114.  
  115. # Email admin if '-q' is on; otherwise, just exit with the error
  116. sub croak {
  117.     if ($q){
  118.         # If '-x' wasn't specified, use the fallback address
  119.         $e ||= $address;
  120.         
  121.         # No place to send an error if this fails... :)
  122.         open Mail, "|$mail -s 'WARNING: $name script error' $e";
  123.         print Mail "$name [" . localtime() . "]: ", $_[0];
  124.         close Mail;
  125.  
  126.         exit 1;
  127.     }
  128.     else {
  129.         die $_[0];
  130.     }
  131. }
  132.  
  133. # Display the help output if requested or in case of incorrect usage
  134. die "$usage\n" if $h;
  135. die "\n*ERROR: '$name' requires an email address with the '-q' and the '-x' options*\n\n$usage" if ($q || $x) && ! $e;
  136. die "\n*ERROR: '$name' requires either a domain name or a domain list as an argument*\n\n$usage" if ! $d && ! $F;
  137.  
  138. # Set default notification interval to 30 days
  139. if ($x){
  140.     croak "Expiration interval must be specified in days (0-9999).\n"
  141.         unless $x =~ /^\d{1,4}$/;
  142. }
  143. else {
  144.     $x = 30;
  145. }
  146.  
  147. # Add the server to the "whois" command if it's been specified
  148. $whois .= " -h $s" if $s;
  149.  
  150. # Read the domain list file
  151. my @domains;
  152. if ($F){
  153.     croak "$F is not a regular file\n" unless -f $F;
  154.     croak "Can't read $F\n" unless -r _;
  155.     # Open the file if it exists
  156.     open F or croak "$F: $!\n";
  157.     while (<F>){
  158.         # Skip blank lines; ignore comments
  159.         next if /^\s*(?:#|$)/;
  160.         # Strip preceding and following blanks
  161.         s/^\s*(.*?)\s*$/$1/;
  162.         # Strip URI method
  163.         s#^.*://##;
  164.         push @domains, $_;
  165.     }
  166.     close F;
  167. }
  168.  
  169. # Having a '-F' AND a '-d' is explicitly not excluded
  170. if ($d){
  171.     # Strip URI method
  172.     $d =~ s#^.*://##;
  173.     push @domains, $d;
  174. }
  175.  
  176. # Trim strings to specified length; return '**UNKNOWN**' if undef
  177. sub trim {
  178.     defined $_[0] || return "**UNKNOWN**";
  179.     substr($_[0], 0, $_[1]);
  180. }
  181.  
  182. # Lookup list for month number->name conversion
  183. my %mth;
  184. @mth{map sprintf("%02d", $_), 1..12}= qw/jan feb mar apr may jun jul aug sep oct nov dec/;
  185.  
  186. ########################## DATA COLLECTION SECTION #############################
  187.  
  188. # Process the domain list
  189. my ($snap, %list);
  190. for my $host (@domains){
  191.  
  192.     # Delay to avoid triggering PIRs rate limiter
  193.     my $delay;
  194.     if ($host =~ /\.org$/){
  195.         if (defined $snap){
  196.             my $diff = timegm(gmtime) - $snap;
  197.             $delay = 30 - $diff if $diff < 30;
  198.         }
  199.         $snap = timegm(gmtime);
  200.     }
  201.  
  202.     my $msg = $delay ? " (waiting $delay seconds: 4 query/minute limit on .org domains)\n" : "\n";
  203.     $q || print "Processing $host$msg";
  204.     sleep $delay if $delay;
  205.  
  206.     # Execute the query
  207.     my $out;
  208.     open Who, "$whois $host|" or croak "Error executing $whois: $!\n";
  209.     {
  210.         # Read in the entire output of 'whois' as a single string
  211.         local $/;
  212.         $out = <Who>;
  213.     }
  214.     close Who;
  215.  
  216.     # 'fgets: connection reset by peer' - bloody annoying response!
  217.     if (!$out || $out !~ /domain/i){
  218.         print "Unable to read 'whois' info for $host. Skipping...\n";
  219.         next;
  220.     }
  221.  
  222.     # Freak out and run away if there's no match
  223.     if ($out =~ /no match/i){
  224.         $q||print "No match for $host!\n";
  225.         next;
  226.     }
  227.     # Ditto for bad hostnames
  228.     if ($out =~ /No whois server is known for this kind of object/i){
  229.         $q||print "'whois' doesn't recognize this kind of object.\n";
  230.         next;
  231.     }
  232.     
  233.     # Convert multi-line 'labeled block' output to 'Label: value'
  234.     $out =~ s/:\n(?!\n)/: /gsm if $out =~ /registrar:\n/i;
  235.  
  236.     # Date preprocessing
  237.     # 'Fri Jun 29 15:16:00 EDT 2007' => '29-Jun-2007' 
  238.     $out =~ s/(date:\s*| on:\s*)[A-Z][a-z]+\s+(...)\s+(\d+).*?(\d+)\s*$/$1$3-$2-$4/igsm;
  239.     # '29-Jun-07' => '29-Jun-2007' 
  240.     $out =~ s/(date:\s*| on:\s*)(\d{2})[\/-](...)[\/-](\d{2})$/$1$2-$3-20$4/igsm;
  241.     # '2007-Jun-29' => '29-Jun-2007' 
  242.     $out =~ s/(date:\s*| on:\s*)(\d{4})[\/-](...)[\/-](\d{2})$/$1$4-$3-$2/igsm;
  243.     # 2007/06/29 => '29-Jun-2007' 
  244.     $out =~ s/(date:\s*| on:\s*)(\d{4})[\/-](0[1-9]|1[0-2])[\/-](\d{2})\s*$/$1$4-$mth{$3}-$2/igsm;
  245.     # YOIKS... 'validity: 29-06-2007' => 'Expiration date: 29-Jun-2007'
  246.     $out =~ s/validity:\s*(\d{2})[\/-](0[1-9]|1[0-2])[\/-](\d{4})\s*$/Expiration date: $1-$mth{$2}-$3/igsm;
  247.  
  248.     # Collect the data from each query
  249.     for (split /\n/, $out){
  250.         # Clip pre- and post- blanks
  251.         s/^\s*(.*?)\s*$/$1/;
  252.         # Squash repeated tabs and spaces
  253.         s/\s+/ /g;
  254.  
  255.         # This is where it all happens - regexes to capture registrar and expiration
  256.         $list{$host}{Registrar} ||= $1 if /registrar\s*(?:name)?:\s*(.*)$/i;
  257.         $list{$host}{Expires} ||= $1 if /(?:expires(?: on)?|expiration date|renewal[- ]date):\s*(\d+-\w+-\d+)/i;
  258.         # print "Registrar: $list{$host}{Registrar}\nExpires: $list{$host}{Expires}\n";
  259.     }
  260.  
  261.     croak "The 'whois' format for $host is not parseable by '$name'. Please report this domain to the author!\n"
  262.         unless defined $list{$host};
  263. }
  264.  
  265. ########################## DATA ANALYSIS SECTION #############################
  266.  
  267. # Get current time snapshot in UTC
  268. my $now = timegm(gmtime);
  269.  
  270. # Convert dates to UTC epoch seconds; *will* fail on 19 Jan 2038. :)
  271. my %months;
  272. @months{qw/jan feb mar apr may jun jul aug sep oct nov dec/} = 0..11;
  273.  
  274. # Print the header if '$q' is off and there's content in %list
  275. $q || %list && printf "%-24s%-36s%s\n%s\n", "Host", "Registrar", "Exp.date/Days left", "=" x 78;
  276.  
  277. # Process the collected data
  278. my (%exp, %end);
  279. for my $k (sort keys %list){
  280.     unless (defined $list{$k}{Registrar} && defined $list{$k}{Expires}){
  281.         my $msg = "*** SKIPPED (missing ";
  282.         $msg .= ! defined($list{$k}{Registrar}) ? "reg. name) ***" : "exp. date) ***";
  283.         $q || printf "%-32s%s\n", trim($k, 31), $msg;
  284.         delete $list{$k};
  285.         next;
  286.     }
  287.     my @chunks = split /-/, $list{$k}{Expires};
  288.     my $epoch = timegm(0, 0, 0, $chunks[0], $months{lc $chunks[1]}, $chunks[2] - 1900);
  289.     my $diff = int(($epoch - $now) / 86400);
  290.     $q || printf "%-24s%-36s%-12s/%5s\n", trim($k, 23), trim($list{$k}{Registrar}, 35), 
  291.         $list{$k}{Expires}, $diff;
  292.  
  293.     # Prepare alerts if domain is expired or the expiration date is <= $x days
  294.     if ($e && ($diff <= $x)){
  295.         if ($diff <= 0){
  296.             $exp{$k} = -$diff; 
  297.         }
  298.         else {
  299.             $end{$k} = $diff;
  300.         }
  301.     }
  302. }
  303.  
  304. # Report expired domains
  305. if (%exp){
  306.     open Mail, "|$mail -s '$name: Expired domains' $e" or croak "$mail: $!\n";
  307.     print Mail "According to 'whois', the following domains have expired:\n\n";
  308.     for my $x (sort { $exp{$a} <=> $exp{$b} } keys %exp){
  309.         my $s = $exp{$x} == 1 ? "" : "s";
  310.         print Mail "$x ($exp{$x} day$s ago)\n";
  311.     }
  312.     close Mail;
  313. }
  314.  
  315. # Report domains that will expire within the '-x' period
  316. if (%end){
  317.     open Mail, "|$mail -s '$name: Domain expiration warning ($x day cutoff)' $e" or croak "$mail: $!\n";
  318.     print Mail "According to 'whois', these domains will expire soon:\n\n";
  319.     for my $d (sort { $end{$a} <=> $end{$b} } keys %end){
  320.         my $s = $end{$d} == 1 ? "" : "s";
  321.         print Mail "$d (in $end{$d} day$s)\n";
  322.     }
  323.     close Mail;
  324. }
  325.  
  326. __END__
  327.  
  328.