line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::Server::NSCA; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
147077
|
use strict; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
231
|
|
4
|
4
|
|
|
4
|
|
20
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
106
|
|
5
|
4
|
|
|
4
|
|
4595
|
use Socket; |
|
4
|
|
|
|
|
23780
|
|
|
4
|
|
|
|
|
2743
|
|
6
|
4
|
|
|
4
|
|
47
|
use Carp; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
227
|
|
7
|
4
|
|
|
4
|
|
3674
|
use Net::Netmask; |
|
4
|
|
|
|
|
100612
|
|
|
4
|
|
|
|
|
674
|
|
8
|
4
|
|
|
4
|
|
4830
|
use Math::Random; |
|
4
|
|
|
|
|
31180
|
|
|
4
|
|
|
|
|
469
|
|
9
|
4
|
|
|
4
|
|
4477
|
use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::Stream); |
|
4
|
|
|
|
|
208827
|
|
|
4
|
|
|
|
|
30
|
|
10
|
4
|
|
|
4
|
|
584701
|
use vars qw($VERSION); |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
169
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$VERSION='0.08'; |
13
|
|
|
|
|
|
|
|
14
|
4
|
|
|
4
|
|
23
|
use constant MAX_INPUT_BUFFER => 2048 ; # /* max size of most buffers we use */ |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
261
|
|
15
|
4
|
|
|
4
|
|
51
|
use constant MAX_HOST_ADDRESS_LENGTH => 256 ; # /* max size of a host address */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
159
|
|
16
|
4
|
|
|
4
|
|
20
|
use constant MAX_HOSTNAME_LENGTH => 64 ; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
150
|
|
17
|
4
|
|
|
4
|
|
18
|
use constant MAX_DESCRIPTION_LENGTH => 128; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
160
|
|
18
|
4
|
|
|
4
|
|
20
|
use constant MAX_PLUGINOUTPUT_LENGTH => 512; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
182
|
|
19
|
4
|
|
|
4
|
|
27
|
use constant MAX_PASSWORD_LENGTH => 512; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
161
|
|
20
|
4
|
|
|
4
|
|
18
|
use constant TRANSMITTED_IV_SIZE => 128; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
174
|
|
21
|
4
|
|
|
4
|
|
19
|
use constant SIZEOF_U_INT32_T => 4; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
152
|
|
22
|
4
|
|
|
4
|
|
20
|
use constant SIZEOF_INT16_T => 2; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
258
|
|
23
|
4
|
|
|
4
|
|
20
|
use constant SIZEOF_INIT_PACKET => TRANSMITTED_IV_SIZE + SIZEOF_U_INT32_T; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
189
|
|
24
|
|
|
|
|
|
|
|
25
|
4
|
|
|
4
|
|
20
|
use constant PROBABLY_ALIGNMENT_ISSUE => 4; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
494
|
|
26
|
|
|
|
|
|
|
|
27
|
4
|
|
|
4
|
|
21
|
use constant SIZEOF_DATA_PACKET => SIZEOF_INT16_T + SIZEOF_U_INT32_T + SIZEOF_U_INT32_T + SIZEOF_INT16_T + MAX_HOSTNAME_LENGTH + MAX_DESCRIPTION_LENGTH + MAX_PLUGINOUTPUT_LENGTH + PROBABLY_ALIGNMENT_ISSUE; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
210
|
|
28
|
|
|
|
|
|
|
|
29
|
4
|
|
|
4
|
|
22
|
use constant ENCRYPT_NONE => 0 ; # /* no encryption */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
199
|
|
30
|
4
|
|
|
4
|
|
20
|
use constant ENCRYPT_XOR => 1 ; # /* not really encrypted, just obfuscated */ |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
171
|
|
31
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_DES => 2 ; # /* DES */ |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
179
|
|
32
|
4
|
|
|
4
|
|
32
|
use constant ENCRYPT_3DES => 3 ; # /* 3DES or Triple DES */ |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
165
|
|
33
|
4
|
|
|
4
|
|
20
|
use constant ENCRYPT_CAST128 => 4 ; # /* CAST-128 */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
250
|
|
34
|
4
|
|
|
4
|
|
53
|
use constant ENCRYPT_CAST256 => 5 ; # /* CAST-256 */ |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
159
|
|
35
|
4
|
|
|
4
|
|
20
|
use constant ENCRYPT_XTEA => 6 ; # /* xTEA */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
197
|
|
36
|
4
|
|
|
4
|
|
25
|
use constant ENCRYPT_3WAY => 7 ; # /* 3-WAY */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
174
|
|
37
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_BLOWFISH => 8 ; # /* SKIPJACK */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
169
|
|
38
|
4
|
|
|
4
|
|
20
|
use constant ENCRYPT_TWOFISH => 9 ; # /* TWOFISH */ |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
177
|
|
39
|
4
|
|
|
4
|
|
20
|
use constant ENCRYPT_LOKI97 => 10 ; # /* LOKI97 */ |
|
4
|
|
|
|
|
57
|
|
|
4
|
|
|
|
|
158
|
|
40
|
4
|
|
|
4
|
|
17
|
use constant ENCRYPT_RC2 => 11 ; # /* RC2 */ |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
163
|
|
41
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_ARCFOUR => 12 ; # /* RC4 */ |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
179
|
|
42
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_RC6 => 13 ; # /* RC6 */ ; # /* UNUSED */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
178
|
|
43
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_RIJNDAEL128 => 14 ; # /* RIJNDAEL-128 */ |
|
4
|
|
|
|
|
24
|
|
|
4
|
|
|
|
|
176
|
|
44
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_RIJNDAEL192 => 15 ; # /* RIJNDAEL-192 */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
154
|
|
45
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_RIJNDAEL256 => 16 ; # /* RIJNDAEL-256 */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
154
|
|
46
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_MARS => 17 ; # /* MARS */ ; # /* UNUSED */ |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
154
|
|
47
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_PANAMA => 18 ; # /* PANAMA */ ; # /* UNUSED */ |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
178
|
|
48
|
4
|
|
|
4
|
|
17
|
use constant ENCRYPT_WAKE => 19 ; # /* WAKE */ |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
152
|
|
49
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_SERPENT => 20 ; # /* SERPENT */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
192
|
|
50
|
4
|
|
|
4
|
|
17
|
use constant ENCRYPT_IDEA => 21 ; # /* IDEA */ ; # /* UNUSED */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
154
|
|
51
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_ENIGMA => 22 ; # /* ENIGMA (Unix crypt) */ |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
3329
|
|
52
|
4
|
|
|
4
|
|
23
|
use constant ENCRYPT_GOST => 23 ; # /* GOST */ |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
172
|
|
53
|
4
|
|
|
4
|
|
19
|
use constant ENCRYPT_SAFER64 => 24 ; # /* SAFER-sk64 */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
144
|
|
54
|
4
|
|
|
4
|
|
18
|
use constant ENCRYPT_SAFER128 => 25 ; # /* SAFER-sk128 */ |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
182
|
|
55
|
4
|
|
|
4
|
|
78
|
use constant ENCRYPT_SAFERPLUS => 26 ; # /* SAFER+ */ |
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
12272
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $HAVE_MCRYPT = 0; |
58
|
|
|
|
|
|
|
eval { |
59
|
|
|
|
|
|
|
require Mcrypt; |
60
|
|
|
|
|
|
|
$HAVE_MCRYPT++; |
61
|
|
|
|
|
|
|
}; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Lookups for loading. |
64
|
|
|
|
|
|
|
my %mcrypts = ( ENCRYPT_NONE, "none", |
65
|
|
|
|
|
|
|
ENCRYPT_XOR, "xor", |
66
|
|
|
|
|
|
|
ENCRYPT_DES, "des", |
67
|
|
|
|
|
|
|
ENCRYPT_3DES, "3des", |
68
|
|
|
|
|
|
|
ENCRYPT_CAST128, "cast-128", |
69
|
|
|
|
|
|
|
ENCRYPT_CAST256, "cast-256", |
70
|
|
|
|
|
|
|
ENCRYPT_XTEA, "xtea", |
71
|
|
|
|
|
|
|
ENCRYPT_3WAY, "threeway", |
72
|
|
|
|
|
|
|
ENCRYPT_BLOWFISH, "blowfish", |
73
|
|
|
|
|
|
|
ENCRYPT_TWOFISH, "twofish", |
74
|
|
|
|
|
|
|
ENCRYPT_LOKI97, "loki97", |
75
|
|
|
|
|
|
|
ENCRYPT_RC2, "rc2", |
76
|
|
|
|
|
|
|
ENCRYPT_ARCFOUR, "arcfour", |
77
|
|
|
|
|
|
|
ENCRYPT_RC6, "rc6", |
78
|
|
|
|
|
|
|
ENCRYPT_RIJNDAEL128, "rijndael-128", |
79
|
|
|
|
|
|
|
ENCRYPT_RIJNDAEL192, "rijndael-192", |
80
|
|
|
|
|
|
|
ENCRYPT_RIJNDAEL256, "rijndael-256", |
81
|
|
|
|
|
|
|
ENCRYPT_MARS, "mars", |
82
|
|
|
|
|
|
|
ENCRYPT_PANAMA, "panama", |
83
|
|
|
|
|
|
|
ENCRYPT_WAKE, "wake", |
84
|
|
|
|
|
|
|
ENCRYPT_SERPENT, "serpent", |
85
|
|
|
|
|
|
|
ENCRYPT_IDEA, "idea", |
86
|
|
|
|
|
|
|
ENCRYPT_ENIGMA, "engima", |
87
|
|
|
|
|
|
|
ENCRYPT_GOST, "gost", |
88
|
|
|
|
|
|
|
ENCRYPT_SAFER64, "safer-sk64", |
89
|
|
|
|
|
|
|
ENCRYPT_SAFER128, "safer-sk128", |
90
|
|
|
|
|
|
|
ENCRYPT_SAFERPLUS, "saferplus", |
91
|
|
|
|
|
|
|
); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub spawn { |
94
|
3
|
|
|
3
|
1
|
47
|
my $package = shift; |
95
|
3
|
|
|
|
|
26
|
my %opts = @_; |
96
|
3
|
|
|
|
|
38
|
$opts{lc $_} = delete $opts{$_} for keys %opts; |
97
|
3
|
50
|
|
|
|
17
|
croak "$package requires a 'password' argument\n" |
98
|
|
|
|
|
|
|
unless $opts{password}; |
99
|
3
|
50
|
|
|
|
12
|
croak "$package requires an 'encryption' argument\n" |
100
|
|
|
|
|
|
|
unless defined $opts{encryption}; |
101
|
3
|
50
|
|
|
|
24
|
croak "'encryption' argument must be a valid numeric\n" |
102
|
|
|
|
|
|
|
unless defined $mcrypts{ $opts{encryption} }; |
103
|
3
|
|
|
|
|
7
|
my $options = delete $opts{options}; |
104
|
3
|
|
50
|
|
|
43
|
my $access = delete $opts{access} || [ Net::Netmask->new('any') ]; |
105
|
3
|
50
|
|
|
|
240
|
$access = [ ] unless ref $access eq 'ARRAY'; |
106
|
3
|
|
|
|
|
9
|
foreach my $acl ( @$access ) { |
107
|
3
|
50
|
|
|
|
35
|
next unless $acl->isa('Net::Netmask'); |
108
|
3
|
|
|
|
|
6
|
push @{ $opts{access} }, $acl; |
|
3
|
|
|
|
|
14
|
|
109
|
|
|
|
|
|
|
} |
110
|
3
|
|
|
|
|
11
|
my $self = bless \%opts, $package; |
111
|
3
|
100
|
|
|
|
57
|
$self->{session_id} = POE::Session->create( |
112
|
|
|
|
|
|
|
object_states => [ |
113
|
|
|
|
|
|
|
$self => { shutdown => '_shutdown', |
114
|
|
|
|
|
|
|
}, |
115
|
|
|
|
|
|
|
$self => [qw( |
116
|
|
|
|
|
|
|
_start |
117
|
|
|
|
|
|
|
_accept_client |
118
|
|
|
|
|
|
|
_accept_failed |
119
|
|
|
|
|
|
|
_conn_input |
120
|
|
|
|
|
|
|
_conn_error |
121
|
|
|
|
|
|
|
_conn_alarm |
122
|
|
|
|
|
|
|
register |
123
|
|
|
|
|
|
|
unregister |
124
|
|
|
|
|
|
|
)], |
125
|
|
|
|
|
|
|
], |
126
|
|
|
|
|
|
|
heap => $self, |
127
|
|
|
|
|
|
|
( ref($options) eq 'HASH' ? ( options => $options ) : () ), |
128
|
|
|
|
|
|
|
)->ID(); |
129
|
3
|
|
|
|
|
513
|
return $self; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub shutdown { |
133
|
3
|
|
|
3
|
1
|
6610
|
my $self = shift; |
134
|
3
|
|
|
|
|
18
|
$poe_kernel->post( $self->{session_id}, 'shutdown' ); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub session_id { |
138
|
2
|
|
|
2
|
1
|
61
|
return $_[0]->{session_id}; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub getsockname { |
142
|
3
|
50
|
|
3
|
1
|
2717
|
return unless $_[0]->{listener}; |
143
|
3
|
|
|
|
|
19
|
return $_[0]->{listener}->getsockname(); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _start { |
147
|
3
|
|
|
3
|
|
964
|
my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER]; |
148
|
3
|
|
|
|
|
35
|
$self->{session_id} = $_[SESSION]->ID(); |
149
|
3
|
50
|
|
|
|
28
|
if ( $self->{alias} ) { |
150
|
0
|
|
|
|
|
0
|
$kernel->alias_set( $self->{alias} ); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
3
|
|
|
|
|
19
|
$kernel->refcount_increment( $self->{session_id} => __PACKAGE__ ); |
154
|
|
|
|
|
|
|
} |
155
|
3
|
|
|
|
|
138
|
$self->{filter} = POE::Filter::Stream->new(); |
156
|
3
|
50
|
|
|
|
79
|
$self->{listener} = POE::Wheel::SocketFactory->new( |
|
|
50
|
|
|
|
|
|
157
|
|
|
|
|
|
|
( defined $self->{address} ? ( BindAddress => $self->{address} ) : () ), |
158
|
|
|
|
|
|
|
( defined $self->{port} ? ( BindPort => $self->{port} ) : ( BindPort => 5667 ) ), |
159
|
|
|
|
|
|
|
SuccessEvent => '_accept_client', |
160
|
|
|
|
|
|
|
FailureEvent => '_accept_failed', |
161
|
|
|
|
|
|
|
SocketDomain => AF_INET, # Sets the socket() domain |
162
|
|
|
|
|
|
|
SocketType => SOCK_STREAM, # Sets the socket() type |
163
|
|
|
|
|
|
|
SocketProtocol => 'tcp', # Sets the socket() protocol |
164
|
|
|
|
|
|
|
Reuse => 'on', # Lets the port be reused |
165
|
|
|
|
|
|
|
); |
166
|
3
|
|
|
|
|
4282
|
return; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub register { |
170
|
2
|
|
|
2
|
1
|
163
|
my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER]; |
171
|
2
|
|
|
|
|
9
|
my $sender_id = $sender->ID(); |
172
|
2
|
|
|
|
|
9
|
my %args; |
173
|
2
|
50
|
|
|
|
10
|
if ( ref $_[ARG0] eq 'HASH' ) { |
|
|
0
|
|
|
|
|
|
174
|
2
|
|
|
|
|
4
|
%args = %{ $_[ARG0] }; |
|
2
|
|
|
|
|
9
|
|
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
elsif ( ref $_[ARG0] eq 'ARRAY' ) { |
177
|
0
|
|
|
|
|
0
|
%args = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
0
|
|
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
else { |
180
|
0
|
|
|
|
|
0
|
%args = @_[ARG0..$#_]; |
181
|
|
|
|
|
|
|
} |
182
|
2
|
|
|
|
|
12
|
$args{lc $_} = delete $args{$_} for keys %args; |
183
|
2
|
50
|
|
|
|
109
|
unless ( $args{event} ) { |
184
|
0
|
|
|
|
|
0
|
warn "No 'event' argument supplied\n"; |
185
|
0
|
|
|
|
|
0
|
return; |
186
|
|
|
|
|
|
|
} |
187
|
2
|
50
|
|
|
|
9
|
if ( defined $self->{sessions}->{ $sender_id } ) { |
188
|
0
|
|
|
|
|
0
|
$self->{sessions}->{ $sender_id } = \%args; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
else { |
191
|
2
|
|
|
|
|
8
|
$self->{sessions}->{ $sender_id } = \%args; |
192
|
2
|
|
|
|
|
11
|
$kernel->refcount_increment( $sender_id, __PACKAGE__ ); |
193
|
|
|
|
|
|
|
} |
194
|
2
|
|
|
|
|
57
|
return; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub unregister { |
198
|
0
|
|
|
0
|
1
|
0
|
my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER]; |
199
|
0
|
|
|
|
|
0
|
my $sender_id = $sender->ID(); |
200
|
0
|
|
|
|
|
0
|
my %args; |
201
|
0
|
0
|
|
|
|
0
|
if ( ref $_[ARG0] eq 'HASH' ) { |
|
|
0
|
|
|
|
|
|
202
|
0
|
|
|
|
|
0
|
%args = %{ $_[ARG0] }; |
|
0
|
|
|
|
|
0
|
|
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
elsif ( ref $_[ARG0] eq 'ARRAY' ) { |
205
|
0
|
|
|
|
|
0
|
%args = @{ $_[ARG0] }; |
|
0
|
|
|
|
|
0
|
|
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
else { |
208
|
0
|
|
|
|
|
0
|
%args = @_[ARG0..$#_]; |
209
|
|
|
|
|
|
|
} |
210
|
0
|
|
|
|
|
0
|
$args{lc $_} = delete $args{$_} for keys %args; |
211
|
0
|
|
|
|
|
0
|
my $data = delete $self->{sessions}->{ $sender_id }; |
212
|
0
|
0
|
|
|
|
0
|
$kernel->refcount_decrement( $sender_id, __PACKAGE__ ) if $data; |
213
|
0
|
|
|
|
|
0
|
return; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _shutdown { |
217
|
3
|
|
|
3
|
|
1225
|
my ($kernel,$self) = @_[KERNEL,OBJECT]; |
218
|
3
|
|
|
|
|
25
|
delete $self->{listener}; |
219
|
3
|
|
|
|
|
571
|
delete $self->{clients}; |
220
|
3
|
|
|
|
|
7
|
$kernel->refcount_decrement( $_, __PACKAGE__ ) for keys %{ $self->{sessions} }; |
|
3
|
|
|
|
|
20
|
|
221
|
3
|
|
|
|
|
99
|
$kernel->alarm_remove_all(); |
222
|
3
|
|
|
|
|
112
|
$kernel->alias_remove( $_ ) for $kernel->alias_list(); |
223
|
3
|
50
|
|
|
|
97
|
$kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ ) unless $self->{alias}; |
224
|
3
|
|
|
|
|
102
|
return; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub _accept_failed { |
228
|
0
|
|
|
0
|
|
0
|
my ($kernel,$self,$operation,$errnum,$errstr,$wheel_id) = @_[KERNEL,OBJECT,ARG0..ARG3]; |
229
|
0
|
|
|
|
|
0
|
warn "Listener: $wheel_id generated $operation error $errnum: $errstr\n"; |
230
|
0
|
|
|
|
|
0
|
delete $self->{listener}; |
231
|
0
|
|
|
|
|
0
|
$kernel->yield( '_shutdown' ); |
232
|
0
|
|
|
|
|
0
|
return; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub _accept_client { |
236
|
3
|
|
|
3
|
|
4680
|
my ($kernel,$self,$socket,$peeraddr,$peerport) = @_[KERNEL,OBJECT,ARG0..ARG2]; |
237
|
3
|
|
|
|
|
52
|
my $sockaddr = inet_ntoa( ( unpack_sockaddr_in ( CORE::getsockname $socket ) )[1] ); |
238
|
3
|
|
|
|
|
23
|
my $sockport = ( unpack_sockaddr_in ( CORE::getsockname $socket ) )[0]; |
239
|
3
|
|
|
|
|
17
|
$peeraddr = inet_ntoa( $peeraddr ); |
240
|
|
|
|
|
|
|
|
241
|
3
|
50
|
|
|
|
6
|
return unless grep { $_->match( $peeraddr ) } @{ $self->{access} }; |
|
3
|
|
|
|
|
21
|
|
|
3
|
|
|
|
|
11
|
|
242
|
|
|
|
|
|
|
|
243
|
3
|
|
|
|
|
337
|
my $wheel = POE::Wheel::ReadWrite->new( |
244
|
|
|
|
|
|
|
Handle => $socket, |
245
|
|
|
|
|
|
|
Filter => $self->{filter}, |
246
|
|
|
|
|
|
|
InputEvent => '_conn_input', |
247
|
|
|
|
|
|
|
ErrorEvent => '_conn_error', |
248
|
|
|
|
|
|
|
FlushedEvent => '_conn_flushed', |
249
|
|
|
|
|
|
|
); |
250
|
|
|
|
|
|
|
|
251
|
3
|
50
|
|
|
|
943
|
return unless $wheel; |
252
|
|
|
|
|
|
|
|
253
|
3
|
|
|
|
|
15
|
my $id = $wheel->ID(); |
254
|
3
|
|
|
|
|
29
|
my $time = time(); |
255
|
3
|
|
|
|
|
20
|
my $iv = join '', random_uniform_integer(128,0,9); |
256
|
3
|
|
|
|
|
564
|
my $init_packet = $iv . pack 'N', $time; |
257
|
3
|
|
|
|
|
28
|
$self->{clients}->{ $id } = |
258
|
|
|
|
|
|
|
{ |
259
|
|
|
|
|
|
|
wheel => $wheel, |
260
|
|
|
|
|
|
|
peeraddr => $peeraddr, |
261
|
|
|
|
|
|
|
peerport => $peerport, |
262
|
|
|
|
|
|
|
sockaddr => $sockaddr, |
263
|
|
|
|
|
|
|
sockport => $sockport, |
264
|
|
|
|
|
|
|
ts => $time, |
265
|
|
|
|
|
|
|
iv => $iv, |
266
|
|
|
|
|
|
|
}; |
267
|
3
|
|
50
|
|
|
76
|
$self->{clients}->{ $id }->{alarm} = $kernel->delay_set( '_conn_alarm', $self->{time_out} || 60, $id ); |
268
|
3
|
|
|
|
|
233
|
$wheel->put( $init_packet ); |
269
|
3
|
|
|
|
|
227
|
return; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub _conn_exists { |
273
|
3
|
|
|
3
|
|
10
|
my ($self,$wheel_id) = @_; |
274
|
3
|
50
|
33
|
|
|
41
|
return 0 unless $wheel_id and defined $self->{clients}->{ $wheel_id }; |
275
|
3
|
|
|
|
|
13
|
return 1; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub _conn_error { |
279
|
0
|
|
|
0
|
|
0
|
my ($self,$errstr,$id) = @_[OBJECT,ARG2,ARG3]; |
280
|
0
|
0
|
|
|
|
0
|
return unless $self->_conn_exists( $id ); |
281
|
0
|
|
|
|
|
0
|
delete $self->{clients}->{ $id }; |
282
|
0
|
|
|
|
|
0
|
return; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub _conn_alarm { |
286
|
1
|
|
|
1
|
|
10001216
|
my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0]; |
287
|
1
|
50
|
|
|
|
30
|
return unless $self->_conn_exists( $id ); |
288
|
1
|
|
|
|
|
18
|
delete $self->{clients}->{ $id }; |
289
|
1
|
|
|
|
|
440
|
return; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub _conn_input { |
293
|
2
|
|
|
2
|
|
18389
|
my ($kernel,$self,$packet,$id) = @_[KERNEL,OBJECT,ARG0,ARG1]; |
294
|
2
|
50
|
|
|
|
10
|
return unless $self->_conn_exists( $id ); |
295
|
2
|
|
|
|
|
8
|
my $client = delete $self->{clients}->{ $id }; |
296
|
2
|
|
|
|
|
9
|
delete $client->{wheel}; |
297
|
2
|
|
|
|
|
394
|
$kernel->alarm_remove( delete $client->{alarm} ); |
298
|
2
|
50
|
|
|
|
213
|
return unless length( $packet ) == SIZEOF_DATA_PACKET; # wrong packet size received |
299
|
2
|
|
|
|
|
14
|
my $input = _decrypt( $packet, $self->{encryption}, $client->{iv}, $self->{password} ); |
300
|
2
|
50
|
|
|
|
10
|
return unless $input; # something wrong with the decryption |
301
|
2
|
|
|
|
|
15
|
my $version = unpack 'n', substr $input, 0, 4; |
302
|
2
|
50
|
|
|
|
18
|
return unless $version == 3; # Wrong version received |
303
|
2
|
|
|
|
|
8
|
my $crc32 = unpack 'N', substr $input, 4, 4; |
304
|
2
|
|
|
|
|
8
|
my $ts = unpack 'N', substr $input, 8, 4; |
305
|
2
|
|
|
|
|
6
|
my $rc = unpack 'n', substr $input, 12, 2; |
306
|
2
|
|
|
|
|
7
|
my $firstbit = substr $input, 0, 4; |
307
|
2
|
|
|
|
|
7
|
my $secondbit = substr $input, 8; |
308
|
2
|
|
|
|
|
36
|
my $checksum = _calculate_crc32( $firstbit . pack('N', 0) . $secondbit ); |
309
|
2
|
|
|
|
|
25
|
my @data = unpack 'a[64]a[128]a[512]', substr $input, 14; |
310
|
2
|
|
|
|
|
42
|
s/\000.*$// for @data; |
311
|
2
|
|
|
|
|
9
|
$client->{version} = $version; |
312
|
2
|
|
|
|
|
21
|
$client->{crc32} = $crc32; |
313
|
2
|
|
|
|
|
5
|
$client->{checksum} = $checksum; |
314
|
2
|
|
|
|
|
5
|
$client->{return_code} = $rc; |
315
|
2
|
|
|
|
|
18
|
$client->{$_} = shift @data for qw(host_name svc_description plugin_output); |
316
|
2
|
|
|
|
|
18
|
delete $client->{$_} for qw(peerport sockaddr sockport ts iv); |
317
|
2
|
|
|
|
|
44
|
$kernel->post( $_, $self->{sessions}->{$_}->{event}, $client, $self->{sessions}->{$_}->{context} ) |
318
|
2
|
|
|
|
|
5
|
for keys %{ $self->{sessions} }; |
319
|
2
|
|
|
|
|
318
|
return; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
#/* calculates the CRC 32 value for a buffer */ |
323
|
|
|
|
|
|
|
sub _calculate_crc32 { |
324
|
2
|
|
|
2
|
|
5
|
my $string = shift; |
325
|
|
|
|
|
|
|
|
326
|
2
|
|
|
|
|
9
|
my $crc32_table = _generate_crc32_table(); |
327
|
2
|
|
|
|
|
6
|
my $crc = 0xFFFFFFFF; |
328
|
|
|
|
|
|
|
|
329
|
2
|
|
|
|
|
186
|
foreach my $tchar (split(//, $string)) { |
330
|
1440
|
|
|
|
|
1235
|
my $char = ord($tchar); |
331
|
1440
|
|
|
|
|
1849
|
$crc = (($crc >> 8) & 0x00FFFFFF) ^ $crc32_table->[($crc ^ $char) & 0xFF]; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
2
|
|
|
|
|
97
|
return ($crc ^ 0xFFFFFFFF); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
#/* build the crc table - must be called before calculating the crc value */ |
338
|
|
|
|
|
|
|
sub _generate_crc32_table { |
339
|
2
|
|
|
2
|
|
21
|
my $crc32_table = []; |
340
|
2
|
|
|
|
|
5
|
my $poly = 0xEDB88320; |
341
|
|
|
|
|
|
|
|
342
|
2
|
|
|
|
|
11
|
for (my $i = 0; $i < 256; $i++){ |
343
|
512
|
|
|
|
|
588
|
my $crc = $i; |
344
|
512
|
|
|
|
|
854
|
for (my $j = 8; $j > 0; $j--) { |
345
|
4096
|
100
|
|
|
|
5210
|
if ($crc & 1) { |
346
|
2048
|
|
|
|
|
3925
|
$crc = ($crc >> 1) ^ $poly; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
else { |
349
|
2048
|
|
|
|
|
3444
|
$crc = ($crc >> 1); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
512
|
|
|
|
|
1323
|
$crc32_table->[$i] = $crc; |
353
|
|
|
|
|
|
|
} |
354
|
2
|
|
|
|
|
11
|
return $crc32_table; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# central switchboard for encryption methods. |
358
|
|
|
|
|
|
|
sub _decrypt { |
359
|
2
|
|
|
2
|
|
7
|
my ($data_packet_string, $encryption_method, $iv_salt, $password) = @_; |
360
|
|
|
|
|
|
|
|
361
|
2
|
|
|
|
|
4
|
my $crypted; |
362
|
2
|
100
|
|
|
|
16
|
if ($encryption_method == ENCRYPT_NONE) { |
|
|
50
|
|
|
|
|
|
363
|
1
|
|
|
|
|
3
|
$crypted = $data_packet_string; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
elsif ($encryption_method == ENCRYPT_XOR) { |
366
|
1
|
|
|
|
|
4
|
$crypted = _decrypt_xor($data_packet_string, $iv_salt, $password); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
else { |
369
|
0
|
|
|
|
|
0
|
$crypted = _decrypt_mcrypt( $data_packet_string, $encryption_method, $iv_salt, $password ); |
370
|
|
|
|
|
|
|
} |
371
|
2
|
|
|
|
|
8
|
return $crypted; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub _decrypt_xor { |
375
|
1
|
|
|
1
|
|
2
|
my ($data_packet_string, $iv_salt, $password) = @_; |
376
|
|
|
|
|
|
|
|
377
|
1
|
|
|
|
|
118
|
my @out = split(//, $data_packet_string); |
378
|
1
|
|
|
|
|
45
|
my @salt_iv = split(//, $iv_salt); |
379
|
1
|
|
|
|
|
9
|
my @salt_pw = split(//, $password); |
380
|
|
|
|
|
|
|
|
381
|
1
|
|
|
|
|
3
|
my $y = 0; |
382
|
1
|
|
|
|
|
2
|
my $x = 0; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
#/* rotate over IV we received from the server... */ |
385
|
1
|
|
|
|
|
5
|
while ($y < SIZEOF_DATA_PACKET) { |
386
|
|
|
|
|
|
|
#/* keep rotating over IV */ |
387
|
720
|
|
|
|
|
842
|
$out[$y] = $out[$y] ^ $salt_iv[$x % scalar(@salt_iv)]; |
388
|
|
|
|
|
|
|
|
389
|
720
|
|
|
|
|
605
|
$y++; |
390
|
720
|
|
|
|
|
1053
|
$x++; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
#/* rotate over password... */ |
394
|
1
|
|
|
|
|
4
|
$y=0; |
395
|
1
|
|
|
|
|
3
|
$x=0; |
396
|
1
|
|
|
|
|
5
|
while ($y < SIZEOF_DATA_PACKET){ |
397
|
|
|
|
|
|
|
#/* keep rotating over password */ |
398
|
720
|
|
|
|
|
1059
|
$out[$y] = $out[$y] ^ $salt_pw[$x % scalar(@salt_pw)]; |
399
|
|
|
|
|
|
|
|
400
|
720
|
|
|
|
|
684
|
$y++; |
401
|
720
|
|
|
|
|
1185
|
$x++; |
402
|
|
|
|
|
|
|
} |
403
|
1
|
|
|
|
|
103
|
return join '', @out; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub _decrypt_mcrypt { |
407
|
0
|
|
|
0
|
|
|
my ( $data_packet_string, $encryption_method, $iv_salt, $password ) = @_; |
408
|
0
|
|
|
|
|
|
my $crypted; |
409
|
0
|
|
|
|
|
|
my $evalok = 0; |
410
|
0
|
0
|
|
|
|
|
if( $HAVE_MCRYPT ){ |
411
|
|
|
|
|
|
|
# Initialise the routine |
412
|
0
|
0
|
|
|
|
|
if( defined( $mcrypts{$encryption_method} ) ){ |
413
|
|
|
|
|
|
|
# Load the routine. |
414
|
0
|
|
|
|
|
|
my $routine = $mcrypts{$encryption_method}; |
415
|
0
|
|
|
|
|
|
eval { |
416
|
|
|
|
|
|
|
# This sometimes dies with 'mcrypt is not of type MCRYPT'. |
417
|
0
|
|
|
|
|
|
my $td = Mcrypt->new( algorithm => $routine, mode => 'cfb', verbose => 0 ); |
418
|
0
|
|
|
|
|
|
my $key = $password; |
419
|
0
|
|
|
|
|
|
my $iv = substr $iv_salt, 0, $td->{IV_SIZE}; |
420
|
0
|
0
|
|
|
|
|
if( defined( $td ) ){ |
421
|
0
|
|
|
|
|
|
$td->init($key, $iv); |
422
|
0
|
|
|
|
|
|
for (my $i = 0; $i < length( $data_packet_string ); $i++ ) { |
423
|
0
|
|
|
|
|
|
$crypted .= $td->decrypt( substr $data_packet_string, 0+$i, 1 ); |
424
|
|
|
|
|
|
|
} |
425
|
0
|
|
|
|
|
|
$td->end(); |
426
|
|
|
|
|
|
|
} |
427
|
0
|
|
|
|
|
|
$evalok++; |
428
|
|
|
|
|
|
|
}; |
429
|
0
|
0
|
|
|
|
|
warn "$@\n" if $@; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
0
|
|
|
|
|
|
return $crypted; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
'Hon beiriant goes at hun ar ddeg'; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
__END__ |