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