File Coverage

blib/lib/Net/OpenVPN/Agent.pm
Criterion Covered Total %
statement 24 140 17.1
branch 0 52 0.0
condition 0 40 0.0
subroutine 8 20 40.0
pod 3 3 100.0
total 35 255 13.7


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