Authen-Perl-NTLM
view release on metacpan or search on metacpan
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
use constant NTLMSSP_REQUEST_INIT_RESPONSE => 0x00100000;
# get back session key, LUID
use constant NTLMSSP_REQUEST_ACCEPT_RESPONSE => 0x00200000;
# request non-ntsession key
use constant NTLMSSP_REQUEST_NON_NT_SESSION_KEY => 0x00400000;
use constant NTLMSSP_NEGOTIATE_TARGET_INFO => 0x00800000;
use constant NTLMSSP_NEGOTIATE_128 => 0x20000000;
use constant NTLMSSP_NEGOTIATE_KEY_EXCH => 0x40000000;
use constant NTLMSSP_NEGOTIATE_80000000 => 0x80000000;
sub lm_hash($);
sub nt_hash($);
sub calc_resp($$);
#########################################################################
# Constructor to initialize authentication related information. In this #
# version, we assume NTLM as the authentication scheme of choice. #
# The constructor takes the class name, LM hash of the client password #
# and the LM hash of the client password as arguments. #
#########################################################################
sub new_client {
usage("new_client Authen::Perl::NTLM(\$lm_hpw, \$nt_hpw\) or\nnew_client Authen::Perl::NTLM\(\$lm_hpw, \$nt_hpw, \$user, \$user_domain, \$domain, \$machine\)") unless @_ == 3 or @_ == 7;
my ($package, $lm_hpw, $nt_hpw, $user, $user_domain, $domain, $machine) = @_;
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
bless {
'domain' => $domain,
'cChallenge' => 0 # a counter to stir the seed to generate random
}, $package; # number for the nonce
}
##########################################################################
# lm_hash calculates the LM hash to be used to calculate the LM response #
# It takes a password and return the 21 bytes LM password hash. #
##########################################################################
sub lm_hash($)
{
my ($passwd) = @_;
my $cipher1;
my $cipher2;
my $magic = pack("H16", "4B47532140232425"); # magical string to be encrypted for the LM password hash
while (length($passwd) < 14) {
$passwd .= chr(0);
}
my $lm_pw = substr($passwd, 0, 14);
$lm_pw = uc($lm_pw); # change the password to upper case
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
$cipher1 = Crypt::DES->new(substr($key, 0, 8));
$cipher2 = Crypt::DES->new(substr($key, 8, 8));
}
return $cipher1->encrypt($magic) . $cipher2->encrypt($magic) . pack("H10", "0000000000");
}
##########################################################################
# nt_hash calculates the NT hash to be used to calculate the NT response #
# It takes a password and return the 21 bytes NT password hash. #
##########################################################################
sub nt_hash($)
{
my ($passwd) = @_;
my $nt_pw = unicodify($passwd);
my $nt_hpw;
if ($Authen::Perl::NTLM::PurePerl == 1) {
$nt_hpw = md4($nt_pw) . pack("H10", "0000000000");
}
else {
my $md4 = new Digest::MD4;
$md4->add($nt_pw);
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
}
return $nt_hpw;
}
####################################################################
# negotiate_msg creates the NTLM negotiate packet given the domain #
# (from Win32::DomainName()) and the workstation name (from #
# $ENV{'COMPUTERNAME'} or Win32::NodeName()) and the negotiation #
# flags. #
####################################################################
sub negotiate_msg($$)
{
my $self = $_[0];
my $flags = pack("V", $_[1]);
my $domain = $self->{'domain'};
my $machine = $self->{'machine'};
my $msg = NTLMSSP_SIGNATURE . chr(0);
$msg .= pack("V", NTLMSSP_NEGOTIATE);
$msg .= $flags;
my $offset = length($msg) + 8*2;
$msg .= pack("v", length($domain)) . pack("v", length($domain)) . pack("V", $offset + length($machine));
$msg .= pack("v", length($machine)) . pack("v", length($machine)) . pack("V", $offset);
$msg .= $machine . $domain;
return $msg;
}
####################################################################
# challenge_msg composes the NTLM challenge message. It takes NTLM #
# Negotiation Flags as an argument. #
####################################################################
sub challenge_msg($)
{
my ($self) = @_;
my $flags = pack("V", $_[1]);
my $domain = $self->{'domain'};
my $msg = NTLMSSP_SIGNATURE . chr(0);
$self->{'cChallenge'} += 0x100;
$msg .= pack("V", NTLMSSP_CHALLENGE);
$msg .= pack("v", length($domain)) . pack("v", length($domain)) . pack("V", 48);
$msg .= $flags;
$msg .= compute_nonce($self->{'cChallenge'});
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
return unpack("v", substr($str, 0, 2));
}
###########################################################################
# auth_msg creates the NTLM response to an NTLM challenge from the #
# server. It takes 2 arguments: $nonce obtained from parse_challenge and #
# NTLM Negotiation Flags. #
# This function ASSUMEs the input of user domain, user name and #
# workstation name are in ASCII format and not in UNICODE format. #
###########################################################################
sub auth_msg($$$)
{
my ($self, $nonce) = @_;
my $session_key = session_key();
my $user_domain = $self->{'user_domain'};
my $username = $self->{'user'};
my $machine = $self->{'machine'};
my $lm_resp = calc_resp($self->{'lm_hpw'}, $nonce);
my $nt_resp = calc_resp($self->{'nt_hpw'}, $nonce);
my $flags = pack("V", $_[2]);
my $msg = NTLMSSP_SIGNATURE . chr(0);
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
#####################################################################
sub session_key
{
return "";
}
#######################################################################
# compute_nonce computes the 8-bytes nonce to be included in server's
# NTLM challenge packet.
#######################################################################
sub compute_nonce($)
{
my ($cChallenge) = @_;
my @SysTime = UNIXTimeToFILETIME($cChallenge, time);
my $Seed = (($SysTime[1] + 1) << 0) |
(($SysTime[2] + 0) << 8) |
(($SysTime[3] - 1) << 16) |
(($SysTime[4] + 0) << 24);
srand $Seed;
my $ulChallenge0 = rand(2**16)+rand(2**32);
my $ulChallenge1 = rand(2**16)+rand(2**32);
my $ulNegate = rand(2**16)+rand(2**32);
if ($ulNegate & 0x1) {$ulChallenge0 |= 0x80000000;}
if ($ulNegate & 0x2) {$ulChallenge1 |= 0x80000000;}
return pack("V", $ulChallenge0) . pack("V", $ulChallenge1);
}
#########################################################################
# convert_key converts a 7-bytes key to an 8-bytes key based on an
# algorithm.
#########################################################################
sub convert_key($) {
my ($in_key) = @_;
my @byte;
my $result = "";
usage("exactly 7-bytes key") unless length($in_key) == 7;
$byte[0] = substr($in_key, 0, 1);
$byte[1] = chr(((ord(substr($in_key, 0, 1)) << 7) & 0xFF) | (ord(substr($in_key, 1, 1)) >> 1));
$byte[2] = chr(((ord(substr($in_key, 1, 1)) << 6) & 0xFF) | (ord(substr($in_key, 2, 1)) >> 2));
$byte[3] = chr(((ord(substr($in_key, 2, 1)) << 5) & 0xFF) | (ord(substr($in_key, 3, 1)) >> 3));
$byte[4] = chr(((ord(substr($in_key, 3, 1)) << 4) & 0xFF) | (ord(substr($in_key, 4, 1)) >> 4));
$byte[5] = chr(((ord(substr($in_key, 4, 1)) << 3) & 0xFF) | (ord(substr($in_key, 5, 1)) >> 5));
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
$byte[$i] = set_odd_parity($byte[$i]);
$result .= $byte[$i];
}
return $result;
}
##########################################################################
# set_odd_parity turns one-byte into odd parity. Odd parity means that
# a number in binary has odd number of 1's.
##########################################################################
sub set_odd_parity($)
{
my ($byte) = @_;
my $parity = 0;
my $ordbyte;
usage("single byte input only") unless length($byte) == 1;
$ordbyte = ord($byte);
for (my $i = 0; $i < 8; ++$i) {
if ($ordbyte & 0x01) {++$parity;}
$ordbyte >>= 1;
}
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
$ordbyte |= 0x01;
}
}
return chr($ordbyte);
}
###########################################################################
# calc_resp computes the 24-bytes NTLM response based on the password hash
# and the nonce.
###########################################################################
sub calc_resp($$)
{
my ($key, $nonce) = @_;
my $cipher1;
my $cipher2;
my $cipher3;
usage("key must be 21-bytes long") unless length($key) == 21;
usage("nonce must be 8-bytes long") unless length($nonce) == 8;
if ($Authen::Perl::NTLM::PurePerl) {
$cipher1 = Crypt::DES_PP->new(convert_key(substr($key, 0, 7)));
$cipher2 = Crypt::DES_PP->new(convert_key(substr($key, 7, 7)));
lib/Authen/Perl/NTLM.pm view on Meta::CPAN
for ($i = 0; $i < length($str) / 2; ++$i) {
$newstr .= substr($str, 2*$i, 1);
}
return $newstr;
}
#########################################################################
# unicodify takes an ASCII string and turns it into a unicode string.
#########################################################################
sub unicodify($)
{
my ($str) = @_;
my $newstr = "";
my $i;
for ($i = 0; $i < length($str); ++$i) {
$newstr .= substr($str, $i, 1) . chr(0);
}
return $newstr;
}
##########################################################################
# UNIXTimeToFILETIME converts UNIX time_t to 64-bit FILETIME format used
# in win32 platforms. It returns two 32-bit integer. The first one is
# the upper 32-bit and the second one is the lower 32-bit. The result is
# adjusted by cChallenge as in NTLM spec. For those of you who want to
# use this function for actual use, please remove the cChallenge variable.
##########################################################################
sub UNIXTimeToFILETIME($$)
{
my ($cChallenge, $time) = @_;
$time = $time * 10000000 + 11644473600000000 + $cChallenge;
my $uppertime = $time / (2**32);
my $lowertime = $time - floor($uppertime) * 2**32;
return ($lowertime & 0x000000ff,
$lowertime & 0x0000ff00,
$lowertime & 0x00ff0000,
$lowertime & 0xff000000,
$uppertime & 0x000000ff,
( run in 0.730 second using v1.01-cache-2.11-cpan-65fba6d93b7 )