diff --git a/Build.PL b/Build.PL index 89519a3..1b8ef47 100755 --- a/Build.PL +++ b/Build.PL @@ -63,6 +63,7 @@ my $build = Module::Build->new( "File::MMagic" => 0, "Compress::Zlib" => 0, "Compress::Bzip2" => 2, + "IO::Compress::Xz" => 0, "Term::ReadKey" => 0, }, build_requires => { diff --git a/Changes b/Changes index ed702d0..4bf191f 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ reslog change log +2022-03-19 + 1. Added support for the xz compression. + 2020-02-06 version 3.17 1. Replaced the messy GNU-styled, multi-lingual documents with a single Markdown README.md. diff --git a/Makefile.PL b/Makefile.PL index a97d33d..fe2b3fd 100755 --- a/Makefile.PL +++ b/Makefile.PL @@ -54,6 +54,7 @@ our (%OPT_PREREQ); "File::MMagic" => 0, "Compress::Zlib" => 0, "Compress::Bzip2" => 2, + "IO::Compress::Xz" => 0, "Term::ReadKey" => 0, ); delete $OPT_PREREQ{$_} diff --git a/README.md b/README.md index c7a0a49..7999d0c 100644 --- a/README.md +++ b/README.md @@ -40,10 +40,10 @@ Caution * I suggest that you install [File::MMagic] instead of counting on the `file` executable. The internal magic file of File::MMagic works better than the `file` executable. `reslog` treats everything not - gzip nor bzip2 compressed as plain text. When a compressed log file - is wrongly recognized as an image, `reslog` treats it as plain text, - reads directly from it, and fails. This does not hurt the source - log files, but is still annoying. + gzip, bzip2, nor xz compressed as plain text. When a compressed log + file is wrongly recognized as an image, `reslog` treats it as plain + text, reads directly from it, and fails. This does not hurt the + source log files, but is still annoying. [File::MMagic]: https://metacpan.org/release/File-MMagic @@ -171,6 +171,42 @@ System Requirement [the bzip2 website]. Be sure to save it as `bzip2.exe` somewhere in your `PATH`. + * [IO::Compress::Xz] and [IO::Uncompress::UnXz] + + They are used to support reading/writing the xz compressed + files. It is only needed when xz compressed files are + encountered. If it is not available, `arclog` tries the `xz` + executable instead. If that is not available, too, `arclog` + fails. They are contained in the [IO-Compress-Lzma] distribution. + You can download and install it from the CPAN archive, or install + them with the CPAN shell: + + cpan IO::Compress::Xz + + or with the CPANPLUS shell: + + cpanp i IO::Compress::Xz + + For Debian/Ubuntu: + + sudo apt install libio-compress-lzma-perl + + For Red Hat/Fedora/CentOS: + + sudo yum install perl-IO-Compress-Lzma + + For FreeBSD: + + ports install p5-IO-Compress-Lzma + + For ActivePerl: + + ppm install IO-Compress-Lzma + + The alternative `xz.exe` for MS-Windows can be obtained from + [the XZ Utils website]. Be sure to save it as `xz.exe` + somewhere in your `PATH`. + * [Term::ReadKey] This is used to display the progress bar. The progress bar is a @@ -211,6 +247,10 @@ System Requirement [IO-Compress]: https://metacpan.org/release/IO-Compress [Compress::Bzip2]: https://metacpan.org/pod/Compress::Bzip2 [the bzip2 website]: http://www.bzip.org +[IO::Compress::Xz]: https://metacpan.org/pod/IO::Compress::Xz +[IO::Uncompress::UnXz]: https://metacpan.org/pod/IO::Uncompress::UnXz +[IO-Compress-Lzma]: https://metacpan.org/dist/IO-Compress-Lzma +[the XZ Utils website]: https://tukaani.org/xz/ [Term::ReadKey]: https://metacpan.org/pod/Term::ReadKey @@ -373,7 +413,8 @@ Options The log file to be resolved. You can specify multiple log files. If not specified, it reads from `STDIN` and outputs to `STDOUT`. You can also specify `-` to read from `STDIN`. Result of `STDIN` - goes to `STDOUT`. `gzip` or `bzip2` compressed files are supported. + goes to `STDOUT`. `gzip`, `bzip2`, or `xz` compressed files are + supported. * `-k`, `--keep mode` @@ -480,7 +521,7 @@ Thanks License ------- - Copyright (C) 2000-2021 imacat. + Copyright (C) 2000-2022 imacat. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/reslog b/reslog index 341b12a..24f8c67 100755 --- a/reslog +++ b/reslog @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # reslog: Reverse-resolve IP in Apache log files -# Copyright (c) 2000-2021 imacat. +# Copyright (c) 2000-2022 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -27,7 +27,7 @@ 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_TEXT TYPE_GZIP TYPE_BZIP2); +push @EXPORT, qw(TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ); push @EXPORT, qw(TMP_SUFFIX where_is rel2abs); @EXPORT_OK = @EXPORT; # Prototype declaration @@ -68,6 +68,7 @@ use constant DEFAULT_KEEP => KEEP_DELETE; use constant TYPE_TEXT => "text/plain"; use constant TYPE_GZIP => "application/x-gzip"; use constant TYPE_BZIP2 => "application/x-bzip2"; +use constant TYPE_XZ => "application/x-xz"; # Other constants use constant TMP_SUFFIX => ".tmp-reslog"; use constant DEFAULT_SUFFIX => ".resolved"; @@ -566,6 +567,7 @@ sub check_type : method { if (-z $FH || $MAGIC_METHOD eq MAGIC_SUFFIX) { return TYPE_GZIP if $file =~ /\.gz$/; return TYPE_BZIP2 if $file =~ /\.bz2$/; + return TYPE_XZ if $file =~ /\.xz$/; # Otherwise we assume it to be text/plain return TYPE_TEXT; } @@ -600,6 +602,7 @@ sub check_type : method { # Check the returned file type text return TYPE_GZIP if /gzip/i; return TYPE_BZIP2 if /bzip2/i; + return TYPE_XZ if /xz/i; # Default everything to text/plain return TYPE_TEXT; } @@ -613,6 +616,8 @@ sub check_io : method { 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 xz compression I/O handler + return _private::IO->check_xz if $self->{"type"} eq TYPE_XZ; # We need a plain I/O handler return _private::IO::Plain->new; } @@ -627,6 +632,8 @@ sub check_output : method { ($file, $dir, $suf) = fileparse $self->{"file"}, ".gz"; } elsif ($self->{"type"} eq TYPE_BZIP2) { ($file, $dir, $suf) = fileparse $self->{"file"}, ".bz2"; + } elsif ($self->{"type"} eq TYPE_XZ) { + ($file, $dir, $suf) = fileparse $self->{"file"}, ".xz"; } else { ($file, $dir, $suf) = fileparse $self->{"file"}; } @@ -823,10 +830,11 @@ BEGIN { import main; } -our ($GZIP_IO, $BZIP2_IO); +our ($GZIP_IO, $BZIP2_IO, $XZ_IO); BEGIN { undef $GZIP_IO; undef $BZIP2_IO; +undef $XZ_IO; } # Initialize the I/O handler interface @@ -902,6 +910,41 @@ sub check_bzip2 : method { die "$THIS_FILE: Necessary Compress::Bzip2 or bzip2 not available.\n$SHORT_HELP\n"; } +# Check for compression method of xz +sub check_xz : method { + local ($_, %_); + + # Checked before + return ref($XZ_IO)->new if defined $XZ_IO; + + # See whether IO::Compress::Xz or xz + print STDERR "Checking xz I/O handler to use ... " if $VERBOSE > 1; + print STDERR "\n Checking IO::Compress::Xz ... " if $VERBOSE > 2; + # Check if we have IO::Compress::Xz + if (eval { require IO::Compress::Xz; require IO::Uncompress::UnXz; 1; }) { + print STDERR "OK\nfound " if $VERBOSE > 2; + print STDERR "IO::Compress::Xz\n" if $VERBOSE > 1; + return ($XZ_IO = _private::IO::Xz::PM->new); + } + # Not found + print STDERR "no\n" if $VERBOSE > 2; + # It's OK not to warn + + # Looking for xz from PATH + print STDERR " Checking xz... " if $VERBOSE > 2; + # Found in PATH + if (defined($_ = where_is "xz")) { + print STDERR "$_\nfound " if $VERBOSE > 2; + print STDERR "$_\n" if $VERBOSE > 1; + return ($XZ_IO = _private::IO::Xz::Exec->new); + } + # Not found + print STDERR "no\n" if $VERBOSE > 2; + + print STDERR "not found\n" if $VERBOSE > 1; + die "$THIS_FILE: Necessary IO::Compress::Xz or xz not available.\n$SHORT_HELP\n"; +} + # _private::IO::Plain: The plain I/O handle package _private::IO::Plain; @@ -1928,6 +1971,456 @@ sub close : method { } +# _private::IO::Xz::PM: The xz module compression I/O handler +package _private::IO::Xz::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 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); + print STDERR " Attaching file with IO::Uncompress::UnXz ... " if $VERBOSE > 2; + $self->{"xz"} = IO::Uncompress::UnXz->new($FH) + or die "$THIS_FILE: $file: $IO::Uncompress::UnXz::UnXzError"; + print STDERR "done\n" if $VERBOSE > 2; + return; +} + +# 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); + print STDERR " Attaching file with IO::Compress::Xz ... " if $VERBOSE > 2; + $self->{"xz"} = IO::Compress::Xz->new($FH, Extreme => 1) + or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + print STDERR "done\n" if $VERBOSE > 2; + return; +} + +# Open the file for appending +sub open_append : method { + local ($_, %_); + my ($self, $file, $FH, $xz); + ($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); + + # 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, $xzt, $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 IO::Uncompress::UnXz ... " if $VERBOSE > 2; + $xzt = IO::Uncompress::UnXz->new($FHT) + or die "$THIS_FILE: tempfile: $IO::Uncompress::UnXz::UnXzError"; + print STDERR "done\n" if $VERBOSE > 2; + print STDERR " Attaching file with IO::Compress::Xz ... " if $VERBOSE > 2; + $xz = IO::Compress::Xz->new($FH, Extreme => 1) + or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + print STDERR "done\n" if $VERBOSE > 2; + + print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2; + $count = 0; + while (defined($_ = $xzt->getline)) { + ($xz->write($_) == length $_) + or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + $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 IO::Compress::Xz ... " if $VERBOSE > 2; + $xz = IO::Compress::Xz->new($FH, Extreme => 1) + or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + print STDERR "done\n" if $VERBOSE > 2; + } + + $self->{"xz"} = $xz; + return; +} + +# Read a line from the I/O stream +sub readline : method { $_[0]->{"xz"}->getline; } + +# Output data to the I/O stream +sub write : method { + local ($_, %_); + my ($self, $file, $xz); + ($self, $_) = @_; + ($file, $xz) = ($self->{"file"}, $self->{"xz"}); + ($xz->write($_) == length $_) or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + return; +} + +# Close the I/O stream +sub close : method { + local ($_, %_); + my ($self, $keep, $tmp, $file, $FH, $xz); + ($self, $keep, $tmp) = @_; + $keep = KEEP_ALL if @_ < 2; + ($file, $FH, $xz) = ($self->{"file"}, $self->{"FH"}, $self->{"xz"}); + + # 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; + $_ = IO::Compress::Xz->new($FH, Extreme => 1) + or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + $_->close or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + undef $_; + undef $xz; + print STDERR "done\n" if $VERBOSE > 2; + } + + if (defined $xz) { + $xz->close or die "$THIS_FILE: $file: $IO::Compress::Xz::XzError"; + } + CORE::close $self->{"FH"} if $self->{"FH"}->opened; + delete $self->{"xz"}; + 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::Xz::Exec: The xz executable compression I/O handler +package _private::IO::Xz::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); + +our ($EXEC); +BEGIN { +undef $EXEC; +} + +# 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 = where_is "xz" 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 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 = where_is "xz" 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 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 = where_is "xz" 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, $CMD_T); + 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"; + $CMD_T = join " ", @_; + print STDERR " Starting $CMD_T 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, "$CMD_T |" or die "$THIS_FILE: $CMD_T: $!"; + } else { + open $PHT, "-|", @_ or die "$THIS_FILE: $CMD_T: $!"; + } + # 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: $CMD_T: $!"; + 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; +} + +# Read a line from the I/O stream +sub readline : method { + local ($_, %_); + my ($self, $PH); + $self = $_[0]; + $PH = $self->{"PH"}; + return <$PH>; +} + +# 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 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 = where_is "xz" 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::Filter: The log file filter # The filter can be override to implementing different log file formats. # Maybe GeoIP. Or MS-Extended, in the future. @@ -2292,10 +2785,11 @@ I suggest that you install L instead of counting on the L executable. The internal magic file of L works better than the L executable. F treats everything not -L nor L compressed as plain text. -When a compressed log file is wrongly recognized as an image, -F treats it as plain text, reads directly from it, and fails. -This does not hurt the source log files, but is still annoying. +L, L, nor L compressed +as plain text. When a compressed log file is wrongly recognized as +an image, F treats it as plain text, reads directly from it, +and fails. This does not hurt the source log files, but is still +annoying. =head1 OPTIONS @@ -2306,7 +2800,8 @@ This does not hurt the source log files, but is still annoying. The log file to be resolved. You can specify multiple log files. If not specified, it reads from C and outputs to C. You can also specify C<-> to read from C. Result of C -goes to C. gzip or bzip2 compressed files are supported. +goes to C. gzip, bzip2, or xz compressed files are +supported. =item -k, --keep mode @@ -2429,6 +2924,8 @@ messages. L, L, +L, L, +L, L, L, L, L. diff --git a/t/01-exhaust.t b/t/01-exhaust.t index 0b2c682..ab5ec5e 100755 --- a/t/01-exhaust.t +++ b/t/01-exhaust.t @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # Test all the possible combination of options -# Copyright (c) 2005-2021 imacat. +# Copyright (c) 2005-2022 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ use warnings; use diagnostics; use Test; -BEGIN { plan tests => 1341 } +BEGIN { plan tests => 1788 } use File::Basename qw(basename); use File::Path qw(mkpath rmtree); @@ -193,7 +193,7 @@ foreach my $st (@SOURCE_TYPES) { die unless $_ || $$st{"skip"}; } - # 85: From STDIN to STDOUT + # 149: From STDIN to STDOUT $_ = eval { return if $$st{"skip"}; my ($title, $cmd, $ret_no, $out, $err, $logfile, $result); diff --git a/t/02-several.t b/t/02-several.t index 2ab6b4d..9247e50 100755 --- a/t/02-several.t +++ b/t/02-several.t @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # Test processing several log files at once -# Copyright (c) 2007-2021 imacat. +# Copyright (c) 2007-2022 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ use warnings; use diagnostics; use Test; -BEGIN { plan tests => 4 } +BEGIN { plan tests => 5 } use File::Basename qw(basename); use File::Path qw(mkpath rmtree); @@ -48,13 +48,15 @@ $_ = eval { $suf = "." . random_word; do { $trim_suf = "." . random_word; } until $trim_suf ne $suf; # (2-4 times available compression) log files - $_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2); + $_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2) + + (has_no_xz? 0: 2); $num = $_ + int rand $_; my %types = qw(); # At least 2 files for each available compression foreach my $st (@SOURCE_TYPES) { next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip) - || ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2); + || ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2) + || ($$st{"type"} eq TYPE_XZ && has_no_xz); @_ = grep !exists $types{$_}, (0...$num-1); $types{$_[int rand @_]} = $st; @_ = grep !exists $types{$_}, (0...$num-1); @@ -65,7 +67,8 @@ $_ = eval { do { $types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES]; } until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip) - && !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2); + && !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2) + && !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz); } @st = map $types{$_}, (0...$num-1); @fs = qw(); @@ -122,14 +125,15 @@ $_ = eval { ok($_, 1, $@); clean_up $_, $WORKDIR, ++$tno; -# 2-4: One of the source log files is read from STDIN +# 2-5: One of the source log files is read from STDIN # The file type at STDIN foreach my $st_stdin (@SOURCE_TYPES) { my $skip; $skip = 0; $_ = eval { if ( ($$st_stdin{"type"} eq TYPE_GZIP && has_no_gzip) - || ($$st_stdin{"type"} eq TYPE_BZIP2 && has_no_bzip2)) { + || ($$st_stdin{"type"} eq TYPE_BZIP2 && has_no_bzip2) + || ($$st_stdin{"type"} eq TYPE_XZ && has_no_xz)) { $skip = 1; return; } @@ -143,13 +147,15 @@ foreach my $st_stdin (@SOURCE_TYPES) { $suf = "." . random_word; do { $trim_suf = "." . random_word; } until $trim_suf ne $suf; # (2-4 times available compression) log files - $_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2); + $_ = 2 + (has_no_gzip? 0: 2) + (has_no_bzip2? 0: 2) + + (has_no_xz? 0: 2); $num = $_ + int rand $_; my %types = qw(); # At least 2 files for each available compression foreach my $st (@SOURCE_TYPES) { next if ($$st{"type"} eq TYPE_GZIP && has_no_gzip) - || ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2); + || ($$st{"type"} eq TYPE_BZIP2 && has_no_bzip2) + || ($$st{"type"} eq TYPE_XZ && has_no_xz); @_ = grep !exists $types{$_}, (0...$num-1); $types{$_[int rand @_]} = $st; @_ = grep !exists $types{$_}, (0...$num-1); @@ -160,7 +166,8 @@ foreach my $st_stdin (@SOURCE_TYPES) { do { $types{$_} = $SOURCE_TYPES[int rand @SOURCE_TYPES]; } until !(${$types{$_}}{"type"} eq TYPE_GZIP && has_no_gzip) - && !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2); + && !(${$types{$_}}{"type"} eq TYPE_BZIP2 && has_no_bzip2) + && !(${$types{$_}}{"type"} eq TYPE_XZ && has_no_xz); } # Choose the STDIN from the matching compression @_ = grep ${$types{$_}}{"type"} eq $$st_stdin{"type"}, (0...$num-1); diff --git a/t/03-errors.t b/t/03-errors.t index 87beb68..98f0f78 100755 --- a/t/03-errors.t +++ b/t/03-errors.t @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # Test the errors that should be captured. -# Copyright (c) 2007-2021 imacat. +# Copyright (c) 2007-2022 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -21,7 +21,7 @@ use warnings; use diagnostics; use Test; -BEGIN { plan tests => 7 } +BEGIN { plan tests => 9 } use File::Basename qw(basename); use File::Path qw(mkpath rmtree); @@ -35,7 +35,7 @@ $WORKDIR = catdir($FindBin::Bin, "logs"); $reslog = catfile($FindBin::Bin, updir, "blib", "script", "reslog"); $tno = 0; -# 1-6: Trim suffix is the same as suffix +# 1-8: Trim suffix is the same as suffix foreach my $st (@SOURCE_TYPES) { # 1: Trim suffix is the same as suffix $_ = eval { @@ -126,7 +126,7 @@ foreach my $st (@SOURCE_TYPES) { clean_up $_ || $$st{"skip"}, $WORKDIR, ++$tno; } -# 7: A same log file is specified more than once +# 9: A same log file is specified more than once $_ = eval { my ($title, $cmd, $ret_no, $out, $err, %logfiles); my ($fr, $frb, @fle, $fle, $flr, %cef, %crf, %tef, %trf); diff --git a/t/_helper.pm b/t/_helper.pm index 2040271..27ccbfb 100644 --- a/t/_helper.pm +++ b/t/_helper.pm @@ -1,6 +1,6 @@ # _helper.pm - A simple test suite helper -# Copyright (c) 2005-2021 imacat +# Copyright (c) 2005-2022 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 @@ -25,10 +25,10 @@ $VERSION = "0.05"; @EXPORT = qw( read_file read_raw_file write_file write_raw_file run_cmd where_is file_type list_files preserve_source clean_up - has_no_file has_no_gzip has_no_bzip2 + has_no_file has_no_gzip has_no_bzip2 has_no_xz make_log_file make_resolved_log_file make_empty_log_file random_word - TYPE_TEXT TYPE_GZIP TYPE_BZIP2 + TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ @CONTENT_TYPES @SOURCE_TYPES @KEEP_MODES @OVERRIDE_MODES @SUFFICES @TRIM_SUFFIX); # Prototype declaration sub this_file(); @@ -45,6 +45,7 @@ sub clean_up($$$); sub has_no_file(); sub has_no_gzip(); sub has_no_bzip2(); +sub has_no_xz(); sub make_log_file($); sub make_resolved_log_file($); sub make_empty_log_file($); @@ -60,16 +61,18 @@ use File::Spec::Functions qw(splitdir catdir catfile path); use File::Temp qw(tempfile); use Socket; -our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $RANDOM_IP); +our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $HAS_NO_XZ, $RANDOM_IP); %WHERE_IS = qw(); undef $HAS_NO_FILE; undef $HAS_NO_GZIP; undef $HAS_NO_BZIP2; +undef $HAS_NO_XZ; undef $RANDOM_IP; use constant TYPE_TEXT => "text/plain"; use constant TYPE_GZIP => "application/x-gzip"; use constant TYPE_BZIP2 => "application/x-bzip2"; +use constant TYPE_XZ => "application/x-xz"; our (@CONTENT_TYPES, @SOURCE_TYPES, @KEEP_MODES, @OVERRIDE_MODES, @SUFFICES, @TRIM_SUFFIX); @@ -94,7 +97,11 @@ our (@CONTENT_TYPES, @SOURCE_TYPES, @KEEP_MODES, @OVERRIDE_MODES, @SUFFICES, { "title" => "bzip2 source", "type" => TYPE_BZIP2, "suf" => ".bz2", - "skip" => has_no_bzip2, }, ); + "skip" => has_no_bzip2, }, + { "title" => "xz source", + "type" => TYPE_XZ, + "suf" => ".xz", + "skip" => has_no_xz, }, ); # All the keep mode information @KEEP_MODES = ( { "title" => "keep default", @@ -239,6 +246,29 @@ sub read_file($) { return $content; } + # an xz compressed file + } elsif ($file =~ /\.xz$/) { + # IO::Uncompress::UnXz + if (eval { require IO::Uncompress::UnXz; 1; }) { + my $xz; + $content = ""; + $xz = IO::Uncompress::UnXz->new($file) + or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError"; + $content = join "", <$xz>; + $xz->close or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError"; + return $content; + + # xz executable + } else { + my ($PH, $CMD); + $CMD = where_is "xz"; + $CMD = "\"$CMD\" -cdf \"$file\""; + open $PH, "$CMD |" or die this_file . ": $CMD: $!"; + $content = join "", <$PH>; + close $PH or die this_file . ": $CMD: $!"; + return $content; + } + # a plain text file } else { my $FH; @@ -326,6 +356,29 @@ sub write_file($$) { return; } + # an xz compressed file + } elsif ($file =~ /\.xz$/) { + # IO::Compress::Xz + if (eval { require IO::Compress::Xz; 1; }) { + my $xz; + $xz = IO::Compress::Xz->new($file, Extreme => 1) + or die this_file . ": $file: $IO::Compress::Xz::XzError"; + ($xz->write($content) == length $content) + or die this_file . ": $file: $IO::Compress::Xz::XzError"; + $xz->close or die this_file . ": $file: $IO::Compress::Xz::XzError"; + return; + + # xz executable + } else { + my ($PH, $CMD); + $CMD = where_is "xz"; + $CMD = "\"$CMD\" -c9f > \"$file\""; + open $PH, "| $CMD" or die this_file . ": $CMD: $!"; + print $PH $content or die this_file . ": $CMD: $!"; + close $PH or die this_file . ": $CMD: $!"; + return; + } + # a plain text file } else { my $FH; @@ -418,6 +471,7 @@ sub file_type($) { $_ = File::MMagic->new->checktype_filename($file); return TYPE_GZIP if /gzip/; return TYPE_BZIP2 if /bzip2/; + return TYPE_XZ if /xz/; # All else are text/plain return TYPE_TEXT; } @@ -426,6 +480,7 @@ sub file_type($) { $_ = join "", `"$_" "$file"`; return TYPE_GZIP if /gzip/; return TYPE_BZIP2 if /bzip2/; + return TYPE_XZ if /: XZ/; # All else are text/plain return TYPE_TEXT; } @@ -515,6 +570,15 @@ sub has_no_bzip2() { return $HAS_NO_BZIP2; } +# If we have xz support somewhere +sub has_no_xz() { + $HAS_NO_XZ = eval { require IO::Compress::Xz; require IO::Uncompress::UnXz; 1; } + || defined where_is "xz"? + 0: "IO::Compress::Xz or xz executable not available" + if !defined $HAS_NO_XZ; + return $HAS_NO_XZ; +} + # Create a normal random log file sub make_log_file($) { local ($_, %_);