Start regress test for pfresolved.

Use Perl framework to start and control pfresolved daemon.  Copy
existing code for daemon process from syslogd and relayd.  Target
make test invokes regress subdir.

LICENSE

@@ -1,4 +1,5 @@
 Copyright (c) 2023 genua GmbH <[email protected]>
+Copyright (c) 2010-2023 Alexander Bluhm <[email protected]>
 Copyright (c) 2019 Tobias Heider <[email protected]>
 Copyright (c) 2010-2016 Reyk Floeter <[email protected]>
 Copyright (c) 2008 Pierre-Yves Ritschard <[email protected]>

Makefile

@@ -17,4 +17,11 @@ CFLAGS+=	-Werror
 
 LDFLAGS+=	-L/usr/local/lib
 
+test: pfresolved
+	PFRESOLVED=${.OBJDIR}/pfresolved ${MAKE} -C ${.CURDIR}/regress
+
+.if (make(clean) || make(cleandir) || make(obj))
+SUBDIR +=	regress
+.endif
+
 .include <bsd.prog.mk>

regress/Makefile

@@ -0,0 +1,49 @@
+#	$OpenBSD$
+
+.if exists(${.CURDIR}/../${.OBJDIR:T}/pfresolved)
+PFRESOLVED ?=		${.CURDIR}/../${.OBJDIR:T}/pfresolved
+.elif exists(${.CURDIR}/../pfresolved)
+PFRESOLVED ?=		${.CURDIR}/../pfresolved
+.endif
+
+PERLS =			Proc.pm Pfresolved.pm funcs.pl pfresolved.pl
+ARGS !=			cd ${.CURDIR} && ls args-*.pl
+REGRESS_TARGETS =       ${ARGS:S/^/run-/}
+CLEANFILES =		*.log *.conf ktrace.out stamp-* *.pid *.ktrace
+
+# Set variables so that make runs with and without obj directory.
+# Only do that if necessary to keep visible output short.
+
+.if ${.CURDIR} == ${.OBJDIR}
+PERLINC =	-I.
+PERLPATH =
+.else
+PERLINC =	-I${.CURDIR} -I${.OBJDIR}
+PERLPATH =	${.CURDIR}/
+.endif
+
+# The arg tests take a perl hash with arguments controlling the
+# test parameters.  Generally they consist of client, syslogd, server.
+
+.for a in ${ARGS}
+run-$a: $a
+	time SUDO=${SUDO} KTRACE=${KTRACE} PFRESOLVED=${PFRESOLVED} \
+	    perl ${PERLINC} ${PERLPATH}pfresolved.pl ${PERLPATH}$a
+.endfor
+
+# make perl syntax check for all args files
+
+.PHONY: syntax
+
+syntax: stamp-syntax
+
+stamp-syntax: ${PERLS} ${ARGS}
+.for p in ${PERLS}
+	@perl -c ${PERLINC} ${PERLPATH}$p
+.endfor
+.for a in ${ARGS}
+	@perl -c ${PERLPATH}$a
+.endfor
+	@date >$@
+
+.include <bsd.regress.mk>

regress/Pfresolved.pm

@@ -0,0 +1,76 @@
+#	$OpenBSD$
+
+# Copyright (c) 2010-2023 Alexander Bluhm <[email protected]>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Pfresolved;
+use parent 'Proc';
+use Carp;
+use Cwd;
+use File::Basename;
+use Sys::Hostname;
+
+sub new {
+	my $class = shift;
+	my %args = @_;
+	$args{ktraceexec} = "ktrace" if $args{ktrace};
+	$args{ktraceexec} = $ENV{KTRACE} if $ENV{KTRACE};
+	$args{ktracefile} ||= "pfresolved.ktrace";
+	$args{logfile} ||= "pfresolved.log";
+	$args{up} ||= "forwarder starting";
+	$args{down} ||= "parent terminating";
+	$args{func} = sub { Carp::confess "$class func may not be called" };
+	$args{execfile} ||= $ENV{PFRESOLVED} ? $ENV{PFRESOLVED} : "pfresolved";
+	$args{conffile} ||= "pfresolved.conf";
+	my $self = Proc::new($class, %args);
+
+	my $test = basename($self->{testfile} || "");
+	open(my $fh, '>', $self->{conffile}) or die ref($self),
+	    " config file '$self->{conffile}' create failed: $!";
+	print $fh "# test $test\n";
+	print $fh "regress-pfresolved {\n";
+	print $fh  "\n}\n";
+
+	return $self;
+}
+
+sub child {
+	my $self = shift;
+	my @sudo = $ENV{SUDO} ? $ENV{SUDO} : "env";
+
+	my @pkill = (@sudo, "pkill", "-KILL", "-x", "pfresolved");
+	my @pgrep = ("pgrep", "-x", "pfresolved");
+	system(@pkill) && $? != 256
+	    and die ref($self), " system '@pkill' failed: $?";
+	while ($? == 0) {
+		print STDERR "pfresolved still running\n";
+		system(@pgrep) && $? != 256
+		    and die ref($self), " system '@pgrep' failed: $?";
+	}
+	print STDERR "pfresolved not running\n";
+
+	my @ktrace;
+	@ktrace = ($self->{ktraceexec}, "-i", "-f", $self->{ktracefile})
+	    if $self->{ktraceexec};
+	my @cmd = (@sudo, @ktrace, $self->{execfile}, "-dvv",
+	    "-f", $self->{conffile});
+	print STDERR "execute: @cmd\n";
+	exec @cmd;
+	die ref($self), " exec '@cmd' failed: $!";
+}
+
+1;

regress/Proc.pm

