#!/usr/bin/perl

#########################################
# Fierce v0.9.9 - Beta 03/24/2007
# By RSnake http://ha.ckers.org/fierce/
# Threading and additions by IceShaman
#########################################

use strict;
use Net::hostent;
use Net::DNS;
use IO::Socket;
use Socket;
use Getopt::Long;
  		
# command line options
my $class_c;
my $delay = 0;
my $dns;
my $dns_file;
my $dns_server;
my @dns_servers;
my $filename;  
my $full_output;
my $help; 
my $http_connect;  
my $nopattern;  
my $range;
my $search;
my $suppress;
my $tcp_timeout;
my $threads;
my $traverse;   
my $version;   
my $wide;    		
my $wordlist;		
                  			
my @common_cnames;
my $count_hostnames = 0;
my @domain_ns;
my $h;
my @ip_and_hostname;
my $logging;
my %options = ();
my $res = Net::DNS::Resolver->new;
my $search_found;
my %subnets;
my %tested_names;
my $this_ip;
my $version_num = 'Version 0.9.9 - Beta 03/24/2007';
my $webservers = 0;
my $wildcard_dns;
my @wildcards;
my @zone;

my $count;
my %known_ips;
my %known_names;
my @output;
my @thread;
my $thread_support;

$count = 0;

# ignore all errors while trying to load up thead stuff
BEGIN {
  $SIG{__DIE__}  = sub { };
  $SIG{__WARN__} = sub { };
}
  
# try and load thread modules, if it works import their functions
BEGIN { 
  eval {
    require threads;
    require threads::shared;
    require Thread::Queue;
    $thread_support = 1;
  };
  if ($@) { # got errors, no ithreads :(
    $thread_support = 0;
  } else { #safe to haul in the threadding functions
    import threads;
    import threads::shared;
    import Thread::Queue;
  }
}

# turn errors back on
BEGIN {
  $SIG{__DIE__}  = 'DEFAULT';
  $SIG{__WARN__} = 'DEFAULT';
}

my $result = GetOptions (	
			'dns=s'		=> \$dns, 
	                'file=s'	=> \$filename,
                  	'suppress'	=> \$suppress,
                  	'help'		=> \$help, 
                  	'connect=s'	=> \$http_connect,
                  	'range=s'	=> \$range,
                  	'wide'		=> \$wide,
                  	'delay=i'	=> \$delay,
                  	'dnsfile=s'	=> \$dns_file,
                  	'dnsserver=s'	=> \$dns_server,
                  	'version'	=> \$version,
                  	'search=s'	=> \$search,
                  	'wordlist=s'	=> \$wordlist,
                  	'fulloutput'	=> \$full_output,
                  	'nopattern'	=> \$nopattern,
                  	'tcptimeout=i'	=> \$tcp_timeout,
                  	'traverse=i'	=> \$traverse,
                  	'threads=i'	=> \$threads,
                        );

help()                   if $help;
quit_early($version_num) if $version;

if (!$dns && !$range) {
  output("You have to use the -dns switch with a domain after it.");
  quit_early("Type: perl fierce.pl -h for help");
} elsif ($dns && $dns !~ /[a-z\d.-]\.[a-z]*/i) {
  output("\n\tUhm, no. \"$dns\" is gimp. A bad domain can mess up your day.");
  quit_early("\tTry again.");
}

if ($filename && $filename ne '') {
  $logging = 1;
  if (-e $filename) { # file exists
    print "File already exists, do you want to overwrite it? [Y|N] ";
    chomp(my $overwrite = <STDIN>);
    if ($overwrite eq 'y' || $overwrite eq 'Y') {
      open FILE, '>', $filename 
        or quit_early("Having trouble opening $filename anyway");
    } else {
      quit_early('Okay, giving up');
    } 
  } else {
    open FILE, '>', $filename 
      or quit_early("Having trouble opening $filename");
  }
  output('Now logging to ' . $filename);
} 

