view release on metacpan or  search on metacpan

lib/Authen/Perl/NTLM.pm  view on Meta::CPAN

use POSIX;
use Carp;
$Authen::Perl::NTLM::PurePerl = undef; # a flag to see if we load pure perl 
                                       # DES and MD4 modules
eval "require Crypt::DES && require Digest::MD4";
if ($@) {
    eval "require Crypt::DES_PP && require Digest::Perl::MD4";
    if ($@) {
	die "Required DES and/or MD4 module doesn't exist!\n";
    }
    else {
        $Authen::Perl::NTLM::PurePerl = 1;
    }
}
else {
    $Authen::Perl::NTLM::PurePerl = 0;
}

if ($Authen::Perl::NTLM::PurePerl == 1) {
    require Crypt::DES_PP;
    Crypt::DES_PP->import;
    require Digest::Perl::MD4;
    import Digest::Perl::MD4 qw(md4);
}
else {
    require Crypt::DES;
    Crypt::DES->import;
    require Digest::MD4;
    import Digest::MD4;
}
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require DynaLoader;

*import = \&Exporter::import;

@ISA = qw (Exporter DynaLoader);
@EXPORT = qw ();
@EXPORT_OK = qw (nt_hash lm_hash calc_resp);
$VERSION = '0.12';

# Stolen from Crypt::DES.
sub usage {
    my ($package, $filename, $line, $subr) = caller (1);
    $Carp::CarpLevel = 2;
    croak "Usage: $subr (@_)";
}

# These constants are stolen from samba-2.2.4 and other sources
use constant NTLMSSP_SIGNATURE => 'NTLMSSP';

# NTLMSSP Message Types
use constant NTLMSSP_NEGOTIATE => 1;
use constant NTLMSSP_CHALLENGE => 2;
use constant NTLMSSP_AUTH      => 3;
use constant NTLMSSP_UNKNOWN   => 4; 

# NTLMSSP Flags

# Text strings are in unicode
use constant NTLMSSP_NEGOTIATE_UNICODE                  => 0x00000001;
# Text strings are in OEM 
use constant NTLMSSP_NEGOTIATE_OEM                      => 0x00000002;
# Server should return its authentication realm 
use constant NTLMSSP_REQUEST_TARGET                     => 0x00000004;
# Request signature capability 
use constant NTLMSSP_NEGOTIATE_SIGN                     => 0x00000010; 
# Request confidentiality
use constant NTLMSSP_NEGOTIATE_SEAL                     => 0x00000020;
# Use datagram style authentication
use constant NTLMSSP_NEGOTIATE_DATAGRAM                 => 0x00000040;
# Use LM session key for sign/seal
use constant NTLMSSP_NEGOTIATE_LM_KEY                   => 0x00000080;
# NetWare authentication
use constant NTLMSSP_NEGOTIATE_NETWARE                  => 0x00000100;
# NTLM authentication
use constant NTLMSSP_NEGOTIATE_NTLM                     => 0x00000200;
# Domain Name supplied on negotiate
use constant NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED      => 0x00001000;
# Workstation Name supplied on negotiate
use constant NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED => 0x00002000;
# Indicates client/server are same machine
use constant NTLMSSP_NEGOTIATE_LOCAL_CALL               => 0x00004000;
# Sign for all security levels
use constant NTLMSSP_NEGOTIATE_ALWAYS_SIGN              => 0x00008000;
# TargetName is a domain name
use constant NTLMSSP_TARGET_TYPE_DOMAIN                 => 0x00010000;
# TargetName is a server name
use constant NTLMSSP_TARGET_TYPE_SERVER                 => 0x00020000;
# TargetName is a share name
use constant NTLMSSP_TARGET_TYPE_SHARE                  => 0x00040000;
# TargetName is a share name
use constant NTLMSSP_NEGOTIATE_NTLM2                    => 0x00080000;
# get back session keys
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) = @_;
    srand time;
    if (not defined($user)) {$user = $ENV{'USERNAME'};}
    if (not defined($user_domain)) {$user_domain = $ENV{'USERDOMAIN'};}

lib/Authen/Perl/NTLM.pm  view on Meta::CPAN

    for (my $i = 0; $i < 8; ++$i) {
	$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;
    }
    $ordbyte = ord($byte);
    if ($parity % 2 == 0) {
	if ($ordbyte & 0x01) {
	    $ordbyte &= 0xFE;
	}
	else {
	    $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)));
	$cipher3 = Crypt::DES_PP->new(convert_key(substr($key, 14, 7)));
    }
    else {
	$cipher1 = Crypt::DES->new(convert_key(substr($key, 0, 7)));
	$cipher2 = Crypt::DES->new(convert_key(substr($key, 7, 7)));
	$cipher3 = Crypt::DES->new(convert_key(substr($key, 14, 7)));
    }
    return $cipher1->encrypt($nonce) . $cipher2->encrypt($nonce) . $cipher3->encrypt($nonce);
}

#########################################################################
# un_unicodify takes a unicode string and turns it into an ASCII string.
# CAUTION: This function is intended to be used with unicodified ASCII
# strings.
#########################################################################
sub un_unicodify
{
   my ($str) = @_;
   my $newstr = "";
   my $i;

   usage("$str must be a string of even length to be un_unicodify!: $!\n") if length($str) % 2;

   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,
	    $uppertime & 0x0000ff00,
	    $uppertime & 0x00ff0000,
	    $uppertime & 0xff000000);
}

1;

__END__

=head1 NAME

Authen::Perl::NTLM - Perl extension for NTLM related computations

=head1 SYNOPSIS

use Authen::Perl::NTLM qw(nt_hash lm_hash);

    $my_pass = "mypassword";
    $client = new_client Authen::Perl::NTLM(lm_hash($my_pass), nt_hash($my_pass));

# To compose a NTLM Negotiate Packet
    $flags = Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_80000000 
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_128
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_NTLM
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_UNICODE
	   | Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_OEM