[unisog] IIS vulernerability scanner tool

Anne Bennett anne at alcor.concordia.ca
Fri Jul 27 19:28:06 GMT 2001


David Dandar <ddandar at odu.edu> writes:

> 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.

Many thanks for sharing your code.  I took the liberty of making some
changes to it (mostly to make it run with "-wT" and "use strict", but
I also added a few comments, changed the reporting format a bit so I
could grep it more easily, and made a few other minor changes).  My
modified version is appended, for anyone who cares.

In the meantime, the "possibly unpatched" and "unknown" IIS categories
catch quite a few machines at my site.  Has anyone seen more detailed
"web server signatures" since David sent us his code?  I'd really love
to be able to get an authoritative answer for all hosts...


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 unpatched versions
# of the Microsoft IIS web server, which are vulnerable to the
# "Code Red" worm released in July 2001.
#
# 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.

# Original by David Dandar <ddandar at odu.edu>, as per posting below.
# Patched for -wT and "use strict" by Anne Bennett <anne at alcor.concordia.ca>
# 2001/07/27

# 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 $http_query = 
     "GET /NULL.ida?".("x"x200)."=X HTTP/1.1\nHost: IITS-test\n\n";

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

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

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

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

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

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

# autoflush on stdout:
$|=1;

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

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);
  }

# --- 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("RESULT $host: TIMEOUT on connect\n")};
    alarm($connect_timeout);
    if($fd=IO::Socket::INET->new(PeerAddr => "$host",
                                 PeerPort => 80,
                                 Proto=>"TCP")) {
      $fd->send($http_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";
      }
  }

# 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, $ver, $result, $detail );
   print "DEBUG  $hosts{$fd}: receiving...\n";

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

   $fd->recv($raw_msg,4096);
   $msg=$raw_msg;
   $msg=~s/\s/ /g;
   chomp $msg;
   if($msg=~/Microsoft-IIS\/(\d+\.\d+)/) {
     $ver=$1;
     if($msg=~/0x80040e14/) {
       $result .= "patched IIS $ver";
       }
     elsif($msg=~/The IDQ file NULL.ida could not be found./) {
       $result .= "UNPATCHED IIS $ver";
       }
     elsif($msg=~/404 Object Not Found/ && ($ver ne "5.0")) {
       $result .= "Possibly UNPATCHED IIS $ver";
       }
     else {
       $result .= "UNKNOWN IIS $ver";
       }
     } else { # Not an IIS server
       if ($raw_msg=~/^Server: ([\S\t ]+).*$/m) {
         $result .= "non-IIS server '$1'";
         } else {
           $result .= "Unknown Response";
           }
       }
   $result .= "\n";
   $detail .= ": $msg\n";
   print $result;
   print $detail;
   $s->remove($fd);
   $fd->close;
   delete $hosts{$fd};
   delete $timeouts{$fd};
   }

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

$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 "$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...

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

  foreach $fd ($s->handles) {
    print "RESULT $hosts{$fd}: LEFTOVER at end of processing\n";
    }
  }
----------------------------------------------------------------------------



More information about the unisog mailing list