Revision 9e8147d6
Von Moritz Bunkus vor fast 5 Jahren hinzugefügt
| SL/ArchiveZipFixes.pm | ||
|---|---|---|
| 1 |
package SL::ArchiveZipFixes; |
|
| 2 |
|
|
| 3 |
use strict; |
|
| 4 |
|
|
| 5 |
use Archive::Zip; |
|
| 6 |
use Archive::Zip::Member; |
|
| 7 |
use version; |
|
| 8 |
|
|
| 9 |
# Archive::Zip contains a bug starting with 1.31_04 which prohibits |
|
| 10 |
# re-writing Zips produced by LibreOffice (.odt). See |
|
| 11 |
# https://rt.cpan.org/Public/Bug/Display.html?id=92205 |
|
| 12 |
|
|
| 13 |
sub _member_writeToFileHandle {
|
|
| 14 |
my $self = shift; |
|
| 15 |
my $fh = shift; |
|
| 16 |
my $fhIsSeekable = shift; |
|
| 17 |
my $offset = shift; |
|
| 18 |
|
|
| 19 |
return _error("no member name given for $self")
|
|
| 20 |
if $self->fileName() eq ''; |
|
| 21 |
|
|
| 22 |
$self->{'writeLocalHeaderRelativeOffset'} = $offset;
|
|
| 23 |
$self->{'wasWritten'} = 0;
|
|
| 24 |
|
|
| 25 |
# Determine if I need to write a data descriptor |
|
| 26 |
# I need to do this if I can't refresh the header |
|
| 27 |
# and I don't know compressed size or crc32 fields. |
|
| 28 |
my $headerFieldsUnknown = ( |
|
| 29 |
( $self->uncompressedSize() > 0 ) |
|
| 30 |
and ($self->compressionMethod() == Archive::Zip::COMPRESSION_STORED |
|
| 31 |
or $self->desiredCompressionMethod() == Archive::Zip::COMPRESSION_DEFLATED ) |
|
| 32 |
); |
|
| 33 |
|
|
| 34 |
my $shouldWriteDataDescriptor = |
|
| 35 |
( $headerFieldsUnknown and not $fhIsSeekable ); |
|
| 36 |
|
|
| 37 |
$self->hasDataDescriptor(1) |
|
| 38 |
if ($shouldWriteDataDescriptor); |
|
| 39 |
|
|
| 40 |
$self->{'writeOffset'} = 0;
|
|
| 41 |
|
|
| 42 |
my $status = $self->rewindData(); |
|
| 43 |
( $status = $self->_writeLocalFileHeader($fh) ) |
|
| 44 |
if $status == Archive::Zip::AZ_OK; |
|
| 45 |
( $status = $self->_writeData($fh) ) |
|
| 46 |
if $status == Archive::Zip::AZ_OK; |
|
| 47 |
if ( $status == Archive::Zip::AZ_OK ) {
|
|
| 48 |
$self->{'wasWritten'} = 1;
|
|
| 49 |
if ( $self->hasDataDescriptor() ) {
|
|
| 50 |
$status = $self->_writeDataDescriptor($fh); |
|
| 51 |
} |
|
| 52 |
elsif ($headerFieldsUnknown) {
|
|
| 53 |
$status = $self->_refreshLocalFileHeader($fh); |
|
| 54 |
} |
|
| 55 |
} |
|
| 56 |
|
|
| 57 |
return $status; |
|
| 58 |
} |
|
| 59 |
|
|
| 60 |
sub fix_write_to_file_handle_1_30 {
|
|
| 61 |
return if version->new("$Archive::Zip::VERSION")->numify <= version->new("1.30")->numify;
|
|
| 62 |
|
|
| 63 |
no warnings 'redefine'; |
|
| 64 |
|
|
| 65 |
*Archive::Zip::Member::_writeToFileHandle = \&_member_writeToFileHandle; |
|
| 66 |
} |
|
| 67 |
|
|
| 68 |
sub apply_fixes {
|
|
| 69 |
fix_write_to_file_handle_1_30(); |
|
| 70 |
} |
|
| 71 |
|
|
| 72 |
1; |
|
| SL/Dispatcher.pm | ||
|---|---|---|
| 19 | 19 |
use List::MoreUtils qw(all); |
| 20 | 20 |
use List::Util qw(first); |
| 21 | 21 |
use POSIX qw(setlocale); |
| 22 |
use SL::ArchiveZipFixes; |
|
| 23 | 22 |
use SL::Auth; |
| 24 | 23 |
use SL::Dispatcher::AuthHandler; |
| 25 | 24 |
use SL::LXDebug; |
| ... | ... | |
| 51 | 50 |
$self->{interface} = lc($interface || 'cgi');
|
| 52 | 51 |
$self->{auth_handler} = SL::Dispatcher::AuthHandler->new;
|
| 53 | 52 |
|
| 54 |
SL::ArchiveZipFixes->apply_fixes; |
|
| 55 |
|
|
| 56 | 53 |
# Initialize character type locale to be UTF-8 instead of C: |
| 57 | 54 |
foreach my $locale (qw(de_DE.UTF-8 en_US.UTF-8)) {
|
| 58 | 55 |
last if setlocale('LC_CTYPE', $locale);
|
| SL/InstallationCheck.pm | ||
|---|---|---|
| 18 | 18 |
@required_modules = ( |
| 19 | 19 |
{ name => "parent", url => "http://search.cpan.org/~corion/", debian => 'libparent-perl' },
|
| 20 | 20 |
{ name => "Algorithm::CheckDigits", url => "http://search.cpan.org/~mamawe/", debian => 'libalgorithm-checkdigits-perl' },
|
| 21 |
{ name => "Archive::Zip", version => '1.16', url => "http://search.cpan.org/~phred/", debian => 'libarchive-zip-perl' },
|
|
| 21 |
{ name => "Archive::Zip", version => '1.40', url => "http://search.cpan.org/~phred/", debian => 'libarchive-zip-perl' },
|
|
| 22 | 22 |
{ name => "CAM::PDF", url => "https://metacpan.org/pod/CAM::PDF", debian => 'libcam-pdf-perl' },
|
| 23 | 23 |
{ name => "CGI", version => '3.43', url => "http://search.cpan.org/~leejo/", debian => 'libcgi-pm-perl' }, # 4.09 is not core anymore (perl 5.20)
|
| 24 | 24 |
{ name => "Clone", url => "http://search.cpan.org/~rdf/", debian => 'libclone-perl' },
|
Auch abrufbar als: Unified diff
Archive::Zip: kein Fix für aktuelle Versionen mehr nötig
Der Fix ist bei 1.40 bereits in offiziellen Releases
enthalten. Deutlich neuere Versionen enthalten sogar Änderungen, bei
denen unser Fix das Modul kaputt macht.
Also… Archive::Zip ≥ 1.40 voraussetzen und unseren eigenen Fix wegwerfen.