When setting KTRACE in the environment, client and server write

ktrace files.  This simplifies debugging as system calls can be
inspected with kdump.

diff --git a/regress/sys/net/pf_divert/Client.pm b/regress/sys/net/pf_divert/Client.pm
index e8ce59f..9f01b3b 100644 (file)
--- a/regress/sys/net/pf_divert/Client.pm
+++ b/regress/sys/net/pf_divert/Client.pm
@@ -1,6 +1,6 @@
-#      $OpenBSD: Client.pm,v 1.4 2017/08/15 04:11:20 bluhm Exp $
+#      $OpenBSD: Client.pm,v 1.5 2017/12/18 17:01:27 bluhm Exp $
 
-# Copyright (c) 2010-2013 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
@@ -29,6 +29,7 @@ use constant SO_BINDANY => 0x1000;
 sub new {
        my $class = shift;
        my %args = @_;
+       $args{ktracefile} ||= "client.ktrace";
        $args{logfile} ||= "client.log";
        $args{up} ||= "Connected";
        $args{down} ||= $args{alarm} ? "Alarm $class" :
@@ -43,6 +44,13 @@ sub new {
        $self->{connectport} || $self->{protocol} !~ /^(tcp|udp)$/
            or croak "$class connect port not given";
 
+       if ($self->{ktrace}) {
+               unlink $self->{ktracefile};
+               my @cmd = ("ktrace", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        my $cs;
        if ($self->{bindany}) {
                do { local $> = 0; $cs = IO::Socket::INET6->new(
@@ -73,6 +81,12 @@ sub new {
                $self->{cs} = $cs;
        }
 
+       if ($self->{ktrace}) {
+               my @cmd = ("ktrace", "-c", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        return $self;
 }
 

diff --git a/regress/sys/net/pf_divert/LICENSE b/regress/sys/net/pf_divert/LICENSE
index 407681a..52b2516 100644 (file)
--- a/regress/sys/net/pf_divert/LICENSE
+++ b/regress/sys/net/pf_divert/LICENSE
@@ -1,4 +1,4 @@
-# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above

diff --git a/regress/sys/net/pf_divert/Makefile b/regress/sys/net/pf_divert/Makefile
index 2c5f538..345fc50 100644 (file)
--- a/regress/sys/net/pf_divert/Makefile
+++ b/regress/sys/net/pf_divert/Makefile
@@ -1,4 +1,4 @@
-#      $OpenBSD: Makefile,v 1.18 2017/10/09 17:31:40 bluhm Exp $
+#      $OpenBSD: Makefile,v 1.19 2017/12/18 17:01:27 bluhm Exp $
 
 # The following ports must be installed for the regression tests:
 # p5-IO-Socket-INET6   object interface for AF_INET and AF_INET6 domain sockets
@@ -54,43 +54,44 @@ regress:
 PERLS =                        Client.pm Packet.pm Proc.pm Remote.pm Server.pm \
                        funcs.pl remote.pl
 ARGS !=                        cd ${.CURDIR} && ls args-*.pl
-TARGETS ?=             inet-args-tcp-to inet6-args-tcp-to \
-                       inet-args-tcp-reply inet6-args-tcp-reply \
-                       inet-args-udp-to inet6-args-udp-to \
-                       inet-args-udp-reply inet6-args-udp-reply \
-                       inet-args-udp-reply-to inet6-args-udp-reply-to \
-                       inet-args-rip-to inet6-args-rip-to \
-                       inet-args-rip-reply inet6-args-rip-reply \
-                       inet-args-rip-reply-to inet6-args-rip-reply-to \
-                       inet-args-icmp-to inet6-args-icmp-to \
-                       inet-args-icmp-reply-to inet6-args-icmp-reply-to \
-                       inet-args-icmp-reply-reuse inet6-args-icmp-reply-reuse \
-                       inet-reuse-tcp-to-to inet6-reuse-tcp-to-to \
-                       inet-reuse-tcp-to-reply inet6-reuse-tcp-to-reply \
-                       inet-reuse-tcp-reply-to inet6-reuse-tcp-reply-to \
-                       inet-reuse-tcp-reply-reply inet6-reuse-tcp-reply-reply \
-                       inet-reuse-udp-to-to inet6-reuse-udp-to-to \
-                       inet-reuse-udp-to-reply inet6-reuse-udp-to-reply \
-                       inet-reuse-udp-to-reply-to inet6-reuse-udp-to-reply-to \
-                       inet-reuse-udp-reply-to inet6-reuse-udp-reply-to \
-                       inet-reuse-udp-reply-reply inet6-reuse-udp-reply-reply \
-                       inet-reuse-udp-reply-reply-to inet6-reuse-udp-reply-reply-to \
-                       inet-reuse-udp-reply-to-to inet6-reuse-udp-reply-to-to \
-                       inet-reuse-udp-reply-to-reply inet6-reuse-udp-reply-to-reply \
-                       inet-reuse-udp-reply-to-reply-to inet6-reuse-udp-reply-to-reply-to \
-                       inet-reuse-rip-to-to inet6-reuse-rip-to-to \
-                       inet-reuse-rip-to-reply inet6-reuse-rip-to-reply \
-                       inet-reuse-rip-to-reply-to inet6-reuse-rip-to-reply-to \
-                       inet-reuse-rip-reply-to inet6-reuse-rip-reply-to \
-                       inet-reuse-rip-reply-reply inet6-reuse-rip-reply-reply \
-                       inet-reuse-rip-reply-reply-to inet6-reuse-rip-reply-reply-to \
-                       inet-reuse-rip-reply-to-to inet6-reuse-rip-reply-to-to \
-                       inet-reuse-rip-reply-to-reply inet6-reuse-rip-reply-to-reply \
-                       inet-reuse-rip-reply-to-reply-to inet6-reuse-rip-reply-to-reply-to \
-                       inet-args-udp-packet-in inet6-args-udp-packet-in \
-                       inet-args-udp-packet-out inet6-args-udp-packet-out
+TARGETS ?=             \
+       inet-args-tcp-to inet6-args-tcp-to \
+       inet-args-tcp-reply inet6-args-tcp-reply \
+       inet-args-udp-to inet6-args-udp-to \
+       inet-args-udp-reply inet6-args-udp-reply \
+       inet-args-udp-reply-to inet6-args-udp-reply-to \
+       inet-args-rip-to inet6-args-rip-to \
+       inet-args-rip-reply inet6-args-rip-reply \
+       inet-args-rip-reply-to inet6-args-rip-reply-to \
+       inet-args-icmp-to inet6-args-icmp-to \
+       inet-args-icmp-reply-to inet6-args-icmp-reply-to \
+       inet-args-icmp-reply-reuse inet6-args-icmp-reply-reuse \
+       inet-reuse-tcp-to-to inet6-reuse-tcp-to-to \
+       inet-reuse-tcp-to-reply inet6-reuse-tcp-to-reply \
+       inet-reuse-tcp-reply-to inet6-reuse-tcp-reply-to \
+       inet-reuse-tcp-reply-reply inet6-reuse-tcp-reply-reply \
+       inet-reuse-udp-to-to inet6-reuse-udp-to-to \
+       inet-reuse-udp-to-reply inet6-reuse-udp-to-reply \
+       inet-reuse-udp-to-reply-to inet6-reuse-udp-to-reply-to \
+       inet-reuse-udp-reply-to inet6-reuse-udp-reply-to \
+       inet-reuse-udp-reply-reply inet6-reuse-udp-reply-reply \
+       inet-reuse-udp-reply-reply-to inet6-reuse-udp-reply-reply-to \
+       inet-reuse-udp-reply-to-to inet6-reuse-udp-reply-to-to \
+       inet-reuse-udp-reply-to-reply inet6-reuse-udp-reply-to-reply \
+       inet-reuse-udp-reply-to-reply-to inet6-reuse-udp-reply-to-reply-to \
+       inet-reuse-rip-to-to inet6-reuse-rip-to-to \
+       inet-reuse-rip-to-reply inet6-reuse-rip-to-reply \
+       inet-reuse-rip-to-reply-to inet6-reuse-rip-to-reply-to \
+       inet-reuse-rip-reply-to inet6-reuse-rip-reply-to \
+       inet-reuse-rip-reply-reply inet6-reuse-rip-reply-reply \
+       inet-reuse-rip-reply-reply-to inet6-reuse-rip-reply-reply-to \
+       inet-reuse-rip-reply-to-to inet6-reuse-rip-reply-to-to \
+       inet-reuse-rip-reply-to-reply inet6-reuse-rip-reply-to-reply \
+       inet-reuse-rip-reply-to-reply-to inet6-reuse-rip-reply-to-reply-to \
+       inet-args-udp-packet-in inet6-args-udp-packet-in \
+       inet-args-udp-packet-out inet6-args-udp-packet-out
 REGRESS_TARGETS =      ${TARGETS:S/^/run-regress-/}
-CLEANFILES +=          *.log *.port ktrace.out stamp-*
+CLEANFILES +=          *.log *.port *.ktrace ktrace.out stamp-*
 
 .MAIN: all
 
@@ -138,9 +139,15 @@ run-regress-${inet}-reuse-rip-to-reply-to:
 run-regress-${inet}-${a:R}: ${a}
        @echo '\n======== $@ ========'
 .if ${@:M*-packet-*}
-       time ${SUDO} SUDO=${SUDO} perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} ${LOCAL_${addr}} ${REMOTE_${addr}} ${REMOTE_SSH} ${PERLPATH}${a}
+       time ${SUDO} SUDO=${SUDO} KTRACE=${KTRACE} \
+           perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} \
+           ${LOCAL_${addr}} ${REMOTE_${addr}} ${REMOTE_SSH} \
+           ${PERLPATH}${a}
 .else
-       time ${SUDO} SUDO=${SUDO} perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} ${PERLPATH}${a}
+       time ${SUDO} SUDO=${SUDO} KTRACE=${KTRACE} \
+           perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} \
+           ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} \
+           ${PERLPATH}${a}
 .endif
 .endfor
 
@@ -150,26 +157,41 @@ run-regress-${inet}-${a:R}: ${a}
 
 run-regress-${inet}-reuse-${proto}-${first}-${second}:
        @echo '\n======== $@ ========'
-       time ${SUDO} SUDO=${SUDO} perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} ${PERLPATH}args-${proto}-${first}.pl
+       time ${SUDO} SUDO=${SUDO} KTRACE=${KTRACE} \
+           perl ${PERLINC} ${PERLPATH}remote.pl -f ${inet} \
+           ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} \
+           ${PERLPATH}args-${proto}-${first}.pl
        sed -n '/^connect peer:/s/.* //p' client.log >client.port
        sed -n '/^connect sock:/s/.* //p' client.log >server.port
 .if "tcp" == ${proto}
 .if "reply" == ${first}
-       ${SUDO} tcpdrop ${LOCAL_${addr}} `cat client.port` ${FAKE_${addr}} `cat server.port`
+       ${SUDO} tcpdrop \
+           ${LOCAL_${addr}} `cat client.port` \
+           ${FAKE_${addr}} `cat server.port`
 .endif
 .if "to" == ${first}
-       ssh ${REMOTE_SSH} ${SUDO} tcpdrop ${FAKE_${addr}} `cat client.port` ${LOCAL_${addr}} `cat server.port`
+       ssh ${REMOTE_SSH} ${SUDO} tcpdrop \
+           ${FAKE_${addr}} `cat client.port` \
+           ${LOCAL_${addr}} `cat server.port`
 .endif
 .endif
-       time ${SUDO} SUDO=${SUDO} perl ${PERLINC} ${PERLPATH}remote.pl ${inet} ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} `cat client.port` `cat server.port` ${PERLPATH}args-${proto}-${second}.pl
+       time ${SUDO} SUDO=${SUDO} KTRACE=${KTRACE} \
+           perl ${PERLINC} ${PERLPATH}remote.pl ${inet} \
+           ${LOCAL_${addr}} ${FAKE_${addr}} ${REMOTE_SSH} \
+           `cat client.port` `cat server.port` \
+           ${PERLPATH}args-${proto}-${second}.pl
 .if "tcp" == ${proto}
 .if "reply" == ${second}
