view release on metacpan or  search on metacpan

lib/Apache2/AuthCookieDBI.pm  view on Meta::CPAN

#===============================================================================
#
# Apache2::AuthCookieDBI
#
# An AuthCookie module backed by a DBI database.
#
# See end of this file for Copyright notices.
#
# Author:  Jacob Davies <jacob@well.com>
# Maintainer: Matisse Enzer <matisse@cpan.org> (as of version 2.0)
#
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#===============================================================================

package Apache2::AuthCookieDBI;

use strict;
use warnings;
use 5.010_000;
our $VERSION = '2.19';

use Apache2::AuthCookie;
use base qw( Apache2::AuthCookie );

use Apache2::RequestRec;
use DBI;
use Apache2::Log;
use Apache2::Const -compile => qw( OK HTTP_FORBIDDEN SERVER_ERROR :log );
use Apache2::ServerUtil;
use Carp qw();
use Digest::MD5 qw( md5_hex );
use Date::Calc qw( Today_and_Now Add_Delta_DHMS );

# Also uses Crypt::CBC if you're using encrypted cookies.
# Also uses Apache2::Session if you're using sessions.
use English qw(-no_match_vars);

#===============================================================================
# FILE (LEXICAL)  G L O B A L S
#===============================================================================

my %CIPHERS = ();

# Stores Cipher::CBC objects in $CIPHERS{ idea:AuthName },
# $CIPHERS{ des:AuthName } etc.

use constant COLON_REGEX => qr/ : /mx;
use constant DATE_TIME_STRING_REGEX =>
    qr/ \A \d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2} \z /mx;
use constant EMPTY_STRING                 => q{};
use constant HEX_STRING_REGEX             => qr/ \A [0-9a-fA-F]+ \z /mx;
use constant HYPHEN_REGEX                 => qr/ - /mx;
use constant PERCENT_ENCODED_STRING_REGEX => qr/ \A [a-zA-Z0-9_\%]+ \z /mx;
use constant THIRTY_TWO_CHARACTER_HEX_STRING_REGEX =>
    qr/  \A [0-9a-fA-F]{32} \z /mx;
use constant TRUE             => 1;
use constant WHITESPACE_REGEX => qr/ \s+ /mx;
use constant LOG_TYPE_AUTH    => 'authentication';
use constant LOG_TYPE_AUTHZ   => 'authorization';
use constant LOG_TYPE_SYSTEM  => 'system';
use constant LOG_TYPE_TIMEOUT => 'timeout';

#===============================================================================
# P E R L D O C
#===============================================================================

=head1 NAME

Apache2::AuthCookieDBI - An AuthCookie module backed by a DBI database.

=head1 COMPATIBILITY

Starting with version 2.03, this module is in the Apache2::* namespace,
L<Apache2::AuthCookieDBI>.  For F<mod_perl 1.x> versions,
there is still L<Apache::AuthCookieDBI>.

=head1 SYNOPSIS

    # In httpd.conf or .htaccess
    
    # Optional: Initiate a persistent database connection using Apache::DBI.
    # See: http://search.cpan.org/dist/Apache-DBI/
    # If you choose to use Apache::DBI then the following directive must come
    # before all other modules using DBI - just uncomment the next line:
    #PerlModule Apache::DBI  
   
    PerlModule Apache2::AuthCookieDBI
    PerlSetVar WhatEverPath /
    PerlSetVar WhatEverLoginScript /login.pl

    # Optional, to share tickets between servers.
    PerlSetVar WhatEverDomain .domain.com
    
    # These must be set
    PerlSetVar WhatEverDBI_DSN "DBI:mysql:database=test"
    PerlSetVar WhatEverDBI_SecretKey "489e5eaad8b3208f9ad8792ef4afca73598ae666b0206a9c92ac877e73ce835c"

    # These are optional, the module sets sensible defaults.
    PerlSetVar WhatEverDBI_User "nobody"
    PerlSetVar WhatEverDBI_Password "password"
    PerlSetVar WhatEverDBI_UsersTable "users"
    PerlSetVar WhatEverDBI_UserField "user"
    PerlSetVar WhatEverDBI_PasswordField "password"
    PerlSetVar WhatEverDBI_UserActiveField "" # Default is skip this feature

