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
1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 # vim: ts=4 sts=4 sw=4:
3 package CPAN::LWP::UserAgent;
4 use strict;
5 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
6 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
7
8 $CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.94";
9
10 sub 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
21 sub 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
34 sub get_proxy_credentials {
35     my $self = shift;
36     my ($user, $password);
37     if ( defined $CPAN::Config->{proxy_user}
38             && $CPAN::Config->{proxy_user}
39     ) {
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
54 sub 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
73 sub _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
96
97 sub no_proxy {
98     my ( $self, $no_proxy ) = @_;
99     return $self->SUPER::no_proxy( split(',',$no_proxy) );
100 }
101
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
132 sub 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
143 1;