if ($http_connect) {
  unless (-e $http_connect) {
    open (HEADERS, "$http_connect") 
      or quit_early("Having trouble opening $http_connect");
    close HEADERS;
  } 
} 

# if user doesn't provide a number, they both end up at 0
quit_early('Your delay tag must be a positive integer')  
  if ($delay && $delay != 0 && $delay !~ /^\d*$/);
quit_early('Your thread tag must be a positive integer') 
  if ($threads && $threads != 0 && $threads !~ /^\d*$/);
  
if ($threads && !$thread_support) {
  quit_early('Perl is not configured to support ithreads');
}
  
if ($dns_file) {
  open (DNSFILE, '<', $dns_file) 
   or quit_early("Can't open $dns_file");
   for (<DNSFILE>) {
     chomp;
     push @dns_servers, $_;
   }  
   if (@dns_servers) {
     output("Using DNS servers from $dns_file");
   } else {
     output("DNS file $dns_file is empty, using default options");
   }
}

if ($full_output && !$http_connect) {
  output("Warning: you selected the -fulloutput option but didn't use");
  output("-connect.\n\tNot sure what to do with that, so continuing...");
}

if ($suppress && !$filename) {
  quit_early("You need to use the -s switch with the -f switch.\n
             . Otherwise all will perish...");
}

if ($tcp_timeout) {
  $res->tcp_timeout($tcp_timeout);
} else {
  $res->tcp_timeout(10);
}

if ($range) {
  $nopattern = 1;
  quit_early('-range must be combined with -dnsserver', $logging, $suppress) 
    if !$dns_server;
  $res->nameservers($dns_server);
  find_nearby($range);
  exit;
}

if ($traverse) {
  quit_early('The -t flag must contain an integer 0-255') if $traverse !~ /\d/;
  quit_early('The -t flag must contain an integer 0-255') if $traverse < 255;
} else {
  $traverse = 5;
}

my @search_strings = split(/\x2C/, $search) if $search;
my $query          = $res->query($dns, 'NS');

if ($query) {
  output("DNS Servers for $dns:");
  foreach my $rr (grep { $_->type eq 'NS' } $query->answer) {
    my $dnssrv = $rr->nsdname;
    output("\t$dnssrv");
    push (@domain_ns, $rr->nsdname);
  }
}

output("\nTrying zone transfer first...");

if ($dns_server) {
  @zone = $res->axfr($dns);
} else {
  for (@domain_ns) {
    $res->nameservers($_);
    output("\tTesting $_");
    @zone = $res->axfr($dns);
    @zone ? last : output("\t\tRequest timed out or transfer not allowed.");
  }
}

if ($dns_server) {
  $res->nameservers($dns_server);
} else {
  $res->nameservers(@domain_ns);
}

# DNS server gave us everything so we don't have to guess
if (@zone) {
  output("\nWhoah, it worked - misconfigured DNS server found:");
  output($_->string) for (@zone);
  quit_early("\nThere isn't much point continuing, you have everything.\n"
             . "Have a nice day.");
} elsif ($dns) {
  output("\nUnsuccessful in zone transfer (it was worth a shot)");
  output("Okay, trying the good old fashioned way... brute force");
  $wordlist = $wordlist || 'hosts.txt';
  if (-e $wordlist) {
    # user provided or default
    open (WORDLIST, '<', $wordlist)   or 
    open (WORDLIST, '<', 'hosts.txt') or
    quit_early("Can't open $wordlist or the default wordlist");
    for (<WORDLIST>){
      chomp;
      push @common_cnames, $_;
    }
    close WORDLIST;
  } else {
    quit_early("Can't open $wordlist or the default wordlist");
  }
  output("\nChecking for wildcard DNS...");
  srand;
  $wildcard_dns = 1e11 - int(rand(1e10));
  if ($h = gethost("$wildcard_dns.$dns")) {
    my $wildcard_addr = inet_ntoa($h->addr);
    output("\t** Found $wildcard_dns.$dns at $wildcard_addr.");
    output("\t** High probability of wildcard DNS.");
    $wildcard_dns = $wildcard_addr;
  } else {
    output('Nope. Good.');
    $wildcard_dns = q{};
  }
  my $total_cnames = @common_cnames;
  output("Now performing $total_cnames test(s)...");
  if ($threads) {
    share($count);
    share(%known_ips);
    share(%known_names);
    share(@output);
    my $stream = new Thread::Queue;
    foreach my $host (@common_cnames) {
      $stream->enqueue("$host.$dns");
    }
    for (0..$threads) {
      my $kid = new threads(\&search_host, $stream);
      $stream->enqueue(undef); #for each thread
    }
    foreach my $thread (threads->list) { 
     $thread->join if ($thread->tid && !threads::equal($thread, threads->self)); 
    } 
  } else {
    foreach my $host (@common_cnames) {
      search_host("$host.$dns");
    }  
  }
  # write to file any output generated by child threads
  print FILE for @output;
}

foreach my $current_name (sort keys(%known_names)) {
  @ip_and_hostname = split (/\x2C/, $current_name);
  my @bytes        = split (/\x2E/, $ip_and_hostname[0]);
  if ( $subnets{"$bytes[0].$bytes[1].$bytes[2]"} ) {
    $subnets{"$bytes[0].$bytes[1].$bytes[2]"}++;
  } else {
    $subnets{"$bytes[0].$bytes[1].$bytes[2]"} = 1;
  }
}

output("\nSubnets found (may want to probe here using nmap or unicornscan):");

foreach my $athroughc (sort keys(%subnets)) {
  $count_hostnames += $subnets{$athroughc};
  output("\t$athroughc.0-255 : $subnets{$athroughc} hostnames found.");
}

&http_connect if $http_connect;

output("\nDone with Fierce scan: http://ha.ckers.org/fierce/\n"
        . "Found $count entries.\n" 
        . ($http_connect ? "and $webservers webservers." : ""));
          
output('Have a nice day.');
close FILE if $logging;

# subs
sub set_nameservers {
  my $res = shift;
  my @servers;
  push @servers, @dns_servers if @dns_servers;
  push @servers, $dns_server  if $dns_server;
  push @servers, @domain_ns   if !@servers;
  $$res->nameservers(@servers);
}

sub search_host {
  sleep $delay;
  my $upstream;
  my $tid;
  my $resbf;
  if ($threads && threads->self->tid()) {
    $upstream = shift;
    $tid      = threads->self->tid();
    $resbf    = Net::DNS::Resolver->new;
    set_nameservers(\$resbf);
  } else {
    $resbf = $res;
  }

  # only runs once if not threaded
  while (my $search_item = $threads ? $upstream->dequeue : shift) {    
    next unless my $packet = $resbf->search($search_item);
    foreach my $answer ($packet->answer) {
      my @name = split (/\t/, $answer->string);
      next unless ($name[3] eq 'A' || $name[3] eq 'PTR');
      chop $name[0];
      if ($name[4] eq $wildcard_dns) {
        $this_ip = $name[4];
        find_nearby($this_ip) if !$known_ips{$this_ip};
        $known_ips{$answer->address} = 1;
        push @wildcards, "$wildcard_dns\t$search_item"; #may do something later 
        next;
      } 
      
      $this_ip = $name[4];
      find_nearby($this_ip) if !$known_ips{$this_ip};
      $known_ips{$this_ip} = 1;
      next if $known_names{"$this_ip,$search_item"};
      $count++;
      $known_names{"$this_ip,$search_item"} = 1; 
      output("$this_ip\t$search_item");
    }
  }
}

sub find_nearby {
  my $lowest;
  my $highest;
  my @octet;
  my $res = $res; # local copy so threads aren't waiting for others
  @octet = split(/\x2E/, shift);
  if ($wide) {
    ($lowest, $highest) = (0, 255);
  } else { # user provided range
    if ($octet[3] =~ /(\d*)-(\d*)/) {
      ($lowest, $highest) = ($1, $2);
      quit_early("Your range doesn't make sense, try again") 
        if $highest < $lowest;
    } else { # automatic call
      $lowest  = $octet[3] < $traverse       ? 0   : $octet[3] - $traverse;
      $highest = $octet[3] > 255 - $traverse ? 255 : $octet[3] + $traverse;
    }
  }
  
  foreach $class_c ($lowest..$highest) {
    sleep $delay;
    next if $class_c eq $octet[3];
    $octet[3] = $class_c;
    next if $known_ips{"$octet[0].$octet[1].$octet[2].$octet[3]"};
    $known_ips{"$octet[0].$octet[1].$octet[2].$octet[3]"} = 1;
    next unless my $packet = $res->search("$octet[0].$octet[1]."
                                          . "$octet[2].$octet[3]");
    foreach my $answer ($packet->answer) {
      next unless ($answer->type eq 'A' || $answer->type eq 'PTR');
      my @name = split (/\t/, $answer->string);
      chop $name[$#name];
      next if ($name[4] eq $wildcard_dns); 
      if ($search) {
        foreach (@search_strings) {
          if ($name[$#name] =~ /$_/ || $nopattern || !$dns) {
            $count++;
            $known_names{"$octet[0].$octet[1].$octet[2].$octet[3],"
                         . "$name[$#name]"} = 1;
            output("$octet[0].$octet[1].$octet[2].$octet[3]\t$name[$#name]");
            find_nearby("$octet[0].$octet[1].$octet[2].$octet[3]"); # recurse 
          }
        }
      } 
      next if ($name[$#name] !~ /$dns/ && !$nopattern);
      $count++;
      $known_names{"$octet[0].$octet[1].$octet[2].$octet[3],"
                   . "$name[$#name]"} = 1;
      output("$octet[0].$octet[1].$octet[2].$octet[3]\t$name[$#name]");
      find_nearby("$octet[0].$octet[1].$octet[2].$octet[3]");  # recurse  
    }
  }
}

sub http_connect {
  foreach my $_current_name (sort keys(%known_names)) {
    my @headers;
    my @my_headers;
    
    @ip_and_hostname = split(/\x2C/, $_current_name);
    my @octet        = split(/\x2E/, $ip_and_hostname[0]);
    if ($octet[0] == 10                     || # can't query RFC1918
        "$octet[0].$octet[1]" eq "192.168"  ||
        ($octet[0] == 172 && $octet[1] > 32 && $octet[1] < 15) ||
        ($ip_and_hostname[0] eq "127.0.0.1") # loopback
       ) {
      next;
    }
    
    open (HEADERS, $http_connect) 
      or quit_early("Don't know why but I can't read from $http_connect now");
    
    foreach (<HEADERS>) {
      $_ =~ s{^Host:\s*\n$}{Host: $ip_and_hostname[1]\n};
      push (@my_headers, $_);
    }
    close HEADERS;
    if ($my_headers[$#my_headers] !~ /^(\r\n)*$/)  {
      $my_headers[$#my_headers + 1] = "\r\n\r\n";
    }
    #TODO: add port selection and range support
    my $socket = new IO::Socket::INET (	
                                      	PeerAddr => "$ip_and_hostname[0]",
	                              	PeerPort => 'http(80)',
       					Timeout  => 10,
                              		Proto    => 'tcp',
                                      )
      or next;
    $webservers++;
    foreach (@my_headers) {
      print $socket $_;
    }
    print $socket . "\n\n";
    foreach (<$socket>) {
      unless ($_ =~ /^(\r\n)*$/) {
        push (@headers, $_);
      } else {
        last unless $full_output;
      }
    }
    output("\n\nHTTP output for $ip_and_hostname[0] $ip_and_hostname[1]");
    output("\t$_") foreach @headers;
    close $socket;
  }
}

sub output {
  my $text = shift;
  if ($logging) {
    if ($threads && threads->self->tid) {
      push @output, "$text\n";  
    } else {
      print FILE "$text\n";
    }
  }
  print "$text\n" unless $suppress;
}

sub quit_early {
  my ($text, $logging, $suppress) = @_; 
  print FILE "$text\nExiting...\n\n" if $logging;
  print "$text\nExiting...\n" unless $suppress;
  exit;
}

sub help {
  print <<EOHELP;
fierce.pl (C) Copywrite 2006,2007 - By RSnake at http://ha.ckers.org/fierce/

	Usage: perl fierce.pl [-dns example.com] [OPTIONS]

Overview:
	Fierce is a semi-lightweight scanner that helps locate non-contiguous
	IP space and hostnames against specified domains.  It's really meant
	as a pre-cursor to nmap, unicornscan, nessus, nikto, etc, since all 
	of those require that you already know what IP space you are looking 
	for.  This does not perform exploitation and does not scan the whole 
	internet indiscriminately.  It is meant specifically to locate likely 
	targets both inside and outside a corporate network.  Because it uses 
	DNS primarily you will often find mis-configured networks that leak 
	internal address space. That's especially useful in targeted malware.

Options:
	-connect	Attempt to make http connections to any non RFC1918
		(public) addresses.  This will output the return headers but
		be warned, this could take a long time against a company with
		many targets, depending on network/machine lag.  I wouldn't
		recommend doing this unless it's a small company or you have a
		lot of free time on your hands (could take hours-days).  
		Inside the file specified the text "Host:\\n" will be replaced
		by the host specified. Usage:

	perl fierce.pl -dns example.com -connect headers.txt

	-delay		The number of seconds to wait between lookups.
	-dns		The domain you would like scanned.
	-dnsfile  	Use DNS servers provided by a file (one per line) for
                reverse lookups (brute force).
	-dnsserver	Use a particular DNS server for reverse lookups 
		(probably should be the DNS server of the target).  Fierce
		uses your DNS server for the initial SOA query and then uses
		the target's DNS server for all additional queries by default.
	-file		A file you would like to output to be logged to.
	-fulloutput	When combined with -connect this will output everything
		the webserver sends back, not just the HTTP headers.
	-help		This screen.
	-nopattern	Don't use a search pattern when looking for nearby
		hosts.  Instead dump everything.  This is really noisy but
		is useful for finding other domains that spammers might be
		using.  It will also give you lots of false positives, 
		especially on large domains.
	-range		Scan an internal IP range (must be combined with 
		-dnsserver).  Note, that this does not support a pattern
		and will simply output anything it finds.  Usage:

	perl fierce.pl -range 111.222.333.0-255 -dnsserver ns1.example.co

	-search		Search list.  When fierce attempts to traverse up and
		down ipspace it may encounter other servers within other
		domains that may belong to the same company.  If you supply a 
		comma delimited list to fierce it will report anything found.
		This is especially useful if the corporate servers are named
		different from the public facing website.  Usage:

	perl fierce.pl -dns examplecompany.com -search corpcompany,blahcompany 

		Note that using search could also greatly expand the number of
		hosts found, as it will continue to traverse once it locates
		servers that you specified in your search list.  The more the
		better.
	-suppress	Suppress all TTY output (when combined with -file).
	-tcptimeout	Specify a different timeout (default 10 seconds).  You
		may want to increase this if the DNS server you are querying
		is slow or has a lot of network lag.
	-threads  Specify how many threads to use while scanning (default
	  is single threaded).
	-traverse	Specify a number of IPs above and below whatever IP you
		have found to look for nearby IPs.  Default is 5 above and 
		below.  Traverse will not move into other C blocks.
	-version	Output the version number.
	-wide		Scan the entire class C after finding any matching
		hostnames in that class C.  This generates a lot more traffic
		but can uncover a lot more information.
	-wordlist	Use a seperate wordlist (one word per line).  Usage:

	perl fierce.pl -dns examplecompany.com -wordlist dictionary.txt
EOHELP
exit;
}