-       ${SUDO} tcpdrop ${LOCAL_${addr}} `cat server.port` ${FAKE_${addr}} `cat client.port`
+       ${SUDO} tcpdrop \
+           ${LOCAL_${addr}} `cat server.port` \
+           ${FAKE_${addr}} `cat client.port`
 .endif
 .if "to" == ${second}
        ssh ${REMOTE_SSH} ${SUDO} pfctl -ss | \
            egrep 'all ${proto} ${FAKE_${addr}}:?\[?'`cat server.port`\]?' .. ${LOCAL_${addr}}:?\[?'`cat client.port`'\]? '
-       ssh ${REMOTE_SSH} ${SUDO} tcpdrop ${FAKE_${addr}} `cat server.port` ${LOCAL_${addr}} `cat client.port`
+       ssh ${REMOTE_SSH} ${SUDO} tcpdrop \
+           ${FAKE_${addr}} `cat server.port` \
+           ${LOCAL_${addr}} `cat client.port`
        ssh ${REMOTE_SSH} ${SUDO} pfctl -ss | \
            ! egrep 'all ${proto} ${FAKE_${addr}}:?\[?'`cat server.port`\]?' .. ${LOCAL_${addr}}:?\[?'`cat client.port`'\]? '
 .endif

diff --git a/regress/sys/net/pf_divert/Packet.pm b/regress/sys/net/pf_divert/Packet.pm
index 7bb6315..dd84db8 100644 (file)
--- a/regress/sys/net/pf_divert/Packet.pm
+++ b/regress/sys/net/pf_divert/Packet.pm
@@ -1,4 +1,4 @@
-#      $OpenBSD: Packet.pm,v 1.3 2017/10/09 17:31:40 bluhm Exp $
+#      $OpenBSD: Packet.pm,v 1.4 2017/12/18 17:01:27 bluhm Exp $
 
 # Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 #
