1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
use Test::More;
use Test::Exception;
use Test::Differences;
use Carp;
use Scalar::Util qw( weaken );
use File::Temp qw( tempfile );
use Errno qw( EAGAIN EBADF EPIPE ECONNABORTED );
use Socket;
use Fcntl;
use POSIX qw(locale_h); BEGIN { setlocale(LC_ALL,'en_US.UTF-8') } # avoid UTF-8 in $!
use EV;
use IO::Stream;
use Carp::Heavy;
$SIG{PIPE} = 'IGNORE';
$EV::DIED = sub { diag $@; EV::unloop };
use constant WIN32 => IO::Stream::WIN32;
use constant BUFSIZE => IO::Stream::BUFSIZE;
### Usage example:
#@CheckPoint = (
# [ 'listener', ACCEPTED ], 'accept incoming connection',
# [ 'ssl_client', IN ], 'client: got server banner',
# [ 'ssl_client', $banner ], 'client: banner is correct',
# [ 'ssl_client', SENT ], 'client: request sent',
# [ 'ssl_server', EOF ], 'server: got eof',
# [ 'ssl_server', $msg ], 'server: requst is correct',
# {
# win32 => [
# [ 'ssl_client', EOF ], 'client: got eof',
# [ 'ssl_server', SENT ], 'server: reply sent',
# ],
# other => [
# [ 'ssl_server', SENT ], 'server: reply sent',
# [ 'ssl_client', EOF ], 'client: got eof',
# ],
# },
# [ 'ssl_client', "echo: $msg" ], 'client: reply is correct',
#);
#plan tests => checkpoint_count();
#
# NOTE Alternatives in @CheckPoint must have same amount of tests!
use vars qw( @CheckPoint );
sub _checkpoint_unwrap {
return @_ if !grep {ref eq 'HASH'} @_;
return _checkpoint_unwrap(map{ref eq 'HASH' ? @{(values %$_)[0]} : $_}@_);
}
sub checkpoint_count {
return _checkpoint_unwrap(@CheckPoint)/2;
}
sub checkpoint {
my ($func) = (caller(1))[3]=~/.*::(.*)/;
if (ref $CheckPoint[0] eq 'HASH') {
my %alt = %{ $CheckPoint[0] };
for my $key (keys %alt) {
if (eq_array([$func, @_], $alt{$key}[0])) {
diag "Alternative match: $key";
shift @CheckPoint;
unshift @CheckPoint, @{ $alt{$key} };
last;
}
}
}
if (ref $CheckPoint[0] eq 'HASH') {
croak("No alternative to match: $func @_");
}
eq_or_diff([$func, @_], shift @CheckPoint, shift @CheckPoint);
return;
}
### Usage example:
#sub client {
# my ($io, $e, $err) = @_;
# &diag_event;
#}
sub diag_event {
my ($io, $e, $err) = @_;
my ($func) = (caller(1))[3]=~/.*::(.*)/;
diag "$func : ".events2str($e, $err);
}
sub events2str {
my ($e, $err) = @_;
my @e = ($e & RESOLVED, $e & CONNECTED, $e & IN, $e & OUT, $e & EOF, $e & SENT, $e & ~(RESOLVED|CONNECTED|IN|OUT|EOF|SENT));
my @n = qw(RESOLVED CONNECTED IN OUT EOF SENT unk);
my $s = join q{|}, map {$e[$_] ? $n[$_] : ()} 0 .. $#e;
return $err ? "$s err=$err" : $s;
}
sub nonblocking {
my ($fh) = @_;
if (WIN32) {
my $nb=1; ioctl $fh, 0x8004667e, \$nb; # FIONBIO
} else {
fcntl $fh, F_SETFL, O_NONBLOCK or croak qq{fcntl: $!};
}
return;
}
sub sockport {
my ($sock) = @_;
my ($port) = sockaddr_in(getsockname $sock);
return $port;
}
sub tcp_server {
my ($host, $port) = @_;
socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!};
setsockopt $sock, SOL_SOCKET, SO_REUSEADDR, 1 or croak qq{setsockopt: $!};
bind $sock, sockaddr_in($port, inet_aton($host))or croak qq{bind: $!};
listen $sock, SOMAXCONN or croak qq{listen: $!};
nonblocking($sock);
return $sock;
}
sub tcp_client {
my ($host, $port) = @_;
socket my $sock, AF_INET, SOCK_STREAM, 0 or croak qq{socket: $!};
nonblocking($sock);
connect $sock, sockaddr_in($port, inet_aton($host));
return $sock;
}
sub unix_server {
my ($path) = @_;
socket my $sock, AF_UNIX, SOCK_STREAM, 0 or croak qq{socket: $!};
unlink $path;
bind $sock, sockaddr_un($path) or croak qq{bind: $!};
listen $sock, SOMAXCONN or croak qq{listen: $!};
nonblocking($sock);
return $sock;
}
sub unix_client {
my ($path) = @_;
socket my $sock, AF_UNIX, SOCK_STREAM, 0 or croak qq{socket: $!};
nonblocking($sock);
connect $sock, sockaddr_un($path);
return $sock;
}
1;
|
