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