From bf0b31fe50c8a80fbbe49a82f4ae6b41a19d3624 Mon Sep 17 00:00:00 2001
From: Alexander Bluhm <alexander.bluhm@gmx.net>
Date: Tue, 14 Nov 2023 14:32:59 +0100
Subject: [PATCH] Test TLS connection with bad hostname must fail.

Create zone file with A and AAAA records in zone regress.
Start nsd with zone file listening on 127.0.0.1.
Write hosts of regress zone into pfresolved config.
Start pfresolved with nsd as resolver.
Pfresolved is provided with wrong hostname to verify server cert.
Wait until pfresolved reports lookup failure.
Check that pfresolved added no addresses.
Check that pfresolved reports "certificate verify failed".
---
 regress/Pfresolved.pm       |  3 ++-
 regress/args-tls-badhost.pl | 54 +++++++++++++++++++++++++++++++++++++
 regress/funcs.pl            | 20 +++++++++++++-
 3 files changed, 75 insertions(+), 2 deletions(-)
 create mode 100644 regress/args-tls-badhost.pl

diff --git a/regress/Pfresolved.pm b/regress/Pfresolved.pm
index d0d18db..2204f78 100644
--- a/regress/Pfresolved.pm
+++ b/regress/Pfresolved.pm
@@ -72,7 +72,8 @@ sub child {
 	my $resolver;
 	$resolver = $self->{addr} if $self->{addr};
 	$resolver .= '@'.$self->{port} if $self->{port};
-	$resolver .= '#localhost' if $self->{tls};
+	my $hostname = $self->{hostname} || "localhost";
+	$resolver .= "#$hostname" if $self->{tls};
 	my @cmd = (@sudo, @ktrace, $self->{execfile}, "-dvvv",
 	    "-f", $self->{conffile});
 	push @cmd, "-r", $resolver if $resolver;
diff --git a/regress/args-tls-badhost.pl b/regress/args-tls-badhost.pl
new file mode 100644
index 0000000..0a065f0
--- /dev/null
+++ b/regress/args-tls-badhost.pl
@@ -0,0 +1,54 @@
+# Create zone file with A and AAAA records in zone regress.
+# Start nsd with zone file listening on 127.0.0.1.
+# Write hosts of regress zone into pfresolved config.
+# Start pfresolved with nsd as resolver.
+# Pfresolved is provided with wrong hostname to verify server cert.
+# Wait until pfresolved reports lookup failure.
+# Check that pfresolved added no addresses.
+# Check that pfresolved reports "certificate verify failed".
+
+use strict;
+use warnings;
+use Socket;
+
+our %args = (
+    nsd => {
+	listen => { proto => "tls" },
+	record_list => [
+	    "foo	IN	A	192.0.2.1",
+	    "bar	IN	AAAA	2001:DB8::1",
+	    "foobar	IN	A	192.0.2.2",
+	    "foobar	IN	AAAA	2001:DB8::2",
+	],
+	loggrep => {
+	    qr/listen on ip-address 127.0.0.1\@\d+ \(tcp\)/ => 1,
+	},
+    },
+    pfresolved => {
+	address_list => [ map { "$_.regress." } qw(foo bar foobar) ],
+	hostname => "badhost",
+	loggrep => {
+	    qr/-r 127.0.0.1\@\d+#badhost/ => 1,
+	    qr/error: ssl handshake failed crypto error:.*/.
+		qr/certificate verify failed/ => '>=1',
+	    qr{added: 192.0.2.1/32,} => 0,
+	    qr{added: 2001:db8::1/128,} => 0,
+	    qr{added: 192.0.2.2/32,} => 0,
+	    qr{added: 2001:db8::2/128,} => 0,
+	},
+    },
+    pfctl => {
+	updated => [1, 0],
+	func => sub {
+	    my $self = shift;
+	    my $pfresolved = $self->{pfresolved};
+	    my $failed = qr/query for .* failed/;
+	    my $timeout = 5;
+	    $pfresolved->loggrep($failed, $timeout)
+		or die ref($self), " no '$failed' in $pfresolved->{logfile}",
+		    " after $timeout seconds";
+	},
+    },
+);
+
+1;
diff --git a/regress/funcs.pl b/regress/funcs.pl
index 92d02e6..41e7af1 100644
--- a/regress/funcs.pl
+++ b/regress/funcs.pl
@@ -47,6 +47,24 @@ sub check_logs {
 	check_loggrep($n, $d, $s, %args);
 }
 
+sub compare($$) {
+	local $_ = $_[1];
+	if (/^\d+/) {
+		return $_[0] == $_;
+	} elsif (/^==(\d+)/) {
+		return $_[0] == $1;
+	} elsif (/^!=(\d+)/) {
+		return $_[0] != $1;
+	} elsif (/^>=(\d+)/) {
+		return $_[0] >= $1;
+	} elsif (/^<=(\d+)/) {
+		return $_[0] <= $1;
+	} elsif (/^~(\d+)/) {
+		return $1 * 0.8 <= $_[0] && $_[0] <= $1 * 1.2;
+	}
+	die "bad compare operator: $_";
+}
+
 sub check_loggrep {
 	my ($n, $d, $s, %args) = @_;
 
@@ -59,7 +77,7 @@ sub check_loggrep {
 			if (ref($pat) eq 'HASH') {
 				while (my($re, $num) = each %$pat) {
 					my @matches = $p->loggrep($re);
-					@matches == $num
+					compare(@matches, $num)
 					    or die "$name matches '@matches': ",
 					    "'$re' => $num";
 				}