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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
use strict;
use utf8;
use Test::More;
use Event::RPC::Server;
use Event::RPC::Message::Negotiate;
my $depend_modules = 0;
eval { require EV };
eval { require AnyEvent } && ++$depend_modules;
eval { require Event } && ++$depend_modules;
eval { require Glib } && ++$depend_modules;
if ( not $depend_modules ) {
plan skip_all => "Neither AnyEvent, Event nor Glib installed";
}
require "t/Event_RPC_Test_Server.pm";
my $PORT = Event_RPC_Test_Server->port;
# determine available message formats (including the insecure)
my $formats = Event::RPC::Server->probe_message_formats(
Event::RPC::Message::Negotiate->message_format_order, 1
);
my $modules_by_name = Event::RPC::Message::Negotiate->known_message_formats;
my $tests = 1 + @{$formats} * 14 + 9 * 3;
plan tests => $tests;
# load client class
use_ok('Event::RPC::Client');
foreach my $format ( @{$formats} ) {
# start server in background, without logging
my $server_pid = Event_RPC_Test_Server->start_server (
p => $PORT,
S => 1,
L => $ENV{EVENT_RPC_LOOP},
f => [ $format ]
);
ok($server_pid, "Started server at $server_pid with format '$format'");
# create client instance
my $client = Event::RPC::Client->new (
host => "localhost",
port => $PORT,
);
# connect to server
$client->connect;
ok(1, "connected");
# check message format
ok($client->get_message_format eq $modules_by_name->{$format}, "$format format chosen");
# create instance of test class over RPC
my $data = "Some test data with utf8: 你好世界. " x 6;
my $object = Event_RPC_Test->new (
data => $data
);
# check object
ok($object->isa("Event_RPC_Test"), "object is Event_RPC_Test");
# check data
ok($object->get_data eq $data, "object data matches");
# set binary data
my $bin_data = join("", map { chr($_) } 0..255);
$bin_data = $bin_data x 100;
ok($object->set_data($bin_data) eq $bin_data, "object bin data set");
ok($object->get_data eq $bin_data, "object bin data get");
# get another object from this object
my $object2 = $object->get_object2;
ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2");
# check data of object2
ok($object2->get_data eq 'foo', "object data is 'foo'");
# create another object from this object
$object2 = $object->new_object2($$);
ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2");
# check data of object2
ok($object2->get_data == $$, "object data is $$");
$object2->set_data($data);
# check if copying the complete object hash works
my $ref = $object2->get_object_copy;
ok($ref->{data} eq $data, "object copy data matches");
if ( $ENV{EVENT_RPC_BENCHMARK} ) {
require Benchmark;
my @objects;
my @payload = map { $_ => ("Huge payload $_" x 100) } 1..100;
diag "Performing benchmark for '$format'";
my $cnt = 20;
my $t = Benchmark::timeit($cnt, sub {
for ( 1..1000 ) {
push @objects, $object->new_object2(\@payload);
}
$_->set_data(42) for @objects;
@objects = ();
});
diag "$cnt loops of '$format' took ".Benchmark::timestr($t);
}
# disconnect client
ok ($client->disconnect, "client disconnected");
# wait on server to quit
wait;
ok (1, "server stopped");
}
SKIP: {
my ($other_format) = grep { $_ ne "STOR" } @{$formats};
my ($has_storable) = grep { $_ eq "STOR" } @{$formats};
plan skip "Negotations tests skipped due to missing formats", 9*3
unless $other_format and $has_storable;
foreach my $client_style (qw/ old insecure secure /) {
foreach my $server_style (qw/ old insecure secure /) {
if ( $client_style eq 'old' ) {
$Event::RPC::Client::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Storable";
}
else {
$Event::RPC::Client::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate";
}
if ( $server_style eq 'old' ) {
$Event::RPC::Server::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Storable";
}
else {
$Event::RPC::Server::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate";
}
my $client_insecure_ok = $client_style eq 'secure' ? 0 : 1;
my $server_insecure_ok = $server_style eq 'secure' ? 0 : 1;
my $server_formats =
$server_style eq 'old' ? ["STOR"] :
$server_style eq 'insecure' ? ["STOR"] : [ $other_format ];
# start server in background, without logging
Event_RPC_Test_Server->start_server (
p => $PORT,
S => 1,
L => $ENV{EVENT_RPC_LOOP},
f => $server_formats,
i => $server_insecure_ok,
l => 0,
);
# create client instance
my $client = Event::RPC::Client->new (
host => "localhost",
port => $PORT,
insecure_msg_fmt_ok => $client_insecure_ok,
);
# connect to server
eval { $client->connect };
if ( $server_style eq 'secure' and $client_style eq 'old' or
$client_style eq 'secure' and $server_style eq 'old')
{
ok($@, "connection failed, server($server_style) | client($client_style) | si=$server_insecure_ok ci=$client_insecure_ok");
}
else {
ok(!$@, "connection succeeded, server($server_style) | client($client_style) | si=$server_insecure_ok ci=$client_insecure_ok");
}
if ( $client->get_connected ) {
ok(
($server_style."|".$client_style =~ /\bsecure\b/ &&
$client->get_message_format !~ /Storable/) ||
($server_style."|".$client_style !~ /\bsecure\b/ &&
$client->get_message_format =~ /Storable/),
"Correct message format chosen"
);
$client->disconnect;
}
else {
ok(1, "No security check on connection failure");
}
# wait on server to quit
wait;
ok (1, "server stopped");
}
}
}
|
