about summary refs log tree commit diff
path: root/blacklisting/check-env.pl
diff options
context:
space:
mode:
authorEelco Dolstra <e.dolstra@tudelft.nl>2011-02-09T12·43+0000
committerEelco Dolstra <e.dolstra@tudelft.nl>2011-02-09T12·43+0000
commiteb94581d399b8d0945b883b14c4a892fdab95dfc (patch)
tree93113049a854cea98c747c94384439d174d1f0a2 /blacklisting/check-env.pl
parent7bba67c4013c1eb17c3f2f0a7015dbb57aae8ac8 (diff)
* Remove obsolete directory.
Diffstat (limited to 'blacklisting/check-env.pl')
-rwxr-xr-xblacklisting/check-env.pl252
1 files changed, 0 insertions, 252 deletions
diff --git a/blacklisting/check-env.pl b/blacklisting/check-env.pl
deleted file mode 100755
index 6eb792a52a8d..000000000000
--- a/blacklisting/check-env.pl
+++ /dev/null
@@ -1,252 +0,0 @@
-#! /usr/bin/perl -w -I /home/eelco/.nix-profile/lib/site_perl
-
-use strict;
-use XML::LibXML;
-#use XML::Simple;
-
-my $blacklistFN = shift @ARGV;
-die unless defined $blacklistFN;
-my $userEnv = shift @ARGV;
-die unless defined $userEnv;
-
-
-# Read the blacklist.
-my $parser = XML::LibXML->new();
-my $blacklist = $parser->parse_file($blacklistFN)->getDocumentElement;
-
-#print $blacklist->toString() , "\n";
-
-
-# Get all the elements of the user environment.
-my $userEnvElems = `nix-store --query --references '$userEnv'`;
-die "cannot query user environment elements" if $? != 0;
-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 $elemName = $condition->getName;
-    
-    if ($elemName eq "containsSource") {
-        my $hash = $condition->attributes->getNamedItem("hash")->getValue;
-        foreach my $path (keys %{$storePathHashes{$hash}}) {
-            return 1 if defined $storePaths->{$path};
-        }
-        return 0;
-    }
-
-    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 ($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 ($elemName eq "false") {
-        return 0;
-    }
-
-    else {
-        die "unknown element `$elemName'";
-    }
-}
-
-
-sub evalOr {
-    my $storePaths = shift;
-    my $nodes = shift;
-
-    my $result = 0;
-    foreach my $node (@{$nodes}) {
-        $result |= evalCondition($storePaths, $node);
-    }
-    
-    return $result;
-}
-
-
-# Iterate over all elements, check them.
-foreach my $userEnvElem (@userEnvElems) {
-
-    # Get the deriver of this path.
-    my $deriver = `nix-store --query --deriver '$userEnvElem'`;
-    die "cannot query deriver" if $? != 0;
-    chomp $deriver;
-
-    if ($deriver eq "unknown-deriver") {
-#        print "  deriver unknown, cannot check sources\n";
-        next;
-    }
-
-    print "CHECKING $userEnvElem\n";
-
-
-    # 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;
-
-
-    # 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;
-#    }
-
-
-    # Evaluate each blacklist item.
-    foreach my $item ($blacklist->getChildrenByTagName("item")) {
-        my $itemId = $item->getAttributeNode("id")->getValue;
-#        print "  CHECKING FOR $itemId\n";
-
-        my $condition = ($item->getChildrenByTagName("condition"))[0];
-        die unless $condition;
-
-        # Evaluate the condition.
-        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;
-            $reason =~ s/^\s+//g;
-
-            print "    VULNERABLE TO `$itemId': $reason\n";
-        }
-    }
-}
-