-
Notifications
You must be signed in to change notification settings - Fork 0
/
RemoteServer.pm
124 lines (103 loc) · 3.18 KB
/
RemoteServer.pm
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
# ---- class RemoteServer ----
# TCP server for synchronizing between ddgrey instances
package DDgrey::RemoteServer;
use strict;
use integer;
use Data::Dumper; # DEBUG
use Net::hostent;
use DDgrey::Perl6::Parameters;
use Socket;
use DDgrey::DNS qw(resolved);
use DDgrey::SyncClientConnection;
use parent qw(DDgrey::Server);
# ---- class methods ----
sub service($self){
# return: name of subsystem (for logging)
return "remote server";
};
# ---- constructor ----
sub new($class){
# return: new TCP server of class
# effect: may raise exception
my $self=bless({},$class);
my $port=($main::config->{port} or ($< ? 1722 : 722));
for my $n (0..20){
$self->{fh}=IO::Socket::INET->new(Listen=>10,Proto=>'tcp',LocalPort=>$port,ReusePort=>1) and last;
main::lm("can't start server on port $port ($!), trying again",$self->service(),'warning');
sleep 5;
};
$self->{fh} or main::error("can't start server on port $port ($!)");
$self->{fh}->blocking(0);
$self->{fh}->timeout($main::debug ? 5 : 60);
# configuration of accept parameters
foreach my $r (@{$main::config->{accept}}){
for my $ip (resolved($r)){
my $m=Net::Netmask->new2($ip) or main::error("unkown address/range $ip");
push @{$self->{accept_write}},$m;
push @{$self->{accept_read}},$m;
};
};
foreach my $r (@{$main::config->{accept_reader}}){
for my $ip (resolved($r)){
my $m=Net::Netmask->new2($ip) or main::error("unkown address/range $ip");
push @{$self->{accept_read}},$m;
};
};
foreach my $r (@{$main::config->{accept_writer}}){
for my $ip (resolved($r)){
my $m=Net::Netmask->new2($ip) or main::error("unkown address/range $ip");
push @{$self->{accept_write}},$m;
};
};
foreach my $r (@{$main::config->{peer}}){
my $peer=$r->{arg}->[0];
for my $ip (resolved($peer)){
my $m=Net::Netmask->new2($ip) or main::error("unkown address/range $ip");
push @{$self->{accept_read}},$m;
};
};
# register
$main::select->register_read($self->{fh},sub{$self->receive_read(@_)});
$main::select->register_exception($self->{fh},sub{$self->close()});
main::lm("listening on port $port",$self->service());
return $self;
};
# ---- methods ----
sub receive_read($self,$fh){
# effect: handles activity on fh
if($fh eq $self->{fh}){
my $client_fh=$fh->accept();
if(!defined($client_fh)){
main::lm("accept failed ($!)",$self->service(),"warning");
return 0;
};
$client_fh->autoflush(1);
$client_fh->blocking(0);
$client_fh->timeout($main::debug ? 5 : 60);
# check accept permission
my $ip=$client_fh->peerhost;
my $accept={read=>0,write=>0};
foreach my $m (@{$self->{accept_read}}){
if($m->match($ip)){
$accept->{read}=1;
last;
};
};
foreach my $m (@{$self->{accept_write}}){
if($m->match($ip)){
$accept->{write}=1;
last;
};
};
# close if no permission at all
if(!($accept->{read} or $accept->{write})){
main::lm("denied connect from ".$client_fh->peerhost(),$self->service(),"warning");
$client_fh->shutdown(2);
$client_fh->close();
return;
};
my $client=DDgrey::SyncClientConnection->new($self,$client_fh,$accept);
};
};
# ---- package init ----
return 1;