Dpkg::Source::Archive/Package: misc fixes and changes

* scripts/Dpkg/Source/Archive.pm: Replace unsafe rmtree() by
the safer erasedir() function.
* scripts/Dpkg/Source/Archive.pm (add_file, add_directory): Prefix
filename with chdir when the directory of the tar process isn't
the current directory.

* scripts/Dpkg/Source/Package.pm (find_original_tarballs): New
function to find original tarballs possibly associated to the current
source package.
* scripts/Dpkg/Source/Package.pm (add_file): Support adding file
who are not stored in the current directory (or who are prefixed with
"./").
* scripts/Dpkg/Source/Package.pm (can_build): New function to check
if a source package build is likely to succeed given the constraints
of a particular source package format. Will be used by dpkg-source to
find an appropriate format.

scripts/Dpkg/Source/Archive.pm

@@ -19,6 +19,7 @@ package Dpkg::Source::Archive;
 use strict;
 use warnings;
 
+use Dpkg::Source::Functions qw(erasedir);
 use Dpkg::Source::CompressedFile;
 use Dpkg::Source::Compressor;
 use Dpkg::Compression;
@@ -28,8 +29,8 @@ use Dpkg::ErrorHandling qw(error syserr warning);
 
 use POSIX;
 use File::Temp qw(tempdir);
-use File::Path qw(rmtree mkpath);
 use File::Basename qw(basename);
+use File::Spec;
 
 use base 'Dpkg::Source::CompressedFile';
 
@@ -38,7 +39,10 @@ sub create {
     $opts{"options"} ||= [];
     my %fork_opts;
     # Possibly run tar from another directory
-    $fork_opts{"chdir"} = $opts{"chdir"} if $opts{"chdir"};
+    if ($opts{"chdir"}) {
+        $fork_opts{"chdir"} = $opts{"chdir"};
+        $self->{"chdir"} = $opts{"chdir"};
+    }
     # Redirect input/output appropriately
     $fork_opts{"to_handle"} = $self->open_for_write();
     $fork_opts{"from_pipe"} = \$self->{'tar_input'};
@@ -59,13 +63,21 @@ sub _add_entry {
 
 sub add_file {
     my ($self, $file) = @_;
-    error("add_file() doesn't handle directories") if not -l $file and -d _;
+    my $testfile = $file;
+    if ($self->{"chdir"}) {
+        $testfile = File::Spec->catfile($self->{"chdir"}, $file);
+    }
+    error("add_file() doesn't handle directories") if not -l $testfile and -d _;
     $self->_add_entry($file);
 }
 
 sub add_directory {
     my ($self, $file) = @_;
-    error("add_directory() only handles directories") unless not -l $file and -d _;
+    my $testfile = $file;
+    if ($self->{"chdir"}) {
+        $testfile = File::Spec->catdir($self->{"chdir"}, $file);
+    }
+    error("add_directory() only handles directories") unless not -l $testfile and -d _;
     $self->_add_entry($file);
 }
 
@@ -76,6 +88,7 @@ sub finish {
     delete $self->{'pid'};
     delete $self->{'tar_input'};
     delete $self->{'cwd'};
+    delete $self->{'chdir'};
     $self->cleanup_after_open();
 }
 
@@ -129,11 +142,11 @@ sub extract {
     subprocerr("chmod -R $modes_set $tmp") if $?;
 
     # Rename extracted directory
-    opendir(D, $tmp) || syserr(_g("Unable to open dir %s"), $tmp);
+    opendir(D, $tmp) || syserr(_g("cannot opendir %s"), $tmp);
     my @entries = grep { $_ ne "." && $_ ne ".." } readdir(D);
     closedir(D);
     my $done = 0;
-    rmtree($dest) if -e $dest;
+    erasedir($dest);
     if (scalar(@entries) == 1 && -d "$tmp/$entries[0]") {
 	rename("$tmp/$entries[0]", $dest) ||
 		syserr(_g("Unable to rename %s to %s"),
@@ -142,7 +155,7 @@ sub extract {
 	rename($tmp, $dest) ||
 		syserr(_g("Unable to rename %s to %s"), $tmp, $dest);
     }
-    rmtree($tmp);
+    erasedir($tmp);
 }
 
 1;

scripts/Dpkg/Source/Package.pm

@@ -26,6 +26,7 @@ use Dpkg::Cdata;
 use Dpkg::Checksums;
 use Dpkg::Version qw(parseversion);
 use Dpkg::Deps qw(@src_dep_fields);
+use Dpkg::Compression;
 
 use File::Basename;
 
@@ -169,6 +170,22 @@ sub get_basename {
     return $basename;
 }
 
+sub find_original_tarballs {
+    my ($self, $ext) = @_;
+    $ext ||= $comp_regex;
+    my $basename = $self->get_basename();
+    my @tar;
+    foreach my $dir (".", $self->{'basedir'}, $self->{'options'}{'origtardir'}) {
+        next unless defined($dir) and -d $dir;
+        opendir(DIR, $dir) || syserr(_g("cannot opendir %s"), $dir);
+        push @tar, map { "$dir/$_" }
+                  grep { /^\Q$basename\E\.orig(-\w+)?\.tar\.$ext$/ }
+                  readdir(DIR);
+        closedir(DIR);
+    }
+    return @tar;
+}
+
 sub is_signed {
     my $self = shift;
     return $self->{'is_signed'};
@@ -208,18 +225,24 @@ sub build {
     error("Dpkg::Source::Package doesn't know how to build a source package. Use one of the subclass.");
 }
 
+sub can_build {
+    my ($self, $dir) = @_;
+    return 0;
+}
+
 sub add_file {
     my ($self, $filename) = @_;
-    if (exists $self->{'files'}{$filename}) {
-        internerr(_g("tried to add file `%s' twice"), $filename);
+    my ($fn, $dir) = fileparse($filename);
+    if (exists $self->{'files'}{$fn}) {
+        internerr(_g("tried to add file `%s' twice"), $fn);
     }
     my (%sums, $size);
     getchecksums($filename, \%sums, \$size);
-    $self->{'files'}{$filename} = $size;
+    $self->{'files'}{$fn} = $size;
     foreach my $alg (sort keys %sums) {
-        $self->{'fields'}{"Checksums-$alg"} .= "\n $sums{$alg} $size $filename";
+        $self->{'fields'}{"Checksums-$alg"} .= "\n $sums{$alg} $size $fn";
     }
-    $self->{'fields'}{'Files'}.= "\n $sums{md5} $size $filename";
+    $self->{'fields'}{'Files'}.= "\n $sums{md5} $size $fn";
 }
 
 sub write_dsc {