line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mail::Pyzor::Client; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Copyright 2018 cPanel, LLC. |
4
|
|
|
|
|
|
|
# All rights reserved. |
5
|
|
|
|
|
|
|
# http://cpanel.net |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# <@LICENSE> |
8
|
|
|
|
|
|
|
# Licensed to the Apache Software Foundation (ASF) under one or more |
9
|
|
|
|
|
|
|
# contributor license agreements. See the NOTICE file distributed with |
10
|
|
|
|
|
|
|
# this work for additional information regarding copyright ownership. |
11
|
|
|
|
|
|
|
# The ASF licenses this file to you under the Apache License, Version 2.0 |
12
|
|
|
|
|
|
|
# (the "License"); you may not use this file except in compliance with |
13
|
|
|
|
|
|
|
# the License. You may obtain a copy of the License at: |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# http://www.apache.org/licenses/LICENSE-2.0 |
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# Unless required by applicable law or agreed to in writing, software |
18
|
|
|
|
|
|
|
# distributed under the License is distributed on an "AS IS" BASIS, |
19
|
|
|
|
|
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
20
|
|
|
|
|
|
|
# See the License for the specific language governing permissions and |
21
|
|
|
|
|
|
|
# limitations under the License. |
22
|
|
|
|
|
|
|
# @LICENSE> |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
|
25
|
2
|
|
|
2
|
|
240826
|
use strict; |
|
2
|
|
|
|
|
17
|
|
|
2
|
|
|
|
|
50
|
|
26
|
2
|
|
|
2
|
|
8
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
243
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=encoding utf-8 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 NAME |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Mail::Pyzor::Client - Pyzor client logic |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use Mail::Pyzor::Client (); |
37
|
|
|
|
|
|
|
use Mail::Pyzor::Digest (); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $client = Mail::Pyzor::Client->new(); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my $digest = Mail::Pyzor::Digest::get( $msg ); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $check_ref = $client->check($digest); |
44
|
|
|
|
|
|
|
die $check_ref->{'Diag'} if $check_ref->{'Code'} ne '200'; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $report_ref = $client->report($digest); |
47
|
|
|
|
|
|
|
die $report_ref->{'Diag'} if $report_ref->{'Code'} ne '200'; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 DESCRIPTION |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
A bare-bones L client that currently only |
52
|
|
|
|
|
|
|
implements the functionality needed for L. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 PROTOCOL DETAILS |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
The Pyzor protocol is not a published standard, and there appears to be |
57
|
|
|
|
|
|
|
no meaningful public documentation. What follows is enough information, |
58
|
|
|
|
|
|
|
largely gleaned through forum posts and reverse engineering, to facilitate |
59
|
|
|
|
|
|
|
effective use of this module: |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Pyzor is an RPC-oriented, message-based protocol. Each message |
62
|
|
|
|
|
|
|
is a simple dictionary of 7-bit ASCII keys and values. Server responses |
63
|
|
|
|
|
|
|
always include at least the following: |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=over |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=item * C - Similar to HTTP status codes; anything besides C<200> |
68
|
|
|
|
|
|
|
is an error. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item * C - Similar to HTTP status reasons: a text description |
71
|
|
|
|
|
|
|
of the status. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=back |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
(NB: There are additional standard response headers that are useful only for |
76
|
|
|
|
|
|
|
the protocol itself and thus are not part of this module’s returns.) |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head2 Reliability |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Pyzor uses UDP rather than TCP, so no message is guaranteed to reach its |
81
|
|
|
|
|
|
|
destination. A transmission failure can happen in either the request or |
82
|
|
|
|
|
|
|
the response; in either case, a timeout error will result. Such errors |
83
|
|
|
|
|
|
|
are represented as thrown instances of L. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
our $VERSION = '0.06_01'; # TRIAL |
90
|
|
|
|
|
|
|
$VERSION =~ tr/_//d; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
our $DEFAULT_SERVER_HOST = 'public.pyzor.org'; |
93
|
|
|
|
|
|
|
our $DEFAULT_SERVER_PORT = 24441; |
94
|
|
|
|
|
|
|
our $DEFAULT_USERNAME = 'anonymous'; |
95
|
|
|
|
|
|
|
our $DEFAULT_PASSWORD = ''; |
96
|
|
|
|
|
|
|
our $DEFAULT_OP_SPEC = '20,3,60,3'; |
97
|
|
|
|
|
|
|
our $PYZOR_PROTOCOL_VERSION = 2.1; |
98
|
|
|
|
|
|
|
our $DEFAULT_TIMEOUT = 3.5; |
99
|
|
|
|
|
|
|
our $READ_SIZE = 8192; |
100
|
|
|
|
|
|
|
|
101
|
2
|
|
|
2
|
|
714
|
use Mail::Pyzor::SHA (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
33
|
|
102
|
2
|
|
|
2
|
|
848
|
use IO::Socket::INET (); |
|
2
|
|
|
|
|
31470
|
|
|
2
|
|
|
|
|
44
|
|
103
|
2
|
|
|
2
|
|
792
|
use IO::SigGuard (); |
|
2
|
|
|
|
|
399
|
|
|
2
|
|
|
|
|
35
|
|
104
|
2
|
|
|
2
|
|
707
|
use Mail::Pyzor::X (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
2020
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my @hash_order = ( 'Op', 'Op-Digest', 'Op-Spec', 'Thread', 'PV', 'User', 'Time', 'Sig' ); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 new(%OPTS) |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Create a new pyzor client. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=over 2 |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item Input |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
%OPTS are (all optional): |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=over 3 |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=item * C - The pyzor server host to connect to (default is |
125
|
|
|
|
|
|
|
C) |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item * C - The pyzor server port to connect to (default is |
128
|
|
|
|
|
|
|
24441) |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item * C - The username to present to the pyzor server (default |
131
|
|
|
|
|
|
|
is C) |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=item * C - The password to present to the pyzor server (default |
134
|
|
|
|
|
|
|
is empty) |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item * C - The maximum time, in seconds, to wait for a response |
137
|
|
|
|
|
|
|
from the pyzor server (defeault is 3.5) |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=back |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item Output |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=over 3 |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Returns a L object. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=back |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=back |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub new { |
154
|
5
|
|
|
5
|
1
|
23022
|
my ( $class, %OPTS ) = @_; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
return bless { |
157
|
|
|
|
|
|
|
'_server_host' => $OPTS{'server_host'} || $DEFAULT_SERVER_HOST, |
158
|
|
|
|
|
|
|
'_server_port' => $OPTS{'server_port'} || $DEFAULT_SERVER_PORT, |
159
|
|
|
|
|
|
|
'_username' => $OPTS{'username'} || $DEFAULT_USERNAME, |
160
|
|
|
|
|
|
|
'_password' => $OPTS{'password'} || $DEFAULT_PASSWORD, |
161
|
|
|
|
|
|
|
'_op_spec' => $DEFAULT_OP_SPEC, |
162
|
5
|
|
66
|
|
|
97
|
'_timeout' => $OPTS{'timeout'} || $DEFAULT_TIMEOUT, |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
163
|
|
|
|
|
|
|
}, $class; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 REQUEST METHODS |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 report($digest) |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Report the digest of a spam message to the pyzor server. This function |
173
|
|
|
|
|
|
|
will throw if a messaging failure or timeout happens. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=over 2 |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=item Input |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=over 3 |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item $digest C |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
The message digest to report, as given by |
184
|
|
|
|
|
|
|
C. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=back |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item Output |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=over 3 |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item C |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Returns a hashref of the standard attributes noted above. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=back |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=back |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub report { |
203
|
2
|
|
|
2
|
1
|
342
|
my ( $self, $digest ) = @_; |
204
|
|
|
|
|
|
|
|
205
|
2
|
|
|
|
|
5
|
my $msg_ref = $self->_get_base_msg( 'report', $digest ); |
206
|
|
|
|
|
|
|
|
207
|
1
|
|
|
|
|
4
|
$msg_ref->{'Op-Spec'} = $self->{'_op_spec'}; |
208
|
|
|
|
|
|
|
|
209
|
1
|
|
|
|
|
4
|
return $self->_send_receive_msg($msg_ref); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head2 check($digest) |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Check the digest of a message to see if |
215
|
|
|
|
|
|
|
the pyzor server has a report for it. This function |
216
|
|
|
|
|
|
|
will throw if a messaging failure or timeout happens. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=over 2 |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item Input |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=over 3 |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item $digest C |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The message digest to check, as given by |
227
|
|
|
|
|
|
|
C. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=back |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item Output |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=over 3 |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item C |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Returns a hashref of the standard attributes noted above |
238
|
|
|
|
|
|
|
as well as the following: |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=over |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item * C - The number of reports the server has received |
243
|
|
|
|
|
|
|
for the given digest. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item * C - The number of whitelist requests the server has received |
246
|
|
|
|
|
|
|
for the given digest. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=back |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=back |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=back |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=cut |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub check { |
257
|
2
|
|
|
2
|
1
|
401
|
my ( $self, $digest ) = @_; |
258
|
|
|
|
|
|
|
|
259
|
2
|
|
|
|
|
7
|
return $self->_send_receive_msg( $self->_get_base_msg( 'check', $digest ) ); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# ---------------------------------------- |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub _send_receive_msg { |
265
|
2
|
|
|
2
|
|
5
|
my ( $self, $msg_ref ) = @_; |
266
|
|
|
|
|
|
|
|
267
|
2
|
50
|
|
|
|
5
|
my $thread_id = $msg_ref->{'Thread'} or die 'No thread ID?'; |
268
|
|
|
|
|
|
|
|
269
|
2
|
|
|
|
|
7
|
$self->_sign_msg($msg_ref); |
270
|
|
|
|
|
|
|
|
271
|
2
|
|
|
|
|
5
|
return $self->_do_send_receive( |
272
|
|
|
|
|
|
|
$self->_generate_packet_from_message($msg_ref) . "\n\n", |
273
|
|
|
|
|
|
|
$thread_id, |
274
|
|
|
|
|
|
|
); |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub _get_base_msg { |
278
|
5
|
|
|
5
|
|
56
|
my ( $self, $op, $digest ) = @_; |
279
|
|
|
|
|
|
|
|
280
|
5
|
100
|
|
|
|
21
|
die "Implementor error: op is required" if !$op; |
281
|
4
|
100
|
|
|
|
23
|
die "error: digest is required" if !$digest; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
return { |
284
|
2
|
|
|
|
|
16
|
'User' => $self->{'_username'}, |
285
|
|
|
|
|
|
|
'PV' => $PYZOR_PROTOCOL_VERSION, |
286
|
|
|
|
|
|
|
'Time' => time(), |
287
|
|
|
|
|
|
|
'Op' => $op, |
288
|
|
|
|
|
|
|
'Op-Digest' => $digest, |
289
|
|
|
|
|
|
|
'Thread' => $self->_generate_thread_id() |
290
|
|
|
|
|
|
|
}; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub _do_send_receive { |
294
|
2
|
|
|
2
|
|
5
|
my ( $self, $packet, $thread_id ) = @_; |
295
|
|
|
|
|
|
|
|
296
|
2
|
|
|
|
|
7
|
my $sock = $self->_get_connection_or_die(); |
297
|
|
|
|
|
|
|
|
298
|
2
|
|
|
|
|
2501
|
$self->_send_packet( $sock, $packet ); |
299
|
2
|
|
|
|
|
1843
|
my $response = $self->_receive_packet( $sock, $thread_id ); |
300
|
|
|
|
|
|
|
|
301
|
2
|
|
|
|
|
8
|
my $resp_hr = { map { ( split(m{: }) )[ 0, 1 ] } split( m{\n}, $response ) }; |
|
8
|
|
|
|
|
23
|
|
302
|
|
|
|
|
|
|
|
303
|
2
|
|
|
|
|
6
|
delete $resp_hr->{'Thread'}; |
304
|
|
|
|
|
|
|
|
305
|
2
|
|
|
|
|
4
|
my $response_pv = delete $resp_hr->{'PV'}; |
306
|
|
|
|
|
|
|
|
307
|
2
|
50
|
|
|
|
11
|
if ( $PYZOR_PROTOCOL_VERSION ne $response_pv ) { |
308
|
0
|
|
|
|
|
0
|
warn "Unexpected protocol version ($response_pv) in Pyzor response!"; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
2
|
|
|
|
|
40
|
return $resp_hr; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub _receive_packet { |
315
|
2
|
|
|
2
|
|
5
|
my ( $self, $sock, $thread_id ) = @_; |
316
|
|
|
|
|
|
|
|
317
|
2
|
|
|
|
|
8
|
my $timeout = $self->{'_timeout'} * 1000; |
318
|
|
|
|
|
|
|
|
319
|
2
|
|
|
|
|
5
|
my $end_time = time + $self->{'_timeout'}; |
320
|
|
|
|
|
|
|
|
321
|
2
|
|
|
|
|
26
|
$sock->blocking(0); |
322
|
2
|
|
|
|
|
5
|
my $response = ''; |
323
|
2
|
|
|
|
|
4
|
my $rout = ''; |
324
|
2
|
|
|
|
|
2
|
my $rin = ''; |
325
|
2
|
|
|
|
|
10
|
vec( $rin, fileno($sock), 1 ) = 1; |
326
|
|
|
|
|
|
|
|
327
|
2
|
|
|
|
|
4
|
while (1) { |
328
|
2
|
|
|
|
|
5
|
my $time_left = $end_time - time; |
329
|
|
|
|
|
|
|
|
330
|
2
|
50
|
|
|
|
6
|
if ( $time_left <= 0 ) { |
331
|
0
|
|
|
|
|
0
|
die Mail::Pyzor::X->create( 'Timeout', "Did not receive a response from the pyzor server $self->{'_server_host'}:$self->{'_server_port'} for $self->{'_timeout'} seconds!" ); |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
2
|
|
|
|
|
13
|
my $bytes = IO::SigGuard::sysread( $sock, $response, $READ_SIZE, length $response ); |
335
|
2
|
0
|
33
|
|
|
533
|
if ( !defined($bytes) && !$!{'EAGAIN'} && !$!{'EWOULDBLOCK'} ) { |
|
|
|
0
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
warn "read from socket: $!"; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
2
|
50
|
|
|
|
8
|
if ( index( $response, "\n\n" ) > -1 ) { |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# Reject the response unless its thread ID matches what we sent. |
342
|
|
|
|
|
|
|
# This prevents confusion among concurrent Pyzor reqeusts. |
343
|
2
|
50
|
|
|
|
9
|
if ( index( $response, "\nThread: $thread_id\n" ) != -1 ) { |
344
|
2
|
|
|
|
|
4
|
last; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
else { |
347
|
0
|
|
|
|
|
0
|
$response = ''; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
0
|
|
|
|
|
0
|
my $found = IO::SigGuard::select( $rout = $rin, undef, undef, $time_left ); |
352
|
0
|
0
|
|
|
|
0
|
warn "select(): $!" if $found == -1; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
2
|
|
|
|
|
6
|
return $response; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub _send_packet { |
359
|
0
|
|
|
0
|
|
0
|
my ( $self, $sock, $packet ) = @_; |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
0
|
$sock->blocking(1); |
362
|
0
|
0
|
|
|
|
0
|
IO::SigGuard::syswrite( $sock, $packet ) or warn "write to socket: $!"; |
363
|
|
|
|
|
|
|
|
364
|
0
|
|
|
|
|
0
|
return; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
sub _get_connection_or_die { |
368
|
1
|
|
|
1
|
|
358
|
my ($self) = @_; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# clear the socket if the PID changes |
371
|
1
|
50
|
33
|
|
|
10
|
if ( defined $self->{'_sock_pid'} && $self->{'_sock_pid'} != $$ ) { |
372
|
0
|
|
|
|
|
0
|
undef $self->{'_sock_pid'}; |
373
|
0
|
|
|
|
|
0
|
undef $self->{'_sock'}; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
1
|
|
33
|
|
|
6
|
$self->{'_sock_pid'} ||= $$; |
377
|
|
|
|
|
|
|
$self->{'_sock'} ||= IO::Socket::INET->new( |
378
|
|
|
|
|
|
|
'PeerHost' => $self->{'_server_host'}, |
379
|
1
|
50
|
33
|
|
|
12
|
'PeerPort' => $self->{'_server_port'}, |
380
|
|
|
|
|
|
|
'Proto' => 'udp' |
381
|
|
|
|
|
|
|
) or die "Cannot connect to $self->{'_server_host'}:$self->{'_server_port'}: $@ $!"; |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
return $self->{'_sock'}; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub _sign_msg { |
387
|
2
|
|
|
2
|
|
4
|
my ( $self, $msg_ref ) = @_; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
$msg_ref->{'Sig'} = lc Mail::Pyzor::SHA::sha1_hex( |
390
|
|
|
|
|
|
|
Mail::Pyzor::SHA::sha1( $self->_generate_packet_from_message($msg_ref) ) . # |
391
|
|
|
|
|
|
|
':' . # |
392
|
2
|
|
|
|
|
5
|
$msg_ref->{'Time'} . # |
393
|
|
|
|
|
|
|
':' . # |
394
|
|
|
|
|
|
|
$self->_get_user_pass_hash_key() # |
395
|
|
|
|
|
|
|
); |
396
|
|
|
|
|
|
|
|
397
|
2
|
|
|
|
|
4
|
return 1; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub _generate_packet_from_message { |
401
|
4
|
|
|
4
|
|
7
|
my ( $self, $msg_ref ) = @_; |
402
|
|
|
|
|
|
|
|
403
|
4
|
|
|
|
|
8
|
return join( "\n", map { "$_: $msg_ref->{$_}" } grep { length $msg_ref->{$_} } @hash_order ); |
|
28
|
|
|
|
|
67
|
|
|
32
|
|
|
|
|
59
|
|
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub _generate_thread_id { |
407
|
2
|
|
|
2
|
|
4
|
my $RAND_MAX = 2**16; |
408
|
2
|
|
|
|
|
4
|
my $val = 0; |
409
|
2
|
|
|
|
|
8
|
$val = int rand($RAND_MAX) while $val < 1024; |
410
|
2
|
|
|
|
|
12
|
return $val; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub _get_user_pass_hash_key { |
414
|
2
|
|
|
2
|
|
6
|
my ($self) = @_; |
415
|
|
|
|
|
|
|
|
416
|
2
|
|
|
|
|
8
|
return lc Mail::Pyzor::SHA::sha1_hex( $self->{'_username'} . ':' . $self->{'_password'} ); |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
1; |