Commit d1126e4a authored by Chris Lamb's avatar Chris Lamb 💬

Run perltidy -b **/*.pm bin/* Makefile.PL && rm **/*.bak

Signed-off-by: Chris Lamb's avatarChris Lamb <lamby@debian.org>
parent c419282c
......@@ -45,6 +45,7 @@ things to exclude.
init();
my @nondeterministic_files;
sub testfile {
return if -l $_ or -d $_; # Skip directories and symlinks always.
......@@ -70,7 +71,8 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
find(\&testfile,$tmp);
next unless @nondeterministic_files;
$File::StripNondeterminism::canonical_time = eval { get_source_date_epoch() };
$File::StripNondeterminism::canonical_time
= eval { get_source_date_epoch() };
if (not defined $File::StripNondeterminism::canonical_time) {
# Hack for old versions of debhelper
isnative($package); # Sets $dh{DATE} as a side-effect
......@@ -79,7 +81,8 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
foreach (@nondeterministic_files) {
my ($path, $normalize) = @$_;
eval { $normalize->($path); 1 } or die "dh_strip_nondeterminism: $path: $@";
eval { $normalize->($path); 1 }
or die "dh_strip_nondeterminism: $path: $@";
}
}
......
......@@ -28,16 +28,19 @@ Getopt::Long::Configure(qw(no_ignore_case permute bundling));
my $cmd = $0;
$cmd =~ s/.*\///;
my $usage = "Usage: $cmd [-t|--type FILETYPE] [-T|--timestamp SECONDS] [--clamp-timestamp] FILENAME\n";
my $usage
= "Usage: $cmd [-t|--type FILETYPE] [-T|--timestamp SECONDS] [--clamp-timestamp] FILENAME\n";
my ($filetype, $timestamp, $clamp_timestamp, $want_help, $want_version);
my $getopt = Getopt::Long::Parser->new;
$getopt->configure(qw(no_ignore_case permute bundling));
$getopt->getoptions('type|t=s', \$filetype,
'timestamp|T=i', \$timestamp,
'clamp-timestamp!', \$clamp_timestamp,
'help|h', \$want_help,
'version|V', \$want_version) or die $usage;
$getopt->getoptions(
'type|t=s', \$filetype,
'timestamp|T=i', \$timestamp,
'clamp-timestamp!', \$clamp_timestamp,
'help|h', \$want_help,
'version|V', \$want_version
) or die $usage;
if ($want_help) {
print $usage;
......@@ -61,14 +64,17 @@ for my $filename (@ARGV) {
my $normalizer;
if (defined $filetype) {
$normalizer = File::StripNondeterminism::get_normalizer_by_name($filetype);
$normalizer
= File::StripNondeterminism::get_normalizer_by_name($filetype);
die "$filetype: Unknown file type\n" unless $normalizer;
} else {
$normalizer = File::StripNondeterminism::get_normalizer_for_file($filename);
$normalizer
= File::StripNondeterminism::get_normalizer_for_file($filename);
next unless $normalizer;
}
eval { $normalizer->($filename); 1 } or die "strip-nondeterminism: $filename: $@";
eval { $normalizer->($filename); 1 }
or die "strip-nondeterminism: $filename: $@";
}
__END__
......
......@@ -43,9 +43,9 @@ sub init {
sub _get_file_type {
my $file=shift;
open (FILE, '-|') # handle all filenames safely
|| exec('file', $file)
|| die "can't exec file: $!";
open(FILE, '-|') # handle all filenames safely
|| exec('file', $file)
|| die "can't exec file: $!";
my $type=<FILE>;
close FILE;
return $type;
......@@ -69,15 +69,21 @@ sub get_normalizer_for_file {
return \&File::StripNondeterminism::handlers::gzip::normalize;
}
# jar
if (m/\.(jar|war|hpi|apk)$/ && _get_file_type($_) =~ m/(Java|Zip) archive data/) {
if (m/\.(jar|war|hpi|apk)$/
&& _get_file_type($_) =~ m/(Java|Zip) archive data/) {
return \&File::StripNondeterminism::handlers::jar::normalize;
}
# javadoc
if (m/\.html$/ && File::StripNondeterminism::handlers::javadoc::is_javadoc_file($_)) {
if (m/\.html$/
&& File::StripNondeterminism::handlers::javadoc::is_javadoc_file($_)) {
return \&File::StripNondeterminism::handlers::javadoc::normalize;
}
# pear registry
if (m/\.reg$/ && File::StripNondeterminism::handlers::pearregistry::is_registry_file($_)) {
if (
m/\.reg$/
&& File::StripNondeterminism::handlers::pearregistry::is_registry_file(
$_)
) {
return \&File::StripNondeterminism::handlers::pearregistry::normalize;
}
# PNG
......@@ -85,11 +91,17 @@ sub get_normalizer_for_file {
return \&File::StripNondeterminism::handlers::png::normalize;
}
# pom.properties, version.properties
if (m/\.properties$/ && File::StripNondeterminism::handlers::javaproperties::is_java_properties_file($_)) {
return \&File::StripNondeterminism::handlers::javaproperties::normalize;
if (
m/\.properties$/
&& File::StripNondeterminism::handlers::javaproperties::is_java_properties_file(
$_)
) {
return
\&File::StripNondeterminism::handlers::javaproperties::normalize;
}
# zip
if (m/\.(zip|pk3|epub|whl|xpi|htb|zhfst)$/ && _get_file_type($_) =~ m/Zip archive data|EPUB document/) {
if (m/\.(zip|pk3|epub|whl|xpi|htb|zhfst)$/
&& _get_file_type($_) =~ m/Zip archive data|EPUB document/) {
return \&File::StripNondeterminism::handlers::zip::normalize;
}
return undef;
......@@ -98,14 +110,22 @@ sub get_normalizer_for_file {
sub get_normalizer_by_name {
$_ = shift;
return \&File::StripNondeterminism::handlers::ar::normalize if $_ eq 'ar';
return \&File::StripNondeterminism::handlers::gettext::normalize if $_ eq 'gettext';
return \&File::StripNondeterminism::handlers::gzip::normalize if $_ eq 'gzip';
return \&File::StripNondeterminism::handlers::jar::normalize if $_ eq 'jar';
return \&File::StripNondeterminism::handlers::javadoc::normalize if $_ eq 'javadoc';
return \&File::StripNondeterminism::handlers::pearregistry::normalize if $_ eq 'pearregistry';
return \&File::StripNondeterminism::handlers::png::normalize if $_ eq 'png';
return \&File::StripNondeterminism::handlers::javaproperties::normalize if $_ eq 'javaproperties';
return \&File::StripNondeterminism::handlers::zip::normalize if $_ eq 'zip';
return \&File::StripNondeterminism::handlers::gettext::normalize
if $_ eq 'gettext';
return \&File::StripNondeterminism::handlers::gzip::normalize
if $_ eq 'gzip';
return \&File::StripNondeterminism::handlers::jar::normalize
if $_ eq 'jar';
return \&File::StripNondeterminism::handlers::javadoc::normalize
if $_ eq 'javadoc';
return \&File::StripNondeterminism::handlers::pearregistry::normalize
if $_ eq 'pearregistry';
return \&File::StripNondeterminism::handlers::png::normalize
if $_ eq 'png';
return \&File::StripNondeterminism::handlers::javaproperties::normalize
if $_ eq 'javaproperties';
return \&File::StripNondeterminism::handlers::zip::normalize
if $_ eq 'zip';
return undef;
}
......
......@@ -37,7 +37,7 @@ sub normalize {
my $buf;
open(my $fh, '+<', $file)
or die("failed to open $file for read+write: $!");
or die("failed to open $file for read+write: $!");
read $fh, $buf, $GLOBAL_HEADER_LENGTH;
return 0 if $buf ne $GLOBAL_HEADER;
......@@ -59,26 +59,30 @@ sub normalize {
#58 59 File magic \140\012
die "Incorrect header length"
if length $buf != $FILE_HEADER_LENGTH;
if length $buf != $FILE_HEADER_LENGTH;
die "Incorrect file magic"
if substr($buf, 58, length($FILE_MAGIC)) ne $FILE_MAGIC;
if substr($buf, 58, length($FILE_MAGIC)) ne $FILE_MAGIC;
my $file_mode = oct(substr($buf, 40, 8));
my $file_size = substr($buf, 48, 10);
seek $fh, $file_header_start + 16, SEEK_SET;
# mtime
syswrite $fh, sprintf("%-12d", $File::StripNondeterminism::canonical_time // 0);
syswrite $fh,
sprintf("%-12d", $File::StripNondeterminism::canonical_time // 0);
# owner
syswrite $fh, sprintf("%-6d", 0);
# group
syswrite $fh, sprintf("%-6d", 0);
# file mode
syswrite $fh, sprintf("%-8o", ($file_mode & oct(100)) ? oct(755) : oct(644));
syswrite $fh,
sprintf("%-8o", ($file_mode & oct(100)) ? oct(755) : oct(644));
# move to next member
my $padding = $file_size % 2;
seek $fh, $file_header_start + $FILE_HEADER_LENGTH + $file_size + $padding, SEEK_SET;
seek $fh,
$file_header_start + $FILE_HEADER_LENGTH + $file_size + $padding,
SEEK_SET;
}
......
......@@ -28,7 +28,8 @@ sub read_file {
my $filename = shift;
local $/ = undef;
open(my $fh, '<', $filename) or die "Can't open file $filename for reading: $!";
open(my $fh, '<', $filename)
or die "Can't open file $filename for reading: $!";
binmode($fh);
my $buf = <$fh>;
close($fh);
......@@ -56,7 +57,8 @@ sub normalize {
return 0;
}
my ($revision, $nstrings, $orig_to, $trans_to) = unpack($fmt x 4, substr($buf, 1*4, 4*4));
my ($revision, $nstrings, $orig_to, $trans_to)
= unpack($fmt x 4, substr($buf, 1*4, 4*4));
my $major = int($revision / 256);
my $minor = int($revision % 256);
return 0 if $major > 1;
......@@ -74,22 +76,25 @@ sub normalize {
my $pot_date = $1;
my $time;
eval {
$time = Time::Piece->strptime($pot_date, "%Y-%m-%d %H:%M%z");
};
eval {$time = Time::Piece->strptime($pot_date, "%Y-%m-%d %H:%M%z");};
next if $@;
next if $time <= $norm_time;
my $new_time = strftime("%Y-%m-%d %H:%M%z", gmtime($norm_time));
$trans_msg =~ s/\QPOT-Creation-Date: $pot_date\E/POT-Creation-Date: $new_time/;
$trans_msg
=~ s/\QPOT-Creation-Date: $pot_date\E/POT-Creation-Date: $new_time/;
next if length($trans_msg) != $trans_len;
$buf = substr($buf, 0, $trans_offset) . $trans_msg . substr($buf, $trans_offset + $trans_len);
$buf
= substr($buf, 0, $trans_offset)
. $trans_msg
. substr($buf, $trans_offset + $trans_len);
$modified = 1;
}
if ($modified) {
open(my $fh, '>', $mo_filename) or die "Can't open file $mo_filename for writing: $!";
open(my $fh, '>', $mo_filename)
or die "Can't open file $mo_filename for writing: $!";
binmode($fh);
print $fh $buf;
close($fh);
......
......@@ -36,7 +36,8 @@ use constant {
sub normalize {
my ($filename) = @_;
open(my $fh, '<', $filename) or die "Unable to open $filename for reading: $!";
open(my $fh, '<', $filename)
or die "Unable to open $filename for reading: $!";
# See RFC 1952
......@@ -54,10 +55,13 @@ sub normalize {
my $new_flg = $flg;
$new_flg &= ~FNAME; # Don't include filename
$new_flg &= ~FHCRC; # Don't include header CRC (not all implementations support it)
unless ($mtime == 0) { # Don't set a deterministic timestamp if there wasn't already a timestamp
$new_flg &= ~FHCRC
; # Don't include header CRC (not all implementations support it)
unless ($mtime == 0)
{ # Don't set a deterministic timestamp if there wasn't already a timestamp
if (defined $File::StripNondeterminism::canonical_time) {
if (!$File::StripNondeterminism::clamp_time || $mtime > $File::StripNondeterminism::canonical_time) {
if ( !$File::StripNondeterminism::clamp_time
|| $mtime > $File::StripNondeterminism::canonical_time) {
$mtime = $File::StripNondeterminism::canonical_time;
}
} else {
......@@ -69,7 +73,8 @@ sub normalize {
my $tempfile = File::Temp->new(DIR => dirname($filename));
# Write a new header
print $tempfile pack('CCCCl<CC', $id1, $id2, $cm, $new_flg, $mtime, $xfl, $os);
print $tempfile
pack('CCCCl<CC', $id1, $id2, $cm, $new_flg, $mtime, $xfl, $os);
if ($flg & FEXTRA) { # Copy through
# 0 1 2
......@@ -79,7 +84,8 @@ sub normalize {
my $buf;
read($fh, $buf, 2) == 2 or die "$filename: Malformed gzip file";
my ($xlen) = unpack('v', $buf);
read($fh, $buf, $xlen) == $xlen or die "$filename: Malformed gzip file";
read($fh, $buf, $xlen) == $xlen
or die "$filename: Malformed gzip file";
print $tempfile pack('vA*', $xlen, $buf);
}
if ($flg & FNAME) { # Read but do not copy through
......@@ -115,8 +121,9 @@ sub normalize {
}
# Copy through the rest of the file.
# TODO: also normalize concatenated gzip files. This will require reading and understanding
# each DEFLATE block (see RFC 1951), since gzip doesn't include lengths anywhere.
# TODO: also normalize concatenated gzip files. This will require
# reading and understanding each DEFLATE block (see RFC 1951), since
# gzip doesn't include lengths anywhere.
while (1) {
my $buf;
my $bytes_read = read($fh, $buf, 4096);
......@@ -127,7 +134,7 @@ sub normalize {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
return 1;
}
......
......@@ -30,7 +30,8 @@ use File::StripNondeterminism::handlers::javaproperties;
sub _jar_filename_cmp($$) {
my ($a, $b) = @_;
# META-INF/ and META-INF/MANIFEST.MF are expected to be the first entries in the Zip archive.
# META-INF/ and META-INF/MANIFEST.MF are expected to be the first
# entries in the Zip archive.
return 0 if $a eq $b;
for (qw{META-INF/ META-INF/MANIFEST.MF}) {
return -1 if $a eq $_;
......@@ -42,7 +43,8 @@ sub _jar_filename_cmp($$) {
sub _jar_normalize_manifest {
my ($filename) = @_;
open(my $fh, '<', $filename) or die "Unable to open $filename for reading: $!";
open(my $fh, '<', $filename)
or die "Unable to open $filename for reading: $!";
my $tempfile = File::Temp->new(DIR => dirname($filename));
my $modified = 0;
......@@ -60,7 +62,7 @@ sub _jar_normalize_manifest {
if ($modified) {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
}
return $modified;
}
......@@ -69,22 +71,28 @@ sub _jar_normalize_member {
my ($member) = @_; # $member is a ref to an Archive::Zip::Member
return if $member->isDirectory();
if ($member->fileName() =~ /\.html$/ &&
File::StripNondeterminism::handlers::zip::peek_member($member, 1024) =~ /\<!-- Generated by javadoc/) {
if ($member->fileName() =~ /\.html$/
&&File::StripNondeterminism::handlers::zip::peek_member($member, 1024)
=~ /\<!-- Generated by javadoc/) {
# javadoc header should be within first 1kb of file
File::StripNondeterminism::handlers::zip::normalize_member($member,
\&File::StripNondeterminism::handlers::javadoc::normalize);
\&File::StripNondeterminism::handlers::javadoc::normalize);
} elsif ($member->fileName() eq 'META-INF/MANIFEST.MF') {
File::StripNondeterminism::handlers::zip::normalize_member($member,
\&_jar_normalize_manifest);
} elsif ($member->fileName() =~ /(pom|version)\.properties$/ &&
File::StripNondeterminism::handlers::javaproperties::is_java_properties_header(
File::StripNondeterminism::handlers::zip::peek_member($member, 1024))) {
# maven header should be within first 1kb of file
\&_jar_normalize_manifest);
} elsif (
$member->fileName() =~ /(pom|version)\.properties$/
&&File::StripNondeterminism::handlers::javaproperties::is_java_properties_header(
File::StripNondeterminism::handlers::zip::peek_member(
$member, 1024
))
) {
# maven header should be within first 1kb of file
File::StripNondeterminism::handlers::zip::normalize_member($member,
\&File::StripNondeterminism::handlers::javaproperties::normalize);
\&File::StripNondeterminism::handlers::javaproperties::normalize);
} elsif ($member->fileName() =~ /\.jar$/) {
File::StripNondeterminism::handlers::zip::normalize_member($member, \&normalize);
File::StripNondeterminism::handlers::zip::normalize_member($member,
\&normalize);
}
return 1;
......@@ -93,16 +101,20 @@ sub _jar_normalize_member {
sub _jar_archive_filter {
my ($zip) = @_;
# Don't normalize signed JARs, since our modifications will break the signature.
# Alternatively, we could strip the signature. However, if a JAR file is signed,
# it is highly likely that the JAR file was part of the source and not produced
# as part of the build, and therefore contains no nondeterminism. Thus, ignoring
# the file makes more sense.
# Don't normalize signed JARs, since our modifications will break the
# signature. Alternatively, we could strip the signature. However, if
# a JAR file is signed, it is highly likely that the JAR file was part
# of the source and not produced as part of the build, and therefore
# contains no nondeterminism. Thus, ignoring the file makes more
# sense.
#
# According to the jarsigner(1) man page, a signed JAR has a .SF file
# in the META-INF directory.
#
# According to the jarsigner(1) man page, a signed JAR has a .SF file in the
# META-INF directory.
if (scalar($zip->membersMatching('^META-INF/.*\.SF$')) > 0) {
warn "strip-nondeterminism: " . $zip->fileName() . ": ignoring signed JAR file\n";
warn "strip-nondeterminism: "
. $zip->fileName()
. ": ignoring signed JAR file\n";
return 0;
}
......@@ -111,10 +123,12 @@ sub _jar_archive_filter {
sub normalize {
my ($jar_filename) = @_;
return File::StripNondeterminism::handlers::zip::normalize($jar_filename,
archive_filter => \&_jar_archive_filter,
filename_cmp => \&_jar_filename_cmp,
member_normalizer => \&_jar_normalize_member);
return File::StripNondeterminism::handlers::zip::normalize(
$jar_filename,
archive_filter => \&_jar_archive_filter,
filename_cmp => \&_jar_filename_cmp,
member_normalizer => \&_jar_normalize_member
);
}
1;
......@@ -30,34 +30,46 @@ use POSIX qw(strftime);
sub is_javadoc_file {
my ($filename) = @_;
# If this is a javadoc file, '<!-- Generated by javadoc' should appear in first 1kb
# If this is a javadoc file, '<!-- Generated by javadoc' should appear
# in first 1kb
my $fh;
my $str;
return open($fh, '<', $filename) && read($fh, $str, 1024) && $str =~ /\<!-- Generated by javadoc/;
return
open($fh, '<', $filename)
&& read($fh, $str, 1024)
&& $str =~ /\<!-- Generated by javadoc/;
}
sub normalize {
my ($filename) = @_;
open(my $fh, '<', $filename) or die "Unable to open $filename for reading: $!";
open(my $fh, '<', $filename)
or die "Unable to open $filename for reading: $!";
my $tempfile = File::Temp->new(DIR => dirname($filename));
# Strip the javadoc comment, which contains a timestamp.
# It should appear before a line containing </head>, which should be within first 15 lines.
# Strip the javadoc comment, which contains a timestamp. It should
# appear before a line containing </head>, which should be within first
# 15 lines.
my $modified = 0;
while (defined(my $line = <$fh>)) {
if ($line =~ /\<!-- Generated by javadoc .* --\>/) {
$line =~ s/\<!-- Generated by javadoc .* --\>//g;
print $tempfile $line unless $line =~ /^\s*$/; # elide lines that are now whitespace-only
print $tempfile $line
unless $line
=~ /^\s*$/; # elide lines that are now whitespace-only
$modified = 1;
} elsif ($line =~ /\<META NAME="date" CONTENT="[^"]*"\>/i) {
if (defined $File::StripNondeterminism::canonical_time) {
my $date = strftime('%Y-%m-%d', gmtime($File::StripNondeterminism::canonical_time));
$line =~ s/\<(META NAME="date" CONTENT)="[^"]*"\>/<$1="$date">/gi;
my $date = strftime('%Y-%m-%d',
gmtime($File::StripNondeterminism::canonical_time));
$line
=~ s/\<(META NAME="date" CONTENT)="[^"]*"\>/<$1="$date">/gi;
} else {
$line =~ s/\<META NAME="date" CONTENT="[^"]*"\>//gi;
}
print $tempfile $line unless $line =~ /^\s*$/; # elide lines that are now whitespace-only
print $tempfile $line
unless $line
=~ /^\s*$/; # elide lines that are now whitespace-only
$modified = 1;
} elsif ($line =~ /<html lang="[^"]+">/) {
# Strip locale as it's inherited from environment.
......@@ -83,7 +95,7 @@ sub normalize {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
return 1;
}
......
......@@ -28,31 +28,38 @@ use File::Basename;
sub is_java_properties_header {
my ($contents) = @_;
return $contents =~ /#Generated by( Apache)? Maven|#Build Number for ANT|#Generated by org.apache.felix.bundleplugin|#POM properties|#.* runtime configuration/;
return $contents
=~ /#Generated by( Apache)? Maven|#Build Number for ANT|#Generated by org.apache.felix.bundleplugin|#POM properties|#.* runtime configuration/;
}
sub is_java_properties_file {
my ($filename) = @_;
# If this is a java properties file, '#Generated by Maven', '#Build Number for ANT',
# or other similar build-tool comment headers should appear in first 1kb
# If this is a java properties file, '#Generated by Maven', '#Build
# Number for ANT', or other similar build-tool comment headers should
# appear in first 1kb
my $fh;
my $str;
return open($fh, '<', $filename) && read($fh, $str, 1024)
&& is_java_properties_header($str);
return
open($fh, '<', $filename)
&& read($fh, $str, 1024)
&& is_java_properties_header($str);
}
sub normalize {
my ($filename) = @_;
open(my $fh, '<', $filename) or die "Unable to open $filename for reading: $!";
open(my $fh, '<', $filename)
or die "Unable to open $filename for reading: $!";
my $tempfile = File::Temp->new(DIR => dirname($filename));
# Strip the generation date comment, which contains a timestamp.
# It should appear within first 10 lines.
# Strip the generation date comment, which contains a timestamp. It
# should appear within first 10 lines.
while (defined(my $line = <$fh>) && $. <= 10) {
# Yes, there really is no comma here
if ($line =~ /^#\w{3} \w{3} \d{2} \d{2}:\d{2}:\d{2} \w{3,4}([+-]\d{2}:\d{2})? \d{4}\s*$/) {
if ($line
=~ /^#\w{3} \w{3} \d{2} \d{2}:\d{2}:\d{2} \w{3,4}([+-]\d{2}:\d{2})? \d{4}\s*$/
) {
$line = '';
print $tempfile $line;
......@@ -66,7 +73,7 @@ sub normalize {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
return 1;
}
print $tempfile $line;
......
......@@ -38,7 +38,7 @@ sub normalize {
my ($filename) = @_;
open(my $fh, '<', $filename)
or die "Unable to open $filename for reading: $!";
or die "Unable to open $filename for reading: $!";
my $modified = 0;
my $tempfile = File::Temp->new(DIR => dirname($filename));
......@@ -46,7 +46,8 @@ sub normalize {
while (defined(my $line = <$fh>)) {
# Normalize _lastmodified
if ($line =~ s/(?<=s:13:"_lastmodified";i:)\d+(?=;)/$canonical_time/g) {
if ($line =~ s/(?<=s:13:"_lastmodified";i:)\d+(?=;)/$canonical_time/g)
{
$modified = 1;
}
......@@ -56,7 +57,7 @@ sub normalize {
if ($modified) {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
}
return $modified;
......
......@@ -40,7 +40,8 @@ sub chunk {
sub time_chunk {
my ($seconds) = @_;
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($seconds);
return chunk('tIME', pack('nCCCCC', 1900+$year, $mon+1, $mday, $hour, $min, $sec));
return chunk('tIME',
pack('nCCCCC', 1900+$year, $mon+1, $mday, $hour, $min, $sec));
}
sub text_chunk {
......@@ -58,7 +59,7 @@ sub normalize {
if (_normalize($filename, $fh, $tempfile)) {
$tempfile->close;
copy_data($tempfile->filename, $filename)
or die "$filename: unable to overwrite: copy_data: $!";
or die "$filename: unable to overwrite: copy_data: $!";
}
close $fh;
......@@ -75,8 +76,9 @@ sub _normalize {
my $modified = 0;
my $bytes_read;
read($fh, my $magic, 8); $magic eq "\x89PNG\r\n\x1a\n"
or die "$filename: does not appear to be a PNG";
read($fh, my $magic, 8);
$magic eq "\x89PNG\r\n\x1a\n"
or die "$filename: does not appear to be a PNG";
print $tempfile $magic;
......@@ -98,12 +100,17 @@ sub _normalize {
}
if ($type eq "tIME") {
print $tempfile time_chunk($canonical_time) if defined($canonical_time);
print $tempfile time_chunk($canonical_time)
if defined($canonical_time);
$modified = 1;
next;
} elsif (($type =~ /[tiz]EXt/) && ($data =~ /^(date:[^\0]+|Creation Time)\0/)) {
print $tempfile text_chunk($1, strftime("%Y-%m-%dT%H:%M:%S-00:00",
gmtime($canonical_time))) if defined($canonical_time);
} elsif (($type =~ /[tiz]EXt/)
&& ($data =~ /^(date:[^\0]+|Creation Time)\0/)) {
print $tempfile text_chunk(
$1,
strftime(
"%Y-%m-%dT%H:%M:%S-00:00",gmtime($canonical_time))
) if defined($canonical_time);
$modified = 1;
next;
}
......@@ -143,7 +150,7 @@ sub _normalize {
}
defined($bytes_read) or die "$filename: read failed: $!";
warn "$filename: $garbage bytes of garbage after IEND chunk"
if $garbage > 0;
if $garbage > 0;
return $modified;
}
......
......@@ -34,13 +34,16 @@ use constant SAFE_EPOCH => 315576060;
sub peek_member {
my ($member, $nbytes) = @_;
my $original_size = $member->compressedSize();
my $old_compression_method = $member->desiredCompressionMethod(COMPRESSION_STORED);
my $old_compression_method
= $member->desiredCompressionMethod(COMPRESSION_STORED);
$member->rewindData() == AZ_OK or die "failed to rewind ZIP member";
my ($buffer, $status) = $member->readChunk($nbytes);
die "failed to read ZIP member" if $status != AZ_OK && $status != AZ_STREAM_END;
die "failed to read ZIP member"
if $status != AZ_OK && $status != AZ_STREAM_END;
$member->endRead();
$member->desiredCompressionMethod($old_compression_method);
$member->{'compressedSize'} = $original_size; # Work around https://github.com/redhotpenguin/perl-Archive-Zip/issues/11
$member->{'compressedSize'} = $original_size
; # Work around https://github.com/redhotpenguin/perl-Archive-Zip/issues/11
return $$buffer;
}
......@@ -53,14 +56,17 @@ sub normalize_member {
my $filename = "$tempdir/member";
my $original_size = $member->compressedSize();
$member->extractToFileNamed($filename);
$member->{'compressedSize'} = $original_size; # Work around https://github.com/redhotpenguin/perl-Archive-Zip/issues/11
$member->{'compressedSize'} = $original_size
; # Work around https://github.com/redhotpenguin/perl-Archive-Zip/issues/11
# Normalize the temporary file.
if ($normalizer->($filename)) {
# Normalizer modified the temporary file.
# Replace the member's contents with the temporary file's contents.
open(my $fh, '<', $filename) or die "Unable to open $filename: $!";
$member->contents(do { local $/; <$fh> });
$member->contents(
do { local $/; <$fh> }
);
}
unlink($filename);
......@@ -72,6 +78,7 @@ use constant {
CENTRAL_HEADER => 0,
LOCAL_HEADER => 1
};
sub normalize_extra_fields {
# See http://sources.debian.net/src/zip/3.0-6/proginfo/extrafld.txt for extra field documentation
# $header_type is CENTRAL_HEADER or LOCAL_HEADER.
......@@ -91,20 +98,22 @@ sub normalize_extra_fields {
# len determines how many timestamps this field contains
# this works for both the central header and local header version
for (my $i = 1; $i < $len; $i += 4) {
$result .= pack("V", $File::StripNondeterminism::canonical_time // SAFE_EPOCH);
$result .= pack("V",
$File::StripNondeterminism::canonical_time // SAFE_EPOCH);
}
} elsif ($id == 0x7875) { # Info-ZIP New Unix Extra Field
$result .= substr($field, $pos, 4);
# Version 1 byte version of this extra field, currently 1
# UIDSize 1 byte Size of UID field
# UID Variable UID for this entry
# GIDSize 1 byte Size of GID field
# GID Variable GID for this entry
# (Same format for both central header and local header)
# Version 1 byte version of this extra field, currently 1
# UIDSize 1 byte Size of UID field
# UID Variable UID for this entry