[Catalyst-commits] r9655 - in Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support: . lib/Catalyst/Authentication/Credential

abraxxa at dev.catalyst.perl.org abraxxa at dev.catalyst.perl.org
Fri Apr 3 16:25:01 BST 2009


Author: abraxxa
Date: 2009-04-03 16:25:01 +0100 (Fri, 03 Apr 2009)
New Revision: 9655

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/README
   Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Todo
   Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm
Log:
cleaned up NTLM support
added POD for NTLM support


Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes	2009-04-03 02:55:15 UTC (rev 9654)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Changes	2009-04-03 15:25:01 UTC (rev 9655)
@@ -1,5 +1,6 @@
+1.00999_02  2009-04-03
    - Add debug when a user is found, but passwords don't match (abraxxa)
-   - Added NTLM support
+   - Added NTLM support (abraxxa)
 
 1.009  2009-01-04
    - Remove use of _config accessor, which I'd stupidly cargo-culted. 

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-03 02:55:15 UTC (rev 9654)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Makefile.PL	2009-04-03 15:25:01 UTC (rev 9655)
@@ -11,8 +11,12 @@
 requires 'Test::MockObject';
 requires 'URI::Escape';
 requires 'Class::Accessor::Fast';
-requires 'Authen::NTLM::HTTP' => '0.31';
+requires 'namespace::clean' => 0.11;
 
+feature  'NTLM support',
+    -default        => 0,
+    'Authen::NTLM'  => '0.31';
+
 resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Authentication-Credential-HTTP';
 
 auto_install;

Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/README
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/README	2009-04-03 02:55:15 UTC (rev 9654)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/README	2009-04-03 15:25:01 UTC (rev 9655)
@@ -9,7 +9,7 @@
             Authentication::Credential::HTTP
         /;
 
-        __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
+        __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'ntlm', 'digest' or 'basic'
         __PACKAGE__->config->{authentication}{users} = {
             Mufasa => { password => "Circle Of Life", },
         };

Modified: Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Todo
===================================================================
--- Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Todo	2009-04-03 02:55:15 UTC (rev 9654)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/Todo	2009-04-03 15:25:01 UTC (rev 9655)
@@ -2,6 +2,5 @@
 . Test 'algorithm' config / MD5-sess properly.
 . Full implementation of MD5-sess with remote authentication service.
 . Domain option should be able to be passed as config.
-. Support for NTLM auth?
 . Config verification / validation on construction.
-. Test all config parameters (esp username_field)
\ No newline at end of file
+. Test all config parameters (esp username_field)

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-03 02:55:15 UTC (rev 9654)
+++ Catalyst-Authentication-Credential-HTTP/1.000/branches/ntlm_support/lib/Catalyst/Authentication/Credential/HTTP.pm	2009-04-03 15:25:01 UTC (rev 9655)
@@ -8,9 +8,18 @@
 use URI::Escape    ();
 use Catalyst       ();
 use Digest::MD5    ();
-use Authen::NTLM;
-use Authen::NTLM::HTTP;
 
+BEGIN {
+    eval {
+        use Authen::NTLM;
+        use Authen::NTLM::HTTP;
+    };
+
+    *NTLM_SUPPORT = $@ ? sub () { 0 } : sub () { 1 };
+}
+
+use namespace::clean;
+
 __PACKAGE__->mk_accessors(qw/
     _config 
     authorization_required_message 
@@ -20,12 +29,15 @@
     realm 
     algorithm 
     use_uri_for
-    ntlm_domain
-    ntlm_version
+    http_realm
 /);
 
-our $VERSION = '1.009_01';
+__PACKAGE__->mk_accessors(qw/
+    ntlm_domain
+/) if NTLM_SUPPORT;
 
