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
|
#!/usr/bin/perl -w
# $Id: server.pl,v 1.3 2005/12/18 14:01:13 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2005 Jrn Reder <joern AT zyn.de>.
# All Rights Reserved. See file COPYRIGHT for details.
#
# This module is part of Event::RPC, which is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#-----------------------------------------------------------------------
use strict;
use strict;
use lib qw( lib ../lib examples .);
use Event::RPC::Server;
use Event::RPC::Logger;
use Getopt::Std;
my $USAGE = <<__EOU;
Usage: server.pl [-l log-level] [-s] [-a user:pass] [-L loop-module]
Description:
Event::RPC server demonstration program. Execute this from
the distribution's base or examples/ directory. Then execute
examples/client.pl on another console.
Options:
-l log-level Logging level. Default: 4
-s Use SSL encryption
-a user:pass Require authorization
-h host Bind to this host interface. Default: localhost
-L loop-module Event loop module to use.
Default: Event::RPC::Loop::Event
__EOU
sub HELP_MESSAGE {
my ($fh) = @_;
$fh ||= \*STDOUT;
print $fh $USAGE;
exit;
}
main: {
my %opts;
my $opts_ok = getopts('h:L:l:a:s',\%opts);
HELP_MESSAGE() unless $opts_ok;
my %ssl_args;
if ( $opts{s} ) {
%ssl_args = (
ssl => 1,
ssl_key_file => 'ssl/server.key',
ssl_cert_file => 'ssl/server.crt',
ssl_passwd_cb => sub { 'eventrpc' },
);
if ( not -f 'ssl/server.key' ) {
chdir ("examples");
if ( not -f 'ssl/server.key' ) {
print "please execute from toplevel or examples/ directory\n";
exit 1;
}
}
}
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 => ($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();
}
#-- Host parameter
my $host = $opts{h} || "localhost";
#-- Create a Server instance and declare the
#-- exported interface
my $server = Event::RPC::Server->new (
name => "test daemon",
host => $host,
port => 5555,
logger => $logger,
loop => $loop,
start_log_listener => 1,
auto_reload_modules => 1,
%auth_args,
%ssl_args,
classes => {
'Test_class' => {
new => '_constructor',
set_data => 1,
get_data => 1,
hello => 1,
quit => 1,
},
},
);
#-- Start the server resp. the Event loop.
$server->start;
}
|
