I've written a patch for LWP::UserAgent and LWP::Protocol::http, so that
outgoing sockets can be explicitly bound to an ip-adress.
New method local_addr:
$ua->local_addr([$address])
Get/set the local ip-address of requests. If set, outgoing sockets
will be explicitly bound to this address.
Example:
my $UA = LWP::UserAgent->new;
$UA->local_addr ('10.1.1.2');
$response = $UA->simple_request(...);
The address can be a hostname or an IP-address on the "xx.xx.xx.xx" form,
it is passed to IO::Socket::INET->new.
I include the two changes files and the diffs. Changes are done in
libwww-perl-5.48.
Peter
Diffs for LWP/UserAgent.pm:
===========================
*** UserAgent.pm Tue Sep 5 14:00:47 2000
--- UserAgent.pm-orig Sun Apr 9 21:05:51 2000
***************
*** 133,135 ****
'no_proxy' => [],
- 'local_addr' => undef,
}, $class;
--- 133,134 ----
***************
*** 194,198 ****
my ($agent, $from, $timeout, $cookie_jar,
! $use_eval, $parse_head, $max_size, $local_addr) =
@{$self}{qw(agent from timeout cookie_jar
! use_eval parse_head max_size local_addr)};
--- 193,197 ----
my ($agent, $from, $timeout, $cookie_jar,
! $use_eval, $parse_head, $max_size) =
@{$self}{qw(agent from timeout cookie_jar
! use_eval parse_head max_size)};
***************
*** 213,215 ****
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout,
$local_addr);
};
--- 212,214 ----
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout);
};
***************
*** 223,225 ****
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout, $local_addr);
# XXX: Should we die unless $response->is_success ???
--- 222,224 ----
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout);
# XXX: Should we die unless $response->is_success ???
***************
*** 466,472 ****
- =item $ua->local_addr([$address])
-
- Get/set the local ip-address of requests. If set, outgoing sockets will
- be explicitly bound to this address.
-
=cut
--- 465,466 ----
***************
*** 479,481 ****
sub max_size { shift->_elem('max_size', @_); }
- sub local_addr { shift->_elem('local_addr',@_); }
--- 473,474 ----
Diffs for LWP/Protocol/http.pm
==============================
*** http.pm Tue Sep 5 14:12:20 2000
--- http.pm-orig Sun Apr 9 21:06:46 2000
***************
*** 24,33 ****
{
! my($self, $host, $port, $timeout, $local_addr) = @_;
local($^W) = 0; # IO::Socket::INET can be noisy
! my $sock = IO::Socket::INET->new(PeerAddr => $host,
! PeerPort => $port,
! LocalAddr => $local_addr,
! Proto => 'tcp',
! Timeout => $timeout,
$self->_extra_sock_opts($host, $port),
--- 24,32 ----
{
! my($self, $host, $port, $timeout) = @_;
local($^W) = 0; # IO::Socket::INET can be noisy
! my $sock = IO::Socket::INET->new(PeerAddr => $host,
! PeerPort => $port,
! Proto => 'tcp',
! Timeout => $timeout,
$self->_extra_sock_opts($host, $port),
***************
*** 84,86 ****
{
! my($self, $request, $proxy, $arg, $size, $timeout, $local_addr) = @_;
LWP::Debug::trace('()');
--- 83,85 ----
{
! my($self, $request, $proxy, $arg, $size, $timeout) = @_;
LWP::Debug::trace('()');
***************
*** 117,119 ****
# connect to remote site
! my $socket = $self->_new_socket($host, $port, $timeout, $local_addr);
$self->_check_sock($request, $socket);
--- 116,118 ----
# connect to remote site
! my $socket = $self->_new_socket($host, $port, $timeout);
$self->_check_sock($request, $socket);
UserAgent.pm
http.pm
