bin/strip-nondeterminism

@@ -29,15 +29,16 @@ Getopt::Long::Configure(qw(no_ignore_case permute bundling));
 my $cmd = $0;
 $cmd =~ s/.*\///;
 my $usage
-  = "Usage: $cmd [-v|--verbose] [-t|--type FILETYPE] [-T|--timestamp SECONDS] [--clamp-timestamp] FILENAME\n";
+  = "Usage: $cmd [-v|--verbose] [-t|--type FILETYPE] [-T|--timestamp SECONDS] [--clamp-timestamp] [--normalizers <+NORMALIZER,-NORMALIZER,+all,-all,...>] FILENAME\n";
 
-my ($filetype, $timestamp, $clamp_timestamp, $want_help, $verbose, $want_version);
+my ($filetype, $timestamp, $clamp_timestamp, $normalizers, $want_help, $verbose, $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,
+	'normalizers=s', \$normalizers,
 	'help|h', \$want_help,
 	'verbose|v', \$verbose,
 	'version|V', \$want_version
@@ -55,6 +56,32 @@ if ($want_version) {
 
 File::StripNondeterminism::init();
 
+for (split(/,/, $normalizers // '')) {
+	my ($fn, $action);
+
+	m/^([+-])(\w+)$/ or die "$0: invalid --normalizer spec: $_";
+
+	if ($1 eq '+') {
+		$fn = \&File::StripNondeterminism::enable_normalizer;
+		$action = 'Enabling';
+	} else {
+		$fn = \&File::StripNondeterminism::disable_normalizer;
+		$action = 'Disabling';
+	}
+	my $name = $2;
+
+	if ($name eq 'all') {
+		print "$0: $action all normalizers\n" if $verbose;
+		for (File::StripNondeterminism::all_normalizers) {
+			&$fn($_);
+		}
+		next;
+	}
+
+	print "$0: $action normalizer $name\n" if $verbose;
+	&$fn($name);
+}
+
 $File::StripNondeterminism::canonical_time = $timestamp;
 $File::StripNondeterminism::clamp_time = $clamp_timestamp;
 
@@ -68,13 +95,20 @@ if (defined $filetype) {
 }
 print "$cmd: Not using a canonical time\n"
   if not defined $timestamp and $verbose;
+print "$cmd: Using normalizers: "
+  . join(" ", File::StripNondeterminism::enabled_normalizers) . "\n"
+  if not defined $timestamp and $verbose;
 for my $filename (@ARGV) {
 	die "$filename: Does not exist\n" unless -e $filename;
 
 	if (!defined $filetype) {
 		$normalizer
 		  = File::StripNondeterminism::get_normalizer_for_file($filename);
-		next unless $normalizer;
+		next unless defined $normalizer;
+		if (!$normalizer) {
+			print "Not normalizing $filename (normalizer disabled)\n" if $verbose;
+			next;
+		}
 	}
 
 	print "Normalizing $filename\n" if $verbose;
@@ -121,6 +155,11 @@ B<--timestamp>.  You can use this option to ensure that only timestamps
 introduced as part of the build process are replaced.  NOT YET IMPLEMENTED
 FOR ALL FILE FORMATS.
 
+=item B<--normalizers> I<SPEC>
+
+Enable or disable specific normalizers separated by a comma (eg. B<+foo,-bar>.
+The magic values B<+all> and B<-all> will enable and disable all normalizers.
+
 =item B<-h>, B<--help>
 
 Display this help message.

lib/File/StripNondeterminism.pm

@@ -47,6 +47,10 @@ sub get_normalizer_for_file($) {
 
 	return undef if -d $_; # Skip directories
 
+	# ar
+	if (m/\.a$/ && _get_file_type($_) =~ m/ar archive/) {
+		return _handler('ar');
+	}
 	# cpio
 	if (m/\.cpio$/ && _get_file_type($_) =~ m/cpio archive/) {
 		return _handler('cpio');
@@ -109,6 +113,7 @@ sub get_normalizer_for_file($) {
 
 our %HANDLER_CACHE;
 our %KNOWN_HANDLERS = (
+	ar	=> 0,
 	bflt	=> 1,
 	cpio	=> 1,
 	gettext	=> 1,
@@ -122,12 +127,41 @@ our %KNOWN_HANDLERS = (
 	zip	=> 1,
 );
 
+sub all_normalizers () {
+	return sort keys %KNOWN_HANDLERS;
+}
+
+sub enabled_normalizers () {
+	my @normalizers;
+	foreach my $x (all_normalizers()) {
+		push @normalizers, $x if $KNOWN_HANDLERS{$x};
+	}
+	return @normalizers;
+}
+
+sub enable_normalizer ($) {
+	my ($name) = @_;
+	die("Unknown normalizer: ${name}")
+	  if not exists($KNOWN_HANDLERS{$name});
+	$KNOWN_HANDLERS{$name} = 1;
+}
+
+sub disable_normalizer ($) {
+	my ($name) = @_;
+	die("Unknown normalizer: ${name}")
+	  if not exists($KNOWN_HANDLERS{$name});
+	$KNOWN_HANDLERS{$name} = 0;
+}
+
 sub _handler {
+	# Returns the normalize routine for this handler or 0 (not undef)
+	# if the handler is not enabled.
 	my ($handler_name) = @_;
 	return $HANDLER_CACHE{$handler_name}
 	  if exists($HANDLER_CACHE{$handler_name});
 	die("Unknown handler: ${handler_name}\n")
 	  if not exists($KNOWN_HANDLERS{$handler_name});
+	return 0 if !$KNOWN_HANDLERS{$handler_name};
 	my $pkg = "File::StripNondeterminism::handlers::${handler_name}";
 	my $mod = "File/StripNondeterminism/handlers/${handler_name}.pm";
 	my $sub_name = "${pkg}::normalize";

lib/File/StripNondeterminism/handlers/ar.pm

+# Copyright © 2014 Jérémy Bobbio <lunar@debian.org>
+# Copyright © 2014 Niko Tyni <ntyni@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 3 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 <http://www.gnu.org/licenses/>.
+#
+# Some code borrowed from ArFile
+# Copyright (C) 2007    Stefano Zacchiroli  <zack@debian.org>
+# Copyright (C) 2007    Filippo Giunchedi   <filippo@debian.org>
+
+package File::StripNondeterminism::handlers::ar;
+
+use strict;
+use warnings;
+
+use Fcntl q/SEEK_SET/;
+
+use File::StripNondeterminism;
+
+sub normalize {
+	my ($file) = @_;
+
+	my $GLOBAL_HEADER = "!<arch>\n";
+	my $GLOBAL_HEADER_LENGTH = length $GLOBAL_HEADER;
+
+	my $FILE_HEADER_LENGTH = 60;
+	my $FILE_MAGIC = "`\n";
+
+	my $buf;
+
+	open(my $fh, '+<', $file)
+	  or die("failed to open $file for read+write: $!");
+
+	read $fh, $buf, $GLOBAL_HEADER_LENGTH;
+	return 0 if $buf ne $GLOBAL_HEADER;
+
+	while (1) {
+		my $file_header_start = tell $fh;
+		my $count = read $fh, $buf, $FILE_HEADER_LENGTH;
+		die "reading $file failed: $!" if !defined $count;
+		last if $count == 0;
+
+		# http://en.wikipedia.org/wiki/Ar_(Unix)
+		#from   to     Name                      Format
+		#0      15     File name                 ASCII
+		#16     27     File modification date    Decimal
+		#28     33     Owner ID                  Decimal
+		#34     39     Group ID                  Decimal
+		#40     47     File mode                 Octal
+		#48     57     File size in bytes        Decimal
+		#58     59     File magic                \140\012
+
+		die "Incorrect header length"
+		  if length $buf != $FILE_HEADER_LENGTH;
+		die "Incorrect 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);
+
+		die "Incorrect file size"
+		  if $file_size < 1;
+
+		seek $fh, $file_header_start + 16, SEEK_SET;
+
+		# mtime
+		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));
+
+		# move to next member
+		my $padding = $file_size % 2;
+		seek $fh,
+		  $file_header_start + $FILE_HEADER_LENGTH + $file_size + $padding,
+		  SEEK_SET;
+
+	}
+
+	return 1;
+}
+
+1;

t/fixtures.t

@@ -48,11 +48,24 @@ my %STAT = (
 
 File::StripNondeterminism::init();
 
+# Enable all normalizers for tests
+for (File::StripNondeterminism::all_normalizers()) {
+	File::StripNondeterminism::enable_normalizer($_);
+}
+
 $File::StripNondeterminism::canonical_time = 1423159771;
 
 my @fixtures = glob('t/fixtures/*/*.in');
 plan tests => scalar @fixtures;
 
+sub handler_name {
+	eval {
+		my $obj = B::svref_2object(shift());
+		return $obj->GV->STASH->NAME;
+	} || "unknown handler";
+}
+
+
 foreach my $filename (@fixtures) {
 	# Use a temporary directory per fixture so we can check whether any
 	# extraneous files are leftover.
@@ -69,6 +82,7 @@ foreach my $filename (@fixtures) {
 		isnt(undef, $normalizer, "Normalizer found for $in");
 
 		my @stat_before = lstat $in;
+		warn handler_name($normalizer);
 		$normalizer->($in) if defined $normalizer;
 		my @stat_after = lstat $in;
 

t/fixtures/ar/one.a.in

+!<arch>
+afile/          1425249797  501   501   100600  1136      `
+cerebral atrophy, n:
+	The phenomena which occurs as brain cells become weak and sick, and
+impair the brain's performance.  An abundance of these "bad" cells can cause
+symptoms related to senility, apathy, depression, and overall poor academic
+performance.  A certain small number of brain cells will deteriorate due to
+everday activity, but large amounts are weakened by intense mental effort
+and the assimilation of difficult concepts.  Many college students become
+victims of this dread disorder due to poor habits such as overstudying.
+
+cerebral darwinism, n:
+	The theory that the effects of cerebral atrophy can be reversed
+through the purging action of heavy alcohol consumption.  Large amounts of
+alcohol cause many brain cells to perish due to oxygen deprivation.  Through
+the process of natural selection, the weak and sick brain cells will die
+first, leaving only the healthy cells.  This wonderful process leaves the
+imbiber with a healthier, more vibrant brain, and increases mental capacity.
+Thus, the devastating effects of cerebral atrophy are reversed, and academic
+performance actually increases beyond previous levels.
+bfile/          1425249797  501   501   100644  80        `
+take forceful action:
+	Do something that should have been done a long time ago.
+cfile/          1425249797  501   501   100775  39        `
+Don't Worry, Be Happy.
+		-- Meher Baba
+
+dfile/          1425249797  501   501   100664  256       `
+"Well, well, well!  Well if it isn't fat stinking billy goat Billy Boy in
+poison!  How art thou, thou globby bottle of cheap stinking chip oil?  Come
+and get one in the yarbles, if ya have any yarble, ya eunuch jelly thou!"
+		-- Alex in "Clockwork Orange"

t/fixtures/ar/one.a.out

+!<arch>
+afile/          1423159771  0     0     644     1136      `
+cerebral atrophy, n:
+	The phenomena which occurs as brain cells become weak and sick, and
+impair the brain's performance.  An abundance of these "bad" cells can cause
+symptoms related to senility, apathy, depression, and overall poor academic
+performance.  A certain small number of brain cells will deteriorate due to
+everday activity, but large amounts are weakened by intense mental effort
+and the assimilation of difficult concepts.  Many college students become
+victims of this dread disorder due to poor habits such as overstudying.
+
+cerebral darwinism, n:
+	The theory that the effects of cerebral atrophy can be reversed
+through the purging action of heavy alcohol consumption.  Large amounts of
+alcohol cause many brain cells to perish due to oxygen deprivation.  Through
+the process of natural selection, the weak and sick brain cells will die
+first, leaving only the healthy cells.  This wonderful process leaves the
+imbiber with a healthier, more vibrant brain, and increases mental capacity.
+Thus, the devastating effects of cerebral atrophy are reversed, and academic
+performance actually increases beyond previous levels.
+bfile/          1423159771  0     0     644     80        `
+take forceful action:
+	Do something that should have been done a long time ago.
+cfile/          1423159771  0     0     755     39        `
+Don't Worry, Be Happy.
+		-- Meher Baba
+
+dfile/          1423159771  0     0     644     256       `
+"Well, well, well!  Well if it isn't fat stinking billy goat Billy Boy in
+poison!  How art thou, thou globby bottle of cheap stinking chip oil?  Come
+and get one in the yarbles, if ya have any yarble, ya eunuch jelly thou!"
+		-- Alex in "Clockwork Orange"