lib/Apache2/AuthCookieDBI.pm  view on Meta::CPAN

is based on two tokens being provided, a username and password, which can
be any strings (there are no illegal characters for either).  The username is
used to set the remote user as if Basic Authentication was used.

On an attempt to access a protected location without a valid cookie being
provided, the module prints an HTML login form (produced by a CGI or any
other handler; this can be a static file if you want to always send people
to the same entry page when they log in).  This login form has fields for
username and password.  On submitting it, the username and password are looked
up in the DBI database.  The supplied password is checked against the password
in the database; the password in the database can be plaintext, or a crypt()
or md5_hex() checksum of the password.  If this succeeds, the user is issued
a ticket.  This ticket contains the username, an issue time, an expire time,
and an MD5 checksum of those and a secret key for the server.  It can
optionally be encrypted before returning it to the client in the cookie;
encryption is only useful for preventing the client from seeing the expire
time.  If you wish to protect passwords in transport, use an SSL-encrypted
connection.  The ticket is given in a cookie that the browser stores.

After a login the user is redirected to the location they originally wished
to view (or to a fixed page if the login "script" was really a static file).

On this access and any subsequent attempt to access a protected document, the
browser returns the ticket to the server.  The server unencrypts it if
encrypted tickets are enabled, then extracts the username, issue time, expire
time and checksum.  A new checksum is calculated of the username, issue time,
expire time and the secret key again; if it agrees with the checksum that
the client supplied, we know that the data has not been tampered with.  We
next check that the expire time has not passed.  If not, the ticket is still
good, so we set the username.

Authorization checks then check that any "require valid-user" or "require
user jacob" settings are passed.  Finally, if a "require group foo" directive
was given, the module will look up the username in a groups database and
check that the user is a member of one of the groups listed.  If all these
checks pass, the document requested is displayed.

If a ticket has expired or is otherwise invalid it is cleared in the browser
and the login form is shown again.

=cut

#===============================================================================
# P R I V A T E   F U N C T I O N S
#===============================================================================

# Get the cipher from the cache, or create a new one if the
# cached cipher hasn't been created.
sub _get_cipher_for_type {
    my ( $class, $dbi_encryption_type, $auth_name, $secret_key ) = @_;
    my $lc_encryption_type = lc $dbi_encryption_type;
    my $message;

    if ( exists $CIPHERS{"$lc_encryption_type:$auth_name"} ) {
        return $CIPHERS{"$lc_encryption_type:$auth_name"};
    }

    my %cipher_for_type = (
        des => sub {
            return $CIPHERS{"des:$auth_name"}
                || Crypt::CBC->new( -key => $secret_key, -cipher => 'DES' );
        },
        idea => sub {
            return $CIPHERS{"idea:$auth_name"}
                || Crypt::CBC->new( -key => $secret_key, -cipher => 'IDEA' );
        },
        blowfish => sub {
            return $CIPHERS{"blowfish:$auth_name"}
                || Crypt::CBC->new(
                -key    => $secret_key,
                -cipher => 'Blowfish'
                );
        },
        blowfish_pp => sub {
            return $CIPHERS{"blowfish_pp:$auth_name"}
                || Crypt::CBC->new(
                -key    => $secret_key,
                -cipher => 'Blowfish_PP'
                );
        },
    );
    my $code_ref = $cipher_for_type{$lc_encryption_type}
        || Carp::confess("Unsupported encryption type: '$dbi_encryption_type'");
    my $cbc_object = $code_ref->();

    # Cache the object. Caught bug where we were not, thanks to unit tests.
    $CIPHERS{"$lc_encryption_type:$auth_name"} = $cbc_object;

    return $cbc_object;
}

sub _encrypt_session_key {
    my $class               = shift;
    my $session_key         = shift;
    my $secret_key          = shift;
    my $auth_name           = shift;
    my $dbi_encryption_type = lc shift;
    my $message;

    if ( !defined $dbi_encryption_type ) {
        Carp::confess('$dbi_encryption_type must be defined.');
    }

    if ( $dbi_encryption_type eq 'none' ) {
        return $session_key;
    }

    my $cipher = $class->_get_cipher_for_type( $dbi_encryption_type, $auth_name,
        $secret_key );
    my $encrypted_key = $cipher->encrypt_hex($session_key);
    return $encrypted_key;
}

