File Coverage

blib/lib/LWP/UserAgent/Tor.pm

Criterion	Covered	Total	%
statement	35	89	39.3
branch	0	26	0.0
condition	0	14	0.0
subroutine	12	16	75.0
pod	2	2	100.0
total	49	147	33.3

package LWP::UserAgent::Tor;

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

use base 'LWP::UserAgent';

our $VERSION = '0.05';

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) = @_;

    # There must be a Tor binary in $PATH; it might be named "tor.real".
    my $tor = which 'tor';
    defined $tor or croak 'could not find tor binary in $PATH';
    my $tor_real = which 'tor.real';

    my $mm = File::MMagic->new;
    my $file_format = $mm->checktype_filename($tor);

    my $binary_format = 'application/octet-stream';

    if ($file_format eq $binary_format) {
        # tor is a binary; do nothing.
    }
    elsif ($file_format =~ m/sh script text$/ && defined $tor_real) {
        # tor is a shell script; it could be from a Tor Browser distribution.
        $file_format = $mm->checktype_filename($tor_real);
        if ($file_format eq $binary_format) {
            # tor.real is the corresponding Tor binary.
            $tor = $tor_real;
        }
        elsif ($file_format =~ m|^x-system/x-error; |) {
            $file_format =~ s|^x-system/x-error; ||;
            croak 'tor.real file format error detected: "' . $file_format . '"';
        }
        else {
            croak 'could not find matching tor binary for tor shell script';
        }
    }
    elsif ($file_format =~ m|^x-system/x-error; |) {
        $file_format =~ s|^x-system/x-error; ||;
        croak 'tor file format error detected: "' . $file_format . '"';
    }
    else {
        croak 'could not work with tor file format "' . $file_format . '"';
    }

    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. 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__