Commit | Line | Data |
3fea05b9 |
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.00"; |
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; |