@@ -0,0 +1,199 @@
+#	$OpenBSD$
+
+# Copyright (c) 2010-2023 Alexander Bluhm <[email protected]>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+
+package Proc;
+use Carp;
+use Errno;
+use File::Basename;
+use IO::File;
+use POSIX;
+use Time::HiRes qw(time alarm sleep);
+
+my %CHILDREN;
+
+sub kill_children {
+	my @pids = @_ ? @_ : keys %CHILDREN
+	    or return;
+	my @perms;
+	foreach my $pid (@pids) {
+		if (kill(TERM => $pid) != 1 and $!{EPERM}) {
+			push @perms, $pid;
+		}
+	}
+	if (my @sudo = split(' ', $ENV{SUDO}) and @perms) {
+		local $?;  # do not modify during END block
+		my @cmd = (@sudo, '/bin/kill', '-TERM', @perms);
+		system(@cmd);
+	}
+	delete @CHILDREN{@pids};
+}
+
+BEGIN {
+	$SIG{TERM} = $SIG{INT} = sub {
+		my $sig = shift;
+		kill_children();
+		$SIG{TERM} = $SIG{INT} = 'DEFAULT';
+		POSIX::raise($sig);
+	};
+}
+
+END {
+	kill_children();
+	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
+}
+
+sub new {
+	my $class = shift;
+	my $self = { @_ };
+	$self->{down} ||= "Shutdown";
+	$self->{func} && ref($self->{func}) eq 'CODE'
+	    or croak "$class func not given";
+	!$self->{ktraceexec} || $self->{ktracefile}
+	    or croak "$class ktrace file not given";
+	$self->{logfile}
+	    or croak "$class log file not given";
+	open(my $fh, '>', $self->{logfile})
+	    or die "$class log file $self->{logfile} create failed: $!";
+	$fh->autoflush;
+	$self->{log} = $fh;
+	$self->{ppid} = $$;
+	return bless $self, $class;
+}
+
+sub run {
+	my $self = shift;
+
+	pipe(my $reader, my $writer)
+	    or die ref($self), " pipe to child failed: $!";
+	defined(my $pid = fork())
+	    or die ref($self), " fork child failed: $!";
+	if ($pid) {
+		$CHILDREN{$pid} = 1;
+		$self->{pid} = $pid;
+		close($reader);
+		$self->{pipe} = $writer;
+		return $self;
+	}
+	%CHILDREN = ();
+	$SIG{TERM} = $SIG{INT} = 'DEFAULT';
+	$SIG{__DIE__} = sub {
+		die @_ if $^S;
+		warn @_;
+		IO::Handle::flush(\*STDERR);
+		POSIX::_exit(255);
+	};
+	open(STDERR, '>&', $self->{log})
+	    or die ref($self), " dup STDERR failed: $!";
+	close($writer);
+	open(STDIN, '<&', $reader)
+	    or die ref($self), " dup STDIN failed: $!";
+	close($reader);
+
+	do {
+		$self->child();
+		print STDERR $self->{up}, "\n";
+		$self->{begin} = time();
+		$self->{func}->($self);
+	} while ($self->{redo});
+	print STDERR "Shutdown", "\n";
+
+	IO::Handle::flush(\*STDOUT);
+	IO::Handle::flush(\*STDERR);
+	POSIX::_exit(0);
+}
+
+sub wait {
+	my $self = shift;
+	my $flags = shift;
+
+	# if we a not the parent process, assume the child is still running
+	return 0 unless $self->{ppid} == $$;
+
+	my $pid = $self->{pid}
+	    or croak ref($self), " no child pid";
+	my $kid = waitpid($pid, $flags);
+	if ($kid > 0) {
+		my $status = $?;
+		my $code;
+		$code = "exit: ".   WEXITSTATUS($?) if WIFEXITED($?);
+		$code = "signal: ". WTERMSIG($?)    if WIFSIGNALED($?);
+		$code = "stop: ".   WSTOPSIG($?)    if WIFSTOPPED($?);
+		delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?);
+		return wantarray ? ($kid, $status, $code) : $kid;
+	}
+	return $kid;
+}
+
+sub loggrep {
+	my $self = shift;
+	my($regex, $timeout, $count) = @_;
+
+	my $end;
+	$end = time() + $timeout if $timeout;
+
+	do {
+		my($kid, $status, $code) = $self->wait(WNOHANG);
+		if ($kid > 0 && $status != 0) {
+			# child terminated with failure
+			die ref($self), " child status: $status $code";
+		}
+		open(my $fh, '<', $self->{logfile})
+		    or die ref($self), " log file open failed: $!";
+		my @match = grep { /$regex/ } <$fh>;
+		return wantarray ? @match : $match[0]
+		    if !$count && @match or $count && @match >= $count;
+		close($fh);
+		# pattern not found
+		if ($kid == 0) {
+			# child still running, wait for log data
+			sleep .1;
+		} else {
+			# child terminated, no new log data possible
+			return;
+		}
+	} while ($timeout and time() < $end);
+
+	return;
+}
+
+sub up {
+	my $self = shift;
+	my $timeout = shift || 10;
+	$self->loggrep(qr/$self->{up}/, $timeout)
+	    or croak ref($self), " no '$self->{up}' in $self->{logfile} ".
+		"after $timeout seconds";
+	return $self;
+}
+
+sub down {
+	my $self = shift;
+	my $timeout = shift || 30;
+	$self->loggrep(qr/$self->{down}/, $timeout)
+	    or croak ref($self), " no '$self->{down}' in $self->{logfile} ".
+		"after $timeout seconds";
+	return $self;
+}
+
+sub kill_child {
+	my $self = shift;
+	kill_children($self->{pid});
+	return $self;
+}
+
+1;

regress/args-default.pl

@@ -0,0 +1,9 @@
+# test default values
+
+use strict;
+use warnings;
+
+our %args = (
+);
+
+1;