Server IP : 85.214.239.14 / Your IP : 18.226.166.207 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Amavis/IO/ |
Upload File : |
# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::IO::Zlib; # A simple IO::File -compatible wrapper around Compress::Zlib, # much like IO::Zlib but simpler: does only what we need and does it carefully use strict; use re 'taint'; BEGIN { require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '2.412'; @ISA = qw(Exporter); } use Errno qw(EIO); use Compress::Zlib; sub new { my $class = shift; my $self = bless {}, $class; if (@_) { $self->open(@_) or return } $self; } sub close { my $self = $_[0]; my $status; my $eval_stat; local($1,$2); eval { $status = $self->{fh}->gzclose; 1 } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" }; delete $self->{fh}; if (defined $eval_stat) { chomp $eval_stat; die $eval_stat if $eval_stat =~ /^timed out\b/; # resignal timeout # can't stash arbitrary text into $! die "gzclose error: $eval_stat, $gzerrno"; $! = EIO; return; # not reached } elsif ($status != Z_OK) { die "gzclose error: $gzerrno"; # can't stash arbitrary text into $! $! = EIO; return; # not reached } 1; } sub DESTROY { my $self = $_[0]; local($@,$!,$_); # ignore failure, make perlcritic happy if ($self && $self->{fh}) { eval { $self->close } or 1 } } sub open { my($self,$fname,$mode) = @_; # ignore failure, make perlcritic happy if (exists($self->{fh})) { eval { $self->close } or 1; delete $self->{fh} } $self->{fname} = $fname; $self->{mode} = $mode; $self->{pos} = 0; my $gz = gzopen($fname,$mode); if ($gz) { $self->{fh} = $gz; } else { die "gzopen error: $gzerrno"; # can't stash arbitrary text into $! $! = EIO; undef $gz; # not reached } $gz; } sub seek { my($self,$pos,$whence) = @_; $whence == 0 or die "Only absolute seek is supported on gzipped file"; $pos >= 0 or die "Can't seek to a negative absolute position"; $self->{mode} eq 'rb' or die "Seek to $whence,$pos on gzipped file only supported for 'rb' mode"; if ($pos < $self->{pos}) { $self->close or die "seek: can't close gzipped file: $!"; $self->open($self->{fname},$self->{mode}) or die "seek: can't reopen gzipped file: $!"; } my $skip = $pos - $self->{pos}; while ($skip > 0) { my $s; my $nbytes = $self->read($s,$skip); # acceptable for small skips defined $nbytes && $nbytes > 0 or die "seek: error skipping $skip bytes on gzipped file: $!"; $skip -= $nbytes; } 1; # seek is supposed to return 1 upon success, 0 otherwise } sub read { # SCALAR,LENGTH,OFFSET my $self = shift; my $len = $_[1]; my $offset = $_[2]; defined $len or die "Amavis::IO::Zlib::read: length argument undefined"; my $nbytes; if (!defined($offset) || $offset == 0) { $nbytes = $self->{fh}->gzread($_[0], $len); } else { my $buff; $nbytes = $self->{fh}->gzread($buff, $len); substr($_[0],$offset) = $buff; } if ($nbytes < 0) { die "gzread error: $gzerrno"; # can't stash arbitrary text into $! $! = EIO; undef $nbytes; # not reached } else { $self->{pos} += $nbytes; } $nbytes; # eof: 0; error: undef } sub getline { my $self = $_[0]; my($nbytes,$line); $nbytes = $self->{fh}->gzreadline($line); if ($nbytes <= 0) { # eof (0) or error (-1) $! = 0; $line = undef; if ($nbytes < 0 && $gzerrno != Z_STREAM_END) { die "gzreadline error: $gzerrno"; # can't stash arbitrary text into $! $! = EIO; # not reached } } else { $self->{pos} += $nbytes; } $line; # eof: undef, $! zero; error: undef, $! nonzero } sub print { my $self = shift; my $buff_ref = @_ == 1 ? \$_[0] : \join('',@_); my $nbytes; my $len = length($$buff_ref); if ($len <= 0) { $nbytes = "0 but true"; } else { $nbytes = $self->{fh}->gzwrite($$buff_ref); $self->{pos} += $len; if ($nbytes <= 0) { die "gzwrite error: $gzerrno"; # can't stash arbitrary text into $! $! = EIO; undef $nbytes; # not reached } } $nbytes; } sub printf { shift->print(sprintf(shift,@_)) } 1;