# 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;