view release on metacpan or  search on metacpan

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

# 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