1 | package LWP::Authen::Ntlm;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use vars qw/$VERSION/;
|
---|
5 |
|
---|
6 | $VERSION = "6.00";
|
---|
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 = LWP::UserAgent->new(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 = LWP::UserAgent->new(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 [email protected]
|
---|
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>.
|
---|