[Perl] Прикрутить цикл

[gamer123]

Здравствуйте. Есть сканер директорий, нужно немного модифицировать, у самого не очень получается, нужна ваша помощь. Скрипт запускается с параметром script.pl www.site.ru и выводит в консоль результаты скана. Нужно убрать параметр, чтобы запускался script.pl просто, а урлы брал циклом из файла sites.txt, и выводил не в консоль, а тоже в файл, out.txt.

#!/usr/bin/perl -w

use strict;
use warnings;

use IO::Socket;
#use IO::Socket::SSL;
use Time::Local;

$| = 1;
####
# TODOs:
# [+] Parse sub
# [+] Head scan sub
# [+] Banner + Timestampts
# [+] Header analyzer; patch scanFiles sub; print server answer in each line; cookie grabber
# [+] Multiplie databases
# [+] update
####
# Database format:
# line [1] # Database_Name
# line [2] # 100% not existing file (e.g. n0l33tf1l3), for 404 probe request
# line [2] # /path1/
# line [3] # /path2/
# line [4] # /path3/
# line [5] # !!!SEP!!! #separator
# line [6] # file1
# line [i] # fileX
######################################################################################
### Config
my $userAgent = '[SSS] [PELMESHK0] uber-leet h4x0r v.1.0 (Linux, xorg)';
my $baseRoot = './'; #pelmeshko db
my $validateFile = "$baseRoot" . "updateCode";
my $SSL = 0;
my $port = 80;
my $path = '/';
my $cFile = 0;
my $url = 0;
my $host = 0;

my @goodAns = (200,401,203,403,302,301);
my @serverHeaders = ('Server', 'X-Powered-By', 'X-Server', 'Set-Cookie');

