# -*- perl -*-
# NTLM_PP.pm - Pure perl implementation of NTLM. In this version, I only
# implemented the client side functions that calculates the NTLM response.
# I will add the corresponding server side functions in the next version.
#

package Crypt::NTLM_PP;

use strict;
use Carp;
use Crypt::DES_PP;
use Digest::Perl::MD4;
use integer;
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_resp lm_resp);
$VERSION = '0.10';

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

sub lm_resp($$);
sub nt_resp($$);
sub calc_resp($$);

#########################################################################
# lm_resp calculates the LM response for NTLM. It takes the nonce and 
# the user password to compute the 24-bytes LM response.
#########################################################################
sub lm_resp($$)
{
    my ($passwd, $nonce) = @_;
    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
    my $key = convert_key(substr($lm_pw, 0, 7)) . convert_key(substr($lm_pw, 7, 7));
    my $cipher1 = Crypt::DES_PP->new(substr($key, 0, 8));
    my $cipher2 = Crypt::DES_PP->new(substr($key, 8, 8));
    my $lm_hpw = $cipher1->encrypt($magic) . $cipher2->encrypt($magic) . pack("H10", "0000000000");
    return calc_resp($lm_hpw, $nonce);
} 

#########################################################################
# nt_resp calculates the NT response for NTLM. It takes the nonce and 
# the user password to compute the 24-bytes NT response.
#########################################################################
sub nt_resp($$)
{
    my ($passwd, $nonce) = @_;
    my $nt_pw = unicodify($passwd);
    my $nt_hpw = md4($nt_pw) . pack("H10", "0000000000");
    return calc_resp($nt_hpw, $nonce);
}

#########################################################################
# 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));
    $byte[6] = chr(((ord(substr($in_key, 5, 1)) << 2) & 0xFF) | (ord(substr($in_key, 6, 1)) >> 6));
    $byte[7] = chr((ord(substr($in_key, 6, 1)) << 1) & 0xFF);
    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) = @_; 
    usage("key must be 21-bytes long") unless length($key) == 21;
    usage("nonce must be 8-bytes long") unless length($nonce) == 8;
    my $cipher1 = Crypt::DES_PP->new(convert_key(substr($key, 0, 7)));
    my $cipher2 = Crypt::DES_PP->new(convert_key(substr($key, 7, 7)));
    my $cipher3 = Crypt::DES_PP->new(convert_key(substr($key, 14, 7)));
    return $cipher1->encrypt($nonce) . $cipher2->encrypt($nonce) . $cipher3->encrypt($nonce);
}

#########################################################################
# 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;
}

1;

__END__

=head1 NAME

Crypt::DES_PP - Perl extension for NTLM related computations

=head1 SYNOPSIS

use Crypt::NTLM_PP;

    $my_pass = "mypassword";
    $nt_resp = nt_resp($my_pass, $nonce);
    $lm_resp = lm_resp($my_pass, $nonce);

=head1 DESCRIPTION

The NTLM (Windows NT LAN Manager) authentication scheme is the authentication
algorithm used by Microsoft. 

NTLM authentication scheme is used in DCOM and HTTP environment. 
It is used to authenticate DCE RPC packets in DCOM. It is also used to
authenticate HTTP packets to MS Web Proxy or MS Web Server.

Currently, it is the authentication scheme Internet Explorer chooses to
authenticate itself to proxies/web servers that supports NTLM.

As of this version, NTLM_PP module only provides the client side functions
to calculate NT response and LM response. The next revision will provide
the server side functions that computes the nonce and verify the NTLM responses.

To use this module, please install the Crypt::DES_PP and Digest::MD4 modules
first.

=head1 BUGS

Nothing known.

=head1 AUTHOR

This implementation was written by Yee Man Chan (ymc@yahoo.com).
Copyright (c) 2002 Yee Man Chan. All rights reserved. This program 
is free software; you can redistribute it and/or modify it under 
the same terms as Perl itself. 

=head1 SEE ALSO

Digest::MD4(3), Crypt::DES(3), perl(1), m4(1).

=cut

Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
tab-width: 4
End: