view release on metacpan or  search on metacpan

AuthCookieDBI.pm  view on Meta::CPAN

	# Login location.
	<Files LOGIN>
		AuthType Apache::AuthCookieDBI
		AuthName WhatEver
		SetHandler perl-script
		PerlHandler Apache::AuthCookieDBI->login
	</Files>

=head1 DESCRIPTION

This module is an authentication handler that uses the basic mechanism provided
by Apache::AuthCookie with a DBI database for ticket-based protection.  It
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
#===============================================================================

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

sub _log_not_set {
    my ( $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    return $r->log_error(
        "Apache::AuthCookieDBI: $variable not set for auth realm
$auth_name", $r->uri
    );
}

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

sub _dir_config_var {
    my ( $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.

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

    my %c;    # config variables hash

=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<Apache::Authcookie> for the directives required for any kind
of Apache::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.

=cut

    unless ( $c{DBI_DSN} = _dir_config_var $r, 'DBI_DSN' ) {
        _log_not_set $r, 'DBI_DSN';
        return;
    }

=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
=cut

    unless ( $c{DBI_SecretKey} = _dir_config_var $r, 'DBI_SecretKey'
        or _dir_config_var $r, 'DBI_SecretKeyFile' )
    {
        _log_not_set $r, 'DBI_SecretKey or DBI_SecretKeyFile';
        return;
    }

=item C<WhatEverDBI_User>

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

=cut

    $c{DBI_user} = _dir_config_var( $r, 'DBI_User' )
      || undef;

=item C<WhatEverDBI_Password>

The password to use to access the database.  This is not required
and defaults to undef.

=cut

    $c{DBI_password} = _dir_config_var( $r, 'DBI_Password' )
      || undef;

=item C<WhatEverDBI_UsersTable>

The table that user names and passwords are stored in.  This is not
required and defaults to 'users'.

=cut

    $c{DBI_userstable} = _dir_config_var( $r, 'DBI_UsersTable' )
      || 'users';

=item C<WhatEverDBI_UserField>

The field in the above table that has the user name.  This is not
required and defaults to 'user'.

=cut

    $c{DBI_userfield} = _dir_config_var( $r, 'DBI_UserField' )
      || 'user';

=item C<WhatEverDBI_PasswordField>

The field in the above table that has the password.  This is not
required and defaults to 'password'.

=cut

    $c{DBI_passwordfield} = _dir_config_var( $r, 'DBI_PasswordField' )
      || 'password';

=item C<WhatEverDBI_CryptType>

What kind of hashing is used on the password field in the database.  This can
be 'none', 'crypt', or 'md5'.  This is not required and defaults to 'none'.

=cut

    $c{DBI_crypttype} = _dir_config_var( $r, 'DBI_CryptType' )
      || 'none';

=item C<WhatEverDBI_GroupsTable>

The table that has the user / group information.  This is not required and
defaults to 'groups'.

=cut

    $c{DBI_groupstable} = _dir_config_var( $r, 'DBI_GroupsTable' )
      || 'groups';

=item C<WhatEverDBI_GroupField>

The field in the above table that has the group name.  This is not required
and defaults to 'grp' (to prevent conflicts with the SQL reserved word 'group').

=cut

    $c{DBI_groupfield} = _dir_config_var( $r, 'DBI_GroupField' )
      || 'grp';

=item C<WhatEverDBI_GroupUserField>

The field in the above table that has the user name.  This is not required
and defaults to 'user'.

=cut

    $c{DBI_groupuserfield} = _dir_config_var( $r, 'DBI_GroupUserField' )
      || 'user';

=item C<WhatEverDBI_SecretKeyFile - DEPRECATED>

The file that contains the secret key (on the first line of the file).  This
is required and has no default value.  This key should be owned and only
readable by root.  It is read at server startup time.  The key should be long
and fairly random.  If you want, you can change it and restart the server,
(maybe daily), which will invalidate all prior-issued tickets.

This directive MUST be set before the PerlModule line that loads this module,
because the secret key file is read immediately (at server start time).  This
is so you can have it owned and only readable by root even though Apache
then changes to another user.

I suggest using DBI_SecretKey instead.

=cut

    unless ( $c{DBI_secretkeyfile} = _dir_config_var $r, 'DBI_SecretKeyFile'
        or _dir_config_var $r, 'DBI_SecretKey' )
    {
        _log_not_set $r, 'DBI_SecretKeyFile or DBI_SecretKey';
        return;
    }

=item C<WhatEverDBI_EncryptionType>

What kind of encryption to use to prevent the user from looking at the fields
in the ticket we give them.  This is almost completely useless, so don't
switch it on unless you really know you need it.  It does not provide any
protection of the password in transport; use SSL for that.  It can be 'none',
'des', 'idea', 'blowfish', or 'blowfish_pp'.

This is not required and defaults to 'none'.

=cut

    $c{DBI_encryptiontype} = _dir_config_var( $r, 'DBI_EncryptionType' )
      || 'none';

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

=item C<WhatEverDBI_SessionLifetime>

How long tickets are good for after being issued.  Note that presently
Apache::AuthCookie does not set a client-side expire time, which means that
most clients will only keep the cookie until the user quits the browser.
However, if you wish to force people to log in again sooner than that, set
this value.  This can be 'forever' or a life time specified as:

	DD-hh-mm-ss -- Days, hours, minute and seconds to live.

This is not required and defaults to '00-24-00-00' or 24 hours.

=cut

    $c{DBI_sessionlifetime} = _dir_config_var( $r, 'DBI_SessionLifetime' )
      || '00-24-00-00';

    return %c;
}

#-------------------------------------------------------------------------------
# _now_year_month_day_hour_minute_second -- Return a string with the time in
# this order separated by dashes.

sub _now_year_month_day_hour_minute_second {
    return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now;
}

#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.

sub _percent_encode {
    my ($str) = @_;
    $str =~ s/([^\w])/ uc sprintf '%%%02x', ord $1 /eg;
    return $str;
}