view release on metacpan or  search on metacpan

SocksChain.pm  view on Meta::CPAN

	}
	$complete++ if !$n;
        return \$buf;
    } );
    $drop_connection++ unless $complete;

    @h = $socket->get_trailers;
    while (@h) {
	my($k, $v) = splice(@h, 0, 2);
	$response->push_header($k, $v);
    }

    # keep-alive support
    unless ($drop_connection) {
	if (my $conn_cache = $self->{ua}{conn_cache}) {
	    my %connection = map { (lc($_) => 1) }
		             split(/\s*,\s*/, ($response->header("Connection") || ""));
	    if (($peer_http_version eq "1.1" && !$connection{close}) ||
		$connection{"keep-alive"})
	    {
		$conn_cache->deposit("http", "$host:$port", $socket);
	    }
	}
    }

    $response;
}

sub _check_sock
{
    my($self, $req, $sock) = @_;
    my $check = $req->header("If-SSL-Cert-Subject");
    if (defined $check) {
	my $cert = $sock->get_peer_certificate ||
	    die "Missing SSL certificate";
	my $subject = $cert->subject_name;
	die "Bad SSL certificate subject: '$subject' !~ /$check/"
	    unless $subject =~ /$check/;
	$req->remove_header("If-SSL-Cert-Subject");  # don't pass it on
    }
}

sub _get_sock_info
{
    my $self = shift;
    #$self->SUPER::_get_sock_info(@_);
    my($res, $sock) = @_;
    $res->header("Client-SSL-Cipher" => $sock->get_cipher);
    my $cert = $sock->get_peer_certificate;
    if ($cert) {
	$res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
	$res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
    }
    $res->header("Client-SSL-Warning" => "Peer certificate not verified");
}


#-----------------------------------------------------------
package LWP::Protocol::https::SocksChain::Socket;
use Net::SC;
use IO::Socket::SSL;
use Net::HTTPS;
use vars qw( @ISA );
@ISA = (
		'LWP::Protocol::http::SocketMethods',
		'Net::HTTPS'
	   );

sub IO::Socket::SSL::SSL_HANDLE::READ { ${shift()}->read     (@_) }

sub new {
	my ( $self, %cfg ) = @_;

	my $host = $cfg{ PeerHost };
	my $port = $cfg{ PeerPort };

	#
	# client certificate support
	#
	if ( defined $ENV{HTTPS_KEY_FILE} and not exists $cfg{SSL_key_file} ) {
		$cfg{SSL_key_file} = $ENV{HTTPS_KEY_FILE};
	}

	if ( defined $ENV{HTTPS_CA_DIR} and not exists $cfg{SSL_ca_path} ) {
		$cfg{SSL_ca_path} = $ENV{HTTPS_CA_DIR}; 
	}

	if ( defined $ENV{HTTPS_CA_FILE} and not exists $cfg{SSL_ca_file} ) {
		$cfg{SSL_ca_file} = $ENV{HTTPS_CA_FILE};
	}

	if ( defined $ENV{HTTPS_CERT_FILE} and not exists $cfg{SSL_cert_file} ) {
		$cfg{SSL_cert_file} = $ENV{HTTPS_CERT_FILE};
	}

	if ( not exists $cfg{SSL_use_cert} and exists $cfg{SSL_cert_file} ) {
		$cfg{SSL_use_cert} = 1
	}

	my $sc = Net::SC->new( %cfg ) || die $!;
	
	unless ( ( my $rc = $sc->connect( $host, $port ) ) == SOCKS_OKAY ) {
		die socks_error($rc) . "\n";
	}

	my $obj = bless $sc->sh, $self;
	
	$obj->http_configure(\%cfg);

	if ( $IO::Socket::SSL::VERSION > 0.97 ) {
		$obj->configure_SSL( \%cfg ) && $obj->connect_SSL();
	} else {
		$obj->configure_SSL( \%cfg ) && $obj->connect_SSL($sc->sh);
	}
}

sub http_connect {
	return shift;
}

1;

__END__

=head1 NAME

LWP::Protocol::https::SocksChain - Speak HTTPs through Net::SC

=head1 SYNOPSIS

 use LWP::UserAgent;
 use LWP::Protocol::https::SocksChain;
 LWP::Protocol::implementor( https => 'LWP::Protocol::https::SocksChain' );

 @LWP::Protocol::https::SocksChain::EXTRA_SOCK_OPTS = ( Chain_Len    => 1,
                                                        Debug        => 0,
                                                        Random_Chain => 1,
                                                        Auto_Save    => 1,
                                                        Restore_Type => 1 );

 my $ua = LWP::UserAgent->new();

 my $req = HTTP::Request->new(
              GET => 'https://home.sinn.ru/~gosha/perl-scripts/');

 my $res = $ua->request($req) || die $!;

 if ($res->is_success) {
  ...
 } else {
  ...
 }


 or


 use LWP::UserAgent;
 use LWP::Protocol::https::SocksChain;
 LWP::Protocol::implementor( https => 'LWP::Protocol::https::SocksChain' );

 @LWP::Protocol::https::SocksChain::EXTRA_SOCK_OPTS = ( Chain_Len    => 1,
                                                        Debug        => 0,
                                                        Random_Chain => 1,
                                                        Chain_File_Data => [
                                                           '2x0.41.23.164:1080:::4:383 b/s Argentina',
                                                           '24.2x2.88.160:1080:::4:1155 b/s Argentina',
                                                        ],
                                                        Auto_Save    => 0,
                                                        Restore_Type => 0 );