Apache2::AuthenNTLM::Cookie - Store NTLM identity in a cookie

  <Location /my/secured/URL>
    PerlAuthenHandler Apache2::AuthenNTLM::Cookie
    AuthType ntlm
    PerlAddVar ntdomain "domain primary_domain_controller other_controller"
    ...    # see other configuration params in Apache2::AuthenNTLM
  </Location>

  <Location /my/secured/URL>
    PerlAuthenHandler Apache2::AuthenNTLM::Cookie
    AuthType ntlm
    PerlAddVar ntdomain "domain primary_domain_controller other_controller"
  </Location>

   PerlSetVar cookie_name my_cookie_name    # default is NTLM_AUTHEN
   PerlSetVar domain      my_cookie_domain  # default is none
   PerlSetVar expires     my_cookie_expires # default is none
   PerlSetVar path        my_cookie_path    # default is none
   PerlSetVar refresh     some_seconds      # default is 14400 (4 hours)
   PerlSetVar secret      my_secret_string  # default from stat(config file)

    perldoc Apache2::AuthenNTLM::Cookie

# see doc at end of file

package Apache2::AuthenNTLM::Cookie;

use strict;
use warnings;

use Apache2::RequestRec        ();
use Apache2::Request;
use Apache2::Cookie;
use Apache2::Directive         ();
use Apache2::Const -compile => qw(OK HTTP_UNAUTHORIZED) ;
use Digest::SHA1               qw(sha1_hex);
use MIME::Base64               ();

use Apache2::AuthenNTLM;

our $VERSION = '1.02';

# constants from NTLM protocol
use constant NEGOTIATE_UNICODE     => 0x00000001;
use constant NEGOTIATE_NTLM        => 0x00000200;
use constant TARGET_TYPE_DOMAIN    => 0x00010000;
use constant NEGOTIATE_TARGET_INFO => 0x00800000;
use constant NTLM_SIGNATURE        => "NTLMSSP";
use constant NTLM_FORMAT           => "a8 V a8 V a8 a8 a8";

# named fields corresponding to format above
my @NTLM_FIELDS = qw/signature msg_type target_name flags 
                     challenge context target_info/;

# cookie format: digest(40); time_created(12); username
use constant COOKIE_FORMAT         => "A40 A12 A*"; 


sub handler : method  {
  my ($class, $r) = @_ ;

  # create an instance
  my $self = bless {
    request     => $r,
    secret      => $r->dir_config('secret')      || $class->default_secret,
    refresh     => $r->dir_config('refresh')     || 14400, # in seconds
    cookie_name => $r->dir_config('cookie_name') || 'NTLM_AUTHEN',
   }, $class;

  my $result;

  # get the cookie
  my $jar    = Apache2::Cookie::Jar->new($r);
  my $cookie = $jar->cookies($self->{cookie_name});
  my $has_valid_cookie = $cookie && $self->validate_cookie($cookie->value);

  # if cookie is present and valid
  if ($has_valid_cookie) {
    $result = Apache2::Const::OK;

    # if MSIE "optimization" is activated, i.e. if this is a POST with an
    # NTLM type1 message and without body ... 
    if ($r->method eq 'POST' && $self->has_empty_body && $self->is_NTLM_msg1) {

      # ... then we must fake a type2 msg so that MSIE will post again
      $r->log->debug("AuthenNTLM::Cookie: creating fake type2 msg");
      $self->add_auth_header($self->fake_NTLM_msg2);
      $result = Apache2::Const::HTTP_UNAUTHORIZED;
    }
  }

  # otherwise (if cookie is absent or invalid)
  else {

    # if no NTLM message, directly ask for authentication (avoid calling
    # Apache2::AuthenNTLM because it pollutes the error log)
    if (!$self->get_NTLM_msg && $self->is_ntlmauthoritative) {
      $self->ask_for_authentication;
      $result = Apache2::Const::HTTP_UNAUTHORIZED;
    }

    # else invoke Apache2::AuthenNTLM to go through the NTLM handshake    
    else {
      my $msg = $cookie ? "cookie invalidated" : "no cookie";
      $r->log->debug("AuthenNTLM::Cookie: $msg, calling Apache2::AuthenNTLM");
      $result = Apache2::AuthenNTLM->handler($r); # will set $r->user

      # create the cookie if NTLM succeeded
      $self->set_cookie if $result == Apache2::Const::OK;
    }
  }

  return $result;
}


