# BanCh v1.0 - check hosts for selected banners (available   #
# services is FTP, SMTP, HTTP). Provide multiline banner   #
# grabbing mode. Can help you with searching vulnerable systems #
# Work quite fast, because of using non-block sockets.          #
# Written on PERL, and need only few standart PERL modules, so  #
# it must work on most servers. Have such features like:   #
# anonymous FTP logon checking, CGI scanning, email extracting   #
# (from html pages), etc.           #
# OS supported: Linux, may be unix clones, Windows is not.   #
# Was checked using perl v5.8.0 and v5.6.0      #
#                 #
# Copyright (c) 22/09/2004 LynX          #
#                #
# This program is free software; you can redistribute it and/or #
# modify it under the terms of the GNU General Public License   #
# as published by the Free Software Foundation.       #
#                 #
# For good purposes only :)          #
#                #
# Thanks:              #
# -------              #
#  nob0dy, Xarth, netc0de and all who know me      #
#                #
# Greets:              #
# -------              #
#  ROOT T34M [http://rootteam.void.ru]        #  
#                #
# P.S. Also sorry for my poor english.        #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#                                              Written by: LynX #
#                                                 <_LynX@bk.ru> #
#                           / close your eyes & dream with me / #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#                #

#! /usr/bin/perl

# global elements
#

## you can hide options, which can be see by 'ps -x' ##
#@ARGV = qw{BanCh.pl -http Server.* -http Date.* -ip 127.0.0.1} ;

## ftp anon ##
$Login = 'anonymous' ;
$Password = 'alice@wonder.ld' ;

## common service ports ##
$Ftp_port = 21 ;
$Smtp_port = 25 ;
$Http_port = 80 ;

## stuff, dont chng
$Separator = "-------------------------------------------------" ;
$Output_file = "BanCh.log" ;
@Host_Addrs = () ;
@Http_cmds = () ;
$Http_cmd = 0 ;
@Ftp_cmds = () ;
$Ftp_cmd = 0 ;
@Smtp_cmds = () ;
$Smtp_cmd = 0 ;
%Sockets ;
%Args = () ;
@Time = () ;
$OUTPUT = STDOUT ;

# check for "Socket" module
eval "require Socket" or 
die("$0: error: need \"Socket\" module, you can download it ".
    "from [http://www.perl.com/CPAN-local/modules].\n") ;
use Socket ;

# check for "Fcntl" module
eval "require Fcntl" or 
die("$0: error: need \"Fcntl\" module, you can download it ".
    "from [http://www.perl.com/CPAN-local/modules].\n") ;
use Fcntl ;

# trap for some signals ;)
$SIG{KILL} = $SIG{INT} = $SIG{HUP} = \&atexit ; 

# procedures & functions
#
# sub error
# sub atexit
# sub usage
# sub getopts
# sub get_hosts
# sub read_file
# sub nonblock_sockets
# sub exam
# sub pattern_extract
# sub exam_ftp
# sub exam_smtp
# sub exam_http


sub error
#
# Print error mesg && die.
#
{
 my ($txt) = @_ ;

 print "$0: error: $txt\n" ;  
 exit 1 ;

} # sub error


sub atexit
#
# Make some actions before programm is go to shutdown
#
{
 print "\n" ;

 # this realization of timer is bad :) 
 $min = 0 ;
 $hour = 0 ;
 $sec = 0 ;
 $sec = $Time[2] * 3600 + $Time[1] * 60 + $Time[0] ;
 (@buf) = (localtime(time))[0,1,2];
 $sec = ($buf[2] * 3600 + $buf[1] * 60 + $buf[0]) - $sec ;
 while ($sec > 0)
 {
  $sec -= 60 ;
  if ($sec >= 0) { $min++ ; }
  if ($min >= 60)
  {
   $min = 0 ;
   if ($hour++ >= 60) 
   {
    $hour = 0 ;
   }
  }
 }
 if ($sec < 0) { $sec += 60 ; }
 print "Total time: $hour \bh $min \bm $sec \bs\n" ; 
 close($OUTPUT) ;
 exit 0 ;

} # sub atexit


