Code Red II: tool to find root.exe

Anne Bennett anne at alcor.concordia.ca
Mon Aug 6 19:52:36 GMT 2001


I have hacked my "code red vulnerability finding" script to create a
script which finds hosts which have "root.exe" on them.  I send a query
requesting a directory listing as "dir /tc" (file creation times).  If
I get a "200" response, the host has scripts/root.exe and is tagged as
compromised.  If I am able to get a date for root.exe, I indicate that
as the likely compromise time.

I did this to find any possible "Code Red II" compromises at my site,
hoping that there would be none because of our patching efforts early
last week.  To my horror, I found some "root.exe"s, but based on
compromised dates (between May and July this year), it looks like
probably "sadmind".  Argh.

Anyway, enjoy the appended.


Anne.
-- 
Ms. Anne Bennett, Senior Analyst, IITS, Concordia University, Montreal H3G 1M8
anne at alcor.concordia.ca                                        +1 514 848-7606
----------------------------------------------------------------------------
#!/usr/bin/perl -wT

# This program scans hosts on port 80 to check for hosts compromised
# by the next generation of Code Red; these hosts have
# /scripts/root.exe installed in their web data tree.  We try to list
# their directory to find the creation date of "root.exe".
#
# On stdin, it accepts a list of lines whose first element is 
# an IP address or a hostname to be scanned -- the rest of each line
# is ignored.

# 2001/07/20 David Dandar <ddandar at odu.edu>
#  - Original as per posting below.
# 2001/07/27 Anne Bennett <anne at alcor.concordia.ca>
#  - Patched for -wT and "use strict"
# 2001/07/30 Anne Bennett <anne at alcor.concordia.ca>
#  - Added mods from David Moore <dmoore at ipn.caida.org>, for
#    multi-lingual recognition of patterns.
# 2001/08/06 Anne Bennett <anne at alcor.concordia.ca>
#  - "/scripts/root.exe" variant

# Date: Fri, 20 Jul 2001 15:45:54 -0400
# From: David Dandar <ddandar at odu.edu>
# To: unisog at sans.org
# Message-ID: <20010720154554.B8261 at kataan.usg.odu.edu>
# Subject: [unisog] IIS vulernerability scanner tool
# 
# Below is a rough-cut perl script I whipped up to test for vulnerable IIS
# servers.  I can offer no guarantees, but it seems to be reporting good info. 
# It's based on a report on Bugtraq that fingerprinted some different
# responses to an exploit attempt.  I know Microsoft has something out there
# that reports patch information, but this is an alternative method.
# 
# I recommend using nmap or some other method of finding hosts listening on
# port 80, then feed the IP addresses in on stdin, or via a file listing on
# the command-line to this script.  The output lines contain the first 4k of
# the response from the server, whitespace squished, so they can be very long. 
# The "cannot determine address" and "bad file descriptor" errors are failed
# connects.
# 
# It shouldn't crash anything, but you have been warned. :-)  Use at your own
# risk.  I recommend trying it on a few known hosts first.
# 
# David

use strict;

use IO::Socket;
use IO::Select;

my ( $parallel, $connect_timeout, $response_timeout, $max_batch_timeout );
my ( @hosts, %hosts, %timeouts, $s );
my ( $codered_query, $vul_response_pattern, $root_date_pattern );


# ----------------------- configuration section ----------------------

# How many hosts to scan in parallel:
$parallel=100;

# How many seconds to wait for a connection to each host:
$connect_timeout=15;

# How many seconds to wait for an answer to our HTTP query:
$response_timeout=20;

# How many seconds to wait, maximum, per batch of tests:
$max_batch_timeout=30;

# ----------------------- configuration section ends -----------------

$codered_query = 
  'GET /scripts/root.exe?/c+dir+/tc HTTP/1.0'."\nHost: IITS-test\n\n";

$vul_response_pattern =
  '^HTTP/1.\d 200';

$root_date_pattern =
  '(^\d\d\/\d\d\/\d{2,4}\s+\d\d:\d\d\w)\s+\d+,\d+\s+root\.exe';

# ----------------------- subroutines --------------------------------

# Connect to the given host and send it the query.  Add it to
# the list of hosts we'll be checking for a response.
sub sendtest($) {
  my $host=shift;
  my $fd;
  print "DEBUG  $host: contacting...\n";

  eval {
    local $SIG{ALRM}=sub { die("TIMEOUT on connect\n")};
    alarm($connect_timeout);
    if($fd=IO::Socket::INET->new(PeerAddr => "$host",
                                 PeerPort => 80,
                                 Proto=>"TCP")) {
      $fd->send($codered_query);
      $fd->autoflush(1);
      alarm(0);
      } else {
        die("Failed to connect: $!"); # dies inside eval only
        }
    };
  unless($@) {  # i.e. if the eval above was successful
    $s->add($fd);          # add the resulting filehandle to our list
    $hosts{$fd}=$host;     # remember which host that handle is for
    $timeouts{$fd}=time()+$response_timeout; # the host should respond
                                             # in the next XX seconds.
    } else {    # if the eval (connect) failed, say why.
      print "RESULT $host: $@\n";
      }
  }


