core/pkgs/build-support/vm/deb/deb-closure.pl
2024-05-13 11:34:52 -04:00

181 lines
4.8 KiB
Perl

use strict;
use Dpkg::Control;
use Dpkg::Deps;
use File::Basename;
my $packagesFile = shift @ARGV;
my $urlPrefix = shift @ARGV;
my @toplevelPkgs = @ARGV;
my %packages;
# Parse the Packages file.
open PACKAGES, "<$packagesFile" or die;
while (1) {
my $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
last if not $cdata->parse(\*PACKAGES, $packagesFile);
die unless defined $cdata->{Package};
#print STDERR $cdata->{Package}, "\n";
$packages{$cdata->{Package}} = $cdata;
}
close PACKAGES;
# Flatten a Dpkg::Deps dependency value into a list of package names.
sub getDeps {
my $deps = shift;
#print "$deps\n";
if ($deps->isa('Dpkg::Deps::AND')) {
my @res = ();
foreach my $dep ($deps->get_deps()) {
push @res, getDeps($dep);
}
return @res;
} elsif ($deps->isa('Dpkg::Deps::OR')) {
# Arbitrarily pick the first alternative.
return getDeps(($deps->get_deps())[0]);
} elsif ($deps->isa('Dpkg::Deps::Simple')) {
return ($deps->{package});
} else {
die "unknown dep type";
}
}
# Process the "Provides" and "Replaces" fields to be able to resolve
# virtual dependencies.
my %provides;
foreach my $cdata (sort {$a->{Package} cmp $b->{Package}} (values %packages)) {
if (defined $cdata->{Provides}) {
my @provides = getDeps(Dpkg::Deps::deps_parse($cdata->{Provides}));
foreach my $name (@provides) {
#die "conflicting provide: $name\n" if defined $provides{$name};
#warn "provide by $cdata->{Package} conflicts with package with the same name: $name\n";
next if defined $packages{$name};
$provides{$name} = $cdata->{Package};
}
}
# Treat "Replaces" like "Provides".
if (defined $cdata->{Replaces}) {
my @replaces = getDeps(Dpkg::Deps::deps_parse($cdata->{Replaces}));
foreach my $name (@replaces) {
next if defined $packages{$name};
$provides{$name} = $cdata->{Package};
}
}
}
# Determine the closure of a package.
my %donePkgs;
my %depsUsed;
my @order = ();
sub closePackage {
my $pkgName = shift;
print STDERR ">>> $pkgName\n";
my $cdata = $packages{$pkgName};
if (!defined $cdata) {
die "unknown (virtual) package $pkgName"
unless defined $provides{$pkgName};
print STDERR "virtual $pkgName: using $provides{$pkgName}\n";
$pkgName = $provides{$pkgName};
$cdata = $packages{$pkgName};
}
die "unknown package $pkgName" unless defined $cdata;
return if defined $donePkgs{$pkgName};
$donePkgs{$pkgName} = 1;
if (defined $cdata->{Provides}) {
foreach my $name (getDeps(Dpkg::Deps::deps_parse($cdata->{Provides}))) {
$provides{$name} = $cdata->{Package};
}
}
my @depNames = ();
if (defined $cdata->{Depends}) {
print STDERR " $pkgName: $cdata->{Depends}\n";
my $deps = Dpkg::Deps::deps_parse($cdata->{Depends});
die unless defined $deps;
push @depNames, getDeps($deps);
}
if (defined $cdata->{'Pre-Depends'}) {
print STDERR " $pkgName: $cdata->{'Pre-Depends'}\n";
my $deps = Dpkg::Deps::deps_parse($cdata->{'Pre-Depends'});
die unless defined $deps;
push @depNames, getDeps($deps);
}
foreach my $depName (@depNames) {
closePackage($depName);
}
push @order, $pkgName;
$depsUsed{$pkgName} = \@depNames;
}
foreach my $pkgName (@toplevelPkgs) {
closePackage $pkgName;
}
# Generate the output Nix expression.
print "# This is a generated file. Do not modify!\n";
print "# Following are the Debian packages constituting the closure of: @toplevelPkgs\n\n";
print "{fetchurl}:\n\n";
print "[\n\n";
# Output the packages in strongly connected components.
my %done;
my %forward;
my $newComponent = 1;
foreach my $pkgName (@order) {
$done{$pkgName} = 1;
my $cdata = $packages{$pkgName};
my @deps = @{$depsUsed{$pkgName}};
foreach my $dep (@deps) {
$dep = $provides{$dep} if defined $provides{$dep};
$forward{$dep} = 1 unless defined $done{$dep};
}
delete $forward{$pkgName};
print " [\n\n" if $newComponent;
$newComponent = 0;
my $origName = basename $cdata->{Filename};
my $cleanedName = $origName;
$cleanedName =~ s/~//g;
print " (fetchurl {\n";
print " url = \"$urlPrefix/$cdata->{Filename}\";\n";
print " sha256 = \"$cdata->{SHA256}\";\n";
print " name = \"$cleanedName\";\n" if $cleanedName ne $origName;
print " })\n";
print "\n";
if (keys %forward == 0) {
print " ]\n\n";
$newComponent = 1;
}
}
foreach my $pkgName (@order) {
my $cdata = $packages{$pkgName};
}
print "]\n";
if ($newComponent != 1) {
print STDERR "argh: ", keys %forward, "\n";
exit 1;
}