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
|
package Event_RPC_Test_Server;
use strict;
use lib qw(t);
sub start_server {
my $class = shift;
my %opts = @_;
#-- fork
my $server_pid = fork();
die "can't fork" unless defined $server_pid;
#-- Client?
if ( $server_pid ) {
#-- client tries to make a log connection to
#-- verify that the server is up and running
#-- (20 times with a usleep of 0.25, so the
#-- overall timeout is 10 seconds)
for ( 1..20 ) {
eval {
Event::RPC::Client->log_connect (
server => "localhost",
port => $opts{p}+1,
);
};
#-- return to client code if connect succeeded
return if !$@;
#-- bail out if the limit is reached
if ( $_ == 20 ) {
die "Couldn't start server";
}
#-- wait a quarter second...
select(undef, undef, undef, 0.25);
}
#-- Client is finished here
return;
}
#-- We're in the server
require Event::RPC::Server;
require Event::RPC::Logger;
require Event_RPC_Test;
require Event_RPC_Test2;
#-- This code is mainly copied from the server.pl
#-- example and works with a command line style
#-- %opts hash
my %ssl_args;
if ( $opts{s} ) {
%ssl_args = (
ssl => 1,
ssl_key_file => 't/ssl/server.key',
ssl_cert_file => 't/ssl/server.crt',
ssl_passwd_cb => sub { 'eventrpc' },
);
if ( not -f 't/ssl/server.key' ) {
print "please execute from toplevel directory\n";
}
}
my %auth_args;
if ( $opts{a} ) {
my ($user, $pass) = split(":", $opts{a});
$pass = Event::RPC->crypt($user, $pass);
%auth_args = (
auth_required => 1,
auth_passwd_href => { $user => $pass },
);
}
#-- Create a logger object
my $logger = Event::RPC::Logger->new (
min_level => (defined $opts{l} ? $opts{l} : 4),
fh_lref => [ \*STDOUT ],
);
#-- Create a loop object
my $loop;
my $loop_module = $opts{L};
if ( $loop_module ) {
eval "use $loop_module";
die $@ if $@;
$loop = $loop_module->new();
}
my $port = $opts{p} || 5555;
my $disconnect_cnt = $opts{S};
#-- Create a Server instance and declare the
#-- exported interface
my $server;
$server = Event::RPC::Server->new (
name => "test daemon",
port => $port,
# logger => $logger,
loop => $loop,
start_log_listener => 1,
load_modules => 0,
%auth_args,
%ssl_args,
classes => {
'Event_RPC_Test' => {
new => '_constructor',
set_data => 1,
get_data => 1,
hello => 1,
quit => 1,
clone => '_object',
multi => '_object',
get_object2 => '_object',
new_object2 => '_object',
echo => 1,
get_cid => 1,
get_object_cnt => 1,
get_undef_object => '_object',
},
'Event_RPC_Test2' => {
new => '_constructor',
set_data => 1,
get_data => 1,
},
},
connection_hook => sub {
my ($conn, $event) = @_;
return if $event eq 'connect';
--$disconnect_cnt;
$server->stop
if $disconnect_cnt <= 0 &&
$server->get_clients_connected == 0;
1;
},
);
#-- Start the server resp. the Event loop.
$server->start;
#-- Exit the program
exit;
}
1;
|
