############################################################################
# Net::Inspect::L5::Socks
# handle Socks encapsulation (only Socks4 connect currently)
# TODO: bind, Socks5
############################################################################
use warnings;
use strict;
package Net::Inspect::L5::Socks;
use base 'Net::Inspect::Connection';
use fields qw(replay sockshdr meta fwd error);
use Net::Inspect::Debug;
use Socket 'inet_ntoa';
sub guess_protocol {
my ($self,$guess,$dir,$data,$eof,$time,$meta) = @_;
if ($data ne '') {
# keep all calls for replaying later
my $replay = $self->{replay} ||=[];
push @$replay,[$dir,$data,$eof,$time];
if ( $dir == 1 ) { # socks reply?
my $buf0 = my $buf1 = '';
for(@$replay) {
if ($_->[0]) {
$buf1 .= $_->[1]
} else {
$buf0 .= $_->[1]
}
}
goto not_me if length($buf0)<9; # too small for socks4 header
my ($ver,$conn,$port,$ip) = unpack('CCna4',$buf0);
goto not_me if $ver != 4; # not socks4
goto not_me if ! $conn; # do only connect not bind for now
return if length($buf1)<8; # not enough bytes for response
($ver,my $status,$port,$ip) = unpack('CCna4',$buf1);
goto not_me if $ver != 0; # no socks4 reply
# FIXME - what should we do if status not success?
goto not_me if $status != 90;
# looks like socks4
my $obj = $self->new_connection($meta) or goto not_me;
$obj->in(@$_) for(@$replay);
return ($obj,length($data));
not_me:
$guess->detach($self);
return;
}
}
return;
}
sub in {
my ($self,$dir,$data,$eof,$time) = @_;
return length($data) if $self->{error};
my $bytes = 0;
if ( ! $self->{fwd} ) {
# strip socks header
if ( $dir == 0 ) {
if ( ! $self->{sockshdr} ) {
goto need_more if length($data)<9; # incomplete socks4 header
my ($ver,$conn,$port,$ip) =
unpack('CCna4',substr($data,0,8,''));
return $self->fatal("only version 4 supported, version=$ver")
if $ver != 4;
return $self->fatal("only connect supported") if ! $conn;
# strip username\0
my $null = index($data,"\0");
if ( $null<0 ) {
# username not finished
return $self->fatal("username too long") if length($data)>512;
goto need_more;
}
my $user = substr($data,0,$null+1,'');
$bytes += 8 + $null + 1;
$self->{sockshdr} = {
daddr => inet_ntoa($ip),
dport => $port,
socks_user => $user,
replay0 => [],
};
return $bytes if $data eq ''; # done
}
# no object yet, e.g. no socks response: buffer data
push @{ $self->{sockshdr}{replay0}}, [ $data,$eof,$time ];
$bytes += length($data);
return $bytes;
} elsif ( $self->{sockshdr} ) {
# socks reply
goto need_more if length($data)<8; # incomplete
my ($ver,$status,$port,$ip) = unpack('CCna4',substr($data,0,8,''));
$ver == 0 or return $self->fatal("invalid version $ver in socks4 reply");
my $r0 = delete $self->{sockshdr}{replay0};
if ( $status == 90 ) {
# successful connect
$self->{fwd} = $self->{upper_flow}->new_connection({
%{$self->{meta}},
%{$self->{sockshdr}},
});
$self->{fwd} ||= Net::Inspect::L5::Socks::IgnoreConnection->new;
} else {
$self->{fwd} = Net::Inspect::L5::Socks::NoData->new;
}
$self->{fwd}->in(0,@$_) for(@$r0);
$bytes += 8;
return $bytes if $data eq '';
} else {
$self->fatal("data from server w/o sockshdr from client");
}
}
# got socks header from both sides, just forward to upper layer
return $bytes + $self->{fwd}->in($dir,$data,$eof,$time);
need_more:
$self->fatal("eof inside socks hdr($dir)") if $eof;
return;
}
sub new_connection {
my ($self,$meta) = @_;
my $obj = $self->new;
$obj->{meta} = $meta;
return $obj;
}
sub fatal {
my ($self,$reason,$dir,$time) = @_;
$self->{error} = 1;
my $obj = $self->{fwd};
return $obj->fatal($reason,$dir,$time) if $obj;
trace($reason);
return;
}
sub expire {
my ($self,$time) = @_;
if ( my $obj = $self->{fwd} ) {
return $obj->expire($time)
}
return $self->SUPER::expire($time);
}
package Net::Inspect::L5::Socks::IgnoreConnection;
{
my $singleton;
sub new { return $singleton ||= bless {},shift }
sub in {
my ($self,$dir,$data) = @_;
return length($data);
}
}
package Net::Inspect::L5::Socks::NoDataConnection;
use base 'Net::Inspect::L5::Socks';
{
my $singleton;
sub new { return $singleton ||= bless {},shift }
sub in {
my ($self,$dir,$data) = @_;
return $self->fatal("unexpected data in connection with socks error")
if $data ne '';
}
}
1;
__END__
=head1 NAME
Net::Inspect::L5::Socks - handles empty connections
=head1 SYNOPSIS
my $guess = Net::Inspect::L5::GuessProtocol->new;
my $null = Net::Inspect::L5::Socks->new;
$guess->attach($null);
=head1 DESCRIPTION
This class is usually used together with Net::Inspect::L5::GuessProtocol to
detect and ignore empty connections. It provides a C<guess_protocol> method
which returns a new object if the connection is closed and no data were
transferred.