dpkg-source: removes some unused code

* scripts/dpkg-source.pl: Removes unused code to check tar files.

diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 5d9059da5543562a677a385e410dce338676c778..b99302572d5c3e8eb28c0ecf4dfa617af87af08c 100755 (executable)
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -114,7 +114,6 @@ use POSIX;
 use Fcntl qw (:mode);
 use English;
 use File::Temp qw (tempfile);
-use Cwd;
 
 textdomain("dpkg-dev");
 
@@ -640,9 +639,6 @@ if ($opmode eq 'build') {
 
         $expectprefix= $origdir; $expectprefix =~ s,^\./,,;
        my $expectprefix_dirname = $origdirname;
-# tar checking is disabled, there are too many broken tar archives out there
-# which we can still handle anyway.
-#        checktarsane($origtargz,$expectprefix);
         mkdir("$origtargz.tmp-nest",0755) ||
             syserr(_g("unable to create `%s'"), "$origtargz.tmp-nest");
        push @exit_handlers, sub { erasedir("$origtargz.tmp-nest") };
@@ -1234,209 +1230,6 @@ sub erasedir {
     failure(_g("rm -rf failed to remove `%s'"), $dir);
 }
 
-sub checktarcpio {
-
-    my ($tarfileread, $wpfx) = @_;
-    my ($tarprefix, $c2);
-
-    @filesinarchive = ();
-
-    # make <CPIO> read from the uncompressed archive file
-    &forkgzipread ("$tarfileread");
-    if (! defined ($c2 = open (CPIO,"-|"))) { &syserr (_g("fork for cpio")); }
-    if (!$c2) {
-       $ENV{'LC_ALL'}= 'C';
-       $ENV{'LANG'}= 'C';
-        open (STDIN,"<&GZIP") || &syserr (_g("reopen gzip for cpio"));
-        &cpiostderr;
-        exec ('cpio','-0t') or &syserr (_g("exec cpio"));
-    }
-    close (GZIP);
-
-    $/ = "\0";
-    while (defined ($fn = <CPIO>)) {
-
-        $fn =~ s/\0$//;
-
-       # store printable name of file for error messages
-       my $pname = $fn;
-       $pname =~ y/ -~/?/c;
-
-        if ($fn =~ m/\n/) {
-           error(_g("tarfile `%s' contains object with newline in its " .
-                    "name (%s)"), $tarfileread, $pname);
-       }
-
-       next if ($fn eq '././@LongLink');
-
-       if (! $tarprefix) {
-           if ($fn =~ m/\n/) {
-               error(_g("first output from cpio -0t (from `%s') contains " .
-                        "newline - you probably have an out of date version " .
-                        "of cpio.  GNU cpio 2.4.2-2 is known to work"),
-                     $tarfileread);
-           }
-           $tarprefix = ($fn =~ m,((\./)*[^/]*)[/],)[0];
-           # need to check for multiple dots on some operating systems
-           # empty tarprefix (due to regex failer) will match emptry string
-           if ($tarprefix =~ /^[.]*$/) {
-               error(_g("tarfile `%s' does not extract into a directory " .
-                        "off the current directory (%s from %s)"),
-                     $tarfileread, $tarprefix, $pname);
-           }
-       }
-
-       my $fprefix = substr ($fn, 0, length ($tarprefix));
-        my $slash = substr ($fn, length ($tarprefix), 1);
-        if ((($slash ne '/') && ($slash ne '')) || ($fprefix ne $tarprefix)) {
-           error(_g("tarfile `%s' contains object (%s) not in expected ".
-                    "directory (%s)"), $tarfileread, $pname, $tarprefix);
-       }
-
-       # need to check for multiple dots on some operating systems
-        if ($fn =~ m/[.]{2,}/) {
-           error(_g("tarfile `%s' contains object with /../ in " .
-                    "its name (%s)"), $tarfileread, $pname);
-       }
-        push (@filesinarchive, $fn);
-    }
-    close (CPIO);
-    $? && subprocerr ("cpio");
-    &reapgzip;
-    $/= "\n";
-
-    my $tarsubst = quotemeta ($tarprefix);
-
-    return $tarprefix;
-}
-
-sub checktarsane {
-
-    my ($tarfileread, $wpfx) = @_;
-    my ($c2);
-
-    %dirincluded = ();
-    %notfileobject = ();
-
-    my $tarprefix = &checktarcpio ($tarfileread, $wpfx);
-
-    # make <TAR> read from the uncompressed archive file
-    &forkgzipread ("$tarfileread");
-    if (! defined ($c2 = open (TAR,"-|"))) { &syserr (_g("fork for tar -t")); }
-    if (! $c2) {
-       $ENV{'LC_ALL'}= 'C';
-        $ENV{'LANG'}= 'C';
-        open (STDIN, "<&GZIP") || &syserr (_g("reopen gzip for tar -t"));
-        exec ('tar', '-vvtf', '-') or &syserr (_g("exec tar -vvtf -"));
-    }
-    close (GZIP);
-
-    my $efix= 0;
-    while (<TAR>) {
-
-        chomp;
-
-        if (! m,^(\S{10})\s,) {
-           error(_g("tarfile `%s' contains unknown object " .
-                    "listed by tar as `%s'"),
-                 $tarfileread, $_);
-       }
-       my $mode = $1;
-
-        $mode =~ s/^([-dpsl])// ||
-           error(_g("tarfile `%s' contains object `%s' with " .
-                    "unknown or forbidden type `%s'"),
-                 $tarfileread, $fn, substr($_,0,1));
-        my $type = $&;
-
-        if ($mode =~ /^l/) { $_ =~ s/ -> .*//; }
-        s/ link to .+//;
-
-       my @tarfields = split(' ', $_, 6);
-       if (@tarfields < 6) { 
-           error(_g("tarfile `%s' contains incomplete entry `%s'\n"),
-                 $tarfileread, $_);
-       }
-
-       my $tarfn = deoctify ($tarfields[5]);
-
-       # store printable name of file for error messages
-       my $pname = $tarfn;
-       $pname =~ y/ -~/?/c;
-
-       # fetch name of file as given by cpio
-        $fn = $filesinarchive[$efix++];
-
-       my $l = length($fn);
-       if (substr ($tarfn, 0, $l + 4) eq "$fn -> ") {
-               # This is a symlink, as listed by tar.  cpio doesn't
-               # give us the targets of the symlinks, so we ignore this.
-               $tarfn = substr($tarfn, 0, $l);
-       }
-       if ($tarfn ne $fn) {
-           if ((length ($fn) == 99) && (length ($tarfn) >= 99)
-               && (substr ($fn, 0, 99) eq substr ($tarfn, 0, 99))) {
-               # this file doesn't match because cpio truncated the name
-               # to the first 100 characters.  let it slide for now.
-               warning(_g("filename '%s' was truncated by cpio; unable " .
-                          "to check full pathname"), $pname);
-               # Since it didn't match, later checks will not be able
-               # to stat this file, so we replace it with the filename
-               # fetched from tar.
-               $filesinarchive[$efix-1] = $tarfn;
-           } else {
-               error(_g("tarfile `%s' contains unexpected object listed " .
-                        "by tar as `%s'; expected `%s'"), $tarfileread, $_,
-                     $pname);
-           }
-       }
-
-       # if cpio truncated the name above, 
-       # we still can't allow files to expand into /../
-       # need to check for multiple dots on some operating systems
-        if ($tarfn =~ m/[.]{2,}/) {
-           error(_g("tarfile `%s' contains object with /../ in its " .
-                    "name (%s)"), $tarfileread, $pname);
-       }
-
-        if ($tarfn =~ /\.dpkg-orig$/) {
-           error(_g("tarfile `%s' contains file with name ending in .dpkg-orig"),
-                 $tarfileread);
-       }
-
-        if ($mode =~ /[sStT]/ && $type ne 'd') {
-           error(_g("tarfile `%s' contains setuid, setgid or sticky " .
-                    "object `%s'"), $tarfileread, $pname);
-       }
-
-        if ($tarfn eq "$tarprefix/debian" && $type ne 'd') {
-           error(_g("tarfile `%s' contains object `debian' that isn't ".
-                    "a directory"), $tarfileread);
-       }
-
-        if ($type eq 'd') { $tarfn =~ s,/$,,; }
-        $tarfn =~ s,(\./)*,,;
-        my $dirname = $tarfn;
-
-        if (($dirname =~ s,/[^/]+$,,) && (! defined ($dirincluded{$dirname}))) {
-           warnerror(_g("tarfile `%s' contains object `%s' but its " .
-                        "containing directory `%s' does not precede it"),
-                     $tarfileread, $pname, $dirname);
-           $dirincluded{$dirname} = 1;
-       }
-       if ($type eq 'd') { $dirincluded{$tarfn} = 1; }
-        if ($type ne '-') { $notfileobject{$tarfn} = 1; }
-    }
-    close (TAR);
-    $? && subprocerr ("tar -vvtf");
-    &reapgzip;
-
-    my $tarsubst = quotemeta ($tarprefix);
-    @filesinarchive = map { s/^$tarsubst/$wpfx/; $_ } @filesinarchive;
-    %dirincluded = map { s/^$tarsubst/$wpfx/; $_=>1 } (keys %dirincluded);
-    %notfileobject = map { s/^$tarsubst/$wpfx/; $_=>1 } (keys %notfileobject);
-}
-
 # check diff for sanity, find directories to create as a side effect
 sub checkdiff
 {
@@ -1674,26 +1467,6 @@ sub addfile {
     $fields->{'Files'}.= "\n $md5sum $size $filename";
 }
 
-# replace \ddd with their corresponding character, refuse \ddd > \377
-# modifies $_ (hs)
-{
-    my $backslash;
-sub deoctify {
-    my $fn= $_[0];
-    $backslash= sprintf("\\%03o", unpack("C", "\\")) if !$backslash;
-
-    s/\\{2}/$backslash/g;
-    @_= split(/\\/, $fn);
-
-    foreach (@_) {
-       /^(\d{3})/ or next;
-       failure(_g("bogus character `\\%s' in `%s'") . "\n", $1, $fn)
-           if oct($1) > 255;
-       $_= pack("c", oct($1)) . $POSTMATCH;
-    }
-    return join("", @_);
-} }
-
 sub readmd5sum {
     (my $md5sum = shift) or return;
     $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o