1*e1860033Sbluhm# $OpenBSD: funcs.pl,v 1.9 2017/11/08 22:14:02 bluhm Exp $ 2f39f8f30Sbluhm 3*e1860033Sbluhm# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org> 4f39f8f30Sbluhm# 5f39f8f30Sbluhm# Permission to use, copy, modify, and distribute this software for any 6f39f8f30Sbluhm# purpose with or without fee is hereby granted, provided that the above 7f39f8f30Sbluhm# copyright notice and this permission notice appear in all copies. 8f39f8f30Sbluhm# 9f39f8f30Sbluhm# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10f39f8f30Sbluhm# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11f39f8f30Sbluhm# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12f39f8f30Sbluhm# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13f39f8f30Sbluhm# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14f39f8f30Sbluhm# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15f39f8f30Sbluhm# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16f39f8f30Sbluhm 17f39f8f30Sbluhmuse strict; 18f39f8f30Sbluhmuse warnings; 1997118090Sbluhmno warnings 'experimental::smartmatch'; 20f39f8f30Sbluhmuse feature 'switch'; 21f39f8f30Sbluhmuse Errno; 22f39f8f30Sbluhmuse Digest::MD5; 23f39f8f30Sbluhmuse IO::Socket qw(sockatmark); 24f39f8f30Sbluhmuse Socket; 25f39f8f30Sbluhmuse Time::HiRes qw(time alarm sleep); 26f39f8f30Sbluhmuse BSD::Socket::Splice qw(setsplice getsplice geterror); 27f39f8f30Sbluhm 28f39f8f30Sbluhm######################################################################## 29f39f8f30Sbluhm# Client funcs 30f39f8f30Sbluhm######################################################################## 31f39f8f30Sbluhm 32f39f8f30Sbluhmsub write_stream { 33f39f8f30Sbluhm my $self = shift; 34f39f8f30Sbluhm my $len = shift // $self->{len} // 251; 35f39f8f30Sbluhm my $sleep = $self->{sleep}; 36f39f8f30Sbluhm 37f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 38f39f8f30Sbluhm my $char = '0'; 39f39f8f30Sbluhm for (my $i = 1; $i < $len; $i++) { 40f39f8f30Sbluhm $ctx->add($char); 41f39f8f30Sbluhm print $char 42f39f8f30Sbluhm or die ref($self), " print failed: $!"; 43f39f8f30Sbluhm given ($char) { 44f39f8f30Sbluhm when(/9/) { $char = 'A' } 45f39f8f30Sbluhm when(/Z/) { $char = 'a' } 46f39f8f30Sbluhm when(/z/) { $char = "\n" } 47f39f8f30Sbluhm when(/\n/) { print STDERR "."; $char = '0' } 48f39f8f30Sbluhm default { $char++ } 49f39f8f30Sbluhm } 50f39f8f30Sbluhm if ($self->{sleep}) { 51f39f8f30Sbluhm IO::Handle::flush(\*STDOUT); 52f39f8f30Sbluhm sleep $self->{sleep}; 53f39f8f30Sbluhm } 54f39f8f30Sbluhm } 55f39f8f30Sbluhm if ($len) { 56f3d4320dSbluhm $ctx->add("\n"); 57f3d4320dSbluhm print "\n" 58f39f8f30Sbluhm or die ref($self), " print failed: $!"; 59f39f8f30Sbluhm print STDERR ".\n"; 60f39f8f30Sbluhm } 61f39f8f30Sbluhm IO::Handle::flush(\*STDOUT); 62f39f8f30Sbluhm 63f39f8f30Sbluhm print STDERR "LEN: $len\n"; 64f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 65f39f8f30Sbluhm} 66f39f8f30Sbluhm 67f39f8f30Sbluhmsub write_oob { 68f39f8f30Sbluhm my $self = shift; 69f39f8f30Sbluhm my $len = shift // $self->{len} // 251; 70f39f8f30Sbluhm 71f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 72f39f8f30Sbluhm my $msg = ""; 73f39f8f30Sbluhm my $char = '0'; 74f39f8f30Sbluhm for (my $i = 1; $i < $len; $i++) { 75f39f8f30Sbluhm $msg .= $char; 76f39f8f30Sbluhm given ($char) { 77f39f8f30Sbluhm when(/9/) { 78f39f8f30Sbluhm $ctx->add("[$char]"); 79f39f8f30Sbluhm defined(send(STDOUT, $msg, MSG_OOB)) 80f39f8f30Sbluhm or die ref($self), " send OOB failed: $!"; 81f39f8f30Sbluhm # If tcp urgent data is sent too fast, 82f39f8f30Sbluhm # it may get overwritten and lost. 83f39f8f30Sbluhm sleep .1; 84f39f8f30Sbluhm $msg = ""; 85f39f8f30Sbluhm $char = 'A'; 86f39f8f30Sbluhm } 87f39f8f30Sbluhm when(/Z/) { $ctx->add($char); $char = 'a' } 88f39f8f30Sbluhm when(/z/) { $ctx->add($char); $char = "\n" } 89f39f8f30Sbluhm when(/\n/) { 90f39f8f30Sbluhm $ctx->add($char); 91f39f8f30Sbluhm defined(send(STDOUT, $msg, 0)) 92f39f8f30Sbluhm or die ref($self), " send failed: $!"; 93f39f8f30Sbluhm print STDERR "."; 94f39f8f30Sbluhm $msg = ""; 95f39f8f30Sbluhm $char = '0'; 96f39f8f30Sbluhm } 97f39f8f30Sbluhm default { $ctx->add($char); $char++ } 98f39f8f30Sbluhm } 99f39f8f30Sbluhm } 100f39f8f30Sbluhm if ($len) { 101f3d4320dSbluhm $msg .= "\n"; 102f3d4320dSbluhm $ctx->add("\n"); 103f39f8f30Sbluhm send(STDOUT, $msg, 0) 104f39f8f30Sbluhm or die ref($self), " send failed: $!"; 105f39f8f30Sbluhm print STDERR ".\n"; 106f39f8f30Sbluhm } 107f39f8f30Sbluhm IO::Handle::flush(\*STDOUT); 108f39f8f30Sbluhm 109f39f8f30Sbluhm print STDERR "LEN: $len\n"; 110f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 111f39f8f30Sbluhm} 112f39f8f30Sbluhm 113f39f8f30Sbluhmsub write_datagram { 114f39f8f30Sbluhm my $self = shift; 115f39f8f30Sbluhm my @lengths = @{$self->{lengths} || [ shift // $self->{len} // 251 ]}; 116f39f8f30Sbluhm my $sleep = $self->{sleep}; 117f39f8f30Sbluhm 118f39f8f30Sbluhm my $len = 0; 119f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 120f39f8f30Sbluhm my $char = '0'; 121f39f8f30Sbluhm my @md5s; 122f39f8f30Sbluhm for (my $num = 0; $num < @lengths; $num++) { 123f39f8f30Sbluhm my $l = $lengths[$num]; 124f39f8f30Sbluhm my $string = ""; 125f39f8f30Sbluhm for (my $i = 1; $i < $l; $i++) { 126f39f8f30Sbluhm $ctx->add($char); 127f39f8f30Sbluhm $string .= $char; 128f39f8f30Sbluhm given ($char) { 129f39f8f30Sbluhm when(/9/) { $char = 'A' } 130f39f8f30Sbluhm when(/Z/) { $char = 'a' } 131f39f8f30Sbluhm when(/z/) { $char = "\n" } 132f39f8f30Sbluhm when(/\n/) { $char = '0' } 133f39f8f30Sbluhm default { $char++ } 134f39f8f30Sbluhm } 135f39f8f30Sbluhm } 136f39f8f30Sbluhm if ($l) { 137f3d4320dSbluhm $ctx->add("\n"); 138f3d4320dSbluhm $string .= "\n"; 139f39f8f30Sbluhm } 140f39f8f30Sbluhm defined(my $write = syswrite(STDOUT, $string)) 141f39f8f30Sbluhm or die ref($self), " syswrite number $num failed: $!"; 142f39f8f30Sbluhm $write == $l 143f39f8f30Sbluhm or die ref($self), " syswrite length $l did write $write"; 144f39f8f30Sbluhm $len += $write; 145f39f8f30Sbluhm print STDERR "."; 146f39f8f30Sbluhm sleep $self->{sleep} if $self->{sleep}; 147f39f8f30Sbluhm } 148f39f8f30Sbluhm print STDERR "\n"; 149f39f8f30Sbluhm 150f39f8f30Sbluhm print STDERR "LEN: $len\n"; 151f39f8f30Sbluhm print STDERR "LENGTHS: @lengths\n"; 152f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 153f39f8f30Sbluhm} 154f39f8f30Sbluhm 155f39f8f30Sbluhmsub solingerout { 156f39f8f30Sbluhm my $self = shift; 157f39f8f30Sbluhm 158f39f8f30Sbluhm setsockopt(STDOUT, SOL_SOCKET, SO_LINGER, pack('ii', 1, 0)) 159f39f8f30Sbluhm or die ref($self), " set linger out failed: $!"; 160f39f8f30Sbluhm} 161f39f8f30Sbluhm 162f39f8f30Sbluhm######################################################################## 163f39f8f30Sbluhm# Relay funcs 164f39f8f30Sbluhm######################################################################## 165f39f8f30Sbluhm 166f39f8f30Sbluhmsub relay_copy_stream { 167f39f8f30Sbluhm my $self = shift; 168f39f8f30Sbluhm my $max = $self->{max}; 169f39f8f30Sbluhm my $idle = $self->{idle}; 170f39f8f30Sbluhm my $size = $self->{size} || 8093; 171f39f8f30Sbluhm 172f39f8f30Sbluhm my $len = 0; 173f39f8f30Sbluhm while (1) { 174f39f8f30Sbluhm my $rin = my $win = my $ein = ''; 175f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 176f39f8f30Sbluhm vec($ein, fileno(STDIN), 1) = 1 unless $self->{oobinline}; 177f39f8f30Sbluhm defined(my $n = select($rin, undef, $ein, $idle)) 178f39f8f30Sbluhm or die ref($self), " select failed: $!"; 179f39f8f30Sbluhm if ($idle && $n == 0) { 180f39f8f30Sbluhm print STDERR "\n"; 181f39f8f30Sbluhm print STDERR "Timeout\n"; 182f39f8f30Sbluhm last; 183f39f8f30Sbluhm } 184f39f8f30Sbluhm my $buf; 185f39f8f30Sbluhm my $atmark = sockatmark(\*STDIN) 186f39f8f30Sbluhm or die ref($self), " sockatmark failed: $!"; 187f39f8f30Sbluhm if ($atmark == 1) { 188f39f8f30Sbluhm if ($self->{oobinline}) { 189f39f8f30Sbluhm defined(recv(STDIN, $buf, 1, 0)) 190f39f8f30Sbluhm or die ref($self), " recv OOB failed: $!"; 191f39f8f30Sbluhm $len += length($buf); 192f39f8f30Sbluhm defined(send(STDOUT, $buf, MSG_OOB)) 193f39f8f30Sbluhm or die ref($self), " send OOB failed: $!"; 194f39f8f30Sbluhm } else { 195f39f8f30Sbluhm defined(recv(STDIN, $buf, 1, MSG_OOB)) || 196f39f8f30Sbluhm $!{EINVAL} 197f39f8f30Sbluhm or die ref($self), " recv OOB failed: $!"; 198f39f8f30Sbluhm print STDERR "OOB: $buf\n" if length($buf); 199f39f8f30Sbluhm } 200f39f8f30Sbluhm } 201f39f8f30Sbluhm if ($self->{nonblocking}) { 202f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 203f39f8f30Sbluhm select($rin, undef, undef, undef) 204f39f8f30Sbluhm or die ref($self), " select read failed: $!"; 205f39f8f30Sbluhm } 206f39f8f30Sbluhm my $read = sysread(STDIN, $buf, 207f39f8f30Sbluhm $max && $max < $size ? $max : $size); 20839b41f2bSbluhm next if !defined($read) && $!{EAGAIN}; 209f39f8f30Sbluhm defined($read) 210f39f8f30Sbluhm or die ref($self), " sysread at $len failed: $!"; 211f39f8f30Sbluhm if ($read == 0) { 212f39f8f30Sbluhm print STDERR "\n"; 213f39f8f30Sbluhm print STDERR "End\n"; 214f39f8f30Sbluhm last; 215f39f8f30Sbluhm } 216f39f8f30Sbluhm print STDERR "."; 217f39f8f30Sbluhm if ($max && $len + $read > $max) { 218f39f8f30Sbluhm $read = $max - $len; 219f39f8f30Sbluhm } 220f39f8f30Sbluhm my $off = 0; 221f39f8f30Sbluhm while ($off < $read) { 222f39f8f30Sbluhm if ($self->{nonblocking}) { 223f39f8f30Sbluhm vec($win, fileno(STDOUT), 1) = 1; 224f39f8f30Sbluhm select(undef, $win, undef, undef) 225f39f8f30Sbluhm or die ref($self), 226f39f8f30Sbluhm " select write failed: $!"; 227f39f8f30Sbluhm } 228f39f8f30Sbluhm my $write; 229f39f8f30Sbluhm # Unfortunately Perl installs signal handlers without 230f39f8f30Sbluhm # SA_RESTART. Work around by restarting manually. 231f39f8f30Sbluhm do { 232f39f8f30Sbluhm $write = syswrite(STDOUT, $buf, $read - $off, 233f39f8f30Sbluhm $off); 234f39f8f30Sbluhm } while (!defined($write) && $!{EINTR}); 235f39f8f30Sbluhm defined($write) || $!{ETIMEDOUT} 236f39f8f30Sbluhm or die ref($self), " syswrite at $len failed: $!"; 237f39f8f30Sbluhm defined($write) or next; 238f39f8f30Sbluhm $off += $write; 239f39f8f30Sbluhm $len += $write; 240f39f8f30Sbluhm } 241f39f8f30Sbluhm if ($max && $len == $max) { 242f39f8f30Sbluhm print STDERR "\n"; 243c5ecd18cSbluhm print STDERR "Big\n"; 244f39f8f30Sbluhm print STDERR "Max\n"; 245f39f8f30Sbluhm last; 246f39f8f30Sbluhm } 247f39f8f30Sbluhm } 248f39f8f30Sbluhm 249f39f8f30Sbluhm print STDERR "LEN: $len\n"; 250f39f8f30Sbluhm} 251f39f8f30Sbluhm 252f39f8f30Sbluhmsub relay_copy_datagram { 253f39f8f30Sbluhm my $self = shift; 254f39f8f30Sbluhm my $max = $self->{max}; 255f39f8f30Sbluhm my $idle = $self->{idle}; 256f39f8f30Sbluhm my $size = $self->{size} || 2**16; 257f39f8f30Sbluhm 258f39f8f30Sbluhm my $len = 0; 259f39f8f30Sbluhm for (my $num = 0;; $num++) { 260f39f8f30Sbluhm my $rin = my $win = ''; 261f39f8f30Sbluhm if ($idle) { 262f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 263f39f8f30Sbluhm defined(my $n = select($rin, undef, undef, $idle)) 264f39f8f30Sbluhm or die ref($self), " select idle failed: $!"; 265f39f8f30Sbluhm if ($n == 0) { 266f39f8f30Sbluhm print STDERR "\n"; 267f39f8f30Sbluhm print STDERR "Timeout\n"; 268f39f8f30Sbluhm last; 269f39f8f30Sbluhm } 270f39f8f30Sbluhm } elsif ($self->{nonblocking}) { 271f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 272f39f8f30Sbluhm select($rin, undef, undef, undef) 273f39f8f30Sbluhm or die ref($self), " select read failed: $!"; 274f39f8f30Sbluhm } 275f39f8f30Sbluhm defined(my $read = sysread(STDIN, my $buf, $size)) 276f39f8f30Sbluhm or die ref($self), " sysread number $num failed: $!"; 277f39f8f30Sbluhm print STDERR "."; 278f39f8f30Sbluhm 279f39f8f30Sbluhm if ($max && $len + $read > $max) { 280f39f8f30Sbluhm print STDERR "\n"; 281f39f8f30Sbluhm print STDERR "Max\n"; 282f39f8f30Sbluhm last; 283f39f8f30Sbluhm } 284f39f8f30Sbluhm 285f39f8f30Sbluhm if ($self->{nonblocking}) { 286f39f8f30Sbluhm vec($win, fileno(STDOUT), 1) = 1; 287f39f8f30Sbluhm select(undef, $win, undef, undef) 288f39f8f30Sbluhm or die ref($self), " select write failed: $!"; 289f39f8f30Sbluhm } 290f3d4320dSbluhm defined(my $write = syswrite(STDOUT, $buf)) 291f39f8f30Sbluhm or die ref($self), " syswrite number $num failed: $!"; 292f39f8f30Sbluhm if (defined($write)) { 293f39f8f30Sbluhm $read == $write 294f39f8f30Sbluhm or die ref($self), " syswrite read $read ". 295f39f8f30Sbluhm "did write $write"; 296f39f8f30Sbluhm $len += $write; 297f39f8f30Sbluhm } 298f39f8f30Sbluhm 299f39f8f30Sbluhm if ($max && $len == $max) { 300f39f8f30Sbluhm print STDERR "\n"; 301c5ecd18cSbluhm print STDERR "Big\n"; 302f39f8f30Sbluhm print STDERR "Max\n"; 303f39f8f30Sbluhm last; 304f39f8f30Sbluhm } 305f39f8f30Sbluhm } 306f39f8f30Sbluhm 307f39f8f30Sbluhm print STDERR "LEN: $len\n"; 308f39f8f30Sbluhm} 309f39f8f30Sbluhm 310f39f8f30Sbluhmsub relay_copy { 311f39f8f30Sbluhm my $self = shift; 312f39f8f30Sbluhm my $protocol = $self->{protocol} || "tcp"; 313f39f8f30Sbluhm 314f39f8f30Sbluhm given ($protocol) { 315f39f8f30Sbluhm when (/tcp/) { relay_copy_stream($self, @_) } 316f39f8f30Sbluhm when (/udp/) { relay_copy_datagram($self, @_) } 317f39f8f30Sbluhm default { die ref($self), " unknown protocol name: $protocol" } 318f39f8f30Sbluhm } 319f39f8f30Sbluhm} 320f39f8f30Sbluhm 321f3d4320dSbluhmsub relay_splice_stream { 322f39f8f30Sbluhm my $self = shift; 323f39f8f30Sbluhm my $max = $self->{max}; 324f39f8f30Sbluhm my $idle = $self->{idle}; 325f39f8f30Sbluhm 326f39f8f30Sbluhm my $len = 0; 327f39f8f30Sbluhm my $splicelen; 328f39f8f30Sbluhm my $shortsplice = 0; 329f39f8f30Sbluhm my $error; 330f39f8f30Sbluhm do { 331f39f8f30Sbluhm my $splicemax = $max ? $max - $len : 0; 332f39f8f30Sbluhm setsplice(\*STDIN, \*STDOUT, $splicemax, $idle) 333f39f8f30Sbluhm or die ref($self), " splice stdin to stdout failed: $!"; 334*e1860033Sbluhm print STDERR "Spliced\n"; 335f39f8f30Sbluhm 336f39f8f30Sbluhm if ($self->{readblocking}) { 337f39f8f30Sbluhm my $read; 338f39f8f30Sbluhm # block by reading from the source socket 339f39f8f30Sbluhm do { 340f39f8f30Sbluhm # busy loop to test soreceive 341f39f8f30Sbluhm $read = sysread(STDIN, my $buf, 2**16); 342f39f8f30Sbluhm } while ($self->{nonblocking} && !defined($read) && 343f39f8f30Sbluhm $!{EAGAIN}); 344f39f8f30Sbluhm defined($read) 345f39f8f30Sbluhm or die ref($self), " read blocking failed: $!"; 346f39f8f30Sbluhm $read > 0 and die ref($self), 347f39f8f30Sbluhm " read blocking has data: $read"; 348f39f8f30Sbluhm print STDERR "Read\n"; 349f39f8f30Sbluhm } else { 350f39f8f30Sbluhm my $rin = ''; 351f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 352f39f8f30Sbluhm select($rin, undef, undef, undef) 353f39f8f30Sbluhm or die ref($self), " select failed: $!"; 354f39f8f30Sbluhm } 355f39f8f30Sbluhm 356f39f8f30Sbluhm defined($error = geterror(\*STDIN)) 357f39f8f30Sbluhm or die ref($self), " get error from stdin failed: $!"; 3584de767e5Sbluhm ($! = $error) && ! $!{ETIMEDOUT} && ! $!{EFBIG} 359f39f8f30Sbluhm and die ref($self), " splice failed: $!"; 360f39f8f30Sbluhm 361f39f8f30Sbluhm defined($splicelen = getsplice(\*STDIN)) 362f39f8f30Sbluhm or die ref($self), " get splice len from stdin failed: $!"; 363f39f8f30Sbluhm print STDERR "SPLICELEN: $splicelen\n"; 364f39f8f30Sbluhm !$max || $splicelen <= $splicemax 365f39f8f30Sbluhm or die ref($self), " splice len $splicelen ". 366f39f8f30Sbluhm "greater than max $splicemax"; 367f39f8f30Sbluhm $len += $splicelen; 368f39f8f30Sbluhm } while ($max && $max > $len && !$shortsplice++); 369f39f8f30Sbluhm 3704de767e5Sbluhm relay_splice_check($self, $idle, $max, $len, $error); 371f39f8f30Sbluhm print STDERR "LEN: $len\n"; 372f39f8f30Sbluhm} 373f39f8f30Sbluhm 374f3d4320dSbluhmsub relay_splice_datagram { 375f3d4320dSbluhm my $self = shift; 376f3d4320dSbluhm my $max = $self->{max}; 377f3d4320dSbluhm my $idle = $self->{idle}; 378f3d4320dSbluhm 379f3d4320dSbluhm my $splicemax = $max || 0; 380f3d4320dSbluhm setsplice(\*STDIN, \*STDOUT, $splicemax, $idle) 381f3d4320dSbluhm or die ref($self), " splice stdin to stdout failed: $!"; 382*e1860033Sbluhm print STDERR "Spliced\n"; 383f3d4320dSbluhm 384f3d4320dSbluhm my $rin = ''; 385f3d4320dSbluhm vec($rin, fileno(STDIN), 1) = 1; 386f3d4320dSbluhm select($rin, undef, undef, undef) 387f3d4320dSbluhm or die ref($self), " select failed: $!"; 388f3d4320dSbluhm 389f3d4320dSbluhm defined(my $error = geterror(\*STDIN)) 390f3d4320dSbluhm or die ref($self), " get error from stdin failed: $!"; 3914de767e5Sbluhm ($! = $error) && ! $!{ETIMEDOUT} && ! $!{EFBIG} 392f3d4320dSbluhm and die ref($self), " splice failed: $!"; 393f3d4320dSbluhm 394f3d4320dSbluhm defined(my $splicelen = getsplice(\*STDIN)) 395f3d4320dSbluhm or die ref($self), " get splice len from stdin failed: $!"; 396f3d4320dSbluhm print STDERR "SPLICELEN: $splicelen\n"; 397f3d4320dSbluhm !$max || $splicelen <= $splicemax 398f3d4320dSbluhm or die ref($self), " splice len $splicelen ". 399f3d4320dSbluhm "greater than max $splicemax"; 400f3d4320dSbluhm my $len = $splicelen; 401f3d4320dSbluhm 402f3d4320dSbluhm if ($max && $max > $len) { 403f3d4320dSbluhm defined(my $read = sysread(STDIN, my $buf, $max - $len)) 404f3d4320dSbluhm or die ref($self), " sysread stdin max failed: $!"; 405f3d4320dSbluhm $len += $read; 406f3d4320dSbluhm } 4074de767e5Sbluhm relay_splice_check($self, $idle, $max, $len, $error); 4084de767e5Sbluhm print STDERR "LEN: $splicelen\n"; 4094de767e5Sbluhm} 4104de767e5Sbluhm 4114de767e5Sbluhmsub relay_splice_check { 4124de767e5Sbluhm my $self = shift; 4134de767e5Sbluhm my ($idle, $max, $len, $error) = @_; 4144de767e5Sbluhm 4154de767e5Sbluhm if ($idle && $error == Errno::ETIMEDOUT) { 4164de767e5Sbluhm print STDERR "Timeout\n"; 4174de767e5Sbluhm } 4184de767e5Sbluhm if ($max && $error == Errno::EFBIG) { 4194de767e5Sbluhm print STDERR "Big\n"; 4204de767e5Sbluhm } 421f3d4320dSbluhm if ($max && $max == $len) { 422f3d4320dSbluhm print STDERR "Max\n"; 423f3d4320dSbluhm } elsif ($max && $max < $len) { 424f3d4320dSbluhm die ref($self), " max $max less than len $len"; 4254de767e5Sbluhm } elsif ($max && $max > $len && $error == Errno::EFBIG) { 426f3d4320dSbluhm die ref($self), " max $max greater than len $len"; 427f3d4320dSbluhm } elsif (!$error) { 428f3d4320dSbluhm defined(my $read = sysread(STDIN, my $buf, 2**16)) 429f3d4320dSbluhm or die ref($self), " sysread stdin failed: $!"; 430f3d4320dSbluhm $read > 0 431f3d4320dSbluhm and die ref($self), " sysread stdin has data: $read"; 432f3d4320dSbluhm print STDERR "End\n"; 433f3d4320dSbluhm } 434f3d4320dSbluhm} 435f3d4320dSbluhm 436f3d4320dSbluhmsub relay_splice { 437f3d4320dSbluhm my $self = shift; 438f3d4320dSbluhm my $protocol = $self->{protocol} || "tcp"; 439f3d4320dSbluhm 440f3d4320dSbluhm given ($protocol) { 441f3d4320dSbluhm when (/tcp/) { relay_splice_stream($self, @_) } 442f3d4320dSbluhm when (/udp/) { relay_splice_datagram($self, @_) } 443f3d4320dSbluhm default { die ref($self), " unknown protocol name: $protocol" } 444f3d4320dSbluhm } 445f3d4320dSbluhm} 446f3d4320dSbluhm 447f39f8f30Sbluhmsub relay { 448f39f8f30Sbluhm my $self = shift; 449f39f8f30Sbluhm my $forward = $self->{forward}; 450f39f8f30Sbluhm 451f39f8f30Sbluhm given ($forward) { 452f39f8f30Sbluhm when (/copy/) { relay_copy($self, @_) } 453f39f8f30Sbluhm when (/splice/) { relay_splice($self, @_) } 454f39f8f30Sbluhm default { die ref($self), " unknown forward name: $forward" } 455f39f8f30Sbluhm } 456f39f8f30Sbluhm 457f39f8f30Sbluhm my $soerror; 458f39f8f30Sbluhm $soerror = getsockopt(STDIN, SOL_SOCKET, SO_ERROR) 459f39f8f30Sbluhm or die ref($self), " get error from stdin failed: $!"; 460f39f8f30Sbluhm print STDERR "ERROR IN: ", unpack('i', $soerror), "\n"; 461f39f8f30Sbluhm $soerror = getsockopt(STDOUT, SOL_SOCKET, SO_ERROR) 462f39f8f30Sbluhm or die ref($self), " get error from stdout failed: $!"; 463f39f8f30Sbluhm print STDERR "ERROR OUT: ", unpack('i', $soerror), "\n"; 464f39f8f30Sbluhm} 465f39f8f30Sbluhm 466f39f8f30Sbluhmsub ioflip { 467f39f8f30Sbluhm my $self = shift; 468f39f8f30Sbluhm 469f39f8f30Sbluhm open(my $fh, '<&', \*STDIN) 470f39f8f30Sbluhm or die ref($self), " ioflip dup failed: $!"; 471f39f8f30Sbluhm open(STDIN, '<&', \*STDOUT) 472f39f8f30Sbluhm or die ref($self), " ioflip dup STDIN failed: $!"; 473f39f8f30Sbluhm open(STDOUT, '>&', $fh) 474f39f8f30Sbluhm or die ref($self), " ioflip dup STDOUT failed: $!"; 475f39f8f30Sbluhm close($fh) 476f39f8f30Sbluhm or die ref($self), " ioflip close failed: $!"; 477f39f8f30Sbluhm} 478f39f8f30Sbluhm 479f39f8f30Sbluhmsub errignore { 480f39f8f30Sbluhm $SIG{PIPE} = 'IGNORE'; 481f39f8f30Sbluhm $SIG{__DIE__} = sub { 482f39f8f30Sbluhm die @_ if $^S; 483a7f4fd62Sbluhm warn "Error ignored"; 484f39f8f30Sbluhm my $soerror; 485f39f8f30Sbluhm $soerror = getsockopt(STDIN, SOL_SOCKET, SO_ERROR); 486f39f8f30Sbluhm print STDERR "ERROR IN: ", unpack('i', $soerror), "\n"; 487f39f8f30Sbluhm $soerror = getsockopt(STDOUT, SOL_SOCKET, SO_ERROR); 488f39f8f30Sbluhm print STDERR "ERROR OUT: ", unpack('i', $soerror), "\n"; 489a7f4fd62Sbluhm warn @_; 490f39f8f30Sbluhm IO::Handle::flush(\*STDERR); 491f39f8f30Sbluhm POSIX::_exit(0); 492f39f8f30Sbluhm }; 493f39f8f30Sbluhm} 494f39f8f30Sbluhm 495f39f8f30Sbluhmsub shutin { 496f39f8f30Sbluhm my $self = shift; 497f39f8f30Sbluhm shutdown(\*STDIN, SHUT_RD) 498f39f8f30Sbluhm or die ref($self), " shutdown read failed: $!"; 499f39f8f30Sbluhm} 500f39f8f30Sbluhm 501f39f8f30Sbluhmsub shutout { 502f39f8f30Sbluhm my $self = shift; 503f39f8f30Sbluhm IO::Handle::flush(\*STDOUT) 504f39f8f30Sbluhm or die ref($self), " flush stdout failed: $!"; 505f39f8f30Sbluhm shutdown(\*STDOUT, SHUT_WR) 506f39f8f30Sbluhm or die ref($self), " shutdown write failed: $!"; 507f39f8f30Sbluhm} 508f39f8f30Sbluhm 509f39f8f30Sbluhm######################################################################## 510f39f8f30Sbluhm# Server funcs 511f39f8f30Sbluhm######################################################################## 512f39f8f30Sbluhm 513f39f8f30Sbluhmsub read_stream { 514f39f8f30Sbluhm my $self = shift; 515f39f8f30Sbluhm my $max = $self->{max}; 516f39f8f30Sbluhm 517f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 518f39f8f30Sbluhm my $len = 0; 519f39f8f30Sbluhm while (<STDIN>) { 520f39f8f30Sbluhm $len += length($_); 521f39f8f30Sbluhm $ctx->add($_); 522f39f8f30Sbluhm print STDERR "."; 523f39f8f30Sbluhm if ($max && $len >= $max) { 524f39f8f30Sbluhm print STDERR "\nMax"; 525f39f8f30Sbluhm last; 526f39f8f30Sbluhm } 527f39f8f30Sbluhm } 528f39f8f30Sbluhm print STDERR "\n"; 529f39f8f30Sbluhm 530f39f8f30Sbluhm print STDERR "LEN: $len\n"; 531f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 532f39f8f30Sbluhm} 533f39f8f30Sbluhm 534f39f8f30Sbluhmsub read_oob { 535f39f8f30Sbluhm my $self = shift; 536f39f8f30Sbluhm my $size = $self->{size} || 4091; 537f39f8f30Sbluhm 538f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 539f39f8f30Sbluhm my $len = 0; 540f39f8f30Sbluhm while (1) { 541f39f8f30Sbluhm my $rin = my $ein = ''; 542f39f8f30Sbluhm vec($rin, fileno(STDIN), 1) = 1; 543f39f8f30Sbluhm vec($ein, fileno(STDIN), 1) = 1 unless $self->{oobinline}; 544f39f8f30Sbluhm select($rin, undef, $ein, undef) 545f39f8f30Sbluhm or die ref($self), " select failed: $!"; 546f39f8f30Sbluhm my $buf; 547f39f8f30Sbluhm my $atmark = sockatmark(\*STDIN) 548f39f8f30Sbluhm or die ref($self), " sockatmark failed: $!"; 549f39f8f30Sbluhm if ($atmark == 1) { 550f39f8f30Sbluhm if ($self->{oobinline}) { 551f39f8f30Sbluhm defined(recv(STDIN, $buf, 1, 0)) 552f39f8f30Sbluhm or die ref($self), " recv OOB failed: $!"; 553f39f8f30Sbluhm print STDERR "[$buf]"; 554f39f8f30Sbluhm $ctx->add("[$buf]"); 555f39f8f30Sbluhm $len += length($buf); 556f39f8f30Sbluhm } else { 557f39f8f30Sbluhm defined(recv(STDIN, $buf, 1, MSG_OOB)) || 558f39f8f30Sbluhm $!{EINVAL} 559f39f8f30Sbluhm or die ref($self), " recv OOB failed: $!"; 560f39f8f30Sbluhm print STDERR "OOB: $buf\n" if length($buf); 561f39f8f30Sbluhm } 562f39f8f30Sbluhm } 563f39f8f30Sbluhm defined(recv(STDIN, $buf, $size, 0)) 564f39f8f30Sbluhm or die ref($self), " recv failed: $!"; 565f39f8f30Sbluhm last unless length($buf); 566f39f8f30Sbluhm print STDERR $buf; 567f39f8f30Sbluhm $ctx->add($buf); 568f39f8f30Sbluhm $len += length($buf); 569f39f8f30Sbluhm print STDERR "."; 570f39f8f30Sbluhm } 571f39f8f30Sbluhm print STDERR "\n"; 572f39f8f30Sbluhm 573f39f8f30Sbluhm print STDERR "LEN: $len\n"; 574f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 575f39f8f30Sbluhm} 576f39f8f30Sbluhm 577f39f8f30Sbluhmsub read_datagram { 578f39f8f30Sbluhm my $self = shift; 579f39f8f30Sbluhm my $max = $self->{max}; 580f3d4320dSbluhm my $idle = $self->{idle}; 581f39f8f30Sbluhm my $size = $self->{size} || 2**16; 582f39f8f30Sbluhm 583f39f8f30Sbluhm my $ctx = Digest::MD5->new(); 584f39f8f30Sbluhm my $len = 0; 585f39f8f30Sbluhm my @lengths; 586f3d4320dSbluhm for (my $num = 0;; $num++) { 587f3d4320dSbluhm if ($idle) { 588f3d4320dSbluhm my $rin = ''; 589f3d4320dSbluhm vec($rin, fileno(STDIN), 1) = 1; 590f3d4320dSbluhm defined(my $n = select($rin, undef, undef, $idle)) 591f3d4320dSbluhm or die ref($self), " select idle failed: $!"; 592f3d4320dSbluhm if ($n == 0) { 593f3d4320dSbluhm print STDERR "\n"; 594f3d4320dSbluhm print STDERR "Timeout"; 595f3d4320dSbluhm last; 596f3d4320dSbluhm } 597f3d4320dSbluhm } 598f39f8f30Sbluhm defined(my $read = sysread(STDIN, my $buf, $size)) 599f3d4320dSbluhm or die ref($self), " sysread number $num failed: $!"; 600f39f8f30Sbluhm $len += $read; 601f39f8f30Sbluhm push @lengths, $read; 602f39f8f30Sbluhm $ctx->add($buf); 603f39f8f30Sbluhm print STDERR "."; 604f39f8f30Sbluhm if ($max && $len >= $max) { 605f39f8f30Sbluhm print STDERR "\nMax"; 606f39f8f30Sbluhm last; 607f39f8f30Sbluhm } 608f39f8f30Sbluhm } 609f39f8f30Sbluhm print STDERR "\n"; 610f39f8f30Sbluhm 611f39f8f30Sbluhm print STDERR "LEN: $len\n"; 612f39f8f30Sbluhm print STDERR "LENGTHS: @lengths\n"; 613f39f8f30Sbluhm print STDERR "MD5: ", $ctx->hexdigest, "\n"; 614f39f8f30Sbluhm} 615f39f8f30Sbluhm 616f39f8f30Sbluhmsub solingerin { 617f39f8f30Sbluhm my $self = shift; 618f39f8f30Sbluhm 619f39f8f30Sbluhm setsockopt(STDIN, SOL_SOCKET, SO_LINGER, pack('ii', 1, 0)) 620f39f8f30Sbluhm or die ref($self), " set linger in failed: $!"; 621f39f8f30Sbluhm} 622f39f8f30Sbluhm 623f39f8f30Sbluhm######################################################################## 624f39f8f30Sbluhm# Script funcs 625f39f8f30Sbluhm######################################################################## 626f39f8f30Sbluhm 627f39f8f30Sbluhmsub check_logs { 628f39f8f30Sbluhm my ($c, $r, $s, %args) = @_; 629f39f8f30Sbluhm 630f39f8f30Sbluhm return if $args{nocheck}; 631f39f8f30Sbluhm 632f3d4320dSbluhm check_relay($c, $r, $s, %args); 633f39f8f30Sbluhm check_len($c, $r, $s, %args); 634f39f8f30Sbluhm check_lengths($c, $r, $s, %args); 635f39f8f30Sbluhm check_md5($c, $r, $s, %args); 636f39f8f30Sbluhm check_error($c, $r, $s, %args); 637f39f8f30Sbluhm} 638f39f8f30Sbluhm 639f3d4320dSbluhmsub check_relay { 640f3d4320dSbluhm my ($c, $r, $s, %args) = @_; 641f3d4320dSbluhm 642c5ecd18cSbluhm return unless $r; 643c5ecd18cSbluhm 644c5ecd18cSbluhm if (defined $args{relay}{timeout}) { 645c5ecd18cSbluhm my $lg = $r->loggrep(qr/^Timeout$/); 646c5ecd18cSbluhm die "no relay timeout" if !$lg && $args{relay}{timeout}; 647c5ecd18cSbluhm die "relay has timeout" if $lg && !$args{relay}{timeout}; 648c5ecd18cSbluhm } 649c5ecd18cSbluhm if (defined $args{relay}{big}) { 650c5ecd18cSbluhm my $lg = $r->loggrep(qr/^Big$/); 651c5ecd18cSbluhm die "no relay big" if !$lg && $args{relay}{big}; 652c5ecd18cSbluhm die "relay has big" if $lg && !$args{relay}{big}; 653c5ecd18cSbluhm } 654f3d4320dSbluhm $r->loggrep(qr/^Max$/) or die "no relay max" 655c5ecd18cSbluhm if $args{relay}{max} && !$args{relay}{nomax}; 656f3d4320dSbluhm $r->loggrep(qr/^End$/) or die "no relay end" 657c5ecd18cSbluhm if $args{relay}{end}; 658f3d4320dSbluhm} 659f3d4320dSbluhm 660f39f8f30Sbluhmsub check_len { 661f39f8f30Sbluhm my ($c, $r, $s, %args) = @_; 662f39f8f30Sbluhm 663f8f8530cSbluhm my ($clen, $rlen, $slen); 664f8f8530cSbluhm $clen = $c->loggrep(qr/^LEN: /) // die "no client len" 665f39f8f30Sbluhm unless $args{client}{nocheck}; 666f8f8530cSbluhm $rlen = $r->loggrep(qr/^LEN: /) // die "no relay len" 667f39f8f30Sbluhm if $r && ! $args{relay}{nocheck}; 668f8f8530cSbluhm $slen = $s->loggrep(qr/^LEN: /) // die "no server len" 669f39f8f30Sbluhm unless $args{server}{nocheck}; 670f39f8f30Sbluhm !$clen || !$rlen || $clen eq $rlen 671f39f8f30Sbluhm or die "client: $clen", "relay: $rlen", "len mismatch"; 672f39f8f30Sbluhm !$rlen || !$slen || $rlen eq $slen 673f39f8f30Sbluhm or die "relay: $rlen", "server: $slen", "len mismatch"; 674f39f8f30Sbluhm !$clen || !$slen || $clen eq $slen 675f39f8f30Sbluhm or die "client: $clen", "server: $slen", "len mismatch"; 676f39f8f30Sbluhm !defined($args{len}) || !$clen || $clen eq "LEN: $args{len}\n" 677f39f8f30Sbluhm or die "client: $clen", "len $args{len} expected"; 678f39f8f30Sbluhm !defined($args{len}) || !$rlen || $rlen eq "LEN: $args{len}\n" 679f39f8f30Sbluhm or die "relay: $rlen", "len $args{len} expected"; 680f39f8f30Sbluhm !defined($args{len}) || !$slen || $slen eq "LEN: $args{len}\n" 681f39f8f30Sbluhm or die "server: $slen", "len $args{len} expected"; 682f39f8f30Sbluhm} 683f39f8f30Sbluhm 684f39f8f30Sbluhmsub check_lengths { 685f39f8f30Sbluhm my ($c, $r, $s, %args) = @_; 686f39f8f30Sbluhm 687f8f8530cSbluhm my ($clengths, $slengths); 688f8f8530cSbluhm $clengths = $c->loggrep(qr/^LENGTHS: /) 689f39f8f30Sbluhm unless $args{client}{nocheck}; 690f8f8530cSbluhm $slengths = $s->loggrep(qr/^LENGTHS: /) 691f39f8f30Sbluhm unless $args{server}{nocheck}; 692f39f8f30Sbluhm !$clengths || !$slengths || $clengths eq $slengths 693f39f8f30Sbluhm or die "client: $clengths", "server: $slengths", "lengths mismatch"; 694f39f8f30Sbluhm !defined($args{lengths}) || !$clengths || 695f39f8f30Sbluhm $clengths eq "LENGTHS: $args{lengths}\n" 696f39f8f30Sbluhm or die "client: $clengths", "lengths $args{lengths} expected"; 697f39f8f30Sbluhm !defined($args{lengths}) || !$slengths || 698f39f8f30Sbluhm $slengths eq "LENGTHS: $args{lengths}\n" 699f39f8f30Sbluhm or die "server: $slengths", "lengths $args{lengths} expected"; 700f39f8f30Sbluhm} 701f39f8f30Sbluhm 702f39f8f30Sbluhmsub check_md5 { 703f39f8f30Sbluhm my ($c, $r, $s, %args) = @_; 704f39f8f30Sbluhm 705f8f8530cSbluhm my ($cmd5, $smd5); 706f8f8530cSbluhm $cmd5 = $c->loggrep(qr/^MD5: /) unless $args{client}{nocheck}; 707f8f8530cSbluhm $smd5 = $s->loggrep(qr/^MD5: /) unless $args{server}{nocheck}; 708f39f8f30Sbluhm !$cmd5 || !$smd5 || ref($args{md5}) eq 'ARRAY' || $cmd5 eq $smd5 709f39f8f30Sbluhm or die "client: $cmd5", "server: $smd5", "md5 mismatch"; 710f39f8f30Sbluhm my $md5 = ref($args{md5}) eq 'ARRAY' ? 711f39f8f30Sbluhm join('|', @{$args{md5}}) : $args{md5}; 712f39f8f30Sbluhm !$md5 || !$cmd5 || $cmd5 =~ /^MD5: ($md5)$/ 713f39f8f30Sbluhm or die "client: $cmd5", "md5 $md5 expected"; 714f39f8f30Sbluhm !$md5 || !$smd5 || $smd5 =~ /^MD5: ($md5)$/ 715f39f8f30Sbluhm or die "server: $smd5", "md5 $md5 expected"; 716f39f8f30Sbluhm} 717f39f8f30Sbluhm 718f39f8f30Sbluhmsub check_error { 719f39f8f30Sbluhm my ($c, $r, $s, %args) = @_; 720f39f8f30Sbluhm 721f39f8f30Sbluhm $args{relay}{errorin} //= 0 unless $args{relay}{nocheck}; 722f39f8f30Sbluhm $args{relay}{errorout} //= 0 unless $args{relay}{nocheck}; 723f39f8f30Sbluhm my %name2proc = (client => $c, relay => $r, server => $s); 724f39f8f30Sbluhm foreach my $name (qw(client relay server)) { 725f39f8f30Sbluhm my $p = $name2proc{$name} 726f39f8f30Sbluhm or next; 727f39f8f30Sbluhm $args{$name}{errorin} //= $args{$name}{error}; 728f39f8f30Sbluhm if (defined($args{$name}{errorin})) { 729f39f8f30Sbluhm my $ein = $p->loggrep(qr/^ERROR IN: /); 730f39f8f30Sbluhm defined($ein) && 731f39f8f30Sbluhm $ein eq "ERROR IN: $args{$name}{errorin}\n" 732f39f8f30Sbluhm or die "$name: $ein ", 733f39f8f30Sbluhm "error in $args{$name}{errorin} expected"; 734f39f8f30Sbluhm } 735f39f8f30Sbluhm if (defined($args{$name}{errorout})) { 736f39f8f30Sbluhm my $eout = $p->loggrep(qr/^ERROR OUT: /); 737f39f8f30Sbluhm defined($eout) && 738f39f8f30Sbluhm $eout eq "ERROR OUT: $args{$name}{errorout}\n" 739f39f8f30Sbluhm or die "$name: $eout ", 740f39f8f30Sbluhm "error out $args{$name}{errorout} expected"; 741f39f8f30Sbluhm } 742f39f8f30Sbluhm } 743f39f8f30Sbluhm} 744f39f8f30Sbluhm 745f39f8f30Sbluhm1; 746