1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3package CPAN::LWP::UserAgent;
4use strict;
5use vars qw(@ISA $USER $PASSWD $SETUPDONE);
6use CPAN::HTTP::Credentials;
7# we delay requiring LWP::UserAgent and setting up inheritance until we need it
8
9$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.9601";
10
11
12sub config {
13    return if $SETUPDONE;
14    if ($CPAN::META->has_usable('LWP::UserAgent')) {
15        require LWP::UserAgent;
16        @ISA = qw(Exporter LWP::UserAgent); ## no critic
17        $SETUPDONE++;
18    } else {
19        $CPAN::Frontend->mywarn("  LWP::UserAgent not available\n");
20    }
21}
22
23sub get_basic_credentials {
24    my($self, $realm, $uri, $proxy) = @_;
25    if ( $proxy ) {
26        return CPAN::HTTP::Credentials->get_proxy_credentials();
27    } else {
28        return CPAN::HTTP::Credentials->get_non_proxy_credentials();
29    }
30}
31
32sub no_proxy {
33    my ( $self, $no_proxy ) = @_;
34    return $self->SUPER::no_proxy( split(',',$no_proxy) );
35}
36
37# mirror(): Its purpose is to deal with proxy authentication. When we
38# call SUPER::mirror, we really call the mirror method in
39# LWP::UserAgent. LWP::UserAgent will then call
40# $self->get_basic_credentials or some equivalent and this will be
41# $self->dispatched to our own get_basic_credentials method.
42
43# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
44
45# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
46# although we have gone through our get_basic_credentials, the proxy
47# server refuses to connect. This could be a case where the username or
48# password has changed in the meantime, so I'm trying once again without
49# $USER and $PASSWD to give the get_basic_credentials routine another
50# chance to set $USER and $PASSWD.
51
52sub mirror {
53    my($self,$url,$aslocal) = @_;
54    my $result = $self->SUPER::mirror($url,$aslocal);
55    if ($result->code == 407) {
56        CPAN::HTTP::Credentials->clear_credentials;
57        $result = $self->SUPER::mirror($url,$aslocal);
58    }
59    $result;
60}
61
621;
63