view release on metacpan or  search on metacpan

local/lib/perl5/LWP/UserAgent.pm  view on Meta::CPAN

}


sub _need_proxy {
    my($req, $ua) = @_;
    return if exists $req->{proxy};
    my $proxy = $ua->{proxy}{$req->uri->scheme} || return;
    if ($ua->{no_proxy}) {
        if (my $host = eval { $req->uri->host }) {
            for my $domain (@{$ua->{no_proxy}}) {
                if ($host =~ /(?:^|\.)\Q$domain\E$/) {
                    return;
                }
            }
        }
    }
    $req->{proxy} = $HTTP::URI_CLASS->new($proxy);
}


sub proxy {
    my $self = shift;
    my $key  = shift;
    if (!@_ && ref $key eq 'ARRAY') {
        die 'odd number of items in proxy arrayref!' unless @{$key} % 2 == 0;

        # This map reads the elements of $key 2 at a time
        return
            map { $self->proxy($key->[2 * $_], $key->[2 * $_ + 1]) }
            (0 .. @{$key} / 2 - 1);
    }
    return map { $self->proxy($_, @_) } @$key if ref $key;

    Carp::croak("'$key' is not a valid URI scheme") unless $key =~ /^$URI::scheme_re\z/;
    my $old = $self->{'proxy'}{$key};
    if (@_) {
        my $url = shift;
        if (defined($url) && length($url)) {
            Carp::croak("Proxy must be specified as absolute URI; '$url' is not") unless $url =~ /^$URI::scheme_re:/;
            Carp::croak("Bad http proxy specification '$url'") if $url =~ /^https?:/ && $url !~ m,^https?://[\w[],;
        }
        $self->{proxy}{$key} = $url;
        $self->set_my_handler("request_preprepare", \&_need_proxy)
    }
    return $old;
}


sub env_proxy {
    my ($self) = @_;
    require Encode;
    require Encode::Locale;
    my $env_request_method= $ENV{REQUEST_METHOD};
    my %seen;
    foreach my $k (sort keys %ENV) {
        my $real_key= $k;
        my $v= $ENV{$k}
            or next;
        if ( $env_request_method ) {
            # Need to be careful when called in the CGI environment, as
            # the HTTP_PROXY variable is under control of that other guy.
            next if $k =~ /^HTTP_/;
            $k = "HTTP_PROXY" if $k eq "CGI_HTTP_PROXY";
        }
	$k = lc($k);
        if (my $from_key= $seen{$k}) {
            warn "Environment contains multiple differing definitions for '$k'.\n".
                 "Using value from '$from_key' ($ENV{$from_key}) and ignoring '$real_key' ($v)"
                if $v ne $ENV{$from_key};
            next;
        } else {
            $seen{$k}= $real_key;
        }

	next unless $k =~ /^(.*)_proxy$/;
	$k = $1;
	if ($k eq 'no') {
	    $self->no_proxy(split(/\s*,\s*/, $v));
	}
	else {
            # Ignore random _proxy variables, allow only valid schemes
            next unless $k =~ /^$URI::scheme_re\z/;
            # Ignore xxx_proxy variables if xxx isn't a supported protocol
            next unless LWP::Protocol::implementor($k);
	    $self->proxy($k, Encode::decode(locale => $v));
	}
    }
}


sub no_proxy {
    my($self, @no) = @_;
    if (@no) {
	push(@{ $self->{'no_proxy'} }, @no);
    }
    else {
	$self->{'no_proxy'} = [];
    }
}


sub _new_response {
    my($request, $code, $message, $content) = @_;
    $message ||= HTTP::Status::status_message($code);
    my $response = HTTP::Response->new($code, $message);
    $response->request($request);
    $response->header("Client-Date" => HTTP::Date::time2str(time));
    $response->header("Client-Warning" => "Internal response");
    $response->header("Content-Type" => "text/plain");
    $response->content($content || "$code $message\n");
    return $response;
}


1;

__END__

=pod

=head1 NAME

LWP::UserAgent - Web user agent class

