From: Raphael Hertzog Date: Fri, 15 Feb 2008 15:39:00 +0000 (+0100) Subject: dpkg-source: removes some unused code X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=99c556fbd1ab68df9626021ab82a8268c779f988;p=dpkg 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 5d9059da..b9930257 100755 --- 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 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 = )) { - - $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 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 () { - - 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