view release on metacpan or  search on metacpan

lib/AnyEvent/SOCKS/Client.pm  view on Meta::CPAN

		}
	 });
}

sub auth{
	my( $self, $method ) = @_;
	my $that = $self->{chain}->[0] ;
	if( $method == AUTH_LOGIN and $that->{login} and $that->{password}){
		$self->{hd}->push_write( 
			pack('CC', 5, length $that->{login} ) . $that->{login} 
			. pack('C', length $that->{password}) . $that->{password} 
		);
		$self->{hd}->push_read( chunk => 2, sub{
			my $status = unpack('xC', $_[1]) ;
			if( $status == 0 ){
				$self->connect_cmd ;
				return ;
			}
			AE::log "error" => "Bad login or password";
		});
		return ;
	}
	AE::log "error" => "Auth method $method not implemented!";
}

sub connect_cmd{
	my( $self ) = @_ ; 
	my $next = $self->{chain}->[1] ;
	my( $host, $port ) = $next 
		? ( $next->{host}, $next->{port} )
		: ( $self->{dst_host}, $self->{dst_port} ) ;

	my ($cmd, $ip );
	if( $ip = parse_ipv4($host) ){
		AE::log "debug" => "Connect IPv4: $host";
		$cmd = pack('CCCCA4n', 5, CMD_CONNECT, 0, TYPE_IP4, $ip, $port);
	}
	elsif( $ip = parse_ipv6($host) ){
		AE::log "debug" => "Connect IPv6: $host";
		$cmd = pack('CCCCA16n', 5, CMD_CONNECT, 0, TYPE_IP6, $ip, $port);
	}
	else{
		AE::log "debug" => "Connect hostname: $host";
		$cmd = pack('CCCCCA*n', 5, CMD_CONNECT, 0, TYPE_FQDN , length $host, $host, $port);
	}

	$self->{hd}->push_write( $cmd );
	$self->{hd}->push_read( chunk => 4, sub{
		my( $status, $type ) = unpack( 'xCxC', $_[1] );
		unless( $status == 0 ){
			AE::log "error" => "Connect cmd rejected: status is $status" ;
			return ;
		}
		$self->connect_cmd_finalize( $type ); 
	});
}

sub connect_cmd_finalize{ 
	my( $self, $type ) = @_ ;

	AE::log "debug" => "Connect cmd done, bind atype is $type"; 

	if($type == TYPE_IP4){
		$self->{hd}->push_read( chunk => 6, sub{
			my( $host, $port) = unpack( "a4n", $_[1] );
			$self->socks_connect_done( format_ipv4( $host ), $port );
		}); 
	}
	elsif($type == TYPE_IP6){
		$self->{hd}->push_read( chunk => 18, sub{
			my( $host, $port) = unpack( "a16n", $_[1] );
			$self->socks_connect_done( format_ipv6( $host ) , $port );
		});
	}
	elsif($type == TYPE_FQDN){
		# read 1 byte (fqdn len)
		# then read fqdn and port
		$self->{hd}->push_read( chunk => 1, sub{
			my $fqdn_len = unpack( 'C', $_[1] ) ;
			$self->{hd}->push_read( chunk => $fqdn_len + 2 , sub{
				my $host = substr( $_[1], 0, $fqdn_len ) ;
				my $port = unpack('n', substr( $_[1], -2) );
				$self->socks_connect_done( $host, $port );
			});
		});
	}
	else{
		AE::log "error" => "Unknown atype $type";
	}
}

sub socks_connect_done{ 
	my( $self, $bind_host, $bind_port ) = @_; 

	my $that = shift @{ $self->{chain} }; # shift = move forward in chain
	AE::log "debug" => "Done with server socks$that->{v}://$that->{host}:$that->{port} , bound to $bind_host:$bind_port";

	if( @{ $self->{chain} } ){
		$self->handshake ;
		return ;
	}

	AE::log "debug" => "Giving up fh and returning to void...";
	my( $fh, $c_cb ) = ( $self->{hd}->fh, delete $self->{c_cb} );
	$self->DESTROY;
	$c_cb->( $fh );
}

sub DESTROY {
	my $self = shift ;
	AE::log "debug" => "Kitten saver called";
	undef $self->{_guard};
	$self->{hd}->destroy	if( $self->{hd} and not $self->{hd}->destroyed );
	$self->{c_cb}->()		if( $self->{c_cb} );
	undef %$self;
	bless $self, __PACKAGE__ . '::destroyed';
}


=head1 AUTHOR

Zlobus, C<< <zlobus at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-anyevent-socks-client at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-SOCKS-Client>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc AnyEvent::SOCKS::Client


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-SOCKS-Client>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/AnyEvent-SOCKS-Client>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/AnyEvent-SOCKS-Client>

=item * Search CPAN