############################################################
#
#   $Id$
#   Apache2::AuthColloquy - mod_perl authentication against the Colloquy users.lua file
#
#   Copyright 2005,2006 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################

package Apache2::AuthColloquy;
# vim:ts=4:sw=4:tw=78

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use MD5;
use mod_perl2;
use Colloquy::Data qw(:all);

require Exporter;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
$VERSION = '1.13' || sprintf('%d.%02d', q$Revision: 1.12 $ =~ /(\d+)/g);

# Test for the version of mod_perl, and use the appropriate libraries
require Apache2::Access;
require Apache2::Connection;
require Apache2::Log;
require Apache2::RequestRec;
require Apache2::RequestUtil;
use Apache2::Const -compile => qw(HTTP_UNAUTHORIZED OK DECLINED);

# Handles Apache requests
sub handler {
	my $r = shift;

	my ($result, $password) = $r->get_basic_auth_pw;
	return $result if $result;

	my $user = $r->user;
	my $users_lua = $r->dir_config('users_lua') || '/usr/local/colloquy/data';
	my $allowaltauth = $r->dir_config('AllowAlternateAuth') || 'no';

	# remove the domainname if logging in from winxp
	## Parse $name's with Domain\Username
	my $domain = '';
	if ($user =~ m|(\w+)[\\/](.+)|) {
		($domain, $user) = ($1, $2);
	}

	# Check that the username doesn't contain characters
	# denied by Colloquy in main.lua
	if ($user =~ /\[\!\;\'\:\@\?\,\`\.\]\s/) {
		$r->note_basic_auth_failure;
		$r->log_error(
			"user $user: invalid username contains disallowed characters ",
			$r->uri);
		return (lc($allowaltauth) eq "yes" ? Apache2::Const::DECLINED : Apache2::Const::HTTP_UNAUTHORIZED);
	}

	# Check we have a password
	unless (length($password)) {
		$r->note_basic_auth_failure;
		$r->log_error("user $user: no password supplied for URI ", $r->uri);
		return Apache2::Const::HTTP_UNAUTHORIZED;
	}

	# Read the database
	my $users = {};
	eval {
		($users) = Colloquy::Data::users($users_lua);
	};

	# Check we can read the database file
	if ($@) {
		$r->note_basic_auth_failure;
		$r->log_error(
			"user $user: unable to read users_lua database '$users_lua': $@ at URI ",
			$r->uri);
		return (lc($allowaltauth) eq "yes" ? Apache2::Const::DECLINED : Apache2::Const::HTTP_UNAUTHORIZED);
	}

	# Check we have found that user
	unless (exists $users->{"$user"}->{password2} || exists $users->{"$user"}->{password}) {
		$r->note_basic_auth_failure;
		$r->log_error(
			"user $user: no valid user found for URI ",
			$r->uri);
		return (lc($allowaltauth) eq "yes" ? Apache2::Const::DECLINED : Apache2::Const::HTTP_UNAUTHORIZED);
	}

	# Now check the password
	my $db_password_hash = $users->{"$user"}->{password2} || $users->{"$user"}->{password} || '_no_db_passd_';
	my $our_password_hash = MD5->hexhash("$user$password") || '_no_usr_passd_';
	if ($our_password_hash eq $db_password_hash) {
		return Apache2::Const::OK;
	} else {
		$r->log_error(
			"user $user: invalid password for URI ",
			$r->uri);
		return (lc($allowaltauth) eq "yes" ? Apache2::Const::DECLINED : Apache2::Const::HTTP_UNAUTHORIZED);
	}

	# Otherwise fail
	return (lc($allowaltauth) eq "yes" ? Apache2::Const::DECLINED : Apache2::Const::HTTP_UNAUTHORIZED);
}

1;

=pod

=head1 NAME

Apache2::AuthColloquy - mod_perl authentication against the Colloquy users.lua file

=head1 SYNOPSIS

 AuthName "Talker Members Area"
 AuthType Basic

 # Full path to your users.lua file or users/ directory
 PerlSetVar users_lua /home/system/colloquy/data

 # Set if you want to allow an alternate method of authentication
 PerlSetVar AllowAlternateAuth yes | no

 require valid-user
 PerlAuthenHandler Apache2::AuthColloquy

=head1 DESCRIPTION

Apache2::AuthColloquy is an Apache 2 authentication module. It will
authenticate against a Colloquy users.lua user database file using
the newer password2 field.

This script munges the users.lua file in to executable perl code
which is then evaluated. It should therefore be used with caution
if you cannot gaurentee the integrity of the users.lua file. See
Colloquy::Data for more details.

=head1 SEE ALSO

L<Colloquy::Data>

=head1 VERSION

$Id$

=head1 AUTHOR

Nicola Worthington <nicolaw@cpan.org>

L<http://perlgirl.org.uk>

=head1 COPYRIGHT

Copyright 2005,2006 Nicola Worthington.

This software is licensed under The Apache Software License, Version 2.0.

L<http://www.apache.org/licenses/LICENSE-2.0>

=cut

__END__