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