Authen-NTLM-HTTP
view release on metacpan or search on metacpan
lib/Authen/NTLM/HTTP.pm view on Meta::CPAN
'cChallenge' => 0 # a counter to stir the seed to generate random
}, $package; # number for the nonce
}
####################################################################
# http_negotiate creates a NTLM-over-HTTP tag line for NTLM #
# negotiate packet given the domain (from Win32::DomainName()) and #
# the workstation name (from $ENV{'COMPUTERNAME'} or #
# Win32::NodeName()) and the negotiation flags. #
####################################################################
sub http_negotiate($$)
{
my $self = shift;
my $flags = shift;
my $str = encode_base64($self->SUPER::negotiate_msg($flags));
$str =~ s/\s//g;
return "Authorization: NTLM " . $str;
}
###########################################################################
# http_parse_negotiate parses the NTLM-over-HTTP negotiate tag line and #
# return a list of NTLM Negotiation Flags, Server Network Domain and #
# Machine name of the client. #
###########################################################################
sub http_parse_negotiate($$)
{
my ($self, $pkt) = @_;
$pkt =~ s/Authorization: NTLM //;
my $str = decode_base64($pkt);
return $self->SUPER::parse_negotiate($str);
}
####################################################################
# http_challenge composes the NTLM-over-HTTP challenge tag line. It#
# takes NTLM Negotiation Flags as an argument. #
####################################################################
sub http_challenge($$)
{
my $self = $_[0];
my $flags = $_[1];
my $nonce = undef;
my $str;
$nonce = $_[2] if @_ == 3;
if (defined $nonce) {
$str = encode_base64($self->SUPER::challenge_msg($flags, $nonce));
}
else {
lib/Authen/NTLM/HTTP.pm view on Meta::CPAN
return $self->SUPER::parse_challenge($str);
}
###########################################################################
# http_auth creates the NTLM-over-HTTP 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 http_auth($$$)
{
my $self = shift;
my $nonce = shift;
my $flags = shift;
my $str = encode_base64($self->SUPER::auth_msg($nonce, $flags));
$str =~ s/\s//g;;
if ($self->{'type'} eq NTLMSSP_HTTP_PROXY) {
return "Proxy-Authorization: NTLM " . $str;
}
else {
return "Authorization: NTLM " . $str;
}
}
###########################################################################
# http_parse_auth parses the NTLM-over-HTTP authentication tag line and #
# return a list of NTLM Negotiation Flags, LM response, NT response, User #
# Domain, User Name, User Machine Name and Session Key. #
###########################################################################
sub http_parse_auth($$)
{
my ($self, $pkt) = @_;
if ($self->{'type'} eq NTLMSSP_HTTP_PROXY) {
$pkt =~ s/Proxy-Authorization: NTLM //;
}
else {
$pkt =~ s/Authorization: NTLM //;
}
my $str = decode_base64($pkt);
return $self->SUPER::parse_auth($str);
lib/Authen/NTLM/HTTP/Base.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::NTLM(\$lm_hpw, \$nt_hpw\) or\nnew_client Authen::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/NTLM/HTTP/Base.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/NTLM/HTTP/Base.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::NTLM::HTTP::Base::PurePerl == 1) {
$nt_hpw = md4($nt_pw) . pack("H10", "0000000000");
}
else {
my $md4 = new Digest::MD4;
$md4->add($nt_pw);
lib/Authen/NTLM/HTTP/Base.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;
}
###########################################################################
# parse_negotiate parses the NTLM negotiate and return a list of NTLM #
# Negotiation Flags, Server Network Domain and Machine name of the client.#
###########################################################################
sub parse_negotiate($$)
{
my ($self, $pkt) = @_;
substr($pkt, 0, 8) eq (NTLMSSP_SIGNATURE . chr(0)) or usage "NTLM Negotiate doesn't contain NTLMSSP_SIGNATURE!\n";
my $type = GetInt32(substr($pkt, 8));
$type == NTLMSSP_NEGOTIATE or usage "Not an NTLM Negotiate Message!\n";
my $flags = GetInt32(substr($pkt, 12));
my $domain = GetString($pkt, 16);
my $machine = GetString($pkt, 24);
return ($flags, $domain, $machine);
}
####################################################################
# challenge_msg composes the NTLM challenge message. It takes NTLM #
# Negotiation Flags as an argument. #
####################################################################
sub challenge_msg($$)
{
my $self = $_[0];
my $flags = pack("V", $_[1]);
my $nonce = undef;
$nonce = $_[2] if @_ == 3;
my $domain = $self->{'domain'};
my $msg = NTLMSSP_SIGNATURE . chr(0);
$self->{'cChallenge'} += 0x100;
$msg .= pack("V", NTLMSSP_CHALLENGE);
if ($_[1] & NTLMSSP_TARGET_TYPE_DOMAIN) {
lib/Authen/NTLM/HTTP/Base.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/NTLM/HTTP/Base.pm view on Meta::CPAN
$msg .= $flags . $user_domain . $username . $machine . $lm_resp . $nt_resp . $session_key;
}
return $msg;
}
###########################################################################
# parse_auth parses the NTLM authentication and return a list of NTLM #
# Negotiation Flags, LM response, NT response, User Domain, User Name, #
# User Machine Name and Session Key. #
###########################################################################
sub parse_auth($$)
{
my ($self, $pkt) = @_;
substr($pkt, 0, 8) eq (NTLMSSP_SIGNATURE . chr(0)) or usage "NTLM Authentication doesn't contain NTLMSSP_SIGNATURE!\n";
my $type = GetInt32(substr($pkt, 8));
$type == NTLMSSP_AUTH or usage "Not an NTLM Authetication Message!\n";
my $lm_resp = GetString($pkt, 12);
my $nt_resp = GetString($pkt, 20);
my $flags = GetInt32(substr($pkt, 60));
my $user_domain = GetString($pkt, 28);
$user_domain = un_unicodify($user_domain) if $flags & NTLMSSP_NEGOTIATE_UNICODE;
lib/Authen/NTLM/HTTP/Base.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/NTLM/HTTP/Base.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/NTLM/HTTP/Base.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::NTLM::HTTP::Base::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/NTLM/HTTP/Base.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.353 second using v1.01-cache-2.11-cpan-a5abf4f5562 )