# -*- perl -*-
# NTLM.pm - An 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 Authen::NTLM::HTTP;

use strict;
use POSIX;
use Carp;
use MIME::Base64;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require DynaLoader;

*import = \&Exporter::import;

@ISA = qw (Exporter DynaLoader Authen::NTLM);
@EXPORT = qw ();
@EXPORT_OK = qw ();
$VERSION = '0.31';

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

# Flags to indicate whether we are talking to web server or proxy
use constant NTLMSSP_HTTP_WWW => "WWW";
use constant NTLMSSP_HTTP_PROXY => "Proxy";

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

#########################################################################
# 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::HTTP(\$lm_hpw, \$nt_hpw\) or\nnew_client Authen::NTLM::HTTP\(\$lm_hpw, \$nt_hpw, \$type, \$user, \$user_domain, \$domain, \$machine\)") unless @_ == 3 or @_ == 4 or @_ == 8;
    my ($package, $lm_hpw, $nt_hpw, $type, $user, $user_domain, $domain, $machine) = @_;
    srand time;
    if (not defined($type)) {$type = NTLMSSP_HTTP_WWW;}
    if (not defined($user)) {$user = $ENV{'USERNAME'};}
    if (not defined($user_domain)) {$user_domain = $ENV{'USERDOMAIN'};}
    if (not defined($domain)) {$domain = Win32::DomainName();}
    if (not defined($machine)) {$machine = $ENV{'COMPUTERNAME'};}
    usage("LM hash must be 21-bytes long") unless length($lm_hpw) == 21;
    usage("NT hash must be 21-bytes long") unless length($nt_hpw) == 21;
    defined($user) or usage "Undefined User Name!\n";
    defined($user_domain) or usage "Undefined User Domain!\n";
    defined($domain) or usage "Undefined Network Domain!\n";
    defined($machine) or usage "Undefined Computer Name!\n";
    my $ctx_id = pack("V", rand 2**32);
    bless {
	'type' => $type,
	'user' => $user,
	'user_domain' => $user_domain,
	'domain' => $domain,
	'machine' => $machine,
	'lm_hpw' => $lm_hpw,
	'nt_hpw' => $nt_hpw
          }, $package;
}

###########################################################################
# new_server instantiate a NTLM server that composes an NTLM challenge    #
# It can take one argument for the server network domain. If the argument #
# is not supplied, it will call Win32::DomainName to obtain it.           #
###########################################################################
sub new_server {
    usage("new_server Authen::NTLM::HTTP or\nnew_server Authen::NTLM::HTTP(\$type, \$domain\)") unless @_ == 1 or @_ == 2 or @_ == 3;
    my ($package, $type, $domain) = @_;
    if (not defined($type)) {$type = NTLMSSP_HTTP_WWW;}
    if (not defined($domain)) {$domain = Win32::DomainName();}
    defined($domain) or usage "Undefined Network Domain!\n";
    bless {
	'type' => $type,
        'domain' => $domain,
	'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 {
	$str = encode_base64($self->SUPER::challenge_msg($flags));
    }
    $str =~ s/\s//g;
    return $self->{'type'} . "-Authenticate: NTLM " . $str;
}

###########################################################################
# http_parse_challenge parses the NTLM-over-HTTP challenge tag line and   #
# return a list of server network domain, NTLM Negotiation Flags, Nonce,  #
# ServerContextHandleUpper and ServerContextHandleLower.                  #
########################################################################### 
sub http_parse_challenge
{
    my ($self, $pkt) = @_;
    my $str = $self->{'type'} . "-Authenticate: NTLM ";
    $pkt =~ s/$str//;
    $str = decode_base64($pkt);
    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);
}

1;

__END__

=head1 NAME

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

=head1 Background

NTLM-over-HTTP Handshake

Stage 1: Client requests a web page.

    1: C  --> S   GET ...

Stage 2: Server responds and says the client needs to authenticate in NTLM manner.
    
    2: C <--  S   401 Unauthorized
                  WWW-Authenticate: NTLM

