This file is indexed.

/usr/share/perl5/Pristine/Tar.pm is in pristine-tar 1.30.

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

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
#!/usr/bin/perl
# pristine-tar utility library

package Pristine::Tar;

use warnings;
use strict;
use File::Temp;
use Getopt::Long;
use IPC::Open2;
use Exporter q{import};

our @EXPORT = qw(error message debug vprint doit try_doit doit_redir
	tempdir dispatch comparefiles
	$verbose $debug $keep);

our $verbose=0;
our $debug=0;
our $keep=0;

sub progname {
	my $name=$0;
	$name=~s!^.*/(.+)$!$1!;
	return $name
}

sub error {
	die progname().": @_\n";
}

sub message {
	print STDERR progname().": @_\n";
}

sub debug {
	message(@_) if $debug;
}

sub vprint {
	message(@_) if $verbose;
}

sub doit {
	if (try_doit(@_) != 0) {
		error "command failed: @_";
	}
}

sub try_doit {
	vprint(@_);
	return system(@_)
}

sub doit_redir {
	no warnings 'once';
	my ($in, $out, @args) = @_;
	vprint(@args, "<", $in, ">", $out);
	open INFILE, "<", $in or die("Could not open '$in' for reading: $!\n");
	open OUTFILE, ">", $out or die("Could not open '$out' for reading: $!\n");
	my $pid = open2(">&OUTFILE", "<&INFILE", @args);
	waitpid $pid, 0;
	if ($? != 0) {
		error "command failed: @args";
	}
}

sub tempdir {
	return File::Temp::tempdir("pristine-tar.XXXXXXXXXX",
		TMPDIR => 1, CLEANUP => !$keep);
}

# Workaround for bug #479317 in perl 5.10.
sub END {
	chdir("/");
}

sub dispatch {
	my %params=@_;

	my %commands=%{$params{commands}};
	my %options=%{$params{options}} if exists $params{options};

	my $command;
	Getopt::Long::Configure("bundling");
	if (! GetOptions(%options,
			"v|verbose!" => \$verbose,
			"d|debug!" => \$debug,
			"k|keep!" => \$keep) ||
	    ! @ARGV) {
	    	$command="usage";
	}
	else {
		$command=shift @ARGV;
	}

	my $i=$commands{$command};
	if (! defined $i) {
		error "Unknown subcommand \"$command\"";
	}

	# Check that the right number of args were passed by user.
	if (defined $i->[1] && @ARGV != $i->[1]) {
		$command="usage";
		$i=$commands{$command};
	}

	$i->[0]->(@ARGV);
}

sub comparefiles {
	my ($old, $new) = (shift, shift);
	system('cmp', '-s', $old, $new);

	if ($? == -1 || $? & 127) {
		die("Failed to execute cmp: $!\n");
	}

	return $? >> 8;
}

1