summaryrefslogtreecommitdiffstats
path: root/scripts/Dpkg/Compression
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/Dpkg/Compression')
-rw-r--r--scripts/Dpkg/Compression/FileHandle.pm473
-rw-r--r--scripts/Dpkg/Compression/Process.pm211
2 files changed, 684 insertions, 0 deletions
diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm
new file mode 100644
index 0000000..23b3984
--- /dev/null
+++ b/scripts/Dpkg/Compression/FileHandle.pm
@@ -0,0 +1,473 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012-2014 Guillem Jover <guillem@debian.org>
+#
+# 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, see <https://www.gnu.org/licenses/>.
+
+package Dpkg::Compression::FileHandle;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.01';
+
+use Carp;
+
+use Dpkg::Compression;
+use Dpkg::Compression::Process;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use parent qw(IO::File Tie::Handle);
+
+# Useful reference to understand some kludges required to
+# have the object behave like a filehandle
+# http://blog.woobling.org/2009/10/are-filehandles-objects.html
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression::FileHandle - object dealing transparently with file compression
+
+=head1 SYNOPSIS
+
+ use Dpkg::Compression::FileHandle;
+
+ my ($fh, @lines);
+
+ $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, '>', 'sample.bz2');
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ $fh->open('sample.xz', 'w');
+ $fh->print("Something\n");
+ $fh->close();
+
+ $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
+ @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, '<', 'sample.bz2');
+ @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ $fh->open('sample.xz', 'r');
+ @lines = $fh->getlines();
+ $fh->close();
+
+=head1 DESCRIPTION
+
+Dpkg::Compression::FileHandle is an object that can be used
+like any filehandle and that deals transparently with compressed
+files. By default, the compression scheme is guessed from the filename
+but you can override this behaviour with the method C<set_compression>.
+
+If you don't open the file explicitly, it will be auto-opened on the
+first read or write operation based on the filename set at creation time
+(or later with the C<set_filename> method).
+
+Once a file has been opened, the filehandle must be closed before being
+able to open another file.
+
+=head1 STANDARD FUNCTIONS
+
+The standard functions acting on filehandles should accept a
+Dpkg::Compression::FileHandle object transparently including
+C<open> (only when using the variant with 3 parameters), C<close>,
+C<binmode>, C<eof>, C<fileno>, C<getc>, C<print>, C<printf>, C<read>,
+C<sysread>, C<say>, C<write>, C<syswrite>, C<seek>, C<sysseek>, C<tell>.
+
+Note however that C<seek> and C<sysseek> will only work on uncompressed
+files as compressed files are really pipes to the compressor programs
+and you can't seek on a pipe.
+
+=head1 FileHandle METHODS
+
+The object inherits from IO::File so all methods that work on this
+object should work for Dpkg::Compression::FileHandle too. There
+may be exceptions though.
+
+=head1 PUBLIC METHODS
+
+=over 4
+
+=item $fh = Dpkg::Compression::FileHandle->new(%opts)
+
+Creates a new filehandle supporting on-the-fly compression/decompression.
+Supported options are "filename", "compression", "compression_level" (see
+respective set_* functions) and "add_comp_ext". If "add_comp_ext"
+evaluates to true, then the extension corresponding to the selected
+compression scheme is automatically added to the recorded filename. It's
+obviously incompatible with automatic detection of the compression method.
+
+=cut
+
+# Object methods
+sub new {
+ my ($this, %args) = @_;
+ my $class = ref($this) || $this;
+ my $self = IO::File->new();
+ # Tying is required to overload the open functions and to auto-open
+ # the file on first read/write operation
+ tie *$self, $class, $self; ## no critic (Miscellanea::ProhibitTies)
+ bless $self, $class;
+ # Initializations
+ *$self->{compression} = 'auto';
+ *$self->{compressor} = Dpkg::Compression::Process->new();
+ *$self->{add_comp_ext} = $args{add_compression_extension} ||
+ $args{add_comp_ext} || 0;
+ *$self->{allow_sigpipe} = 0;
+ if (exists $args{filename}) {
+ $self->set_filename($args{filename});
+ }
+ if (exists $args{compression}) {
+ $self->set_compression($args{compression});
+ }
+ if (exists $args{compression_level}) {
+ $self->set_compression_level($args{compression_level});
+ }
+ return $self;
+}
+
+=item $fh->ensure_open($mode, %opts)
+
+Ensure the file is opened in the requested mode ("r" for read and "w" for
+write). The options are passed down to the compressor's spawn() call, if one
+is used. Opens the file with the recorded filename if needed. If the file
+is already open but not in the requested mode, then it errors out.
+
+=cut
+
+sub ensure_open {
+ my ($self, $mode, %opts) = @_;
+ if (exists *$self->{mode}) {
+ return if *$self->{mode} eq $mode;
+ croak "ensure_open requested incompatible mode: $mode";
+ } else {
+ # Sanitize options.
+ delete $opts{from_pipe};
+ delete $opts{from_file};
+ delete $opts{to_pipe};
+ delete $opts{to_file};
+
+ if ($mode eq 'w') {
+ $self->_open_for_write(%opts);
+ } elsif ($mode eq 'r') {
+ $self->_open_for_read(%opts);
+ } else {
+ croak "invalid mode in ensure_open: $mode";
+ }
+ }
+}
+
+##
+## METHODS FOR TIED HANDLE
+##
+sub TIEHANDLE {
+ my ($class, $self) = @_;
+ return $self;
+}
+
+sub WRITE {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open('w');
+ return *$self->{file}->write($scalar, $length, $offset);
+}
+
+sub READ {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open('r');
+ return *$self->{file}->read($scalar, $length, $offset);
+}
+
+sub READLINE {
+ my ($self) = shift;
+ $self->ensure_open('r');
+ return *$self->{file}->getlines() if wantarray;
+ return *$self->{file}->getline();
+}
+
+sub OPEN {
+ my ($self) = shift;
+ if (scalar(@_) == 2) {
+ my ($mode, $filename) = @_;
+ $self->set_filename($filename);
+ if ($mode eq '>') {
+ $self->_open_for_write();
+ } elsif ($mode eq '<') {
+ $self->_open_for_read();
+ } else {
+ croak 'Dpkg::Compression::FileHandle does not support ' .
+ "open() mode $mode";
+ }
+ } else {
+ croak 'Dpkg::Compression::FileHandle only supports open() ' .
+ 'with 3 parameters';
+ }
+ return 1; # Always works (otherwise errors out)
+}
+
+sub CLOSE {
+ my ($self) = shift;
+ my $ret = 1;
+ if (defined *$self->{file}) {
+ $ret = *$self->{file}->close(@_) if *$self->{file}->opened();
+ } else {
+ $ret = 0;
+ }
+ $self->_cleanup();
+ return $ret;
+}
+
+sub FILENO {
+ my ($self) = shift;
+ return *$self->{file}->fileno(@_) if defined *$self->{file};
+ return;
+}
+
+sub EOF {
+ # Since perl 5.12, an integer parameter is passed describing how the
+ # function got called, just ignore it.
+ my ($self, $param) = (shift, shift);
+ return *$self->{file}->eof(@_) if defined *$self->{file};
+ return 1;
+}
+
+sub SEEK {
+ my ($self) = shift;
+ return *$self->{file}->seek(@_) if defined *$self->{file};
+ return 0;
+}
+
+sub TELL {
+ my ($self) = shift;
+ return *$self->{file}->tell(@_) if defined *$self->{file};
+ return -1;
+}
+
+sub BINMODE {
+ my ($self) = shift;
+ return *$self->{file}->binmode(@_) if defined *$self->{file};
+ return;
+}
+
+##
+## NORMAL METHODS
+##
+
+=item $fh->set_compression($comp)
+
+Defines the compression method used. $comp should one of the methods supported by
+B<Dpkg::Compression> or "none" or "auto". "none" indicates that the file is
+uncompressed and "auto" indicates that the method must be guessed based
+on the filename extension used.
+
+=cut
+
+sub set_compression {
+ my ($self, $method) = @_;
+ if ($method ne 'none' and $method ne 'auto') {
+ *$self->{compressor}->set_compression($method);
+ }
+ *$self->{compression} = $method;
+}
+
+=item $fh->set_compression_level($level)
+
+Indicate the desired compression level. It should be a value accepted
+by the function C<compression_is_valid_level> of B<Dpkg::Compression>.
+
+=cut
+
+sub set_compression_level {
+ my ($self, $level) = @_;
+ *$self->{compressor}->set_compression_level($level);
+}
+
+=item $fh->set_filename($name, [$add_comp_ext])
+
+Use $name as filename when the file must be opened/created. If
+$add_comp_ext is passed, it indicates whether the default extension
+of the compression method must be automatically added to the filename
+(or not).
+
+=cut
+
+sub set_filename {
+ my ($self, $filename, $add_comp_ext) = @_;
+ *$self->{filename} = $filename;
+ # Automatically add compression extension to filename
+ if (defined($add_comp_ext)) {
+ *$self->{add_comp_ext} = $add_comp_ext;
+ }
+ my $comp_ext_regex = compression_get_file_extension_regex();
+ if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
+ warning('filename %s already has an extension of a compressed file ' .
+ 'and add_comp_ext is active', $filename);
+ }
+}
+
+=item $file = $fh->get_filename()
+
+Returns the filename that would be used when the filehandle must
+be opened (both in read and write mode). This function errors out
+if "add_comp_ext" is enabled while the compression method is set
+to "auto". The returned filename includes the extension of the compression
+method if "add_comp_ext" is enabled.
+
+=cut
+
+sub get_filename {
+ my $self = shift;
+ my $comp = *$self->{compression};
+ if (*$self->{add_comp_ext}) {
+ if ($comp eq 'auto') {
+ croak 'automatic detection of compression is ' .
+ 'incompatible with add_comp_ext';
+ } elsif ($comp eq 'none') {
+ return *$self->{filename};
+ } else {
+ return *$self->{filename} . '.' .
+ compression_get_property($comp, 'file_ext');
+ }
+ } else {
+ return *$self->{filename};
+ }
+}
+
+=item $ret = $fh->use_compression()
+
+Returns "0" if no compression is used and the compression method used
+otherwise. If the compression is set to "auto", the value returned
+depends on the extension of the filename obtained with the B<get_filename>
+method.
+
+=cut
+
+sub use_compression {
+ my $self = shift;
+ my $comp = *$self->{compression};
+ if ($comp eq 'none') {
+ return 0;
+ } elsif ($comp eq 'auto') {
+ $comp = compression_guess_from_filename($self->get_filename());
+ *$self->{compressor}->set_compression($comp) if $comp;
+ }
+ return $comp;
+}
+
+=item $real_fh = $fh->get_filehandle()
+
+Returns the real underlying filehandle. Useful if you want to pass it
+along in a derived object.
+
+=cut
+
+sub get_filehandle {
+ my $self = shift;
+ return *$self->{file} if exists *$self->{file};
+}
+
+## INTERNAL METHODS
+
+sub _open_for_write {
+ my ($self, %opts) = @_;
+ my $filehandle;
+
+ croak 'cannot reopen an already opened compressed file'
+ if exists *$self->{mode};
+
+ if ($self->use_compression()) {
+ *$self->{compressor}->compress(from_pipe => \$filehandle,
+ to_file => $self->get_filename(), %opts);
+ } else {
+ CORE::open($filehandle, '>', $self->get_filename)
+ or syserr(g_('cannot write %s'), $self->get_filename());
+ }
+ *$self->{mode} = 'w';
+ *$self->{file} = $filehandle;
+}
+
+sub _open_for_read {
+ my ($self, %opts) = @_;
+ my $filehandle;
+
+ croak 'cannot reopen an already opened compressed file'
+ if exists *$self->{mode};
+
+ if ($self->use_compression()) {
+ *$self->{compressor}->uncompress(to_pipe => \$filehandle,
+ from_file => $self->get_filename(), %opts);
+ *$self->{allow_sigpipe} = 1;
+ } else {
+ CORE::open($filehandle, '<', $self->get_filename)
+ or syserr(g_('cannot read %s'), $self->get_filename());
+ }
+ *$self->{mode} = 'r';
+ *$self->{file} = $filehandle;
+}
+
+sub _cleanup {
+ my $self = shift;
+ my $cmdline = *$self->{compressor}{cmdline} // '';
+ *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
+ if (*$self->{allow_sigpipe}) {
+ require POSIX;
+ unless (($? == 0) || (POSIX::WIFSIGNALED($?) &&
+ (POSIX::WTERMSIG($?) == POSIX::SIGPIPE()))) {
+ subprocerr($cmdline);
+ }
+ *$self->{allow_sigpipe} = 0;
+ }
+ delete *$self->{mode};
+ delete *$self->{file};
+}
+
+=back
+
+=head1 DERIVED OBJECTS
+
+If you want to create an object that inherits from
+Dpkg::Compression::FileHandle you must be aware that
+the object is a reference to a GLOB that is returned by Symbol::gensym()
+and as such it's not a HASH.
+
+You can store internal data in a hash but you have to use
+C<*$self->{...}> to access the associated hash like in the example below:
+
+ sub set_option {
+ my ($self, $value) = @_;
+ *$self->{option} = $value;
+ }
+
+=head1 CHANGES
+
+=head2 Version 1.01 (dpkg 1.17.11)
+
+New argument: $fh->ensure_open() accepts an %opts argument.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+1;
diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm
new file mode 100644
index 0000000..9b733cc
--- /dev/null
+++ b/scripts/Dpkg/Compression/Process.pm
@@ -0,0 +1,211 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
+#
+# 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, see <https://www.gnu.org/licenses/>.
+
+package Dpkg::Compression::Process;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+
+use Carp;
+
+use Dpkg::Compression;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::IPC;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression::Process - run compression/decompression processes
+
+=head1 DESCRIPTION
+
+This module provides an object oriented interface to run and manage
+compression/decompression processes.
+
+=head1 METHODS
+
+=over 4
+
+=item $proc = Dpkg::Compression::Process->new(%opts)
+
+Create a new instance of the object. Supported options are "compression"
+and "compression_level" (see corresponding set_* functions).
+
+=cut
+
+sub new {
+ my ($this, %args) = @_;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ $self->set_compression($args{compression} || compression_get_default());
+ $self->set_compression_level($args{compression_level} ||
+ compression_get_default_level());
+ return $self;
+}
+
+=item $proc->set_compression($comp)
+
+Select the compression method to use. It errors out if the method is not
+supported according to C<compression_is_supported> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression {
+ my ($self, $method) = @_;
+ error(g_('%s is not a supported compression method'), $method)
+ unless compression_is_supported($method);
+ $self->{compression} = $method;
+}
+
+=item $proc->set_compression_level($level)
+
+Select the compression level to use. It errors out if the level is not
+valid according to C<compression_is_valid_level> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression_level {
+ my ($self, $level) = @_;
+ error(g_('%s is not a compression level'), $level)
+ unless compression_is_valid_level($level);
+ $self->{compression_level} = $level;
+}
+
+=item @exec = $proc->get_compress_cmdline()
+
+=item @exec = $proc->get_uncompress_cmdline()
+
+Returns a list ready to be passed to C<exec>, its first element is the
+program name (either for compression or decompression) and the following
+elements are parameters for the program.
+
+When executed the program acts as a filter between its standard input
+and its standard output.
+
+=cut
+
+sub get_compress_cmdline {
+ my $self = shift;
+ my @prog = (@{compression_get_property($self->{compression}, 'comp_prog')});
+ my $level = '-' . $self->{compression_level};
+ $level = '--' . $self->{compression_level}
+ if $self->{compression_level} !~ m/^[1-9]$/;
+ push @prog, $level;
+ return @prog;
+}
+
+sub get_uncompress_cmdline {
+ my $self = shift;
+ return (@{compression_get_property($self->{compression}, 'decomp_prog')});
+}
+
+sub _sanity_check {
+ my ($self, %opts) = @_;
+ # Check for proper cleaning before new start
+ error(g_('Dpkg::Compression::Process can only start one subprocess at a time'))
+ if $self->{pid};
+ # Check options
+ my $to = my $from = 0;
+ foreach my $thing (qw(file handle string pipe)) {
+ $to++ if $opts{"to_$thing"};
+ $from++ if $opts{"from_$thing"};
+ }
+ croak 'exactly one to_* parameter is needed' if $to != 1;
+ croak 'exactly one from_* parameter is needed' if $from != 1;
+ return %opts;
+}
+
+=item $proc->compress(%opts)
+
+Starts a compressor program. You must indicate where it will read its
+uncompressed data from and where it will write its compressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub compress {
+ my ($self, %opts) = @_;
+
+ $self->_sanity_check(%opts);
+ my @prog = $self->get_compress_cmdline();
+ $opts{exec} = \@prog;
+ $self->{cmdline} = "@prog";
+ $self->{pid} = spawn(%opts);
+ delete $self->{pid} if $opts{to_string}; # wait_child already done
+}
+
+=item $proc->uncompress(%opts)
+
+Starts a decompressor program. You must indicate where it will read its
+compressed data from and where it will write its uncompressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub uncompress {
+ my ($self, %opts) = @_;
+
+ $self->_sanity_check(%opts);
+ my @prog = $self->get_uncompress_cmdline();
+ $opts{exec} = \@prog;
+ $self->{cmdline} = "@prog";
+ $self->{pid} = spawn(%opts);
+ delete $self->{pid} if $opts{to_string}; # wait_child already done
+}
+
+=item $proc->wait_end_process(%opts)
+
+Call B<Dpkg::IPC::wait_child> to wait until the sub-process has exited
+and verify its return code. Any given option will be forwarded to
+the C<wait_child> function. Most notably you can use the "nocheck" option
+to verify the return code yourself instead of letting C<wait_child> do
+it for you.
+
+=cut
+
+sub wait_end_process {
+ my ($self, %opts) = @_;
+ $opts{cmdline} //= $self->{cmdline};
+ wait_child($self->{pid}, %opts) if $self->{pid};
+ delete $self->{pid};
+ delete $self->{cmdline};
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-30 15:06:47 +0000