use utf8;
use warnings; no warnings "redefine";
use strict;
use Dbase::Globals qw(content puny_decode);
use Dbase::Help qw(DoFn);
use Fehler qw(fehler problem ffehler);
use IO::Socket::INET '$CRLF';
use Loader qw(domain_reg);
use UTFkram qw(decode_anything);

sub domain_whois($;$) {
	my($domain,$whois) = @_;

	$domain = DoFn "select domain from domainkunde where id=$domain"
		if $domain =~ /^\d+$/;

	return problem 'Es wurde kein Domain-Name angegeben.'
	  unless content($domain);
	
	return "" if $ENV{'TESTING2'}; # beim Testen: is nich

	domain_reg($domain,undef,undef,undef,undef,undef,undef,undef,\$whois) unless $whois;

	my($whois_server, $whois_args);
	if ($whois) {
		($whois_server, $whois_args) = split ' ', $whois, 2;
	} elsif ( $domain =~ /([^.]+)$/ ) {
		$whois_server = "$1.whois-servers.net";
	} else {
		$whois_server = 'whois.thur.de';
	}
	$whois_server .= ':whois' unless $whois_server =~ y/://;
	$whois_args ||= '<domain>';

	$whois_args =~ s#<domain(-ace)?># defined $1 ? $domain : puny_decode $domain #eg;

	my @lines;
	my $socket;

	my $err = 'Unknown error';
	Whois: for ( sub {}, sub { fehler($err)} ) {
		$err = 'Socket timeout';
		local $SIG{ALRM} = $_;
		ffehler {
			alarm(21);
			eval {
				$err = "Problem: Timeout beim Verbindungsaufbau zu $whois_server";
				$socket = IO::Socket::INET->new( PeerAddr => $whois_server );

				# Damit IDN-Abfragen bei der DENIC funktionieren, vgl. RT#453196.
				# Sollten dadurch andere nicht mehr funktionieren, müssten wir
				# die Kodierung evtl. auch noch in der Konfiguration abbilden.
				binmode $socket, ':encoding(UTF-8)'
				  or return problem(
					"Kann whois-Kommunikation nicht auf UTF-8 setzen: $!\n");

				unless($socket) {
					problem "Kann keine Verbindung zu $whois_server herstellen: $!\n"
						unless $ENV{TESTING2};
					return undef;
				}
				$err = "Problem: Timeout beim Senden an $whois_server";

				$socket->print( $whois_args . $CRLF )
					or return problem "Fehler bei der Kommunikation mit $whois_server: $!\n";
	
				$err = "Problem: Timeout beim Lesen von $whois_server";
				@lines = readline $socket
				  and $lines[-1] !~ /\n\z/ and $lines[-1] .= "\n";
			};
			alarm(0);
			$socket->close if defined $socket;
			if($@) {
				@lines = ();
				return problem $@;
			}
		} sub {
			alarm(0);
			$socket->close;
			return problem @_;
		};
		last if @lines;
	}

	return map { decode_anything($_) } @lines;
}

1;
