This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7bb86f9a15deee51dd4770afd595fcc64022cfeb
[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         $user = $CPAN::Config->{proxy_user};
39         $password = $CPAN::Config->{proxy_pass} || "";
40         return ($user, $password);
41     }
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
46      )\nUsername:";
47     ($user, $password) =
48         _get_username_and_password_from_user($username_prompt);
49     return ($user,$password);
50 }
51
52 sub get_non_proxy_credentials {
53     my $self = shift;
54     my ($user,$password);
55     if ( defined $CPAN::Config->{username} ) {
56         $user = $CPAN::Config->{username};
57         $password = $CPAN::Config->{password} || "";
58         return ($user, $password);
59     }
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
64      )\nUsername:";
65
66     ($user, $password) =
67         _get_username_and_password_from_user($username_prompt);
68     return ($user,$password);
69 }
70
71 sub _get_username_and_password_from_user {
72     my $username_message = shift;
73     my ($username,$password);
74
75     ExtUtils::MakeMaker->import(qw(prompt));
76     $username = prompt($username_message);
77         if ($CPAN::META->has_inst("Term::ReadKey")) {
78             Term::ReadKey::ReadMode("noecho");
79         }
80     else {
81         $CPAN::Frontend->mywarn(
82             "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
83         );
84     }
85     $password = prompt("Password:");
86
87         if ($CPAN::META->has_inst("Term::ReadKey")) {
88             Term::ReadKey::ReadMode("restore");
89         }
90         $CPAN::Frontend->myprint("\n\n");
91     return ($username,$password);
92 }
93
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.
99
100 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
101
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.
108
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.
114
115 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
116
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.
123
124 sub mirror {
125     my($self,$url,$aslocal) = @_;
126     my $result = $self->SUPER::mirror($url,$aslocal);
127     if ($result->code == 407) {
128         undef $USER;
129         undef $PASSWD;
130         $result = $self->SUPER::mirror($url,$aslocal);
131     }
132     $result;
133 }
134
135 1;