1#!/usr/bin/perl 2# $OpenBSD: chain.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('46c:p:v', \%opts) or do { 31 print STDERR <<"EOF"; 32usage: $0 [-46v] [-c count] [-p proto] 33 -4 use IPv4 34 -6 use IPv6 35 -c count number of splices in the chain, default 1 36 -p proto protocol, tcp or udp, default tcp 37 -v verbose 38EOF 39 exit(2); 40}; 41 42$opts{4} && $opts{6} 43 and die "Cannot use -4 and -6 together"; 44my $localhost = $opts{4} ? "127.0.0.1" : $opts{6} ? "::1" : "localhost"; 45my $count = $opts{c} || 1; 46my $proto = $opts{p} || "tcp"; 47my $type = $proto eq "tcp" ? SOCK_STREAM : SOCK_DGRAM; 48my $verbose = $opts{v}; 49 50my $timeout = 10; 51$SIG{ALRM} = sub { die "Timeout triggered after $timeout seconds" }; 52alarm($timeout); 53 54my $ls = IO::Socket::IP->new( 55 GetAddrInfoFlags => AI_PASSIVE, 56 Listen => ($type == SOCK_STREAM) ? 1 : undef, 57 LocalHost => $localhost, 58 Proto => $proto, 59 Type => $type, 60) or die "Listen socket failed: $@"; 61my ($host, $service) = $ls->sockhost_service(1); 62print "listen on host '$host' service '$service'\n" if $verbose; 63 64my (@cs, @as); 65foreach (0..$count) { 66 my $cs = IO::Socket::IP->new( 67 PeerHost => $host, 68 PeerService => $service, 69 Proto => $proto, 70 Type => $type, 71 ) or die "Connect socket failed: $@"; 72 print "connect to host '$host' service '$service'\n" if $verbose; 73 74 my $as; 75 if ($type == SOCK_STREAM) { 76 ($as, my $peer) = $ls->accept() 77 or die "Accept socket failed: $!"; 78 if ($verbose) { 79 my ($err, $peerhost, $peerservice) = getnameinfo($peer, 80 NI_NUMERICHOST | NI_NUMERICSERV); 81 $err and die "Getnameinfo failed: $err"; 82 print "accept from host '$peerhost' service '$peerservice'\n"; 83 } 84 } else { 85 $as = $ls; 86 $ls = IO::Socket::IP->new( 87 GetAddrInfoFlags => AI_PASSIVE, 88 LocalHost => $localhost, 89 Proto => $proto, 90 Type => $type, 91 ) or die "Listen socket failed: $@"; 92 ($host, $service) = $ls->sockhost_service(1); 93 } 94 if (@as) { 95 setsplice($as[-1], $cs) 96 or die "Splice previous accept to connect socket failed: $!"; 97 } 98 push @cs, $cs; 99 push @as, $as; 100} 101 102system("\${SUDO} fstat -n -p $$") if $verbose; 103my ($msg, $buf) = "foo"; 104$cs[0]->send($msg, 0) 105 or die "Send to first connect socket failed: $!"; 106if ($count > M_MAXLOOP) { 107 $as[-1]->blocking(0); 108 sleep 1; 109 defined $as[-1]->recv($buf, 100, 0) 110 and die "Recv from last accept socket succeeded: $buf"; 111 $!{EWOULDBLOCK} 112 or die "Recv errno is not EWOULDBLOCK: $!"; 113 # reaching maxloop unsplices, message stays in socket 114 $#as = M_MAXLOOP; 115 $! = geterror($as[-1]) 116 or die "No error at maxloop accept socket"; 117 $!{ELOOP} 118 or die "Errno at maxloop accept socket is not ELOOP: $!"; 119} 120defined $as[-1]->recv($buf, 100, 0) 121 or die "Recv from last accept socket failed: $!"; 122$msg eq $buf 123 or die "Value modified in splice chain"; 124