local-lib5/lib/perl5/LWP/Authen/Ntlm.pm

   1 package LWP::Authen::Ntlm;
   2
   3 use strict;
   4 use vars qw/$VERSION/;
   5
   6 $VERSION = '5.827';
   7
   8 use Authen::NTLM "1.02";
   9 use MIME::Base64 "2.12";
  10
  11 sub authenticate {
  12     my($class, $ua, $proxy, $auth_param, $response,
  13        $request, $arg, $size) = @_;
  14
  15     my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
  16                                                   $request->uri, $proxy);
  17
  18     unless(defined $user and defined $pass) {
  19                 return $response;
  20         }
  21
  22         if (!$ua->conn_cache()) {
  23                 warn "The keep_alive option must be enabled for NTLM authentication to work.  NTLM authentication aborted.\n";
  24                 return $response;
  25         }
  26
  27         my($domain, $username) = split(/\\/, $user);
  28
  29         ntlm_domain($domain);
  30         ntlm_user($username);
  31         ntlm_password($pass);
  32
  33     my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
  34
  35         # my ($challenge) = $response->header('WWW-Authenticate');
  36         my $challenge;
  37         foreach ($response->header('WWW-Authenticate')) {
  38                 last if /^NTLM/ && ($challenge=$_);
  39         }
  40
  41         if ($challenge eq 'NTLM') {
  42                 # First phase, send handshake
  43             my $auth_value = "NTLM " . ntlm();
  44                 ntlm_reset();
  45
  46             # Need to check this isn't a repeated fail!
  47             my $r = $response;
  48                 my $retry_count = 0;
  49             while ($r) {
  50                         my $auth = $r->request->header($auth_header);
  51                         ++$retry_count if ($auth && $auth eq $auth_value);
  52                         if ($retry_count > 2) {
  53                                     # here we know this failed before
  54                                     $response->header("Client-Warning" =>
  55                                                       "Credentials for '$user' failed before");
  56                                     return $response;
  57                         }
  58                         $r = $r->previous;
  59             }
  60
  61             my $referral = $request->clone;
  62             $referral->header($auth_header => $auth_value);
  63             return $ua->request($referral, $arg, $size, $response);
  64         }
  65
  66         else {
  67                 # Second phase, use the response challenge (unless non-401 code
  68                 #  was returned, in which case, we just send back the response
  69                 #  object, as is
  70                 my $auth_value;
  71                 if ($response->code ne '401') {
  72                         return $response;
  73                 }
  74                 else {
  75                         my $challenge;
  76                         foreach ($response->header('WWW-Authenticate')) {
  77                                 last if /^NTLM/ && ($challenge=$_);
  78                         }
  79                         $challenge =~ s/^NTLM //;
  80                         ntlm();
  81                         $auth_value = "NTLM " . ntlm($challenge);
  82                         ntlm_reset();
  83                 }
  84
  85             my $referral = $request->clone;
  86             $referral->header($auth_header => $auth_value);
  87             my $response2 = $ua->request($referral, $arg, $size, $response);
  88                 return $response2;
  89         }
  90 }
  91
  92 1;
  93
  94
  95 =head1 NAME
  96
  97 LWP::Authen::Ntlm - Library for enabling NTLM authentication (Microsoft) in LWP
  98
  99 =head1 SYNOPSIS
 100
 101  use LWP::UserAgent;
 102  use HTTP::Request::Common;
 103  my $url = 'http://www.company.com/protected_page.html';
 104
 105  # Set up the ntlm client and then the base64 encoded ntlm handshake message
 106  my $ua = new LWP::UserAgent(keep_alive=>1);
 107  $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
 108
 109  $request = GET $url;
 110  print "--Performing request now...-----------\n";
 111  $response = $ua->request($request);
 112  print "--Done with request-------------------\n";
 113
 114  if ($response->is_success) {print "It worked!->" . $response->code . "\n"}
 115  else {print "It didn't work!->" . $response->code . "\n"}
 116
 117 =head1 DESCRIPTION
 118
 119 C<LWP::Authen::Ntlm> allows LWP to authenticate against servers that are using the
 120 NTLM authentication scheme popularized by Microsoft.  This type of authentication is
 121 common on intranets of Microsoft-centric organizations.
 122
 123 The module takes advantage of the Authen::NTLM module by Mark Bush.  Since there
 124 is also another Authen::NTLM module available from CPAN by Yee Man Chan with an
 125 entirely different interface, it is necessary to ensure that you have the correct
 126 NTLM module.
 127
 128 In addition, there have been problems with incompatibilities between different
 129 versions of Mime::Base64, which Bush's Authen::NTLM makes use of.  Therefore, it is
 130 necessary to ensure that your Mime::Base64 module supports exporting of the
 131 encode_base64 and decode_base64 functions.
 132
 133 =head1 USAGE
 134
 135 The module is used indirectly through LWP, rather than including it directly in your
 136 code.  The LWP system will invoke the NTLM authentication when it encounters the
 137 authentication scheme while attempting to retrieve a URL from a server.  In order
 138 for the NTLM authentication to work, you must have a few things set up in your
 139 code prior to attempting to retrieve the URL:
 140
 141 =over 4
 142
 143 =item *
 144
 145 Enable persistent HTTP connections
 146
 147 To do this, pass the "keep_alive=>1" option to the LWP::UserAgent when creating it, like this:
 148
 149     my $ua = new LWP::UserAgent(keep_alive=>1);
 150
 151 =item *
 152
 153 Set the credentials on the UserAgent object
 154
 155 The credentials must be set like this:
 156
 157    $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
 158
 159 Note that you cannot use the HTTP::Request object's authorization_basic() method to set
 160 the credentials.  Note, too, that the 'www.company.com:80' portion only sets credentials
 161 on the specified port AND it is case-sensitive (this is due to the way LWP is coded, and
 162 has nothing to do with LWP::Authen::Ntlm)
 163
 164 =back
 165
 166 =head1 AVAILABILITY
 167
 168 General queries regarding LWP should be made to the LWP Mailing List.
 169
 170 Questions specific to LWP::Authen::Ntlm can be forwarded to jtillman@bigfoot.com
 171
 172 =head1 COPYRIGHT
 173
 174 Copyright (c) 2002 James Tillman. All rights reserved. This
 175 program is free software; you can redistribute it and/or modify it
 176 under the same terms as Perl itself.
 177
 178 =head1 SEE ALSO
 179
 180 L<LWP>, L<LWP::UserAgent>, L<lwpcook>.