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