# Figure out whether we have a patched or unpatched system based on
# the response to the crafted "code red" query.  This code should be
# called only for IIS servers.
sub classify_codered_response($$) {
  my ( $msg, $version ) = @_;
  my ( $pattern );

  if($msg=~/$vul_response_pattern/m) {
    if($msg=~/$root_date_pattern/m) {
        return "COMPROMISED ($1)";
      } else {
        return "COMPROMISED (no date available)";
        }
    } else {
      return "probably ok";
      }

  }


# Read a host's response to our query, and delete it from the
# list of hosts we're still waiting for.
sub recvtest($) {
   my $fd=shift;
   my ( $raw_msg, $msg, $version, $result, $type, $detail );
   print "DEBUG  $hosts{$fd}: receiving...\n";

   $result = "RESULT $hosts{$fd}: ";
   $type   = "TYPE   $hosts{$fd}: ";
   $detail = "DETAIL $hosts{$fd}: ";

   $fd->recv($raw_msg,4096);
   $msg=$raw_msg;
   $msg=~s/\s/ /g;
   chomp $msg;

   if ($raw_msg=~/^Server: ([\S\t ]+).*$/m) {
     $type .= "$1";
     } else {
       $type .= "UNKNOWN";
       }

   if($msg=~/Microsoft-IIS\/(\d+\.\d+)/) {
     $version=$1;
     $result .= classify_codered_response($raw_msg, $version) . " " . $version;
     } else { # Not an IIS server
         $result .= "ignore -- not an IIS server";
       }
   print "$result\n";
   print "$type\n";
   print "$detail: $msg\n";
   $s->remove($fd);
   $fd->close;
   delete $hosts{$fd};
   delete $timeouts{$fd};
   }

# ------------ main program ------------

# --- set up list of hosts to scan ---

# autoflush on stdout:
$|=1;

while(<>) {	# Take a list of hosts to scan on stdin.
  chomp;
  my $host;
  # Keep only the first element of the line, then check it properly.
  if( /^\s*(\S+)(\s+.*$|$)/ ) {
    $host = $1;  # WARNING: this is not correctly untainted yet!
    if( $host =~ /^([\d\.]+)$/ ) {  # Looks like an IP address
      if( $host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ ) {
        if( ( $1 >= 0 ) && ( $1 <= 255 ) &&
            ( $2 >= 0 ) && ( $2 <= 255 ) &&
            ( $3 >= 0 ) && ( $3 <= 255 ) &&
            ( $4 >= 0 ) && ( $4 <= 255 )    ) {
          $host = "$1.$2.$3.$4";  # untainted
          } else {
            print "ERROR  $host line $.: IP addr element out of range 0-155\n";
            next;
            }
        } else {
          print "ERROR  $host line $.: malformatted IP address\n";
          next;
          }
      } else {                       # Looks liek a hostname
        if( $host =~ /^([\w\-\.]+)$/ ) {
          $host = $1;  # untainted
          } else {
            print "ERROR  $host line $.: bad characters in hostname\n";
            next;
          }
        }
    } else {
      print "ERROR  UNKNOWN line $.: unparsable line: $_\n";
      next;
      }
  push(@hosts, $host);
  }

$s=IO::Select->new();
{
  my ( $next, $fd, @ready );

  while(@hosts) {
    while(($s->handles)<$parallel && @hosts) {
      # start a bunch of parallel tests
      sendtest(shift(@hosts));
      }
  
    # Timeout management: our next batch of reads should wait only as long
    # as the earliest of our queued up timeouts.
    $next=time()+$max_batch_timeout;
    foreach $fd ($s->handles) {
      $next=$timeouts{$fd} if($timeouts{$fd}<$next);
      }
  
    # Read a batch of responses.
    @ready=$s->can_read($next-time());
    if(@ready) {
      foreach $fd (@ready) {
        recvtest($fd);
        }
      }
    
    # If any handles were not processed in the above read batch,
    # check them for timeouts, and if they are timed out, report and
    # delete them.
    foreach $fd ($s->handles) {
      if(time()>$timeouts{$fd}) {
        print "RESULT $hosts{$fd}: TIMEOUT on read\n";
        $s->remove($fd);
        delete $hosts{$fd};
        delete $timeouts{$fd};
        }
      }
    } # while
  
  # Make sure we don't get any leftovers after all our batches...
  sleep $max_batch_timeout if $s->handles;

  # Read last batch of responses.
  @ready=$s->can_read($max_batch_timeout);
  if(@ready) {
    foreach $fd (@ready) {
      recvtest($fd);
      }
    }

  # Deal with last batch (we hope!) of timeouts:
  foreach $fd ($s->handles) {
    if(time()>$timeouts{$fd}) {
      print "RESULT $hosts{$fd}: TIMEOUT on read\n";
      $s->remove($fd);
      delete $hosts{$fd};
      delete $timeouts{$fd};
      }
    }

  # There should be no more, but...
  foreach $fd ($s->handles) {
    print "RESULT $hosts{$fd}: LEFTOVER at end of processing\n";
    }
  }
----------------------------------------------------------------------------



More information about the unisog mailing list