local/lib/perl5/LWP/UserAgent.pm  view on Meta::CPAN

The path to a file containing Certificate Authority certificates.
A default setting for this option is provided by checking the environment
variables C<PERL_LWP_SSL_CA_FILE> and C<HTTPS_CA_FILE> in order.

=item C<SSL_ca_path> => $path

The path to a directory containing files containing Certificate Authority
certificates.
A default setting for this option is provided by checking the environment
variables C<PERL_LWP_SSL_CA_PATH> and C<HTTPS_CA_DIR> in order.

=back

Other options can be set and are processed directly by the SSL Socket implementation
in use.  See L<IO::Socket::SSL> or L<Net::SSL> for details.

The libwww-perl core no longer bundles protocol plugins for SSL.  You will need
to install L<LWP::Protocol::https> separately to enable support for processing
https-URLs.

=head2 timeout

    my $secs = $ua->timeout;
    $ua->timeout( $secs );

Get/set the timeout value in seconds. The default value is
180 seconds, i.e. 3 minutes.

The request is aborted if no activity on the connection to the server
is observed for C<timeout> seconds.  This means that the time it takes
for the complete transaction and the L<LWP::UserAgent/request> method to
actually return might be longer.

When a request times out, a response object is still returned.  The response
will have a standard HTTP Status Code (500).  This response will have the
"Client-Warning" header set to the value of "Internal response".  See the
L<LWP::UserAgent/get> method description below for further details.

=head1 PROXY ATTRIBUTES

The following methods set up when requests should be passed via a
proxy server.

=head2 env_proxy

    $ua->env_proxy;

Load proxy settings from C<*_proxy> environment variables.  You might
specify proxies like this (sh-syntax):

  gopher_proxy=http://proxy.my.place/
  wais_proxy=http://proxy.my.place/
  no_proxy="localhost,example.com"
  export gopher_proxy wais_proxy no_proxy

csh or tcsh users should use the C<setenv> command to define these
environment variables.

On systems with case insensitive environment variables there exists a
name clash between the CGI environment variables and the C<HTTP_PROXY>
environment variable normally picked up by C<env_proxy>.  Because of
this C<HTTP_PROXY> is not honored for CGI scripts.  The
C<CGI_HTTP_PROXY> environment variable can be used instead.

=head2 no_proxy

    $ua->no_proxy( @domains );
    $ua->no_proxy('localhost', 'example.com');
    $ua->no_proxy(); # clear the list

Do not proxy requests to the given domains.  Calling C<no_proxy> without
any domains clears the list of domains.

=head2 proxy

    $ua->proxy(\@schemes, $proxy_url)
    $ua->proxy(['http', 'ftp'], 'http://proxy.sn.no:8001/');

    # For a single scheme:
    $ua->proxy($scheme, $proxy_url)
    $ua->proxy('gopher', 'http://proxy.sn.no:8001/');

    # To set multiple proxies at once:
    $ua->proxy([
        ftp => 'http://ftp.example.com:8001/',
        [ 'http', 'https' ] => 'http://http.example.com:8001/',
    ]);

Set/retrieve proxy URL for a scheme.

The first form specifies that the URL is to be used as a proxy for
access methods listed in the list in the first method argument,
i.e. C<http> and C<ftp>.

The second form shows a shorthand form for specifying
proxy URL for a single access scheme.

The third form demonstrates setting multiple proxies at once. This is also
the only form accepted by the constructor.

=head1 HANDLERS

Handlers are code that injected at various phases during the
processing of requests.  The following methods are provided to manage
the active handlers:

=head2 add_handler

    $ua->add_handler( $phase => \&cb, %matchspec )

Add handler to be invoked in the given processing phase.  For how to
specify C<%matchspec> see L<HTTP::Config/"Matching">.

The possible values C<$phase> and the corresponding callback signatures are as
follows.  Note that the handlers are documented in the order in which they will
be run, which is:

    request_preprepare
    request_prepare
    request_send
    response_header
    response_data
    response_done