[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