local-lib5/lib/perl5/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.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;