+our $VERSION = '1.00999_02';
+
 sub new {
     my ($class, $config, $app, $realm) = @_;
     
@@ -43,8 +55,11 @@
 sub init {
     my ($self) = @_;
     my $type = $self->type || 'any';
-    
-    if (!grep /$type/, ('basic', 'digest', 'ntlm', 'any')) {
+
+    my @available_types = ('basic', 'digest', 'any');
+    unshift (@available_types, 'ntlm') if NTLM_SUPPORT;
+
+    if (!grep /$type/, @available_types) {
         Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
     }
     $self->type($type);
@@ -54,8 +69,11 @@
     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;
+    # don't try NTLM auth if NTLM support isn't available
+    if (NTLM_SUPPORT) {
+        $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;
@@ -198,8 +216,14 @@
 sub authenticate_ntlm {
     my ( $self, $c, $realm, $auth_info ) = @_;
     
+    die "Authen::NTLM needs to be installed to use NTLM authentication."
+        unless NTLM_SUPPORT;
+
     $c->log->debug('Checking http ntlm authentication.') if $c->debug;
-    my @authorization = $c->req->header('Authorization');
+    my $ntlm_domain = $self->_build_ntlm_domain;
+    
+    my $headers       = $c->req->headers;
+    my @authorization = $headers->header('Authorization');
     foreach my $authorization (@authorization) {
         # find NTLM authorization headers
         next unless $authorization =~ m{^NTLM};
@@ -208,37 +232,37 @@
         my $ntlm_msg = $authorization;
         $ntlm_msg =~ s/^NTLM //;
     
-        my $server = Authen::NTLM::HTTP->new_server(undef, $self->ntlm_domain);
+        my $server = Authen::NTLM::HTTP->new_server(undef, $ntlm_domain);
 
-        my ($flags, $domain, $machine);
-        my ($lm_resp, $nt_resp, $user_domain, $username);
+        my ($t1_flags, $t1_domain, $t1_machine);
+        my ($t3_flags, $t3_lm_resp, $t3_nt_resp, $t3_user_domain, $t3_username, $t3_machine);
 
         # 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);
+            ($t1_flags, $t1_domain, $t1_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) =
+                ($t3_flags, $t3_lm_resp, $t3_nt_resp, $t3_user_domain, $t3_username, $t3_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;
+                $c->log->debug("NTLM type 3 msg received: flags: $t3_flags\ndomain: $t3_user_domain\nuser: $t3_username\nmachine: $t3_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;
+            if ($t3_user_domain ne $ntlm_domain) {
+                    $c->log->debug("NTLM client domain $t3_user_domain doesn't match ours $ntlm_domain") if $c->debug;
                     return;
                 }
 
-                my $user_obj = $realm->find_user( { $self->username_field => $username }, $c);
+                my $user_obj = $realm->find_user( { $self->username_field => $t3_username }, $c);
                 
                 if ($user_obj) {
                     return $user_obj;
@@ -251,9 +275,9 @@
         }
         # 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;
+            $c->log->debug("NTLM type 1 msg received: flags: $t1_flags\ndomain: $t1_domain\nmachine: $t1_machine\n") if $c->debug;
             # send NTLM type 2 message
-            $self->_create_ntlm_challenge_response($c, $server, $flags);
+            $self->_create_ntlm_challenge_response($c, $server, $t1_flags);
         }
     }
 }
@@ -269,10 +293,32 @@
 sub _is_http_auth_type {
     my ( $self, $type ) = @_;
     my $cfgtype = lc( $self->type );
-    return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
+    # any means just digest + basic
+    return 1 if ($cfgtype eq 'any' && ($type eq 'digest' || $type eq 'basic')) || $cfgtype eq lc $type;
     return 0;
 }
 
+sub _build_http_realm {
+    my ($self, $auth_info) = @_;
+    # returns the http realm name
+    # the order of preference is:
+    # - passed realm name to ->authenticate
+    # - configured http_realm
+    # - name of your Catalyst authentication realm
+    return $auth_info->{realm} || $self->http_realm || $self->realm->name;
+}
+
+sub _build_ntlm_domain {
+    my ($self, $auth_info) = @_;
+    
+    my $ntlm_domain = $auth_info->{ntlm_domain} || $self->ntlm_domain;
+    
+    die "ntlm_domain needs to be set in your credential configuration or passed to your authenticate/authenticate_ntlm call for NTLM to work!"
+        unless defined $ntlm_domain;
+    
+    return $ntlm_domain;
+}
+
 sub authorization_required_response {
     my ( $self, $c, $realm, $auth_info ) = @_;
 
@@ -289,14 +335,16 @@
 
     # *DONT* short circuit
     my $ok;
-    $ok++ if $self->_create_ntlm_auth_response($c, $auth_info);
+    if (NTLM_SUPPORT) {
+        $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);
 
     unless ( $ok ) {
         die 'Could not build authorization required response. '
         . 'Did you configure a valid authentication http type: '
-        . 'basic, digest, any';
+        . 'ntlm, digest, basic, any';
     }
     return;
 }
@@ -361,7 +409,7 @@
 
 sub _build_auth_header_realm {
     my ( $self, $c, $opts ) = @_;    
-    if ( my $realm_name = String::Escape::qprintable($opts->{realm} ? $opts->{realm} : $self->realm->name) ) {
+    if ( my $realm_name = String::Escape::qprintable($self->_build_http_realm($opts)) ) {
         $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
         return 'realm=' . $realm_name;
     } 
@@ -398,8 +446,7 @@
 }
 
 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
+    # a plain 'NTLM' is sent to the client to let it know we support NTLM
     return 'NTLM';
 }
 
@@ -410,6 +457,8 @@
         | Authen::NTLM::NTLMSSP_NEGOTIATE_NTLM
         | Authen::NTLM::NTLMSSP_NEGOTIATE_UNICODE;
     my $challenge_msg = $server->http_challenge($flags);
+    # strip part of the http header generated by Authen::NTLM::HTTP
+    # because we handle the header generation ourselves
     $challenge_msg =~ s/^WWW-Authenticate: NTLM //;
 
     $c->log->debug("NTLM type 2 message: $challenge_msg") if $c->debug;
@@ -501,7 +550,7 @@
 
 =head1 NAME
 
-Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
+Catalyst::Authentication::Credential::HTTP - HTTP NTLM, Digest and Basic authentication
 for Catalyst.
 
 =head1 SYNOPSIS
@@ -516,9 +565,14 @@
             example => { 
                 credential => { 
                     class => 'HTTP',
-                    type  => 'any', # or 'digest' or 'basic'
+                    type  => 'any', # or 'ntlm', 'digest' or 'basic'
+                    # any means just digest + basic to stay backward compatible
                     password_type  => 'clear',
-                    password_field => 'password'
+                    password_field => 'password',
+                    # this is the text shown as title of the browser popup
+                    http_realm => 'MyApp',
+                    # for ntlm you need to specify the Windows domain name
+                    ntlm_domain => 'YOURCOMPANY',
                 },
                 store => {
                     class => 'Minimal',
@@ -539,8 +593,17 @@
         # RFC 2617 sense) is overridden here, but this *does not* 
         # effect the Catalyst::Authentication::Realm used for 
         # authentication - to do that, you need 
-        # $c->authenticate({}, 'otherrealm')
+        # $c->authenticate(undef, 'otherrealm');
+        
+        # if your default authentication realm is setup to do NTLM but you
+        # don't want to include the ntlm_domain in your config file because
+        # you need multiple domains you can pass it here as well:
+        # $c->authenticate({ ntlm_domain => 'DOMAIN1' });
 
+        # and of course if the NTLM auth realm is not your default one
+        # you can pass that one too:
+        # $c->authenticate({ ntlm_domain => 'DOMAIN1' }, 'realm_using_ntlm');
+
         do_stuff();
     }
     
@@ -560,8 +623,8 @@
 =head1 DESCRIPTION
 
 This module lets you use HTTP authentication with
-L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
-are currently supported.
+L<Catalyst::Plugin::Authentication>. Currently NTLM, Digest and Basic
+authentication are supported.
 
 When authentication is required, this module sets a status of 401, and
 the body of the response to 'Authorization required.'. To override
@@ -600,10 +663,10 @@
 Tries to authenticate the user, and if that fails calls
 C<authorization_required_response> and detaches the current action call stack.
 
-Looks inside C<< $c->request->headers >> and processes the digest and basic
-(badly named) authorization header.
+Looks inside C<< $c->request->headers >> and processes the contained
+authorization header.
 
-This will only try the methods set in the configuration. First digest, then basic.
+This will only try the methods set in the configuration. First NTLM, Digest then Basic.
 
 The %auth_info hash can contain a number of keys which control the authentication behaviour:
 
@@ -613,6 +676,7 @@
 
 Sets the HTTP authentication realm presented to the client. Note this does not alter the
 Catalyst::Authentication::Realm object used for the authentication.
+If using NTLM this has to be the Windows domain name.
 
 =item domain
 
@@ -640,16 +704,21 @@
 
 =item authenticate_digest $c, $realm, \%auth_info
 
-Performs HTTP digest authentication. Note that the password_type B<must> by I<clear> for
-digest authentication to succeed, and you must have L<Catalyst::Plugin::Session> in
-your application as digest authentication needs to store persistent data.
+Performs HTTP Digest authentication. Note that the password_type B<must> by I<clear> for
+Digest authentication to succeed, and you must have L<Catalyst::Plugin::Session> in
+your application as Digest authentication needs to store persistent data.
 
 Note - if you do not want to store your user passwords as clear text, then it is possible
-to store instead the MD5 digest in hex of the string '$username:$realm:$password' 
+to store instead the MD5 Digest in hex of the string '$username:$realm:$password' 
 
 Takes an additional parameter of I<algorithm>, the possible values of which are 'MD5' (the default)
 and 'MD5-sess'. For more information about 'MD5-sess', see section 3.2.2.2 in RFC 2617.
 
+=item authenticate_ntlm $c, $realm, \%auth_info
+
+Performs HTTP NTLM authentication.
+Authen::NTLM has to be installed, else this will die.
+
 =item authorization_required_response $c, $realm, \%auth_info
 
 Sets C<< $c->response >> to the correct status code, and adds the correct
@@ -658,13 +727,13 @@
 Typically used by C<authenticate>, but may be invoked manually.
 
 %opts can contain C<domain> and C<algorithm>, which are used to build
-%the digest header.
+%the Digest header.
 
 =item store_digest_authorization_nonce $c, $key, $nonce
 
 =item get_digest_authorization_nonce $c, $key
 
-Set or get the C<$nonce> object used by the digest auth mode.
+Set or get the C<$nonce> object used by the Digest auth mode.
 
 You may override these methods. By default they will call C<get> and C<set> on
 C<< $c->cache >>.
@@ -681,7 +750,7 @@
 
 =item type
 
-Can be either C<any> (the default), C<basic> or C<digest>.
+Can be either C<any> (the default), C<ntlm>, C<digest> or C<basic>.
 
 This controls C<authorization_required_response> and C<authenticate>, but
 not the "manual" methods.
@@ -715,7 +784,7 @@
 
 =head1 RESTRICTIONS
 
-When using digest authentication, this module will only work together
+When using Digest authentication, this module will only work together
 with authentication stores whose User objects have a C<password>
 method that returns the plain-text password. It will not work together
 with L<Catalyst::Authentication::Store::Htpasswd>, or




More information about the Catalyst-commits mailing list