diff --git a/Changes b/Changes index 51be237..0c9de0e 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ arclog change log +2022-03-19 + Added support for the xz compression. + 2020-02-06 version 3.05 1. Replaced the messy GNU-styled, multi-lingual documents with a single Markdown README.md. diff --git a/README.md b/README.md index d1ca977..1cd02eb 100644 --- a/README.md +++ b/README.md @@ -12,9 +12,9 @@ space and prevents potential attacks on log files. Currently, `arclog` supports [Apache] access log, Syslog, [NTP], Apache 1 SSL engine log, and my own bracketed, modified ISO date/time -log file formats, and gzip and bzip2 compression methods. Several -software projects log (or can log) in a format compatible with the -Apache access log, like [CUPS], [ProFTPD], [Pure-FTPd]… etc., and +log file formats, and gzip, bzip2, and xz compression methods. +Several software projects log (or can log) in a format compatible with +the Apache access log, like [CUPS], [ProFTPD], [Pure-FTPd]… etc., and `arclog` can archive their Apache-like log files, too. Caution @@ -84,10 +84,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. `arclog` treats everything not - gzip nor bzip2 compressed as plain text. When a compressed log file - is wrongly recognized as an image, `arclog` 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, or xz compressed as plain text. When a compressed log + file is wrongly recognized as an image, `arclog` treats it as plain + text, reads directly from it, and fails. This does not hurt the + source log files, but is still annoying. [Date::Parse]: https://metacpan.org/release/TimeDate [File::MMagic]: https://metacpan.org/release/File-MMagic @@ -248,6 +248,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 @@ -286,9 +322,13 @@ System Requirement [GnuWin32]: http://gnuwin32.sourceforge.net [Compress::Zlib]: https://metacpan.org/pod/Compress::Zlib [the gzip website]: https://www.gzip.org -[IO-Compress]: https://metacpan.org/release/IO-Compress +[IO-Compress]: https://metacpan.org/dist/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 @@ -430,8 +470,8 @@ Options * `logfile` The log file to be archived. Specify `-` to read from `STDIN`. - You can specify multiple log files. `gzip` or `bzip2` compressed - files are supported. + You can specify multiple log files. `gzip`, `bzip2`, or `xz` + compressed files are supported. * `output` @@ -465,6 +505,14 @@ Options installed, it tries `bzip2` instead. If `bzip2` is not available, either, it fails. + * `x`, `xz` + + Compress with `xz`. `arclog` can use `IO::Compress::Xz` to + compress instead of calling `xz`. This can be safer and faster + for not calling foreign binaries. If `IO::Compress::Xz` is not + installed, it tries `xz` instead. If `xz` is not available, + either, it fails. + * `n`, `none` No compression at all. (Why? :p) diff --git a/arclog b/arclog index fd8f4e7..64f260a 100755 --- a/arclog +++ b/arclog @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # arclog: Archive the log files monthly -# Copyright (c) 2001-2021 imacat. +# Copyright (c) 2001-2022 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -36,10 +36,10 @@ use base qw(Exporter); our (@EXPORT, @EXPORT_OK); BEGIN { @EXPORT = qw( -COMPRESS_GZIP COMPRESS_BZIP2 COMPRESS_NONE +COMPRESS_GZIP COMPRESS_BZIP2 COMPRESS_XZ COMPRESS_NONE OVERRIDE_OVERWRITE OVERRIDE_APPEND OVERRIDE_IGNORE OVERRIDE_FAIL OVERRIDE_ASK KEEP_ALL KEEP_RESTART KEEP_DELETE KEEP_THIS_MONTH -TYPE_PLAIN TYPE_GZIP TYPE_BZIP2 +TYPE_PLAIN TYPE_GZIP TYPE_BZIP2 TYPE_XZ TMP_SUFFIX where_is to_yyyymm format_number rel2abs); @EXPORT_OK = @EXPORT; # Prototype declaration @@ -65,6 +65,7 @@ $THIS_MONTH = to_yyyymm $^T; # The compress mode use constant COMPRESS_GZIP => "gzip"; use constant COMPRESS_BZIP2 => "bzip2"; +use constant COMPRESS_XZ => "xz"; use constant COMPRESS_NONE => "none"; use constant DEFAULT_COMPRESS => COMPRESS_GZIP; # The override mode @@ -84,6 +85,7 @@ use constant DEFAULT_KEEP => KEEP_THIS_MONTH; use constant TYPE_PLAIN => "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-arclog"; use constant GZIP_SUFFIX => ".gz"; @@ -103,7 +105,7 @@ Archive the log files monthly. named as pre.yyyymm, ie: pre.200001, pre.200002. If not specified, the default prefix is the logfile pathname. --compress method Compress the archived files. Available methods are: - gzip, bzip2 and none. The default is gzip. + gzip, bzip2, xz, and none. The default is gzip. --sort Sort the records in the log files by time. --nosort Do not sort the records. (default) --override mode The override behavior when the target archived files @@ -218,6 +220,8 @@ sub parse_args() { $CONF{"COMPRESS"} = COMPRESS_GZIP; } elsif ($_[1] =~ /^(?:b|bzip2)$/i) { $CONF{"COMPRESS"} = COMPRESS_BZIP2; + } elsif ($_[1] =~ /^(?:x|xz)$/i) { + $CONF{"COMPRESS"} = COMPRESS_XZ; } elsif ($_[1] =~ /^(?:n|none)$/i) { $CONF{"COMPRESS"} = COMPRESS_NONE; } else { @@ -364,6 +368,7 @@ sub parse_args() { if ($one_arg) { $CONF{"OUTPUT"} =~ s/\.gz$// if $LOGFILES[0]->{"type"} eq TYPE_GZIP; $CONF{"OUTPUT"} =~ s/\.bz2$// if $LOGFILES[0]->{"type"} eq TYPE_BZIP2; + $CONF{"OUTPUT"} =~ s/\.xz// if $LOGFILES[0]->{"type"} eq TYPE_XZ; } die "$THIS_FILE: Please specify output prefix\n$SHORT_HELP\n" if !defined $CONF{"OUTPUT"}; @@ -616,6 +621,8 @@ sub check_temp : 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"}; } @@ -821,6 +828,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_PLAIN; } @@ -855,6 +863,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_PLAIN; } @@ -868,6 +877,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; } @@ -1028,6 +1039,8 @@ sub new : method { $self->{"io"} = _private::IO->check_gzip; } elsif ($CONF{"COMPRESS"} eq COMPRESS_BZIP2) { $self->{"io"} = _private::IO->check_bzip2; + } elsif ($CONF{"COMPRESS"} eq COMPRESS_XZ) { + $self->{"io"} = _private::IO->check_xz; } else { $self->{"io"} = _private::IO::Plain->new; } @@ -1232,10 +1245,11 @@ import main; use Fcntl qw(:seek); -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 @@ -1314,6 +1328,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"; +} + # Prepend records to an existing file # * static method * # For most I/O we read records out and write back with 2 I/O accesses. @@ -2442,6 +2491,465 @@ sub close : method { return; } + +# _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); + +# The file name suffix of this mime type +sub suffix : method { ".xz"; } + +# 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) + 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) + 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) + 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 { + return $_[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 || $keep eq KEEP_THIS_MONTH) { + # 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, Append => 0) + 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; +} + +# The file name suffix of this mime type +sub suffix : method { ".xz"; } + +# 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, "-9f"); + @_ = map "\"$_\"", @_ if $^O eq "MSWin32"; + $CMD = join " ", @_; + print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; + # Redirect STDOUT to $FH + open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; + # Start the process + if ($^O eq "MSWin32") { + open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!"; + } else { + open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!"; + } + # Restore STDOUT + open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!"; + print STDERR "done\n" if $VERBOSE > 2; + ($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH); + return; +} + +# Open 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, "-9f"); + @_ = map "\"$_\"", @_ if $^O eq "MSWin32"; + $CMD = join " ", @_; + print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; + # Redirect STDOUT to $FH + open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; + # Start the process + if ($^O eq "MSWin32") { + open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!"; + } else { + open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!"; + } + # Restore STDOUT + open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!"; + print STDERR "done\n" if $VERBOSE > 2; + + print STDERR " Reading old records back from the buffer ... " if $VERBOSE > 2; + $count = 0; + while (defined($_ = <$PHT>)) { + print $PH $_ or die "$THIS_FILE: $file: $!"; + $count++; + } + close $PHT or die "$THIS_FILE: $CMD_T: $!"; + close $FHT or die "$THIS_FILE: tempfile: $!"; + print STDERR "$count records\n" if $VERBOSE > 2; + + # A whole new file + } else { + @_ = ($EXEC, "-9f"); + @_ = map "\"$_\"", @_ if $^O eq "MSWin32"; + $CMD = join " ", @_; + print STDERR " Starting $CMD to file ... " if $VERBOSE > 2; + # Redirect STDOUT to $FH + open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; + # Start the process + if ($^O eq "MSWin32") { + open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!"; + } else { + open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!"; + } + # Restore STDOUT + open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!"; + print STDERR "done\n" if $VERBOSE > 2; + } + + ($self->{"CMD"}, $self->{"PH"}) = ([@_], $PH); + return; +} + +# 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 || $keep eq KEEP_THIS_MONTH) { + 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, "-9f"); + @_ = map "\"$_\"", @_ if $^O eq "MSWin32"; + $CMD = join " ", @_; + # Redirect STDOUT to $FH + open STDOUT, ">&", $FH or die "$THIS_FILE: $file: $!"; + # Start the process and end it + if ($^O eq "MSWin32") { + open $PH, "| $CMD" or die "$THIS_FILE: $CMD: $!"; + } else { + open $PH, "|-", @_ or die "$THIS_FILE: $CMD: $!"; + } + close $PH or die "$THIS_FILE: $CMD: $!"; + # Restore STDOUT + open STDOUT, ">&", $STDOUT or die "$THIS_FILE: STDOUT: $!"; + print STDERR "done\n" if $VERBOSE > 2; + } + + ($CMD, $PH) = (join(" ", @{$self->{"CMD"}}), $self->{"PH"}); + CORE::close $PH or die "$THIS_FILE: $CMD: $!"; + CORE::close $FH or die "$THIS_FILE: $file: $!"; + delete $self->{"PH"}; + delete $self->{"CMD"}; + delete $self->{"FH"}; + delete $self->{"file"}; + + # Delete the file + if ($keep eq KEEP_DELETE) { + print STDERR " Deleting file ... " if $VERBOSE > 2; + unlink $file or die "$THIS_FILE: $file: $!"; + print STDERR "done\n" if $VERBOSE > 2; + } + # Delete the temporary file if needed + if (defined $tmp && -e $tmp) { + unlink $tmp or die "$THIS_FILE: $tmp: $!"; + } + return; +} + + # _private::Format: The abstract log file format handler interface package _private::Format; use 5.008; @@ -2587,7 +3095,7 @@ to archived files named logfile.yyyymm.gz. Currently, F supports Apache access log, Syslog, NTP, Apache 1 SSL engine log, and my own bracketed, modified ISO date/time log -file formats, and gzip and bzip2 compression methods. Several +file formats, and gzip, bzip2, and xz compression methods. Several software projects log (or can log) in a format compatible with the Apache access log, like CUPS, ProFTPD, Pure-FTPd... etc., and F can archive their Apache-like log files, too. @@ -2657,10 +3165,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 @@ -2669,8 +3178,8 @@ F treats it as plain text, reads directly from it, and fails. =item logfile The log file to be archived. Specify C<-> to read from C. -You can specify multiple log files. L or -L compressed files are supported. +You can specify multiple log files. L, +L, or L compressed files are supported. =item output @@ -2707,6 +3216,15 @@ calling foreign binaries. If L is not installed, it will try to use L instead. If L is not available, either, it fails. +=item x, xz + +Compress with L. F can use +L to compress instead of +calling L. This can be safer and faster for not +calling foreign binaries. If L +is not installed, it will try to use L instead. If +L is not available, either, it fails. + =item n, none No compression at all. (Why? :p) @@ -2859,8 +3377,11 @@ messages. =head1 SEE ALSO -L, L, -L, L, -L, L +L, L, L, +L, L, +L, +L, +L, +L =cut diff --git a/t/01-exhaust.t b/t/01-exhaust.t index 0bc063e..50bd828 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) 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 => 2160 } +BEGIN { plan tests => 3600 } use File::Basename qw(basename); use File::Path qw(mkpath rmtree); @@ -35,7 +35,7 @@ $WORKDIR = catdir($FindBin::Bin, "logs"); $arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog"); $tno = 0; -# 1-2160: All possible option combinations +# 1-3600: All possible option combinations # Test each log file format foreach my $fmt (@LOG_FORMATS) { # Test each source log file type diff --git a/t/02-several.t b/t/02-several.t index 5042517..bf61d41 100755 --- a/t/02-several.t +++ b/t/02-several.t @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # Test archiving 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. @@ -21,7 +21,7 @@ use warnings; use diagnostics; use Test; -BEGIN { plan tests => 16 } +BEGIN { plan tests => 25 } use File::Basename qw(basename); use File::Path qw(mkpath rmtree); @@ -35,14 +35,15 @@ $WORKDIR = catdir($FindBin::Bin, "logs"); $arclog = catfile($FindBin::Bin, updir, "blib", "script", "arclog"); $tno = 0; -# 1-16: Archiving several log files at once +# 1-25: Archiving several log files at once foreach my $rt (@RESULT_TYPES) { my $skip; $skip = 0; # 1: Source log files listed as the arguments $_ = eval { if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip) - || ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2)) { + || ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2) + || ($$rt{"type"} eq TYPE_XZ && has_no_xz)) { $skip = 1; return; } @@ -56,13 +57,15 @@ foreach my $rt (@RESULT_TYPES) { $title = join ", ", "several log files", "all listed as arguments", $$fmt{"title"}, $$rt{"title"}; # (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); @@ -73,7 +76,8 @@ foreach my $rt (@RESULT_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); } @st = map $types{$_}, (0...$num-1); @fs = qw(); @@ -146,15 +150,17 @@ foreach my $rt (@RESULT_TYPES) { skip($skip, $_, 1, $@); clean_up $_ || $skip, $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) { $skip = 0; $_ = eval { if ( ($$rt{"type"} eq TYPE_GZIP && has_no_gzip) || ($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2) + || ($$rt{"type"} eq TYPE_XZ && has_no_xz) || ($$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; } @@ -168,13 +174,15 @@ foreach my $rt (@RESULT_TYPES) { $title = join ", ", "several log files", "one read from STDIN", "STDIN " . $$st_stdin{"title"}, $$rt{"title"}; # (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); @@ -185,7 +193,8 @@ foreach my $rt (@RESULT_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-fallback.t b/t/03-fallback.t index cb8ff35..79c0c8c 100755 --- a/t/03-fallback.t +++ b/t/03-fallback.t @@ -1,7 +1,7 @@ #! /usr/bin/perl -w # Test fallback behavior -# 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. @@ -50,18 +50,21 @@ foreach my $kt (@KEEP_MODES) { do { $rt = $RESULT_TYPES[int rand @RESULT_TYPES]; } until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip) - && !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2); + && !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2) + && !($$rt{"type"} eq TYPE_XZ && has_no_xz); $title = join ", ", "STDIN keep fall back", $$kt{"title"}, $$fmt{"title"}, $$rt{"title"}; # (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 $_; $stdin = int rand $num; 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); @@ -72,7 +75,8 @@ foreach my $kt (@KEEP_MODES) { 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(); @@ -160,18 +164,21 @@ $_ = eval { do { $rt = $RESULT_TYPES[int rand @RESULT_TYPES]; } until !($$rt{"type"} eq TYPE_GZIP && has_no_gzip) - && !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2); + && !($$rt{"type"} eq TYPE_BZIP2 && has_no_bzip2) + && !($$rt{"type"} eq TYPE_XZ && has_no_xz); $title = join ", ", "STDIN override ask fall back", $$fmt{"title"}, $$rt{"title"}; # (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 $_; $stdin = int rand $num; 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); @@ -182,7 +189,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(); diff --git a/t/04-errors.t b/t/04-errors.t index 5c70f54..07e4d1c 100755 --- a/t/04-errors.t +++ b/t/04-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. @@ -140,13 +140,15 @@ $_ = eval { $title = join ",", "A same log file is specified more than once", $$fmt{"title"}, $$rt{"title"}; # (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); @@ -157,7 +159,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(); diff --git a/t/_helper.pm b/t/_helper.pm index 6d8e3fd..4d3c70a 100644 --- a/t/_helper.pm +++ b/t/_helper.pm @@ -1,6 +1,6 @@ # _helper.pm - A simple test suite helper -# 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. @@ -24,12 +24,12 @@ $VERSION = "0.01"; @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_apache_log_file make_syslog_log_file make_ntp_log_file make_apache_ssl_log_file make_modified_iso_log_file random_word - TYPE_TEXT TYPE_GZIP TYPE_BZIP2 + TYPE_TEXT TYPE_GZIP TYPE_BZIP2 TYPE_XZ @LOG_FORMATS @SOURCE_TYPES @RESULT_TYPES @KEEP_MODES @OVERRIDE_MODES); # Prototype declaration sub this_file(); @@ -46,6 +46,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_apache_log_file($;$); sub make_syslog_log_file($;$); @@ -71,15 +72,17 @@ use File::Temp qw(tempfile); use Time::Local qw(timelocal); $Data::Dumper::Indent = 1; -our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2); +our (%WHERE_IS, $HAS_NO_FILE, $HAS_NO_GZIP, $HAS_NO_BZIP2, $HAS_NO_XZ); %WHERE_IS = qw(); undef $HAS_NO_FILE; undef $HAS_NO_GZIP; undef $HAS_NO_BZIP2; +undef $HAS_NO_XZ; 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 (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES); # All the log format information @@ -107,7 +110,11 @@ our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES); { "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 result type information @RESULT_TYPES = ( { "title" => "default compress", @@ -125,6 +132,11 @@ our (@LOG_FORMATS, @SOURCE_TYPES, @RESULT_TYPES, @KEEP_MODES, @OVERRIDE_MODES); "suf" => ".bz2", "skip" => has_no_bzip2, "opts" => [qw(-c b)], }, + { "title" => "xz compress", + "type" => TYPE_XZ, + "suf" => ".xz", + "skip" => has_no_xz, + "opts" => [qw(-c x)], }, { "title" => "no compress", "type" => TYPE_TEXT, "suf" => "", @@ -275,6 +287,36 @@ sub read_file($) { return $content; } + # an xz compressed file + } elsif ($file =~ /\.xz/) { + # IO::Uncompress::UnXz + if (eval { require IO::Uncompress::UnXz; 1; }) { + my ($FH, $xz); + $content = ""; + open $FH, $file or die this_file . ": $file: $!"; + + $xz = IO::Uncompress::UnXz->new($FH) + or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError"; + while (1) { + ($xz->read($_, 10240) != -1) + or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError"; + $content .= $_; + last if length $_ < 10240; + } + $xz->close or die this_file . ": $file: $IO::Uncompress::UnXz::UnXzError"; + return $content; + + # xz executable + } else { + my ($PH, $CMD); + $CMD = where_is "xz"; + $CMD = "xz -cd \"$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; @@ -360,6 +402,30 @@ sub write_file($$) { return; } + # an xz compressed file + } elsif ($file =~ /\.xz/) { + # IO::Compress::Xz + if (eval { require IO::Compress::Xz; 1; }) { + my ($FH, $xz); + open $FH, ">$file" or die this_file . ": $file: $!"; + $xz = IO::Compress::Xz->new($FH) + or die this_file . ": $file: $IO::Compress::Xz::XzError"; + ($xz->write($content, length $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\" -9f > \"$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; @@ -452,6 +518,7 @@ sub file_type($) { $_ = File::MMagic->new->checktype_filename($file); return "application/x-gzip" if /gzip/; return "application/x-bzip2" if /bzip2/; + return "application/x-xz" if /xz/; # All else are text/plain return "text/plain"; } @@ -460,6 +527,7 @@ sub file_type($) { $_ = join "", `"$_" "$file"`; return "application/x-gzip" if /gzip/; return "application/x-bzip2" if /bzip2/; + return "application/x-xz" if /: XZ/; # All else are text/plain return "text/plain"; } @@ -549,6 +617,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 random existing log file sub make_log_file($$$@) { local ($_, %_);