Read the dpkg status file to look for source packages even when no packages needed to be downloaded or unpacked. (Closes: #623563)

git-svn-id: http://emdebian.org/svn/current@8002 563faec7-e20c-0410-992a-a66f704d0ccd
This commit is contained in:
codehelp 2011-05-11 19:29:33 +00:00
parent 97aa95bc92
commit 5e1d52e43c
2 changed files with 47 additions and 23 deletions

4
debian/changelog vendored
View file

@ -3,8 +3,10 @@ multistrap (2.1.14) unstable; urgency=low
* Improve device-table incrementing
* Disable multi-arch field handling for same and wrap foreign and
allowed. dpkg does not currently support changes in /var/lib/dpkg/info
* Read the dpkg status file to look for source packages even when no
packages needed to be downloaded or unpacked. (Closes: #623563)
-- Neil Williams <codehelp@debian.org> Sat, 09 Apr 2011 09:22:01 +0100
-- Neil Williams <codehelp@debian.org> Wed, 11 May 2011 20:30:03 +0100
multistrap (2.1.13) unstable; urgency=low

View file

@ -751,19 +751,54 @@ sub check_bin_sh {
sub tidy_apt {
print _g("I: Tidying up apt cache and list data.\n");
if ($unpack eq "true") {
opendir (DEBS, "${dir}${cachedir}/archives/")
or die (_g("Cannot read apt archives directory.\n"));
my @files=grep(!m:\.\.?$:, readdir DEBS);
closedir (DEBS);
foreach my $file (@files) {
next if (-d $file);
next unless ($file =~ /\.deb$/);
if (defined $sourcedir) {
my $srcname = `LC_ALL dpkg -f ${dir}${cachedir}archives/$file Source`;
chomp ($srcname);
push @dsclist, $srcname;
system ("mv ${dir}${cachedir}archives/$file $sourcedir/$file");
} else {
unlink ("${dir}${cachedir}archives/$file");
}
}
}
if (defined $sourcedir) {
print "Checking ${dir}${dpkgdir}status\n";
if (-f "${dir}${dpkgdir}status") {
open (STATUS, "${dir}${dpkgdir}status");
my @lines=<STATUS>;
close (STATUS);
foreach my $line (@lines) {
if ($line =~ /^Source: (.*)$/) {
my $c = $1;
$c =~ s/\(.*\)$//;
$c =~ s/ //g;
push @dsclist, $c;
}
}
}
my %uniqdsc=();
foreach my $a (@dsclist) {
$uniqdsc{$a}++;
}
my $olddir = getcwd();
chdir ($sourcedir);
print "apt-get -d config_str source " . join (" ", sort keys %uniqdsc) . "\n";
foreach my $srcpkg (sort keys %uniqdsc) {
system ("apt-get -d $config_str source $srcpkg");
if (scalar keys %uniqdsc > 0) {
print "apt-get -d $config_str source " . join (" ", sort keys %uniqdsc) . "\n";
foreach my $srcpkg (sort keys %uniqdsc) {
system ("apt-get -d $config_str source $srcpkg");
}
}
chdir ($olddir);
}
$sourcedir=undef;
unlink ("${dir}etc/apt/sources.list")
if (-f "${dir}etc/apt/sources.list");
opendir (DEBS, "${dir}${libdir}lists/")
@ -783,22 +818,6 @@ sub tidy_apt {
next unless ($file =~ /\.bin$/);
unlink ("${dir}${cachedir}$file");
}
if ($unpack eq "true") {
opendir (DEBS, "${dir}${cachedir}/archives/")
or die (_g("Cannot read apt archives directory.\n"));
my @files=grep(!m:\.\.?$:, readdir DEBS);
closedir (DEBS);
foreach my $file (@files) {
next if (-d $file);
next unless ($file =~ /\.deb$/);
if (defined $sourcedir) {
system ("mv ${dir}${cachedir}archives/$file $sourcedir/$file");
} else {
unlink ("${dir}${cachedir}archives/$file");
}
}
$sourcedir=undef;
}
}
# if native arch, do a few tasks just because we can and probably should.
@ -1055,7 +1074,8 @@ sub cascade {
}
my @d = split(' ', lc($keys{$section}{'debootstrap'}));
push @debootstrap, @d;
my @b = split(' ', lc($keys{$section}{'bootstrap'}));
my @b = split(' ', lc($keys{$section}{'bootstrap'}))
if (defined $keys{$section}{'bootstrap'});
push @debootstrap, @b;
my @a = split (' ', lc($keys{$section}{'aptsources'}));
push @aptsources, @a;
@ -1090,10 +1110,12 @@ sub cascade {
if (not exists $components{$section} and not exists $flatfile{$section});
$omitdebsrc{$section}=$section if ((defined $keys{$section}{'omitdebsrc'})
and ($keys{$section}{'omitdebsrc'} eq "true"));
push @reinstall, split (/ /, lc($keys{$section}{'reinstall'}));
push @reinstall, split (/ /, lc($keys{$section}{'reinstall'}))
if (defined $keys{$section}{'reinstall'});
$components{$section}='main' if (not defined $components{$section});
$keyrings{$section}=$keys{$section}{'keyring'} if (not exists $keyrings{$section});
push @extrapkgs, split (' ', lc($keys{$section}{'additional'}));
push @extrapkgs, split (' ', lc($keys{$section}{'additional'}))
if (defined $keys{$section}{'additional'});
}
}
my %uniq=();