#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;

BEGIN {
    unshift @INC, ( $ENV{'POPHOME'} || '@POPHOME@' ) . '/lib'
      unless $ENV{'KUNDE_NO_PERLPATH'};
}

use Date::Parse qw(str2time);
use Dbase::Getopt qw(:DEFAULT getopt_descr);
use Dbase::Globals qw(find_descr get_descr);
use Dbase::Help qw(Do DoSelect qquote);
use Fehler qw(probleme warnungen);
use Loader qw(domain_whois);

sub check_whois(\%$%) {
    my ( $whois, $expire_date_field, %expect ) = @_;
    while ( my ( $key, $expected_value ) = each %expect ) {
        defined( my $value = $whois->{$key} )
          or return qq(Die whois-Daten enthalten keine Angabe zu "$key".);
        return qq($key ist laut whois "@$value" statt "$expected_value".)
          if ref $expected_value
            ? "@$value" !~ $expected_value
            : "@$value" ne $expected_value;
    }
    defined( my $expire_date = $whois->{$expire_date_field} )
      or return qq(Die whois-Daten enthalten kein $expire_date_field.);
    defined( my $expire_time = str2time("@$expire_date") )
      or return qq(Kann $expire_date_field "$expire_date" nicht parsen.);
    $expire_time;
}

use constant HANDLER => {

    'ca' => sub {
        my ( $domain, @whois ) = @_;
        my %whois;
        {
            my ( $prefix, $previous_key );
            my $cre_key = qr/(\S[^:]*)(?<=\S):/;
            for (@whois) {
                next if /^%/ || !/\S/; # Kommentare und Leerzeilen überspringen
                if (/^$cre_key\s+(.+?)\s*$/) {    # "normale" Einträge
                    push @{ $whois{ $previous_key = $1 } }, $2;
                }
                elsif (/^\s+$cre_key\s+(.+?)\s*$/) {    # Unter-Einträge
                    push @{ $whois{ $previous_key = "$prefix $1" } }, $2;
                }
                elsif (/^\s+(\S.*?)\s*$/) { # fortgesetzte mehrzeilige Einträge
                    push @{ $whois{$previous_key} }, $1;
                }
                elsif (/^$cre_key$/) {      # Überschriften von Unterkategorien
                    $previous_key = $prefix = $1;
                }
                else { return "Unerwartete whois-Daten: $_" }
            }
        }
        check_whois(
            %whois, 'Renewal date',
            'Domain name'   => $domain,
            'Domain status' => 'EXIST'
        );
    },

    'cn' => sub {
        my ( $domain, @whois ) = @_;
        my %whois;
        for (@whois) {
            /^([^:]+):\s*(.*)/ or return "Unerwartete whois-Daten: $_";
            push @{ $whois{$1} }, $2;
        }
        check_whois(
            %whois, 'Expiration Date',
            'Domain Name'   => $domain,
            'Domain Status' => qr/^(?:ok|clientTransferProhibited)\z/
        );
    },

    'nz' => sub {
        my ( $domain, @whois ) = @_;
        my %whois;
        for (@whois) {
            next if /^%/;
            /^([^:\s]+): (.*)/ or return "Unerwartete whois-Daten: $_";
            push @{ $whois{$1} }, $2;
        }
        check_whois(
            %whois, 'domain_datebilleduntil',
            domain_name              => $domain,
            query_status             => '200 Active',
            domain_delegaterequested => 'yes'
        );
    },
};

sub get_expire_time($@) {
    my ( $domain, @whois ) = @_;
    my ($tld) = $domain =~ /\.([^.]+)\z/ or return 'Kann TLD nicht ermitteln.';
    my $handler = HANDLER->{$tld}
      or return
"Keine Ahnung, wie ich für .$tld-Domains das Expire-Datum ermitteln kann.";
    s/\cM?\cJ\z// for @whois;
    $handler->( $domain, @whois );
}

