This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update CPAN to CPAN version 1.94_62
[perl5.git] / cpan / CPAN / lib / CPAN / LWP / UserAgent.pm
CommitLineData
f9916dde
AK
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);
6# we delay requiring LWP::UserAgent and setting up inheritance until we need it
7
7b8f75d3 8$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.94";
2f2071b1 9
f9916dde
AK
10sub config {
11 return if $SETUPDONE;
12 if ($CPAN::META->has_usable('LWP::UserAgent')) {
13 require LWP::UserAgent;
14 @ISA = qw(Exporter LWP::UserAgent); ## no critic
15 $SETUPDONE++;
16 } else {
17 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
18 }
19}
20
21sub get_basic_credentials {
22 my($self, $realm, $uri, $proxy) = @_;
23 if ($USER && $PASSWD) {
24 return ($USER, $PASSWD);
25 }
26 if ( $proxy ) {
27 ($USER,$PASSWD) = $self->get_proxy_credentials();
28 } else {
29 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
30 }
31 return($USER,$PASSWD);
32}
33
34sub get_proxy_credentials {
35 my $self = shift;
36 my ($user, $password);
07be2ace
CBW
37 if ( defined $CPAN::Config->{proxy_user}
38 && $CPAN::Config->{proxy_user}
39 ) {
f9916dde
AK
40 $user = $CPAN::Config->{proxy_user};
41 $password = $CPAN::Config->{proxy_pass} || "";
42 return ($user, $password);
43 }
44 my $username_prompt = "\nProxy authentication needed!
45 (Note: to permanently configure username and password run
46 o conf proxy_user your_username
47 o conf proxy_pass your_password
48 )\nUsername:";
49 ($user, $password) =
50 _get_username_and_password_from_user($username_prompt);
51 return ($user,$password);
52}
53
54sub get_non_proxy_credentials {
55 my $self = shift;
56 my ($user,$password);
57 if ( defined $CPAN::Config->{username} ) {
58 $user = $CPAN::Config->{username};
59 $password = $CPAN::Config->{password} || "";
60 return ($user, $password);
61 }
62 my $username_prompt = "\nAuthentication needed!
63 (Note: to permanently configure username and password run
64 o conf username your_username
65 o conf password your_password
66 )\nUsername:";
67
68 ($user, $password) =
69 _get_username_and_password_from_user($username_prompt);
70 return ($user,$password);
71}
72
73sub _get_username_and_password_from_user {
74 my $username_message = shift;
75 my ($username,$password);
76
77 ExtUtils::MakeMaker->import(qw(prompt));
78 $username = prompt($username_message);
79 if ($CPAN::META->has_inst("Term::ReadKey")) {
80 Term::ReadKey::ReadMode("noecho");
81 }
82 else {
83 $CPAN::Frontend->mywarn(
84 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
85 );
86 }
87 $password = prompt("Password:");
88
89 if ($CPAN::META->has_inst("Term::ReadKey")) {
90 Term::ReadKey::ReadMode("restore");
91 }
92 $CPAN::Frontend->myprint("\n\n");
93 return ($username,$password);
94}
95
07be2ace
CBW
96
97sub no_proxy {
98 my ( $self, $no_proxy ) = @_;
99 return $self->SUPER::no_proxy( split(',',$no_proxy) );
100}
101
f9916dde
AK
102# mirror(): Its purpose is to deal with proxy authentication. When we
103# call SUPER::mirror, we relly call the mirror method in
104# LWP::UserAgent. LWP::UserAgent will then call
105# $self->get_basic_credentials or some equivalent and this will be
106# $self->dispatched to our own get_basic_credentials method.
107
108# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
109
110# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
111# although we have gone through our get_basic_credentials, the proxy
112# server refuses to connect. This could be a case where the username or
113# password has changed in the meantime, so I'm trying once again without
114# $USER and $PASSWD to give the get_basic_credentials routine another
115# chance to set $USER and $PASSWD.
116
117# mirror(): Its purpose is to deal with proxy authentication. When we
118# call SUPER::mirror, we relly call the mirror method in
119# LWP::UserAgent. LWP::UserAgent will then call
120# $self->get_basic_credentials or some equivalent and this will be
121# $self->dispatched to our own get_basic_credentials method.
122
123# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
124
125# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
126# although we have gone through our get_basic_credentials, the proxy
127# server refuses to connect. This could be a case where the username or
128# password has changed in the meantime, so I'm trying once again without
129# $USER and $PASSWD to give the get_basic_credentials routine another
130# chance to set $USER and $PASSWD.
131
132sub mirror {
133 my($self,$url,$aslocal) = @_;
134 my $result = $self->SUPER::mirror($url,$aslocal);
135 if ($result->code == 407) {
136 undef $USER;
137 undef $PASSWD;
138 $result = $self->SUPER::mirror($url,$aslocal);
139 }
140 $result;
141}
142
1431;