#!/usr/bin/perl -w

use strict;
use utf8;
use warnings;

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

use Cf qw($DENIC_RRI_SERVER $DENIC_RRI_USER $DENIC_RRI_PASSWORD);
use Encode qw(encode_utf8);
use Net::SSLeay qw(die_now die_if_ssl_error);
use Umlaut qw(textmodus);
use UTFkram qw(decode_anything);
use Socket;

Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();

my ( $ssl, $ctx, $mbuf );
my ( $Server, $Port ) = split( /:/, $DENIC_RRI_SERVER );

sub sock_open() {
    $mbuf = "";

    my $dest_ip = gethostbyname($Server);
    die "Keine IP-Adresse gefunden: $Server" unless defined $dest_ip;
    my $dest_serv_params = sockaddr_in( $Port, $dest_ip );
    
    socket  (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
    connect (S, $dest_serv_params)          or die "connect: $!";
    select  (S); $| = 1; select (STDOUT);   # Eliminate STDIO buffering
    
    # The network connection is now open, lets fire up SSL
    $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
    $Net::SSLeay::trace = 1;
    Net::SSLeay::CTX_set_options( $ctx, &Net::SSLeay::OP_ALL )
      and die_if_ssl_error("ssl ctx set options");
    $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
    Net::SSLeay::set_fd( $ssl, fileno(S) );    # Must use fileno
    my $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");

    # print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
    Net::SSLeay::get_cipher($ssl);
}

sub sock_write($) {
    my ($msg) = @_;

    # Länge in Bytes vom String ist nicht gleich Anzahl von Character
    Net::SSLeay::write( $ssl, pack( "N", length( encode_utf8 $msg) ) . $msg );
    die_if_ssl_error("ssl write:" . $!);
    print "SEND:\n" . $msg . "\n" if $ENV{DEBUG};
}

sub sock_read_raw($) {
    my ($len) = @_;
    while ( length($mbuf) < $len ) {
        my $data = Net::SSLeay::read($ssl);
        die "no data" if not defined $data or $data eq "";
        die_if_ssl_error("ssl read");
        $mbuf .= $data;
    }
    return substr( $mbuf, 0, $len, "" );
}

sub sock_read() {
    my $msg = sock_read_raw(4);
    return sock_read_raw( unpack( "N", $msg ) );
}

sub sock_close() {
    Net::SSLeay::free($ssl);    # Tear down connection
    Net::SSLeay::CTX_free($ctx);
    close S;
}

sub rri_login() {
    sock_open();
    sock_write(<<_);
Action: LOGIN
Version: 2.0
User: $DENIC_RRI_USER
Password: $DENIC_RRI_PASSWORD
_
    die "Login nicht erfolgreich"
      unless ( sock_read() =~ /^RESULT:\s+success\s/ );
}

sub rri_logout() {
    sock_write("ACTION: LOGOUT\n");
    sock_close();
}

sub check_if_free {
    my $domain = shift;
    print localtime() . " Check $domain: " if $ENV{DEBUG};

    sock_write( <<_ );
Action:     CHECK
Version:    2.0
Domain:     $domain
_
    my $data = sock_read();

    print "Result for $domain: [$data] " if $ENV{DEBUG};
    if ( $data !~ /^Status:\s*(\S+)/mi ) {
        warn "Domain hat keinen Status: $data\n" if $ENV{DEBUG};
        return 0;
    }
    elsif ( $1 eq 'connect' || $1 eq 'failed' ) {
        print "Domain weg ($1)!\n" if $ENV{DEBUG};
        return 0;
    }
    elsif ( $1 eq 'invalid' ) {
        print "Domain invalide ($1)!\n" if $ENV{DEBUG};
        return 0;
    }
    elsif ( $1 eq 'free' ) {
        print "Domain ist frei: Status $1\n" if $ENV{DEBUG};
        print $domain . "\n";
        return 1;
    }
    else {
        warn "Domain $_ hat einen unbekannten Status: $1\n";
        return 0;
    }
}

# ---------------------
# -- START OF SCRIPT --
# ---------------------
textmodus(\*STDOUT);
$| = 1;

rri_login();
while (<>) {
    $_ = decode_anything($_);
    s/#.*//;
    next unless /\S/;
    chomp;

    check_if_free($_);
}
rri_logout();

__END__

=head1 NAME

finde_freie_de-domains - Prüft nach welche Domains frei sind

=head1 SYNOPSE

    ./finde_freie_de-domains my_domainlist
    <my_domainlist ./finde_freie_de-domains

=head1 BESCHREIBUNG

Das Tool erhält eine Liste mit Domains und prüft nach ob diese frei sind.

=head1 RÜCKGABEWERT

Als Rückgabe erhält man eine Liste mit den Domains die frei sind.

=head1 AUTOR

 Stelios Gikas <entwicklung@noris.net>
 Stelios Gikas <10065509@ticket.noris.net>