my %ExcludeNic;
GetOptions(
    'min-ttl=i' => \( my $Min_TTL = 21 * 86400 ),
    'exclude-nic=s' => sub {
        my $nic = getopt_descr( nic => @_ );
        $ExcludeNic{$nic} = undef;
    },
    'update-db!' => \( my $UpdateDb = 1 ),
);

my $min_expires = $^T + $Min_TTL;

$| = 1;
DoSelect {
    my ( $id, $domain, $expires, $nic_id ) = @_;
    my $nic_name =
      defined $nic_id ? 'NIC ' . get_descr( nic => $nic_id ) : 'kein NIC';
    print "$domain ($nic_name): ";
    if ( defined $nic_id && exists $ExcludeNic{$nic_id} ) {
        print "wird übersprungen\n";
    }
    elsif ( not ( my @whois = domain_whois($domain) ) ) {
        my @fehler;
        probleme { push @fehler, @_ };
        warnungen { push @fehler, @_ };
        print 'konnte keine whois-Daten ermitteln'
          . ( @fehler ? ': ' . join( '; ', @fehler ) : '.' ) . "\n";
    }
    elsif (
        ( my $expire_time = get_expire_time( $domain, @whois ) ) !~ /^\d+\z/ )
    {
        print "konnte kein Expire-Datum ermitteln: $expire_time\n";
    }
    else {
        Do("UPDATE domainkunde SET expires=$expire_time WHERE id=$id")
          if $UpdateDb;

        if ( $expire_time < $min_expires ) {
            printf "wird in %.f Tagen expiren (%s).\n",
              ( $expire_time - $^T ) / 86400, scalar localtime $expire_time;
        }
        else { print 'OK (' . localtime($expire_time) . ")\n" }
    }
}
<<_
	SELECT id, domain, expires, nic
	FROM   domainkunde
	WHERE  SUBSTRING_INDEX( domain, '.', -1 ) IN (${\join ',', map qquote($_), keys %{+HANDLER} })
	   AND status != ${\ find_descr( domainstatus => unregistriert => 1 ) }
	   AND ( ende    IS NULL OR ende    > expires      )
	   AND ( expires IS NULL OR expires < $min_expires )
_

__END__

=head1 NAME

check_domain_expiries_by_whois - Expire-Überprüfung für diverse ccTLDs

=head1 SYNOPSE

    check_domain_expiries_by_whois

=head1 BESCHREIBUNG

Dieses Tool überprüft für alle in der Datenbank registrierten
.{ca,cn,nz}-Domains, für die dort noch kein oder ein in naher Zukunft
liegendes Expire-Datum vermerkt ist, das tatsächliche Expire-Datum anhand whois
und aktualisiert es dann auf Wunsch in der Datenbank.

Für jede Domain wird eine Zeile ausgegeben, die mit dem Domainnamen gefolgt von
einem Doppelpunkt und einem Leerzeichen beginnt.
Sodann folgt die Zeichenkette C<OK > und weitere Hinweise zum Expire-Datum,
sofern alles okay ist, oder andernfalls eine Fehlermeldung, die hoffentlich mit
einer anderen Zeichenkette beginnt. :-)

=head1 OPTIONEN

=over 4

=item -verbose

um zusätzliche Meldungen (auf der Standardausgabe) zu bekommen, etwa, wenn eine
Domain übersprungen wird.

=item -exclude-nic NIC

Domains, die zu diesem NIC gehören, nicht überprüfen.
Kann mehrfach verwendet werden, um Domains unterschiedlicher NICs zu ignorieren.

=item -min-ttl Tage

Mindestanzahl von Tagen, die das Expire-Datum einer Domain noch in der
Zukunft liegen sollte, bevor wir anfangen, uns Sorgen zu machen;
Default: C<21>

=item -noupdate-db

um das Expire-Datum der überprüften Domain(s) in der Datenbank nicht zu
aktualisieren

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 BEKANNTE FEHLER

=over 4

=item *

cn.whois-servers.net spackt öfter mal; es gibt dann false positives.

=back
