Commit | Line | Data |
ee801c00 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings FATAL => 'all'; |
4 | |
5 | use ExtUtils::Manifest qw(maniread); |
6 | use File::Spec; |
7 | use Getopt::Long qw(:config gnu_getopt); |
8 | |
9 | GetOptions( |
10 | 'tar=s' => \(my $tar = 'tar'), |
11 | ) or die("Error in command line arguments\n"); |
12 | |
13 | my ($tarball, $manifest) = @ARGV; |
14 | my $type |
38513b0a |
15 | = $tarball =~ /\.bz2$/ ? '-j' |
16 | : $tarball =~ /\.xz$/ ? '-J' |
17 | : $tarball =~ /\.t?gz$/ ? '-z' |
18 | : $tarball =~ /\.Z$/ ? '-Z' |
ee801c00 |
19 | : ''; |
20 | |
21 | my @tarfiles; |
22 | { |
23 | my $null = File::Spec->devnull; |
38513b0a |
24 | @tarfiles = `$tar -t $type -f "$tarball" 2>$null`; |
ee801c00 |
25 | chomp @tarfiles; |
26 | } |
27 | |
28 | { |
29 | my $prefix; |
30 | for my $path (@tarfiles) { |
31 | if (!defined $prefix) { |
32 | ($prefix) = $path =~ m{^([^/]+)}; |
33 | } |
34 | elsif ($path !~ m{^\Q$prefix\E(?:/|$)}) { |
35 | undef $prefix; |
36 | last; |
37 | } |
38 | } |
39 | if ($prefix) { |
40 | s{^\Q$prefix\E/}{} for @tarfiles; |
41 | } |
42 | } |
43 | |
44 | @tarfiles = grep !m{(?:^|/)$}, @tarfiles; |
45 | my %tarfiles = map +($_ => 1), @tarfiles; |
46 | |
47 | my %manifiles = %{ maniread($manifest) }; |
48 | |
49 | my @extra = grep { !exists $manifiles{$_} } sort keys %tarfiles; |
50 | my @missing = grep { !exists $tarfiles{$_} } sort keys %manifiles; |
51 | |
52 | my $message = ''; |
53 | if (@extra) { |
54 | $message .= "$tarball has extra files:\n" . join '', map " $_\n", @extra; |
55 | } |
56 | if (@missing) { |
57 | $message .= "$tarball is missing files:\n" . join '', map " $_\n", @missing; |
58 | } |
c3410697 |
59 | if ($message) { |
60 | die $message . <<'END_MESSAGE'; |
61 | |
62 | This may happen if the file attributes are not compatible with the ustar format. |
63 | END_MESSAGE |
64 | } |
ee801c00 |
65 | exit 0; |