my $badAnsCode;
my $totalInd = 0;
my $firstTime = 1;
# sub scanFiles(ip, port, path, timeout, cookie)
# First scan method.
sub scanFiles {
#vars
  my $files; my $ans; my $cookie;
  my $firstTime = 1;
  my ($ip, $port, $path, $timeout, $cFile) = @_;
#databases loop
  foreach(glob("$baseRoot/*")) {
    chomp;
    my $baseCurr = $_;
    my $foundRoots; my $gotSep;
    open($files,"<$baseCurr") or warn "[x] files db open error. Quit.\n" and exit(1);
    my $dbName = <$files>; chomp $dbName;
    my @rootsFound; my $rootsFoundInd = 0;
    my $badAnsCode;
#main loop
    my $gotRoots; my $sep;
    my @foundRoots; my $foundRootsInd;
# 
    while (<$files>) {
      chomp();
      if ($_ eq '/') { $_ = ''; }
      if ($_ =~ /\/.{1,100}/) { $_ =~ s/\///; } #cut starting '/'
      my $scanFile = $_;
      if ($_ eq '!!!SEP!!!') {
        last unless $gotRoots;
        #print "[*] Sep dbg. \$gotRoots:$gotRoots; \$dbName:$dbName; @foundRoots;\n";
        $sep = 1;
        print "[*] Database $dbName:\n";
        foreach (@foundRoots) {
          print "[*]   Rootdir found: $ip$path$_\n";
        }
      }
#database parse
      unless ($sep) {
        my $ans = head($_); chomp $ans;
        my ($version, $ansCode, $text) = split (/ /, $ans); #chomp $text;
        if (matchAns($ansCode, $badAnsCode)) { 
          $foundRoots[$foundRootsInd++] = $_;
          $gotRoots = 1;
        }
        next;
      }

      foreach (@foundRoots) { 
        my $ans = head("$_$scanFile"); 
        my ($version, $ansCode, $text) = split (/ /, $ans); #chomp $text;
        if (matchAns($ansCode)) { print "[*]   [$ansCode] Found: $ip$path$_$scanFile \n"; } 
      }
#end of loop
    }
  }
  close COOK if $cFile;
  close $files;
}


getArgs;

[gamer123]

места форума нехватило, продолжение скрипта:

sub usage () {
  print '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #' . "\n";
  print "    SomeShitScan[pelmeshk0] hscan.pl - Advanced HEAD-Scaner.\n";
  print '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #' . "\n";
  print " Usage:   hscan [--update] [http://]somehost.net[:port][/path/]\n";
  print "          [https(1/0)] [COOK]\n";
  print " Example: hscan http://antichat.ru:443/ 1 cookies.txt\n";
  print "          hscan forum.antichat.ru\n";
  print '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #' . "\n";
  print "                                                [c]ode by Gh0s7\n";
  print '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #' . "\n";
  exit(0);
}

sub getArgs {
  $url = $ARGV[0];
  $SSL = $ARGV[1] and $port = 443 if $ARGV[1];
  $cFile = $ARGV[2] if $ARGV[2];
  checkUpdates() if $url =~ /--update/;
  #http://host.net:port/path
  $url =~ s!http.{0,1}://!!;
  #host.net:port/path
  if ($url =~ m!.{1,128}:[0-9]{1,5}/.{0,128}!) {
    my ($ip, $portPath) = split (/:/, $url);
    my @res = split(/\//, $portPath);
    $port = $res[0]; $res[0] = '';
    foreach (@res) { $path .= $_; }
    $host = $ip;
  #host.net/path
  } elsif ($url =~ m!.{1,128}/.{0,128}!) {
    my @res = split(/\//, $url);
    $host = $res[0]; $res[0] = '';
    foreach (@res) { $path .= $_; }
  #host.net:port
  } elsif ($url =~ m!.{1,128}:[0-9]{1,5}!) {
    ($host, $port) = split (/:/, $url);
  #host.net
  } else { $host = $url; }
  #$path .= '/'
  start();
  # sub scanFiles(ip, port, path, timeout, cookie)
  scanFiles($host, $port, $path, 0, $cFile); finish();
}

sub head {
  $totalInd++;
  my ($file) = @_;
  my $somesock; my $cookie;
  my $ip = $host;
  #cookie files
  if ($cFile) { 
    open (COOK, "<$cFile") and $cookie = <COOK> or warn "[!] Cookie file not found, skipping.\n" and undef($cFile);
  }

#ssl check
  if ($SSL) {
    $somesock = new IO::Socket::SSL (PeerAddr => $ip, PeerPort => $port, PeerProto => 'tcp', TimeOut => 10) or warn "[!] Connection failed\n" and exit(1);
  } else {
    $somesock = new IO::Socket::INET (PeerAddr => $ip, PeerPort => $port, PeerProto => 'tcp', TimeOut => 10) or warn "[!] Connection failed\n" and exit(1);
  }
    # Cookie: name=val; name2=val2;
#packet
my $server_check ="HEAD $path$file HTTP/1.1\n";
   $server_check.="Host: $ip\n";
   $server_check.="User-Agent: $userAgent\n"; chomp($cookie) if $cFile;
   $server_check.="Cookie: " . $cookie . "\n" if $cFile;
   $server_check.="Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\n";
   $server_check.="Accept-Language: en-us,en;q=0.5\n";
   $server_check.="Accept-Encoding: gzip,deflate\n";
   $server_check.="X-Forwarded-For: uber leet pelmeshko host\n";
   $server_check.="Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n\n";

  print $somesock $server_check;
  my $ans = <$somesock>;
  my $http;
#first-time checks, header analyzer
  if ($firstTime) { 
    print "[*] 404 Probe request to server. Server answering with $ans"; 
    $firstTime = 0 ; ($http, $badAnsCode) = split (/ /, $ans); #print "[*] [DBG] \$badAnsCode:$badAnsCode\n";
    my $firstHeaders = 1;
    while (<$somesock>) {
      chomp;
      my $socketStr = $_;
      foreach (@serverHeaders) {
        my ($headerName, $content) = split (/:/, $socketStr); 
        if ($headerName eq $_) { 
          print "[*] Server Headers:\n" and $firstHeaders = 0 if $firstHeaders; 
          if ($_ eq 'Set-Cookie') { print "[*]   Cookies:$content\n"; next; }
            print "[*]   $headerName:$content\n";
          }
        }
     }
  }
  close $somesock;
  return $ans;
}

[gamer123]

и снова:

sub checkUpdates {
  my $uptodate = 0;
  my ($pelmeshko, $lastCode, $validateCode);
  my $validateSock = new IO::Socket::INET (PeerHost => 'someshit.net', PeerPort => 80, PeerProto => 'tcp', TimeOut => 15) or warn "[x] Cant connect to someshit.net" and exit(0);
  my $headers = "Host: someshit.net\nUser-Agent:SSS Updater\nAccept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\n";
  open (CODE, "<$validateFile");
  $lastCode = <CODE>; chomp $lastCode; close CODE;
  print $validateSock "GET /sss/updateCode HTTP/1.1\n" . $headers . "\n";
  while (<$validateSock>) {
    chomp;
    if (/pelmeshko:.{1,128}/) {
      ($pelmeshko, $validateCode) = split (/:/, $_);
      if ($lastCode eq $validateCode) { print "[*] $0 version $lastCode is up-to-date; no updates required\n"; $uptodate = 1; last and exit(0); }
    }
  }

  unless ($uptodate) { 
    print "[*] You has $lastCode version. Last version is $validateCode\n";
    print "[*] Please, download new version from http://someshit.net/sss/pelmeshko.tgz\n";
  }
  exit(0);
}

sub start() {
  my $time = localtime();
  print '-' x 45;
  print "\n[i] Starting scan.\n";
  print "[i] Start time: $time\n";
  print "[i] Targer host/path: $host$path\n";
  print "[i] Targer port/SSL: $port | $SSL\n";
  print '-' x 45, "\n";
}

sub finish() {
  my $time = localtime();
  print '-' x 45, "\n";
  print "[*] Scan finished at $time. Total $totalInd objects scanned\n";
  print '-' x 45, "\n";
  exit(0); 
}

sub matchAns {
  my ($code) = @_; my $regexp;
  foreach (@goodAns) { if ($_ == $badAnsCode) { next; } $regexp .= $_ . '|'; } 
  chop $regexp; #print $regexp;
  if ($_[0] =~ /$regexp/) { 
   return 1; 
  } else {
    return 0;
  }
}

usage() unless $ARGV[0];

[ssdm]

Блин. Да проще новый написать чем модифицировать )
Напиши нормально что хочешь сделать, то есть что твой скрипт должен делать.

[ssdm]

Ну вроде что то переписал. У себя не проверял.
Разделитель для url в файле sites.txt - перевод каретки.

[gamer123]

Сообщение от ssdm

Ну вроде что то переписал. У себя не проверял.
Разделитель для url в файле sites.txt - перевод каретки.

Ошибка вылазит

me:~/e/lm# perl scan.pl
Bareword "getArgs" not allowed while "strict subs" in use at scan.pl line 109.
Execution of scan.pl aborted due to compilation errors.
me:~/e/lm#

что это может быть?

[ssdm]

Попробуй сейчас.

[gamer123]

Сообщение от ssdm

Попробуй сейчас.

perl temp.pl

такой вывод консоли идет, этот кусок повторяется бесконечное количество раз

Use of uninitialized value $ans in concatenation (.) or string at temp.pl line 192.[*] 404 Probe request to server. Server answering with Use of uninitialized value $ans in split at temp.pl line 193.
Use of uninitialized value $ans in scalar chomp at temp.pl line 83.
Use of uninitialized value $ans in split at temp.pl line 84.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $badAnsCode in numeric eq (==) at temp.pl line 254.
Use of uninitialized value $_[0] in pattern match (m//) at temp.pl line 256.

[ssdm]

пишет что какие то проблемы с подключением.
Так собственно что скрипт то должен делать ?