more flexible proxy setup for LWP::UserAgent

Anthony Foiani (afoiani@uswest.com)
Tue, 16 Sep 1997 13:18:00 -0600 

--DWyAlgd3Ra
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


In the midst of writing a statistics-gathering spider suite, I found
myself faced with a very ugly proxying situation.  Here's the solution
I came up with; searching the archive, I found at least one other
person who could probably benefit from this.

Hopefully someone else will find it useful.  I'm still quite new to
Perl OOP ("POOP"?), and any feedback on the quality of the code would
also be appreciated.

Thanks,
Tony

p.s. Please note that the sample proxy subroutine (in the POD for this
     package) is untested; I'm not comfortable publishing the proxy
     configuration for my employer, and the concept is straightforward.
-- 
Anthony Foiani, Contractor
   voice (303) 685-2625   fax (303) 624-8462
   email <afoiani@uswest.com>
   these are my own opinions.


--DWyAlgd3Ra
Content-Type: text/plain
Content-Description: SmartProxyUA.pm
Content-Disposition: inline;
	filename="SmartProxyUA.pm"
Content-Transfer-Encoding: 7bit

#!/usr/local/bin/perl5 -w

# -------------------------- SmartProxyUA ----------------------------

package LWP::SmartProxyUA;

=head1 NAME

LWP::SmartProxyUA -- Flexible Proxying for LWP::UserAgent;

=head1 SYNOPSIS

  require LWP::SmartProxyUA;
  $ua = new LWP::SmartProxyUA;
  $ua->set_proxy_function(\&my_proxy_func)

  # ... various calls to LWP::UserAgent here...

  sub my_proxy_func {
    my ($ua, $url) = @_;

    $url = new URI::URL($url) unless ref($url);
    my ($host, $domain) = split /\./, $url->host(), 2;

    return undef unless ($domain);

    # all hosts in "my_domain.com" are considered local, except for
    # those in the "external.my_domain.com" domain.
    if ($domain =~ /my_domain\.com$/ and
	$domain !~ /external\.my_domain\.com$/) {
      return undef;
    }
    return new URI::URL("http://proxy.my_domain.com");
  }

=head1 DESCRIPTION

SmartProxyUA is a simple subclass of LWP::UserAgent; it overrides a
private method in that class, allowing the user to get more direct
control over determining whether a URL needs to be sent through a
proxy.

The original motivation was to translate "Automatic Proxy
Configuration" functions from JavaScript to Perl; this seemed a
relatively clean way to do it.

=head1 METHODS

There is only one new function added by this subclass:

=cut

require LWP::UserAgent;

@ISA = qw(LWP::UserAgent);

sub new
{
  my $class = shift;
  my $self = SUPER::new $class;

  $self->{smart_proxy_func} = undef;

  return $self;
}

=head2 $ua->set_proxy_function(\&proxy_func)

If you have a complicated proxy determination script (or at least an
ugly one, courtesy of the the Netscape autoproxy scripts), you can use
this function to install a callback to determine what proxy to use.

The subroutine pointed at by C<proxy_func> should expect two
arguments; the first is a UserAgent object (normally this object), and
the second is the URL to be examined.  If the passed URL is local,
C<proxy_func> should return C<undef>; if a proxy is required, the
proxy URL should be returned.

To remove the smart proxy function, just pass C<undef> to this function.

=cut

sub set_proxy_function
{
  my $self = shift;
  my $sub_ref = shift;

  $self->{smart_proxy_func} = $sub_ref;
}

sub _need_proxy
{
  my ($self, $url) = @_;

  if ($self->{smart_proxy_func}) {
    return &{$self->{smart_proxy_func}}($self, $url);
  } else {
    return $self->SUPER::_need_proxy($url);
  }
}

=head1 AUTHOR

Anthony Foiani <tkil@scrye.com>

=head2 Copyright

Copyright (c) 1997 by Anthony Foiani <tkil@scrye.com>

This code is distributable under the same terms as Perl itself.

=cut

--DWyAlgd3Ra
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit



--DWyAlgd3Ra--