File Coverage

blib/lib/LWP/UserAgent/Tor.pm

Criterion	Covered	Total	%
statement	29	67	43.2
branch	0	14	0.0
condition	0	11	0.0
subroutine	10	14	71.4
pod	2	2	100.0
total	41	108	37.9

package LWP::UserAgent::Tor;

use 5.010;
use strict;
use warnings;
use Carp;
use LWP::UserAgent;
use IO::Socket::INET;
use LWP::Protocol::socks;
use Net::EmptyPort qw(empty_port);
use Proc::Background;

use base 'LWP::UserAgent';

our $VERSION = '0.04';

sub new {
    my ($class, %args) = @_;

    my $tor_control_port = delete( $args{tor_control_port} ) // empty_port();
    my $tor_port         = delete( $args{tor_port} )         // do {
        my $port;
        while (($port = empty_port()) == $tor_control_port){};
        $port;
    };
    my $tor_ip   = delete( $args{tor_ip}  ) // 'localhost';
    my $tor_cfg  = delete( $args{tor_cfg} );

    my $self = $class->SUPER::new(%args);
    $self->{_tor_proc}    = _start_tor_proc($tor_ip, $tor_port, $tor_control_port, $tor_cfg);
    $self->{_tor_socket} = IO::Socket::INET->new(
        PeerAddr => $tor_ip,
        PeerPort => $tor_control_port,
    ) // croak 'could not connect to tor';

    $self->proxy( [ 'http', 'https' ], "socks://$tor_ip:$tor_port" );

    return bless $self, $class;
}

sub DESTROY {
    my ($self) = @_;

    my $tor_proc = $self->{_tor_proc};
    $tor_proc->die if defined $tor_proc;
    $self->SUPER::DESTROY if $self->can('SUPER::DESTROY');

    return;
}

sub _start_tor_proc {
    my ($ip, $port, $control_port, $cfg) = @_;

    my $tor_cmd = "tor --ControlListenaddress $ip:$control_port --ControlPort auto --SocksPort $port --quiet";
    if (defined $cfg){
        croak 'tor config file does not exist' unless -e $cfg;
        $tor_cmd .= " -f $cfg";
    }

    my $tor_proc = Proc::Background->new($tor_cmd);

    # starting tor...
    sleep 1;

    if (!$tor_proc->alive) {
        croak "error running tor (probably not installed?). Run tor manually to get a hint.";
    }

    return $tor_proc;
}


sub rotate_ip {
    my ($self) = @_;

    my $socket = $self->{_tor_socket};
    my $answer = q{};

    $socket->send("AUTHENTICATE\n");
    $socket->recv($answer, 1024);
    return 0 unless $answer eq "250 OK\r\n";

    $socket->send("SIGNAL NEWNYM\n");
    $socket->recv($answer, 1024);
    return 0 unless $answer eq "250 OK\r\n";

    return 1;
}

1;

__END__