sub usage 
#
# usage() -- show info about options etc.
#
{

 print q
 { 
 BanCh - check hosts for selected banners. Can help you with 
searching vulnerable systems.
 } ;
 print "\n\bUsage: $0 options\n" ;
 print q
 {
Options:

 -ftp [banner1] [-ftp [bannerN]] -- show hosts, which has one of
 this FTP banners, banners can be specified by using PERL 
 patterns, which must be concluded in '' (ex. ".?*" and others). 
 You also can use just "-ftp" option (without 
 [banner1,...,bannerN]), in this case all banners, will be showed.
 -anon  -- check if FTP anonymous login is allow (multiline 
 grabbing mode will be automatically on).
 -ftp_f <file_name> -- sets file with banners list (one line - 
 one banner), PERL patterns are allowed (dont use ''). This 
 option substitutes option "-ftp".
 -ftp_cmd_f <file_name> -- sets file with list of FTP commands 
 (one line - one command), which will be executed, after 
 successfully logining (option "-anon" must be setted, if you 
 want to use special account insted of anonymous, you must edit 
 sources of the programm). 
 -smtp [banner1] [-smtp [bannerN]] -- show hosts, which has one 
 of this SMTP banners, banners can be specified by using PERL 
 patterns, which must be concluded in '' (ex. ".?*" and others). 
 You also can use just "-smtp" option (without 
 [banner1,...,bannerN]), in this case all banners, will be showed.
 -smtp_f <file_name> -- sets file with banners list (one line - 
 one banner), PERL patterns are allowed (dont use ''). This 
 option substitutes option "-smtp".
 -smtp_cmd_f <file_name> -- sets file with list of SMTP commands 
 (one line - one command), which will be executed, after 
 successful connecting.
 -http [banner1] [-http [bannerN]] -- show hosts, which has one 
 of this HTTP banners, banners can be specified by using PERL 
 patterns, which must be concluded in '' (ex. ".?*" and others). 
 You also can use just "-http" option (without 
 [banner1,...,bannerN]), in this case all banners, will be showed.
 -http_f <file_name> -- sets file with banners list (one line - 
 one banner), PERL patterns are allowed (dont use ''). This 
 option substitutes option "-http".
 -http_cmd_f <file_name> -- sets file with list of HTTP commands
 (one line - one command), which will be executed, after 
 successful connecting.
 -c <number> -- amout of non-block sockets (default 5).
 -m -- turn multiline banner grabbing mode.
 -ts <seconds> -- how long we will be working with every socket 
 (default 10 sec). 
 -tc <seconds> -- specify timeout of connections (default 10 sec).
 -o [file] -- sets output file (default "BanCh.log").
 -i <file_name> -- sets file with hosts list (one line - one 
 host), file also can contain comments (text which going after 
 "#"). You also can use this option with "-ip".
 -ip <ip_address1,...,ip_addressN> -- select ip addresses,
 which will be checked for selected banners. You also can
 specify ip addresses range [ip_address1-ip_address2]; type 
 domain names instead of ip addresses (* this version does not 
 support domain names with "-" symbol *).

Examples: 

 [LynX BanCh]$ perl BanCh.pl -http 'Server:.*' -http 'Date.*' \
 > -ftp -anon -m -ip 127.0.0.1

 [ BanCh started ]


 [##] 127.0.0.1:21
 -------------------------------------------------
 220 ProFTPD 1.2.2rc1 Server (ProFTPD Default Installationnsfgdsfnsdfgn) [localhost.localdomain]
 
 [##] 127.0.0.1:80
 -------------------------------------------------
 Server: Apache-AdvancedExtranetServer/1.3.19 (Linux-Mandrake/3mdk)
 Date: Wed, 22 Sep 2004 10:01:25 GMT


 Total time: 0h 0m 0s
 [LynX BanCh]$ 

To extract domain names, from html:

 [LynX BanCh]$ perl BanCh.pl -http 'www\.\w+\.\w+' \
 >-http_cmd "GET /search ?q=someone&hl=uk&lr=&ie=UTF-8&start
 >=10&sa=N HTTP/1.0" -ip www.google.com.ua

 [ BanCh started ]


 [##] www.google.com.ua:80
 -------------------------------------------------
 www.google.com www.google.com
 www.metanoia.org
 www.metanoia.org www.metanoia.org www.metanoia.org www.amazon.com
 www.amazon.com www.amazon.com www.amazon.com www.amazon.com
 www.amazon.com www.amazon.com www.amazon.com www.amazon.com www.amazon.com
 www.cdc.gov
 www.cdc.gov www.cdc.gov www.cdc.gov
 www.imdb.com
 www.imdb.com www.imdb.com www.imdb.com www.imdb.com www.imdb.com


 Total time: 0h 0m 5s
 [LynX BanCh]$ 

To make CGI scanning, you must write, all "GET" commands in file
(it is not difficult using such utils like "awk", "sed")

 [LynX BanCh]$ cat cmds
 GET /cgi-bin/test.cgi HTTP/1.0
 GET /cgi-bin/web_store.cgi HTTP/1.0
 GET /search HTTP/1.0
 [LynX BanCh]$ perl BanCh.pl -http '200 OK' -http_cmd_f \
 > cmds -ip www.google.com.ua

 [ BanCh v1.0 started ]


 [##] www.google.com.ua:80: GET /search HTTP/1.0
 -------------------------------------------------
 200 OK


 Total time: 0h 0m 4s
 [LynX BanCh]$ 

} ; # print q{...}

 exit(0) ;

} # sub usage


sub getopts
#
# Return %args, in which every option have its own argument.
#
{
 my ($options, @arg) = @_ ;
 my $count = 0 ;
 my $multi = 1 ;

 @options = split(/ /, $options) ;

 # extract all arguments
 while ($arg = @arg[$count]) 
 {
  chomp $arg ;
  foreach $option(@options)
  {
   if ($option eq "|") { $multi = 0 ; }
   if ("$arg" eq "$option") 
   { 
    $buff = substr(@arg[++$count], 0, 1) ;
    ($Args{$option} = "") if ($buff eq "-") ; 
    if ($multi)
    {
     ($Args{$option} .= @arg[$count]."\n") if ($buff ne "-") ; 
    }
    else
    {
     ($Args{$option} = @arg[$count]) if ($buff ne "-") ; 
    }
    goto cont ;
   } # if ($arg eq $option)
  } # foreach $option(@options)
  $multi = 1 ;
  $count++ ;
  cont: ;
 } # while ($arg = @arg[$count])

} # sub getopts


sub get_hosts
#
# @Host_Addrs = get_hosts(HOSTS) -- check format of typed ip 
# addresses in HOSTS and add them in array of hosts
# which will be returned.
#
{
 my ($from_file) = @_ ;
 my $hosts_file = $Args{"-i"} ;
 my @tmp_addrs = () ;
 my $max = 254 ;

 # get hosts
 if ($from_file)
 {
  @Host_Addrs = read_file($Args{"-i"}, 0) ;
 }
 else
 {
  push(@Host_Addrs, split(/,/, $Args{"-ip"})) ;
 }
 
 # and check hosts format(',','-' etc.)
 foreach $host_addr(@Host_Addrs)
 {

  # if its a simple ip address
  if ($host_addr =~m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/)
  {

   # if its a range of ip addresses
   if ($host_addr =~m/\-/)
   {
    # get start ip
    @start = split(/\./, substr($host_addr, 0,
                        index($host_addr,'-'))) ;
    # get end ip
    @end = split(/\./, substr($host_addr, 
                 index($host_addr,'-') + 1, length($host_addr))) ;

    # and get all ip from this range :) "Praid for us" :))
    for (;@start[0] < @end[0] ; @start[0]++, @start[1] = 0)
    {
     for (;@start[1] < $max ; @start[1]++, @start[2] = 0)
     {
      for (;@start[2] < $max ; @start[2]++, @start[3] = 1)
      {
       for (;@start[3] < $max ; @start[3]++)
       {
        push(@tmp_addrs, join('.', @start)) ;
       } # for (;@start[3] < $max ; @start[3]++)
      } # for (;@start[2] < $max ; @start[2]++, @start[3] = 1)
     } # for (;@start[1] < $max ; @start[1]++, @start[2] = 0)
    } # for (;@start[0] < @end[0] ; @start[0]++, @start[1] = 0)
    #
    for (;@start[1] < @end[1] ; @start[1]++, @start[2] = 0)
    {
     for (;@start[2] < $max ; @start[2]++, @start[3] = 1)
     {
      for (;@start[3] < $max ; @start[3]++)
      {
       push(@tmp_addrs, join('.', @start)) ;
      } # for (;@start[3] < $max ; @start[3]++)
     } # for (;@start[2] < $max ; @start[2]++, @start[3] = 1)
    } # for (;@start[1] < @end[1] ; @start[1]++, @start[2] = 0)
    #
    for (;@start[2] < @end[2] ; @start[2]++, @start[3] = 1)
    {
     for (;@start[3] < $max ; @start[3]++)
     {
      push(@tmp_addrs, join('.', @start)) ;
     } # for (;@start[3] < $max ; @start[3]++)
    } # for (;@start[2] < @end[2] ; @start[2]++, @start[3] = 1)
    #
    for (;@start[3] <= @end[3] ; @start[3]++)
    {
     push(@tmp_addrs, join('.', @start)) ;
    } # for (;@start[3] <= @end[3] ; @start[3]++)
   } # if ($host_addr =~m/\-/)
   else
   {
    push(@tmp_addrs, $host_addr) ;
   } # else if ($host_addr =~m/\-/)

  } # if ($host_addr =~m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/)

  else

  {
   push(@tmp_addrs, $host_addr) ;
  } 

 } # foreach $host_addr(@Host_Addrs)

 @Host_Addrs = @tmp_addrs ;

} # sub get_hosts


sub read_file
#
# Read data from file, and return it
#
{
 my ($file, $newline) = @_ ;
 my (@data) = () ;
 
 if (not -f $file) { error("File \"$file\" does not exist") ; }
 open(FILE, "$file") or 
   error("Cant open file \"$file\": $!") ;
 while (<FILE>) 
 {
  if (m/^#/) { next ; }
  if (!$newline) { chomp ; }
  push(@data, $_) ;
 }
 close(FILE) ;
 
 return(@data) ;
 
} # sub read_file


sub nonblock_sockets
#
# Create $socks_num sockets, setted to NONBLOCK mode,
# and write them in %Sockets (host->socket)
#
{
 my ($num_of_host, $port, $num_of_con) = @_ ;
 my $sockets_num = $Args{"-c"} ;
 my $i = 0 ;
 my $rin = '' ;
 my $win = '' ;
 %Sockets = () ;

 # creating array of NON-BLOCK sockets
 for ($ii = 0 ; $ii < $sockets_num && 
                $$num_of_host < @Host_Addrs ; $ii++) 
 {
  
  if ($$num_of_con < 0)
  { 
   $socket = \$Sockets{$Host_Addrs[$$num_of_host]} ;
  } 
  else 
  {
   $socket = \$Sockets{$Host_Addrs[$$num_of_host]}[$i] ;
  }

  if (!socket($$socket, PF_INET, 
              SOCK_STREAM, getprotobyname("tcp")))
  {
   print $OUTPUT "[##] $Host_Addrs[$$num_of_host]:$port: Cant ".
                 "create the socket: $!\n$Separator\n\n" ;
   print "$Host_Addrs[$$num_of_host]:$port ... done\n" 
      if ($OUTPUT ne STDOUT) ;
   $ii-- ;
   delete($Sockets{$Host_Addrs[$$num_of_host]}) ;
   $$num_of_host += 1 ;
   next ;
  }
  $iaddr = inet_aton($Host_Addrs[$$num_of_host]) ;
  if (!$iaddr) 
  { 
   print $OUTPUT "[##] $Host_Addrs[$$num_of_host]:$port: Cant ".
                 "resolv host: $!\n$Separator\n\n" ;
   print "$Host_Addrs[$$num_of_host]:$port ... done\n" 
      if ($OUTPUT ne STDOUT) ;
   $ii-- ;
   delete($Sockets{$Host_Addrs[$$num_of_host]}) ;
   $$num_of_host += 1 ;
   close($$socket) ;
   next ;   
  }
  $saddr = sockaddr_in($port, $iaddr) ;
  if (!fcntl($$socket, F_SETFL, 
             O_NONBLOCK))
  {
   print $OUTPUT "[##] $Host_Addrs[$$num_of_host]:$port: Cant set".
                 "socket on NONBLOCK mode: $!\n$Separator\n\n" ;
   print "$Host_Addrs[$$num_of_host]:$port ... done\n" 
      if ($OUTPUT ne STDOUT) ;
   $ii-- ;
   delete($Sockets{$Host_Addrs[$$num_of_host]}) ;
   $$num_of_host += 1 ;
   close($$socket) ;
   next ;
  }  
  connect($$socket, $saddr) ;
  vec($win, fileno($$socket), 1) = 1 ; 
  vec($rin, fileno($$socket), 1) = 1 ; 

  if ($$num_of_con < 0) { $$num_of_host++ ; } 
  else 
  { 
   $i++ ;
   if (not --$$num_of_con) 
   { 
    $$num_of_host++ ;
    $$num_of_con = @Http_cmds ;
    $Http_cmd = 0 ;
    last ; 
   } 
  }

 } # for ($ii = 0 ; $ii < $sockets_num && ...) 

 return($rin, $win) ;

} # sub nonblock_sockets


sub exam
#
# Exam sockets which ready to RW
# 
{
 my ($rin, $win, $port, $func, $num_of_con) = @_ ;
 my $timeout_connect = $Args{"-tc"} ;
 my $ii = ($num_of_con < 0)?keys(%Sockets):
                            @{$Sockets{(keys(%Sockets))[0]}} ;
 my $i = 0 ; 

 while ($nfound = select($rout = $$rin, $wout = $$win, undef, 
                         $timeout_connect) >= 0)
 {   

  if ($nfound == 0) { next ; }
  $ii -= $nfound ;

  foreach $host(keys %Sockets)
  {

   @sockets = ();
   if ($num_of_con < 0) { push(@sockets, $Sockets{$host}) ; } 
   else { push(@sockets, @{$Sockets{$host}}) ; }

   foreach $socket(@sockets)
   {    

    if (not $nfound) { last ; }
    if (vec($rout,fileno($socket),1) || vec($wout,fileno($socket),1))
    {
 
     if (!getpeername($socket))
     {
      print $OUTPUT "[##] $host:$port: Cant create connection\n".
                    "$Separator\n\n" ;      
      print "$host:$port ... done\n" if ($OUTPUT ne STDOUT) ;
     }
     else
     {
      &$func($host, $socket) ;
     }

     if ($num_of_con < 0) { delete($Sockets{$host}) ; } 
     else 
     { 
      if (++$i >= @{$Sockets{$host}}) 
      { 
       delete($Sockets{$host}) ;
      }
     } 
     vec($$rin,fileno($socket),1) = 0 ;
     vec($rout,fileno($socket),1) = 0 ;
     vec($$win,fileno($socket),1) = 0 ;
     vec($wout,fileno($socket),1) = 0 ;
     close($socket) ;
     $nfound-- ;
 
    } # if (vec($rout,fileno($socket),1))    

   } # foreach $socket(@sockets)

  } # foreach $host(keys %Sockets)

  if (not $ii) { last ; }
 
 } # while ($nfound = select(...) >= 0)
  
 while (($host) = each %Sockets)
 {
  @sockets = ();
  if ($num_of_con < 0) { push(@sockets, $Sockets{$host}) ; } 
  else { push(@sockets, @{$Sockets{$host}}) ; }
  foreach $socket(@sockets)
  {    
   print $OUTPUT "[##] $host:$port: Connection timeout\n".
                 "$Separator\n\n" ;      
   print "$host:$port ... done\n" if ($OUTPUT ne STDOUT) ;
   close($socket) ; 
  }
  delete($Sockets{$host}) ; 
 }

 return ;

} # sub exam


sub pattern_extract
#
# Extracts patterns from readed text
#
{
 my ($host, $port, $msg, $lines, $patterns) = @_ ;

 if (not @$patterns) 
 {
  print $OUTPUT "[##] $host:$port$msg\n$Separator\n$$lines\n\n" ;
  print "$host:$port ... done\n" if ($OUTPUT ne STDOUT) ;
 }
 else
 {
  $y = 0 ;
  foreach $pattern(@$patterns)
  {
   (@banner_lines) = split(/\n/, $$lines) ;
   foreach $line(@banner_lines)
   {
    (@founded) = ($line =~ m/$pattern/g) ;
    if (@founded ne 0)
    {
     if ($y == 0)
     {
      print $OUTPUT "[##] $host:$port$msg\n$Separator\n" ;
      $y++ ;
     }
     print $OUTPUT "@founded\n" ;
    }
   }
  }
  if ($y) { print $OUTPUT "\n" ; }  
  print "$host:$port ... done\n" if ($OUTPUT ne STDOUT) ;
 }

 return ;

} # sub pattern_extract


sub exam_ftp
#
# Make ftp examination: get banners, check if anonymous login
# avalible.
#
{
 my ($host, $sock) = @_ ;
 my $anon_login = 1 if exists($Args{"-anon"}) ;
 my $timeout_sock = $Args{"-ts"} ;
 my $multiline = 1 if exists($Args{"-m"}) ;
 my $anon ; 

 if (exists($Args{"-ftp_f"}))
 {
  if ($Args{"-ftp_f"} ne "")
  {
   @patterns = read_file($Args{"-ftp_f"}, 1) ;
  }
 }
 else
 {
  @patterns = split(/\n/, $Args{"-ftp"}) ; 
 }

 $SIG{ALRM} = sub { die "time to die\n" } ;

 eval 
 { 

  alarm($timeout_sock) ;  
  fcntl($sock, F_SETFL, 0) ;    
  $banner = <$sock> ;
  if ($multiline || $anon_login)
  {
   if ($banner =~ /^\d*-/) 
   {
    $_ = <$sock> ;
    while (not /^\d+\s/)
    {
     $_ = <$sock> ;
     $banner .= $_ ;
    }
   }
  }
  if ($anon_login) 
  {
   send($sock, "USER $Login\n", 0) ;
   <$sock> ;
   send($sock, "PASS $Password\n", 0) ;
   $_ = <$sock> ;
   $anon = ": anonymous ok o.b. ;)" if $_ =~ m/230/ ;
  }

  if (@Ftp_cmds)
  {
   foreach $cmd(@Ftp_cmds)
   { 
    send($sock, $cmd, 0) ;
    $_ = <$sock> ;
    if ($banner =~ /^\d*-/) 
    {
     $banner .= $_ ;
     $_ = <$sock> ;
     while (not /^\d+\s/)
     {
      $_ = <$sock> ;
      $banner .= $_ ;
     }
    }
    else
    {
     $banner .= $_ ;
    }
   }
  } 
    
  chomp($banner) ;
  alarm(0) ;

 } ; # eval 

 if ($@) 
 {
  die unless $@ eq "time to die\n" ;
  if ($banner eq "")     
  {
   print $OUTPUT "[##] $host:$Ftp_port: Stopped, time is out\n".
                 "$Separator\n\n" ; 
   print "$host:$Ftp_port ... done\n" if ($OUTPUT ne STDOUT) ;
   return ;
  }
 }

 pattern_extract($host, $Ftp_port, $anon, 
                 \$banner, \@patterns) ;

 return ;

} # sub exam_ftp


sub exam_smtp
#
# Make smtp examination.
#
{
 my ($host, $sock) = @_ ;
 my $multiline = 1 if exists($Args{"-m"}) ;
 my $timeout_sock = $Args{"-ts"} ;

 if (exists($Args{"-smtp_f"}))
 {
  if ($Args{"-smtp_f"} ne "")
  {
   @patterns = read_file($Args{"-smtp_f"}, 1) ;
  }
 }
 else
 {
  @patterns = split(/\n/, $Args{"-smtp"}) ; 
 }

 $SIG{ALRM} = sub { die "time to die\n" } ;

 eval 
 { 

  alarm($timeout_sock) ;
  fcntl($sock, F_SETFL, 0) ;    
  $banner = <$sock> ;
  if ($multiline)
  {
   if ($banner =~ /^\d*-/) 
   {
    $_ = <$sock> ;
    while (not /^\d+\s/)
    {
     $_ = <$sock> ;
     $banner .= $_ ;
    }
   }
  }

  if (@Smtp_cmds)
  {
   foreach $cmd(@Smtp_cmds)
   { 
    send($sock, $cmd, 0) ;
    $_ = <$sock> ;
    if ($banner =~ /^\d*-/) 
    {
     $banner .= $_ ;
     $_ = <$sock> ;
     while (not /^\d+\s/)
     {
      $_ = <$sock> ;
      $banner .= $_ ;
     }
    }
    else
    {
     $banner .= $_ ;
    }
   }
  } 

  chomp($banner) ;
  alarm(0) ;

 } ; # eval 

 if ($@) 
 {
  die unless $@ eq "time to die\n" ;
  if ($banner eq "")     
  {
   print $OUTPUT "[##] $host:$Smtp_port: Stopped, time is out\n".
                 "$Separator\n\n" ; 
   print "$host:$Smtp_port ... done\n" if ($OUTPUT ne STDOUT) ;
   return ;
  }
 }

 pattern_extract($host, $Smtp_port, "", \$banner, \@patterns) ;

 return ;

} # sub exam_smtp


sub exam_http
#
# Make http examination, get banners etc.
#
{
 my ($host, $sock) = @_ ;
 my $cmd = ($Args{"-http_cmd"} eq "")?"GET / HTTP/1.0":
           $Args{"-http_cmd"} ;
 my $timeout_sock = $Args{"-ts"} ;
 my $end_query = "\015\012\015\012" ;

 if (exists($Args{"-http_cmd_f"}))
 {
  $cmd = $Http_cmds[$Http_cmd++] ;
 }
 if (exists($Args{"-http_f"}))
 {
  if ($Args{"-http_f"} ne "")
  {
   @patterns = read_file($Args{"-http_f"}, 1) ;
  }
 }
 else
 {
  @patterns = split(/\n/, $Args{"-http"}) ; 
 }

 $SIG{ALRM} = sub { die "time to die\n" } ;

 eval 
 { 

  alarm($timeout_sock) ;
  fcntl($sock, F_SETFL, 0) ;    
  send($sock, "$cmd$end_query", 0) ;
  $banner = '' ;
  while (<$sock>)
  {
   $banner .= "$_" ;
  }
  alarm(0) ;

 } ; # eval  

 if ($@) 
 {
  die unless $@ eq "time to die\n" ;
  if ($banner eq "")     
  {
   print $OUTPUT "[##] $host:$Http_port: Stopped, time is out\n".
                 "$Separator\n\n" ; 
   print "$host:$Http_port ... done\n" if ($OUTPUT ne STDOUT) ;
   return ;
  }
 }

 pattern_extract($host, $Http_port, ": $cmd", \$banner, \@patterns) ;
 
 return ; 

} # sub exam_http


#
# Main function
#
{

 # check arguments
 if (@ARGV < 1) { &usage() ; }
 @Time = (localtime(time))[0,1,2];
 print "\n\033[32m[ BanCh v1.0 started ]\033[0m\n\n\n" ;

 # get %args (option => argument)
 getopts("-ftp -smtp -http | -ftp_f -anon -smtp_f -m -tc -ts ".
         "-http_cmd -smtp_cmd_f -ftp_cmd_f -http_cmd_f -c -ip".
         " -i -o -http_f", @ARGV) ;

 # set default values
 if (($Args{"-c"} eq "") or not(exists $Args{"-c"})) 
 {
  $Args{"-c"} = 5 ;
 }
 if (($Args{"-tc"} eq "") or not(exists $Args{"-tc"})) 
 {
  $Args{"-tc"} = 10 ; 
 }
 if (($Args{"-ts"} eq "") or not(exists $Args{"-ts"})) 
 {
  $Args{"-ts"} = 10 ; 
 }

 # get host addresses
 if (not(exists $Args{"-i"}) && not(exists $Args{"-ip"}))
 {
  error("You must specify host addresses") ;
 }
 if ($Args{"-i"} ne "")
 {
  error("Input file does not exist") 
   if not(-f $Args{"-i"}) ;
  get_hosts(1) ;
 }
 elsif (exists $Args{"-i"} && ($Args{"-i"} eq ""))
 {
  error("Specify file name with host addresses") ;
 }
 if ($Args{"-ip"} ne "")
 {
  get_hosts(0) ;
 }
 else
 { 
 # random generate in the next version %)
 }
 
 # output file mode
 if (exists($Args{"-o"}) && $Args{"-o"} eq "")
 {
  $Args{"-o"} = $Output_file ;
 }
 if ($Args{"-o"} ne "") 
 {       
  $OUTPUT = 0 ;
  open($OUTPUT, '>'.$Args{"-o"}) or 
  warn("$0: warning: Cant create output file ".$Args{"-o"}.": ".
       "$!: All info will go to STDOUT\n\n"), $OUTPUT = STDOUT ;
 }

 ## start to show checked banners ##

 # FTP
 if (exists($Args{"-ftp"}) || exists($Args{"-ftp_f"}))
 {
  if (exists($Args{"-ftp_cmd_f"}) && $Args{"-ftp_cmd_f"} ne "")
  {
   @Ftp_cmds = read_file($Args{"-ftp_cmd_f"}, 1) ;
  }
  for ($num_of_host = 0 ; $num_of_host < @Host_Addrs ;) 
  {
   ($rin, $win) = nonblock_sockets(\$num_of_host, $Ftp_port, \-1) ;
   if (keys %Sockets == 0) { next ; }
   exam(\$rin, \$win, $Ftp_port, \&exam_ftp, -1) ;
  }
 }

 # SMTP
 if (exists($Args{"-smtp"}) || exists($Args{"-smtp_f"}))
 {
  if (exists($Args{"-smtp_cmd_f"}) && $Args{"-smtp_cmd_f"} ne "")
  {
   @Smtp_cmds = read_file($Args{"-smtp_cmd_f"}, 1) ;
  }
  for ($num_of_host = 0 ; $num_of_host < @Host_Addrs ;) 
  {
   ($rin, $win) = nonblock_sockets(\$num_of_host, $Smtp_port,
                                   \-1) ;
   if (keys %Sockets == 0) { next ; }
   exam(\$rin, \$win, $Smtp_port, \&exam_smtp, -1) ;
  }
 }

 # HTTP
 if (exists($Args{"-http"}) || exists($Args{"-http_f"}))
 {
  if (exists($Args{"-http_cmd_f"}) && $Args{"-http_cmd_f"} ne "")
  {
   @Http_cmds = read_file($Args{"-http_cmd_f"}, 1) ;
  }
  $connects = (@Http_cmds)?@Http_cmds:-1 ;
  for ($num_of_host = 0 ; $num_of_host < @Host_Addrs ;) 
  {
   ($rin, $win) = nonblock_sockets(\$num_of_host, $Http_port,
                                   \$connects) ;
   if (keys %Sockets == 0) { next ; }
   exam(\$rin, \$win, $Http_port, \&exam_http, $connects) ;
  }
 }

 # ATEXIT 
 atexit() ;
 exit(0) ;
 
} # main function


# LynX <_LynX@bk.ru>
# *EOF*