1#!/usr/local/bin/perl 2 3package Authen::NTLM; 4use strict; 5use Authen::NTLM::DES; 6use Authen::NTLM::MD4; 7use MIME::Base64; 8use Digest::HMAC_MD5; 9 10use vars qw($VERSION @ISA @EXPORT); 11require Exporter; 12 13=head1 NAME 14 15Authen::NTLM - An NTLM authentication module 16 17=head1 SYNOPSIS 18 19 use Mail::IMAPClient; 20 use Authen::NTLM; 21 my $imap = Mail::IMAPClient->new(Server=>'imaphost'); 22 ntlm_user($username); 23 ntlm_password($password); 24 $imap->authenticate("NTLM", Authen::NTLM::ntlm); 25 : 26 $imap->logout; 27 ntlm_reset; 28 : 29 30or 31 32 ntlmv2(1); 33 ntlm_user($username); 34 ntlm_host($host); 35 ntlm_password($password); 36 : 37 38or 39 40 my $ntlm = Authen::NTLM-> new( 41 host => $host, 42 user => $username, 43 domain => $domain, 44 password => $password, 45 version => 1, 46 ); 47 $ntlm-> challenge; 48 : 49 $ntlm-> challenge($challenge); 50 51 52 53=head1 DESCRIPTION 54 55 This module provides methods to use NTLM authentication. It can 56 be used as an authenticate method with the Mail::IMAPClient module 57 to perform the challenge/response mechanism for NTLM connections 58 or it can be used on its own for NTLM authentication with other 59 protocols (eg. HTTP). 60 61 The implementation is a direct port of the code from F<fetchmail> 62 which, itself, has based its NTLM implementation on F<samba>. As 63 such, this code is not especially efficient, however it will still 64 take a fraction of a second to negotiate a login on a PII which is 65 likely to be good enough for most situations. 66 67=head2 FUNCTIONS 68 69=over 4 70 71=item ntlm_domain() 72 73 Set the domain to use in the NTLM authentication messages. 74 Returns the new domain. Without an argument, this function 75 returns the current domain entry. 76 77=item ntlm_user() 78 79 Set the username to use in the NTLM authentication messages. 80 Returns the new username. Without an argument, this function 81 returns the current username entry. 82 83=item ntlm_password() 84 85 Set the password to use in the NTLM authentication messages. 86 Returns the new password. Without an argument, this function 87 returns the current password entry. 88 89=item ntlm_reset() 90 91 Resets the NTLM challenge/response state machine so that the next 92 call to C<ntlm()> will produce an initial connect message. 93 94=item ntlm() 95 96 Generate a reply to a challenge. The NTLM protocol involves an 97 initial empty challenge from the server requiring a message 98 response containing the username and domain (which may be empty). 99 The first call to C<ntlm()> generates this first message ignoring 100 any arguments. 101 102 The second time it is called, it is assumed that the argument is 103 the challenge string sent from the server. This will contain 8 104 bytes of data which are used in the DES functions to generate the 105 response authentication strings. The result of the call is the 106 final authentication string. 107 108 If C<ntlm_reset()> is called, then the next call to C<ntlm()> will 109 start the process again allowing multiple authentications within 110 an application. 111 112=item ntlmv2() 113 114 Use NTLM v2 authentication. 115 116=back 117 118=head2 OBJECT API 119 120=over 121 122=item new %options 123 124Creates an object that accepts the following options: C<user>, C<host>, 125C<domain>, C<password>, C<version>. 126 127=item challenge [$challenge] 128 129If C<$challenge> is not supplied, first-stage challenge string is generated. 130Otherwise, the third-stage challenge is generated, where C<$challenge> is 131assumed to be extracted from the second stage of NTLM exchange. The result of 132the call is the final authentication string. 133 134=back 135 136=head1 AUTHOR 137 138 David (Buzz) Bussenschutt <davidbuzz@gmail.com> - current maintainer 139 Dmitry Karasik <dmitry@karasik.eu.org> - nice ntlmv2 patch, OO extensions. 140 Andrew Hobson <ahobson@infloop.com> - initial ntlmv2 code 141 Mark Bush <Mark.Bush@bushnet.demon.co.uk> - perl port 142 Eric S. Raymond - author of fetchmail 143 Andrew Tridgell and Jeremy Allison for SMB/Netbios code 144 145=head1 SEE ALSO 146 147L<perl>, L<Mail::IMAPClient>, L<LWP::Authen::Ntlm> 148 149=head1 HISTORY 150 151 1.09 - fix CPAN ticket # 70703 152 1.08 - fix CPAN ticket # 39925 153 1.07 - not publicly released 154 1.06 - relicense as GPL+ or Artistic 155 1.05 - add OO interface by Dmitry Karasik 156 1.04 - implementation of NTLMv2 by Andrew Hobson/Dmitry Karasik 157 1.03 - fixes long-standing 1 line bug L<http://rt.cpan.org/Public/Bug/Display.html?id=9521> - released by David Bussenschutt 9th Aug 2007 158 1.02 - released by Mark Bush 29th Oct 2001 159 160=cut 161 162$VERSION = "1.09"; 163@ISA = qw(Exporter); 164@EXPORT = qw(ntlm ntlm_domain ntlm_user ntlm_password ntlm_reset ntlm_host ntlmv2); 165 166my $domain = ""; 167my $user = ""; 168my $password = ""; 169 170my $str_hdr = "vvV"; 171my $hdr_len = 8; 172my $ident = "NTLMSSP"; 173 174my $msg1_f = 0x0000b207; 175my $msg1 = "Z8VV"; 176my $msg1_hlen = 16 + ($hdr_len*2); 177 178my $msg2 = "Z8Va${hdr_len}Va8a8a${hdr_len}"; 179my $msg2_hlen = 12 + $hdr_len + 20 + $hdr_len; 180 181my $msg3 = "Z8V"; 182my $msg3_tl = "V"; 183my $msg3_hlen = 12 + ($hdr_len*6) + 4; 184 185my $state = 0; 186 187my $host = ""; 188my $ntlm_v2 = 0; 189my $ntlm_v2_msg3_flags = 0x88205; 190 191 192# Domain Name supplied on negotiate 193use constant NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED => 0x00001000; 194# Workstation Name supplied on negotiate 195use constant NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED => 0x00002000; 196# Try to use NTLMv2 197use constant NTLMSSP_NEGOTIATE_NTLM2 => 0x00080000; 198 199 200# Object API 201 202sub new 203{ 204 my ( $class, %opt) = @_; 205 for (qw(domain user password host)) { 206 $opt{$_} = "" unless defined $opt{$_}; 207 } 208 $opt{version} ||= 1; 209 return bless { %opt }, $class; 210} 211 212sub challenge 213{ 214 my ( $self, $challenge) = @_; 215 $state = defined $challenge; 216 ($user,$domain,$password,$host) = @{$self}{qw(user domain password host)}; 217 $ntlm_v2 = ($self-> {version} eq '2') ? 1 : 0; 218 return ntlm($challenge); 219} 220 221eval "sub $_ { \$#_ ? \$_[0]->{$_} = \$_[1] : \$_[0]->{$_} }" 222 for qw(user domain password host version); 223 224# Function API 225 226sub ntlm_domain 227{ 228 if (@_) 229 { 230 $domain = shift; 231 } 232 return $domain; 233} 234 235sub ntlm_user 236{ 237 if (@_) 238 { 239 $user = shift; 240 } 241 return $user; 242} 243 244sub ntlm_password 245{ 246 if (@_) 247 { 248 $password = shift; 249 } 250 return $password; 251} 252 253sub ntlm_reset 254{ 255 $state = 0; 256} 257 258sub ntlmv2 259{ 260 if (@_) { 261 $ntlm_v2 = shift; 262 } 263 return $ntlm_v2; 264} 265 266sub ntlm_host { 267 if (@_) { 268 $host = shift; 269 } 270 return $host; 271} 272 273sub ntlm 274{ 275 my ($challenge) = @_; 276 277 my ($flags, $user_hdr, $domain_hdr, 278 $u_off, $d_off, $c_info, $lmResp, $ntResp, $lm_hdr, 279 $nt_hdr, $wks_hdr, $session_hdr, $lm_off, $nt_off, 280 $wks_off, $s_off, $u_user, $msg1_host, $host_hdr, $u_host); 281 my $response; 282 if ($state) 283 { 284 285 $challenge =~ s/^\s*//; 286 $challenge = decode_base64($challenge); 287 $c_info = &decode_challenge($challenge); 288 $u_user = &unicode($user); 289 if (!$ntlm_v2) { 290 $domain = substr($challenge, $c_info->{domain}{offset}, $c_info->{domain}{len}); 291 $lmResp = &lmEncrypt($c_info->{data}); 292 $ntResp = &ntEncrypt($c_info->{data}); 293 $flags = pack($msg3_tl, $c_info->{flags}); 294 } 295 elsif ($ntlm_v2 eq '1') { 296 $lmResp = &lmv2Encrypt($c_info->{data}); 297 $ntResp = &ntv2Encrypt($c_info->{data}, $c_info->{target_data}); 298 $flags = pack($msg3_tl, $ntlm_v2_msg3_flags); 299 } 300 else { 301 $domain = &unicode($domain);#substr($challenge, $c_info->{domain}{offset}, $c_info->{domain}{len}); 302 $lmResp = &lmEncrypt($c_info->{data}); 303 $ntResp = &ntEncrypt($c_info->{data}); 304 $flags = pack($msg3_tl, $c_info->{flags}); 305 } 306 $u_host = &unicode(($host ? $host : $user)); 307 $response = pack($msg3, $ident, 3); 308 309 $lm_off = $msg3_hlen; 310 $nt_off = $lm_off + length($lmResp); 311 $d_off = $nt_off + length($ntResp); 312 $u_off = $d_off + length($domain); 313 $wks_off = $u_off + length($u_user); 314 $s_off = $wks_off + length($u_host); 315 $lm_hdr = &hdr($lmResp, $msg3_hlen, $lm_off); 316 $nt_hdr = &hdr($ntResp, $msg3_hlen, $nt_off); 317 $domain_hdr = &hdr($domain, $msg3_hlen, $d_off); 318 $user_hdr = &hdr($u_user, $msg3_hlen, $u_off); 319 $wks_hdr = &hdr($u_host, $msg3_hlen, $wks_off); 320 $session_hdr = &hdr("", $msg3_hlen, $s_off); 321 $response .= $lm_hdr . $nt_hdr . $domain_hdr . $user_hdr . 322 $wks_hdr . $session_hdr . $flags . 323 $lmResp . $ntResp . $domain . $u_user . $u_host; 324 } 325 else # first response; 326 { 327 my $f = $msg1_f; 328 if (!length $domain) { 329 $f &= ~NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED; 330 } 331 $msg1_host = $user; 332 if ($ntlm_v2 and $ntlm_v2 eq '1') { 333 $f &= ~NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED; 334 $f |= NTLMSSP_NEGOTIATE_NTLM2; 335 $msg1_host = ""; 336 } 337 338 $response = pack($msg1, $ident, 1, $f); 339 $u_off = $msg1_hlen; 340 $d_off = $u_off + length($msg1_host); 341 $host_hdr = &hdr($msg1_host, $msg1_hlen, $u_off); 342 $domain_hdr = &hdr($domain, $msg1_hlen, $d_off); 343 $response .= $host_hdr . $domain_hdr . $msg1_host . $domain; 344 $state = 1; 345 } 346 return encode_base64($response, ""); 347} 348 349sub hdr 350{ 351 my ($string, $h_len, $offset) = @_; 352 353 my ($res, $len); 354 $len = length($string); 355 if ($string) 356 { 357 $res = pack($str_hdr, $len, $len, $offset); 358 } 359 else 360 { 361 $res = pack($str_hdr, 0, 0, $offset - $h_len); 362 } 363 return $res; 364} 365 366sub decode_challenge 367{ 368 my ($challenge) = @_; 369 370 my $res; 371 my (@res, @hdr); 372 my $original = $challenge; 373 374 $res->{buffer} = $msg2_hlen < length $challenge 375 ? substr($challenge, $msg2_hlen) : ''; 376 $challenge = substr($challenge, 0, $msg2_hlen); 377 @res = unpack($msg2, $challenge); 378 $res->{ident} = $res[0]; 379 $res->{type} = $res[1]; 380 @hdr = unpack($str_hdr, $res[2]); 381 $res->{domain}{len} = $hdr[0]; 382 $res->{domain}{maxlen} = $hdr[1]; 383 $res->{domain}{offset} = $hdr[2]; 384 $res->{flags} = $res[3]; 385 $res->{data} = $res[4]; 386 $res->{reserved} = $res[5]; 387 $res->{empty_hdr} = $res[6]; 388 @hdr = unpack($str_hdr, $res[6]); 389 $res->{target}{len} = $hdr[0]; 390 $res->{target}{maxlen} = $hdr[1]; 391 $res->{target}{offset} = $hdr[2]; 392 $res->{target_data} = substr($original, $hdr[2], $hdr[1]); 393 394 return $res; 395} 396 397sub unicode 398{ 399 my ($string) = @_; 400 my ($reply, $c, $z) = (''); 401 402 $z = sprintf "%c", 0; 403 foreach $c (split //, $string) 404 { 405 $reply .= $c . $z; 406 } 407 return $reply; 408} 409 410sub NTunicode 411{ 412 my ($string) = @_; 413 my ($reply, $c); 414 415 foreach $c (map {ord($_)} split(//, $string)) 416 { 417 $reply .= pack("v", $c); 418 } 419 return $reply; 420} 421 422sub lmEncrypt 423{ 424 my ($data) = @_; 425 426 my $p14 = substr($password, 0, 14); 427 $p14 =~ tr/a-z/A-Z/; 428 $p14 .= "\0"x(14-length($p14)); 429 my $p21 = E_P16($p14); 430 $p21 .= "\0"x(21-length($p21)); 431 my $p24 = E_P24($p21, $data); 432 return $p24; 433} 434 435sub ntEncrypt 436{ 437 my ($data) = @_; 438 439 my $p21 = &E_md4hash; 440 $p21 .= "\0"x(21-length($p21)); 441 my $p24 = E_P24($p21, $data); 442 return $p24; 443} 444 445sub E_md4hash 446{ 447 my $wpwd = &NTunicode($password); 448 my $p16 = mdfour($wpwd); 449 return $p16; 450} 451 452sub lmv2Encrypt { 453 my ($data) = @_; 454 455 my $u_pass = &unicode($password); 456 my $ntlm_hash = mdfour($u_pass); 457 458 my $u_user = &unicode("\U$user\E"); 459 my $u_domain = &unicode("$domain"); 460 my $concat = $u_user . $u_domain; 461 462 my $hmac = Digest::HMAC_MD5->new($ntlm_hash); 463 $hmac->add($concat); 464 my $ntlm_v2_hash = $hmac->digest; 465 466 # Firefox seems to use this as its random challenge 467 my $random_challenge = "\0" x 8; 468 469 my $concat2 = $data . $random_challenge; 470 471 $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); 472 $hmac->add(substr($data, 0, 8) . $random_challenge); 473 my $r = $hmac->digest . $random_challenge; 474 475 return $r; 476} 477 478sub ntv2Encrypt { 479 my ($data, $target) = @_; 480 481 my $u_pass = &unicode($password); 482 my $ntlm_hash = mdfour($u_pass); 483 484 my $u_user = &unicode("\U$user\E"); 485 my $u_domain = &unicode("$domain"); 486 my $concat = $u_user . $u_domain; 487 488 my $hmac = Digest::HMAC_MD5->new($ntlm_hash); 489 $hmac->add($concat); 490 my $ntlm_v2_hash = $hmac->digest; 491 492 my $zero_long = "\000" x 4; 493 my $sig = pack("H8", "01010000"); 494 my $time = pack("VV", (time + 11644473600) + 10000000); 495 my $rand = "\0" x 8; 496 my $blob = $sig . $zero_long . $time . $rand . $zero_long . 497 $target . $zero_long; 498 499 $concat = $data . $blob; 500 501 $hmac = Digest::HMAC_MD5->new($ntlm_v2_hash); 502 $hmac->add($concat); 503 504 my $d = $hmac->digest; 505 506 my $r = $d . $blob; 507 508 return $r; 509} 510 5111; 512