295 lines
7.4 KiB
Perl
Executable File
295 lines
7.4 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
use strict;
|
|
use Compress::Zlib;
|
|
|
|
my $dir;
|
|
my $rollback = 0;
|
|
my $option = shift;
|
|
if ($option =~ /--rollback/) {
|
|
$rollback = 1;
|
|
$dir = shift;
|
|
} else {
|
|
$dir = $option;
|
|
}
|
|
|
|
if (! -d $dir) {
|
|
die "$dir is not a directory ...";
|
|
}
|
|
|
|
my $mirror = $ENV{'MIRROR'} || die "Set the MIRROR var ...\n";
|
|
my $localdebs = $ENV{'LOCALDEBS'} || $mirror;
|
|
my $security = $ENV{'SECURITY'} || $mirror;
|
|
my $basedir = $ENV{'BASEDIR'} || die "Set the BASEDIR var ...\n";
|
|
my $codename = $ENV{'CODENAME'} || die "Set the CODENAME var ...\n";
|
|
my $tdir = $ENV{'TDIR'} || die "Set the TDIR var ...\n";
|
|
|
|
my $total_size = 0;
|
|
my $iso_blksize = 2048;
|
|
my $pkgname;
|
|
my $arch;
|
|
|
|
open(LOG, ">> $tdir/$codename/log.add_packages")
|
|
|| die "Can't write in $tdir/log.add_packages!\n";
|
|
|
|
sub msg {
|
|
my $level = shift;
|
|
print LOG @_;
|
|
}
|
|
|
|
require "$basedir/tools/link.pl";
|
|
|
|
my $old_split = $/;
|
|
$/ = ''; # Browse by paragraph
|
|
|
|
# From a package name and section, work out the directory where its
|
|
# corresponding Packages file should live
|
|
sub Packages_dir {
|
|
my $file = shift;
|
|
my $section = shift;
|
|
|
|
my ($pdir, $dist);
|
|
|
|
if ($file =~ /\/main\//) {
|
|
$dist = "main";
|
|
} elsif ($file =~ /\/contrib\//) {
|
|
$dist = "contrib";
|
|
} elsif ($file =~ /\/non-free\//) {
|
|
$dist = "non-free";
|
|
} elsif ($file =~ /\/local\//) {
|
|
$dist = "local";
|
|
}
|
|
|
|
$pdir = "$dir/dists/$codename/$dist";
|
|
if ($section eq "debian-installer") {
|
|
$pdir = "$dir/dists/$codename/$dist/debian-installer";
|
|
}
|
|
return $pdir;
|
|
}
|
|
|
|
# Dump the apt-cached data into a Packages file; make the parent dir
|
|
# for the Packages file if necesssary
|
|
sub add_Packages_entry {
|
|
my ($p, $file, $section, $pdir, $pkgfile, $gz);
|
|
my $arch = shift;
|
|
|
|
m/^Package: (\S+)/m and $p = $1;
|
|
m/^Section: (\S+)/m and $section = $1;
|
|
|
|
if ($arch eq "source") {
|
|
m/^Directory: (\S+)/mi and $file = $1;
|
|
$pdir = Packages_dir($file, $section) . "/source";
|
|
$pkgfile = "$pdir/Sources";
|
|
} else {
|
|
m/^Filename: (\S+)/mi and $file = $1;
|
|
$pdir = Packages_dir($file, $section) . "/binary-$arch";
|
|
$pkgfile = "$pdir/Packages";
|
|
}
|
|
|
|
msg(0, " Adding $p to $pkgfile(.gz)\n");
|
|
|
|
if (! -d $pdir) {
|
|
system("mkdir -p $pdir");
|
|
}
|
|
|
|
open(PFILE, ">>$pkgfile");
|
|
print PFILE $_;
|
|
close(PFILE);
|
|
|
|
$gz = gzopen("$pkgfile.gz", "ab9") or die "Failed to open $pkgfile.gz: $gzerrno\n";
|
|
$gz->gzwrite($_) or die "Failed to write $pkgfile.gz: $gzerrno\n";
|
|
$gz->gzclose();
|
|
}
|
|
|
|
sub add_md5_entry {
|
|
my $arch = shift;
|
|
my ($pdir, $file, $md5);
|
|
my $md5file = "$dir/md5sum.txt";
|
|
|
|
open(MD5FILE, ">>$md5file");
|
|
|
|
if ($arch eq "source") {
|
|
m/^Directory: (\S+)/mi and $pdir = $1;
|
|
m/^ (\S+) (\S+) ((\S+).*dsc)/m and print MD5FILE "$1 ./$pdir/$3\n";
|
|
m/^ (\S+) (\S+) ((\S+).*tar.gz)/m and print MD5FILE "$1 ./$pdir/$3\n";
|
|
m/^ (\S+) (\S+) ((\S+).*diff.gz)/m and print MD5FILE "$1 ./$pdir/$3\n";
|
|
} else {
|
|
m/^Filename: (\S+)/m and $file = $1;
|
|
m/^MD5sum: (\S+)/m and print MD5FILE "$1 ./$file\n";
|
|
}
|
|
|
|
close(MD5FILE);
|
|
}
|
|
|
|
# Roll back the results of add_Packages_entry()
|
|
sub remove_Packages_entry {
|
|
my ($p, $file, $section, $pdir, $pkgfile, $tmp_pkgfile, $match, $gz);
|
|
my $arch = shift;
|
|
|
|
m/^Package: (\S+)/m and $p = $1;
|
|
m/^Section: (\S+)/m and $section = $1;
|
|
|
|
if ($arch eq "source") {
|
|
m/^Directory: (\S+)/mi and $file = $1;
|
|
$pdir = Packages_dir($file, $section) . "/source";
|
|
$pkgfile = "$pdir/Sources";
|
|
} else {
|
|
m/^Filename: (\S+)/mi and $file = $1;
|
|
$pdir = Packages_dir($file, $section) . "/binary-$arch";
|
|
$pkgfile = "$pdir/Packages";
|
|
}
|
|
|
|
$tmp_pkgfile = "$pkgfile" . ".rollback";
|
|
|
|
msg(0, " Removing $p from $pkgfile\n");
|
|
|
|
open(IFILE, "<$pkgfile");
|
|
open(OFILE, ">>$tmp_pkgfile");
|
|
|
|
$gz = gzopen("$pkgfile.gz", "wb9");
|
|
|
|
while (defined($match = <IFILE>)) {
|
|
if (! ($match =~ /^Package: $p$/m)) {
|
|
print OFILE $match;
|
|
$gz->gzwrite($match) or die "Failed to write $pkgfile.gz: $gzerrno\n";
|
|
}
|
|
}
|
|
|
|
$gz->gzclose();
|
|
close(IFILE);
|
|
close(OFILE);
|
|
|
|
rename $tmp_pkgfile, $pkgfile;
|
|
}
|
|
|
|
sub remove_md5_entry {
|
|
my $arch = shift;
|
|
my ($pdir, $file, $md5, $match, $present);
|
|
my $md5file = "$dir/md5sum.txt";
|
|
my $tmp_md5file = "$dir/md5sum.txt.tmp";
|
|
my @fileslist;
|
|
|
|
$/ = $old_split; # Browse by line again
|
|
|
|
if ($arch eq "source") {
|
|
m/^Directory: (\S+)/mi and $pdir = $1;
|
|
m/^ (\S+) (\S+) ((\S+).*dsc)/m and push(@fileslist, "$1 ./$pdir/$3");
|
|
m/^ (\S+) (\S+) ((\S+).*diff.gz)/m and push(@fileslist, "$1 ./$pdir/$3");
|
|
m/^ (\S+) (\S+) ((\S+).*tar.gz)/m and push(@fileslist, "$1 ./$pdir/$3");
|
|
} else {
|
|
m/^Filename: (\S+)/m and $file = $1;
|
|
m/^MD5Sum: (\S+)/mi and push(@fileslist, "$1 ./$file");
|
|
}
|
|
|
|
open(IFILE, "<$md5file");
|
|
open(OFILE, ">>$tmp_md5file");
|
|
while (defined($match = <IFILE>)) {
|
|
$present = 0;
|
|
foreach my $entry (@fileslist) {
|
|
if (($match =~ /$entry$/m)) {
|
|
$present++;
|
|
}
|
|
}
|
|
if (!$present) {
|
|
print OFILE $match;
|
|
}
|
|
}
|
|
close(IFILE);
|
|
close(OFILE);
|
|
|
|
$/ = ''; # Browse by paragraph again
|
|
rename $tmp_md5file, $md5file;
|
|
}
|
|
|
|
sub get_file_size {
|
|
my $realfile = shift;
|
|
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($realfile);
|
|
$size = 1 + int(($size + $iso_blksize - 1) / $iso_blksize);
|
|
return $size;
|
|
}
|
|
|
|
my ($p, @files, $d, $realfile, $source, $section, $name, $pkgfile, $pdir);
|
|
|
|
foreach my $package (@ARGV) {
|
|
$pkgname = $package;
|
|
$pkgname =~ s/^.*://;
|
|
$arch = $package;
|
|
$arch =~ s/:.*$//g;
|
|
|
|
$ENV{'ARCH'} = $arch;
|
|
if ($arch eq "source") {
|
|
open (LIST, "$basedir/tools/apt-selection cache showsrc $pkgname |")
|
|
|| die "Can't fork : $!\n";
|
|
} else {
|
|
open (LIST, "$basedir/tools/apt-selection cache show $pkgname |")
|
|
|| die "Can't fork : $!\n";
|
|
}
|
|
|
|
while (defined($_ = <LIST>)) {
|
|
undef @files;
|
|
|
|
msg(0, "Looking at $package: arch $arch, package $pkgname\n");
|
|
|
|
m/^Package: (\S+)/m and $p = $1;
|
|
m/^Section: (\S+)/m and $section = $1;
|
|
|
|
$source = $mirror;
|
|
if ($arch eq "source") {
|
|
m/^Directory: (\S+)/m and $pdir = $1;
|
|
$source=$localdebs if $pdir=~m:local/:;
|
|
$source=$security if $pdir=~m:updates/:;
|
|
m/^ (\S+) (\S+) ((\S+).*dsc)/m and push(@files, "$pdir/$3");
|
|
m/^ (\S+) (\S+) ((\S+).*diff.gz)/m and push(@files, "$pdir/$3");
|
|
m/^ (\S+) (\S+) ((\S+).*tar.gz)/m and push(@files, "$pdir/$3");
|
|
} else {
|
|
m/^Filename: (\S+)/mi and push(@files, $1);
|
|
$source=$localdebs if $1=~m:local/:;
|
|
$source=$security if $1=~m:updates/:;
|
|
}
|
|
|
|
if ($rollback) {
|
|
# Remove the Packages entry/entries for the specified package
|
|
remove_Packages_entry($arch, $_);
|
|
remove_md5_entry($arch, $_);
|
|
|
|
foreach my $file (@files) {
|
|
# Count how big the file is we're removing, for checking if the disc is full
|
|
$realfile = real_file ("$source/$file");
|
|
$total_size -= get_file_size($realfile);
|
|
|
|
# Remove the link
|
|
unlink ("$dir/$file") or die "Failed to remove $dir/$file\n";
|
|
msg(0, " Rollback: removing $dir/$file\n");
|
|
}
|
|
} else {
|
|
add_Packages_entry($arch, $_);
|
|
add_md5_entry($arch, $_);
|
|
|
|
foreach my $file (@files) {
|
|
# And put the file in the CD tree (with a (hard) link)
|
|
$realfile = real_file ("$source/$file");
|
|
|
|
if (! -e "$dir/$file") {
|
|
# Count how big the file is, for checking if the disc
|
|
# is full. ONLY do this if the file is not already
|
|
# linked in - consider binary-all packages on a
|
|
# multi-arch disc
|
|
$total_size += get_file_size($realfile);
|
|
good_link ($realfile, "$dir/$file");
|
|
msg(0, " Linked $dir/$file\n");
|
|
} else {
|
|
msg(0, " $dir/$file already linked in\n");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close LIST or die "Something went wrong with apt-cache : $@ ($!)\n";
|
|
}
|
|
|
|
msg(0, " size $total_size\n");
|
|
print "$total_size\n";
|
|
|
|
close LOG
|
|
|
|
|