@@ -30,12 +30,21 @@ use constant IPPROTO_DIVERT => 258;
 sub new {
        my $class = shift;
        my %args = @_;
+       $args{ktracefile} ||= "packet.ktrace";
        $args{logfile} ||= "packet.log";
        $args{up} ||= "Bound";
        $args{down} ||= "Shutdown $class";
        my $self = Proc::new($class, %args);
        $self->{domain}
            or croak "$class domain not given";
+
+       if ($self->{ktrace}) {
+               unlink $self->{ktracefile};
+               my @cmd = ("ktrace", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        my $ds = do { local $> = 0; IO::Socket::INET6->new(
            Type        => Socket::SOCK_RAW,
            Proto       => IPPROTO_DIVERT,
@@ -53,6 +62,13 @@ sub new {
        $self->{divertaddr} = $ds->sockhost();
        $self->{divertport} = $ds->sockport();
        $self->{ds} = $ds;
+
+       if ($self->{ktrace}) {
+               my @cmd = ("ktrace", "-c", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        return $self;
 }
 

diff --git a/regress/sys/net/pf_divert/Proc.pm b/regress/sys/net/pf_divert/Proc.pm
index f07dfba..91213d5 100644 (file)
--- a/regress/sys/net/pf_divert/Proc.pm
+++ b/regress/sys/net/pf_divert/Proc.pm
@@ -1,6 +1,6 @@
-#      $OpenBSD: Proc.pm,v 1.5 2017/08/15 04:11:20 bluhm Exp $
+#      $OpenBSD: Proc.pm,v 1.6 2017/12/18 17:01:27 bluhm Exp $
 
-# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
@@ -46,6 +46,8 @@ sub new {
        $self->{down} ||= $self->{alarm} ? "Alarm $class" : "Shutdown $class";
        $self->{func} && ref($self->{func}) eq 'CODE'
            or croak "$class func not given";
+       !$self->{ktrace} || $self->{ktracefile}
+           or croak "$class ktrace file not given";
        $self->{logfile}
            or croak "$class log file not given";
        open(my $fh, '>', $self->{logfile})
@@ -76,6 +78,16 @@ sub run {
        open(STDERR, '>&', $self->{log})
            or die ref($self), " dup STDERR failed: $!";
 
+       if ($self->{ktrace}) {
+               my @cmd = ("ktrace", "-af", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+               my $uid = $>;
+               do { local $> = 0; chown $uid, -1, $self->{ktracefile} }
+                   or die ref($self),
+                   " chown $uid '$self->{ktracefile}' failed: $?";
+       }
+
        $self->child();
        print STDERR $self->{up}, "\n";
        alarm($self->{alarm}) if $self->{alarm};

diff --git a/regress/sys/net/pf_divert/README b/regress/sys/net/pf_divert/README
index c602d4e..acfc9ad 100644 (file)
--- a/regress/sys/net/pf_divert/README
+++ b/regress/sys/net/pf_divert/README
@@ -48,3 +48,11 @@ args-...-reply and args-...-reply-to tests consecutively to check
 that the pf states to not interfere.  The first run flushes the
 state, the second must get rid of the state automatically.  For TCP
 the connection in TIME_WAIT is dropped to remove the state.
+
+SUDO=sudo
+As pf and bindany need root privileges either run the tests as root
+or set this variable and run make as a regular user.
+
+KTRACE=ktrace
+Set this variable if you want a ktrace output from client and server.
+Note that ktrace is invoked after sudo as sudo would disable it.

diff --git a/regress/sys/net/pf_divert/Remote.pm b/regress/sys/net/pf_divert/Remote.pm
index d51dd8a..8734ebf 100644 (file)
--- a/regress/sys/net/pf_divert/Remote.pm
+++ b/regress/sys/net/pf_divert/Remote.pm
@@ -1,4 +1,4 @@
-#      $OpenBSD: Remote.pm,v 1.9 2017/09/01 17:44:00 bluhm Exp $
+#      $OpenBSD: Remote.pm,v 1.10 2017/12/18 17:01:27 bluhm Exp $
 
 # Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
 #
@@ -22,10 +22,12 @@ use parent 'Proc';
 use Carp;
 use Cwd;
 use File::Basename;
+use File::Copy;
 
 sub new {
        my $class = shift;
        my %args = @_;
+       $args{ktracefile} ||= "remote.ktrace";
        $args{logfile} ||= "remote.log";
        $args{up} ||= "Started";
        $args{down} ||= "Shutdown";
@@ -63,6 +65,42 @@ sub up {
        return $self;
 }
 
+sub down {
+       my $self = Proc::down(shift, @_);
+
+       if ($ENV{KTRACE}) {
+               my @sshopts = $ENV{SSH_OPTIONS} ?
+                   split(' ', $ENV{SSH_OPTIONS}) : ();
+               my $dir = dirname($0);
+               $dir = getcwd() if ! $dir || $dir eq ".";
+               my $ktr;
+
+               my @cmd = ("ssh", "-n", @sshopts, $self->{remotessh},
+                   "cat", "$dir/remote.ktrace");
+               do { local $< = $>; open($ktr, '-|', @cmd) }
+                   or die ref($self), " open pipe from '@cmd' failed: $!";
+               unlink $self->{ktracefile};
+               copy($ktr, $self->{ktracefile});
+               close($ktr) or die ref($self), $! ?
+                   " close pipe from '@cmd' failed: $!" :
+                   " '@cmd' failed: $?";
+
+               if ($self->{packet}) {
+                       @cmd = ("ssh", "-n", @sshopts, $self->{remotessh},
+                           "cat", "$dir/packet.ktrace");
+                       do { local $< = $>; open($ktr, '-|', @cmd) }
+                           or die ref($self),
+                           " open pipe from '@cmd' failed: $!";
+                       unlink "packet.ktrace";
+                       copy($ktr, "packet.ktrace");
+                       close($ktr) or die ref($self), $! ?
+                           " close pipe from '@cmd' failed: $!" :
+                           " '@cmd' failed: $?";
+               }
+       }
+       return $self;
+}
+
 sub child {
        my $self = shift;
        my @remoteopts;
@@ -79,9 +117,11 @@ sub child {
        print STDERR $self->{up}, "\n";
        my @sshopts = $ENV{SSH_OPTIONS} ? split(' ', $ENV{SSH_OPTIONS}) : ();
        my @sudo = $ENV{SUDO} ? ($ENV{SUDO}, "SUDO=$ENV{SUDO}") : ();
+       my @ktrace = $ENV{KTRACE} ? "KTRACE=$ENV{KTRACE}" : ();
        my $dir = dirname($0);
        $dir = getcwd() if ! $dir || $dir eq ".";
-       my @cmd = ("ssh", "-n", @sshopts, $self->{remotessh}, @sudo, "perl",
+       my @cmd = ("ssh", $self->{remotessh},
+           @sudo, @ktrace, "perl",
            "-I", $dir, "$dir/".basename($0), @remoteopts, $self->{af},
            $self->{bindaddr}, $self->{connectaddr}, $self->{connectport},
            ($self->{bindport} ? $self->{bindport} : ()),

diff --git a/regress/sys/net/pf_divert/Server.pm b/regress/sys/net/pf_divert/Server.pm
index ea1c06a..564f11d 100644 (file)
--- a/regress/sys/net/pf_divert/Server.pm
+++ b/regress/sys/net/pf_divert/Server.pm
@@ -1,6 +1,6 @@
-#      $OpenBSD: Server.pm,v 1.4 2017/08/15 04:11:20 bluhm Exp $
+#      $OpenBSD: Server.pm,v 1.5 2017/12/18 17:01:27 bluhm Exp $
 
-# Copyright (c) 2010-2013 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
@@ -28,6 +28,7 @@ use IO::Socket::INET6;
 sub new {
        my $class = shift;
        my %args = @_;
+       $args{ktracefile} ||= "server.ktrace";
        $args{logfile} ||= "server.log";
        $args{up} ||= "Accepted";
        $args{down} ||= "Shutdown $class";
@@ -36,6 +37,14 @@ sub new {
            or croak "$class domain not given";
        $self->{protocol}
            or croak "$class protocol not given";
+
+       if ($self->{ktrace}) {
+               unlink $self->{ktracefile};
+               my @cmd = ("ktrace", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        my $ls = do { local $> = 0; IO::Socket::INET6->new(
            Type        => $self->{socktype},
            Proto       => $self->{protocol},
@@ -69,6 +78,13 @@ sub new {
        $self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr};
        $self->{listenport} = $ls->sockport() unless $self->{listenport};
        $self->{ls} = $ls;
+
+       if ($self->{ktrace}) {
+               my @cmd = ("ktrace", "-c", "-f", $self->{ktracefile}, "-p", $$);
+               do { local $> = 0; system(@cmd) }
+                   and die ref($self), " system '@cmd' failed: $?";
+       }
+
        return $self;
 }
 

diff --git a/regress/sys/net/pf_divert/remote.pl b/regress/sys/net/pf_divert/remote.pl
index 6257d60..a32330f 100644 (file)
--- a/regress/sys/net/pf_divert/remote.pl
+++ b/regress/sys/net/pf_divert/remote.pl
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-#      $OpenBSD: remote.pl,v 1.8 2017/08/15 04:11:20 bluhm Exp $
+#      $OpenBSD: remote.pl,v 1.9 2017/12/18 17:01:27 bluhm Exp $
 
 # Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
 #
@@ -94,18 +94,22 @@ my ($srcaddr, $dstaddr)     = @ARGV[0,1];
 ($srcaddr, $dstaddr) = ($dstaddr, $srcaddr) if $mode eq "divert";
 ($srcaddr, $dstaddr) = ($dstaddr, $srcaddr) if $divert =~ /reply|out/;
 
-my ($logfile, $packetlog);
+my ($logfile, $ktracefile, $packetlog, $packetktrace);
 if ($mode eq "divert") {
        $logfile        = dirname($0)."/remote.log";
+       $ktracefile     = dirname($0)."/remote.ktrace";
        $packetlog      = dirname($0)."/packet.log";
+       $packetktrace   = dirname($0)."/packet.ktrace";
 }
 
 my ($c, $l, $r, $s);
 if ($local eq "server") {
        $l = $s = Server->new(
+           ktrace              => $ENV{KTRACE},
            %args,
            %{$args{server}},
            logfile             => $logfile,
+           ktracefile          => $ktracefile,
            af                  => $af,
            domain              => $domain,
            protocol            => $protocol,
@@ -123,6 +127,7 @@ if ($mode eq "auto") {
            opts                => \%opts,
            down                => $args{packet} && "Shutdown Packet",
            logfile             => "$remote.log",
+           ktracefile          => "$remote.ktrace",
            testfile            => $test,
            af                  => $af,
            remotessh           => $ARGV[2],
@@ -139,9 +144,11 @@ if ($mode eq "auto") {
 }
 if ($local eq "client") {
        $l = $c = Client->new(
+           ktrace              => $ENV{KTRACE},
            %args,
            %{$args{client}},
            logfile             => $logfile,
+           ktracefile          => $ktracefile,
            af                  => $af,
            domain              => $domain,
            protocol            => $protocol,
@@ -169,9 +176,11 @@ if ($mode eq "divert") {
 
        my ($p, $plog);
        $p = Packet->new(
+           ktrace              => $ENV{KTRACE},
            %args,
            %{$args{packet}},
            logfile             => $packetlog,
+           ktracefile          => $packetktrace,
            af                  => $af,
            domain              => $domain,
            bindport            => 666,