This file is indexed.

/usr/bin/pristine-xz is in pristine-tar 1.30.

This file is owned by root:root, with mode 0o755.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

=head1 NAME

pristine-xz - regenerate pristine xz files

=head1 SYNOPSIS

B<pristine-xz> [-vdk] gendelta I<file.xz> I<delta>

B<pristine-xz> [-vdk] genxz I<delta> I<file>

=head1 DESCRIPTION

This is a complement to the pristine-tar(1) command. Normally you
don't need to run it by hand, since pristine-tar calls it as necessary
to handle .tar.xz files.

pristine-xz gendelta takes the specified I<xz> file, and generates a
small binary I<delta> file that can later be used by pristine-xz genxz
to recreate the original file.

pristine-xz genxz takes the specified I<delta> file, and compresses the
specified input I<file> (which must be identical to the contents of the
original xz file). The resulting file will be identical to
the original gz file used to create the delta.

The approach used to regenerate the original xz file is to figure out
how it was produced -- what compression level was used, etc. Currently
support is poor for xz files produced with unusual compression options.

If the delta filename is "-", pristine-xz reads or writes it to stdio.

=head1 OPTIONS

=over 4

=item -v

Verbose mode, show each command that is run.

=item -d

Debug mode.

=item -k

Don't clean up the temporary directory on exit.

=item -t

Try harder to determine how to generate deltas of difficult xz files.

=back

=head1 ENVIRONMENT

=over 4

=item B<TMPDIR>

Specifies a location to place temporary files, other than the default.

=back

=head1 AUTHOR

Joey Hess <joeyh@debian.org>,
Faidon Liambotis <paravoid@debian.org>,
Cyril Brulebois <cyril.brulebois@enst-bretagne.fr>

Licensed under the GPL, version 2.

=cut

use warnings;
use strict;
use Pristine::Tar;
use Pristine::Tar::Delta;
use Pristine::Tar::Formats;
use File::Basename qw/basename/;
use IO::Handle;

my @supported_xz_programs = qw(xz);

my $try=0;

dispatch(
	commands => {
		usage => [\&usage],
		genxz => [\&genxz, 2],
		gendelta => [\&gendelta, 2],
	},
	options => {
		"t|try!" => \$try,
	},
);

sub usage {
	print STDERR "Usage: pristine-xz [-vdkt] gendelta file.xz delta\n";
	print STDERR "       pristine-xz [-vdkt] genxz delta file\n";
}

sub assign_fields {
	my ($hash, $labels, $fields) = @_;
	@$hash{@$labels} = @$fields[1..scalar(@$labels)];
}

sub scan_xz_lvv_robot {
	my ($filename) = @_;
	# We need at least version 5.0 to get a proper '-lvv --robot'
	# implemented
	my $cmd = "xz -lvv --robot $filename";
	my $ret = open (my $in, "$cmd |") || die "$cmd failed: $!";
	my %xz = (file => {}, stream => {}, blocks => [],
		  summary => {}, totals => {});
	my (%file, %stream, @blocks, %summary, %totals);
	my @file_labels = qw{nb_streams nb_blocks compressed uncompressed
			     ratio checks padding_size};
	my @stream_labels =
		qw{stream_num nb_blocks compressed_offset uncompressed_offset
		   compressed_size uncompressed_size ratio check_name
		   padding_size};
	my @block_labels = 
		qw{stream_num block_in_stream block_in_file compressed_offset
		   uncompressed_offset compressed_size uncompressed_size ratio
		   check_name check_value header_size size_present_flags
		   actual_compressed_size uncompress_memory filter_chain};
	my @summary_labels = qw{uncompressed_memory size_in_blocks};
	my @totals_labels =
		qw{nb_streams nb_blocks compressed_size uncompressed_size ratio
		   check_names padding_size nb_files uncompressed_memory
		   size_in_blocks};

	while (my $line = <$in>) {
		chomp $line;
		my @fields = split(/\t/, $line);
		if ($fields[0] eq 'name') {
			next;
		}
		if ($fields[0] eq 'file') {
			assign_fields($xz{file}, \@file_labels, \@fields);
			next;
		}
		if ($fields[0] eq 'stream') {
			assign_fields($xz{stream}, \@stream_labels, \@fields);
			next;
		}
		if ($fields[0] eq 'block') {
			my %block;
			assign_fields(\%block, \@block_labels, \@fields);
			push @{$xz{blocks}}, \%block;
			next;
		}
		if ($fields[0] eq 'summary') {
			assign_fields($xz{summary}, \@summary_labels, \@fields);
			next;
		}
		if ($fields[0] eq 'totals') {
			assign_fields($xz{totals}, \@totals_labels, \@fields);
			next;
		}
	}
	close $in;
	return \%xz;
}