Stage 3: Client responds with NTLM negotiate message that contains the identity and the domain of the client.
    
    3: C  --> S   GET ...
                  Authorization: NTLM <base64-encoded type-1-message>
    
Stage 4: Server challenges the client with a 8-bytes random number in the NTLM challenge message.

    4: C <--  S   401 Unauthorized
                  WWW-Authenticate: NTLM <base64-encoded type-2-message>

Stage 5: Client responds with a reply that uses its password to encrypt the 8-bytes random number.
    
    5: C  --> S   GET ...
                  Authorization: NTLM <base64-encoded type-3-message>
   
Stage 6: Authentication success. Server replies with the web page.
 
    6: C <--  S   200 Ok

=head1 SYNOPSIS

use Authen::NTLM (nt_hash lm_hash);
use Authen::NTLM::HTTP;

    $my_pass = "mypassword";
# Note: To instantiate a client talking to a proxy, do 
# $client = new_client Authen::NTLM::HTTP(lm_hash($my_pass), nt_hash($my_pass), Authen::NTLM::HTTP::NTLMSSP_HTTP_PROXY);
    $client = new_client Authen::NTLM::HTTP(lm_hash($my_pass), nt_hash($my_pass));

# Stage 3 scenario: creates NTLM negotiate message and then
# append $negotiate_msg to one of the tag lines in your HTTP
# request header

# To compose a NTLM Negotiate Packet
    $flags = Authen::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_OEM_DOMAIN_SUPPLIED
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_OEM_WORKSTATION_SUPPLIED
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_NTLM
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_UNICODE
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_OEM
    $negotiate_msg = $client->http_negotiate($flags);

# Stage 4 scenario: extract the line contains "Authorization: NTLM "
# in the HTTP header.
# Parses NTLM negotiate message and then generates
# the NTLM challenge message.

# To instantiate a server to parse a NTLM negotiation
# and compose a NTLM challenge
# Note: To instantiate a proxy, do 
# $server = new_server Authen::NTLM::HTTP(Authen::NTLM::HTTP::NTLMSSP_HTTP_PROXY);
    $server = new_server Authen::NTLM::HTTP;

    ($flags, $domain, $machine) = 
	$server->http_parse_negotiate($negotiate_msg);

    $flags = Authen::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_NTLM
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_UNICODE;
    $challenge_msg = $server->http_challenge($flags);

# Stage 5 Scenario: Client receives NTLM challenge message
# Extract the line that contains "WWW-Authenticate: NTLM "
# Pass it to http_parse_challenge to obtain the nonce
# Then use nonce to compose reply with http_auth

# client parse NTLM challenge
    ($domain, $flags, $nonce, $ctx_upper, $ctx_lower) = 
	$client->http_parse_challenge($challenge_msg);

# To compose a NTLM Response Packet
    $flags = Authen::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_NTLM
	   | Authen::NTLM::NTLMSSP_NEGOTIATE_UNICODE
	   | Authen::NTLM::NTLMSSP_REQUEST_TARGET;
    $auth_msg = $client->http_auth($nonce, $flags);

# Stage 6 Scenario: Finally the server parses the reply
# verify the authentication credentials.

# To parse a NTLM Response Packet
    ($flags, $lm_resp, $nt_resp, $user_domain, $username, $machine) =
	$server->http_parse_auth($auth_msg);

=head1 DESCRIPTION

This is an extension of the Authen::NTLM module written by 
Yee Man Chan. It was written due to popular requests. 
Yee Man Chan never tests it in any production environment
but he is confident that it should work as expected.

=head1 DEPENDENCIES

To use this module, please install the following two modules:

1) Authen::NTLM module by Yee Man Chan (UMVUE)

2) MIME::Base64 module by Gisle Aas (GAAS).


=head1 TO-DO

Supposedly this implementation is complete. Improvements will be done
on the underlying Authen::NTLM module. However, if you figure out
something I missed, feel free to let me know.

=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

Authen::NTLM(3), MIME::Base64(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: