[PATCH 2/2] dnsbl.cgi: Add support for IDN

[Stefan Schantl <stefan.schantl@ipfire.org>]

Use the LibIDN2 perl module to convert international domain names
in the custom allow and block list, into the idn ascii format (punnycode).

Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>
---
 html/cgi-bin/dnsbl.cgi | 122 +++++++++++++++++++++++++++++++++++------
 1 file changed, 106 insertions(+), 16 deletions(-)

diff --git a/html/cgi-bin/dnsbl.cgi b/html/cgi-bin/dnsbl.cgi
index e81b144c2..16e6dded2 100644
--- a/html/cgi-bin/dnsbl.cgi
+++ b/html/cgi-bin/dnsbl.cgi
@@ -21,6 +21,7 @@
 
 use strict;
 use JSON::PP;
+use Net::LibIDN2 ':all';
 
 # enable only the following on debugging purpose
 #use warnings;
@@ -168,6 +169,8 @@ if ($cgiparams{'ACTION'} eq "$Lang::tr{'save'}") {
 } elsif ($cgiparams{'CUSTOM_DOMAINS'} eq "$Lang::tr{'save'}") {
 	my @cgi_allowed_domains;
 	my @cgi_blocked_domains;
+	my @ascii_allowed_domains;
+	my @ascii_blocked_domains;
 
 	# Get the current configured custom domains to allow or block
 	&readsettings("$custom_domains_file", \%custom_domains) if (-f "$custom_domains_file");
@@ -184,36 +187,32 @@ if ($cgiparams{'ACTION'} eq "$Lang::tr{'save'}") {
 	@cgi_allowed_domains = &General::uniq(@cgi_allowed_domains);
 	@cgi_blocked_domains = &General::uniq(@cgi_blocked_domains);
 
+	# Check domains and convert into ascii format.
+	@ascii_allowed_domains = &format_domains(\@cgi_allowed_domains, "ascii");
+	@ascii_blocked_domains = &format_domains(\@cgi_blocked_domains, "ascii");
+
 	# Merge temporary merge both arrays for duplicate and valid check.
-	my @merged = (@cgi_allowed_domains, @cgi_blocked_domains);
+	my @ascii_merged = (@ascii_allowed_domains, @ascii_blocked_domains);
 
 	# Check if there are duplicate entries on the merged list.
 	# This assumes a domain which has been entered on both
-	my $dup = &check_for_duplicates(@merged);
+	my $dup = &check_for_duplicates(@ascii_merged);
 
 	# If a duplicate has been found, raise an error
 	if ($dup) {
 		push(@errormessages, "$dup - $Lang::tr{'dnsbl error domain specified twice'}");
 	}
 
-	# Loop through the arrays and check for valid domains and duplicates
-	foreach my $domain (@merged) {
-		# Check if the domain is valid
-		unless (&General::validdomainname($domain)) {
-			push(@errormessages, "$domain - $Lang::tr{'invalid domain name'}");
-		}
-	}
-
 	# Check if a domain from the posted blocked domains array is allready part of
 	# the saved allowed domains array
-	$dup = &compare_arrays(\@custom_allowed_domains, \@cgi_blocked_domains);
+	$dup = &compare_arrays(\@custom_allowed_domains, \@ascii_blocked_domains);
 	if ($dup) {
 		push(@errormessages, "$dup - $Lang::tr{'dnsbl error domain specified twice'}");
 	}
 
 	# Check if a domain from the posted allowed domains array is allready part of
 	# the saved blocked domains array.
-	$dup = &compare_arrays(\@custom_blocked_domains, \@cgi_allowed_domains);
+	$dup = &compare_arrays(\@custom_blocked_domains, \@ascii_allowed_domains);
 	if ($dup) {
 		push(@errormessages, "$dup - $Lang::tr{'dnsbl error domain specified twice'}");
 	}
@@ -222,11 +221,11 @@ if ($cgiparams{'ACTION'} eq "$Lang::tr{'save'}") {
 		my %tmp;
 
 		# Assign the allowed and blocked domain arrays to the temporary hash
-		foreach my $domain (@cgi_allowed_domains) {
+		foreach my $domain (@ascii_allowed_domains) {
 			$tmp{$domain} = [ "allowed" ];
 		}
 
-		foreach my $domain (@cgi_blocked_domains) {
+		foreach my $domain (@ascii_blocked_domains) {
 			$tmp{$domain} = [ "blocked" ];
 		}
 
@@ -271,9 +270,9 @@ sub show_mainpage() {
 			my $status = $custom_domains{$domain}[0];
 
 			if ($status eq "allowed") {
-				push(@custom_allowed_domains, $domain);
+				push(@custom_allowed_domains, &format_domain_to_unicode($domain));
 			} elsif ($status eq "blocked") {
-				push(@custom_blocked_domains, $domain);
+				push(@custom_blocked_domains, &format_domain_to_unicode($domain));
 			}
 		}
 	}
@@ -539,3 +538,94 @@ sub compare_arrays (\@\@) {
 		}
 	}
 }
+
+sub format_domains(\@$) {
+	my ($arrayref, $format) = @_;
+	my @formated_domains;
+
+	# Deref and assign array.
+	my @domains = @{ $arrayref };
+
+	# Exit if not data passed.
+	return unless (@domains);
+
+	# Loop through the given domains array.
+	foreach my $domain (@domains) {
+		my $formated_domain;
+
+		# Check the output format and convert the domain into requested format.
+		if ($format eq "ascii") {
+			$formated_domain = &format_domain_to_ascii($domain);
+		} elsif ($format eq "unicode") {
+			$formated_domain = &format_domain_to_unicode($domain);
+		} else {
+			# Unknown format requested.
+			return;
+		}
+
+		# Check if the domain could be converted.
+		if ($formated_domain) {
+			# Add the converted domain to the array of ascii domains.
+			push(@formated_domains, $formated_domain);
+		} else {
+			# Add the invalid domain to the array of error messages.
+			push(@errormessages, "$domain - $Lang::tr{'invalid domain name'}");
+		}
+	}
+
+	return @formated_domains;
+}
+
+sub format_domain_to_ascii($) {
+	my ($domain) = @_;
+	my $ascii;
+	my $ret;
+
+	# Early exit on empty input.
+	return unless($domain);
+
+	# Spit the given domain name into parts.
+	my @parts = split(/\./, $domain);
+
+	# Exit if the given domain does not contain at least one dot.
+	return if(scalar(@parts) < 2);
+
+	# Use the perl module to convert the domain into the idn ascii format.
+	$ascii = &Net::LibIDN2::idn2_to_ascii_8($domain, "", $ret);
+
+	# Check if an error occured.
+	if ($ret) {
+		# Get the error message.
+		my $error = &Net::LibIDN2::idn2_strerror($ret);
+
+		push(@errormessages, "$domain - LibIDN2: $error");
+	}
+
+	# Exit if the given domain could not be converted.
+	return unless($ascii);
+
+	# Return the converted domain.
+	return $ascii;
+}
+
+sub format_domain_to_unicode($) {
+	my ($ascii) = @_;
+	my $unicode;
+	my $ret;
+
+	# Exit if no input has been given.
+	return unless($ascii);
+
+	# Convert the idn_ascii formated domain back to unicode and return it.
+	$unicode = &Net::LibIDN2::idn2_to_unicode_88($ascii, $ret);
+
+	# Check if an error occured.
+	if ($ret) {
+		# Get the error message.
+		my $error = &Net::LibIDN2::idn2_strerror($ret);
+
+		push(@errormessages, "$ascii - LibIDN2: $error");
+	}
+
+	return $unicode;
+}
-- 
2.47.3