File Coverage

blib/lib/Authen/NTLM/HTTP.pm

Criterion	Covered	Total	%
statement	168	181	92.8
branch	20	40	50.0
condition	4	12	33.3
subroutine	45	46	97.8
pod	0	9	0.0
total	237	288	82.2

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

*import = \&Exporter::import;

use base qw/Authen::NTLM::HTTP::Base/;
@EXPORT = qw ();
@EXPORT_OK = qw ();
$VERSION = '0.33';

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