239 lines
8.1 KiB
Perl
239 lines
8.1 KiB
Perl
# Selima Website Content Management System
|
|
# LogIn.pm: The log-in form checker.
|
|
|
|
# Copyright (c) 2004-2018 imacat.
|
|
#
|
|
# 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.
|
|
|
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
|
# First written: 2004-09-26
|
|
|
|
package Selima::Checker::LogIn;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Selima::Checker::User);
|
|
|
|
use Digest::MD5 qw(md5_hex);
|
|
|
|
use Selima::Array;
|
|
use Selima::ChkPriv;
|
|
use Selima::DataVars qw($DBH :hostconf);
|
|
use Selima::Guest;
|
|
use Selima::HTTP;
|
|
use Selima::Logging;
|
|
use Selima::ShortCut;
|
|
|
|
# new: Initialize the checker
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self);
|
|
($class, @_) = @_;
|
|
$_[1] = "users" if scalar(@_) < 2 || !defined $_[1];
|
|
$self = $class->SUPER::new(@_);
|
|
$self->{"row"} = undef;
|
|
$self->{"allcols"} = [ $DBH->cols($self->{"table"}) ];
|
|
return $self;
|
|
}
|
|
|
|
# check: Run a list of checks
|
|
sub check : method {
|
|
local ($_, %_);
|
|
my ($self, $error, @cols);
|
|
($self, @cols) = @_;
|
|
|
|
# See if a log in is attemped.
|
|
%_ = map { $_ => 1 } @cols;
|
|
$self->{"login"} = exists $_{"id"} && exists $_{"passwd"}
|
|
if !exists $self->{"login"};
|
|
# Run the parent method first
|
|
$error = $self->SUPER::check(@cols);
|
|
return $error if defined $error;
|
|
return;
|
|
}
|
|
|
|
# _check_id: Check the user ID
|
|
sub _check_id : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $sth, $sql);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("id");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("id");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in your user ID.")}
|
|
if $form->param("id") eq "";
|
|
# Check the length
|
|
if (length $form->param("id") > ${$self->{"maxlens"}}{"id"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because user ID is too long.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
if (length $form->param("id") < ${$self->{"minlens"}}{"id"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because user ID is too short.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
|
|
# Check if this user exists
|
|
@_ = qw();
|
|
push @_, "id=" . $DBH->quote($form->param("id"));
|
|
push @_, "NOT deleted" if in_array("deleted", @{$self->{"allcols"}});
|
|
$sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
|
|
. " WHERE " . join(" AND ", @_) . ";\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
if ($sth->rows != 1) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because user ID does not exist.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
# Save it for further reference
|
|
$self->{"row"} = $sth->fetchrow_hashref;
|
|
$self->{"sn"} = ${$self->{"row"}}{"sn"};
|
|
# Check if log-in is closed
|
|
if ($NOLOGIN && !is_su $self->{"sn"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because website is temporarily closed.")
|
|
if $self->{"login"};
|
|
# This message is duplicated
|
|
return {};
|
|
}
|
|
# Check if this user is disabled
|
|
if (${$self->{"row"}}{"disabled"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because account is disabled.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Your account is disabled. Contact our system administrator for assistence.")};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_passwd: Check the user password
|
|
sub _check_passwd : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip password checks for guests
|
|
return if exists $self->{"sn"} && is_guest $self->{"sn"};
|
|
# Check if it exists
|
|
$error = $self->_missing("passwd");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("passwd");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in your password.")}
|
|
if $form->param("passwd") eq "";
|
|
# Check the length
|
|
if (length $form->param("passwd") > ${$self->{"maxlens"}}{"passwd"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because password is too long.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
if (length $form->param("passwd") < ${$self->{"minlens"}}{"passwd"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because password is too short.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
# Check if the password is correct
|
|
if ( defined $self->{"row"}
|
|
&& md5_hex($form->param("id") . ":magicat:"
|
|
. $form->param("passwd")) eq ${$self->{"row"}}{"passwd"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because password is incorrect.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_authdig: Check the user credential using HTTP Digest Authentication
|
|
sub _check_authdig : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip credential checks for guests
|
|
return if exists $self->{"sn"} && is_guest $self->{"sn"};
|
|
# Check if it exists
|
|
http_500 "Apache::AuthDigest::API \"rd\" not supplied"
|
|
if !exists $self->{"rd"};
|
|
http_500 "client response \"response\" not supplied"
|
|
if !exists $self->{"response"};
|
|
http_500 "\"id\" did not checked before \"authdig\""
|
|
if !defined $self->{"row"};
|
|
# Check if the credential is correct
|
|
if ( !$self->{"rd"}->compare_digest_response($self->{"response"},
|
|
${$self->{"row"}}{"passwd"})) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because password is incorrect.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("Log in failed. Either your user ID or your password is incorrect.")};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_admin: Check if the user is an administrator
|
|
sub _check_admin : method {
|
|
local ($_, %_);
|
|
my ($self, $form);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip checking for guests
|
|
return if is_guest $self->{"sn"};
|
|
# Skip checking for super users
|
|
return if is_su $self->{"sn"};
|
|
# Check if this user is an administrator
|
|
if (!is_admin $self->{"sn"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because user is not an administrator.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("You are not an administrator and cannot log into here.")};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_nonadmin: Check if the user is not an administrator
|
|
sub _check_nonadmin : method {
|
|
local ($_, %_);
|
|
my ($self, $form);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip checking for guests
|
|
return if is_guest $self->{"sn"};
|
|
# Check if this user is an administrator
|
|
if (is_admin $self->{"sn"}) {
|
|
actlog("Log in failed for user " . $form->param("id")
|
|
. " because user is an administrator.")
|
|
if $self->{"login"};
|
|
return {"msg"=>N_("You are an administrator and cannot log into here.")};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
return 1;
|