801 lines
24 KiB
Perl
801 lines
24 KiB
Perl
# Selima Website Content Management System
|
|
# Checker.pm: The base 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-25
|
|
|
|
package Selima::Checker;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Encode::HanConvert qw(trad_to_simp simp_to_trad);
|
|
use Regexp::Common::URI::RFC2396 qw();
|
|
use URI::Escape qw(uri_escape);
|
|
|
|
use Selima::AddGet;
|
|
use Selima::Array;
|
|
use Selima::CallForm;
|
|
use Selima::ChkFunc;
|
|
use Selima::ChkWrite;
|
|
use Selima::DataVars qw($DBH FORM_CAPTCHA :dataman :forms :l10n
|
|
:lninfo :requri);
|
|
use Selima::FormFunc;
|
|
use Selima::GetLang;
|
|
use Selima::HTTP;
|
|
use Selima::LnInfo;
|
|
use Selima::Logging;
|
|
use Selima::Picture;
|
|
use Selima::ShortCut;
|
|
|
|
# Load these classes
|
|
use Selima::Checker::User;
|
|
use Selima::Checker::Group;
|
|
use Selima::Checker::UserMem;
|
|
use Selima::Checker::GroupMem;
|
|
use Selima::Checker::UserPref;
|
|
use Selima::Checker::ScptPriv;
|
|
use Selima::Checker::LogIn;
|
|
use Selima::Checker::ListPref;
|
|
|
|
use Selima::Checker::Guestbook;
|
|
use Selima::Checker::Guestbook::Public;
|
|
use Selima::Checker::Page;
|
|
use Selima::Checker::LinkCat;
|
|
use Selima::Checker::Link;
|
|
use Selima::Checker::LinkCatz;
|
|
|
|
use Selima::Checker::Rebuild;
|
|
use Selima::Checker::MailTo;
|
|
|
|
use Selima::Checker::AcctSubj;
|
|
use Selima::Checker::AcctTrx;
|
|
use Selima::Checker::AcctRec;
|
|
|
|
# new: Initialize the checker
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($class, $form, $table, $checker);
|
|
($class, $form, $table) = @_;
|
|
$checker = bless {}, $class;
|
|
|
|
$checker->{"form"} = $form;
|
|
if (defined $table) {
|
|
$checker->{"table"} = $table;
|
|
$checker->{"maxlens"} = { $DBH->col_lens($table) };
|
|
}
|
|
$checker->{"minlens"} = {};
|
|
${$checker->{"minlens"}}{"id"} = 3;
|
|
$checker->{"iscur"} = (keys %CURRENT > 0)? 1: 0;
|
|
$checker->{"sn"} = $form->param("sn")
|
|
if $checker->{"iscur"} && defined $form->param("sn");
|
|
return $checker;
|
|
}
|
|
|
|
# check: Run a list of checks
|
|
sub check : method {
|
|
local ($_, %_);
|
|
my ($self, @cols, $error);
|
|
($self, @cols) = @_;
|
|
|
|
# Check the list itself first
|
|
@_ = qw();
|
|
foreach my $col (@cols) {
|
|
http_500 "Called an undefined check \"$col\""
|
|
if !defined($_ = $self->can("_check_$col"));
|
|
push @_, $_;
|
|
}
|
|
# Run each checker
|
|
foreach (@_) {
|
|
$error = &$_($self);
|
|
return $error if defined $error;
|
|
}
|
|
return;
|
|
}
|
|
|
|
# redir: Redirect to another form
|
|
sub redir : method {
|
|
local ($_, %_);
|
|
my ($self, @cols);
|
|
($self, @cols) = @_;
|
|
# Check the list itself first
|
|
@_ = qw();
|
|
foreach my $col (@cols) {
|
|
http_500 "Called an undefined redirection \"$col\""
|
|
if !defined($_ = $self->can("_redir_$col"));
|
|
push @_, $_;
|
|
}
|
|
# Check each redirection
|
|
&$_($self) foreach @_;
|
|
return;
|
|
}
|
|
|
|
#
|
|
# Private column checkers. Do not call them directly.
|
|
# Add or override the column checkers when needed.
|
|
# Method names must be in the following format:
|
|
# sub _check_{column} : method { ... }
|
|
# Columns started with underlines are reserved for internal use, as usual.
|
|
#
|
|
# _check_usr: The default user checker
|
|
sub _check_usr : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("usr");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("usr");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please select a user.")}
|
|
if $form->param("usr") eq "";
|
|
# Check if this user exists
|
|
return {"msg"=>N_("This user does not exist anymore. Please select another one.")}
|
|
if !check_sn_in ${$form->param_fetch("usr")}[0], "users";
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_grp: The default group checker
|
|
sub _check_grp : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("grp");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("grp");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please select a group.")}
|
|
if $form->param("grp") eq "";
|
|
# Check if the group exists
|
|
return {"msg"=>N_("This group does not exist anymore. Please select another one.")}
|
|
if !check_sn_in ${$form->param_fetch("grp")}[0], "groups";
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_script: The default script checker
|
|
sub _check_script : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("script");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("script");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the script.")}
|
|
if $form->param("script") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This script is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"script"}]}
|
|
if length $form->param("script") > ${$self->{"maxlens"}}{"script"};
|
|
# Check if this script exists
|
|
return {"msg"=>N_("This script is not a valid script. Please specify another one.")}
|
|
if !check_script($form->param("script"));
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_author: The default author checker
|
|
sub _check_author : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("author");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("author");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the author.")}
|
|
if $form->param("author") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This author is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"author"}]}
|
|
if length $form->param("author") > ${$self->{"maxlens"}}{"author"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_body: The default content body checker
|
|
sub _check_body : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("body");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trimtext("body");
|
|
# Check if it is filled
|
|
$form->param("body", "")
|
|
if $form->param("body") eq C_("Fill in the content here.");
|
|
return {"msg"=>N_("Please fill in the content.")}
|
|
if $form->param("body") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This content is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"body"}]}
|
|
if length $form->param("body") > ${$self->{"maxlens"}}{"body"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_date: Check the date
|
|
sub _check_date : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $sth, $sql);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("date");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("date");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in a date.")}
|
|
if $form->param("date") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
|
if length $form->param("date") > ${$self->{"maxlens"}}{"date"};
|
|
# Check the date format
|
|
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
|
if $form->param("date") !~ /^(\d{4})-(\d{2})-(\d{2})$/;
|
|
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
|
if !check_date $1, $2, $3;
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_dsc: The default description checker
|
|
sub _check_dsc : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("dsc");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trimtext("dsc");
|
|
# Check if it is filled
|
|
$form->param("dsc", "")
|
|
if $form->param("dsc") eq C_("Fill in the description here.");
|
|
return {"msg"=>N_("Please fill in the description.")}
|
|
if $form->param("dsc") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This description is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"dsc"}]}
|
|
if length $form->param("dsc") > ${$self->{"maxlens"}}{"dsc"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_id: The default ID. checker
|
|
sub _check_id : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$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 the ID.")}
|
|
if $form->param("id") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This ID. is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"id"}]}
|
|
if length $form->param("id") > ${$self->{"maxlens"}}{"id"};
|
|
return {"msg"=>N_("This ID. is too short. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"id"}]}
|
|
if length $form->param("id") < ${$self->{"minlens"}}{"id"};
|
|
# Check if the characters used are valid
|
|
return {"msg"=>N_("Only lower-case English letters, numbers and underscores are allowed for the ID.")}
|
|
unless $form->param("id") =~ /^[a-z][a-z0-9_]*$/;
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_kw: The default keyword list checker
|
|
sub _check_kw : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("kw");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("kw");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the keywords.")}
|
|
if $form->param("kw") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This keyword list is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"kw"}]}
|
|
if length $form->param("kw") > ${$self->{"maxlens"}}{"kw"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_message: The default message checker
|
|
sub _check_message : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("message");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trimtext("message");
|
|
# Check if it is filled
|
|
$form->param("message", "")
|
|
if $form->param("message") eq C_("Fill in the message here.");
|
|
return {"msg"=>N_("Please fill in the message.")}
|
|
if $form->param("message") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This message is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"message"}]}
|
|
if length $form->param("message") > ${$self->{"maxlens"}}{"message"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_ord: The default order checker
|
|
sub _check_ord : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("ord");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("ord");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the order.")}
|
|
if $form->param("ord") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This order is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"ord"}]}
|
|
if length $form->param("ord") > ${$self->{"maxlens"}}{"ord"};
|
|
# Check if it is a valid positive integer
|
|
return {"msg"=>N_("Please fill in a positive integer order.")}
|
|
unless $form->param("ord") =~ /^\d+$/;
|
|
# Set to an integer
|
|
$_ = $form->param("ord");
|
|
$_ += 0;
|
|
$form->param("ord", $_);
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_path: The default page path checker
|
|
sub _check_path : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $sth, $sql);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("path");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("path");
|
|
# Remove the trailing excess "index.html"
|
|
$_ = $form->param("path");
|
|
s/\/index\.html?$/\//;
|
|
$form->param("path", $_);
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the page path.")}
|
|
if $form->param("path") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This page path is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"path"}]}
|
|
if length $form->param("path") > ${$self->{"maxlens"}}{"path"};
|
|
# Check if this item is duplicated
|
|
@_ = qw();
|
|
push @_, "path=" . $DBH->quote($form->param("path"));
|
|
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 page already exists. You cannot create a duplicated one.")}
|
|
if $sth->rows > 0;
|
|
# Check if the path is absolute
|
|
return {"msg"=>N_("Please fill in an absolute page path.")}
|
|
if $form->param("path") !~ /^\//;
|
|
# Check if the path is legal
|
|
return {"msg"=>N_("Please fill in a valid page path.")}
|
|
if $form->param("path") !~ /^\/$Regexp::Common::URI::RFC2396::path_segments$/;
|
|
# Check if it is the cover home page
|
|
return {"msg"=>N_("You cannot overwrite the cover home page.")}
|
|
if $form->param("path") eq "";
|
|
# Check if it is *.html
|
|
return {"msg"=>N_("You can only fill in an HTML page path (*.html).")}
|
|
if $form->param("path") !~ /(?:\/|\.html)$/;
|
|
# Check if we are permitted to write files there
|
|
if (@ALL_LINGUAS > 1) {
|
|
$_ = $DOC_ROOT . $form->param("path");
|
|
$_ =~ s/\/$/\/index.html/;
|
|
$_ .= ".%s.xhtml";
|
|
foreach my $ln (@ALL_LINGUAS) {
|
|
$error = check_writable sprintf $_, ln $ln, LN_FILENAME;
|
|
return $error if defined $error;
|
|
}
|
|
} else {
|
|
$error = check_writable $DOC_ROOT . $form->param("path") . ".xhtml";
|
|
return $error if defined $error;
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_pic: The default picture checker
|
|
sub _check_pic : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error, $PICS);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip if there is no picture to check
|
|
return if $self->_missing("pic");
|
|
# Check if this picture exists
|
|
return {"msg"=>N_("This picture does not exist anymore. Please upload another one.")}
|
|
if !pic_exists ${$form->param_fetch("pic")}[0];
|
|
# Check the length
|
|
$PICS = pic_deposit;
|
|
return {"msg"=>N_("This picture is too large. Please upload another one. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"pic"}]}
|
|
if length ${$$PICS{$form->param("pic")}}{"content"} > ${$self->{"maxlens"}}{"pic"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_piccap: default picture caption checker
|
|
sub _check_piccap : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip if there is no picture now
|
|
if ($self->_missing("pic")) {
|
|
$form->delete("piccap");
|
|
return;
|
|
}
|
|
# Check if it exists
|
|
$error = $self->_missing("piccap");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("piccap");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the picture caption.")}
|
|
if $form->param("piccap") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This picture caption is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"piccap"}]}
|
|
if length $form->param("piccap") > ${$self->{"maxlens"}}{"piccap"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_picpos: default picture position checker
|
|
sub _check_picpos : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip if there is no picture now
|
|
if ($self->_missing("pic")) {
|
|
$form->delete("picpos");
|
|
return;
|
|
}
|
|
# Check if it exists
|
|
$error = $self->_missing("picpos");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("picpos");
|
|
# Check if the picture position is legal
|
|
return {"msg"=>N_("This picture position is invalid. Please choose a proper picture position.")}
|
|
if !in_array($form->param("picpos"), @PIC_VALID_POS);
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_title: The default title checker
|
|
sub _check_title : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("title");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("title");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the title.")}
|
|
if $form->param("title") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This title is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"title"}]}
|
|
if length $form->param("title") > ${$self->{"maxlens"}}{"title"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_title_en: The default English title checker
|
|
sub _check_title_en : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Check if it exists
|
|
$error = $self->_missing("title_en");
|
|
return $error if defined $error;
|
|
# Regularize it
|
|
$self->_trim("title_en");
|
|
# Check if it is filled
|
|
return {"msg"=>N_("Please fill in the English title.")}
|
|
if $form->param("title_en") eq "";
|
|
# Check the length
|
|
return {"msg"=>N_("This English title is too long. (Max. length [#,_1])"),
|
|
"margs"=>[${$self->{"maxlens"}}{"title_en"}]}
|
|
if length $form->param("title_en") > ${$self->{"maxlens"}}{"title_en"};
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
#
|
|
# Spam Checkers:
|
|
# There are a series of checks for spam here. _check_spam() called each of them.
|
|
# Moved to Selima::Init. It starts at an early phrase before database initialization.
|
|
#
|
|
# _check_spam: Check the spam
|
|
sub _check_spam : method {
|
|
local ($_, %_);
|
|
# Check the CAPTCHA
|
|
$_[0]->_check_captcha;
|
|
# Check the local content filter
|
|
$_[0]->_checkspam_local if $_[0]->can("_checkspam_local");
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _check_captcha: The default CAPTCHA checker
|
|
sub _check_captcha : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $col, $error);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
$col = FORM_CAPTCHA;
|
|
# Check if it exists
|
|
$error = $self->_missing($col);
|
|
return $error if defined $error;
|
|
$self->_block_spam("_check_captcha: captcha column \"$col\" should be empty but got \""
|
|
. $form->param($col) . "\".")
|
|
if $form->param($col) ne "";
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _block_spam: Block the spam message
|
|
sub _block_spam : method {
|
|
local ($_, %_);
|
|
my ($self, $msg);
|
|
($self, $msg) = @_;
|
|
spamlog $msg;
|
|
# Disconnect now. Leave resources for meaningful requests
|
|
$DBH->rollback;
|
|
$DBH->disconnect;
|
|
undef $DBH;
|
|
# Delay the spammer
|
|
sleep 300;
|
|
http_403(0);
|
|
# No return
|
|
}
|
|
|
|
#
|
|
# Private form redirectors. Do not call them directly.
|
|
# Add redirector definitions here.
|
|
# Method names must be in the following format:
|
|
# sub _redir_{column} : method { ... }
|
|
# Columns started with underlines are reserved for internal use, as usual.
|
|
#
|
|
# _redir_del: Suspend and move to the deletion form
|
|
sub _redir_del : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if $self->_missing("del");
|
|
# Skip if S/N does not exist
|
|
return if $self->_missing("sn");
|
|
@_ = qw();
|
|
push @_, "form=del";
|
|
push @_, "sn=" . uri_escape($self->{"form"}->param("sn"));
|
|
call_form FORM_THIS, [@_];
|
|
}
|
|
|
|
# _redir_zhsync: Synchronize Chinese columns
|
|
sub _redir_zhsync : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $lndb);
|
|
$self = $_[0];
|
|
$form = $self->{"form"};
|
|
# Skip if not requested
|
|
return if $self->_missing("zhsync");
|
|
%_ = map { $_ => 1 } @ALL_LINGUAS;
|
|
$_ = getlang;
|
|
# We are at a subordinary language
|
|
if ($_ ne $DEFAULT_LANG) {
|
|
# We are in Simplified Chinese and there is Traditional Chinese
|
|
if ($_ eq "zh-cn" && exists $_{"zh-tw"}) {
|
|
$lndb = ln "zh-tw", LN_DATABASE;
|
|
# Convert the form
|
|
$form->param($_, trad_to_simp($CURRENT{$_ . "_$lndb"}))
|
|
foreach grep s/_$lndb$//, keys %CURRENT;
|
|
|
|
# We are in Traditional Chinese and there is Simplified Chinese
|
|
} elsif ($_ eq "zh-tw" && exists $_{"zh-cn"}) {
|
|
$lndb = ln "zh-cn", LN_DATABASE;
|
|
# Convert the form
|
|
$form->param($_, simp_to_trad($CURRENT{$_ . "_$lndb"}))
|
|
foreach grep s/_$lndb$//, keys %CURRENT;
|
|
}
|
|
}
|
|
# Show the form again
|
|
success_redirect undef;
|
|
}
|
|
|
|
# _redir_cancel: Cancel the form and return to the originator
|
|
sub _redir_cancel : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if $self->_missing("cancel");
|
|
# A calling form -- return to the caller
|
|
if (!$self->_missing("caller", "cformid")) {
|
|
$_ = $self->{"form"}->param("caller");
|
|
$_ = $self->{"form"}->param("hostport") . $_
|
|
if !$self->_missing("hostport");
|
|
$_ = add_get_arg($_, "formid", $self->{"form"}->param("cformid"));
|
|
if ($ENV{"REQUEST_METHOD"} eq "POST") {
|
|
http_303 $_;
|
|
} else {
|
|
http_307 $_;
|
|
}
|
|
}
|
|
# Referer2 specified -- return to referer2
|
|
if (!$self->_missing("referer2")) {
|
|
$_ = $self->{"form"}->param("referer2");
|
|
# Return to the hostport
|
|
} elsif (!$self->_missing("hostport")) {
|
|
$_ = $self->{"form"}->param("hostport") . "/magicat/";
|
|
} else {
|
|
$_ = "/magicat/";
|
|
}
|
|
if ($ENV{"REQUEST_METHOD"} eq "POST") {
|
|
http_303 $_;
|
|
} else {
|
|
http_307 $_;
|
|
}
|
|
}
|
|
|
|
# _redir_selgrp: Suspend and move to the group selection form
|
|
sub _redir_selgrp : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if !defined $self->{"form"}->param("selgrp");
|
|
call_form FORM_GROUPS, undef, "import_selgrp";
|
|
}
|
|
|
|
# _redir_delgrp: Remove the group
|
|
sub _redir_delgrp : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if !defined $self->{"form"}->param("delgrp");
|
|
$self->{"form"}->delete("grp");
|
|
success_redirect undef;
|
|
}
|
|
|
|
# _redir_selparent: Suspend and move to the parent selection form
|
|
sub _redir_selparent : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if $self->_missing("selparent");
|
|
call_form FORM_THIS, undef, "import_selparent";
|
|
}
|
|
|
|
# _redir_delparent: Remove the parent
|
|
sub _redir_delparent : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Skip if not requested
|
|
return if $self->_missing("delparent");
|
|
$self->{"form"}->delete("parent");
|
|
success_redirect undef;
|
|
}
|
|
|
|
#
|
|
# Private utility methods. Do not override them.
|
|
#
|
|
# _missing: Check if certain columns are submitted
|
|
sub _missing : method {
|
|
local ($_, %_);
|
|
my ($self, @cols);
|
|
($self, @cols) = @_;
|
|
%_ = map { $_ => 1 } $self->{"form"}->param;
|
|
foreach (@cols) {
|
|
return {"msg"=>N_("The following field was not received: \"[_1]\"."),
|
|
"margs"=>[$_],
|
|
"isform"=>0}
|
|
if !exists $_{$_};
|
|
}
|
|
# OK
|
|
return;
|
|
}
|
|
|
|
# _trim: Trim spaces from both sides of a field
|
|
sub _trim : method {
|
|
local ($_, %_);
|
|
my ($self, @cols);
|
|
($self, @cols) = @_;
|
|
foreach my $col (@cols) {
|
|
s/^\s*(.*?)\s*$/$1/s foreach @{$self->{"form"}->param_fetch($col)}
|
|
}
|
|
return;
|
|
}
|
|
|
|
# _trimtext: Trim spaces and blank lines from both sides of a text
|
|
sub _trimtext : method {
|
|
local ($_, %_);
|
|
my ($self, @cols);
|
|
($self, @cols) = @_;
|
|
foreach my $col (@cols) {
|
|
foreach (@{$self->{"form"}->param_fetch($col)}) {
|
|
# Trim blank lines
|
|
s/^(?:\s*\n)?(.*?)\s*$/$1/s;
|
|
# Trim the trailing spaces of each line
|
|
s/[^\S\n]+\n/\n/g;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
return 1;
|