1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 # vim: ts=4 sts=4 sw=4:
3 package CPAN::LWP::UserAgent;
5 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
6 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
8 $CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.00";
12 if ($CPAN::META->has_usable('LWP::UserAgent')) {
13 require LWP::UserAgent;
14 @ISA = qw(Exporter LWP::UserAgent); ## no critic
17 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
21 sub get_basic_credentials {
22 my($self, $realm, $uri, $proxy) = @_;
23 if ($USER && $PASSWD) {
24 return ($USER, $PASSWD);
27 ($USER,$PASSWD) = $self->get_proxy_credentials();
29 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
31 return($USER,$PASSWD);
34 sub get_proxy_credentials {
36 my ($user, $password);
37 if ( defined $CPAN::Config->{proxy_user} ) {
38 $user = $CPAN::Config->{proxy_user};
39 $password = $CPAN::Config->{proxy_pass} || "";
40 return ($user, $password);
42 my $username_prompt = "\nProxy authentication needed!
43 (Note: to permanently configure username and password run
44 o conf proxy_user your_username
45 o conf proxy_pass your_password
48 _get_username_and_password_from_user($username_prompt);
49 return ($user,$password);
52 sub get_non_proxy_credentials {
55 if ( defined $CPAN::Config->{username} ) {
56 $user = $CPAN::Config->{username};
57 $password = $CPAN::Config->{password} || "";
58 return ($user, $password);
60 my $username_prompt = "\nAuthentication needed!
61 (Note: to permanently configure username and password run
62 o conf username your_username
63 o conf password your_password
67 _get_username_and_password_from_user($username_prompt);
68 return ($user,$password);
71 sub _get_username_and_password_from_user {
72 my $username_message = shift;
73 my ($username,$password);
75 ExtUtils::MakeMaker->import(qw(prompt));
76 $username = prompt($username_message);
77 if ($CPAN::META->has_inst("Term::ReadKey")) {
78 Term::ReadKey::ReadMode("noecho");
81 $CPAN::Frontend->mywarn(
82 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
85 $password = prompt("Password:");
87 if ($CPAN::META->has_inst("Term::ReadKey")) {
88 Term::ReadKey::ReadMode("restore");
90 $CPAN::Frontend->myprint("\n\n");
91 return ($username,$password);
94 # mirror(): Its purpose is to deal with proxy authentication. When we
95 # call SUPER::mirror, we relly call the mirror method in
96 # LWP::UserAgent. LWP::UserAgent will then call
97 # $self->get_basic_credentials or some equivalent and this will be
98 # $self->dispatched to our own get_basic_credentials method.
100 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
102 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
103 # although we have gone through our get_basic_credentials, the proxy
104 # server refuses to connect. This could be a case where the username or
105 # password has changed in the meantime, so I'm trying once again without
106 # $USER and $PASSWD to give the get_basic_credentials routine another
107 # chance to set $USER and $PASSWD.
109 # mirror(): Its purpose is to deal with proxy authentication. When we
110 # call SUPER::mirror, we relly call the mirror method in
111 # LWP::UserAgent. LWP::UserAgent will then call
112 # $self->get_basic_credentials or some equivalent and this will be
113 # $self->dispatched to our own get_basic_credentials method.
115 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
117 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
118 # although we have gone through our get_basic_credentials, the proxy
119 # server refuses to connect. This could be a case where the username or
120 # password has changed in the meantime, so I'm trying once again without
121 # $USER and $PASSWD to give the get_basic_credentials routine another
122 # chance to set $USER and $PASSWD.
125 my($self,$url,$aslocal) = @_;
126 my $result = $self->SUPER::mirror($url,$aslocal);
127 if ($result->code == 407) {
130 $result = $self->SUPER::mirror($url,$aslocal);