sub predict_xz_args {
	my ($xz) = @_;
	my $presets = undef;
	my $block_list = undef;
	my $blocks = $xz->{blocks};
	if (scalar(@$blocks)) {
		# There is at least one block. We assume the same compression
		# level for all blocks
		my $block = $blocks->[0];
		my @filters = split(/,/, $block->{filter_chain});
		if (scalar(@filters) != 1 || $filters[0] !~ /^--lzma2=/) {
			die "Only LZMA2 is supported";
		}
		# Deduce the presets from the dict size
		if ($filters[0] =~ /--lzma2=dict=(.*)/) {
			my $dict_size = $1;
			my %lzma2_presets_from_dict_size_of =
				('256KiB' => ['0'],
				 '1Mib'   => ['1'],
				 '2MiB'   => ['2'],
				 '4MiB'   => ['4', '3'],
				 # Put 6 before 5 as it's the default and is
				 # more likely to be right
				 '8MiB'   => ['6', '5'],
				 '16MiB'  => ['7'],
				 '32MiB'  => ['8'],
				 '64MiB'  => ['9'],
				);
			$presets = $lzma2_presets_from_dict_size_of{$dict_size};
			die "Unkown dict size: $dict_size\n"
				if (!defined($presets));
		}
		if (scalar(@$blocks) > 1) {
			# Gather the block uncompressed sizes
			$block_list = join(',', map {$_->{uncompressed_size}}
					    @$blocks);
		}
	}
	my %check_kwd_of = 
		(None => 'none',
		 CRC32 => 'crc32',
		 CRC64 => 'crc64',
		 'SHA-256' => 'sha256',
		);
	my $check_name = $xz->{stream}->{check_name};
	my $check_kwd = $check_kwd_of{$check_name};
	die "Unknown xz check: $check_name\n" if (!defined($check_kwd));

	my $possible_args = [];
	my $common = ["--check=$check_kwd", "-z"];
	if (defined($block_list)) {
		unshift @$common, "--block-list=$block_list";
	}
	foreach my $preset (@$presets) {
		push @$possible_args, [@$common, "-$preset"];
		push @$possible_args, [@$common, "-${preset}e"];
	}
	return $possible_args;
}

sub readxz {
	my $filename = shift;

	if (! is_xz($filename)) {
		error "This is not a valid xz archive.";
	}

	# This will guess the compression level, check and blocks from the file.
	# More info is still needed if the level used was 3/4 or 5/6 (see
	# lzma2_presets_from_dict_size_of in predict_xz_args) or if --extreme
	# was used. We output possible args for each combination in this case.
	my $xz = scan_xz_lvv_robot($filename);
	my $possible_args = predict_xz_args($xz);
	return $possible_args;
}

sub predictxzlevels {
	my $filename = shift;

	if (! is_xz($filename)) {
		error "This is not a valid xz archive.";
	}

	# XXX We don't currently have a way to guess the level from the
	# file format, as this level only presets several other tunables.
	# Correct handling would involve finding as many preset values as
	# possible, and reconstructing the compression level from that.
	#
	# So far in the wild only these levels have been seen.
	# (Note that level 9 can use a lot of memory.)
	my $possible_levels = ["6", "9", "0", "6e", "9e", "0e"];

	return ($possible_levels);
}

sub predictxzargs {
	my ($possible_levels, $program) = @_;

	my @args;
	foreach my $level (@$possible_levels) {
		push @args, ["-z", "-$level"];
		push @args, ["-z", "-$level", "--check=crc32"];
		push @args, ["-z", "-$level", "--check=sha256"];
	}
	return @args;
}

sub testvariant {
	my ($old, $tmpin, $xz_program, @args) = @_;

	my $new=$tmpin.'.xz';
	unlink($new);

	# Note that file name, mode, mtime do not matter to xz.

	# try xz'ing with the arguments passed
	doit_redir($tmpin, $new, $xz_program, @args);

	unless (-e $new) {
		die("$xz_program failed, aborting");
	}

	# and compare the generated with the original
	return !comparefiles($old, $new);
}

sub reproducexz {
	my $orig=shift;

	my $wd=tempdir();

	my $tmpin="$wd/test";
	doit_redir($orig, $tmpin, "xz", "-dc");

	# read fields from xz headers
	my $possible_args;
	eval {
		$possible_args = readxz($orig);
	};
	# If we get an error we fallback to guessing, otherwise, we should
	# succeed with one of the proposed combinations
	if (! $@) {
		foreach my $program (@supported_xz_programs) {
			foreach my $args (@$possible_args) {
				testvariant($orig, $tmpin, $program, @$args)
					&& return $program, @$args;
			}
		}
	}
	else {
		# Fallback to guessing
		my ($possible_levels) = predictxzlevels($orig);

		foreach my $program (@supported_xz_programs) {
			# try to guess the xz arguments that are needed
			foreach my $args (predictxzargs($possible_levels,
							$program)) {
				testvariant($orig, $tmpin, $program, @$args)
					&& return $program, @$args;
			}
		}
	}

	print STDERR "pristine-xz failed to reproduce build of $orig\n";
	print STDERR "(Please file a bug report.)\n";
	exit 1;
}

sub genxz {
	my $deltafile=shift;
	my $file=shift;

	my $delta=Pristine::Tar::Delta::read(Tarball => $deltafile);
	Pristine::Tar::Delta::assert($delta, type => "xz", maxversion => 2, 
		fields => [qw{params program}]);

	my @params=split(' ', $delta->{params});
	while (@params) {
		my $param=shift @params;

		next if $param=~/^(-[0-9]e?)$/;
		next if $param eq '-z';
		next if $param eq '--check=none';
		next if $param eq '--check=crc32';
		next if $param eq '--check=crc64';
		next if $param eq '--check=sha256';
		next if $param=~/^(--block-list=[0-9,]+)$/;
		die "paranoia check failed on params from delta ($param)";
	}
	@params=split(' ', $delta->{params});

	my $program=$delta->{program};
	if (! grep { $program eq $_ } @supported_xz_programs) {
		die "paranoia check failed on program from delta ($program)";
	}

	doit($program, @params, $file);
}

sub gendelta {
	my $xzfile=shift;
	my $deltafile=shift;

	my ($program, @params) = reproducexz($xzfile);

	Pristine::Tar::Delta::write(Tarball => $deltafile, {
		version => '2.0',
		type => 'xz',
		params => "@params",
		program => $program,
	});
}