[Catalyst-commits] r9647 - in
Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support:
. lib/Catalyst/Authentication/Credential
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Fri Apr 3 00:47:54 BST 2009
Author: t0m
Date: 2009-04-03 00:47:54 +0100 (Fri, 03 Apr 2009)
New Revision: 9647
Modified:
Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes
Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Makefile.PL
Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm
Log:
patch from epic nopaste
Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes 2009-04-02 23:44:19 UTC (rev 9646)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes 2009-04-02 23:47:54 UTC (rev 9647)
@@ -1,3 +1,6 @@
+ - Add debug when a user is found, but passwords don't match (abraxxa)
+ - Added NTLM support
+
1.009 2009-01-04
- Remove use of _config accessor, which I'd stupidly cargo-culted.
As we don't ever run in auth back-compat mode, we can store
Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Makefile.PL
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Makefile.PL 2009-04-02 23:44:19 UTC (rev 9646)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Makefile.PL 2009-04-02 23:47:54 UTC (rev 9647)
@@ -11,6 +11,7 @@
requires 'Test::MockObject';
requires 'URI::Escape';
requires 'Class::Accessor::Fast';
+requires 'Authen::NTLM::HTTP' => '0.31';
resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Authentication-Credential-HTTP';
Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm 2009-04-02 23:44:19 UTC (rev 9646)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm 2009-04-02 23:47:54 UTC (rev 9647)
@@ -8,6 +8,8 @@
use URI::Escape ();
use Catalyst ();
use Digest::MD5 ();
+use Authen::NTLM;
+use Authen::NTLM::HTTP;
__PACKAGE__->mk_accessors(qw/
_config
@@ -18,9 +20,11 @@
realm
algorithm
use_uri_for
+ ntlm_domain
+ ntlm_version
/);
-our $VERSION = '1.009';
+our $VERSION = '1.00999_01';
sub new {
my ($class, $config, $app, $realm) = @_;
@@ -40,7 +44,7 @@
my ($self) = @_;
my $type = $self->type || 'any';
- if (!grep /$type/, ('basic', 'digest', 'any')) {
+ if (!grep /$type/, ('basic', 'digest', 'ntlm', 'any')) {
Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
}
$self->type($type);
@@ -50,6 +54,9 @@
my ( $self, $c, $realm, $auth_info ) = @_;
my $auth;
+ $auth = $self->authenticate_ntlm($c, $realm, $auth_info) if $self->_is_http_auth_type('ntlm');
+ return $auth if $auth;
+
$auth = $self->authenticate_digest($c, $realm, $auth_info) if $self->_is_http_auth_type('digest');
return $auth if $auth;
@@ -188,6 +195,69 @@
return;
}
+sub authenticate_ntlm {
+ my ( $self, $c, $realm, $auth_info ) = @_;
+
+ $c->log->debug('Checking http ntlm authentication.') if $c->debug;
+ my @authorization = $c->req->header('Authorization');
+ foreach my $authorization (@authorization) {
+ # find NTLM authorization headers
+ next unless $authorization =~ m{^NTLM};
+
+ # strip NTLM from the ntlm $negotiation message
+ my $ntlm_msg = $authorization;
+ $ntlm_msg =~ s/^NTLM //;
+
+ my $server = Authen::NTLM::HTTP->new_server(undef, $self->ntlm_domain);
+
+ my ($flags, $domain, $machine);
+ my ($lm_resp, $nt_resp, $user_domain, $username);
+
+ # find out the type of the received NTLM message
+ eval {
+ # try to parse NTLM type 1 message
+ ($flags, $domain, $machine) = $server->http_parse_negotiate($ntlm_msg);
+ };
+
+ # if an error occurred it wasn't a type 1 message
+ if ($@) {
+ eval {
+ # try to parse NTLM type 3 message
+ ($flags, $lm_resp, $nt_resp, $user_domain, $username, $machine) =
+ $server->http_parse_auth($ntlm_msg);
+ };
+ if ($@) {
+ $c->log->error("unknown NTLM message received");
+ }
+ else {
+ $c->log->debug("NTLM type 3 msg received: flags: $flags\ndomain: $user_domain\nuser: $username\nmachine: $machine\n") if $c->debug;
+
+ # check if the configured domain matches the clients one
+ if ($user_domain ne $self->ntlm_domain) {
+ $c->log->debug("NTLM client domain doesn't match ours") if $c->debug;
+ return;
+ }
+
+ my $user_obj = $realm->find_user( { $self->username_field => $username }, $c);
+
+ if ($user_obj) {
+ return $user_obj;
+ }
+ else {
+ $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
+ return;
+ }
+ }
+ }
+ # else it was a type 1 message
+ else {
+ $c->log->debug("NTLM type 1 msg received: flags: $flags\ndomain: $domain\nmachine: $machine\n") if $c->debug;
+ # send NTLM type 2 message
+ $self->_create_ntlm_challenge_response($c, $server, $flags);
+ }
+ }
+}
+
sub _check_cache {
my $c = shift;
@@ -219,6 +289,7 @@
# *DONT* short circuit
my $ok;
+ $ok++ if $self->_create_ntlm_auth_response($c, $auth_info);
$ok++ if $self->_create_digest_auth_response($c, $auth_info);
$ok++ if $self->_create_basic_auth_response($c, $auth_info);
@@ -236,6 +307,32 @@
return;
}
+sub _create_ntlm_auth_response {
+ my ( $self, $c, $opts ) = @_;
+
+ return unless $self->_is_http_auth_type('ntlm');
+
+ if ( my $ntlm = $self->_build_ntlm_auth_header( $c, $opts ) ) {
+ _add_authentication_header( $c, $ntlm );
+ return 1;
+ }
+
+ return;
+}
+
+sub _create_ntlm_challenge_response {
+ my ( $self, $c, $server, $flags ) = @_;
+
+ return unless $self->_is_http_auth_type('ntlm');
+
+ if ( my $ntlm = $self->_build_ntlm_challenge_header( $c, $server, $flags ) ) {
+ _add_authentication_header( $c, $ntlm );
+ return 1;
+ }
+
+ return;
+}
+
sub _create_digest_auth_response {
my ( $self, $c, $opts ) = @_;
@@ -300,6 +397,26 @@
return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
}
+sub _build_ntlm_auth_header {
+ my ( $self, $c, $opts ) = @_;
+ # a plain 'NTLM' is sent to the client to let him know we want him to do NTLM
+ return 'NTLM';
+}
+
+sub _build_ntlm_challenge_header {
+ my ( $self, $c, $server, $flags ) = @_;
+
+ $flags = Authen::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN
+ | Authen::NTLM::NTLMSSP_NEGOTIATE_NTLM
+ | Authen::NTLM::NTLMSSP_NEGOTIATE_UNICODE;
+ my $challenge_msg = $server->http_challenge($flags);
+ $challenge_msg =~ s/^WWW-Authenticate: NTLM //;
+
+ $c->log->debug("NTLM type 2 message: $challenge_msg") if $c->debug;
+
+ return _join_auth_header_parts( NTLM => $challenge_msg );
+}
+
sub _build_digest_auth_header {
my ( $self, $c, $opts ) = @_;
More information about the Catalyst-commits
mailing list