Initial commit.
This commit is contained in:
219
htdocs/htc/cgi-bin/counter.cgi
Executable file
219
htdocs/htc/cgi-bin/counter.cgi
Executable file
@@ -0,0 +1,219 @@
|
||||
#! /usr/bin/perl -w
|
||||
# History: Theory and Culture
|
||||
# counter.cgi: The visitor counter.
|
||||
|
||||
# Copyright (c) 2003-2021 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: 2003-04-07
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::htc;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub dont_update();
|
||||
sub read_counter();
|
||||
sub update_counter();
|
||||
sub log_visitor($);
|
||||
sub counter_cookie();
|
||||
sub html_image($);
|
||||
|
||||
use Fcntl qw(:seek);
|
||||
use Date::Format qw(time2str);
|
||||
use GD;
|
||||
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||
use Net::CIDR::Lite qw();
|
||||
|
||||
use constant DATA_FILE => $ENV{"DOCUMENT_ROOT"} . "/magicat/data/counter.dat";
|
||||
use constant LOG_FILE => "/var/log/apache2/htc/counter.log";
|
||||
use vars qw($OUR_NETWORKS @FGCOLOR @BGCOLOR $FONT);
|
||||
# People in our networks will not be counted
|
||||
$OUR_NETWORKS = Net::CIDR::Lite->new(
|
||||
qw(127.0.0.1/8 10.0.0.0/8 211.20.30.96/29));
|
||||
@FGCOLOR = (0, 0, 0); # #000000 Black
|
||||
@BGCOLOR = (255, 255, 255); # #FFFFFF White
|
||||
$FONT = gdLargeFont;
|
||||
use constant TRANSPARENT => 1;
|
||||
use constant COOKIE_NAME => "counter";
|
||||
use constant COUNT_ARG => "countme";
|
||||
use constant IGNORE_ARG => "ignoreme";
|
||||
initenv( -allowed => [qw(GET HEAD)],
|
||||
-session => 0,
|
||||
-dbi => DBI_NONE,
|
||||
-lastmod => 0,
|
||||
-multilang => 0);
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
|
||||
# If we should not update the counter
|
||||
if (dont_update) {
|
||||
# Check last-modified here
|
||||
my (@tables, @files);
|
||||
@tables = qw();
|
||||
@files = (DATA_FILE);
|
||||
http_304 if not_modified @tables, @files;
|
||||
html_image read_counter;
|
||||
|
||||
# Update the counter
|
||||
} else {
|
||||
$_ = html_image update_counter;
|
||||
# Log the visitor
|
||||
log_visitor $_;
|
||||
}
|
||||
|
||||
# Set the counter cookie
|
||||
$NEWCOOKIES{COOKIE_NAME()} = $_ if defined ($_ = counter_cookie);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# dont_update: If we should not update the counter
|
||||
sub dont_update() {
|
||||
local ($_, %_);
|
||||
# Find any reason that we should not update the counter
|
||||
# If this visitor came from our own network
|
||||
return 1 if $OUR_NETWORKS->find($ENV{"REMOTE_ADDR"});
|
||||
# If this visitor had been counted
|
||||
return 1 if exists $COOKIES{COOKIE_NAME()};
|
||||
# If we are not told to count this visitor
|
||||
return 1 if !defined $GET->param(COUNT_ARG);
|
||||
# Well, update it
|
||||
return 0;
|
||||
}
|
||||
|
||||
# read_counter: Read the counter
|
||||
sub read_counter() {
|
||||
return -s DATA_FILE? xfread DATA_FILE: 0;
|
||||
}
|
||||
|
||||
# update_counter: Update the counter
|
||||
sub update_counter() {
|
||||
local ($_, %_);
|
||||
# File exists
|
||||
if (-s DATA_FILE) {
|
||||
my $FH;
|
||||
open $FH, "+<", DATA_FILE or http_500 DATA_FILE . ": $!";
|
||||
flock $FH, LOCK_EX or http_500 DATA_FILE . ": $!";
|
||||
$_ = <$FH>;
|
||||
$_++;
|
||||
seek $FH, 0, SEEK_SET or http_500 DATA_FILE . ": $!";
|
||||
truncate $FH, 0 or http_500 DATA_FILE . ": $!";
|
||||
print $FH $_ or http_500 DATA_FILE . ": $!";
|
||||
flock $FH, LOCK_UN or http_500 DATA_FILE . ": $!";
|
||||
close $FH or http_500 DATA_FILE . ": $!";
|
||||
|
||||
# Not exists or zero sized -- create a new one
|
||||
} else {
|
||||
xfwrite DATA_FILE, ($_ = 1);
|
||||
}
|
||||
return $_;
|
||||
}
|
||||
|
||||
# log_visitor: Log the visitor
|
||||
sub log_visitor($) {
|
||||
local ($_, %_);
|
||||
my ($host, $user, $date, $uri, $size, $referer, $ua, $langs, $FD);
|
||||
$size = $_[0];
|
||||
|
||||
# Gather the infomation to log
|
||||
$host = (defined remote_host)? remote_host: $ENV{"REMOTE_ADDR"};
|
||||
$user = (exists $ENV{"REMOTE_USER"} && $ENV{"REMOTE_USER"} ne "")?
|
||||
$ENV{"REMOTE_USER"}: "-";
|
||||
$date = time2str("%d/%b/%Y:%T %z", time);
|
||||
$uri = $REQUEST_URI;
|
||||
$referer = (exists $ENV{"HTTP_REFERER"} && $ENV{"HTTP_REFERER"} ne "")?
|
||||
$ENV{"HTTP_REFERER"}: "-";
|
||||
$ua = (exists $ENV{"HTTP_USER_AGENT"} && $ENV{"HTTP_USER_AGENT"} ne "")?
|
||||
$ENV{"HTTP_USER_AGENT"}: "=";
|
||||
$langs = (exists $ENV{"HTTP_ACCEPT_LANGUAGE"} && $ENV{"HTTP_ACCEPT_LANGUAGE"} ne "")?
|
||||
$ENV{"HTTP_ACCEPT_LANGUAGE"}: "-";
|
||||
|
||||
# Compose the log record 組合紀錄行
|
||||
$_ = sprintf "%s - %s [%s] \"%s %s %s\" 200 %s \"%s\" \"%s\" \"%s\" %s %s\n",
|
||||
$host, $user, $date, $ENV{"REQUEST_METHOD"}, $uri,
|
||||
$ENV{"SERVER_PROTOCOL"}, $size, $referer, $ua, $langs,
|
||||
$ENV{"REMOTE_ADDR"}, country_lookup($ENV{"REMOTE_ADDR"});
|
||||
|
||||
# Save the log record 儲存記錄
|
||||
xfappend LOG_FILE, $_;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# counter_cookie: Set the counter cookie
|
||||
sub counter_cookie() {
|
||||
local ($_, %_);
|
||||
# Leave our network alone
|
||||
return if $OUR_NETWORKS->find($ENV{"REMOTE_ADDR"});
|
||||
# Already set
|
||||
return if exists $COOKIES{COOKIE_NAME()};
|
||||
# Count me
|
||||
return new CGI::Cookie( -name=>COOKIE_NAME,
|
||||
-value=>"counted",
|
||||
-path=>$REQUEST_PATH)
|
||||
if defined $GET->param(COUNT_ARG);
|
||||
# Ignore me
|
||||
return new CGI::Cookie( -name=>COOKIE_NAME,
|
||||
-value=>"ignored",
|
||||
-path=>$REQUEST_PATH)
|
||||
if defined $GET->param(IGNORE_ARG);
|
||||
# Leave it alone
|
||||
return;
|
||||
}
|
||||
|
||||
# html_image: Make the image from the counter value
|
||||
sub html_image($) {
|
||||
local $_;
|
||||
my ($counter, $image, $width, $height, $fgcolor, $bgcolor);
|
||||
$counter = $_[0];
|
||||
|
||||
# Group the counter with commas at thousand digits.
|
||||
$counter = fmtno($counter);
|
||||
|
||||
# Initialize the image object
|
||||
# Get the width and height
|
||||
$width = $FONT->width * (length $counter);
|
||||
$height = $FONT->height;
|
||||
# Create an image object
|
||||
$image = GD::Image->new($width, $height);
|
||||
# Create the forground/background color objects
|
||||
$fgcolor = $image->colorAllocate(@FGCOLOR);
|
||||
$bgcolor = $image->colorAllocate(@BGCOLOR);
|
||||
|
||||
# Draw the image
|
||||
# Set the transparent background
|
||||
$image->transparent($bgcolor) if TRANSPARENT;
|
||||
# Paint the background
|
||||
$image->filledRectangle(0, 0, $width, $height, $bgcolor);
|
||||
# Write the text
|
||||
$image->string($FONT, 0, 0, $counter, $fgcolor);
|
||||
|
||||
# Output
|
||||
$CONTENT_TYPE = "image/png";
|
||||
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":raw";
|
||||
$_ = $image->png;
|
||||
print $_;
|
||||
|
||||
return length $_;
|
||||
}
|
||||
Reference in New Issue
Block a user