sub validate_cookie {
  my ($self, $cookie_val) = @_;

  # unpack cookie information
  my ($sha, $time_created, $username) = unpack COOKIE_FORMAT, $cookie_val;

  # valid if not too old and matches the SHA1 digest
  my $now = time;
  my $is_valid 
    =  ($now - $time_created) < $self->{refresh}
    && $sha eq sha1_hex($time_created, $username, $self->{secret});

  # if valid, set the username
  $self->{request}->user($username) if $is_valid;

  $self->{request}->log->debug("cookie $cookie_val is " . 
                                 ($is_valid ? "valid" : "invalid"));
  return $is_valid;
}


sub set_cookie {
  my ($self) = @_;

  # prepare a new cookie from current time and current user
  my $r           = $self->{request};
  my $username    = $r->user; # was just set from the parent handler
  my $now         = time;
  my $sha         = sha1_hex($now, $username, $self->{secret});
  my $cookie_val  = pack COOKIE_FORMAT, $sha, $now, $username;
  my @cookie_args = (-name => $self->{cookie_name}, -value => $cookie_val);

  # other cookie args may come from apache config
 ARG:
  foreach my $arg (qw/expires domain path/) {
    my $val = $r->dir_config($arg) or next ARG;
    push @cookie_args, -$arg => $val;
  }

  # send cookie
  my $cookie = Apache2::Cookie->new($r, @cookie_args);
  $cookie->bake($r);

  $r->log->debug("AuthenNTLM::Cookie: baked cookie $cookie_val");
}


sub default_secret {
  my ($class) = @_;

  # default secret : mtime and i-node of Apache configuration file
  my $config_file     = Apache2::Directive::conftree->filename;
  my ($mtime, $inode) = (stat $config_file)[9, 1];
  return $mtime . $inode;
}


sub has_empty_body {
  my $self = shift;

  my $content_length = $self->{request}->headers_in->{"Content-Length"};
  if (defined $content_length && !$content_length) {
    return 1;
  }
  else {
    my $apr_req        = Apache2::Request->new($self->{request});
    my $body_apr_table = $apr_req->body;
    return !$body_apr_table || !scalar(keys %$body_apr_table);
  }
}


sub get_NTLM_msg {
  my $self         = shift;
  my $r            = $self->{request};
  my $header_field = $r->proxyreq ? 'Proxy-Authorization' : 'Authorization';
  my $auth_header  = $r->headers_in->{$header_field};

  if ($auth_header && $auth_header =~ s/^NTLM//) {
    my $packed = MIME::Base64::decode($auth_header);
    my %NTLM_msg;
    @NTLM_msg{@NTLM_FIELDS} = unpack NTLM_FORMAT, $packed;
    return \%NTLM_msg;
  }

  return;
}


sub is_NTLM_msg1 {
  my $self = shift;
  my $NTLM_msg = $self->get_NTLM_msg;
  return $NTLM_msg && $NTLM_msg->{msg_type} == 1;
}


sub fake_NTLM_msg2 {
  my $self = shift;

  my %NTLM_msg = (
    signature => NTLM_SIGNATURE,
    msg_type  => 2,
    flags     => NEGOTIATE_UNICODE  | NEGOTIATE_NTLM |
                 TARGET_TYPE_DOMAIN | NEGOTIATE_TARGET_INFO,
   );

  no warnings 'uninitialized';
  my $packed = pack NTLM_FORMAT, @NTLM_msg{@NTLM_FIELDS};

  return "NTLM " . MIME::Base64::encode($packed, '');
}


sub ask_for_authentication {
  my $self = shift;

  my $r      = $self->{request};
  my $auth_type = $r->auth_type || 'NTLM,Basic';

  $self->add_auth_header('NTLM') 
    if $auth_type =~ /\bNTLM\b/i;
  $self->add_auth_header(sprintf 'Basic realm="%s"', $r -> auth_name || '')
    if $auth_type =~ /\bBasic\b/i;
}


sub add_auth_header {
  my ($self, $header) = @_;

  my $r           = $self->{request};
  my $header_name = $r->proxyreq ? 'Proxy-Authenticate' : 'WWW-Authenticate';
  $r->err_headers_out->add($header_name => $header);
}


sub is_ntlmauthoritative {
  my $self = shift;

  my $r      = $self->{request};
  my $config = $r->dir_config('ntlmauthoritative') || 'on';
  return $config =~ /^(on|1)$/i;
}


1; # End of Apache2::AuthenNTLM::Cookie


__END__