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