#! /usr/bin/perl -w # reslog: Reverse-resolve IP in Apache log files # Copyright (c) 2000-2005 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 2 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, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # 版權所有 (c) 2000-2005 依瑪貓 # # 本程式是自由軟體,您可以遵照自由軟體基金會( Free Software Foundation # )出版的 GNU 通用公共許可證條款( GNU General Public License )第二版 # 來修改和重新發佈這一程式,或者自由選擇使用任何更新的版本。 # # 發佈這一程式的目的是希望它有用,但沒有任何擔保。甚至沒有適合特定目的 # 而隱含的擔保。更詳細的情況請參閱 GNU 通用公共許可證。 # # 您應該已經和程式一起收到一份 GNU 通用公共許可證的副本。如果還沒有,寫 # 信給: Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # First written: 2000-12-22 package ResLog; use 5.7.2; use strict; use warnings; use threads; use threads::shared; use base qw(Exporter); use vars qw($VERSION @EXPORT @EXPORT_OK); $VERSION = "3.01"; BEGIN { @EXPORT = qw(); push @EXPORT, qw($THIS_FILE $SHORTHELP $VERBOSE TMP_SUFFIX); push @EXPORT, qw(OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_FAIL); push @EXPORT, qw(KEEP_ALL KEEP_RESTART KEEP_DELETE); push @EXPORT, qw(add_ip host whereis); @EXPORT_OK = @EXPORT; # Prototype declaration sub main(); sub parse_args(); sub add_ip($); sub host($); sub sort_ip(); sub resolve_all(); sub resolve_nonthread(); sub resolve_in_a_thread(); sub resolve_ip($$); sub show_progress($$$); sub whereis($); sub term_width(); } use Config qw(); use Fcntl qw(:flock); use File::Basename qw(basename); use File::Spec::Functions qw(path catfile); use Getopt::Long qw(GetOptions); use IO::Handle; use Socket qw(inet_aton AF_INET); # 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; # Other constants use constant DEFAULT_SUFFIX => ".resolved"; use constant TMP_SUFFIX => ".tmp-reslog"; use constant DEFAULT_STDOUT => 0; use constant DEFAULT_THREADS => 10; use vars qw(%H_ERRNO); %H_ERRNO = (-1 => "NETDB_INTERNAL", 0 => "NETDB_SUCCESS", 1 => "HOST_NOT_FOUND", 2 => "TRY_AGAIN", 3 => "NO_RECOVERY", 4 => "NO_DATA"); our ($CURINDEX, $DONE, @IP, %PKIP, %NAMES, $START, $LASTLINE) : shared; $CURINDEX = 0; $DONE = 0; @IP = qw(); %PKIP = qw(); %NAMES = qw(); undef $START; undef $LASTLINE; use vars qw($VERBOSE $PROGBAR $THREADS %WHEREIS); $VERBOSE = 1; $PROGBAR = 0; use vars qw($THIS_FILE $SHORTHELP $VERSTR $HELPSTR); $THIS_FILE = basename($0); $SHORTHELP = "Try `$THIS_FILE --help' for more information."; $VERSTR = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>"; $HELPSTR = << "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 "restart". -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 debugging messages. -q,--quiet Be quiet. Only yell when errors. -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>.tmp and restart the <logfile> first. Then it will resolve the <logfile>.tmp. The result will be appended to the <logfile>.resolved and the temporary <logfile>.tmp will be removed. If this program crashes during execution, leaving an unfinished <logfile>.tmp, you can specify -t to force resolving the <logfile>.tmp. EOF main; exit; # main: Main program sub main() { local ($_, %_); my (@logfiles, $count, $t0); # Parse the arguments @logfiles = parse_args; # Create the temporary working files $_->create_temp foreach @logfiles; # Read the source files to temporary working files $count = 0; $count += $_->read_source foreach @logfiles; printf STDERR "%d IP found in %d records\n", scalar(@IP), $count if $VERBOSE > 0; # Sort to group neighber IP together for faster process sort_ip; # Resolve the IP $t0 = time; resolve_all; printf STDERR "Resolved %d IP from %d (%3.2f%%) in %d seconds\n", scalar(keys %NAMES), scalar(@IP), scalar(keys %NAMES)*100/scalar(@IP), (time-$t0) if $VERBOSE > 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 ($_, %_); %_ = qw(); # Get the arguments 取得參數 eval { local $SIG{__WARN__} = sub { die $_[0]; }; Getopt::Long::Configure("no_auto_abbrev"); GetOptions( "keep|k=s"=>sub { if ($_[1] =~ /^(?:a|all)?$/i) { $_{"KEEP"} = KEEP_ALL; } elsif ($_[1] =~ /^(?:r|restart)?$/i) { $_{"KEEP"} = KEEP_RESTART; } elsif ($_[1] =~ /^(?:d|delete)?$/i) { $_{"KEEP"} = KEEP_DELETE; } else { die "$THIS_FILE: unknown keep mode: $_[1]\n"; } }, "override|o=s"=>sub { if ($_[1] =~ /^(?:o|overwrite)?$/i) { $_{"OVERRIDE"} = OVERRIDE_OVERWRITE; } elsif ($_[1] =~ /^(?:a|append)?$/i) { $_{"OVERRIDE"} = OVERRIDE_APPEND; } elsif ($_[1] =~ /^(?:f|fail)?$/i) { $_{"OVERRIDE"} = OVERRIDE_FAIL; } else { die "$THIS_FILE: unknown override mode: $_[1]\n"; } }, "suffix|s=s"=>sub { $_{"SUFFIX"} = $_[1]; }, "trim-suffix|t=s"=>sub { $_{"TRIM_SUFFIX"} = $_[1]; }, "num-threads|n=i"=>sub { die "$THIS_FILE: invalid number of threads: $_[1]\n" if $_[1] < 0; $THREADS = $_[1]; }, "stdout|c!"=>sub { $_{"STDOUT"} = $_[1]; }, "debug|d"=>sub { $VERBOSE++; }, "quiet|q"=>sub { $VERBOSE = 0; }, "help|h"=>sub { print $HELPSTR; exit 0; }, "version|v"=>sub { print "$VERSTR\n"; exit 0; }); }; die "$THIS_FILE: $@$SHORTHELP\n" if $@ ne ""; # The log files if (@ARGV > 0) { @_ = @ARGV; } else { @_ = qw(-); } die "$THIS_FILE: you can only specify STDIN once\n$SHORTHELP\n" if grep($_ eq "-", @_) > 1; # Set the verbose level autoflush STDERR if $VERBOSE > 1; $PROGBAR = 1 if ($VERBOSE == 1 || $VERBOSE == 2) && -t STDERR; if ($PROGBAR) { # Check if we have Term::Size $_ = eval { if ($^O eq "MSWin32") { require Win32::Console; } else { require Term::Size; } 1; }; # Not found $PROGBAR = 0 if !$_; } # Set the default STDOUT mode $_{"STDOUT"} = DEFAULT_STDOUT if !exists $_{"STDOUT"}; # If outputing to STDOUT if ($_{"STDOUT"}) { # Warn if not overwrite warn "$THIS_FILE: Nonsense to override mode \"fail\" when outputing to STDOUT.\n" if exists $_{"OVERRIDE"} && $_{"OVERRIDE"} eq OVERRIDE_FAIL; # Always use overwrite $_{"OVERRIDE"} = OVERRIDE_OVERWRITE; # Default keep mode changed to keep all $_{"KEEP"} = KEEP_ALL if !exists $_{"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 $THREADS && $THREADS > 0; $THREADS = 0; } $THREADS = DEFAULT_THREADS if !defined $THREADS; # Set the default keep mode $_{"KEEP"} = DEFAULT_KEEP if !exists $_{"KEEP"}; # Set the default override mode $_{"OVERRIDE"} = DEFAULT_OVERRIDE if !exists $_{"OVERRIDE"}; # Set the default file name suffix to be appended $_{"SUFFIX"} = DEFAULT_SUFFIX if !exists $_{"SUFFIX"}; # Set the default file name suffix to be trimmed $_{"TRIM_SUFFIX"} = undef if !exists $_{"TRIM_SUFFIX"}; # Check the log files # Initialize STDIN at last. STDIN copies data to a temporarily file # which will be a lot slower @_ = map new ResLog::LogFile($_, \%_), @_; # Initialize the STDIN @_ = map new ResLog::LogFile::STDIN($_, \%_), @_; return @_; } # add_ip: Add an IP address sub add_ip($) { local ($_, %_); my ($ip, $pkip); $ip = $_[0]; # Skip duplicated IP return if exists $PKIP{$ip}; # Skip malformed IP return unless defined($pkip = inet_aton $ip); push @IP, $ip; $PKIP{$ip} = $pkip; return; } # host: Return the resolved host name of an IP address sub host($) { local ($_, %_); $_ = $_[0]; return $NAMES{$_} if exists $NAMES{$_}; return $_; } # sort_ip: Sort the IP sub sort_ip() { @IP = sort { $PKIP{$a} cmp $PKIP{$b} } @IP; } # resolve_all: Resolve the IP sub resolve_all() { local ($_, %_); print STDERR "Resolving IP ... " if ($VERBOSE == 1 || $VERBOSE == 2) && !$PROGBAR; # Run resolve_nonthread() if ithread is not available if ($THREADS == 0) { resolve_nonthread; } else { @_ = qw(); # Start the thread workers push @_, threads->new(\&resolve_in_a_thread) while @_ < $THREADS; # Wait for everyone to end $_->join foreach @_; } print STDERR "done\n" if ($VERBOSE == 1 || $VERBOSE == 2) && !$PROGBAR; return; } # resolve_nonthread: Resolve IP without threading sub resolve_nonthread() { local ($_, %_); for ($_ = 0; $_ < @IP; $_++) { resolve_ip $IP[$_], $_ + 1; } return; } # resolve_in_a_thread: Proform URL checks in a thread sub resolve_in_a_thread() { local ($_, %_); # Check until the end resolve_ip $IP[$_], $_ + 1 while ($_ = $CURINDEX++) < @IP; return; } # resolve_ip: Resolve an IP sub resolve_ip($$) { local ($_, %_); my ($ip, $num, $name, $result); ($ip, $num) = @_; $? = 0 if $? != 0; $name = gethostbyaddr $PKIP{$ip}, AF_INET; # Found if (defined $name) { $NAMES{$ip} = $name; $result = $name; # Not found } else { # h_errno not returned if (!defined $?) { $result = "failed (no h_errno given)"; # h_errno not defined } elsif (!exists $H_ERRNO{$?}) { $result = "failed (h_errno = $?)"; # Report the h_errno constant } else { $result = "failed ($H_ERRNO{$?})"; } } # Show the result $DONE++; # Lock to prevent simultaneous write to STDERR if ($^O ne "MSWin32") { flock STDERR, LOCK_EX or die "$THIS_FILE: STDERR: $!"; } printf STDERR "[%d/%d] %s => %s\n", $num, scalar(@IP), $ip, $result if $VERBOSE > 2; show_progress sprintf("%d/%d", $DONE, scalar(@IP)), $DONE, scalar(@IP) if $PROGBAR; # Release the lock if ($^O ne "MSWin32") { flock STDERR, LOCK_UN or die "$THIS_FILE: STDERR: $!"; } return; } # 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_width - 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 print STDERR "\n" if $cur == $total; return; } # whereis: Find an executable sub whereis($) { local ($_, %_); my ($file, $path); $file = $_[0]; return $WHEREIS{$file} if exists $WHEREIS{$file}; print STDERR "\n" if $VERBOSE > 3; foreach my $dir (path) { $path = catfile($dir, $file); print STDERR " Checking $path ... " if $VERBOSE > 3; `$path --help 2>&1`; if ($? == 0) { print STDERR "yes\n found " if $VERBOSE > 3; return ($WHEREIS{$file} = "$path"); } print STDERR "no\n" if $VERBOSE > 3; } return ($WHEREIS{$file} = undef); } # term_width: Get the terminal width sub term_width() { local ($_, %_); $_ = $_[0]; return ((new Win32::Console)->Info)[0] if $^O eq "MSWin32"; return (Term::Size::chars(*STDERR{IO}))[0]; } # ResLog::LogFile: The source log file package ResLog::LogFile; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Config qw(); use Cwd qw(cwd); use Fcntl qw(:flock :seek); use File::Basename qw(fileparse); use File::Spec::Functions qw(file_name_is_absolute catdir catfile splitdir curdir updir); # Constants # The file types use constant TYPE_PLAIN => "text/plain"; use constant TYPE_GZIP => "application/x-gzip"; use constant TYPE_BZIP2 => "application/x-bzip2"; # The file type checkers use constant MAGIC_PM => "File::MMagic"; use constant MAGIC_EXEC => "file"; use constant MAGIC_SUFFIX => "suffix"; # The I/O handler type use constant IO_PLAIN => "ResLog::IO::Plain"; use constant IO_GZIP_PM => "ResLog::IO::Gzip::PM"; use constant IO_GZIP_EXEC => "ResLog::IO::Gzip::Exec"; use constant IO_BZIP2_PM => "ResLog::IO::Bzip2::PM"; use constant IO_BZIP2_EXEC => "ResLog::IO::Bzip2::Exec"; use vars qw($MAGIC_METHOD $MAGIC $GZIP_IO $BZIP2_IO); undef $MAGIC_METHOD; undef $GZIP_IO; undef $BZIP2_IO; # new: Initialize the source log file processer sub new : method { local ($_, %_); my ($class, $self, $file, $FH, $conf, $f0); ($class, $file, $conf) = @_; # STDIN is not initialized here return $file if $file eq "-"; $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"}; # Load the File::MMagic first before opening anything, or the seek # method will not be loaded into IO::Handle $self->check_magic; $self->{"file"} = $file; $self->rel2abs; ($f0, $file) = ($file, $self->{"file"}); die "$THIS_FILE: $file: not found\n$SHORTHELP\n" if !-e $file; die "$THIS_FILE: $file: permission denied\n$SHORTHELP\n" if !-r $file || !-w $file; # Open the file handler open $FH, "+<", $file or die "$THIS_FILE: $file: $!"; $self->{"FH"} = $FH; flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!"; # Check the file type print STDERR "Checking file type of $f0 ... " if $VERBOSE > 1; $self->check_type; print STDERR $self->{"type"} . "\n" if $VERBOSE > 1; # Check the I/O handler to use $self->check_io; # bzip2 for MSWin32 will fail if STDIN/STDOUT is locked if ($self->{"io"}->{"type"} eq IO_BZIP2_EXEC && $^O eq "MSWin32") { flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!"; } # Check the output file availability $self->check_output; # Reset the file pointer seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!"; 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 or die "$THIS_FILE: $temp: $!"; $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, $io, $file, $FHT, $count, $line); $self = $_[0]; ($file, $FHT) = ($self->{"file"}, $self->{"FHT"}); print STDERR "Reading from $file ... " if $VERBOSE > 1; print STDERR "\n" if $VERBOSE > 2; $io = $self->{"io"}->new_read($file, $self->{"FH"}); print STDERR " Reading source records ... " if $VERBOSE > 2; $count = 0; while (defined($line = $io->readline)) { add_ip($1) if $line =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /; print $FHT $line or die "$THIS_FILE: $!"; $count++; } print STDERR "$count records\n" if $VERBOSE > 2; $io->close($self->{"keep"}); print STDERR "$count records\n" if $VERBOSE > 1; return $count;; } # write_result: Write the result file sub write_result : method { local ($_, %_); my ($self, $io, $file, $FHT, $FH, $count, $line); $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: $!"; } if ($self->{"override"} eq OVERRIDE_OVERWRITE) { print STDERR "Outputing to $file ... " if $VERBOSE > 1; print STDERR "\n" if $VERBOSE > 2; $io = $self->{"io"}->new_write($file, $FH); } else { print STDERR "Appending to $file ... " if $VERBOSE > 1; print STDERR "\n" if $VERBOSE > 2; $io = $self->{"io"}->new_append($file, $FH); } print STDERR " Outputing result records ... " if $VERBOSE > 2; seek $FHT, 0, SEEK_SET or die "$THIS_FILE: $!"; $count = 0; while (defined($line = <$FHT>)) { $line =~ s/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) /host($1) . " "/e; $io->write($line); $count++; } print STDERR "$count records\n" if $VERBOSE > 2; $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, $type, $PIPE, $CMD); $self = $_[0]; $file = $self->{"file"}; # 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 if ($MAGIC_METHOD eq MAGIC_SUFFIX) { return ($self->{"type"} = TYPE_GZIP) if $file =~ /\.gz$/; return ($self->{"type"} = TYPE_BZIP2) if $file =~ /\.bz2$/; # Otherwise assume to be text/plain return ($self->{"type"} = TYPE_PLAIN); } # Check the file format # Check by File::MMagic if ($MAGIC_METHOD eq MAGIC_PM) { $_ = $MAGIC->checktype_filehandle($self->{"FH"}); # Check by the file program } elsif ($MAGIC_METHOD eq MAGIC_EXEC) { @_ = ($MAGIC, "-"); $CMD = join " ", @_; # Save STDIN open $_, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!"; # Redirect STDIN to $FH open STDIN, "<&", $self->{"FH"} or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "$CMD |" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "-|", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDIN open STDIN, "<&", $_ or die "$THIS_FILE: STDIN: $!"; $_ = join "", <$PIPE>; close $PIPE or die "$THIS_FILE: $MAGIC $file: $!"; } # Check the returned file type text return ($self->{"type"} = TYPE_GZIP) if /gzip/i; return ($self->{"type"} = TYPE_BZIP2) if /bzip2/i; return ($self->{"type"} = TYPE_PLAIN) if /(?:text|empty)/i; # Not a valid file type die "$THIS_FILE: Unsupported file format: $type ($file)\n$SHORTHELP\n"; } # 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 if ($self->{"type"} eq TYPE_GZIP) { $_ = $self->check_gzip; # We need a bzip2 compression I/O handler } elsif ($self->{"type"} eq TYPE_BZIP2) { $_ = $self->check_bzip2; # We need a plain I/O handler } else { $_ = IO_PLAIN; } return ($self->{"io"} = ResLog::IO->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" unless -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" unless -f $self->{"output"}; die "$THIS_FILE: " . $self->{"output"} . ": permission denied\n$SHORTHELP\n" unless -w $self->{"output"}; # Output does not exist -- always overwrite it } else { $self->{"override"} = OVERRIDE_OVERWRITE; } } return; } # rel2abs: Convert a relative path to an absolute path sub rel2abs : method { local ($_, %_); my ($self, $user, $file); $self = $_[0]; $file = $self->{"file"}; # Deal the ~ home directories under UNIX if (defined $Config::Config{"d_getpwent"}) { @_ = splitdir($file); # If start from user's home directory if ($_[0] =~ /^~(.*)$/) { $user = $1; # Get the current user if user not specified $user = getlogin if $user eq ""; # Get the user home directory $_ = (getpwnam $user)[7]; # Replace with the user home directory $_[0] = $_ if defined $_; # Compose the path $file = catfile @_; } } # Append the current directory if relative $file = catdir(cwd, $file) unless file_name_is_absolute $file; @_ = splitdir($file); # 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 } } $file = catfile @_; # Compose the full path return ($self->{"file"} = $file); } # check_magic: Check the file type checker to use sub check_magic : method { local ($_, %_); my ($self, $ok); $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 $ok = eval { require File::MMagic; 1; }; # Found if ($ok) { 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'll check with $MAGIC instead\n" if $VERBOSE > 0; return ($MAGIC_METHOD = MAGIC_EXEC); } # Check by file name suffix print STDERR "file name suffix\n" if $VERBOSE == 2; print STDERR "no\nnot found\n" if $VERBOSE == 3; print STDERR " not found\nnot found\n" if $VERBOSE > 3; warn "$THIS_FILE: We'll check by file name suffix instead\n" if $VERBOSE > 0; return ($MAGIC_METHOD = MAGIC_SUFFIX); } # check_gzip: Check for compression method of gzip sub check_gzip : method { local ($_, %_); my ($self, $ok); $self = $_[0]; # Checked before return $GZIP_IO 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 $ok = eval { require Compress::Zlib; 1; }; # Found if ($ok) { print STDERR "OK\nfound " if $VERBOSE > 2; print STDERR "Compress::Zlib\n" if $VERBOSE > 1; return ($GZIP_IO = IO_GZIP_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 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 = IO_GZIP_EXEC); } # Still not found print STDERR "no\n" if $VERBOSE == 2; print STDERR "no\nnot found\n" if $VERBOSE == 3; print STDERR " not found\nnot found\n" if $VERBOSE > 3; 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 ($_, %_); my ($self, $ok); $self = $_[0]; # Checked before return $BZIP2_IO 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 $ok = eval { require Compress::Bzip2; import Compress::Bzip2 2.00; 1; }; # Found if ($ok) { print STDERR "OK\nfound " if $VERBOSE > 2; print STDERR "Compress::Bzip2\n" if $VERBOSE > 1; return ($BZIP2_IO = IO_BZIP2_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 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 = IO_BZIP2_EXEC); } # Still not found print STDERR "no\n" if $VERBOSE == 2; print STDERR "no\nnot found\n" if $VERBOSE == 3; print STDERR " not found\nnot found\n" if $VERBOSE > 3; die "$THIS_FILE: Necessary Compress::Bzip2 or bzip2 not available.\n$SHORTHELP\n"; } # ResLog::LogFile::STDIN: The source log file as STDIN package ResLog::LogFile::STDIN; use 5.7.2; use strict; use warnings; use base qw(ResLog::LogFile); BEGIN { import ResLog; } use IO::Handle; use Fcntl qw(:flock :seek); use File::Temp qw(tempfile); # new: Initialize the source log file processer sub new : method { local ($_, %_); my ($class, $self, $file, $FH, $conf); ($class, $file, $conf) = @_; # 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; # 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"; $FH = tempfile or die "$THIS_FILE: tempfile: $!"; ($self->{"FH"}, $self->{"file"}) = ($FH, $file); flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!"; binmode $FH or die "$THIS_FILE: $file: $!"; 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->check_type; seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!"; print STDERR $self->{"type"} . "\n" if $VERBOSE > 1; # Check the I/O handler to use $self->check_io; # bzip2 for MSWin32 will fail if STDIN/STDOUT is locked if ($self->{"io"}->{"type"} eq $self->IO_BZIP2_EXEC && $^O eq "MSWin32") { flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!"; } # Set the output file $self->{"output"} = undef; 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 or die "$THIS_FILE: tempfile: $!"; 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; flock $_->{"FHT"}, LOCK_UN or die "$THIS_FILE: tempfile: $!"; close $_->{"FHT"} or die "$THIS_FILE: tempfile: $!"; print STDERR "done\n" if $VERBOSE > 2; return; } # ResLog::IO: The I/O handler package ResLog::IO; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } # new: Initialize the I/O handler sub new : method { local ($_, %_); my ($class, $self, $type); ($class, $type) = @_; $self = bless {}, $class; $self->{"type"} = $type; return $self; } # new_read: Return a reader in a proper I/O type sub new_read : method { local ($_, %_); my ($self, $file, $FH); ($self, $file, $FH) = @_; return new_read ResLog::IO::Gzip::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::PM"; return new_read ResLog::IO::Gzip::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::Exec"; return new_read ResLog::IO::Bzip2::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::PM"; return new_read ResLog::IO::Bzip2::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::Exec"; return new_read ResLog::IO::Plain($file, $FH); } # new_write: Return a writer in a proper I/O type sub new_write : method { local ($_, %_); my ($self, $file, $FH); ($self, $file, $FH) = @_; return new_write ResLog::IO::Gzip::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::PM"; return new_write ResLog::IO::Gzip::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::Exec"; return new_write ResLog::IO::Bzip2::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::PM"; return new_write ResLog::IO::Bzip2::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::Exec"; return new_write ResLog::IO::Plain($file, $FH); } # new_append: Return a appender in a proper I/O type sub new_append : method { local ($_, %_); my ($self, $file, $FH); ($self, $file, $FH) = @_; return new_append ResLog::IO::Gzip::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::PM"; return new_append ResLog::IO::Gzip::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Gzip::Exec"; return new_append ResLog::IO::Bzip2::PM($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::PM"; return new_append ResLog::IO::Bzip2::Exec($file, $FH) if $self->{"type"} eq "ResLog::IO::Bzip2::Exec"; return new_append ResLog::IO::Plain($file, $FH); } # ResLog::IO::Plain: The plain I/O handle package ResLog::IO::Plain; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Fcntl qw(:flock :seek); # new_read: Set a new reader sub new_read : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); return $self; } # new_write: Set a new writer sub new_write : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); return $self; } # new_append: Set a new appender sub new_append : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); return $self; } # 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, $file, $FH); ($self, $keep) = @_; $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; } return; } # ResLog::IO::Gzip::PM: The gzip module compression I/O handle package ResLog::IO::Gzip::PM; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Fcntl qw(:flock :seek); use File::Temp qw(tempfile); # new_read: Set a new reader sub new_read : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # new_write: Set a new writer sub new_write : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # new_append: Set a new appender sub new_append : method { local ($_, %_); my ($class, $self, $file, $FH, $gz); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # 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, $file, $FH, $gz); ($self, $keep) = @_; $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; } return; } # ResLog::IO::Gzip::Exec: The gzip executable compression I/O handle package ResLog::IO::Gzip::Exec; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Fcntl qw(:flock :seek); use File::Temp qw(tempfile); use vars qw($EXEC); # new_read: Set a new reader sub new_read : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); $EXEC = whereis "gzip" if !defined $EXEC; @_ = ($EXEC, "-cdf"); $CMD = join " ", @_; print STDERR " Starting $CMD from file ... " if $VERBOSE > 2; # Save STDIN open $_, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!"; # Redirect STDIN to $FH open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "$CMD |" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "-|", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDIN open STDIN, "<&", $_ or die "$THIS_FILE: STDIN: $!"; print STDERR "done\n" if $VERBOSE > 2; ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # new_write: Set a new writer sub new_write : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); $EXEC = whereis "gzip" if !defined $EXEC; @_ = ($EXEC, "-c9f"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # new_append: Set a new appender sub new_append : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($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, $PIPET, $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"); $CMDT = join " ", @_; print STDERR " Starting $CMDT from buffer ... " if $VERBOSE > 2; # Save STDIN open $_, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!"; # Redirect STDIN to $FH open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPET, "$CMDT |" or die "$THIS_FILE: $CMDT: $!"; } else { open $PIPET, "-|", @_ or die "$THIS_FILE: $CMDT: $!"; } # Restore STDIN open STDIN, "<&", $_ or die "$THIS_FILE: STDIN: $!"; print STDERR "done\n" if $VERBOSE > 2; @_ = ($EXEC, "-c9f"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open 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($_ = <$PIPET>)) { print $PIPE $_ or die "$THIS_FILE: $file: $!"; $count++; } close $PIPET 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"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # readline: Read a line from the I/O stream sub readline : method { local ($_, %_); my ($self, $PIPE); $self = $_[0]; $PIPE = $self->{"PIPE"}; return <$PIPE>; } # write: Output data to the I/O stream sub write : method { local ($_, %_); my ($self, $CMD, $PIPE); ($self, $_) = @_; ($CMD, $PIPE) = (join(" ", @{$self->{"CMD"}}), $self->{"PIPE"}); print $PIPE $_ or die "$THIS_FILE: $CMD: $!"; return; } # close: Close the I/O stream sub close : method { local ($_, %_); my ($self, $keep, $file, $FH, $CMD, $PIPE); ($self, $keep) = @_; $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"); $CMD = join " ", @_; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process and end it if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } close $PIPE or die "$THIS_FILE: $CMD: $!"; # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($CMD, $PIPE) = (join(" ", @{$self->{"CMD"}}), $self->{"PIPE"}); CORE::close $PIPE or die "$THIS_FILE: $CMD: $!"; CORE::close $FH or die "$THIS_FILE: $file: $!"; delete $self->{"PIPE"}; 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; } return; } # ResLog::IO::Bzip2::PM: The bzip2 module compression I/O handle package ResLog::IO::Bzip2::PM; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Fcntl qw(:flock :seek); use File::Temp qw(tempfile); # new_read: Set a new reader sub new_read : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # new_write: Set a new writer sub new_write : method { local ($_, %_); my ($class, $self, $file, $FH); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # new_append: Set a new appender sub new_append : method { local ($_, %_); my ($class, $self, $file, $FH, $bz); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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 or die "$THIS_FILE: $file: $!"; 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 $self; } # 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, $file, $FH, $bz); ($self, $keep) = @_; $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; } return; } # ResLog::IO::Bzip2::Exec: The bzip2 executable compression I/O handle package ResLog::IO::Bzip2::Exec; use 5.7.2; use strict; use warnings; BEGIN { import ResLog; } use Fcntl qw(:flock :seek); use File::Temp qw(tempfile); use vars qw($EXEC); # new_read: Set a new reader sub new_read : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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: $!"; # bzip2 for MSWin32 will fail if STDIN/STDOUT is locked if ($^O ne "MSWin32") { flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!"; } print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); $EXEC = whereis "bzip2" if !defined $EXEC; @_ = ($EXEC, "-cdf"); $CMD = join " ", @_; print STDERR " Starting $CMD from file ... " if $VERBOSE > 2; # Save STDIN open $_, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!"; # Redirect STDIN to $FH open STDIN, "<&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "$CMD |" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "-|", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDIN open STDIN, "<&", $_ or die "$THIS_FILE: STDIN: $!"; print STDERR "done\n" if $VERBOSE > 2; ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # new_write: Set a new writer sub new_write : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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: $!"; # bzip2 for MSWin32 will fail if STDIN/STDOUT is locked if ($^O ne "MSWin32") { flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!"; } print STDERR "done\n" if $VERBOSE > 2; } ($self->{"file"}, $self->{"FH"}) = ($file, $FH); $EXEC = whereis "bzip2" if !defined $EXEC; @_ = ($EXEC, "-9f"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # new_append: Set a new appender sub new_append : method { local ($_, %_); my ($class, $self, $file, $FH, $PIPE, $CMD); ($class, $file, $FH) = @_; $self = bless {}, $class; # 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: $!"; # bzip2 for MSWin32 will fail if STDIN/STDOUT is locked if ($^O ne "MSWin32") { flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!"; } print STDERR "done\n" if $VERBOSE > 2; } ($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, $PIPET, $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"); $CMDT = join " ", @_; print STDERR " Starting $CMDT from buffer ... " if $VERBOSE > 2; # Save STDIN open $_, "<&", \*STDIN or die "$THIS_FILE: STDIN: $!"; # Redirect STDIN to $FH open STDIN, "<&", $FHT or die "$THIS_FILE: tempfile: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPET, "$CMDT |" or die "$THIS_FILE: $CMDT: $!"; } else { open $PIPET, "-|", @_ or die "$THIS_FILE: $CMDT: $!"; } # Restore STDIN open STDIN, "<&", $_ or die "$THIS_FILE: STDIN: $!"; print STDERR "done\n" if $VERBOSE > 2; @_ = ($EXEC, "-9f"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open 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($_ = <$PIPET>)) { print $PIPE $_ or die "$THIS_FILE: $file: $!"; $count++; } close $PIPET 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"); $CMD = join " ", @_; print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($self->{"CMD"}, $self->{"PIPE"}) = ([@_], $PIPE); return $self; } # readline: Read a line from the I/O stream sub readline : method { local ($_, %_); my ($self, $PIPE); $self = $_[0]; $PIPE = $self->{"PIPE"}; return <$PIPE>; } # write: Output data to the I/O stream sub write : method { local ($_, %_); my ($self, $CMD, $PIPE); ($self, $_) = @_; ($CMD, $PIPE) = (join(" ", @{$self->{"CMD"}}), $self->{"PIPE"}); print $PIPE $_ or die "$THIS_FILE: $CMD: $!"; return; } # close: Close the I/O stream sub close : method { local ($_, %_); my ($self, $keep, $file, $FH, $CMD, $PIPE); ($self, $keep) = @_; $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 "bzip2" if !defined $EXEC; @_ = ($EXEC, "-9f"); $CMD = join " ", @_; # Save STDOUT open $_, ">&", \*STDOUT or die "$THIS_FILE: STDOUT: $!"; # Redirect STDOUT to $FH open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; # Start the process and end it if ($^O eq "MSWin32") { open $PIPE, "| $CMD" or die "$THIS_FILE: $CMD: $!"; } else { open $PIPE, "|-", @_ or die "$THIS_FILE: $CMD: $!"; } close $PIPE or die "$THIS_FILE: $CMD: $!"; # Restore STDOUT open STDOUT, ">&", $_ or die "$THIS_FILE: STDOUT: $!"; print STDERR "done\n" if $VERBOSE > 2; } ($CMD, $PIPE) = (join(" ", @{$self->{"CMD"}}), $self->{"PIPE"}); CORE::close $PIPE or die "$THIS_FILE: $CMD: $!"; CORE::close $FH or die "$THIS_FILE: $file: $!"; delete $self->{"PIPE"}; 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; } return; } __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)|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)|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. =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>. Gzipped 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. This is the default. =item d,delete Delete the source file after records are resolved. =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.01 =head1 COPYRIGHT Copyright (c) 2001-2005 imacat. All rights reserved. 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 2 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, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =head1 AUTHOR imacat <imacat@mail.imacat.idv.tw> =head1 BUGS Please report if any. ^_*' =head1 TODO Currently none. You can tell me. ^_*' =head1 SEE ALSO L<Compress::Zlib(3)|Compress::Zlib/3>, L<Compress::Bzip2(3)|Compress::Bzip2/3>, L<perlthrtut(1)|perlthrtut/1>, L<gzip(1)|gzip/1>, L<zlib(3)|zlib/3>, L<bzip2(1)|bzip2/1>. =cut