297 lines
12 KiB
Perl
297 lines
12 KiB
Perl
# Selima Website Content Management System
|
|
# User.pm: The user account 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::User;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Selima::Checker);
|
|
|
|
use Crypt::Cracklib qw(fascist_check);
|
|
use Email::Valid qw();
|
|
$Crypt::Cracklib::DICT = "/usr/share/dict/pw_dict";
|
|
|
|
use Selima::Array;
|
|
use Selima::ChkPriv;
|
|
use Selima::DataVars qw($DBH :groups);
|
|
use Selima::LogIn;
|
|
use Selima::UserName;
|
|
use Selima::Passwd;
|
|
use Selima::ShortCut;
|
|
|
|
use Selima::Checker::UserMem;
|
|
|
|
# new: Initialize the checker
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $self);
|
|
($class, @_) = @_;
|
|
$_[1] = "users" if scalar(@_) < 2 || !defined $_[1];
|
|
$self = $class->SUPER::new(@_);
|
|
${$self->{"maxlens"}}{"passwd"} = 16;
|
|
${$self->{"minlens"}}{"passwd"} = 6;
|
|
${$self->{"minlens"}}{"email"} = 5;
|
|
return $self;
|
|
}
|
|
|
|
# check: Run a list of checks
|
|
sub check : method {
|
|
local ($_, %_);
|
|
my ($self, @cols, $error);
|
|
($self, @cols) = @_;
|
|
# Check the guest flag first
|
|
$self->_is_guest;
|
|
# Run the parent method
|
|
return $self->SUPER::check(@cols);
|
|
}
|
|
|
|
# _is_guest: If the user being edited is a guest
|
|
sub _is_guest : method {
|
|
local ($_, %_);
|
|
my ($self, $form);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Checked before
|
|
return $form->param("_is_guest") if !$self->_missing("_is_guest");
|
|
%_ = map { $_ => 1 } $form->param;
|
|
for ($_ = 0; exists $_{"supgroup$_" . "sn"}; $_++) {
|
|
# Skip unselected groups
|
|
next if !exists $_{"supgroup$_"};
|
|
# Check if this is the guest group
|
|
return $form->param("_is_guest", 1)
|
|
if groupid($form->param("supgroup$_" . "sn")) eq GUEST_GROUP;
|
|
}
|
|
# No guest group was found
|
|
return $form->param("_is_guest", 0);
|
|
}
|
|
|
|
# _check_id: Check the user ID.
|
|
sub _check_id : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $sth, $sql);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip for a non-super-user editing a super-user
|
|
return if $self->{"iscur"} && !is_su && is_su $self->{"sn"};
|
|
# 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 the user ID.")}
|
|
if $form->param("id") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This user ID. is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"id"}]}
|
|
if length $form->param("id") > ${$self->{"maxlens"}}{"id"};
|
|
return {"msg"=>N_("This user ID. is too short. (Min. length [#,_1])"),
|
|
"margs"=>[${$self->{"minlens"}}{"id"}]}
|
|
if length $form->param("id") < ${$self->{"minlens"}}{"id"};
|
|
# Check if the characters used are valid
|
|
return {"msg"=>N_("Only English letters, numbers, at-signs, dots, dashes and underscores are allowed for the user ID.")}
|
|
unless $form->param("id") =~ /^[a-z][a-z0-9@\.\-_]*$/;
|
|
# Check if this item is duplicated
|
|
@_ = qw();
|
|
push @_, "id=" . $DBH->quote($form->param("id"));
|
|
push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
|
|
$sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
|
|
. " WHERE " . join(" AND ", @_) . ";\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
return {"msg"=>N_("This user already has an account. You cannot create a duplicated one.")}
|
|
if $sth->rows > 0;
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_passwd: Check the user password
|
|
sub _check_passwd : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip for a non-super-user editing a super-user
|
|
return if $self->{"iscur"} && !is_su && is_su $self->{"sn"};
|
|
# Set the passwords with the password registry
|
|
sync_saved_passwd($form, "*" x ${$self->{"maxlens"}}{"passwd"});
|
|
# Skip password checking for guests
|
|
return if $self->_is_guest;
|
|
# Check if it exists
|
|
$error = $self->_missing("passwd", "passwd2");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("passwd", "passwd2");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the password.")}
|
|
if !$self->{"iscur"} && $form->param("passwd") eq "";
|
|
return {"msg"=>N_("Please confirm the password.")}
|
|
if $form->param("passwd") ne "" && $form->param("passwd2") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This password is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"passwd"}]}
|
|
if length $form->param("passwd") > ${$self->{"maxlens"}}{"passwd"};
|
|
return {"msg"=>N_("This password is too short. (Min. length [#,_1])"),
|
|
"margs"=>[${$self->{"minlens"}}{"passwd"}]}
|
|
if $form->param("passwd") ne ""
|
|
&& length $form->param("passwd") < ${$self->{"minlens"}}{"passwd"};
|
|
# Check if two passwords are consistent
|
|
return {"msg"=>N_("The 2 passwords are different. Please fill in the password again.")}
|
|
if $form->param("passwd") ne $form->param("passwd2");
|
|
if ($form->param("passwd") ne "") {
|
|
# Check the password strength with cracklib
|
|
if (($_ = fascist_check($form->param("passwd"))) ne "ok") {
|
|
# See the message from cracklib/fscist.c
|
|
# FascistGecos()
|
|
#return {"msg"=>N_("You are not registered.")}
|
|
# if $_ eq "you are not registered in the password file";
|
|
return {"msg"=>N_("This password is based on the user ID.")}
|
|
if $_ eq "it is based on your username";
|
|
#return {"msg"=>N_("This password is based upon the personal information.")}
|
|
# if $_ eq "it is based upon your password entry";
|
|
#return {"msg"=>N_("This password is derived from the personal information.")}
|
|
# if $_ eq "it is derived from your password entry"
|
|
# || $_ eq "it's derived from your password entry";
|
|
#return {"msg"=>N_("This password is derivable from the personal information.")}
|
|
# if $_ eq "it is derivable from your password entry"
|
|
# || $_ eq "it's derivable from your password entry";
|
|
# FascistLook()
|
|
#return {"msg"=>N_("This password is too short. (Min. length [#,_1])"),
|
|
# "margs"=>[${$self->{"minlens"}}{"passwd"}]}
|
|
# if $_ eq "it's WAY too short"
|
|
# || $_ eq "it is too short";
|
|
return {"msg"=>N_("This password does not contain enough different characters.")}
|
|
if $_ eq "it does not contain enough DIFFERENT characters";
|
|
#return {"msg"=>N_("This password is all whitespace.")}
|
|
# if $_ eq "it is all whitespace";
|
|
return {"msg"=>N_("This password is too simplistic/systematic.")}
|
|
if $_ eq "it is too simplistic/systematic";
|
|
#return {"msg"=>N_("This password looks like a National Insurance number.")}
|
|
# if $_ eq "it looks like a National Insurance number";
|
|
return {"msg"=>N_("This password is based on a dictionary word.")}
|
|
if $_ eq "it is based on a dictionary word";
|
|
return {"msg"=>N_("This password is based on a (reversed) dictionary word.")}
|
|
if $_ eq "it is based on a (reversed) dictionary word";
|
|
return {"msg"=>N_("This password is too simple.")};
|
|
}
|
|
return {"msg"=>$_}
|
|
if ($_ = fascist_check($form->param("passwd"))) ne "ok";
|
|
# Check if the group and the member are different
|
|
return {"msg"=>N_("You cannot use a password that is based on your user ID.")}
|
|
if defined($_ = $form->param("id"))
|
|
&& $form->param("passwd") =~ /$_/i;
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_name: Check the user name
|
|
sub _check_name : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("name");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("name");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the name.")}
|
|
if $form->param("name") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This name is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"name"}]}
|
|
if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_email: Check the user e-mail
|
|
sub _check_email : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $col);
|
|
($self, $col) = @_;
|
|
$form = $self->{"form"};
|
|
$col = "email" if !defined $col;
|
|
# Check if it exists
|
|
$error = $self->_missing($col);
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim($col);
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the e-mail.")}
|
|
if $form->param($col) eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This e-mail is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{$col}]}
|
|
if length $form->param($col) > ${$self->{"maxlens"}}{$col};
|
|
return {"msg"=>N_("This e-mail is too short. (Min. length [#,_1])"),
|
|
"margs"=>[${$self->{"minlens"}}{$col}]}
|
|
if length $form->param($col) < ${$self->{"minlens"}}{$col};
|
|
# Check the e-mail validity
|
|
return {"msg"=>N_("Please fill in a valid e-mail address.")}
|
|
if !Email::Valid->rfc822($form->param($col));
|
|
return {"msg"=>N_("The domain of this e-mail does not exists. Check if there is any typo in it.")}
|
|
if !Email::Valid->mx($form->param($col));
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_supgroup: Check the belonging groups
|
|
sub _check_supgroup : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, %items);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip for a non-super-user editing herself
|
|
return if $self->{"iscur"} && !is_su && $self->{"sn"} == get_login_sn;
|
|
for (my $i = 0, %items = qw(); !$self->_missing("supgroup$i" . "sn"); $i++) {
|
|
my ($subform, $checker);
|
|
# Skip unselected ones
|
|
next if $self->_missing("supgroup$i");
|
|
# Regularize it
|
|
$self->_trim("supgroup$i" . "sn");
|
|
# Check if this selection is duplicated
|
|
return {"msg"=>N_("This belonging group is duplicated. You cannot set duplicated ones.")}
|
|
if exists $items{$form->param("supgroup$i" . "sn")};
|
|
$items{$form->param("supgroup$i" . "sn")} = 1;
|
|
# Check with the subform checker
|
|
$subform = new CGI("");
|
|
$subform->param("grp", $form->param("supgroup$i" . "sn"));
|
|
$subform->param("member", $self->{"sn"}) if $self->{"iscur"};
|
|
$checker = new Selima::Checker::UserMem($subform);
|
|
$error = $checker->check("grp");
|
|
return $error if defined $error;
|
|
# Check if a special group is submitted
|
|
$_ = groupid($form->param("supgroup$i" . "sn"));
|
|
return {"msg"=>N_("You cannot submit the super-user group along with other groups.")}
|
|
if $_ eq SU_GROUP;
|
|
return {"msg"=>N_("You cannot set the administrators group.")}
|
|
if $_ eq ADMIN_GROUP;
|
|
return {"msg"=>N_("You cannot set the all-users group.")}
|
|
if $_ eq ALLUSERS_GROUP;
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
return 1;
|