about summary refs log tree commit diff
path: root/blacklisting/check-env.pl
diff options
context:
space:
mode:
Diffstat (limited to 'blacklisting/check-env.pl')
-rwxr-xr-xblacklisting/check-env.pl177
1 files changed, 144 insertions, 33 deletions
diff --git a/blacklisting/check-env.pl b/blacklisting/check-env.pl
index f334ef04cb1e..0d76156ee7fb 100755
--- a/blacklisting/check-env.pl
+++ b/blacklisting/check-env.pl
@@ -26,44 +26,157 @@ my @userEnvElems = split ' ', $userEnvElems;
 my %storePathHashes;
 
 
+sub getElemNodes {
+    my $node = shift;
+    my @elems = ();
+    foreach my $node ($node->getChildNodes) {
+        push @elems, $node if $node->nodeType == XML_ELEMENT_NODE;
+    }
+    return @elems;
+}
+
+
+my %referencesCache;
+sub getReferences {
+    my $path = shift;
+    return $referencesCache{$path} if defined $referencesCache{$path};
+    
+    my $references = `nix-store --query --references '$path'`;
+    die "cannot query references" if $? != 0;
+    $referencesCache{$path} = [split ' ', $references];
+    
+    return $referencesCache{$path};
+}
+
+
+my %attrsCache;
+sub getAttr {
+    my $path = shift;
+    my $name = shift;
+    my $key = "$path/$name";
+    return $referencesCache{$key} if defined $referencesCache{$key};
+
+    my $value = `nix-store --query --binding '$name' '$path' 2> /dev/null`;
+    $value = "" if $? != 0; # !!!
+    chomp $value;
+    $referencesCache{$key} = $value;
+
+    return $value;
+}
+
+
+sub evalCondition;
+
+
+sub traverse {
+    my $done = shift;
+    my $set = shift;
+    my $path = shift;
+    my $stopCondition = shift;
+
+    return if defined $done->{$path};
+    $done->{$path} = 1;
+    $set->{$path} = 1;
+
+#    print "  in $path\n";
+
+    if (!evalCondition({$path => 1}, $stopCondition)) {
+#        print "  STOPPING in $path\n";
+        return;
+    }
+
+    # Get the requisites of the deriver.
+
+    foreach my $reference (@{getReferences $path}) {
+        traverse($done, $set, $reference, $stopCondition);
+    }
+}
+
+
+sub evalSet {
+    my $inSet = shift;
+    my $expr = shift;
+    my $name = $expr->getName;
+    
+    if ($name eq "traverse") {
+        my $stopCondition = (getElemNodes $expr)[0];
+        my $done = { };
+        my $set = { };
+        foreach my $path (keys %{$inSet}) {
+            traverse($done, $set, $path, $stopCondition);
+        }
+        return $set;
+    }
+
+    else {
+        die "unknown element `$name'";
+    }
+}
+
+
 # Function for evaluating conditions.
 sub evalCondition {
     my $storePaths = shift;
     my $condition = shift;
-
-    my $name = $condition->getName;
+    my $elemName = $condition->getName;
     
-    if ($name eq "containsSource") {
+    if ($elemName eq "containsSource") {
         my $hash = $condition->attributes->getNamedItem("hash")->getValue;
         foreach my $path (keys %{$storePathHashes{$hash}}) {
-            # !!! use a hash for $storePaths
-            foreach my $path2 (@{$storePaths}) {
-                return 1 if $path eq $path2;
-            }
+            return 1 if defined $storePaths->{$path};
         }
         return 0;
     }
 
-    elsif ($name eq "and") {
-        my $result = 1;
-        foreach my $node ($condition->getChildNodes) {
-            if ($node->nodeType == XML_ELEMENT_NODE) {
-                $result &= evalCondition($storePaths, $node);
+    elsif ($elemName eq "hasName") { 
+        my $nameRE = $condition->attributes->getNamedItem("name")->getValue;
+        foreach my $path (keys %{$storePaths}) {
+            return 1 if $path =~ /$nameRE/;
+        }
+        return 0;
+    }
+    
+    elsif ($elemName eq "hasAttr") { 
+        my $name = $condition->attributes->getNamedItem("name")->getValue;
+        my $valueRE = $condition->attributes->getNamedItem("value")->getValue;
+        foreach my $path (keys %{$storePaths}) {
+            if ($path =~ /\.drv$/) {
+                my $value = getAttr($path, $name);
+#                print "    $path $name $value\n";
+                return 1 if $value =~ /$valueRE/;
             }
         }
+        return 0;
+    }
+    
+    elsif ($elemName eq "and") {
+        my $result = 1;
+        foreach my $node (getElemNodes $condition) {
+            $result &= evalCondition($storePaths, $node);
+        }
         return $result;
     }
 
-    elsif ($name eq "true") {
+    elsif ($elemName eq "not") {
+        return !evalCondition($storePaths, (getElemNodes $condition)[0]);
+    }
+    
+    elsif ($elemName eq "within") {
+        my @elems = getElemNodes $condition;
+        my $set = evalSet($storePaths, $elems[0]);
+        return evalCondition($set, $elems[1]);
+    }
+
+    elsif ($elemName eq "true") {
         return 1;
     }
 
-    elsif ($name eq "false") {
+    elsif ($elemName eq "false") {
         return 0;
     }
 
     else {
-        die "unknown element `$name'";
+        die "unknown element `$elemName'";
     }
 }
 
@@ -74,9 +187,7 @@ sub evalOr {
 
     my $result = 0;
     foreach my $node (@{$nodes}) {
-        if ($node->nodeType == XML_ELEMENT_NODE) {
-            $result |= evalCondition($storePaths, $node);
-        }
+        $result |= evalCondition($storePaths, $node);
     }
     
     return $result;
@@ -100,22 +211,22 @@ foreach my $userEnvElem (@userEnvElems) {
 
 
     # Get the requisites of the deriver.
-    my $requisites = `nix-store --query --requisites --include-outputs '$deriver'`;
-    die "cannot query requisites" if $? != 0;
-    my @requisites = split ' ', $requisites;
+#    my $requisites = `nix-store --query --requisites --include-outputs '$deriver'`;
+#    die "cannot query requisites" if $? != 0;
+#    my @requisites = split ' ', $requisites;
 
 
     # Get the hashes of the requisites.
-    my $hashes = `nix-store --query --hash @requisites`;
-    die "cannot query hashes" if $? != 0;
-    my @hashes = split ' ', $hashes;
-    for (my $i = 0; $i < scalar @requisites; $i++) {
-        die unless $i < scalar @hashes;
-        my $hash = $hashes[$i];
-        $storePathHashes{$hash} = {} unless defined $storePathHashes{$hash};
-        my $r = $storePathHashes{$hash}; # !!! fix
-        $$r{$requisites[$i]} = 1;
-    }
+#    my $hashes = `nix-store --query --hash @requisites`;
+#    die "cannot query hashes" if $? != 0;
+#    my @hashes = split ' ', $hashes;
+#    for (my $i = 0; $i < scalar @requisites; $i++) {
+#        die unless $i < scalar @hashes;
+#        my $hash = $hashes[$i];
+#        $storePathHashes{$hash} = {} unless defined $storePathHashes{$hash};
+#        my $r = $storePathHashes{$hash}; # !!! fix
+#        $$r{$requisites[$i]} = 1;
+#    }
 
 
     # Evaluate each blacklist item.
@@ -127,8 +238,8 @@ foreach my $userEnvElem (@userEnvElems) {
         die unless $condition;
 
         # Evaluate the condition.
-        my @foo = $condition->getChildNodes();
-        if (evalOr(\@requisites, \@foo)) {
+        my @elems = getElemNodes $condition;
+        if (evalOr({$deriver => 1}, \@elems)) {
             # Oops, condition triggered.
             my $reason = ($item->getChildrenByTagName("reason"))[0]->getChildNodes->to_literal;
             $reason =~ s/\s+/ /g;