#-------------------------------------------------------------------------------
# _log_not_set -- Log that a particular authentication variable was not set.

sub _log_not_set {
    my ( $class, $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    my $message   = "${class}\t$variable not set for auth realm $auth_name";
    $class->logger( $r, Apache2::Const::LOG_ERR, $message, undef,
        LOG_TYPE_SYSTEM, $r->uri );
    return;
}

#-------------------------------------------------------------------------------
# _dir_config_var -- Get a particular authentication variable.

sub _dir_config_var {
    my ( $class, $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    return $r->dir_config("$auth_name$variable");
}

#-------------------------------------------------------------------------------
# _dbi_config_vars -- Gets the config variables from the dir_config and logs
# errors if required fields were not set, returns undef if any of the fields
# had errors or a hash of the values if they were all OK.  Takes a request
# object.

my %CONFIG_DEFAULT = (
    DBI_DSN             => undef,
    DBI_SecretKey       => undef,
    DBI_User            => undef,
    DBI_Password        => undef,
    DBI_UsersTable      => 'users',
    DBI_UserField       => 'user',
    DBI_PasswordField   => 'password',
    DBI_UserActiveField => EMPTY_STRING,    # Default is don't use this feature
    DBI_CryptType       => 'none',
    DBI_GroupsTable     => 'groups',
    DBI_GroupField      => 'grp',
    DBI_GroupUserField  => 'user',
    DBI_EncryptionType  => 'none',
    DBI_SessionLifetime => '00-24-00-00',
    DBI_sessionmodule   => 'none',
);

sub _dbi_config_vars {
    my ( $class, $r ) = @_;

    my %c;    # config variables hash
    foreach my $variable ( keys %CONFIG_DEFAULT ) {
        my $value_from_config = $class->_dir_config_var( $r, $variable );
        $c{$variable}
            = defined $value_from_config
            ? $value_from_config
            : $CONFIG_DEFAULT{$variable};
        if ( !defined $c{$variable} ) {
            $class->_log_not_set( $r, $variable );
        }
    }

    # If we used encryption we need to pull in Crypt::CBC.
    if ( $c{'DBI_EncryptionType'} ne 'none' ) {
        require Crypt::CBC;
    }

    # Compile module for password encryption, if needed.
    if ( $c{'DBI_CryptType'} =~ /^sha/ ) {
        require Digest::SHA;
    }

    return %c;
}

=head1 APACHE CONFIGURATION DIRECTIVES

All configuration directives for this module are passed in PerlSetVars.  These
PerlSetVars must begin with the AuthName that you are describing, so if your
AuthName is PrivateBankingSystem they will look like:

    PerlSetVar PrivateBankingSystemDBI_DSN "DBI:mysql:database=banking"

See also L<Apache2::Authcookie> for the directives required for any kind
of Apache2::AuthCookie-based authentication system.

In the following descriptions, replace "WhatEver" with your particular
AuthName.  The available configuration directives are as follows:

=over 4

=item C<WhatEverDBI_DSN>

Specifies the DSN for DBI for the database you wish to connect to retrieve
user information.  This is required and has no default value.

=item C<WhateverDBI_SecretKey>

Specifies the secret key for this auth scheme.  This should be a long
random string.  This should be secret; either make the httpd.conf file
only readable by root, or put the PerlSetVar in a file only readable by
root and include it.

This is required and has no default value.  (NOTE: In AuthCookieDBI versions
1.22 and earlier the secret key either could be set in the configuration file
itself or it could be placed in a separate file with the path configured with
C<PerlSetVar WhateverDBI_SecretKeyFile>.

As of version 2.0, you must use C<WhateverDBI_SecretKey> and not
C<PerlSetVar WhateverDBI_SecretKeyFile>.

If you want to put the secret key in a separate file then you can create a
separate file that uses C<PerlSetVar WhateverDBI_SecretKey> and include that
file in your main Apache configuration using Apaches' C<Include>
directive. You might wish to make the file not
world-readable. Also, make sure that the Perl environment variables are
not publically available, for example via the /perl-status handler.)
See also L</"COMPATIBILITY"> in this man page.


=item C<WhatEverDBI_User>

The user to log into the database as.  This is not required and
defaults to undef.