Add resolve-system-dependencies.pl

1 files changed, 123 insertions, 0 deletions

diff --git a/scripts/resolve-system-dependencies.pl.in b/scripts/resolve-system-dependencies.pl.in
new file mode 100755
index 000000000000..412f07274c12
--- /dev/null
+++ b/scripts/resolve-system-dependencies.pl.in
@@ -0,0 +1,123 @@
+#! @perl@ -w @perlFlags@
+
+use utf8;
+use strict;
+use warnings;
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+use File::Path qw(make_path);
+use File::Spec::Functions qw(catfile);
+use List::Util qw(reduce);
+use IPC::Open3;
+use Nix::Config;
+use Nix::Store qw(derivationFromPath);
+use POSIX qw(uname);
+use Storable qw(lock_retrieve lock_store);
+
+my ($sysname, undef, $version, undef, $machine) = uname;
+$sysname =~ /Darwin/ or die "This tool is only meant to be used on Darwin systems.";
+
+my $cache = "$Nix::Config::stateDir/dependency-maps/$machine-$sysname-$version.map";
+
+make_path dirname($cache);
+
+our $DEPS;
+eval {
+  $DEPS = lock_retrieve($cache);
+} or do {
+  lock_store {}, $cache;
+  $DEPS = {};
+};
+
+sub mkset(@) {
+  my %set;
+  @set{@_} = ();
+  \%set
+}
+
+sub union($$) {
+  my ($set1, $set2) = @_;
+  my $new = {};
+  foreach my $key (keys %$set1) {
+    $new->{$key} = $set1->{$key};
+  }
+  foreach my $key (keys %$set2) {
+    $new->{$key} = $set2->{$key};
+  }
+  $new
+}
+
+sub cache_filepath($) {
+  my $fp = shift;
+  $fp =~ s/-/--/g;
+  $fp =~ s/\//-/g;
+  $fp =~ s/^-//g;
+  catfile $cache, $fp
+}
+
+sub resolve_tree {
+  sub resolve_tree_inner {
+    my ($lib, $TREE) = @_;
+    return if (defined $TREE->{$lib});
+    $TREE->{$lib} = mkset(@{cache_get($lib)});
+    foreach my $dep (keys %{$TREE->{$lib}}) {
+      resolve_tree_inner($dep, $TREE);
+    }
+    values %$TREE
+  }
+
+  reduce { union($a, $b) } {}, resolve_tree_inner(@_)
+}
+
+sub cache_get {
+  my $key = shift;
+  if (defined $DEPS->{$key}) {
+    $DEPS->{$key}
+  } else {
+    cache_insert($key);
+    cache_get($key)
+  }
+}
+
+sub cache_insert($) {
+  my $key = shift;
+  print STDERR "Finding dependencies for $key...\n";
+  my @deps = find_deps($key);
+  $DEPS->{$key} = \@deps;
+}
+
+sub find_deps($) {
+  my $lib = shift;
+  my($chld_in, $chld_out, $chld_err);
+  my $pid = open3($chld_in, $chld_out, $chld_err, "@otool@", "-L", "-arch", "x86_64", $lib);
+  waitpid($pid, 0);
+  my $line = readline $chld_out;
+  if($? == 0 and $line !~ /not an object file/) {
+    my @libs;
+    while(<$chld_out>) {
+      my $dep = (split /\s+/)[1];
+      push @libs, $dep unless $dep eq $lib or $dep =~ /\@rpath/;
+    }
+    @libs
+  } elsif (-l $lib) {
+    (realpath($lib))
+  } else {
+    ()
+  }
+}
+
+if (defined $ARGV[0]) {
+  my $deps = derivationFromPath($ARGV[0])->{"env"}->{"__impureHostDeps"};
+  if (defined $deps) {
+    my @files = split(/\s+/, $deps);
+    my $depcache = {};
+    my $depset = reduce { union($a, $b) } (map { resolve_tree($_, $depcache) } @files);
+    print "extra-chroot-dirs\n";
+    print join("\n", keys %$depset);
+    print "\n\n";
+  }
+  lock_store($DEPS, $cache);
+} else {
+  print STDERR "Usage: $0 path/to/derivation.drv\n";
+  exit 1
+}