| 1 | #!/usr/bin/perl -w |
| 2 | |
| 3 | use strict; |
| 4 | |
| 5 | # Check whether there are naming conflicts when names are truncated to |
| 6 | # the DOSish case-ignoring 8.3 format, plus other portability no-nos. |
| 7 | |
| 8 | # The "8.3 rule" is loose: "if reducing the directory entry names |
| 9 | # within one directory to lowercase and 8.3-truncated causes |
| 10 | # conflicts, that's a bad thing". So the rule is NOT the strict |
| 11 | # "no filename shall be longer than eight and a suffix if present |
| 12 | # not longer than three". |
| 13 | |
| 14 | # The 8-level depth rule is for older VMS systems that likely won't |
| 15 | # even be able to unpack the tarball if more than eight levels |
| 16 | # (including the top of the source tree) are present. |
| 17 | |
| 18 | my %seen; |
| 19 | my $maxl = 30; # make up a limit for a maximum filename length |
| 20 | |
| 21 | sub eight_dot_three { |
| 22 | return () if $seen{$_[0]}++; |
| 23 | my ($dir, $base, $ext) = ($_[0] =~ m{^(?:(.+)/)?([^/.]*)(?:\.([^/.]+))?$}); |
| 24 | my $file = $base . ( defined $ext ? ".$ext" : "" ); |
| 25 | $base = substr($base, 0, 8); |
| 26 | $ext = substr($ext, 0, 3) if defined $ext; |
| 27 | if (defined $dir && $dir =~ /\./) { |
| 28 | print "directory name contains '.': $dir\n"; |
| 29 | } |
| 30 | if ($base eq "") { |
| 31 | print "filename starts with dot: $_[0]\n"; |
| 32 | } |
| 33 | if ($file =~ /[^A-Za-z0-9\._-]/) { |
| 34 | print "filename contains non-portable characters: $_[0]\n"; |
| 35 | } |
| 36 | if (length $file > $maxl) { |
| 37 | print "filename longer than $maxl characters: $file\n"; |
| 38 | } |
| 39 | if (defined $dir) { |
| 40 | return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base"); |
| 41 | } else { |
| 42 | return ('.', defined $ext ? "$base.$ext" : $base); |
| 43 | } |
| 44 | } |
| 45 | |
| 46 | my %dir; |
| 47 | |
| 48 | if (open(MANIFEST, "MANIFEST")) { |
| 49 | while (<MANIFEST>) { |
| 50 | chomp; |
| 51 | s/\s.+//; |
| 52 | unless (-f) { |
| 53 | print "missing: $_\n"; |
| 54 | next; |
| 55 | } |
| 56 | if (tr/././ > 1) { |
| 57 | print "more than one dot: $_\n"; |
| 58 | next; |
| 59 | } |
| 60 | if ((my $slashes = $_ =~ tr|\/|\/|) > 7) { |
| 61 | print "more than eight levels deep: $_\n"; |
| 62 | next; |
| 63 | } |
| 64 | while (m!/|\z!g) { |
| 65 | my ($dir, $edt) = eight_dot_three("$`"); |
| 66 | next unless defined $dir; |
| 67 | ($dir, $edt) = map { lc } ($dir, $edt); |
| 68 | push @{$dir{$dir}->{$edt}}, $_; |
| 69 | } |
| 70 | } |
| 71 | } else { |
| 72 | die "$0: MANIFEST: $!\n"; |
| 73 | } |
| 74 | |
| 75 | for my $dir (sort keys %dir) { |
| 76 | for my $edt (keys %{$dir{$dir}}) { |
| 77 | my @files = @{$dir{$dir}{$edt}}; |
| 78 | if (@files > 1) { |
| 79 | print "conflict on filename $edt:\n", map " $_\n", @files; |
| 80 | } |
| 81 | } |
| 82 | } |