domreg_sensor

#!/usr/bin/perl -w
use strict;
use FindBin;
use Digest::MD5 qw/md5_hex/;
use Net::Whois::Raw;
use Storable qw/lock_retrieve lock_nstore/;
my $cache_file = "/var/tmp/domreg_sensor.cache";
my $default_whois_server = "whois.nic.ru";
my $cache_timeout = 6*60*60; # 6 hours
my $now = time;

my %whois_servers = (
	"dp.ua" => "ua.whois-servers.net",
	"co.ua" => "whois.co.ua",
	"biz.ua" => "whois.biz.ua",
	"com.ua" => "whois.com.ua",
	"net.ua" => "whois.com.ua",
	"gov.ua" => "whois.com.ua",
	"org.ua" => "whois.com.ua",
	"edu.ua" => "whois.com.ua",
	"ua" => "whois.com.ua",
	"ru" => "whois.ripn.net",
	"su" => "whois.ripn.net",
	"xn--p1ai" => "whois.ripn.net",
	"com" => "com.whois-servers.net",
	"net" => "net.whois-servers.net",
	"org" => "org.whois-servers.net",
	"info" => "info.whois-servers.net",
	"biz" => "biz.whois-servers.net",
	"name" => "name.whois-servers.net",
	"tv" => "tv.whois-servers.net",
	"cc" => "cc.whois-servers.net",
	"ws" => "ws.whois-servers.net",
);
my %month_names = (
	jan	=> "01",
	feb	=> "02",
	mar	=> "03",
	apr	=> "04",
	may	=> "05",
	jun	=> "06",
	jul	=> "07",
	aug	=> "08",
	sep	=> "09",
	"oct"	=> "10",
	nov	=> "11",
	dec	=> "12",
);

sub get_whois_server($) {
	my $domain = shift;
	$domain =~ /^[\w\d\-_]+\.([\w\d\-_\.]+)$/ or die "bad domain: $domain\n";
	my $postfix = $1;
	my $server = $whois_servers{$postfix};
	$server = $default_whois_server unless defined $server;
	return $server;
}

sub get_dominfo($) {
	my $domain = lc shift;
	my $server = get_whois_server( $domain );
	my $dominfo = defined($server) ? whois( $domain, $server ) : whois( $domain );
	return $dominfo;
}

sub get_raw_expiry_date($) {
	my $domain = shift;
	my $dominfo = get_dominfo( $domain );
	foreach ( split /\n/, $dominfo ) {
		if( /paid-till:\s*([\d\.]+)\s*$/ ) { # ru
			return $1;
		} elsif( /Record expires on ([\d\w\-]+)\.?\s*$/ ) { # com
			return $1;
		} elsif( /^\s*Expiration Date:\s+(\d\d?-\w\w\w?-\d\d\d\d)\.?\s*$/ ) { # Expiration Date: 09-jul-2014
			return $1;
		} elsif( /^\s*Registrar Registration Expiration Date:\s+(\d\d\d\d)-(\d\d)-(\d\d)\.?\s*$/ ) { # Registrar Registration Expiration Date: 2014-07-09
			return "$1.$2.$3";
		} elsif( /Record expired on (\d\d)\/(\d\d)\/(\d\d\d\d)\s*$/ ) { # 07/09/2012
			return "$3.$1.$2";
		} elsif( /^expires:\s*(20\d\d)-(\d\d)-(\d\d)\s/ ) { # new ua
			return "$1.$2.$3";
		} elsif( /status:\s*OK-UNTIL\s+(20\d\d)(\d\d)(\d\d)\d*\s*$/ ) { # old ua
			return "$1.$2.$3";
		} elsif( /^\s*Registrar Registration Expiration Date:\s+(\d\d\d\d)-(\d\d)-(\d\d)T\d\d:\d\d:\d\dZ\s*$/ ) { # Registrar Registration Expiration Date: 2016-02-17T20:00:00Z
			return "$1.$2.$3";
		}
	}
}

sub fix_date($) {
	my $raw = shift;
	if( $raw =~ /^20\d\d\.\d\d\.\d\d$/ ) {
		return $raw;
	} elsif( $raw =~ /^(\d\d?)-(\w+)-(20\d\d)$/ ) {
		my $month = $month_names{lc $2} or die "bad month: $2\n";
		return "$3.$month.$1";
	} elsif( not defined $raw or "" eq $raw ) {
		return "0unknown";
	} else {
		die "unknown date format: $raw\n";
	}
}

sub get_expiry_date($) {
	return fix_date get_raw_expiry_date shift;
}

sub get_cached_expiry_date($) {
	my $domain = shift;
	my $cache = eval{ lock_retrieve($cache_file) } || {};
	if( exists $cache->{$domain} ) {
		my $expiry_date = $cache->{$domain}{expiry_date};
		my $cached_time = $cache->{$domain}{cached_time};
		if( defined($expiry_date) and $now - $cached_time < $cache_timeout ) {
			return ($expiry_date, $cached_time);
		};
	}
	#warn "cache fail for $domain\n"; #####################
	my $expiry_date = get_expiry_date($domain);
	if( defined($expiry_date) and "" ne $expiry_date and $expiry_date !~ /unknown/ ) {
		$cache->{$domain}{expiry_date} = $expiry_date;
		$cache->{$domain}{cached_time} = $now;
		lock_nstore( $cache, $cache_file ); # no checks
	}
	return $expiry_date; # the second return value is undef which means expiry_date is not from cache
}

sub get_error_date() {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($now);
	$year += 1900;
	$mon += 1;
	if( 12 == $mon ) {
		++$year;
		$mon = 1;
	} else {
		++$mon;
	}
	return sprintf "%s.%02d.%02d", $year, $mon, $mday;
}

sub main() {
	die "Usage: $FindBin::Script [-v]|[--sensor] <domains>\n" unless @ARGV;
	my ($verbose, $sensor);
	if( "-v" eq $ARGV[0] ) {
		shift @ARGV;
		$verbose = 1;
	} elsif( "--sensor" eq $ARGV[0] ) {
		shift @ARGV;
		$sensor = 1;
	}
	#printf "error date: %s\n", get_error_date;
	my $error_date = get_error_date;
	my $allok = 1;
	my %out_table = ();
	foreach my $domain (@ARGV) {
		$domain = lc $domain;
		my ($expiry_date, $cached_time) = get_cached_expiry_date( $domain );
		my $domainok = ( ($expiry_date cmp $error_date) >= 0 );
		$allok = 0 unless $domainok;
		if( $verbose ) {
			print get_dominfo($domain);
		};
		if( not $sensor or not $domainok ) {
			my $out = sprintf "%30s %s %s (%s)\n",
				$domain,
				( $domainok ? "OK" : "!!" ),
				$expiry_date,
				( defined($cached_time) ? "cached " . scalar(localtime $cached_time) : "not cached" );
			$out_table{$out} = $expiry_date;
		}
	}
	print join "", sort { $out_table{$a} cmp $out_table{$b} } keys %out_table;
	if( $sensor ) {
		print $allok ? "OK\n" : "Total status: domreg problems.\n";
	} else {
		printf "Total status: %s\n", $allok ? "OK" : "domreg problems.";
		print "Cache file is $cache_file, remove it to force status update.\n";
	}
}

main;