buildEnv: better warning and error messages

1 files changed, 35 insertions, 3 deletions

diff --git a/pkgs/build-support/buildenv/builder.pl b/pkgs/build-support/buildenv/builder.pl
index 411b147cc58..350cb83f731 100755
--- a/pkgs/build-support/buildenv/builder.pl
+++ b/pkgs/build-support/buildenv/builder.pl
@@ -10,6 +10,9 @@ use JSON::PP;
 
 STDOUT->autoflush(1);
 
+$SIG{__WARN__} = sub { warn "warning: ", @_ };
+$SIG{__DIE__}  = sub { die "error: ", @_ };
+
 my $out = $ENV{"out"};
 
 my @pathsToLink = split ' ', $ENV{"pathsToLink"};
@@ -88,6 +91,10 @@ sub findFilesInDir {
 sub checkCollision {
     my ($path1, $path2) = @_;
 
+    if (! -e $path1 || ! -e $path2) {
+        return 0;
+    }
+
     my $stat1 = (stat($path1))[2];
     my $stat2 = (stat($path2))[2];
 
@@ -101,6 +108,11 @@ sub checkCollision {
     return compare($path1, $path2) == 0;
 }
 
+sub prependDangling {
+    my $path = shift;
+    return (-l $path && ! -e $path ? "dangling symlink " : "") . "`$path'";
+}
+
 sub findFiles {
     my ($relName, $target, $baseName, $ignoreCollisions, $checkCollisionContents, $priority) = @_;
 
@@ -125,12 +137,21 @@ sub findFiles {
     # symlink to a file (not a directory) in a lower-priority package,
     # overwrite it.
     if (!defined $oldTarget || ($priority < $oldPriority && ($oldTarget ne "" && ! -d $oldTarget))) {
+        # If target is a dangling symlink, emit a warning.
+        if (-l $target && ! -e $target) {
+            my $link = readlink $target;
+            warn "creating dangling symlink `$out$extraPrefix/$relName' -> `$target' -> `$link'\n";
+        }
         $symlinks{$relName} = [$target, $priority];
         return;
     }
 
     # If target already exists and both targets resolves to the same path, skip
-    if (defined $oldTarget && $oldTarget ne "" && abs_path($target) eq abs_path($oldTarget)) {
+    if (
+        defined $oldTarget && $oldTarget ne "" &&
+        defined abs_path($target) && defined abs_path($oldTarget) &&
+        abs_path($target) eq abs_path($oldTarget)
+    ) {
         # Prefer the target that is not a symlink, if any
         if (-l $oldTarget && ! -l $target) {
             $symlinks{$relName} = [$target, $priority];
@@ -144,14 +165,25 @@ sub findFiles {
         return;
     }
 
+    # If target is supposed to be a directory but it isn't, die with an error message
+    # instead of attempting to recurse into it, only to fail then.
+    # This happens e.g. when pathsToLink contains a non-directory path.
+    if ($oldTarget eq "" && ! -d $target) {
+        die "not a directory: `$target'\n";
+    }
+
     unless (-d $target && ($oldTarget eq "" || -d $oldTarget)) {
+        # Prepend "dangling symlink" to paths if applicable.
+        my $targetRef = prependDangling($target);
+        my $oldTargetRef = prependDangling($oldTarget);
+
         if ($ignoreCollisions) {
-            warn "collision between `$target' and `$oldTarget'\n" if $ignoreCollisions == 1;
+            warn "collision between $targetRef and $oldTargetRef\n" if $ignoreCollisions == 1;
             return;
         } elsif ($checkCollisionContents && checkCollision($oldTarget, $target)) {
             return;
         } else {
-            die "collision between `$target' and `$oldTarget'\n";
+            die "collision between $targetRef and $oldTargetRef\n";
         }
     }