lix/blacklisting/check-env.pl
Eelco Dolstra 97c93526da * 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.)
2005-03-07 16:26:05 +00:00

253 lines
6.3 KiB
Perl
Executable file

#! /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";
}
}
}