File Coverage

blib/lib/IO/Stream/Proxy/SOCKSv4.pm

Criterion	Covered	Total	%
statement	38	82	46.3
branch	0	20	0.0
condition	0	3	0.0
subroutine	13	18	72.2
pod	1	3	33.3
total	52	126	41.2

package IO::Stream::Proxy::SOCKSv4;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;

our $VERSION = 'v2.0.1';

use IO::Stream::const;
use IO::Stream::EV;
use Scalar::Util qw( weaken );

use constant VN => 0x04;    # SOCKS protocol version number (4)
use constant CD => 0x01;    # SOCKS protocol command code (CONNECT)
use constant REPLY_LEN=> 8; # SOCKS protocol reply length (bytes)
use constant REPLY_VN => 0; # SOCKS protocol reply code version
use constant REPLY_CD => 90;# SOCKS protocol reply code 'request granted'


sub new {
    my ($class, $opt) = @_;
    croak '{host}+{port} required'
        if !defined $opt->{host}
        || !defined $opt->{port}
        ;
    my $self = bless {
        host        => undef,
        port        => undef,
        userid      => q{},
        %{$opt},
        out_buf     => q{},                 # modified on: OUT
        out_pos     => undef,               # modified on: OUT
        out_bytes   => 0,                   # modified on: OUT
        in_buf      => q{},                 # modified on: IN
        in_bytes    => 0,                   # modified on: IN
        ip          => undef,               # modified on: RESOLVED
        is_eof      => undef,               # modified on: EOF
        _want_write => undef,
        }, $class;
    return $self;
}

sub PREPARE {
    my ($self, $fh, $host, $port) = @_;
    croak '{fh} already connected'
        if !defined $host;
    $self->{_slave}->PREPARE($fh, $self->{host}, $self->{port});
    IO::Stream::EV::resolve($host, $self, sub {
        my ($self, $ip) = @_;
        $self->{_master}{ip} = $ip;
        $self->{out_buf} = pack 'C C n CCCC Z*',
            VN, CD, $port, split(/[.]/xms, $ip), $self->{userid};
        $self->{_slave}->WRITE();
    });
    return;
}

sub WRITE {
    my ($self) = @_;
    $self->{_want_write} = 1;
    return;
}

sub EVENT {
    my ($self, $e, $err) = @_;
    my $m = $self->{_master};
    if ($err) {
        $m->EVENT(0, $err);
    }
    if ($e & IN) {
        if (length $self->{in_buf} < REPLY_LEN) {
            $m->EVENT(0, 'socks v4 proxy: protocol error');
        } else {
            my ($vn, $cd) = unpack 'CC', $self->{in_buf};
            substr $self->{in_buf}, 0, REPLY_LEN, q{};
            if ($vn != REPLY_VN) {
                $m->EVENT(0, 'socks v4 proxy: unknown version of reply code');
            }
            elsif ($cd != REPLY_CD) {
                $m->EVENT(0, 'socks v4 proxy: error '.$cd);
            }
            else {
                $e = CONNECTED;
                if (my $l = length $self->{in_buf}) {
                    $e |= IN;
                    $m->{in_buf}    .= $self->{in_buf};
                    $m->{in_bytes}  += $l;
                }
                $m->EVENT($e);
                $self->{_slave}->{_master} = $m;
                weaken($self->{_slave}->{_master});
                $m->{_slave} = $self->{_slave};
                if ($self->{_want_write}) {
                    $self->{_slave}->WRITE();
                }
            }
        }
    }
    if ($e & EOF) {
        $m->{is_eof} = $self->{is_eof};
        $m->EVENT(0, 'socks v4 proxy: unexpected EOF');
    }
    return;
}


1; # Magic true value required at end of module
__END__