#!/usr/bin/perl # $OpenBSD: direct.pl,v 1.1 2011/09/01 17:33:17 bluhm Exp $ # Copyright (c) 2010,2011 Alexander Bluhm # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. use strict; use warnings; use Socket; use Socket6; use Client; use Server; require 'funcs.pl'; our %args; if (my $test = pop) { do $test or die "Do test file $test failed: ", $@ || $!; } @ARGV == 0 or die "usage: direct.pl [test-args.pl]\n"; my $s = Server->new( func => \&read_char, %{$args{server}}, listendomain => AF_INET, listenaddr => "127.0.0.1", ); my $c = Client->new( func => \&write_char, %{$args{client}}, connectdomain => AF_INET, connectaddr => "127.0.0.1", connectport => $s->{listenport}, ); $s->run; $c->run->up; $s->up; $c->down; $s->down; exit if $args{nocheck} || $args{client}{nocheck}; my $clen = $c->loggrep(qr/^LEN: /) unless $args{client}{nocheck}; my $slen = $s->loggrep(qr/^LEN: /) unless $args{server}{nocheck}; !$clen || !$slen || $clen eq $slen or die "client: $clen", "server: $slen", "len mismatch"; !defined($args{len}) || !$clen || $clen eq "LEN: $args{len}\n" or die "client: $clen", "len $args{len} expected"; !defined($args{len}) || !$slen || $slen eq "LEN: $args{len}\n" or die "server: $slen", "len $args{len} expected"; my $cmd5 = $c->loggrep(qr/^MD5: /) unless $args{client}{nocheck}; my $smd5 = $s->loggrep(qr/^MD5: /) unless $args{server}{nocheck}; !$cmd5 || !$smd5 || ref($args{md5}) eq 'ARRAY' || $cmd5 eq $smd5 or die "client: $cmd5", "server: $smd5", "md5 mismatch"; my $md5 = ref($args{md5}) eq 'ARRAY' ? join('|', @{$args{md5}}) : $args{md5}; !$md5 || !$cmd5 || $cmd5 =~ /^MD5: ($md5)$/ or die "client: $cmd5", "md5 $md5 expected"; !$md5 || !$smd5 || $smd5 =~ /^MD5: ($md5)$/ or die "server: $smd5", "md5 $md5 expected";