xref: /openbsd-src/regress/sys/kern/sosplice/loop/loop.pl (revision f6246b7f478ea7b2b6df549ae5998f8112d22650) 
1#!/usr/bin/perl
2#	$OpenBSD: loop.pl,v 1.1 2021/01/02 01:27:45 bluhm Exp $
3
4# Copyright (c) 2021 Alexander Bluhm <bluhm@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use strict;
19use warnings;
20use BSD::Socket::Splice qw(setsplice geterror);
21use Errno;
22use Getopt::Std;
23use IO::Socket::IP;
24use Socket qw(getnameinfo AI_PASSIVE NI_NUMERICHOST NI_NUMERICSERV);
25
26# from /usr/include/sys/mbuf.h
27use constant M_MAXLOOP => 128;
28
29my %opts;
30getopts('46p:v', \%opts) or do {
31    print STDERR <<"EOF";
32usage: $0 [-46v] [-p proto]
33    -4		use IPv4
34    -6		use IPv6
35    -p proto	protocol, tcp or udp, default tcp
36    -v		verbose
37EOF
38    exit(2);
39};
40
41$opts{4} && $opts{6}
42    and die "Cannot use -4 and -6 together";
43my $localhost = $opts{4} ? "127.0.0.1" : $opts{6} ? "::1" : "localhost";
44my $proto = $opts{p} || "tcp";
45my $type = $proto eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;
46my $verbose = $opts{v};
47
48my $timeout = 10;
49$SIG{ALRM} = sub { die "Timeout triggered after $timeout seconds" };
50alarm($timeout);
51
52my $ls = IO::Socket::IP->new(
53    GetAddrInfoFlags	=> AI_PASSIVE,
54    Listen		=> ($type == SOCK_STREAM) ? 1 : undef,
55    LocalHost		=> $localhost,
56    Proto		=> $proto,
57    Type		=> $type,
58) or die "Listen socket failed: $@";
59my ($host, $service) = $ls->sockhost_service(1);
60print "listen on host '$host' service '$service'\n" if $verbose;
61
62my $cs = IO::Socket::IP->new(
63    PeerHost		=> $host,
64    PeerService		=> $service,
65    Proto		=> $proto,
66    Type		=> $type,
67) or die "Connect socket failed: $@";
68print "connect to host '$host' service '$service'\n" if $verbose;
69
70my ($as, $peer);
71if ($type == SOCK_STREAM) {
72    ($as, $peer) = $ls->accept()
73	or die "Accept socket failed: $!";
74} else {
75    $as = $ls;
76    $peer = $cs->sockname();
77    $as->connect($peer)
78	or die "Connect passive socket failed: $!";
79}
80if ($verbose) {
81    my ($err, $peerhost, $peerservice) = getnameinfo($peer,
82	NI_NUMERICHOST | NI_NUMERICSERV);
83    $err and die "Getnameinfo failed: $err";
84    print "accept from host '$peerhost' service '$peerservice'\n";
85}
86
87setsplice($as, $cs)
88    or die "Splice accept to connect socket failed: $!";
89setsplice($cs, $as)
90    or die "Splice connect to accept socket failed: $!";
91
92system("\${SUDO} fstat -n -p $$") if $verbose;
93my ($msg, $buf) = "foo";
94$cs->send($msg, 0)
95    or die "Send to connect socket failed: $!";
96defined $as->recv($buf, 100, 0)
97    or die "Recv from accept socket failed: $!";
98$msg eq $buf
99    or die "Value modified in splice chain";
100$! = geterror($as)
101    or die "No error at accept socket";
102$!{ELOOP}
103    or die "Errno at accept socket is not ELOOP: $!";
104