# EAP_26.pm
#
# Module for  handling Authentication via EAP type 26: MSCHAP-V2
# Hmmmm, Iana assigned 29 for MSCHAP-V2 and 
# 26 for MS-EAP-Authentication. What gives?
#
# See RFCs 2759 draft-kamath-pppext-eap-mschapv2-00.txt
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 2001 Open System Consultants
# $Id: EAP_26.pm,v 1.15 2003/11/13 10:31:08 mikem Exp $

package Radius::EAP_26;
use Radius::MSCHAP;
use strict;

# Definitions for MSCHAP Type
$Radius::EAP_26::MSCHAP_TYPE_CHALLENGE   = 1;
$Radius::EAP_26::MSCHAP_TYPE_RESPONSE    = 2;
$Radius::EAP_26::MSCHAP_TYPE_SUCCESS     = 3;
$Radius::EAP_26::MSCHAP_TYPE_FAILURE     = 4;
$Radius::EAP_26::MSCHAP_TYPE_CHANGE_PASS = 7;

#####################################################################
# request
# Called by EAP.pm when a rexquest is received for this protocol type
sub request
{
    my ($classname, $self, $context, $p, $data) = @_;

    return ($main::ACCEPT);
}

#####################################################################
# Called by EAP.pm when an EAP Response/Identity is received
sub response_identity
{
    my ($classname, $self, $context, $p) = @_;

    # Generate a MS-CHAP-V2 Challenge packet as per RFC 2759
    # Remember the challenge for later
    $context->{mschapv2_challenge} = &Radius::Util::random_string(16)
	unless defined $context->{mschapv2_challenge};
    return ($main::REJECT, 'No MSCHAP CHallenge available') 
	unless defined $context->{mschapv2_challenge};

    my $name = $main::hostname; # system name
    my $message = pack('C C n C a16 a*', 
		       $Radius::EAP_26::MSCHAP_TYPE_CHALLENGE,
		       $context->{next_id},    # MS-CHAPv2-ID
		       length($name) + 21, # MS-Length
		       16,     # value-sizelength
		       $context->{mschapv2_challenge},
		       $name);
    $self->eap_request($p->{rp}, $context, $Radius::EAP::EAP_TYPE_MSCHAPV2, $message);
    return ($main::CHALLENGE, 'EAP MSCHAP-V2 Challenge');
}

