git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-perl/libwww-perl-5.813/debian/libwww-perl/usr/share/perl5/LWP/Authen/Ntlm.pm

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