line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::OpenVPN::Agent; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
27497
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
4
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
5
|
1
|
|
|
1
|
|
1884
|
use HTTP::Tiny; |
|
1
|
|
|
|
|
71960
|
|
|
1
|
|
|
|
|
41
|
|
6
|
1
|
|
|
1
|
|
982
|
use HTTP::CookieJar; |
|
1
|
|
|
|
|
34747
|
|
|
1
|
|
|
|
|
79
|
|
7
|
1
|
|
|
1
|
|
1199
|
use Net::OpenVPN::Launcher; |
|
1
|
|
|
|
|
407460
|
|
|
1
|
|
|
|
|
39
|
|
8
|
1
|
|
|
1
|
|
10
|
use sigtrap qw/die normal-signals/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
9
|
1
|
|
|
1
|
|
1509
|
use Log::Log4perl; |
|
1
|
|
|
|
|
79794
|
|
|
1
|
|
|
|
|
8
|
|
10
|
1
|
|
|
1
|
|
1138
|
use YAML::XS qw/LoadFile/; |
|
1
|
|
|
|
|
3455
|
|
|
1
|
|
|
|
|
2056
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = 0.01; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Net::OpenVPN::Agent - a resilient anonimizing user agent that provides IP and useragent masking, full logging capability using OpenVPN and log4perl. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 REQUIREMENTS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
An account with L<HideMyAss.com|http://hidemyass.com/vpn/r14824/> VPN service (affiliate link) is required. This module has been tested on Linux and *may* work on other UNIX-based OSes. OpenVPN must be installed. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use Net::OpenVPN::Agent; |
23
|
|
|
|
|
|
|
my $ua = Net::OpenVPN::Agent->new; |
24
|
|
|
|
|
|
|
my $html = $ua->get_page('http://google.com'); # connect to HMA VPN and request the page, decrement request count |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 METHODS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head2 new |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Returns a new Agent object. Requires a YAML config file called agent.conf in to be present in the root program directory. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Example agent.conf |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
--- |
35
|
|
|
|
|
|
|
USERNAME: sillymoose |
36
|
|
|
|
|
|
|
PASSWORD: itsasecret |
37
|
|
|
|
|
|
|
SERVER_REQUEST_LIMIT_MAX: 31 |
38
|
|
|
|
|
|
|
SERVER_REQUEST_LIMIT_MIN: 15 |
39
|
|
|
|
|
|
|
SERVER_REQUEST_CHECK_LIMIT: 5 |
40
|
|
|
|
|
|
|
RETRY_DELAY_SECS: 10 |
41
|
|
|
|
|
|
|
TIMEOUT_SECS: 5 |
42
|
|
|
|
|
|
|
COOKIES: |
43
|
|
|
|
|
|
|
- google.com: |
44
|
|
|
|
|
|
|
- PREF=ID=dd1e749e64f70eb6:U=99aeb3ab0a5582ce:FF=0:TM=1385654322:LM=1385654323:S=JNn9pYDiSZipdvLU |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
AGENTS: |
47
|
|
|
|
|
|
|
- Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.22 (KHTML, like Gecko) Chrome/25.0.1364.172 Safari/537.22 |
48
|
|
|
|
|
|
|
- Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0) |
49
|
|
|
|
|
|
|
- Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; Trident/6.0) |
50
|
|
|
|
|
|
|
- Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.2; Trident/6.0) |
51
|
|
|
|
|
|
|
- Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 5.1; Trident/5.0) |
52
|
|
|
|
|
|
|
- Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.22 (KHTML, like Gecko) Chrome/25.0.1364.172 Safari/537.22 |
53
|
|
|
|
|
|
|
- Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.15 (KHTML, like Gecko) Chrome/24.0.1295.0 Safari/537.15 |
54
|
|
|
|
|
|
|
- Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/125.2 (KHTML, like Gecko) Safari/125.8 |
55
|
|
|
|
|
|
|
- Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/537.22 (KHTML like Gecko) Safari/537.22 |
56
|
|
|
|
|
|
|
LOG_CONF: |
57
|
|
|
|
|
|
|
- log4perl.logger=DEBUG, Screen |
58
|
|
|
|
|
|
|
- log4perl.appender.Screen=Log::Dispatch::Screen |
59
|
|
|
|
|
|
|
- log4perl.appender.Screen.stderr=0 |
60
|
|
|
|
|
|
|
- log4perl.appender.Screen.Threshold=DEBUG |
61
|
|
|
|
|
|
|
- log4perl.appender.Screen.layout=Log::Log4perl::Layout::SimpleLayout |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=over 4 |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=item * |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
USERNAME/PASSWORD: these are your HMA credentials |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item * |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
SERVER_REQUEST_LIMIT_MIN / MAX: this is lower-upper limit from which to randomly calculate the maximum number of GET requests to be allowed per server. Once this limit is reached, the Agent.pm object will automatically connect to a new HMA VPN server, changing the IP address. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item * |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
SERVER_REQUEST_CHECK_LIMIT: this is the number of times Agent.pm will check your IP address after connecting to a new server. If after this limit Agent.pm was not able to get a new IP address, it will automatically disconnect and connect to a new HMA VPN server. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item * |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
RETRY_DELAY_SECS: the number of seconds Agent.pm will delay before retrying a failed request to validate a new server connection. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item * |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
COOKIES: any cookies you want Agent.pm to use. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item * |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
AGENTS: a list of useragent strings. Every time Agent.pm connects to a new server and obtains a new IP address, a new useragent string will be randomly selected from this list. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item * |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
LOG_CONF: a list of log4perl settings for the logging requests and results. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=back |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub new { |
99
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
100
|
|
|
|
|
|
|
|
101
|
0
|
0
|
|
|
|
|
my $config = -e 'agent.conf' |
102
|
|
|
|
|
|
|
? LoadFile('agent.conf') |
103
|
|
|
|
|
|
|
: undef; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# load log4perl settings |
106
|
0
|
|
|
|
|
|
my $log_conf = exists $config->{LOG_CONF} |
107
|
0
|
0
|
|
|
|
|
? join("\n", @{$config->{LOG_CONF}}) |
108
|
|
|
|
|
|
|
: "log4perl.logger.Net.OpenVPN.Agent=ERROR, Screen\n |
109
|
|
|
|
|
|
|
log4perl.appender.Screen=Log::Dispatch::Screen\n |
110
|
|
|
|
|
|
|
log4perl.appender.Screen.stderr=0\n |
111
|
|
|
|
|
|
|
log4perl.appender.Screen.Threshold=ERROR\n |
112
|
|
|
|
|
|
|
log4perl.appender.Screen.layout=Log::Log4perl::Layout::SimpleLayout"; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
Log::Log4perl->init(\$log_conf); |
115
|
0
|
|
|
|
|
|
my $log = Log::Log4perl->get_logger('Net::OpenVPN::Agent'); |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
|
$log->logdie('agent.conf not found') unless $config; |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
0
|
|
|
|
my $self = bless { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
120
|
|
|
|
|
|
|
USERNAME => $config->{USERNAME} || $log->logdie("USERNAME not found in agent.conf"), |
121
|
|
|
|
|
|
|
PASSWORD => $config->{PASSWORD} || $log->logdie("PASSWORD not found in agent.conf"), |
122
|
|
|
|
|
|
|
SERVER_REQUEST_LIMIT_MAX => $config->{SERVER_REQUEST_LIMIT_MAX} || 30, |
123
|
|
|
|
|
|
|
SERVER_REQUEST_LIMIT_MIN => $config->{SERVER_REQUEST_LIMIT_MIN} || 15, |
124
|
|
|
|
|
|
|
SERVER_REQUEST_CHECK_LIMIT => $config->{SERVER_REQUEST_CHECK_LIMIT} || 5, |
125
|
|
|
|
|
|
|
RETRY_DELAY_SECS => $config->{RETRY_DELAY_SECS} || 10, |
126
|
|
|
|
|
|
|
TIMEOUT_SECS => $config->{TIMEOUT_SECS} || 5, |
127
|
|
|
|
|
|
|
COOKIES => $config->{COOKIES} || {}, |
128
|
|
|
|
|
|
|
AGENTS => $config->{AGENTS} || ["Net::OpenVPN::Agent $VERSION"], |
129
|
|
|
|
|
|
|
log => $log, |
130
|
|
|
|
|
|
|
GET_REQUEST_LIMIT => $config->{GET_REQUEST_LIMIT} || 1, |
131
|
|
|
|
|
|
|
}, $class; |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
$self->{ua} = $self->_makeAgent; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
return $self; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 get_page |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Requires a URL an argument. Performs an HTTP get and returns the HTML page. Will initiate an HMA VPN connection using OpenVPN. Every call to get_page decrements the page request limit ($self->{request_limit}). When the request limit reaches zero this method will connect to another HMA server. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub get_page { |
145
|
0
|
|
|
0
|
1
|
|
my ( $self, $url ) = @_; |
146
|
0
|
0
|
|
|
|
|
$self->{log}->logdie("Missing mandatory argument url") unless $url; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Get home ip address first time called |
149
|
0
|
0
|
|
|
|
|
unless (exists $self->{home_ip} ) { |
150
|
0
|
|
|
|
|
|
$self->{log}->debug("setting ip address"); |
151
|
0
|
|
|
|
|
|
$self->{home_ip} = $self->get_ip_address; |
152
|
0
|
|
|
|
|
|
$self->{ip} = $self->{home_ip}; |
153
|
0
|
0
|
|
|
|
|
unless ($self->{ip}) { |
154
|
0
|
|
|
|
|
|
$self->{log}->logdie("Unable to get home ip address.") |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# Connect to another server unless request limit has not been reached |
159
|
0
|
0
|
|
|
|
|
unless ( $self->_decrement_request_limit ) { |
160
|
0
|
|
|
|
|
|
for (my $i = 0; $i < $self->{SERVER_REQUEST_CHECK_LIMIT}; $i++) { |
161
|
0
|
0
|
|
|
|
|
last if $self->_connect_to_random_server; |
162
|
0
|
0
|
|
|
|
|
if ($i == $self->{SERVER_REQUEST_CHECK_LIMIT}) { |
163
|
0
|
|
|
|
|
|
$self->{log}->logdie("Maximum server connection attempts reached."); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
0
|
|
|
|
|
|
$self->{ua} = $self->_makeAgent; |
167
|
|
|
|
|
|
|
} |
168
|
0
|
|
|
|
|
|
return $self->_get($url); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 get_ip_address |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Will return the current IP address or 0 if the ip lookup is not successful. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub get_ip_address { |
178
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
179
|
0
|
|
|
|
|
|
return $self->_get('http://geoip.hidemyass.com/ip/'); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head2 DESTROY |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Object destructor that cleans up any .conf files created by the UserAgent. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=cut |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub DESTROY { |
189
|
0
|
|
|
0
|
|
|
my $self = shift; |
190
|
0
|
0
|
0
|
|
|
|
unlink './user.conf' if ( -e './user.conf' and -w './user.conf' ); |
191
|
0
|
0
|
0
|
|
|
|
unlink './openvpn.conf' if ( -e './openvpn.conf' and -w './openvpn.conf' ); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 _makeAgent |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Internal Method. Returns a new useragent. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _makeAgent { |
203
|
0
|
|
|
0
|
|
|
my $self = shift; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
my $jar = HTTP::CookieJar->new; |
206
|
0
|
0
|
|
|
|
|
if (exists $self->{COOKIES}) { |
207
|
0
|
|
|
|
|
|
foreach my $url (keys $self->{COOKIES}) { |
208
|
0
|
|
|
|
|
|
foreach (@{$self->{COOKIES}->{$url}}) { |
|
0
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
$jar->add($url, $_); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
0
|
|
|
|
|
|
return HTTP::Tiny->new( |
214
|
|
|
|
|
|
|
cookie_jar => $jar, |
215
|
|
|
|
|
|
|
agent => $self->_get_ua_string, |
216
|
|
|
|
|
|
|
timeout => $self->{TIMEOUT_SECS}, |
217
|
|
|
|
|
|
|
); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 _get |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Internal method. Requires a URL as a an argument. Performs an HTTP get and returns the response hashref. Does not connect to a HMA server and does not decrement the page request limit count. Internally this method is used to check the Agent's current IP address. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub _get { |
227
|
0
|
|
|
0
|
|
|
my ( $self, $url ) = @_; |
228
|
0
|
0
|
|
|
|
|
$self->{log}->logdie("Missing mandatory argument url") unless $url; |
229
|
0
|
|
|
|
|
|
$self->{log}->debug("GET: $url"); |
230
|
0
|
|
|
|
|
|
my $response = $self->{ua}->get($url); |
231
|
0
|
|
|
|
|
|
my $requestLimit = $self->{GET_REQUEST_LIMIT}; |
232
|
0
|
|
|
|
|
|
while ($requestLimit > 0) { |
233
|
0
|
0
|
|
|
|
|
if ( $response->{success} ) { |
234
|
0
|
|
|
|
|
|
$self->{log}->debug("Request successful"); |
235
|
0
|
|
|
|
|
|
return $response->{content}; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
else { |
238
|
0
|
|
|
|
|
|
$self->{log}->error( |
239
|
|
|
|
|
|
|
"Request failed for $url. $response->{status}: $response->{reason}." |
240
|
|
|
|
|
|
|
); |
241
|
0
|
|
|
|
|
|
$requestLimit--; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
0
|
|
|
|
|
|
return 0; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head2 _connect_to_random_server |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
This internal method will invoke openvpn and connect to a new HMA server. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub _connect_to_random_server { |
254
|
0
|
|
|
0
|
|
|
my $self = shift; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# reload server list if empty |
257
|
0
|
0
|
0
|
|
|
|
unless (exists $self->{server_list} and @{$self->{server_list}}) { |
|
0
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$self->{server_list} = $self->_get_server_list; |
259
|
0
|
0
|
|
|
|
|
$self->{log}->logdie("Unable to get server list") unless $self->{server_list}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
# remove a randomly selected server from the list |
262
|
0
|
|
|
|
|
|
my $server = splice( @{$self->{server_list}}, int( rand($#{$self->{server_list}}) ), 1); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
263
|
0
|
|
|
|
|
|
my $config_filepath = $self->_make_config_file($server); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Start a launcher object if it doesnt exist |
266
|
0
|
0
|
|
|
|
|
if ($self->{vpn}) { |
267
|
0
|
|
|
|
|
|
$self->{vpn}->stop; |
268
|
0
|
|
|
|
|
|
$self->{log}->debug("Disconnecting from server."); |
269
|
0
|
|
|
|
|
|
sleep(30); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
else { |
272
|
0
|
|
|
|
|
|
$self->{vpn} = Net::OpenVPN::Launcher->new; |
273
|
|
|
|
|
|
|
} |
274
|
0
|
|
|
|
|
|
$self->{log}->debug("Connecting to $server->{ip}, $server->{name}, $server->{country_code}"); |
275
|
0
|
|
|
|
|
|
$self->{vpn}->start($config_filepath); |
276
|
0
|
|
|
|
|
|
my $current_ip = $self->{ip}; |
277
|
0
|
|
|
|
|
|
for (my $i = 0; $i < $self->{SERVER_REQUEST_CHECK_LIMIT}; $i++) { |
278
|
0
|
0
|
0
|
|
|
|
if ($self->{ip} ne '0' and $self->{ip} ne $current_ip and $self->{ip} ne $self->{home_ip}) { |
|
|
|
0
|
|
|
|
|
279
|
0
|
|
|
|
|
|
$self->{log}->debug("Ip address changed to $self->{ip} from $current_ip"); |
280
|
0
|
|
|
|
|
|
return 1; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
else { |
283
|
0
|
|
|
|
|
|
$self->{log}->warn("Ip address not changed, re-requesting ip"); |
284
|
0
|
|
|
|
|
|
sleep($self->{RETRY_DELAY_SECS}); |
285
|
0
|
|
|
|
|
|
$self->{ip} = $self->get_ip_address; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
0
|
|
|
|
|
|
$self->{log}->error("Unable to get ip address"); |
289
|
0
|
|
|
|
|
|
return 0; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head2 _get_ua_string |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Internal method. Returns a randomly selected UA string from an array of useragents. This can be provided in the agent.conf YAML file as AGENTS. If none are provided, will return a useragent string containing this module name and version. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub _get_ua_string { |
299
|
0
|
|
|
0
|
|
|
my $self = shift; |
300
|
0
|
|
|
|
|
|
return $self->{AGENTS}->[ int( rand($#{$self->{AGENTS}}) ) ]; |
|
0
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head2 _decrement_request_limit |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Internal method. Resets the current request limit to be a random number between the agent.conf variables SERVER_REQUEST_LIMIT_MIN and SERVER_REQUEST_LIMIT_MAXunless the request limit is greater than 1, in which case this method will decrement the count by 1. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=cut |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub _decrement_request_limit { |
310
|
0
|
|
|
0
|
|
|
my $self = shift; |
311
|
0
|
0
|
0
|
|
|
|
if ( exists $self->{request_limit} and $self->{request_limit} > 0 ) { |
312
|
0
|
|
|
|
|
|
$self->{request_limit}--; |
313
|
0
|
|
|
|
|
|
return 1; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else { |
316
|
0
|
|
|
|
|
|
$self->{log} |
317
|
|
|
|
|
|
|
->debug("Request limit is zero, resetting the request limit."); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# if min / max are not equal, set rand range, else fix |
320
|
0
|
|
|
|
|
|
my $diff = $self->{SERVER_REQUEST_LIMIT_MAX} - $self->{SERVER_REQUEST_LIMIT_MIN}; |
321
|
0
|
0
|
|
|
|
|
if ($diff) { |
322
|
0
|
|
|
|
|
|
$self->{request_limit} = $self->{SERVER_REQUEST_LIMIT_MIN} + int( rand($diff) ); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
else { |
325
|
0
|
|
|
|
|
|
$self->{request_limit} = $self->{SERVER_REQUEST_LIMIT_MAX}; |
326
|
|
|
|
|
|
|
} |
327
|
0
|
|
|
|
|
|
return 0; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head2 _get_hma_config |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Internal method. Gets the HMA OpenVPN config file. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=cut |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _get_hma_config { |
338
|
0
|
|
|
0
|
|
|
my $self = shift; |
339
|
0
|
|
|
|
|
|
return $self->_get( |
340
|
|
|
|
|
|
|
'http://securenetconnection.com/vpnconfig/openvpn-template.ovpn'); |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=head2 _get_server_list |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
Internal method. Gets the current HMA server list. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=cut |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub _get_server_list { |
350
|
0
|
|
|
0
|
|
|
my $self = shift; |
351
|
0
|
|
|
|
|
|
my $response = |
352
|
|
|
|
|
|
|
$self->_get('http://securenetconnection.com/vpnconfig/servers-cli.php'); |
353
|
0
|
0
|
|
|
|
|
if ($response) { |
354
|
0
|
|
|
|
|
|
my $server_list_arrayhash; |
355
|
0
|
|
|
|
|
|
for my $server ( split qr/\n/, $response) { |
356
|
0
|
|
|
|
|
|
my @server_data = split qr/\|/, $server; |
357
|
0
|
|
|
|
|
|
push @{$server_list_arrayhash}, |
|
0
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
{ |
359
|
|
|
|
|
|
|
'ip' => $server_data[0], |
360
|
|
|
|
|
|
|
'name' => $server_data[1], |
361
|
|
|
|
|
|
|
'country_code' => $server_data[2], |
362
|
|
|
|
|
|
|
'tcp_flag' => $server_data[3], |
363
|
|
|
|
|
|
|
'udp_flag' => $server_data[4], |
364
|
|
|
|
|
|
|
'norandom_flag' => $server_data[5], |
365
|
|
|
|
|
|
|
}; |
366
|
|
|
|
|
|
|
} |
367
|
0
|
|
|
|
|
|
return $server_list_arrayhash; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
else { |
370
|
0
|
|
|
|
|
|
$self->{log}->logdie( |
371
|
|
|
|
|
|
|
"Failed to retrieve server list via get_server_list. Last known ip: $self->{ip}" |
372
|
|
|
|
|
|
|
); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head2 _make_config_file |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Internal method. Accepts a server_hashref and creates a config file, returning the filepath. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=cut |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub _make_config_file { |
383
|
0
|
|
|
0
|
|
|
my ( $self, $server_hashref ) = @_; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# get config unless it exists already |
386
|
0
|
0
|
|
|
|
|
$self->{config} = $self->_get_hma_config unless $self->{config}; |
387
|
0
|
0
|
|
|
|
|
$self->{log}->logdie("Unable to get HMA config") unless $self->{config}; |
388
|
0
|
|
|
|
|
|
my $config_string = $self->{config}; |
389
|
0
|
0
|
|
|
|
|
my ( $proto, $port ) = |
390
|
|
|
|
|
|
|
defined $server_hashref->{udp_flag} ? qw/udp 53/ : qw/tcp 443/; |
391
|
0
|
|
|
|
|
|
$config_string .= |
392
|
|
|
|
|
|
|
"\nremote $server_hashref->{ip} $port\nproto $proto\nauth-nocache"; |
393
|
0
|
|
|
|
|
|
$config_string =~ s/\ndev tun\n/\ndev tun0\n/; |
394
|
0
|
|
|
|
|
|
$config_string =~ s/\ntun-mtu-extra 32//; |
395
|
0
|
|
|
|
|
|
$config_string =~ s/\nauth-user-pass/\nauth-user-pass user.conf/; |
396
|
0
|
|
|
|
|
|
$config_string .= "\nlog /dev/null"; |
397
|
0
|
0
|
|
|
|
|
open( my $configfile, '>', './openvpn.conf' ) |
398
|
|
|
|
|
|
|
or $self->{log}->logdie("Error unable to open FH to openvpn.conf $!"); |
399
|
0
|
|
|
|
|
|
print $configfile $config_string; |
400
|
0
|
0
|
|
|
|
|
open( my $userfile, '>', './user.conf' ) |
401
|
|
|
|
|
|
|
or $self->{log}->logdie("Error unable to open FH to user.conf $!"); |
402
|
0
|
|
|
|
|
|
print $userfile $self->{USERNAME} . "\n" . $self->{PASSWORD}; |
403
|
0
|
|
|
|
|
|
return './openvpn.conf'; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=head1 AUTHOR |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
David Farrell, C<< <sillymoos at cpan.org> >> L<http://perltricks.com> |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head1 BUGS |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-Net-OpenVPN-Agent at rt.cpan.org>, or through |
413
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-OpenVPN-Agent>. I will be notified, and then you'll |
414
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 SUPPORT |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
perldoc Net::OpenVPN::Agent |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
You can also look for information at: |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=over 4 |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-OpenVPN-Agent> |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Net-OpenVPN-Agent> |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item * CPAN Ratings |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Net-OpenVPN-Agent> |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=item * Search CPAN |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Net-OpenVPN-Agent/> |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=back |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
Copyright 2013 David Farrell. |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
450
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
451
|
|
|
|
|
|
|
copy of the full license at: |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
L<http://www.perlfoundation.org/artistic_license_2_0> |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
456
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
457
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
458
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
461
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
462
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
465
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
468
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
469
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
470
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
471
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
472
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
473
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
474
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
477
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
478
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
479
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
480
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
481
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
482
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
483
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=cut |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
1; |
488
|
|
|
|
|
|
|
__END__ |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=head2 get_servers_by_country_code |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
Returns an arrayhash of HMA servers with a matching location. If no arguments are passed to this method, it will return the entire arrayhash of available servers. |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=cut |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub get_servers_by_country_code { |
498
|
|
|
|
|
|
|
my ($self, $country_code) = @_; |
499
|
|
|
|
|
|
|
my $server_list_arrayhash; |
500
|
|
|
|
|
|
|
if ($country_code){ |
501
|
|
|
|
|
|
|
push @{$server_list_arrayhash}, grep { |
502
|
|
|
|
|
|
|
$_->{country_code} =~ m/$country_code/i} @{$self->hma_server_list}; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
else { |
505
|
|
|
|
|
|
|
push @{$server_list_arrayhash}, $self->hma_server_list; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
return $server_list_arrayhash; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=head2 get_servers_by_name |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
Returns an arrayhash of HMA severs with a matching name. If no arguments are passed to this method, it will return the entire arrayhash of available servers. |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=cut |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
sub get_servers_by_name { |
517
|
|
|
|
|
|
|
my ($self, $name) = @_; |
518
|
|
|
|
|
|
|
my $server_list_arrayhash; |
519
|
|
|
|
|
|
|
if ($name){ |
520
|
|
|
|
|
|
|
push @{$server_list_arrayhash}, grep { |
521
|
|
|
|
|
|
|
$_->{name} =~ m/$name/i} @{$self->hma_server_list}; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
else { |
524
|
|
|
|
|
|
|
push @{$server_list_arrayhash}, $self->hma_server_list; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
return $server_list_arrayhash; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|