webgui/lib/WebGUI/Auth.pm
2006-05-20 08:43:16 +00:00

795 lines
22 KiB
Perl

package WebGUI::Auth;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2006 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
use CGI::Util qw(rearrange);
use DBI;
use strict qw(subs vars);
use Tie::IxHash;
use WebGUI::HTML;
use WebGUI::HTMLForm;
use WebGUI::International;
use WebGUI::Macro;
use WebGUI::TabForm;
use WebGUI::Asset::Template;
use WebGUI::Utility;
use WebGUI::User;
use WebGUI::Operation::Shared;
use WebGUI::Operation::Profile;
use WebGUI::Workflow::Instance;
use WebGUI::Inbox;
=head1 NAME
Package WebGUI::Auth
=head1 DESCRIPTION
An abstract class for all authentication modules to extend.
=head1 SYNOPSIS
use WebGUI::Auth;
our @ISA = qw(WebGUI::Auth);
=head1 METHODS
These methods are available from this class:
=cut
#-------------------------------------------------------------------
sub _isDuplicateUsername {
my $self = shift;
my $username = shift;
#Return false if the user is already logged in, but not changing their username.
return 0 if($self->userId ne "1" && $self->session->user->username eq $username);
my ($otherUser) = $self->session->db->quickArray("select count(*) from users where username=".$self->session->db->quote($username));
return 0 if !$otherUser;
my $i18n = WebGUI::International->new($self->session);
$self->error(sprintf($i18n->get(77), $username,$username,$username,$self->session->datetime->epochToHuman($self->session->datetime->time(),"%y")));
return 1;
}
#-------------------------------------------------------------------
=head2 _isValidUsername ( username )
Validates the username passed in.
=cut
sub _isValidUsername {
my $self = shift;
my $username = shift;
my $error = "";
return 1 if($self->userId ne "1" && $self->session->user->username eq $username);
my $i18n = WebGUI::International->new($self->session);
if ($username =~ /^\s/ || $username =~ /\s$/) {
$error .= '<li>'.$i18n->get(724).'</li>';
}
if ($username eq "") {
$error .= '<li>'.$i18n->get(725).'</li>';
}
$self->error($error);
return $error eq "";
}
#-------------------------------------------------------------------
sub _logLogin {
my $self = shift;
$self->session->db->write("insert into userLoginLog values (".$self->session->db->quote($_[0]).",".$self->session->db->quote($_[1]).",".$self->session->datetime->time().","
.$self->session->db->quote($self->session->env->get("REMOTE_ADDR")).",".$self->session->db->quote($self->session->env->get("HTTP_USER_AGENT")).")");
}
#-------------------------------------------------------------------
=head2 addUserForm ( userId )
Creates elements for the add user form specific to this Authentication Method.
=cut
sub addUserForm {
#Added for interface purposes only. Needs to be implemented in the subclass.
}
#-------------------------------------------------------------------
=head2 addUserFormSave ( properties [,userId] )
Saves user elements unique to this authentication method
=cut
sub addUserFormSave {
my $self = shift;
$self->saveParams(($_[1] || $self->userId),$self->authMethod,$_[0]);
}
#-------------------------------------------------------------------
=head2 authenticate ( )
Superclass method that performs standard login routines. This method returns true if login success, otherwise returns false.
=cut
sub authenticate {
my $self = shift;
my $username = shift;
my $i18n = WebGUI::International->new($self->session);
my $user = $self->session->db->quickHashRef("select userId,authMethod,status from users where username=".$self->session->db->quote($username));
my $uid = $user->{userId};
#If userId does not exist or is not active, fail login
if (!$uid) {
$self->error($i18n->get(68));
return 0;
} elsif($user->{status} ne 'Active') {
$self->error($i18n->get(820));
$self->_logLogin($uid, "failure");
return 0;
}
#Set User Id
$self->user(WebGUI::User->new($self->session,$uid));
return 1;
}
#-------------------------------------------------------------------
=head2 authMethod ( [authMethod] )
Gets or sets the authMethod in the Auth Object
=head3 authMethod
A string which sets the auth method for an instance of this class
=cut
sub authMethod {
my $self = shift;
return $self->{authMethod} if(!$_[0]);
$self->{authMethod} = $_[0];
}
#-------------------------------------------------------------------
=head2 createAccount ( method [,vars] )
Superclass method that performs general functionality for creating new accounts.
=head3 method
Auth method that the form for creating users should call
=head3 vars
Array ref of template vars from subclass
=cut
sub createAccount {
my $self = shift;
my $method = $_[0];
my $vars = $_[1];
my $i18n = WebGUI::International->new($self->session);
$vars->{title} = $i18n->get(54);
$vars->{'create.form.header'} = WebGUI::Form::formHeader($self->session,{});
$vars->{'create.form.header'} .= WebGUI::Form::hidden($self->session,{"name"=>"op","value"=>"auth"});
$vars->{'create.form.header'} .= WebGUI::Form::hidden($self->session,{"name"=>"method","value"=>$method});
#User Defined Options
$vars->{'create.form.profile'} = WebGUI::Operation::Profile::getRequiredProfileFields($self->session);
$vars->{'create.form.submit'} = WebGUI::Form::submit($self->session,{});
$vars->{'create.form.footer'} = WebGUI::Form::formFooter($self->session,);
$vars->{'login.url'} = $self->session->url->page('op=auth;method=init');
$vars->{'login.label'} = $i18n->get(58);
$vars->{'login.url'} = $self->session->url->page('op=auth;method=init');
$vars->{'login.label'} = $i18n->get(58);
return WebGUI::Asset::Template->new($self->session,$self->getCreateAccountTemplateId)->process($vars);
}
#-------------------------------------------------------------------
=head2 createAccountSave ( username,properties [,password,profile] )
Superclass method that performs general functionality for saving new accounts.
=head3 username
Username for the account being created
=head3 properties
Properties from the subclass that should be saved as authentication parameters
=head3 password
Password entered by the user. This is only used in for sending the user a notification by email of his/her username/password
=head3 profile
Hashref of profile values returned by the function WebGUI::Operation::Profile::validateProfileData($self->session)
=cut
sub createAccountSave {
my $self = shift;
my $username = $_[0];
my $properties = $_[1];
my $password = $_[2];
my $profile = $_[3];
my $i18n = WebGUI::International->new($self->session);
my $u = WebGUI::User->new($self->session,"new");
$self->user($u);
my $userId = $u->userId;
$u->username($username);
$u->authMethod($self->authMethod);
$u->karma($self->session->setting->get("karmaPerLogin"),"Login","Just for logging in.") if ($self->session->setting->get("useKarma"));
WebGUI::Operation::Profile::saveProfileFields($self->session,$u,$profile) if($profile);
$self->saveParams($userId,$self->authMethod,$properties);
if ($self->getSetting("sendWelcomeMessage")){
my $authInfo = "\n\n".$i18n->get(50).": ".$username;
$authInfo .= "\n".$i18n->get(51).": ".$password if($password);
$authInfo .= "\n\n";
WebGUI::Inbox->new($self->session)->addMessage({
message => $self->getSetting("welcomeMessage").$authInfo,
subject => $i18n->get(870),
userId => $self->userId,
});
}
$self->session->user({user=>$u});
$self->_logLogin($userId,"success");
$self->session->http->setStatus(201,"Account Registration Successful");
if ($self->session->setting->get("runOnRegistration")) {
WebGUI::Workflow::Instance->create($self->session, {
workflowId=>$self->session->setting->get("runOnRegistration"),
methodName=>"new",
className=>"WebGUI::User",
parameters=>$self->session->userId,
priority=>1
});
}
return "";
}
#-------------------------------------------------------------------
=head2 deactivateAccount ( method )
Superclass method that displays a confirm message for deactivating a user's account.
=head3 method
Auth method that the form for creating users should call
=cut
sub deactivateAccount {
my $self = shift;
my $method = $_[0];
return $self->session->privilege->vitalComponent() if($self->userId eq '1' || $self->userId eq '3');
return $self->session->privilege->adminOnly() if(!$self->session->setting->get("selfDeactivation"));
my $i18n = WebGUI::International->new($self->session);
my %var;
$var{title} = $i18n->get(42);
$var{question} = $i18n->get(60);
$var{'yes.url'} = $self->session->url->page('op=auth;method='.$method);
$var{'yes.label'} = $i18n->get(44);
$var{'no.url'} = $self->session->url->page();
$var{'no.label'} = $i18n->get(45);
return WebGUI::Asset::Template->new($self->session,"PBtmpl0000000000000057")->process(\%var);
}
#-------------------------------------------------------------------
=head2 deactivateAccount ( method )
Superclass method that performs general functionality for deactivating accounts.
=cut
sub deactivateAccountConfirm {
my $self = shift;
return $self->session->privilege->vitalComponent() if($self->userId eq '1' || $self->userId eq '3');
my $u = $self->user;
$u->status("Selfdestructed");
$self->session->var->end();
$self->session->user({userId=>'1'});
}
#-------------------------------------------------------------------
=head2 deleteParams ( )
Removes the user's authentication parameters from the database for all authentication methods. This is primarily useful when deleting the user's account.
=cut
sub deleteParams {
my $self = shift;
$self->session->db->write("delete from authentication where userId=".$self->session->db->quote($self->userId));
}
#-------------------------------------------------------------------
=head2 displayAccount ( method [,vars] )
Superclass method that performs general functionality for viewing editable fields related to a user's account.
=head3 method
Auth method that the form for updating a user's account should call
=head3 vars
Array ref of template vars from subclass
=cut
sub displayAccount {
my $self = shift;
my $method = $_[0];
my $vars = $_[1];
my $i18n = WebGUI::International->new($self->session);
$vars->{title} = $i18n->get(61);
$vars->{'account.form.header'} = WebGUI::Form::formHeader($self->session,{});
$vars->{'account.form.header'} .= WebGUI::Form::hidden($self->session,{"name"=>"op","value"=>"auth"});
$vars->{'account.form.header'} .= WebGUI::Form::hidden($self->session,{"name"=>"method","value"=>$method});
if ($self->session->setting->get("useKarma")) {
$vars->{'account.form.karma'} = $self->session->user->karma;
$vars->{'account.form.karma.label'} = $i18n->get(537);
}
$vars->{'account.form.submit'} = WebGUI::Form::submit($self->session,{});
$vars->{'account.form.footer'} = WebGUI::Form::formFooter($self->session,);
$vars->{'account.options'} = WebGUI::Operation::Shared::accountOptions($self->session);
return WebGUI::Asset::Template->new($self->session,$self->getAccountTemplateId)->process($vars);
}
#-------------------------------------------------------------------
=head2 displayLogin ( [method,vars] )
Superclass method that performs general functionality for creating new accounts.
=head3 method
Auth method that the form for performing the login routine should call
=head3 vars
Array ref of template vars from subclass
=cut
sub displayLogin {
my $self = shift;
my $method = $_[0] || "login";
my $vars = $_[1];
unless ($self->session->form->process("op") eq "auth") {
$self->session->scratch->set("redirectAfterLogin",$self->session->url->page($self->session->env->get("QUERY_STRING")));
}
my $i18n = WebGUI::International->new($self->session);
$vars->{title} = $i18n->get(66);
my $action;
if ($self->session->setting->get("encryptLogin")) {
$action = $self->session->url->page(undef,1);
$action =~ s/http:/https:/;
}
$vars->{'login.form.header'} = WebGUI::Form::formHeader($self->session,{action=>$action});
$vars->{'login.form.hidden'} = WebGUI::Form::hidden($self->session,{"name"=>"op","value"=>"auth"});
$vars->{'login.form.hidden'} .= WebGUI::Form::hidden($self->session,{"name"=>"method","value"=>$method});
$vars->{'login.form.username'} = WebGUI::Form::text($self->session,{"name"=>"username"});
$vars->{'login.form.username.label'} = $i18n->get(50);
$vars->{'login.form.password'} = WebGUI::Form::password($self->session,{"name"=>"identifier"});
$vars->{'login.form.password.label'} = $i18n->get(51);
$vars->{'login.form.submit'} = WebGUI::Form::submit($self->session,{"value"=>$i18n->get(52)});
$vars->{'login.form.footer'} = WebGUI::Form::formFooter($self->session,);
$vars->{'anonymousRegistration.isAllowed'} = ($self->session->setting->get("anonymousRegistration"));
$vars->{'createAccount.url'} = $self->session->url->page('op=auth;method=createAccount');
$vars->{'createAccount.label'} = $i18n->get(67);
return WebGUI::Asset::Template->new($self->session,$self->getLoginTemplateId)->process($vars);
}
#-------------------------------------------------------------------
=head2 editUserForm ( )
Creates user form elements specific to this Auth Method.
=cut
sub editUserForm {
#Added for interface purposes only. Needs to be implemented in the subclass.
}
#-------------------------------------------------------------------
=head2 editUserFormSave ( properties )
Saves user elements unique to this authentication method
=cut
sub editUserFormSave {
my $self = shift;
$self->saveParams($self->userId,$self->authMethod,$_[0]);
}
#-------------------------------------------------------------------
=head2 error ( [errorMsg] )
Sets or returns the error currently stored in the object
=cut
sub error {
my $self = shift;
return $self->{error} if (!$_[0]);
$self->{error} = $_[0];
}
#-------------------------------------------------------------------
=head2 getAccountTemplateId ()
This method should be overridden by the subclass and should return the template ID for the display/edit account screen.
=cut
sub getAccountTemplateId {
return "PBtmpl0000000000000010";
}
#-------------------------------------------------------------------
=head2 getAccountTemplateId ()
This method should be overridden by the subclass and should return the template ID for the create account screen.
=cut
sub getCreateAccountTemplateId {
return "PBtmpl0000000000000011";
}
#-------------------------------------------------------------------
=head2 getAccountTemplateId ()
This method should be overridden by the subclass and should return the template ID for the login screen.
=cut
sub getLoginTemplateId {
return "PBtmpl0000000000000013";
}
#-------------------------------------------------------------------
=head2 getParams ()
Returns a hash reference with the user's authentication information. This method uses data stored in the instance of the object.
=cut
sub getParams {
my $self = shift;
my $userId = $_[0] || $self->userId;
my $authMethod = $_[1] || $self->authMethod;
return $self->session->db->buildHashRef("select fieldName, fieldData from authentication where userId=".$self->session->db->quote($userId)." and authMethod=".$self->session->db->quote($authMethod));
}
#-------------------------------------------------------------------
=head2 getSetting ( setting )
Returns a setting for this authMethod instance. If none is specified, returns the system authMethod setting
=head3 setting
Specify a setting to retrieve
=cut
sub getSetting {
my $self = shift;
my $setting = $_[0];
$setting = lc($self->authMethod).ucfirst($setting);
return $self->session->setting->get($setting);
}
#-------------------------------------------------------------------
=head2 init ( )
Initialization function for these auth routines. Default is a superclass function called displayLogin.
Override this method in your subclass to change the initialization for custom authentication methods
=cut
sub init {
my $self = shift;
return $self->displayLogin;
}
#-------------------------------------------------------------------
=head2 isCallable ( method )
Returns whether or not a method is callable
=cut
sub isCallable {
my $self = shift;
return isIn($_[0],@{$self->{callable}})
}
#-------------------------------------------------------------------
=head2 login ( )
Superclass method that performs standard login routines. This is what should happen after a user has been authenticated.
Authentication should always happen in the subclass routine.
=cut
sub login {
my $self = shift;
my ($cmd, $uid, $u, $authMethod,$msg,$userData,$expireDate);
#Create a new user
$uid = $self->userId;
$u = WebGUI::User->new($self->session,$uid);
$self->session->user({user=>$u});
$u->karma($self->session->setting->get("karmaPerLogin"),"Login","Just for logging in.") if ($self->session->setting->get("useKarma"));
$self->_logLogin($uid,"success");
if ($self->session->scratch->get("redirectAfterLogin")) {
$self->session->http->setRedirect($self->session->scratch->get("redirectAfterLogin"));
$self->session->scratch->delete("redirectAfterLogin");
}
return "";
}
#-------------------------------------------------------------------
=head2 logout ( )
Superclass method that performs standard logout routines.
=cut
sub logout {
my $self = shift;
$self->session->var->end($self->session->var->get("sessionId"));
$self->session->user({userId=>'1'});
my $u = WebGUI::User->new($self->session,1);
$self->{user} = $u;
return "";
}
#-------------------------------------------------------------------
=head2 new ( session, authMethod [,userId,callable] )
Constructor.
=head3 session
=head3 authMethod
This object's authentication method
=head3 userId
userId for the user requesting authentication. This defaults to $self->session->user->userId
=head3 callable
Array reference of methods allowed to be called externally;
=cut
sub new {
my $self = {};
my $class = shift;
$self->{_session} = shift;
$self->{authMethod} = shift;
my $userId = shift || $self->{_session}->user->userId;
# Can't do this... if you're updating the account of a user that's not you, this will not work
#$self->{user} = $self->{_session}->user;
$self->{user} = WebGUI::User->new($self->{_session}, $userId);
$self->{error} = "";
$self->{profile} = ();
$self->{warning} = "";
my $call = shift;
my @callable = ('init', @{$call});
$self->{callable} = \@callable;
bless $self, $class;
return $self;
}
#-------------------------------------------------------------------
=head2 profile ()
Sets or returns the Profile hash for a user.
=cut
sub profile {
my $self = shift;
return $self->{profile} if ($_[0]);
$self->{profile} = $_[0];
}
#-------------------------------------------------------------------
sub session {
my $self = shift;
return $self->{_session};
}
#-------------------------------------------------------------------
=head2 setCallable ( callableMethods )
adds elements to the callable routines list. This list determines whether or not a method in this instance is
allowed to be called externally
=head3 callableMethods
Array reference containing a list of methods for this authentication instance that can be called externally
=cut
sub setCallable {
my $self = shift;
my @callable = @{$self->{callable}};
@callable = (@callable,@{$_[0]});
}
#-------------------------------------------------------------------
=head2 saveParams ( userId, authMethod, data )
Saves the user's authentication parameters to the database.
=head3 userId
Specify a user id.
=head3 authMethod
Specify the authentication method to save these paramaters under.
=head3 data
A hash reference containing parameter names and values to be saved.
=cut
sub saveParams {
my $self = shift;
my ($uid, $authMethod, $data) = @_;
foreach (keys %{$data}) {
$self->session->db->write("delete from authentication where userId=".$self->session->db->quote($uid)." and authMethod=".$self->session->db->quote($authMethod)." and fieldName=".$self->session->db->quote($_));
$self->session->db->write("insert into authentication (userId,authMethod,fieldData,fieldName) values (".$self->session->db->quote($uid).",".$self->session->db->quote($authMethod).",".$self->session->db->quote($data->{$_}).",".$self->session->db->quote($_).")");
}
}
#-------------------------------------------------------------------
=head2 user ( [user] )
Sets or Returns the user object stored in the wobject
=cut
sub user {
my $self = shift;
return $self->{user} if (!$_[0]);
$self->{user} = $_[0];
}
#-------------------------------------------------------------------
=head2 userId ( )
Returns the userId currently stored in the object
=cut
sub userId {
my $self = shift;
my $u = $self->user;
return $u->userId;
}
#-------------------------------------------------------------------
=head2 username ( )
Returns the username currently stored in the object
=cut
sub username {
my $self = shift;
my $u = $self->user;
return $u->username;
}
#-------------------------------------------------------------------
=head2 validUsername ( username )
Validates the a username.
=cut
sub validUsername {
my $self = shift;
my $username = shift;
WebGUI::Macro::negate(\$username);
my $error = "";
if ($self->_isDuplicateUsername($username)) {
$error .= $self->error;
}
if (!$self->_isValidUsername($username)) {
$error .= $self->error;
}
$self->error($error);
return $error eq "";
}
#-------------------------------------------------------------------
=head2 warning ( [warningMsg] )
Sets or Returns a warning in the object
=cut
sub warning {
my $self = shift;
return $self->{warning} if (!$_[0]);
$self->{warning} = $_[0];
}
1;