Initial commit.

This commit is contained in:
2026-03-10 21:25:26 +08:00
commit 78739bf725
3089 changed files with 472990 additions and 0 deletions

343
htdocs/wov/magicat/bin/r703alog Executable file
View File

@@ -0,0 +1,343 @@
#! /usr/bin/perl -w
# Filename: r703alog
# Description: Perl script to download r703a log files
# Author: imacat <imacat@mail.imacat.idv.tw>
# Date: 2000-12-21
# Copyright: (c) 2000-2007 imacat
use 5.006;
use strict;
use warnings;
use Compress::Zlib qw(gzopen);
use Fcntl qw(:flock :seek);
use File::Basename qw(basename);
use File::Temp qw(tempfile);
use Getopt::Long qw(GetOptions);
use IO::Handle qw(autoflush);
use IPC::Open3 qw(open3);
use Net::FTP qw();
use Socket qw();
# Prototype declaration
sub main();
sub parse_args();
sub is_member($@);
sub format_number($);
sub xfread($);
use vars qw($THIS_FILE $VERSION $VERBOSE);
$THIS_FILE = basename($0);
$VERSION = "2.03";
$VERBOSE = 1;
use vars qw($R_HOST $R_ID $R_PASSWD $R_DIR $L_DIR $FILELIST %DNS @RESLOG @ARCLOG);
$R_HOST = "r703a.chem.nthu.edu.tw";
$R_ID = "wov";
$R_PASSWD = undef;
$R_DIR = "/srv/www/logs";
$L_DIR = "/var/log/apache/wov/r703a";
$FILELIST = "$L_DIR/filelist.txt";
%DNS = qw();
@RESLOG = qw(/usr/sbin/reslog.pl --stdout);
@ARCLOG = qw(/usr/sbin/arclog.pl --keep=all --override=append --sort - /var/log/apache/wov/r703a/access_log);
use vars qw($VERMSG $SHORTHELP $HELPMSG);
$VERMSG = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>";
$SHORTHELP = "Try `$THIS_FILE --help' for more information.";
$HELPMSG = << "EOT";
Usage: $THIS_FILE [options]
Download and archive the r703a apache access log files.
-d,--debug Display debug messages. Multiple --debug to debug more.
-q,--quiet Disable debug messages. An opposite that cancels the
effect of --debug.
-h,--help Display this help.
-v,--version Display version number.
EOT
main;
exit 0;
# main: Main program
sub main() {
local ($_, %_);
my ($FTP, @downloaded, @files, $t0, $t);
my ($WORKING, $FH);
my ($file, $gz, $bytes);
my ($fc_total, $fc_acc, $fc_new);
my ($rc_total, $rc_valid, $rc_file_total, $rc_file_valid);
my ($errline, @errmsgs);
# Parse the arguments
parse_args;
# No longer a working script
print "Mission completed long time ago. Program stopped to avoid further problems.\n";
return;
# Get the downloaded files list
print STDERR "Fetching the downloaded list... " if $VERBOSE >= 2;
@downloaded = xfread $FILELIST;
@downloaded = grep /\S/, @downloaded;
@downloaded = grep !/^#/, @downloaded;
chomp foreach @downloaded;
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR "" . format_number(scalar @downloaded) . " downloaded files recorded in the downloaded list.\n" if $VERBOSE >= 1;
# Get the files list
print STDERR "Connecting to $R_HOST... " if $VERBOSE >= 2;
$FTP = new Net::FTP($R_HOST) or die "$THIS_FILE: Failed FTP connection: $@";
$FTP->login($R_ID, $R_PASSWD) or die "$THIS_FILE: Failed login: " . $FTP->code . " " . $FTP->message;
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR "Fetching the files list... " if $VERBOSE >= 2;
$FTP->cwd($R_DIR) or die "$THIS_FILE: Failed cwd $R_DIR: " . $FTP->code . " " . $FTP->message;
(@files = $FTP->ls()) or die "$THIS_FILE: Failed ls: " . $FTP->code . " " . $FTP->message;
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR "Filtering new access logs... " if $VERBOSE >= 2;
$fc_total = format_number(scalar @files);
@files = grep /^httpd-log\.[A-Z][a-z]{2}\d{4}\.gz$/, @files;
$fc_acc = format_number(scalar @files);
@files = grep !is_member($_, @downloaded), @files;
$fc_new = format_number(scalar @files);
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR "$fc_new new files found in $fc_acc access logs in $fc_total files.\n" if $VERBOSE >= 1;
if ($fc_new == 0) {
print STDERR "No new files found. Program exists\n" if $VERBOSE >= 1;
# Close the connection
print STDERR "Closing the FTP connection... " if $VERBOSE >= 2;
$FTP->quit or die "$THIS_FILE: ftp close: " . $FTP->code . " " . $FTP->message;
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR "Done. " . format_number($fc_new) . " files processed, " . format_number(time - $^T) . " seconds elapsed\n" if $VERBOSE >= 1;
return;
}
# Download the files
print STDERR "Now we will download the new files\n" if $VERBOSE >= 2;
$t0 = time;
foreach (@files) {
print STDERR "Downloading $_... " if $VERBOSE >= 1;
$t = time;
$FTP->get($_, "$L_DIR/$_") or die "$THIS_FILE: Failed get $L_DIR/$_: " . $FTP->code . " " . $FTP->message;
print STDERR "done, " . format_number(time - $t) . " seconds elapsed\n" if $VERBOSE >= 1;
}
print STDERR "Downloading finished, " . format_number(scalar @files) . " new files downloaded, " . format_number(time - $t0) . " seconds elapsed\n" if $VERBOSE >= 2;
# Close the connection
print STDERR "Closing the FTP connection... " if $VERBOSE >= 2;
$FTP->quit or die "$THIS_FILE: ftp close: " . $FTP->code . " " . $FTP->message;
print STDERR "done\n" if $VERBOSE >= 2;
# Create the temporary working file
print STDERR "Creating temporary working file... " if $VERBOSE >= 2;
($WORKING = tempfile) or die "$THIS_FILE: $!";
print STDERR "done\n" if $VERBOSE >= 2;
# Copy the needed records into temporary working file
print STDERR "Now we will copy records to the temporary working file\n" if $VERBOSE >= 2;
($rc_total, $rc_valid) = (0, 0);
foreach $file (@files) {
# Open the file
print STDERR "Opening $file... " if $VERBOSE >= 2;
$gz = gzopen("$L_DIR/$file", "rb")
or die "$THIS_FILE: $!";
print STDERR "done\n" if $VERBOSE >= 2;
# Copy to the temporary working file
print STDERR "Copying records... " if $VERBOSE >= 2;
($rc_file_total, $rc_file_valid) = (0, 0);
while (($bytes = $gz->gzreadline($_)) != 0) {
die "$THIS_FILE: " . $gz->gzerror() if $bytes == -1;
$rc_file_total++;
next unless / \/(~|%7E)wov/;
print $WORKING $_;
$rc_file_valid++;
}
print STDERR "done\n" if $VERBOSE >= 2;
print "" . format_number($rc_file_valid) . " valid records copied in " . format_number($rc_file_total) . " found records.\n" if $VERBOSE >= 2;
$rc_total += $rc_file_total;
$rc_valid += $rc_file_valid;
# Close the source file
print STDERR "Closing $file... " if $VERBOSE >= 2;
$gz->gzclose() && die "$THIS_FILE: " . $gz->gzerror();
print STDERR "done\n" if $VERBOSE >= 2;
# Deleting the source file
print STDERR "Deleting $file... " if $VERBOSE >= 2;
unlink "$L_DIR/$file" or die "$THIS_FILE: $L_DIR/$file: $!";
print STDERR "done\n" if $VERBOSE >= 2;
}
print STDERR "Copying finished\n" if $VERBOSE >= 2;
print STDERR "Totally " . format_number($rc_valid) . " valid records copied in " . format_number($rc_total) . " found records.\n" if $VERBOSE >= 1;
# Resolve the records
print STDERR "Now we will resolve the records\n" if $VERBOSE >= 1;
$t = time;
if ($VERBOSE >= 2) {
open3(\*DATA_W, \*DATA_R, \*DATA_E, @RESLOG, "--debug")
or die "$THIS_FILE: $!";
} else {
open3(\*DATA_W, \*DATA_R, \*DATA_E, @RESLOG, "--quiet")
or die "$THIS_FILE: $!";
}
seek $WORKING, 0, SEEK_SET or die "$THIS_FILE: $!";
print DATA_W $_ while defined($_ = <$WORKING>);
close DATA_W or die "$THIS_FILE: $!";
if ($VERBOSE >= 2) {
$errline = "";
while (defined($_ = getc DATA_E)) {
print STDERR $_ if $VERBOSE >= 2;
$errline =~ s/^[^\n]*\n$//;
$errline .= $_;
if ($errline eq "Printing to STDOUT... ") {
seek $WORKING, 0, SEEK_SET
or die "$THIS_FILE: $!";
truncate $WORKING, 0 or die "$THIS_FILE: $!";
print $WORKING $_ while defined($_ = <DATA_R>);
}
}
} else {
seek $WORKING, 0, SEEK_SET or die "$THIS_FILE: $!";
truncate $WORKING, 0 or die "$THIS_FILE: $!";
print $WORKING $_ while defined($_ = <DATA_R>);
}
close DATA_E or die "$THIS_FILE: $!";
close DATA_R or die "$THIS_FILE: $!";
wait;
die "$THIS_FILE: Failed reslog.pl with error code $?" if $? != 0;
print STDERR "Resolving finished, " . format_number(time - $t) . " seconds elapsed\n" if $VERBOSE >= 1;
# Archive the records
print STDERR "Now we will archive the records\n" if $VERBOSE >= 1;
$t = time;
if ($VERBOSE >= 2) {
open3(\*DATA_W, \*DATA_R, \*DATA_E, @ARCLOG)
or die "$THIS_FILE: $!";
} else {
open3(\*DATA_W, \*DATA_R, \*DATA_E, @ARCLOG, "--quiet")
or die "$THIS_FILE: $!";
}
seek $WORKING, 0, SEEK_SET or die "$THIS_FILE: $!";
print DATA_W $_ while defined($_ = <$WORKING>);
close DATA_W or die "$THIS_FILE: $!";
while (defined($_ = getc DATA_E)) {
print STDERR $_ if $VERBOSE >= 2;
}
close DATA_R or die "$THIS_FILE: $!";
close DATA_E or die "$THIS_FILE: $!";
wait;
die "$THIS_FILE: Failed arclog.pl with error code $?" if $? != 0;
print STDERR "Archiving finished, " . format_number(time - $t) . " seconds elapsed\n" if $VERBOSE >= 1;
# Close the temporary working file
print STDERR "Closing temporary working file... " if $VERBOSE >= 2;
close $WORKING or die "$THIS_FILE: $!";
print STDERR "done\n" if $VERBOSE >= 2;
# Write the new files to the downloaded list
print STDERR "Updating the downloaded list... " if $VERBOSE >= 2;
open $FH, ">>$FILELIST" or die "$THIS_FILE: $FILELIST: $!";
flock $FH, LOCK_EX or die "$THIS_FILE: $FILELIST: $!";
print $FH join "", map "$_\n", @files;
flock $FH, LOCK_UN or die "$THIS_FILE: $FILELIST: $!";
close $FH or die "$THIS_FILE: $FILELIST: $!";
print STDERR "done\n" if $VERBOSE >= 2;
print STDERR format_number(scalar @files) . " files processed\n"
if $VERBOSE > 0;
print STDERR "Done. " . (time - $^T) . " seconds elapsed.\n"
if $VERBOSE > 0;
return;
}
# parse_args: Parse the arguments
sub parse_args() {
local ($_, %_);
# Get the arguments
eval {
local $SIG{"__WARN__"} = sub { die $_[0]; };
Getopt::Long::Configure(qw(no_auto_abbrev bundling));
GetOptions( "debug|d+"=>\$VERBOSE,
"quiet|q"=>sub { $VERBOSE-- if $VERBOSE > 0; },
"help|h"=>sub { print $HELPMSG; exit 0; },
"version|v"=>sub { print "$VERMSG\n"; exit 0; });
};
die "$THIS_FILE: $@$SHORTHELP\n" if $@ ne "";
$| = 1 if $VERBOSE > 0;
# Check the arguments
# We have no arguments
die "$THIS_FILE: Too many arguments: $ARGV[0]\n$SHORTHELP\n"
if @ARGV > 0;
return;
}
# is_member: If a variable is a member of an array
sub is_member($@) {
local ($_, %_);
my ($v, @a);
($v, @a) = @_;
return 1 if grep ($_ eq $v, @a) > 0;
return 0;
}
# format_number: Format the number every 3 digit
sub format_number($) {
local ($_, %_);
$_ = $_[0];
# Group every 3 digit
$_ = $1 . "," . $2 . $3 while /^([^\.]*\d)(\d\d\d)(.*)$/;
return $_;
}
# xfread: Read from a file
sub xfread($) {
local ($_, %_);
my ($FH, $file);
$file = $_[0];
# Return as lines
if (wantarray) {
open $FH, $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
@_ = <$FH>;
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
close $FH or die "$THIS_FILE: $file: $!";
return @_;
# A scalar file content
} else {
# Regular files
if (-f $file) {
my $size;
@_ = stat $file or die "$THIS_FILE: $file: $!";
$size = $_[7];
return "" if $size == 0;
open $FH, $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
read $FH, $_, $size or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
close $FH or die "$THIS_FILE: $file: $!";
return $_;
# Special files
} else {
open $FH, $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
$_ = join "", <$FH>;
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
close $FH or die "$THIS_FILE: $file: $!";
return $_;
}
}
}
__END__