#! /usr/bin/perl -w
# reslog: Reverse-resolve IP in Apache log files
# Copyright (c) 2000-2007 imacat
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# First written: 2000-12-22
package main;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_FAIL);
push @EXPORT, qw(KEEP_ALL KEEP_RESTART KEEP_DELETE);
push @EXPORT, qw(TYPE_PLAIN TYPE_GZIP TYPE_BZIP2);
push @EXPORT, qw(TMP_SUFFIX whereis rel2abs show_progress);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub main();
sub parse_args();
sub whereis($);
sub rel2abs($;$);
sub show_progress($$$);
}
use Config qw();
use Cwd qw(cwd);
use ExtUtils::MakeMaker qw();
use File::Basename qw(basename);
use File::Spec::Functions qw(devnull file_name_is_absolute path catfile
splitdir curdir updir);
use File::Temp qw(tempfile);
use Getopt::Long qw(GetOptions);
use IO::Handle;
our ($THIS_FILE, $VERBOSE);
use vars qw($VERSION);
$THIS_FILE = basename($0);
$VERSION = "3.16";
$VERBOSE = 1;
# Constants
# The override mode
use constant OVERRIDE_OVERWRITE => "overwrite";
use constant OVERRIDE_APPEND => "append";
use constant OVERRIDE_FAIL => "fail";
use constant DEFAULT_OVERRIDE => OVERRIDE_FAIL;
# The keep mode
use constant KEEP_ALL => "all";
use constant KEEP_RESTART => "restart";
use constant KEEP_DELETE => "delete";
use constant DEFAULT_KEEP => KEEP_DELETE;
# The file types
use constant TYPE_PLAIN => "text/plain";
use constant TYPE_GZIP => "application/x-gzip";
use constant TYPE_BZIP2 => "application/x-bzip2";
# Other constants
use constant TMP_SUFFIX => ".tmp-reslog";
use constant DEFAULT_SUFFIX => ".resolved";
use constant DEFAULT_STDOUT => 0;
use constant DEFAULT_THREADS => 10;
use constant DEFAULT_PROGBAR => 1;
our (%CONF, @LOGFILES, $RESOLVER, $START, $LASTLINE, $STDIN, $STDOUT);
use vars qw(%WHEREIS);
use vars qw($VERMSG $HELPMSG);
our $SHORTHELP;
$VERMSG = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>";
$SHORTHELP = "Try `$THIS_FILE --help' for more information.";
$HELPMSG = << "EOF";
Usage: $THIS_FILE [options] [logfile...]
Resolve IPs from the Apache access log.
-k,--keep mode What to keep in the logfile. Available modes are:
all, restart and delete. The default is "delete".
-o,--override mode What to do when the target file exists. Available
modes are: overwrite, append and fail. The default
is "fail".
-s,--suffix suf The suffix to be appended to the output file. If not
specified, the default is ".resolved".
-t,--trim-suffix suf The suffix to be trimmed from the input file name
before appending the above suffix. Default is none.
If you are running several log file filters, this can
help you trim the suffix of the previous one.
-n,--num-threads num Number of threads to run simultaneously. The default
is 10. Use 0 to disable threading. This option has
no effect on systems that does not support threading.
-c,--stdout Output the result to STDOUT.
-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.
logfile The Apache access log file to be resolved.
It will copy the <logfile> to a temporary working file <logfile>-reslog and
restart the <logfile> first. Then it will resolve the <logfile>-reslog. The
result will be appended to the <logfile>.resolved and the temporary
<logfile>.tmp-reslog will be removed. If it stops in the middle, leaving an
unfinished <logfile>.tmp-reslog, resolve the <logfile>.tmp-reslog as an
ordinary log file.
EOF
main;
exit 0;
# main: Main program
sub main() {
local ($_, %_);
my ($c, $t0);
# Parse the arguments
parse_args;
# Create the temporary working files
$_->create_temp foreach @LOGFILES;
# Read the source files to temporary working files
$c = 0;
$c += $_->read_source foreach @LOGFILES;
printf STDERR "%d IP found in %d records\n", scalar(@{$RESOLVER->{"IP"}}), $c
if $VERBOSE > 0;
# Resolve the IP
$RESOLVER->resolve_all if scalar(@{$RESOLVER->{"IP"}}) > 0;
# Replace the IP with the host name and output to the resolved result
$_->write_result foreach @LOGFILES;
# Remove the temporary working files
$_->remove_temp foreach @LOGFILES;
print STDERR "Done. " . (time - $^T) . " seconds elapsed.\n"
if $VERBOSE > 0;
return;
}
# parse_args: Parse the arguments
sub parse_args() {
local ($_, %_);
%CONF = qw();
# Get the arguments
eval {
local $SIG{"__WARN__"} = sub { die $_[0]; };
Getopt::Long::Configure(qw(no_auto_abbrev bundling));
GetOptions( "keep|k=s"=>sub {
if ($_[1] =~ /^(?:a|all)?$/i) {
$CONF{"KEEP"} = KEEP_ALL;
} elsif ($_[1] =~ /^(?:r|restart)?$/i) {
$CONF{"KEEP"} = KEEP_RESTART;
} elsif ($_[1] =~ /^(?:d|delete)?$/i) {
$CONF{"KEEP"} = KEEP_DELETE;
} else {
die "$THIS_FILE: Unknown keep mode: $_[1]\n";
} },
"override|o=s"=>sub {
if ($_[1] =~ /^(?:o|overwrite)?$/i) {
$CONF{"OVERRIDE"} = OVERRIDE_OVERWRITE;
} elsif ($_[1] =~ /^(?:a|append)?$/i) {
$CONF{"OVERRIDE"} = OVERRIDE_APPEND;
} elsif ($_[1] =~ /^(?:f|fail)?$/i) {
$CONF{"OVERRIDE"} = OVERRIDE_FAIL;
} else {
die "$THIS_FILE: Unknown override mode: $_[1]\n";
} },
"suffix|s=s"=>sub { $CONF{"SUFFIX"} = $_[1]; },
"trim-suffix|t=s"=>sub { $CONF{"TRIM_SUFFIX"} = $_[1]; },
"num-threads|n=i"=>sub {
die "$THIS_FILE: Invalid number of threads: $_[1]\n"
if $_[1] < 0;
$CONF{"THREADS"} = $_[1]; },
"stdout|c!"=>sub { $CONF{"STDOUT"} = $_[1]; },
"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 "";
# Check the arguments
# Arguments are log files
@LOGFILES = qw();
%_ = qw();
while (@ARGV > 0) {
$_ = shift @ARGV;
# Treat /dev/stdin as - on UNIX-like systems
$_ = "-" if $_ eq "/dev/stdin" && devnull eq "/dev/null";
die "$THIS_FILE: $_: You can only specify a file once\n$SHORTHELP\n"
if exists $_{$_};
push @LOGFILES, $_;
$_{$_} = 1;
}
@LOGFILES = qw(-) if @LOGFILES == 0;
# Save the original STDIN and STDOUT
open $STDIN, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!";
open $STDOUT, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!";
# Set the verbose level
autoflush STDERR if $VERBOSE > 1;
$CONF{"PROGBAR"} = DEFAULT_PROGBAR;
$CONF{"PROGBAR"} = 0 if $VERBOSE == 0 || $VERBOSE > 2 || !-t STDERR;
if ($CONF{"PROGBAR"}) {
# Check if we have Term::ReadKey
$CONF{"PROGBAR"} = 0 unless eval { require Term::ReadKey; 1; };
}
# Set the default STDOUT mode
$CONF{"STDOUT"} = DEFAULT_STDOUT if !exists $CONF{"STDOUT"};
# If outputing to STDOUT
if ($CONF{"STDOUT"}) {
# Warn if not overwrite
warn "$THIS_FILE: Nonsense to override mode \"fail\" when outputing to STDOUT.\n"
if exists $CONF{"OVERRIDE"} && $CONF{"OVERRIDE"} eq OVERRIDE_FAIL;
# Always use overwrite
$CONF{"OVERRIDE"} = OVERRIDE_OVERWRITE;
# Default keep mode changed to keep all
$CONF{"KEEP"} = KEEP_ALL if !exists $CONF{"KEEP"};
}
# Set the default number of threads
if (!defined $Config::Config{"useithreads"}) {
warn "$THIS_FILE: Threading disabled because your OS or Perl does not support it.\n"
if defined $CONF{"THREADS"} && $CONF{"THREADS"} > 0;
$CONF{"THREADS"} = 0;
}
$CONF{"THREADS"} = DEFAULT_THREADS if !exists $CONF{"THREADS"};
# Set the default keep mode
$CONF{"KEEP"} = DEFAULT_KEEP if !exists $CONF{"KEEP"};
# Set the default override mode
$CONF{"OVERRIDE"} = DEFAULT_OVERRIDE if !exists $CONF{"OVERRIDE"};
# Set the default file name suffix to be appended
$CONF{"SUFFIX"} = DEFAULT_SUFFIX if !exists $CONF{"SUFFIX"};
# Set the default file name suffix to be trimmed
$CONF{"TRIM_SUFFIX"} = undef if !exists $CONF{"TRIM_SUFFIX"};
# The suffix to be appended cannot be the same as the suffix to be trimmed
die "$THIS_FILE: " . $CONF{"SUFFIX"} . ": Suffix cannot be the same as the suffix to be trimmed.\n"
if defined $CONF{"TRIM_SUFFIX"} && $CONF{"TRIM_SUFFIX"} eq $CONF{"SUFFIX"};
# Initialize the resolver
if ($CONF{"THREADS"}) {
$RESOLVER = new _private::Resolver::Threaded;
} else {
$RESOLVER = new _private::Resolver;
}
# Check the log files
@LOGFILES = map new _private::LogFile($_), @LOGFILES;
return;
}
# whereis: Find an executable
# Code inspired from CPAN::FirstTime
sub whereis($) {
local ($_, %_);
my ($file, $path);
$file = $_[0];
return $WHEREIS{$file} if exists $WHEREIS{$file};
foreach my $dir (path) {
print STDERR " Checking $dir ... " if $VERBOSE > 3;
if (defined($path = MM->maybe_command(catfile($dir, $file)))) {
print STDERR "$path\n found " if $VERBOSE > 3;
return ($WHEREIS{$file} = $path);
}
print STDERR "no\n" if $VERBOSE > 3;
}
return ($WHEREIS{$file} = undef);
}
# rel2abs: Convert a relative path to an absolute path
sub rel2abs($;$) {
local ($_, %_);
my ($path, $base);
($path, $base) = @_;
# Turn the base absolute
$base = cwd unless defined $base;
$base = rel2abs $base if !file_name_is_absolute $base;
# Deal with the ~ user home directories under UNIX
if (defined $Config::Config{"d_getpwent"}) {
@_ = splitdir($path);
# If it starts from the user home directory
if ($_[0] =~ /^~(.*)$/) {
my ($user, @pwent, $home);
$user = $1;
# The same as the current user
if ( (@pwent = getpwuid $>) > 0
&& ($user eq "" || $user eq $pwent[0])) {
# Replace with the user home directory
# Respect the HOME environment variable if exists
$home = exists $ENV{"HOME"}? $ENV{"HOME"}: $pwent[7];
@_ = (splitdir($home), @_[1...$#_]);
# Get the user home directory
} elsif ((@pwent = getpwnam $user) > 0) {
# Replace with the user home directory
$home = $pwent[7];
@_ = (splitdir($home), @_[1...$#_]);
}
# Compose the path
$path = catfile @_;
}
}
# Append the current directory if relative
$path = catfile($base, $path) unless file_name_is_absolute $path;
@_ = splitdir($path); # Split into directory components
# Add an empty filename level if last level is a directory
push @_, "" if ($_[@_-1] eq curdir || $_[@_-1] eq updir);
for ($_ = 1; $_ < @_; $_++) { # Parse each level one by one
# If it is this directory
if ($_[$_] eq curdir) {
splice @_, $_, 1; # Remove this level directly
$_--; # The level number drop by 1
# If it is the parent directory
} elsif ($_ > 1 && $_[$_] eq updir && $_[$_-1] ne updir) {
splice @_, $_-1, 2; # Remove this and the previous level
$_ -= 2; # The level number drop by 2
}
}
$path = catfile @_; # Compose the full path
return $path;
}
# show_progress: Show a progress bar
sub show_progress($$$) {
local ($_, %_);
my ($label, $cur, $total, $line, $width, $bar, $elapsed, $m, $s);
($label, $cur, $total) = @_;
# Disable line buffer
$| = 1;
# Not enough space for a progress bar
return if ($width = (Term::ReadKey::GetTerminalSize())[0] - 30) < 1;
# Start the timer
$START = time if !defined $START;
# Calculate the elapsed time
$elapsed = time - $START;
$s = $elapsed % 60;
$m = ($elapsed - $s) / 60;
# Calculate the percentage and the progress bar
$bar = "*" x sprintf("%1.0f", ($cur / $total) * $width);
# Compose the line
$line = sprintf "\r%-14.14s |%-".$width."s| %3.0f%% %02d:%02d",
$label, $bar, ($cur / $total) * 100, $m, $s;
# Print if changed
if (!defined $LASTLINE || $LASTLINE ne $line) {
# Print it
print STDERR "\r$line";
# Record the current line
$LASTLINE = $line;
}
# Finished
if ($cur == $total) {
print STDERR "\n";
undef $START;
}
return;
}
# _private::LogFile: The source log file
package _private::LogFile;
use 5.008;
use strict;
use warnings;
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
use File::Basename qw(fileparse);
# Constants
# The file type checkers
use constant MAGIC_PM => "File::MMagic";
use constant MAGIC_EXEC => "file";
use constant MAGIC_SUFFIX => "suffix";
use vars qw($MAGIC_METHOD $MAGIC);
undef $MAGIC_METHOD;
# new: Initialize the source log file processer
sub new : method {
local ($_, %_);
my ($class, $self, $file, $FH, $f0);
($class, $file) = @_;
# STDIN is another class
if ($file eq "-") {
$class .= "::STDIN";
return $class->new(@_[1...$#_]);
}
$self = bless {}, $class;
$self->{"stdin"} = 0;
$self->{"keep"} = $CONF{"KEEP"};
$self->{"override"} = $CONF{"OVERRIDE"};
$self->{"suffix"} = $CONF{"SUFFIX"};
$self->{"trim_suffix"} = $CONF{"TRIM_SUFFIX"};
$self->{"stdout"} = $CONF{"STDOUT"};
$self->{"tmp"} = undef;
# Load the File::MMagic first before opening anything, or the seek
# method will not be loaded into IO::Handle
$self->check_magic;
$self->{"checktype"} = $file if $MAGIC_METHOD eq MAGIC_EXEC;
$self->{"file"} = rel2abs $file;
($f0, $file) = ($file, $self->{"file"});
# Open the file
if ($self->{"keep"} eq KEEP_ALL) {
open $FH, $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_SH;
} else {
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
}
$self->{"FH"} = $FH;
# Check the file type
print STDERR "Checking file type of $f0 ... " if $VERBOSE > 1;
$self->{"type"} = $self->check_type;
print STDERR $self->{"type"} . "\n" if $VERBOSE > 1;
# Check the I/O handler to use
$self->{"io"} = $self->check_io;
# Check the output file availability
$self->check_output;
return $self;
}
# create_temp: Create the temporary working file
sub create_temp : method {
local ($_, %_);
my ($self, $temp, $FHT);
$self = $_[0];
$temp = $self->{"temp"};
print STDERR "Creating $temp ... " if $VERBOSE > 2;
open $FHT, "+>", $temp or die "$THIS_FILE: $temp: $!";
flock $FHT, LOCK_EX;
$self->{"FHT"} = $FHT;
print STDERR "done\n" if $VERBOSE > 2;
return $FHT;
}
# remove_temp: Remove the temporary working file
sub remove_temp : method {
local ($_, %_);
my ($self, $temp, $FHT);
$self = $_[0];
($FHT, $temp) = ($self->{"FHT"}, $self->{"temp"});
print STDERR "Removing $temp ... " if $VERBOSE > 2;
close $FHT or die "$THIS_FILE: $temp: $!";
unlink $temp or die "$THIS_FILE: $temp: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# read_source: Read the source file
sub read_source : method {
local ($_, %_);
my ($self, $file, $FHT, $count);
$self = $_[0];
($file, $FHT) = ($self->{"file"}, $self->{"FHT"});
print STDERR "Reading from $file ... " if $VERBOSE > 1;
print STDERR "\n" if $VERBOSE > 2;
$self->{"io"}->open_read($file, $self->{"FH"});
print STDERR " Reading source records ... " if $VERBOSE > 2;
$count = 0;
while (defined($_ = $self->{"io"}->readline)) {
_private::Filter->parse_line($_);
print $FHT $_ or die "$THIS_FILE: $!";
$count++;
}
print STDERR "$count records\n" if $VERBOSE > 2;
$self->{"io"}->close($self->{"keep"}, $self->{"tmp"});
print STDERR "$count records\n" if $VERBOSE > 1;
return $count;;
}
# write_result: Write the result file
sub write_result : method {
local ($_, %_);
my ($self, $file, $FHT, $FH, $count);
$self = $_[0];
($file, $FHT) = ($self->{"output"}, $self->{"FHT"});
$file = "STDOUT" if $self->{"stdout"};
undef $FH;
if ($self->{"stdout"}) {
open $FH, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!";
flock $FH, LOCK_EX;
}
if ($self->{"override"} eq OVERRIDE_OVERWRITE) {
print STDERR "Outputing to $file ... " if $VERBOSE > 1;
print STDERR "\n" if $VERBOSE > 2;
$self->{"io"}->open_write($file, $FH);
} else {
print STDERR "Appending to $file ... " if $VERBOSE > 1;
print STDERR "\n" if $VERBOSE > 2;
$self->{"io"}->open_append($file, $FH);
}
print STDERR " Outputing result records ... " if $VERBOSE > 2;
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: $!";
$count = 0;
while (defined($_ = <$FHT>)) {
$self->{"io"}->write(_private::Filter->replace_line($_));
$count++;
}
print STDERR "$count records\n" if $VERBOSE > 2;
$self->{"io"}->close;
print STDERR "$count records\n" if $VERBOSE > 1;
return $count;;
}
# check_type: Check the source file type
sub check_type : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
$self = $_[0];
($file, $FH) = ($self->{"file"}, $self->{"FH"});
# Check the file type checker to use
$self->check_magic;
die "$THIS_FILE: Cannot check STDIN from the filename suffix.\n"
if $self->{"stdin"} && $MAGIC_METHOD eq MAGIC_SUFFIX;
# Check by file name suffix
# Check by file name suffix on empty files, too.
# Compress::Bzip2 2 creates empty files that confuses further processing.
if (-z $FH || $MAGIC_METHOD eq MAGIC_SUFFIX) {
return TYPE_GZIP if $file =~ /\.gz$/;
return TYPE_BZIP2 if $file =~ /\.bz2$/;
# Otherwise we assume it to be text/plain
return TYPE_PLAIN;
}
# Check the file format
# Check by File::MMagic
if ($MAGIC_METHOD eq MAGIC_PM) {
$_ = $MAGIC->checktype_filehandle($FH);
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
# Check by the file program
} elsif ($MAGIC_METHOD eq MAGIC_EXEC) {
flock $FH, LOCK_UN;
@_ = ($MAGIC, $self->{"checktype"});
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
# Start the process
if ($^O eq "MSWin32") {
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
}
$_ = join "", <$PH>;
close $PH or die "$THIS_FILE: $CMD: $!";
if ($self->{"keep"} eq KEEP_ALL) {
flock $FH, LOCK_SH;
} else {
flock $FH, LOCK_EX;
}
}
# Check the returned file type text
return TYPE_GZIP if /gzip/i;
return TYPE_BZIP2 if /bzip2/i;
# Default everything to text/plain
return TYPE_PLAIN;
}
# check_io: Check the I/O handler to use
sub check_io : method {
local ($_, %_);
my $self;
$self = $_[0];
# We need a gzip compression I/O handler
return _private::IO->check_gzip if $self->{"type"} eq TYPE_GZIP;
# We need a bzip2 compression I/O handler
return _private::IO->check_bzip2 if $self->{"type"} eq TYPE_BZIP2;
# We need a plain I/O handler
return _private::IO::Plain->new;
}
# check_output: Check the availability of the output file
sub check_output : method {
local ($_, %_);
my ($self, $file, $dir, $suf, $temp, $FHT);
$self = $_[0];
if ($self->{"type"} eq TYPE_GZIP) {
($file, $dir, $suf) = fileparse $self->{"file"}, ".gz";
} elsif ($self->{"type"} eq TYPE_BZIP2) {
($file, $dir, $suf) = fileparse $self->{"file"}, ".bz2";
} else {
($file, $dir, $suf) = fileparse $self->{"file"};
}
$suf = "" if !defined $suf;
# Trim the suffix to be removed
($file, $dir) = fileparse $dir . $file, $self->{"trim_suffix"}
if defined $self->{"trim_suffix"};
# Is its directory writable? We need to create the temporary working
# file and possibly the ouput file there.
die "$THIS_FILE: $dir: Permission denied\n$SHORTHELP\n"
if !-w $dir;
# Check the temporary working file
$self->{"temp"} = $dir . $file . TMP_SUFFIX;
$_ = $self->{"temp"};
# Does the temporary working file exists?
die "$THIS_FILE: $_: Temporary working file exists\n$SHORTHELP\n"
if -e $_;
# Check the output file
# STDOUT
if ($self->{"stdout"}) {
$self->{"output"} = undef;
# STDOUT - always overwrite it
$self->{"override"} = OVERRIDE_OVERWRITE;
# Ordinary output file
} else {
$self->{"output"} = $dir . $file . $self->{"suffix"} . $suf;
# Output exists - is it writable?
if (-e $self->{"output"}) {
die "$THIS_FILE: " . $self->{"output"} . ": File exists\n$SHORTHELP\n"
if $self->{"override"} eq OVERRIDE_FAIL;
die "$THIS_FILE: " . $self->{"output"} . ": Not a file\n$SHORTHELP\n"
if !-f $self->{"output"};
die "$THIS_FILE: " . $self->{"output"} . ": Permission denied\n$SHORTHELP\n"
if !-w $self->{"output"};
# Output does not exist - always overwrite it
} else {
$self->{"override"} = OVERRIDE_OVERWRITE;
}
}
return;
}
# check_magic: Check the file type checker to use
sub check_magic : method {
local ($_, %_);
my $self;
$self = $_[0];
# Checked before
return $MAGIC_METHOD if defined $MAGIC_METHOD;
print STDERR "Checking file type checker to use ... " if $VERBOSE > 1;
print STDERR "\n Checking File::MMagic ... " if $VERBOSE > 2;
# Check if we have File::MMagic
if (eval { require File::MMagic; 1; }) {
print STDERR "OK\nfound " if $VERBOSE > 2;
print STDERR "File::MMagic\n" if $VERBOSE > 1;
$MAGIC = File::MMagic->new;
return ($MAGIC_METHOD = MAGIC_PM);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
$@ =~ s/^(Can't locate \S+ in \@INC).*\n/$1\n/; # '
warn "$@" if $VERBOSE == 1;
# Looking for file from PATH
print STDERR " Checking file ... " if $VERBOSE > 2;
# Found in PATH
if (defined($MAGIC = whereis "file")) {
print STDERR "$MAGIC\nfound " if $VERBOSE > 2;
print STDERR "$MAGIC\n" if $VERBOSE > 1;
warn "$THIS_FILE: We will check with $MAGIC instead\n"
if $VERBOSE > 0;
return ($MAGIC_METHOD = MAGIC_EXEC);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
# Check by file name suffix
print STDERR " Fall back using file name suffix instead\n" if $VERBOSE > 2;
print STDERR "file name suffix\n" if $VERBOSE > 1;
warn "$THIS_FILE: We will check by file name suffix instead\n"
if $VERBOSE == 1;
return ($MAGIC_METHOD = MAGIC_SUFFIX);
}
# _private::LogFile::STDIN: The source log file as STDIN
package _private::LogFile::STDIN;
use 5.008;
use strict;
use warnings;
use base qw(_private::LogFile);
BEGIN {
import main;
}
use IO::Handle;
use Fcntl qw(:flock :seek);
use File::Temp qw(tempfile unlink0);
# new: Initialize the source log file processer
sub new : method {
local ($_, %_);
my ($class, $self, $file, $FH, $tmp);
($class, $file) = @_;
# We only initialize STDIN
return $file if ref($file) ne "" || $file ne "-";
$self = bless {}, $class;
$self->{"stdin"} = 1;
$self->{"keep"} = KEEP_ALL;
$self->{"override"} = OVERRIDE_OVERWRITE;
$self->{"suffix"} = undef;
$self->{"trim_suffix"} = undef;
$self->{"stdout"} = 1;
$self->{"tmp"} = undef;
# Load the File::MMagic first before opening anything, or the seek
# method will not be loaded into IO::Handle
$self->check_magic;
# Save STDIN to somewhere
$file = "the STDIN buffer";
if ($_private::LogFile::MAGIC_METHOD eq _private::LogFile::MAGIC_EXEC) {
($FH, $tmp) = tempfile(undef, UNLINK => 1)
or die "$THIS_FILE: tempfile: $!";
$self->{"checktype"} = $tmp;
$self->{"tmp"} = $tmp;
} else {
undef $tmp;
$FH = tempfile or die "$THIS_FILE: tempfile: $!";
}
($self->{"FH"}, $self->{"file"}) = ($FH, $file);
flock $FH, LOCK_EX;
print STDERR "Saving STDIN to a buffer ... " if $VERBOSE > 1;
while (defined($_ = <STDIN>)) {
print $FH $_ or die "$THIS_FILE: $file: $!";
}
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 1;
# Check the file type
print STDERR "Checking file type of STDIN ... " if $VERBOSE > 1;
$self->{"type"} = $self->check_type;
print STDERR $self->{"type"} . "\n" if $VERBOSE > 1;
# Check the I/O handler to use
$self->{"io"} = $self->check_io;
# Set the output file
$self->{"output"} = undef;
# Unlink the temporarily working file first
if ($_private::LogFile::MAGIC_METHOD eq _private::LogFile::MAGIC_EXEC) {
unlink0($FH, $tmp) or die "$THIS_FILE: $tmp: $!";
}
return $self;
}
# create_temp: Create the temporary working file
sub create_temp : method {
local ($_, %_);
$_ = $_[0];
print STDERR "Creating temporary working file for STDIN ... " if $VERBOSE > 2;
$_->{"FHT"} = tempfile or die "$THIS_FILE: tempfile: $!";
flock $_->{"FHT"}, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
return $_->{"FHT"};
}
# remove_temp: Remove the temporary working file
sub remove_temp : method {
local ($_, %_);
$_ = $_[0];
print STDERR "Closing temporary working file for STDIN ... " if $VERBOSE > 2;
close $_->{"FHT"} or die "$THIS_FILE: tempfile: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# _private::IO: The abstract I/O handler interface
package _private::IO;
use 5.008;
use strict;
use warnings;
BEGIN {
import main;
}
use vars qw($GZIP_IO $BZIP2_IO);
undef $GZIP_IO;
undef $BZIP2_IO;
# new: Initialize the I/O handler interface
sub new : method { bless {}, $_[0]; }
# check_gzip: Check for compression method of gzip
sub check_gzip : method {
local ($_, %_);
# Checked before
return ref($GZIP_IO)->new if defined $GZIP_IO;
# See whether Compress::Zlib or gzip
print STDERR "Checking gzip I/O handler to use ... " if $VERBOSE > 1;
print STDERR "\n Checking Compress::Zlib ... " if $VERBOSE > 2;
# Check if we have Compress::Zlib
if (eval { require Compress::Zlib; 1; }) {
print STDERR "OK\nfound " if $VERBOSE > 2;
print STDERR "Compress::Zlib\n" if $VERBOSE > 1;
return ($GZIP_IO = _private::IO::Gzip::PM->new);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
# It's OK not to warn
# Looking for gzip from PATH
print STDERR " Checking gzip... " if $VERBOSE > 2;
# Found in PATH
if (defined($_ = whereis "gzip")) {
print STDERR "$_\nfound " if $VERBOSE > 2;
print STDERR "$_\n" if $VERBOSE > 1;
return ($GZIP_IO = _private::IO::Gzip::Exec->new);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
print STDERR "not found\n" if $VERBOSE > 1;
die "$THIS_FILE: Necessary Compress::Zlib or gzip not available.\n$SHORTHELP\n";
}
# check_bzip2: Check for compression method of bzip2
sub check_bzip2 : method {
local ($_, %_);
# Checked before
return ref($BZIP2_IO)->new if defined $BZIP2_IO;
# See whether Compress::Bzip2 or bzip2
print STDERR "Checking bzip2 I/O handler to use ... " if $VERBOSE > 1;
print STDERR "\n Checking Compress::Bzip2 ... " if $VERBOSE > 2;
# Check if we have Compress::Bzip2
if (eval { require Compress::Bzip2; import Compress::Bzip2 2.00; 1; }) {
print STDERR "OK\nfound " if $VERBOSE > 2;
print STDERR "Compress::Bzip2\n" if $VERBOSE > 1;
return ($BZIP2_IO = _private::IO::Bzip2::PM->new);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
# It's OK not to warn
# Looking for bzip2 from PATH
print STDERR " Checking bzip2... " if $VERBOSE > 2;
# Found in PATH
if (defined($_ = whereis "bzip2")) {
print STDERR "$_\nfound " if $VERBOSE > 2;
print STDERR "$_\n" if $VERBOSE > 1;
return ($BZIP2_IO = _private::IO::Bzip2::Exec->new);
}
# Not found
print STDERR "no\n" if $VERBOSE > 2;
print STDERR "not found\n" if $VERBOSE > 1;
die "$THIS_FILE: Necessary Compress::Bzip2 or bzip2 not available.\n$SHORTHELP\n";
}
# _private::IO::Plain: The plain I/O handle
package _private::IO::Plain;
use 5.008;
use strict;
use warnings;
use base qw(_private::IO);
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
# open_read: Open the file for reading
sub open_read : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
return;
}
# open_write: Open the file for writing
sub open_write : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
return;
}
# open_append: Open the file for appending
sub open_append : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in append mode ... " if $VERBOSE > 2;
open $FH, ">>", $file or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
return;
}
# readline: Read a line from the I/O stream
sub readline : method {
local ($_, %_);
my ($self, $FH);
$self = $_[0];
$FH = $self->{"FH"};
return <$FH>;
}
# write: Output data to the I/O stream
sub write : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $_) = @_;
($file, $FH) = ($self->{"file"}, $self->{"FH"});
print $FH $_ or die "$THIS_FILE: $file: $!";
return;
}
# close: Close the I/O stream
sub close : method {
local ($_, %_);
my ($self, $keep, $tmp, $file, $FH);
($self, $keep, $tmp) = @_;
$keep = KEEP_ALL if @_ < 2;
($file, $FH) = ($self->{"file"}, $self->{"FH"});
# Restart the file
if ($keep eq KEEP_RESTART) {
# Empty the source file
print STDERR " Emptying file ... " if $VERBOSE > 2;
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
CORE::close $FH or die "$THIS_FILE: $file: $!";
delete $self->{"FH"};
delete $self->{"file"};
# Delete the file
if ($keep eq KEEP_DELETE) {
print STDERR " Deleting file ... " if $VERBOSE > 2;
unlink $file or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
# Delete the temporary file if needed
if (defined $tmp && -e $tmp) {
unlink $tmp or die "$THIS_FILE: $tmp: $!";
}
return;
}
# _private::IO::Gzip::PM: The gzip module compression I/O handle
package _private::IO::Gzip::PM;
use 5.008;
use strict;
use warnings;
use base qw(_private::IO);
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
use File::Temp qw(tempfile);
# open_read: Open the file for reading
sub open_read : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Zlib qw(gzopen);
print STDERR " Attaching file with gzopen(..., \"rb\") ... " if $VERBOSE > 2;
$self->{"gz"} = gzopen($FH, "rb") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# open_write: Open the file for writing
sub open_write : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Zlib qw(gzopen);
print STDERR " Attaching file with gzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$self->{"gz"} = gzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# open_append: Open the file for appending
sub open_append : method {
local ($_, %_);
my ($self, $file, $FH, $gz);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Zlib qw(gzopen);
# Save the original data if file has content so that file size is
# greater than 0. STDOUT is always of size 0.
if ((stat $FH)[7] > 0) {
my ($count, $FHT, $gzt, $n);
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
# Copy the original content to a buffer
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
while (defined($_ = <$FH>)) {
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
}
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Restarting file ... " if $VERBOSE > 2;
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Decompress the buffer and save to our file
print STDERR " Attaching buffer with gzopen(..., \"rb\") ... " if $VERBOSE > 2;
$gzt = gzopen($FHT, "rb") or die "$THIS_FILE: tempfile: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Attaching file with gzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$gz = gzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
$count = 0;
while (($n = $gzt->gzreadline($_)) != 0) {
die "$THIS_FILE: tempfile: " . $gz->gzerror if $n == -1;
($gz->gzwrite($_) == $n) or die "$THIS_FILE: $file: " . $gz->gzerror;
$count++;
}
close $FHT or die "$THIS_FILE: tempfile: $!";
print STDERR "$count records\n" if $VERBOSE > 2;
# A whole new file
} else {
print STDERR " Attaching file with gzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$gz = gzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
$self->{"gz"} = $gz;
return;
}
# readline: Read a line from the I/O stream
sub readline : method {
local ($_, %_);
my ($self, $file, $gz, $n);
$self = $_[0];
($file, $gz) = ($self->{"file"}, $self->{"gz"});
(($n = $gz->gzreadline($_)) != -1) or die "$THIS_FILE: $file: " . $gz->gzerror;
return undef if $n == 0;
return $_;
}
# write: Output data to the I/O stream
sub write : method {
local ($_, %_);
my ($self, $file, $gz);
($self, $_) = @_;
($file, $gz) = ($self->{"file"}, $self->{"gz"});
($gz->gzwrite($_) == length $_) or die "$THIS_FILE: $file: " . $gz->gzerror;
return;
}
# close: Close the I/O stream
sub close : method {
local ($_, %_);
my ($self, $keep, $tmp, $file, $FH, $gz);
($self, $keep, $tmp) = @_;
$keep = KEEP_ALL if @_ < 2;
($file, $FH, $gz) = ($self->{"file"}, $self->{"FH"}, $self->{"gz"});
# Restart the file
if ($keep eq KEEP_RESTART) {
# Empty the source file
print STDERR " Emptying file ... " if $VERBOSE > 2;
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Create empty compressed content
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
$_ = gzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
$_->gzclose and die "$THIS_FILE: $file: " . $_->gzerror;
undef $_;
undef $gz;
print STDERR "done\n" if $VERBOSE > 2;
}
if (defined $gz) {
$gz->gzclose and die "$THIS_FILE: $file: " . $gz->gzerror;
}
CORE::close $self->{"FH"} if $self->{"FH"}->opened;
delete $self->{"gz"};
delete $self->{"FH"};
delete $self->{"file"};
# Delete the file
if ($keep eq KEEP_DELETE) {
print STDERR " Deleting file ... " if $VERBOSE > 2;
unlink $file or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
# Delete the temporary file if needed
if (defined $tmp && -e $tmp) {
unlink $tmp or die "$THIS_FILE: $tmp: $!";
}
return;
}
# _private::IO::Gzip::Exec: The gzip executable compression I/O handle
package _private::IO::Gzip::Exec;
use 5.008;
use strict;
use warnings;
use base qw(_private::IO);
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
use File::Temp qw(tempfile);
use vars qw($EXEC);
# open_read: Open the file for reading
sub open_read : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "gzip" if !defined $EXEC;
@_ = ($EXEC, "-cdf");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD from file ... " if $VERBOSE > 2;
# Redirect STDIN to $FH
open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDIN
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
print STDERR "done\n" if $VERBOSE > 2;
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# open_write: Open the file for writing
sub open_write : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "gzip" if !defined $EXEC;
@_ = ($EXEC, "-c9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# open_append: Open the file for appending
sub open_append : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "gzip" if !defined $EXEC;
# Save the original data if file has content so that file size is
# greater than 0. STDOUT is always of size 0.
if ((stat $FH)[7] > 0) {
my ($count, $FHT, $PHT, $CMDT);
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
# Copy the original content to a buffer
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
while (defined($_ = <$FH>)) {
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
}
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Restarting file ... " if $VERBOSE > 2;
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Decompress the buffer and save to our file
@_ = ($EXEC, "-cdf");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMDT = join " ", @_;
print STDERR " Starting $CMDT from buffer ... " if $VERBOSE > 2;
# Redirect STDIN to $FH
open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PHT, "$CMDT |" or die "$THIS_FILE: $CMDT: $!";
} else {
open $PHT, "-|", @_ or die "$THIS_FILE: $CMDT: $!";
}
# Restore STDIN
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
print STDERR "done\n" if $VERBOSE > 2;
@_ = ($EXEC, "-c9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
$count = 0;
while (defined($_ = <$PHT>)) {
print $PH $_ or die "$THIS_FILE: $file: $!";
$count++;
}
close $PHT or die "$THIS_FILE: $CMDT: $!";
close $FHT or die "$THIS_FILE: tempfile: $!";
print STDERR "$count records\n" if $VERBOSE > 2;
# A whole new file
} else {
@_ = ($EXEC, "-c9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# readline: Read a line from the I/O stream
sub readline : method {
local ($_, %_);
my ($self, $PH);
$self = $_[0];
$PH = $self->{"PH"};
return <$PH>;
}
# write: Output data to the I/O stream
sub write : method {
local ($_, %_);
my ($self, $CMD, $PH);
($self, $_) = @_;
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
print $PH $_ or die "$THIS_FILE: $CMD: $!";
return;
}
# close: Close the I/O stream
sub close : method {
local ($_, %_);
my ($self, $keep, $tmp, $file, $FH, $CMD, $PH);
($self, $keep, $tmp) = @_;
$keep = KEEP_ALL if @_ < 2;
($file, $FH) = ($self->{"file"}, $self->{"FH"});
# Restart the file
if ($keep eq KEEP_RESTART) {
# Empty the source file
print STDERR " Emptying file ... " if $VERBOSE > 2;
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Create empty compressed content
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
$EXEC = whereis "gzip" if !defined $EXEC;
@_ = ($EXEC, "-c9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process and end it
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
close $PH or die "$THIS_FILE: $CMD: $!";
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
CORE::close $PH or die "$THIS_FILE: $CMD: $!";
CORE::close $FH or die "$THIS_FILE: $file: $!";
delete $self->{"PH"};
delete $self->{"CMD"};
delete $self->{"FH"};
delete $self->{"file"};
# Delete the file
if ($keep eq KEEP_DELETE) {
print STDERR " Deleting file ... " if $VERBOSE > 2;
unlink $file or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
# Delete the temporary file if needed
if (defined $tmp && -e $tmp) {
unlink $tmp or die "$THIS_FILE: $tmp: $!";
}
return;
}
# _private::IO::Bzip2::PM: The bzip2 module compression I/O handle
package _private::IO::Bzip2::PM;
use 5.008;
use strict;
use warnings;
use base qw(_private::IO);
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
use File::Temp qw(tempfile);
# open_read: Open the file for reading
sub open_read : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Bzip2 qw(bzopen);
print STDERR " Attaching file with bzopen(..., \"rb\") ... " if $VERBOSE > 2;
$self->{"bz"} = bzopen($FH, "rb") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# open_write: Open the file for writing
sub open_write : method {
local ($_, %_);
my ($self, $file, $FH);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Bzip2 qw(bzopen);
print STDERR " Attaching file with bzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$self->{"bz"} = bzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
return;
}
# open_append: Open the file for appending
sub open_append : method {
local ($_, %_);
my ($self, $file, $FH, $bz);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
flock $FH, LOCK_EX;
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
import Compress::Bzip2 qw(bzopen);
# Save the original data if file has content so that file size is
# greater than 0. STDOUT is always of size 0.
if ((stat $FH)[7] > 0) {
my ($count, $FHT, $bzt, $n);
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
# Copy the original content to a buffer
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
while (defined($_ = <$FH>)) {
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
}
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Restarting file ... " if $VERBOSE > 2;
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Decompress the buffer and save to our file
print STDERR " Attaching buffer with bzopen(..., \"rb\") ... " if $VERBOSE > 2;
$bzt = bzopen($FHT, "rb") or die "$THIS_FILE: tempfile: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Attaching file with bzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$bz = bzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
$count = 0;
while (($n = $bzt->bzreadline($_)) != 0) {
die "$THIS_FILE: tempfile: " . $bz->bzerror if $n == -1;
($bz->bzwrite($_, length $_) == length $_)
or die "$THIS_FILE: $file: " . $bz->bzerror;
$count++;
}
close $FHT or die "$THIS_FILE: tempfile: $!";
print STDERR "$count records\n" if $VERBOSE > 2;
# A whole new file
} else {
print STDERR " Attaching file with bzopen(..., \"wb9\") ... " if $VERBOSE > 2;
$bz = bzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
$self->{"bz"} = $bz;
return;
}
# readline: Read a line from the I/O stream
sub readline : method {
local ($_, %_);
my ($self, $file, $bz, $n);
$self = $_[0];
($file, $bz) = ($self->{"file"}, $self->{"bz"});
(($n = $bz->bzreadline($_)) != -1) or die "$THIS_FILE: $file: " . $bz->bzerror;
return undef if $n == 0;
return $_;
}
# write: Output data to the I/O stream
sub write : method {
local ($_, %_);
my ($self, $file, $bz);
($self, $_) = @_;
($file, $bz) = ($self->{"file"}, $self->{"bz"});
($bz->bzwrite($_, length $_) == length $_)
or die "$THIS_FILE: $file: " . $bz->bzerror;
return;
}
# close: Close the I/O stream
sub close : method {
local ($_, %_);
my ($self, $keep, $tmp, $file, $FH, $bz);
($self, $keep, $tmp) = @_;
$keep = KEEP_ALL if @_ < 2;
($file, $FH, $bz) = ($self->{"file"}, $self->{"FH"}, $self->{"bz"});
# Restart the file
if ($keep eq KEEP_RESTART) {
# Empty the source file
print STDERR " Emptying file ... " if $VERBOSE > 2;
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Create empty compressed content
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
$_ = bzopen($FH, "wb9") or die "$THIS_FILE: $file: $!";
$_->bzclose and die "$THIS_FILE: $file: " . $_->bzerror;
undef $_;
undef $bz;
print STDERR "done\n" if $VERBOSE > 2;
}
if (defined $bz) {
$bz->bzclose and die "$THIS_FILE: $file: " . $bz->bzerror;
}
CORE::close $self->{"FH"} if $self->{"FH"}->opened;
delete $self->{"bz"};
delete $self->{"FH"};
delete $self->{"file"};
# Delete the file
if ($keep eq KEEP_DELETE) {
print STDERR " Deleting file ... " if $VERBOSE > 2;
unlink $file or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
# Delete the temporary file if needed
if (defined $tmp && -e $tmp) {
unlink $tmp or die "$THIS_FILE: $tmp: $!";
}
return;
}
# _private::IO::Bzip2::Exec: The bzip2 executable compression I/O handle
package _private::IO::Bzip2::Exec;
use 5.008;
use strict;
use warnings;
use base qw(_private::IO);
BEGIN {
import main;
}
use Fcntl qw(:flock :seek);
use File::Temp qw(tempfile);
use vars qw($EXEC);
# open_read: Open the file for reading
sub open_read : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "bzip2" if !defined $EXEC;
@_ = ($EXEC, "-cdf");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD from file ... " if $VERBOSE > 2;
# Redirect STDIN to $FH
open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "$CMD |" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "-|", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDIN
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
print STDERR "done\n" if $VERBOSE > 2;
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# open_write: Open the file for writing
sub open_write : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Creating file in write mode ... " if $VERBOSE > 2;
open $FH, "+>", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "bzip2" if !defined $EXEC;
@_ = ($EXEC, "-9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# open_append: Open the file for appending
sub open_append : method {
local ($_, %_);
my ($self, $file, $FH, $PH, $CMD);
($self, $file, $FH) = @_;
# Open the file if it is not opened yet
if (!defined $FH) {
print STDERR " Opening file in read/write mode ... " if $VERBOSE > 2;
open $FH, "+<", $file or die "$THIS_FILE: $file: $!";
binmode $FH or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
} else {
flock $FH, LOCK_UN;
}
($self->{"file"}, $self->{"FH"}) = ($file, $FH);
$EXEC = whereis "bzip2" if !defined $EXEC;
# Save the original data if file has content so that file size is
# greater than 0. STDOUT is always of size 0.
if ((stat $FH)[7] > 0) {
my ($count, $FHT, $PHT, $CMDT);
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
# Copy the original content to a buffer
print STDERR " Reading compressed data to the buffer ... " if $VERBOSE > 2;
$FHT = tempfile or die "$THIS_FILE: tempfile: $!";
while (defined($_ = <$FH>)) {
print $FHT $_ or die "$THIS_FILE: tempfile: $!";
}
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Restarting file ... " if $VERBOSE > 2;
seek $FHT, 0, SEEK_SET or die "$THIS_FILE: tempfile: $!";
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Decompress the buffer and save to our file
@_ = ($EXEC, "-cdf");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMDT = join " ", @_;
print STDERR " Starting $CMDT from buffer ... " if $VERBOSE > 2;
# Redirect STDIN to $FH
open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PHT, "$CMDT |" or die "$THIS_FILE: $CMDT: $!";
} else {
open $PHT, "-|", @_ or die "$THIS_FILE: $CMDT: $!";
}
# Restore STDIN
open STDIN, "<&", $STDIN or die "$THIS_FILE: STDIN: $!";
print STDERR "done\n" if $VERBOSE > 2;
@_ = ($EXEC, "-9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2;
$count = 0;
while (defined($_ = <$PHT>)) {
print $PH $_ or die "$THIS_FILE: $file: $!";
$count++;
}
close $PHT or die "$THIS_FILE: $CMDT: $!";
close $FHT or die "$THIS_FILE: tempfile: $!";
print STDERR "$count records\n" if $VERBOSE > 2;
# A whole new file
} else {
@_ = ($EXEC, "-9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
print STDERR " Starting $CMD to file ... " if $VERBOSE > 2;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH);
return;
}
# readline: Read a line from the I/O stream
sub readline : method {
local ($_, %_);
my ($self, $PH);
$self = $_[0];
$PH = $self->{"PH"};
return <$PH>;
}
# write: Output data to the I/O stream
sub write : method {
local ($_, %_);
my ($self, $CMD, $PH);
($self, $_) = @_;
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
print $PH $_ or die "$THIS_FILE: $CMD: $!";
return;
}
# close: Close the I/O stream
sub close : method {
local ($_, %_);
my ($self, $keep, $tmp, $file, $FH, $CMD, $PH);
($self, $keep, $tmp) = @_;
$keep = KEEP_ALL if @_ < 2;
($file, $FH) = ($self->{"file"}, $self->{"FH"});
# Restart the file
if ($keep eq KEEP_RESTART) {
my ($CMD, $PH);
# Empty the source file
print STDERR " Emptying file ... " if $VERBOSE > 2;
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
# Create empty compressed content
print STDERR " Applying empty compressed content ... " if $VERBOSE > 2;
$EXEC = whereis "bzip2" if !defined $EXEC;
@_ = ($EXEC, "-9f");
@_ = map "\"$_\"", @_ if $^O eq "MSWin32";
$CMD = join " ", @_;
# Redirect STDOUT to $FH
open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!";
# Start the process and end it
if ($^O eq "MSWin32") {
open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!";
} else {
open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!";
}
close $PH or die "$THIS_FILE: $CMD: $!";
# Restore STDOUT
open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"});
CORE::close $PH or die "$THIS_FILE: $CMD: $!";
CORE::close $FH or die "$THIS_FILE: $file: $!";
delete $self->{"PH"};
delete $self->{"CMD"};
delete $self->{"FH"};
delete $self->{"file"};
# Delete the file
if ($keep eq KEEP_DELETE) {
print STDERR " Deleting file ... " if $VERBOSE > 2;
unlink $file or die "$THIS_FILE: $file: $!";
print STDERR "done\n" if $VERBOSE > 2;
}
# Delete the temporary file if needed
if (defined $tmp && -e $tmp) {
unlink $tmp or die "$THIS_FILE: $tmp: $!";
}
return;
}
# _private::Filter: The log file filter
# The filter can be override to implementing different log file formats.
# Maybe GeoIP. Or MS-Extended, in the future.
package _private::Filter;
use 5.008;
use strict;
use warnings;
# parse_line: Parse the line to get an IP address
sub parse_line : method {
local ($_, %_);
$_ = $_[1];
# Skip malformed lines
return unless /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /;
$RESOLVER->add($1);
return;
}
# replace_line: Replace the line with the resolved result
sub replace_line : method {
local ($_, %_);
$_ = $_[1];
s/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /$RESOLVER->result($1) . " "/e;
return $_;
}
# _private::Resolver: The non-threaded resolver
package _private::Resolver;
use 5.008;
use strict;
use warnings;
BEGIN {
import main;
}
use Socket qw(inet_aton AF_INET);
use vars qw(%H_ERRNO %WSAERROR);
BEGIN {
%H_ERRNO = (-1 => "NETDB_INTERNAL",
0 => "NETDB_SUCCESS",
1 => "HOST_NOT_FOUND",
2 => "TRY_AGAIN",
3 => "NO_RECOVERY",
4 => "NO_DATA");
# Windows Sockets Error Codes
%WSAERROR = ( 10093 => "WSANOTINITIALISED",
10050 => "WSAENETDOWN",
11001 => "WSAHOST_NOT_FOUND",
11002 => "WSATRY_AGAIN",
11003 => "WSANO_RECOVERY",
11004 => "WSANO_DATA",
10036 => "WSAEINPROGRESS",
10047 => "WSAEAFNOSUPPORT",
10014 => "WSAEFAULT",
10004 => "WSAEINTR");
}
# new: Initialize the resolver
sub new : method {
local ($_, %_);
my ($class, $self);
$class = $_[0];
$self = bless {}, $class;
$self->{"threaded"} = 0;
$self->{"IP"} = [];
$self->{"PKIP"} = {};
$self->{"RESULT"} = {};
$self->{"DONE"} = 0;
return $self;
}
# add: Add an IP address
sub add : method {
local ($_, %_);
my ($self, $ip, $pkip);
($self, $ip) = @_;
# Skip malformed lines
return unless defined $ip;
# Skip duplicated IP
return if exists ${$self->{"PKIP"}}{$ip};
# Skip malformed IP
return unless defined($pkip = inet_aton $ip);
push @{$self->{"IP"}}, $ip;
${$self->{"PKIP"}}{$ip} = $pkip;
return;
}
# result: Return the resolved result of an IP address
sub result : method {
local ($_, %_);
my ($self, $ip);
($self, $ip) = @_;
return ${$self->{"RESULT"}}{$ip} if exists ${$self->{"RESULT"}}{$ip};
return $ip;
}
# sort: Sort the IP
sub sort : method {
local ($_, %_);
my ($self, $IP, $PKIP);
$self = $_[0];
($IP, $PKIP) = ($self->{"IP"}, $self->{"PKIP"});
$IP = [CORE::sort { $$PKIP{$a} cmp $$PKIP{$b} } @$IP];
return;
}
# resolve_all: Resolve the collected IP
sub resolve_all : method {
local ($_, %_);
my ($self, $t0, $IP, $RESULT);
$self = $_[0];
($IP, $RESULT) = ($self->{"IP"}, $self->{"RESULT"});
$t0 = time;
print STDERR "Resolving IP ... " if ($VERBOSE == 1 || $VERBOSE == 2) && !$CONF{"PROGBAR"};
# Sort to group neighber IP together for faster process
$self->sort;
for ($_ = 0; $_ < @$IP; $_++) {
$self->resolve_ip($_);
}
print STDERR "done\n" if ($VERBOSE == 1 || $VERBOSE == 2) && !$CONF{"PROGBAR"};
printf STDERR "Resolved %d IP from %d (%3.2f%%) in %d seconds\n",
scalar(keys %$RESULT), scalar(@$IP),
scalar(keys %$RESULT)*100/scalar(@$IP),
(time-$t0)
if $VERBOSE > 0;
return;
}
# show_result: Show the result
sub show_result : method {
local ($_, %_);
my ($self, $idx, $result, $IP, $label);
($self, $idx, $result) = @_;
$IP = $self->{"IP"};
# Show the progress bar
if ($CONF{"PROGBAR"}) {
$self->{"DONE"}++;
$label = sprintf "%d/%d", $self->{"DONE"}, scalar(@$IP);
show_progress $label, $self->{"DONE"}, scalar(@$IP);
# Show detail result
} elsif ($VERBOSE > 2) {
printf STDERR "[%d/%d] %s => %s\n",
$idx+1, scalar(@$IP), $$IP[$idx], $result;
}
return;
}
# Methods below are specific to DNS reverse-resolve, but can be overwrite for other type
# of resolving, like GeoIP.
# resolve_ip: Resolve an IP
sub resolve_ip : method {
local ($_, %_);
my ($self, $idx, $ip, $name, $result, $errno);
($self, $idx) = @_;
$ip = ${$self->{"IP"}}[$idx];
$? = 0 if $? != 0;
$name = gethostbyaddr ${$self->{"PKIP"}}{$ip}, AF_INET;
$errno = $?;
# Found
if (defined $name) {
${$self->{"RESULT"}}{$ip} = $name;
$result = $name;
# Not found
} else {
# MSWin32 use Windows Sockets Error Codes
if ($^O eq "MSWin32") {
# Error not returned
if (!defined $errno) {
$result = "failed (no error given)";
# Error not defined
} elsif (!exists $WSAERROR{$errno}) {
$result = "failed (error = $errno)";
# Report the error
} else {
$result = "failed ($WSAERROR{$errno})";
}
# Others use h_errno
} else {
# Error not returned
if (!defined $errno) {
$result = "failed (no h_errno given)";
# Error not defined
} elsif (!exists $H_ERRNO{$errno}) {
$result = "failed (h_errno = $errno)";
# Report the error
} else {
$result = "failed ($H_ERRNO{$errno})";
}
}
}
# Show the result
$self->show_result($idx, $result);
return;
}
# _private::Resolver::Threaded: The threaded resolver
package _private::Resolver::Threaded;
use 5.008;
use strict;
use warnings;
BEGIN {
eval "sub share {}"
if !eval { require threads;
require threads::shared;
import threads::shared;
1; };
}
use base qw(_private::Resolver);
BEGIN {
import main;
# Prototype declaration
sub resolve_in_a_thread($$);
}
use Fcntl qw(:flock);
# new: Initialize the resolver
sub new : method {
my ($class, $self);
$class = $_[0];
$self = $class->SUPER::new;
$self->{"threaded"} = 1;
$self->{"CURINDEX"} = 0;
share $self->{"IP"};
share $self->{"PKIP"};
share $self->{"RESULT"};
share $self->{"DONE"};
share $self->{"CURINDEX"};
share $START;
share $LASTLINE;
return $self;
}
# resolve_all: Resolve the collected IP
sub resolve_all : method {
local ($_, %_);
my ($self, $t0, $IP, $RESULT);
$self = $_[0];
($IP, $RESULT) = ($self->{"IP"}, $self->{"RESULT"});
$t0 = time;
print STDERR "Resolving IP ... " if ($VERBOSE == 1 || $VERBOSE == 2) && !$CONF{"PROGBAR"};
# Sort to group neighber IP together for faster process
$self->sort;
# Start the thread workers
for ($_ = 0, @_ = qw(); $_ < $CONF{"THREADS"}; $_++) {
push @_, threads->new(\&resolve_in_a_thread, $self, $_+1);
}
# Wait for everyone to end
$_->join foreach @_;
print STDERR "done\n" if ($VERBOSE == 1 || $VERBOSE == 2) && !$CONF{"PROGBAR"};
printf STDERR "Resolved %d IP from %d (%3.2f%%) in %d seconds\n",
scalar(keys %$RESULT), scalar(@$IP),
scalar(keys %$RESULT)*100/scalar(@$IP),
(time-$t0)
if $VERBOSE > 0;
return;
}
# show_result: Show the result
sub show_result : method {
local ($_, %_);
my ($self, $idx, $result, $IP, $label);
($self, $idx, $result) = @_;
$IP = $self->{"IP"};
# Lock to prevent simultaneous write to STDERR
flock STDERR, LOCK_EX;
# Show the progress bar
if ($CONF{"PROGBAR"}) {
lock $self->{"DONE"};
$self->{"DONE"}++;
$label = sprintf "%d/%d", $self->{"DONE"}, scalar(@$IP);
show_progress $label, $self->{"DONE"}, scalar(@$IP);
# Show detail result
} elsif ($VERBOSE > 2) {
printf STDERR "[t%d:%d/%d] %s => %s\n",
$self->{"tno"}, $idx+1, scalar(@$IP), $$IP[$idx], $result;
}
# Release the lock
flock STDERR, LOCK_UN;
return;
}
# resolve_in_a_thread: Proform URL checks in a thread
sub resolve_in_a_thread($$) {
local ($_, %_);
my ($self, $tno, $IP);
($self, $tno) = @_;
$self->{"tno"} = $tno;
$IP = $self->{"IP"};
if ($VERBOSE > 2) {
flock STDERR, LOCK_EX;
print STDERR "Thread $tno started.\n" ;
flock STDERR, LOCK_UN;
}
# Check until the end
$self->resolve_ip($_)
while ($_ = $self->newidx) < @$IP;
if ($VERBOSE > 2) {
flock STDERR, LOCK_EX;
print STDERR "Thread $tno finished.\n";
flock STDERR, LOCK_UN;
}
return;
}
# newidx: Obtain a new index
sub newidx($$) {
local ($_, %_);
my $self;
$self = $_[0];
lock $self->{"CURINDEX"};
return $self->{"CURINDEX"}++;
}
__END__
=head1 NAME
reslog - Reverse-resolve IP in Apache log files
=head1 SYNOPSIS
reslog [options] [logfile...]
reslog [-h|-v]
=head1 DESCRIPTION
F<reslog> resolves IPs in L<Apache(8)> log files. The result can
then be analyzed by another program, like Analog. You can think
of it as a replacement of the L<Apache(8)> C<HostNameLookups>
directive, in the sense that it resolves client IPs altogether once a
day.
I<Resolving takes long time>. This is mainly caused by resolving:
Network packets may be filtered by firewalls; DNS servers may not be
correctly configured; may not be up working; may sit in slow network
sections; may be old slow machines; may have traffic jam... etc. All
these reasons are out of our control.
If it stops in the middle of its execution, as when the user hits a
C<Ctrl-Break>, it may leave a temporary working file. The next time
it runs, it will stop when it sees that temporary working file at the
first sight. Please process that file first. You can resolve it
again, just like an ordinary log file.
This prorgam needs temporary working space. Between memory and disk
space, I choose disk space, since it is cheaper and may be available
in more environments. However, this means that it needs free
temporary disk space about 2 times of the size of the source log log
file (10 times if using memory). Please make sure you have that much
free space.
I suggest you to install L<File::MMagic(3)|File::MMagic/3> instead of
counting on the file executable. The internal magic file of
L<File::MMagic(3)|File::MMagic/3> seems to work better than the
L<file(1)|file/1> executable. F<reslog> treats everything not
L<gzip(1)|gzip/1> nor L<bzip2(1)|bzip2/1> compressed as plain text.
When a compressed log file is wrongly recognized as an image,
F<reslog> will treat it as plain text, read log records directly from
it and fail. This failure does not hurt the source log files, but is
still annoying.
=head1 OPTIONS
=over
=item logfile
The log file to be resolved. If not specified, it will read from
C<STDIN> and output to C<STDOUT>. You can also specify C<-> to read
from C<STDIN>. Multiple log files are supported. If one of these
files are C<STDIN>, it will output to C<STDOUT>. L<gzip(1)|gzip/1>
or L<bzip2(1)|bzip2/1> compressed files are supported, too.
=item -k,--keep mode
What to keep in the source file. Currently the following modes are
supported:
=over
=item a,all
Keep the source file after records are resolved.
=item r,restart
Restart the source file after records are resolved.
=item d,delete
Delete the source file after records are resolved. This is the
default.
=back
=item -o,--override mode
Whether we should overwrite the existing resolved files. Currently
the following modes are supported:
=over
=item o,overwrite
Overwrite any existing target file.
=item a,append
Append the records to the existing target file.
=item f,fail
Stop processing whenever a target file exists, to prevent destroying
any existing files by accident. This is the default.
=back
=item -s,--suffix suf
The suffix to be appended to the output file. If not specified, the
default is C<.resolved>.
=item -t,--trim-suffix suf
The suffix to be trimmed from the input file name before appending
the above suffix. Default is none. If you are running several log
file filters, this can help you trim the suffix of the previous one.
=item -n,--num-threads n
Number of threads to run simultaneously. The default is 10. Use 0
to disable threading. This option has no effect on systems that does
not support threading.
=item -c, --stdout
Output the result to C<STDOUT>.
=item -d, --debug
Show the detailed debugging messages.
=item -q, --quiet
Shihhhhhh. Only yell when errors.
=item -h, --help
Display the help message and exit.
=item -v, --version
Output version information and exit.
=back
=head1 VERSION
3.11
=head1 COPYRIGHT
Copyright (c) 2000-2007 imacat.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but I<WITHOUT ANY WARRANTY>; without even the implied warranty of
I<MERCHANTABILITY> or I<FITNESS FOR A PARTICULAR PURPOSE>. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see L<http://www.gnu.org/licenses/>.
=head1 AUTHOR
imacat <imacat@mail.imacat.idv.tw>.
You may visit reslog's website at:
L<http://reslog.sourceforge.net/>,
L<http://search.cpan.org/dist/reslog/> or
L<http://www.imacat.idv.tw/tech/reslog.html>.
=head1 BUGS
reslog has a mailing list reslog-users@lists.sourceforge.net. If you
have any question, comment, bug report, patch, please send it to the
mailing list. You may join the mailing list at
L<https://lists.sourceforge.net/lists/listinfo/reslog-users>. Do not
send mails directly to me unless you have private business with me.
The mailing list has an archive. People having the same trouble as
you may search the archive, find the answer and save a lot of time.
=head1 TODO
Multi-lingual support, with Traditional and Simplified Chinese
messages.
=head1 SEE ALSO
L<Compress::Zlib(3)>,
L<Compress::Bzip2(3)>,
L<perlthrtut(1)>, L<gzip(1)>, L<zlib(3)>,
L<bzip2(1)>.
=cut