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