imacat/selima-perl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit.

Browse Source
This commit is contained in:
依瑪貓
2026-03-10 21:25:26 +08:00
commit 78739bf725
3089 changed files with 472990 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

207
lib/perl5/Selima/Logging.pm Normal file
View File

@@ -0,0 +1,207 @@
# Selima Website Content Management System
# Logging.pm: The loggers.
# 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::Logging;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(log_error log_warn actlog sub check_actlog_file);
push @EXPORT, qw(spamlog check_spamlog_file $ACTLOG $SPAMLOG);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub log_error($);
sub log_warn($);
sub actlog($;$);
sub check_actlog_file();
sub spamlog($);
sub check_spamlog_file();
}
use Date::Format qw(time2str);
use Encode qw(encode is_utf8 FB_CROAK);
use File::Spec::Functions qw(catfile);
BEGIN {
if (exists $ENV{"MOD_PERL_API_VERSION"} && $ENV{"MOD_PERL_API_VERSION"} >= 2) {
require Apache2::Connection;
}
}
use Selima::DataVars qw(:env :siteconf :requri);
use Selima::HTTP;
use Selima::LogIn;
use Selima::RemoHost;
use Selima::XFileIO;
use vars qw($ACTLOG $SPAMLOG);
# log_error: Log to Apache error_log as error
sub log_error($) {
local ($_, %_);
my $remote;
$_ = $_[0];
chomp;
# mod_perl: use Apache->request->log_error
if ($IS_MODPERL) {
my $r;
$r = $IS_MP2? Apache2::RequestUtil->request: Apache->request;
$remote = defined remote_host? remote_host:
$r->connection->remote_ip;
$_ = sprintf "[client %s] %s", $remote, $_;
$r->log_error($_);
# Non-mod_perl: print to STDERR
} else {
$remote = defined remote_host? remote_host:
$ENV{"REMOTE_ADDR"};
$_ = sprintf "[client %s] %s", $remote, $_;
printf STDERR "[%s] [error] %s\n",
time2str("%a %b %e %T %Y", time), $_;
}
return;
}
# log_error: Log to Apache error_log as warning
sub log_warn($) {
local ($_, %_);
my $remote;
$_ = $_[0];
chomp;
# mod_perl: use Apache->request->log_error
if ($IS_MODPERL) {
my $r;
$r = $IS_MP2? Apache2::RequestUtil->request: Apache->request;
remote_host;
$remote = defined remote_host? remote_host:
$r->connection->remote_ip;
$_ = sprintf "[client %s] %s", $remote, $_;
$r->warn($_);
# Non-mod_perl: print to STDERR
} else {
$remote = defined remote_host? remote_host:
$ENV{"REMOTE_ADDR"};
$_ = sprintf "[client %s] %s", $remote, $_;
printf STDERR "[%s] [warn] %s\n",
time2str("%a %b %e %T %Y", time), $_;
}
return;
}
# actlog: Log an activity
sub actlog($;$) {
local ($_, %_);
my ($msg, $user, $remote);
($msg, $user) = @_;
# Set the file location of the activity log file
check_actlog_file;
# No valid activity log file is found
http_500 "Activity log actlog.txt not found"
if !defined $ACTLOG;
# Escape control characters for safety
$msg =~ s/\t/\\t/g;
$msg =~ s/\r/\\r/g;
$msg =~ s/\n/\\n/g;
$msg =~ s/([\x00-\x08\x0B\x0C\x0E-\x1F])/sprintf("\\x%02x", ord($1));/ge;
$msg = encode("UTF-8", $msg, FB_CROAK) if is_utf8($msg);
if (!defined $user) {
$user = defined get_login_id? get_login_id: "anonymous";
}
$remote = $IS_MODPERL? ($IS_MP2?
Apache2::RequestUtil->request->connection->remote_ip:
Apache->request->connection->remote_ip):
$ENV{"REMOTE_ADDR"};
$msg = sprintf "[%s] %s: (%s from %s) %s\n",
time2str("%Y-%m-%d %X %z", time), $REQUEST_PATH, $user, $remote, $msg;
xfappend($ACTLOG, $msg);
return;
}
# check_actlog_file: Check the activity log file
sub check_actlog_file() {
local ($_, %_);
# Gather the candidates
@_ = qw();
push @_, catfile("/var/log/apache2", $PACKAGE, "actlog.txt");
push @_, catfile("/var/log/apache2", "actlog.txt");
# Found
foreach (@_) {
return ($ACTLOG = $_) if -e $_ && -f $_ && -w $_;
}
# Not found
undef $ACTLOG;
return undef;
}
# spamlog: Log a suspicious spammer
sub spamlog($) {
local ($_, %_);
my ($msg, $remote);
$msg = $_[0];
# Set the file location of the activity log file
check_spamlog_file;
# No valid activity log file is found
http_500 "Spam log spamlog.txt not found"
if !defined $SPAMLOG;
# Escape control characters for safety
$msg =~ s/\t/\\t/g;
$msg =~ s/\r/\\r/g;
$msg =~ s/\n/\\n/g;
$msg =~ s/([\x00-\x08\x0B\x0C\x0E-\x1F])/sprintf("\\x%02x", ord($1));/ge;
$msg = encode("UTF-8", $msg, FB_CROAK) if is_utf8($msg);
$remote = $IS_MODPERL? ($IS_MP2?
Apache2::RequestUtil->request->connection->remote_ip:
Apache->request->connection->remote_ip):
$ENV{"REMOTE_ADDR"};
$msg = sprintf "[%s] %s: %s: (from %s) %s\n",
time2str("%Y-%m-%d %X %z", time), $PACKAGE, $REQUEST_PATH, $remote, $msg;
xfappend($SPAMLOG, $msg);
return;
}
# check_spamlog_file: Check the spammer log file
sub check_spamlog_file() {
local ($_, %_);
# Gather the candidates
@_ = qw();
push @_, catfile("/var/log/apache2", $PACKAGE, "spamlog.txt");
push @_, catfile("/var/log/apache2", "spamlog.txt");
# Found
foreach (@_) {
return ($SPAMLOG = $_) if -e $_ && -f $_ && -w $_;
}
# Not found
undef $SPAMLOG;
return undef;
}
return 1;