#####################################################################
# Called by EAP.pm when an EAP Response (other than Identity)
# is received
sub response
{
    my ($classname, $self, $context, $p, $type, $typedata) = @_;

    my ($mschaptype, $mschapdata) = unpack('C a*', $typedata);
    if ($mschaptype == $Radius::EAP_26::MSCHAP_TYPE_SUCCESS
	&& $context->{success})
    {
	# Client liked our MSCHAP V2 Success Request and sent an ACK,
	# so we reply with an EAP-Success
	$p->{rp}->add_attr_list($context->{last_reply_attrs});

	if ($self->{AutoMPPEKeys})
	{
	    $p->{rp}->add_attr
		('MS-MPPE-Send-Key', 
		 $p->encode_mppe_key($context->{send_key}, $p->{Client}->{Secret}));
	    $p->{rp}->add_attr
		('MS-MPPE-Recv-Key', 
		 $p->encode_mppe_key($context->{recv_key}, $p->{Client}->{Secret}));
	}
	$self->eap_success($p->{rp}, $context);
	return ($main::ACCEPT); # Success, all done
    }
    elsif ($mschaptype == $Radius::EAP_26::MSCHAP_TYPE_FAILURE)
    {
	# Client acknowledges our MSCHAP_TYPE_FAILURE request
	$self->eap_failure($p->{rp}, $context);
	return ($main::REJECT); # Failure, all done
    }
    elsif ($mschaptype == $Radius::EAP_26::MSCHAP_TYPE_RESPONSE)
    {
	my $identity = $context->{identity};
	$identity =~ s/@[^@]*$//
	    if $self->{UsernameMatchesWithoutRealm};
	if (defined $self->{RewriteUsername})
	{
	    my $rule;
	    foreach $rule (@{$self->{RewriteUsername}})
	    {
		# We use an eval so an error in the pattern wont kill us.
		eval("\$identity =~ $rule");
		&main::log($main::LOG_ERR, "Error while rewriting identity $identity: $@") 
		    if $@;
		&main::log($main::LOG_DEBUG, "Rewrote identity to $identity");
	    }
	}

	my ($user, $result, $reason) = $self->get_user($identity, $p);
	if (!$user || $result != $main::ACCEPT)
	{
	    $self->eap_failure($p->{rp}, $context);
	    return ($main::REJECT, "EAP MSCHAP V2 failed: no such user $identity");
	}

	# Got a user record for this user. Need the plaintext password now
	my $password = $self->get_plaintext_password($user);
	my ($mschapid, $mslength, $valuesize, $peerchallenge, $reserved, $response, $flags, $name) 
	    = unpack('C n C a16 a8 a24 C a*', $mschapdata);

	# Strip off any DOMAIN, else the mschapv2 auth will fail
	$name =~ s/^(.*)\\//;

	my $usersessionkey; # Returned by check_mschapv2
	my $check_result = $self->check_mschapv2
	    ($p, $name, $password, $context->{mschapv2_challenge}, 
	     $peerchallenge, $response, \$usersessionkey, undef, $context);

	if ($check_result)
	{
	    # Password must be right, send back an MSCHAP V2 Success Request
	    if ($self->{AutoMPPEKeys})
	    {
		# Compute and save the MPPE keys for later.
		($context->{send_key}, $context->{recv_key}) = 
		    &Radius::MSCHAP::mppeGetKeys($usersessionkey, $response, 16);
	    }
	    # Save the users reply items for later, when the MSCHAP_TYPE_SUCCESS comes
	    my $temp =  Radius::Radius->new($main::dictionary);
	    $temp->{rp} = Radius::Radius->new($main::dictionary);
	    $context->{last_reply_attrs} = Radius::AttrVal->new();
	    $self->authoriseUser($user, $temp);
	    $context->{last_reply_attrs}->add_attr_list($temp->{rp});

	    # Build a success request packet
	    my $authenticator_response = 
		&Radius::MSCHAP::GenerateAuthenticatorResponseHash
		($usersessionkey,
		 $response,
		 $peerchallenge,
		 $context->{mschapv2_challenge},
		 $name) . ' M=success';
	    my $message = pack('C C n a*', 
			       $Radius::EAP_26::MSCHAP_TYPE_SUCCESS,
			       $context->{this_id}, # XP MSCHAP-V2 expects the same as before!
			       length($authenticator_response) + 4,
			       $authenticator_response);
	    $self->eap_request($p->{rp}, $context, $Radius::EAP::EAP_TYPE_MSCHAPV2, $message);
	    $context->{success}++;
	    # Make sure we dont use this challenge again.
	    $context->{mschapv2_challenge} = undef;
	    return ($main::CHALLENGE, 'EAP MSCHAP V2 Challenge: Success');
	}
	else
	{
	    # Windows XP SP1 via PEAP is much happier with this. The PEAP server
	    # code detects the inner EAP failure and then does an acknowledged
	    # fail handshake
	    $self->eap_failure($p->{rp}, $context);
	    return ($main::REJECT, 'EAP MSCHAP-V2 Authentication failure');

	    # Authentication failed, send an EAP/MSCHAPV2/Fail as per 
	    # draft-kamath-pppext-eap-mschapv2-00.txt
	    # Client will ACK this
#	    my $errormsg = 'E=691 R=0 V=3 M=Authentication Failed';
#	    my $message = pack('C C n a*',
#			       $Radius::EAP_26::MSCHAP_TYPE_FAILURE,
#			       $context->{this_id},
#			       length($errormsg) + 4,
#			       $errormsg);
#	    $self->eap_request($p->{rp}, $context, $Radius::EAP::EAP_TYPE_MSCHAPV2, $message);
#	    return ($main::CHALLENGE, 'EAP MSCHAP-V2 Challenge: Fail');
	}
    }
    elsif ($mschaptype == $Radius::EAP_26::MSCHAP_TYPE_CHANGE_PASS)
    {
	$self->eap_failure($p->{rp}, $context);
	return ($main::REJECT, 'EAP MSCHAP-V2 Change-Password not suported');
    }
    else
    {
	$self->eap_failure($p->{rp}, $context);
	return ($main::IGNORE, "EAP MSCHAP-V2 unknown mschaptype $mschaptype");
    }
}

1;