diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index bffbdbde5d..7b0aef061b 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -7,13 +7,14 @@ noinst_SCRIPTS = nix-profile.sh generate-patches.pl
 
 nix-pull nix-push: readmanifest.pm readconfig.pm download-using-manifests.pl
 
-install-exec-local: readmanifest.pm download-using-manifests.pl
+install-exec-local: readmanifest.pm download-using-manifests.pl find-runtime-roots.pl
 	$(INSTALL) -d $(DESTDIR)$(sysconfdir)/profile.d
 	$(INSTALL_PROGRAM) nix-profile.sh $(DESTDIR)$(sysconfdir)/profile.d/nix.sh
 	$(INSTALL) -d $(DESTDIR)$(libexecdir)/nix
 	$(INSTALL_DATA) readmanifest.pm $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL_DATA) readconfig.pm $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL_PROGRAM) download-using-manifests.pl $(DESTDIR)$(libexecdir)/nix 
+	$(INSTALL_PROGRAM) find-runtime-roots.pl $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL) -d $(DESTDIR)$(sysconfdir)/nix
 
 include ../substitute.mk
@@ -27,4 +28,5 @@ EXTRA_DIST = nix-collect-garbage.in \
   nix-build.in \
   download-using-manifests.pl.in \
   generate-patches.pl.in \
-  nix-pack-closure.in nix-unpack-closure.in
+  nix-pack-closure.in nix-unpack-closure.in \
+  find-runtime-roots.pl.in
diff --git a/scripts/find-runtime-roots.pl.in b/scripts/find-runtime-roots.pl.in
new file mode 100644
index 0000000000..3e55ee4458
--- /dev/null
+++ b/scripts/find-runtime-roots.pl.in
@@ -0,0 +1,58 @@
+#! @perl@ -w
+
+use strict;
+
+my $procDir = "/proc";
+
+
+sub readProc {
+    return unless -d $procDir;
+
+    opendir DIR, $procDir or return;
+    
+    foreach my $name (readdir DIR) {
+        next unless $name =~ /^\d+$/;
+
+        my $process = "$procDir/$name";
+
+        #print STDERR "=== $process\n";
+        
+        my $target;
+        print "$target\n" if $target = readlink "$process/exe";
+        print "$target\n" if $target = readlink "$process/cwd";
+
+        if (opendir FDS, "$process/fd") {
+            foreach my $name (readdir FDS) {
+                $target = readlink "$process/fd/$name";
+                print "$target\n" if $target && substr($target, 0, 1) eq "/";
+            }
+            closedir FDS;
+        }
+
+        if (open MAP, "<$process/maps") {
+            while (<MAP>) {
+                next unless /^ \s* \S+ \s+ \S+ \s+ \S+ \s+ \S+ \s+ \S+ \s+ (\/\S+) \s* $/x;
+                print "$1\n";
+            }
+            close MAP;
+        }
+    }
+
+    closedir DIR;
+}
+
+
+sub lsof {
+    return unless open LSOF, "lsof -b -w -F n |";
+
+    while (<LSOF>) {
+        next unless /^n (\/ .*)$/x;
+        print $1, "\n";
+    }
+
+    close LSOF;
+}
+
+
+readProc;
+lsof;