* In the checker, do traversals of the dependency graph explicitly. A

  conditional expression in the blacklist can specify when to
  continue/stop a traversal.  For example, in

    <condition>
      <within>
        <traverse>
          <not><hasAttr name='outputHash' value='.+' /></not>
        </traverse>
        <hasAttr name='outputHash' value='ef1cb003448b4a53517b8f25adb12452' />
      </within>
    </condition>

  we traverse the dependency graph, not following the dependencies of
  `fetchurl' derivations (as indicated by the presence of an
  `outputHash' attribute - this is a bit ugly).  The resulting set of
  paths is scanned for a fetch of a file with the given hash, in this
  case, the hash of zlib-1.2.1.tar.gz (which has a security bug).  The
  intent is that a dependency on zlib is not a problem if it is in a
  `fetchurl' derivation, since that's build-time only.  (Other
  build-time uses of zlib *might* be a problem, e.g., static linking.)

2 files changed, 152 insertions, 45 deletions

diff --git a/blacklisting/blacklist.xml b/blacklisting/blacklist.xml
index aec9113262..9c33395971 100644
--- a/blacklisting/blacklist.xml
+++ b/blacklisting/blacklist.xml
@@ -1,32 +1,28 @@
 <blacklist>
 
 
-<!--
 <item id='openssl-0.9.7d-obsolete'>
   <condition>
-    <containsSource
-        hash="sha256:1xf1749gdfw9f50mxa5rsnmwiwrb5mi0kg4siw8a73jykdp2i6ii"
-        origin="openssl-0.9.7d.tar.gz" />
+    <within>
+      <traverse><true /></traverse>
+      <hasAttr name='outputHash' value='1b49e90fc8a75c3a507c0a624529aca5' />
+    </within>
   </condition>
   <reason>
     Race condition in CRL checking code.  Upgrade to 0.9.7e.
   </reason>
   <severity class="all" level="low" />
 </item>
--->
 
 
 <item id='zlib-1.2.1-security' type='security'>
   <condition>
-    <containsSource
-        hash="sha256:1xf1749gdfw9f50mxa5rsnmwiwrb5mi0kg4siw8a73jykdp2i6ii"
-        origin="openssl-0.9.7d.tar.gz" />
-<!--    <within>
+    <within>
       <traverse>
-        <not><hasName name='*.tar.*' /></not>
+        <not><hasAttr name='outputHash' value='.+' /></not>
       </traverse>
-      <hasAttr name='md5' value='ef1cb003448b4a53517b8f25adb12452' />
-    </within> -->
+      <hasAttr name='outputHash' value='ef1cb003448b4a53517b8f25adb12452' />
+    </within>
   </condition>
   <reason>
     Zlib 1.2.1 is vulnerable to a denial-of-service condition.  See
diff --git a/blacklisting/check-env.pl b/blacklisting/check-env.pl
index f334ef04cb..0d76156ee7 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;