josch/multistrap
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

tidy up

Browse source 
git-svn-id: http://emdebian.org/svn/current@7331 563faec7-e20c-0410-992a-a66f704d0ccd
This commit is contained in:
codehelp 2010-07-20 22:00:12 +00:00
parent c38d89d3ff
commit a92c5505f2
1 changed files with 80 additions and 169 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

249
multistrap
View file

@ -95,14 +95,11 @@ cascade($file);
foreach my $inc (@includes) foreach my $inc (@includes)
{ {
# look for the full filepath or try same directory as current conf. # look for the full filepath or try same directory as current conf.
if (not -f $inc ) if (not -f $inc ) {
{
$chk = `realpath $cfgdir/$inc 2>/dev/null`; $chk = `realpath $cfgdir/$inc 2>/dev/null`;
next if ($chk =~ /^\n?$/); next if ($chk =~ /^\n?$/);
chomp ($chk); chomp ($chk);
} } else {
else
{
$chk = $inc; $chk = $inc;
} }
printf (_g("%s %s using %s\n"), $progname, $ourversion, $chk); printf (_g("%s %s using %s\n"), $progname, $ourversion, $chk);
@ -110,8 +107,7 @@ foreach my $inc (@includes)
} }
&dump_config if (defined $dryrun); &dump_config if (defined $dryrun);
if (not defined $dir or not defined $arch) if (not defined $dir or not defined $arch) {
{
&dump_config; &dump_config;
exit 3; exit 3;
} }
@ -120,23 +116,17 @@ if (not defined $dir or not defined $arch)
printf (_g("%s %s using %s\n"), $progname, $ourversion, $file); printf (_g("%s %s using %s\n"), $progname, $ourversion, $file);
$host = `dpkg --print-architecture`; $host = `dpkg --print-architecture`;
chomp ($host); chomp ($host);
if ((not defined $arch) or ($arch eq "")) if ((not defined $arch) or ($arch eq "")) {
{
$arch = $host; $arch = $host;
printf (_g("Defaulting architecture to native: %s\n"),$arch); printf (_g("Defaulting architecture to native: %s\n"),$arch);
} } elsif ($arch eq $host) {
elsif ($arch eq $host)
{
printf (_g("Defaulting architecture to native: %s\n"),$arch); printf (_g("Defaulting architecture to native: %s\n"),$arch);
} } else {
else
{
printf (_g("Using foreign architecture: %s\n"), $arch); printf (_g("Using foreign architecture: %s\n"), $arch);
} }
$foreign++ if ($host ne $arch); $foreign++ if ($host ne $arch);
unless (keys %sources and @aptsources) unless (keys %sources and @aptsources) {
{
my $msg = sprintf(_g("No sources defined for a foreign multistrap. my $msg = sprintf(_g("No sources defined for a foreign multistrap.
Using your existing apt sources. To use different sources, Using your existing apt sources. To use different sources,
list them with aptsources= in '%s'."), $file); list them with aptsources= in '%s'."), $file);
@ -147,8 +137,7 @@ unless (keys %sources and @aptsources)
# Translators: fields are: programname, architecture, host architecture. # Translators: fields are: programname, architecture, host architecture.
printf (_g("%s building %s multistrap on '%s'\n"), $progname, $arch, $host); printf (_g("%s building %s multistrap on '%s'\n"), $progname, $arch, $host);
if (not -d "$dir") if (not -d "$dir") {
{
my $ret = system ("mkdir -p $dir"); my $ret = system ("mkdir -p $dir");
$ret /= 256 if (defined $ret); $ret /= 256 if (defined $ret);
my $msg = sprintf (_g("Unable to create directory '%s'"),$dir); my $msg = sprintf (_g("Unable to create directory '%s'"),$dir);
@ -207,9 +196,7 @@ if (-l "${dir}lib64" ) {
symlink "./lib", "lib64"; symlink "./lib", "lib64";
chdir ("${old}"); chdir ("${old}");
} }
} } else {
else
{
my $old = `pwd`; my $old = `pwd`;
chomp ($old); chomp ($old);
chdir ("$dir"); chdir ("$dir");
@ -223,8 +210,7 @@ unlink ("${dir}etc/apt/sources.list.d/multistrap.sources.list")
unlink ("${dir}etc/apt/sources.list") unlink ("${dir}etc/apt/sources.list")
if (-f "${dir}etc/apt/sources.list"); if (-f "${dir}etc/apt/sources.list");
foreach $repo (sort keys %suites) foreach $repo (sort keys %suites) {
{
if (not -e "${dir}${cachedir}") { if (not -e "${dir}${cachedir}") {
mkdir "${dir}${cachedir}"; mkdir "${dir}${cachedir}";
} }
@ -242,30 +228,24 @@ foreach $repo (sort keys %suites)
} }
} }
%uniq=(); %uniq=();
foreach my $line (@debootstrap) foreach my $line (@debootstrap) {
{
$uniq{$line}++; $uniq{$line}++;
} }
@debootstrap=sort keys %uniq; @debootstrap=sort keys %uniq;
%uniq=(); %uniq=();
foreach my $aptsrc (@debootstrap) foreach my $aptsrc (@debootstrap) {
{ if (defined $deflist) {
if (defined $deflist)
{
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list") open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list")
or die _g("Cannot open sources list"). $!; or die _g("Cannot open sources list"). $!;
print SOURCES $deflist; print SOURCES $deflist;
close SOURCES; close SOURCES;
} } elsif (-d "${dir}etc/apt/") {
elsif (-d "${dir}etc/apt/")
{
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list") open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list")
or die _g("Cannot open sources list"). $!; or die _g("Cannot open sources list"). $!;
$mirror = $sources{$aptsrc}; $mirror = $sources{$aptsrc};
$suite = $suites{$aptsrc}; $suite = $suites{$aptsrc};
$component = (defined $components{$aptsrc}) ? $components{$aptsrc} : "main"; $component = (defined $components{$aptsrc}) ? $components{$aptsrc} : "main";
if (defined $mirror and defined $suite) if (defined $mirror and defined $suite) {
{
print SOURCES "deb $mirror $suite $component\n"; print SOURCES "deb $mirror $suite $component\n";
print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc}); print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc});
close SOURCES; close SOURCES;
@ -273,16 +253,14 @@ foreach my $aptsrc (@debootstrap)
} }
} }
my $k; my $k;
foreach my $pkg (values %keyrings) foreach my $pkg (values %keyrings) {
{
next if (not defined $pkg); next if (not defined $pkg);
next if ("" eq "$pkg"); next if ("" eq "$pkg");
my $status = `LC_ALL=C dpkg -s $pkg`; my $status = `LC_ALL=C dpkg -s $pkg`;
next if $status =~ /Status: install ok installed/; next if $status =~ /Status: install ok installed/;
$k .= "$pkg "; $k .= "$pkg ";
} }
if (defined $k) if (defined $k) {
{
my $e=`LC_ALL=C printenv`; my $e=`LC_ALL=C printenv`;
if ($e !~ /\nFAKEROOTKEY=[0-9]+\n/) { if ($e !~ /\nFAKEROOTKEY=[0-9]+\n/) {
my $str = ""; my $str = "";
@ -313,23 +291,19 @@ die (sprintf (_g("apt update failed. Exit value: %d\n"), ($retval/256)))
if ($retval != 0); if ($retval != 0);
my @s = (); my @s = ();
$str = ""; $str = "";
if ((not defined $omitrequired) or ($omitrequired eq "false")) if ((not defined $omitrequired) or ($omitrequired eq "false")) {
{
print _g("I: Calculating required packages.\n"); print _g("I: Calculating required packages.\n");
&get_required_debs; &get_required_debs;
$str .= join (' ', keys %required); $str .= join (' ', keys %required);
chomp($str); chomp($str);
} }
$str .= " "; $str .= " ";
foreach my $sect (sort keys %packages) foreach my $sect (sort keys %packages) {
{
my @list = split (' ', $sect); my @list = split (' ', $sect);
foreach my $pkg (@list) foreach my $pkg (@list) {
{
next if ($packages{$pkg} =~ /^\s*$/); next if ($packages{$pkg} =~ /^\s*$/);
my @long=split (/ /, $packages{$sect}); my @long=split (/ /, $packages{$sect});
foreach my $l (@long) foreach my $l (@long) {
{
chomp ($l); chomp ($l);
if (defined $explicit_suite) { if (defined $explicit_suite) {
# instruct apt to get packages from the specified # instruct apt to get packages from the specified
@ -346,8 +320,7 @@ $str .= " " . join (' ', values %keyrings) . " ";
chomp($str); chomp($str);
%uniq=(); %uniq=();
@s = split (/ /, $str); @s = split (/ /, $str);
foreach my $a (@s) foreach my $a (@s) {
{
$uniq{$a}++; $uniq{$a}++;
} }
$str = join (' ', sort keys %uniq); $str = join (' ', sort keys %uniq);
@ -360,7 +333,7 @@ die (sprintf (_g("apt download failed. Exit value: %d\n"),($retval/256)))
if ($retval != 0); if ($retval != 0);
&force_unpack if ($unpack eq "true"); &force_unpack if ($unpack eq "true");
system ("touch ${dir}${libdir}lists/lock"); system ("touch ${dir}${libdir}lists/lock");
system ("$setupsh $dir $arch") if ((defined $setupsh) and (-f $setupsh)); system ("$setupsh $dir $arch") if ((defined $setupsh) and (-x $setupsh));
&native if (not defined ($foreign)); &native if (not defined ($foreign));
&add_extra_packages; &add_extra_packages;
system ("cp $configsh $dir/") if ((defined $configsh) and (-f $configsh)); system ("cp $configsh $dir/") if ((defined $configsh) and (-f $configsh));
@ -380,36 +353,29 @@ opendir (LISTS, "${dir}etc/apt/sources.list.d/")
or die (_g("Cannot read apt sources list directory.\n")); or die (_g("Cannot read apt sources list directory.\n"));
my @sources=grep(!m:\.\.?$:, readdir LISTS); my @sources=grep(!m:\.\.?$:, readdir LISTS);
closedir (LISTS); closedir (LISTS);
foreach my $filelist (@sources) foreach my $filelist (@sources) {
{
next if (-d $filelist); next if (-d $filelist);
unlink ("${dir}etc/apt/sources.list.d/$filelist"); unlink ("${dir}etc/apt/sources.list.d/$filelist");
} }
%uniq=(); %uniq=();
foreach my $line (@aptsources) foreach my $line (@aptsources) {
{
$uniq{$line}++; $uniq{$line}++;
} }
@aptsources=sort keys %uniq; @aptsources=sort keys %uniq;
%uniq=(); %uniq=();
foreach my $aptsrc (@aptsources) foreach my $aptsrc (@aptsources) {
{ if (defined $deflist) {
if (defined $deflist)
{
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list") open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list")
or die _g("Cannot open sources list"). $!; or die _g("Cannot open sources list"). $!;
print SOURCES $deflist; print SOURCES $deflist;
close SOURCES; close SOURCES;
} } elsif (-d "${dir}etc/apt/") {
elsif (-d "${dir}etc/apt/")
{
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list") open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list")
or die _g("Cannot open sources list"). $!; or die _g("Cannot open sources list"). $!;
$mirror = $sources{$aptsrc}; $mirror = $sources{$aptsrc};
$suite = $suites{$aptsrc}; $suite = $suites{$aptsrc};
$component = (defined $components{$aptsrc}) ? $components{$aptsrc} : "main"; $component = (defined $components{$aptsrc}) ? $components{$aptsrc} : "main";
if (defined $mirror and defined $suite) if (defined $mirror and defined $suite) {
{
print SOURCES "deb $mirror $suite $component\n"; print SOURCES "deb $mirror $suite $component\n";
print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc}); print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc});
close SOURCES; close SOURCES;
@ -419,15 +385,13 @@ foreach my $aptsrc (@aptsources)
# altered the sources, so get apt to update. # altered the sources, so get apt to update.
(not defined $tidy) ? system ("apt-get $config_str update") : &tidy_apt; (not defined $tidy) ? system ("apt-get $config_str update") : &tidy_apt;
printf (_g("\nMultistrap system installed successfully in %s.\n"), $dir); printf (_g("\nMultistrap system installed successfully in %s.\n"), $dir);
if (defined $tgzname) if (defined $tgzname) {
{
printf (_g("\nCompressing multistrap system in '%s' to a tarball called: '%s'.\n"), $dir, $tgzname); printf (_g("\nCompressing multistrap system in '%s' to a tarball called: '%s'.\n"), $dir, $tgzname);
chdir ("$dir"); chdir ("$dir");
unlink $tgzname if (-f $tgzname); unlink $tgzname if (-f $tgzname);
my $retval = system ("tar -czf ../$tgzname ."); my $retval = system ("tar -czf ../$tgzname .");
$retval /= 256; $retval /= 256;
if ($retval == 0) if ($retval == 0) {
{
printf (_g("\nRemoving build directory: '%s'\n"), $dir); printf (_g("\nRemoving build directory: '%s'\n"), $dir);
system ("rm -rf $dir/*"); system ("rm -rf $dir/*");
} }
@ -443,11 +407,9 @@ sub our_version {
(defined $query) ? return $query : return "2.1.5"; (defined $query) ? return $query : return "2.1.5";
} }
sub add_extra_packages sub add_extra_packages {
{
$str = join (' ', @extrapkgs); $str = join (' ', @extrapkgs);
if (@extrapkgs) if (@extrapkgs) {
{
print "apt-get -y $config_str install $str\n"; print "apt-get -y $config_str install $str\n";
$retval = system ("apt-get -y $config_str install $str"); $retval = system ("apt-get -y $config_str install $str");
&force_unpack (@extrapkgs) if ($unpack eq "true"); &force_unpack (@extrapkgs) if ($unpack eq "true");
@ -456,8 +418,7 @@ sub add_extra_packages
} }
} }
sub force_unpack sub force_unpack {
{
my (@limits) = @_; my (@limits) = @_;
my %unpack=(); my %unpack=();
my %filter = (); my %filter = ();
@ -465,14 +426,10 @@ sub force_unpack
or die (_g("Cannot read apt archives directory.\n")); or die (_g("Cannot read apt archives directory.\n"));
@archives=grep(/.*\.deb$/, readdir DEBS); @archives=grep(/.*\.deb$/, readdir DEBS);
closedir (DEBS); closedir (DEBS);
if (@limits) if (@limits) {
{ foreach my $l (@limits) {
foreach my $l (@limits) foreach my $file (@archives) {
{ if ($file =~ m:$l:) {
foreach my $file (@archives)
{
if ($file =~ m:$l:)
{
$filter{$l} = "$file"; $filter{$l} = "$file";
} }
} }
@ -480,36 +437,30 @@ sub force_unpack
@archives = sort values %filter; @archives = sort values %filter;
} }
print _g("I: Calculating obsolete packages\n"); print _g("I: Calculating obsolete packages\n");
foreach $deb (sort @archives) foreach $deb (sort @archives) {
{
my $version = `LC_ALL=C dpkg -f ${dir}${cachedir}archives/$deb Version`; my $version = `LC_ALL=C dpkg -f ${dir}${cachedir}archives/$deb Version`;
my $package = `LC_ALL=C dpkg -f ${dir}${cachedir}archives/$deb Package`; my $package = `LC_ALL=C dpkg -f ${dir}${cachedir}archives/$deb Package`;
chomp ($version); chomp ($version);
chomp ($package); chomp ($package);
if (exists $unpack{$package}) if (exists $unpack{$package}) {
{
my $test=system("dpkg --compare-versions $unpack{$package} '<<' $version"); my $test=system("dpkg --compare-versions $unpack{$package} '<<' $version");
$test /= 256; $test /= 256;
# unlink version in $unpack if 0 # unlink version in $unpack if 0
# unlink $deb (current one) if 1 # unlink $deb (current one) if 1
if ($test == 0) if ($test == 0) {
{
my $old = $deb; my $old = $deb;
$old =~ s/$version/$unpack{$package}/; $old =~ s/$version/$unpack{$package}/;
printf (_g("I: Removing %s\n"), $old); printf (_g("I: Removing %s\n"), $old);
unlink "${dir}${cachedir}archives/$old"; unlink "${dir}${cachedir}archives/$old";
next; next;
} } else {
else
{
printf (_g("I: Removing %s\n"), $deb); printf (_g("I: Removing %s\n"), $deb);
unlink "${dir}${cachedir}archives/$deb"; unlink "${dir}${cachedir}archives/$deb";
} }
} }
$unpack{$package}=$version; $unpack{$package}=$version;
} }
if (not @limits) if (not @limits) {
{
open (LOCK, ">${dir}${libdir}lists/lock"); open (LOCK, ">${dir}${libdir}lists/lock");
close (LOCK); close (LOCK);
opendir (DEBS, "${dir}${cachedir}archives/") opendir (DEBS, "${dir}${cachedir}archives/")
@ -521,8 +472,7 @@ sub force_unpack
chomp ($old); chomp ($old);
chdir ("${dir}"); chdir ("${dir}");
printf (_g("Using directory %s for unpacking operations\n"), $dir); printf (_g("Using directory %s for unpacking operations\n"), $dir);
foreach $deb (sort @archives) foreach $deb (sort @archives) {
{
printf (_g("I: Extracting %s...\n"), $deb); printf (_g("I: Extracting %s...\n"), $deb);
my $ver=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Version`; my $ver=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Version`;
my $pkg=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Package`; my $pkg=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Package`;
@ -534,15 +484,13 @@ sub force_unpack
my $datatar = `LC_ALL=C dpkg -X ./${cachedir}archives/$deb ${dir}`; my $datatar = `LC_ALL=C dpkg -X ./${cachedir}archives/$deb ${dir}`;
my $exit = `echo $?`; my $exit = `echo $?`;
chomp ($exit); chomp ($exit);
if ($exit ne "0") if ($exit ne "0") {
{
printf(_g("dpkg -X failed with error code %s\nSkipping...\n"), $exit); printf(_g("dpkg -X failed with error code %s\nSkipping...\n"), $exit);
next; next;
} }
my @lines = split("\n", $datatar); my @lines = split("\n", $datatar);
open (LIST, ">>./${dpkgdir}info/${pkg}.list"); open (LIST, ">>./${dpkgdir}info/${pkg}.list");
foreach my $l (@lines) foreach my $l (@lines) {
{
chomp ($l); chomp ($l);
$l =~ s:^\.::; $l =~ s:^\.::;
$l =~ s:^/$:/\.:; $l =~ s:^/$:/\.:;
@ -556,11 +504,9 @@ sub force_unpack
closedir (MAINT); closedir (MAINT);
open (AVAIL, ">>./${dpkgdir}available"); open (AVAIL, ">>./${dpkgdir}available");
open (STATUS, ">>./${dpkgdir}status"); open (STATUS, ">>./${dpkgdir}status");
foreach my $mscript (@maint) foreach my $mscript (@maint) {
{
rename "./${tmpdir}/$mscript", "./${dpkgdir}info/$pkg.$mscript"; rename "./${tmpdir}/$mscript", "./${dpkgdir}info/$pkg.$mscript";
if ( $mscript eq "control" ) if ( $mscript eq "control" ) {
{
open (MSCRIPT, "./${dpkgdir}info/$pkg.$mscript"); open (MSCRIPT, "./${dpkgdir}info/$pkg.$mscript");
my @scr=<MSCRIPT>; my @scr=<MSCRIPT>;
close (MSCRIPT); close (MSCRIPT);
@ -573,15 +519,13 @@ sub force_unpack
} }
} }
close (AVAIL); close (AVAIL);
if ( -f "./${dpkgdir}info/$pkg.conffiles") if ( -f "./${dpkgdir}info/$pkg.conffiles") {
{
print STATUS "Conffiles:\n"; print STATUS "Conffiles:\n";
printf (_g(" -> Processing conffiles for %s\n"), $pkg); printf (_g(" -> Processing conffiles for %s\n"), $pkg);
open (CONF, "./${dpkgdir}info/$pkg.conffiles"); open (CONF, "./${dpkgdir}info/$pkg.conffiles");
my @lines=<CONF>; my @lines=<CONF>;
close (CONF); close (CONF);
foreach my $line (@lines) foreach my $line (@lines) {
{
chomp ($line); chomp ($line);
my $md5=`LC_ALL=C md5sum ./$line | cut -d" " -f1`; my $md5=`LC_ALL=C md5sum ./$line | cut -d" " -f1`;
chomp ($md5); chomp ($md5);
@ -593,8 +537,7 @@ sub force_unpack
system ("rm -rf ./${tmpdir}"); system ("rm -rf ./${tmpdir}");
if (-l "${dir}lib64" ) { if (-l "${dir}lib64" ) {
my $r = readlink "${dir}lib64"; my $r = readlink "${dir}lib64";
if ($r =~ m:^/:) if ($r =~ m:^/:) {
{
my $old = `pwd`; my $old = `pwd`;
chomp ($old); chomp ($old);
printf (_g("ERR: lib64 -> ./lib symbolic link clobbered by %s\n"), $pkg); printf (_g("ERR: lib64 -> ./lib symbolic link clobbered by %s\n"), $pkg);
@ -610,8 +553,7 @@ sub force_unpack
print _g("I: Unpacking complete.\n"); print _g("I: Unpacking complete.\n");
} }
sub check_bin_sh sub check_bin_sh {
{
$dir = shift; $dir = shift;
my $old = `pwd`; my $old = `pwd`;
chomp ($old); chomp ($old);
@ -620,37 +562,29 @@ sub check_bin_sh
# (works OK in subsequent upgrades.) #546528 # (works OK in subsequent upgrades.) #546528
unlink ("$dir/var/lib/dpkg/info/dash.postinst"); unlink ("$dir/var/lib/dpkg/info/dash.postinst");
# now ensure that a usable shell is available as /bin/sh # now ensure that a usable shell is available as /bin/sh
if (not -l "$dir/bin/sh") if (not -l "$dir/bin/sh") {
{
print (_g("ERR: ./bin/sh symbolic link does not exist.\n")); print (_g("ERR: ./bin/sh symbolic link does not exist.\n"));
if (-f "$dir/bin/dash") if (-f "$dir/bin/dash") {
{
print (_g("INF: Setting ./bin/sh -> ./bin/dash\n")); print (_g("INF: Setting ./bin/sh -> ./bin/dash\n"));
chdir ("$dir/bin"); chdir ("$dir/bin");
symlink ("dash", "sh"); symlink ("dash", "sh");
chdir ("$old"); chdir ("$old");
} } elsif (-f "$dir/bin/bash") {
elsif (-f "$dir/bin/bash")
{
print (_g("INF: ./bin/dash not found. Setting ./bin/sh -> ./bin/bash\n")); print (_g("INF: ./bin/dash not found. Setting ./bin/sh -> ./bin/bash\n"));
chdir ("$dir/bin"); chdir ("$dir/bin");
symlink ("bash", "sh"); symlink ("bash", "sh");
chdir ("$old"); chdir ("$old");
} }
} }
if (-l "$dir/bin/sh") if (-l "$dir/bin/sh") {
{
print ("${dir}bin/sh found OK:\n"); print ("${dir}bin/sh found OK:\n");
system ("(cd $dir ; ls -lh bin/sh)"); system ("(cd $dir ; ls -lh bin/sh)");
} } else {
else
{
die ("No shell in $dir."); die ("No shell in $dir.");
} }
} }
sub tidy_apt sub tidy_apt {
{
print _g("I: Tidying up apt cache and list data.\n"); print _g("I: Tidying up apt cache and list data.\n");
if (defined $sourcedir) { if (defined $sourcedir) {
my $str = join (" ", @dsclist); my $str = join (" ", @dsclist);
@ -663,8 +597,7 @@ sub tidy_apt
or die (_g("Cannot read apt lists directory.\n")); or die (_g("Cannot read apt lists directory.\n"));
my @lists=grep(!m:\.\.?$:, readdir DEBS); my @lists=grep(!m:\.\.?$:, readdir DEBS);
closedir (DEBS); closedir (DEBS);
foreach my $file (@lists) foreach my $file (@lists) {
{
next if (-d $file); next if (-d $file);
unlink ("${dir}${libdir}lists/$file"); unlink ("${dir}${libdir}lists/$file");
} }
@ -672,20 +605,17 @@ sub tidy_apt
or die (_g("Cannot read apt cache directory.\n")); or die (_g("Cannot read apt cache directory.\n"));
my @files=grep(!m:\.\.?$:, readdir DEBS); my @files=grep(!m:\.\.?$:, readdir DEBS);
closedir (DEBS); closedir (DEBS);
foreach my $file (@files) foreach my $file (@files) {
{
next if (-d $file); next if (-d $file);
next unless ($file =~ /\.bin$/); next unless ($file =~ /\.bin$/);
unlink ("${dir}${cachedir}$file"); unlink ("${dir}${cachedir}$file");
} }
if ($unpack eq "true") if ($unpack eq "true") {
{
opendir (DEBS, "${dir}${cachedir}/archives/") opendir (DEBS, "${dir}${cachedir}/archives/")
or die (_g("Cannot read apt archives directory.\n")); or die (_g("Cannot read apt archives directory.\n"));
my @files=grep(!m:\.\.?$:, readdir DEBS); my @files=grep(!m:\.\.?$:, readdir DEBS);
closedir (DEBS); closedir (DEBS);
foreach my $file (@files) foreach my $file (@files) {
{
next if (-d $file); next if (-d $file);
next unless ($file =~ /\.deb$/); next unless ($file =~ /\.deb$/);
if (defined $sourcedir) { if (defined $sourcedir) {
@ -699,8 +629,7 @@ sub tidy_apt
} }
# if native arch, do a few tasks just because we can and probably should. # if native arch, do a few tasks just because we can and probably should.
sub native sub native {
{
my $e=`LC_ALL=C printenv`; my $e=`LC_ALL=C printenv`;
my $env = "DEBIAN_FRONTEND=noninteractive ". my $env = "DEBIAN_FRONTEND=noninteractive ".
"DEBCONF_NONINTERACTIVE_SEEN=true ". "DEBCONF_NONINTERACTIVE_SEEN=true ".
@ -723,8 +652,7 @@ sub native
closedir (PRI); closedir (PRI);
printf (_g("I: Running preinst scripts with 'upgrade' argument.\n")); printf (_g("I: Running preinst scripts with 'upgrade' argument.\n"));
my $f = join (" ", @reinstall); my $f = join (" ", @reinstall);
foreach my $script (sort @preinsts) foreach my $script (sort @preinsts) {
{
my $t = $script; my $t = $script;
$t =~ s/\.preinst//; $t =~ s/\.preinst//;
next if ($t =~ /$f/); next if ($t =~ /$f/);
@ -732,14 +660,12 @@ sub native
system ("$str $env chroot $dir /var/lib/dpkg/info/$script upgrade"); system ("$str $env chroot $dir /var/lib/dpkg/info/$script upgrade");
} }
# reinstall set # reinstall set
foreach my $reinst (sort @reinstall) foreach my $reinst (sort @reinstall) {
{
system ("$str $env chroot $dir apt-get --reinstall -y install $reinst"); system ("$str $env chroot $dir apt-get --reinstall -y install $reinst");
} }
} }
sub get_required_debs sub get_required_debs {
{
# emulate required="$(get_debs Priority: required)" # emulate required="$(get_debs Priority: required)"
# from debootstrap/functions # from debootstrap/functions
# needs to be run after the first apt-get install so that # needs to be run after the first apt-get install so that
@ -751,20 +677,16 @@ sub get_required_debs
"${dir}${libdir}lists/", $!); "${dir}${libdir}lists/", $!);
my @lists=grep(/_Packages$/, readdir (PKGS)); my @lists=grep(/_Packages$/, readdir (PKGS));
closedir (PKGS); closedir (PKGS);
foreach my $strap (@debootstrap) foreach my $strap (@debootstrap) {
{
my $s = lc($strap); my $s = lc($strap);
foreach my $l (@lists) foreach my $l (@lists) {
{
$listfiles{$l}++; $listfiles{$l}++;
} }
} }
foreach my $file (keys %listfiles) foreach my $file (keys %listfiles) {
{
my $fh = IO::File->new("${dir}${libdir}lists/$file"); my $fh = IO::File->new("${dir}${libdir}lists/$file");
my $parser = Parse::Debian::Packages->new( $fh ); my $parser = Parse::Debian::Packages->new( $fh );
while (my %package = $parser->next) while (my %package = $parser->next) {
{
if (not defined $package{'Priority'} and (defined $package{'Essential'})) { if (not defined $package{'Priority'} and (defined $package{'Essential'})) {
$required{$package{'Package'}}++; $required{$package{'Package'}}++;
continue; continue;
@ -777,8 +699,7 @@ sub get_required_debs
} }
# inherited from apt-cross # inherited from apt-cross
sub prepare_sources_list sub prepare_sources_list {
{
my @source_list=(); my @source_list=();
# collate all available/configured sources into one list # collate all available/configured sources into one list
if (-e "/etc/apt/sources.list") { if (-e "/etc/apt/sources.list") {
@ -875,20 +796,16 @@ will be created - it is not packed into a .tgz once complete.
or die ("$progname: ". _g("failed to write usage:") . "$!\n"); or die ("$progname: ". _g("failed to write usage:") . "$!\n");
} }
sub cascade sub cascade {
{
$file = shift; $file = shift;
$config = Config::Auto::parse($file); $config = Config::Auto::parse($file);
foreach $key (%$config) foreach $key (%$config) {
{
$type = lc($key) if (ref $key ne "HASH"); $type = lc($key) if (ref $key ne "HASH");
$value = $key if (ref $key eq "HASH"); $value = $key if (ref $key eq "HASH");
$keys{$type} = $value; $keys{$type} = $value;
} }
foreach $section (sort keys %keys) foreach $section (sort keys %keys) {
{ if ($section eq "general") {
if ($section eq "general")
{
$arch = $keys{$section}{'arch'} $arch = $keys{$section}{'arch'}
if (defined $keys{$section}{'arch'} and (not defined $arch)); if (defined $keys{$section}{'arch'} and (not defined $arch));
$dir = $keys{$section}{'directory'} $dir = $keys{$section}{'directory'}
@ -926,9 +843,7 @@ sub cascade
push @aptsources, @a; push @aptsources, @a;
my @i = split (' ', lc($keys{$section}{'include'})); my @i = split (' ', lc($keys{$section}{'include'}));
push @includes, @i; push @includes, @i;
} } else {
else
{
$sources{$section}=$keys{$section}{'source'} if (not exists $source{$section}); $sources{$section}=$keys{$section}{'source'} if (not exists $source{$section});
$packages{$section}=$keys{$section}{'packages'} if (not exists $packages{$section}); $packages{$section}=$keys{$section}{'packages'} if (not exists $packages{$section});
$suites{$section}=$keys{$section}{'suite'} if (not exists $suites{$section}); $suites{$section}=$keys{$section}{'suite'} if (not exists $suites{$section});
@ -977,8 +892,7 @@ sub _g {
} }
sub dump_config { sub dump_config {
if (not defined $dir or not defined $arch) if (not defined $dir or not defined $arch) {
{
my $msg = sprintf(_g("The supplied configuration file '%s'". my $msg = sprintf(_g("The supplied configuration file '%s'".
" cannot be parsed correctly."), $file); " cannot be parsed correctly."), $file);
warn ("\n$msg\n"); warn ("\n$msg\n");
@ -992,8 +906,7 @@ sub dump_config {
push @check, @debootstrap; push @check, @debootstrap;
push @check, @aptsources; push @check, @aptsources;
foreach my $sect (@check) { $uniq{$sect}++; } foreach my $sect (@check) { $uniq{$sect}++; }
foreach my $sect (sort keys %uniq) foreach my $sect (sort keys %uniq) {
{
if (not exists $keys{$sect}) { if (not exists $keys{$sect}) {
$msg .= sprintf (_g("ERR: The '%s' section is not defined.\n"), $sect); $msg .= sprintf (_g("ERR: The '%s' section is not defined.\n"), $sect);
} }
@ -1005,11 +918,9 @@ sub dump_config {
} }
print "source: \tSources: ".join (", ", sort values %sources)."\n"; print "source: \tSources: ".join (", ", sort values %sources)."\n";
my @long=(); my @long=();
foreach my $sect (sort keys %packages) foreach my $sect (sort keys %packages) {
{
my @list = split (' ', $sect); my @list = split (' ', $sect);
foreach my $pkg (@list) foreach my $pkg (@list) {
{
next if ($packages{$pkg} =~ /^\s*$/); next if ($packages{$pkg} =~ /^\s*$/);
@long=split (/ /, $packages{$sect}); @long=split (/ /, $packages{$sect});
} }