perl.lt  
 
  Apie   Straipsniai   Funkcijos   Parsisiųsti   Nuorodos  
 
  Versija spausdinimui /Kodas/netcraft.pl - searchdns.netcraft.com sričių (max 500) išgavimas (panaudojant IO::Socket)./ Atgal  
 
 
#!/usr/bin/perl

# (c)left Algirdas @ perl.lt
# netcraft.pl v1.0 [2006.12.27]
#
# searchdns.netcraft.com sriciu (kiekvienos <= 500) isgavimas (panaudojant IO::Socket)
#
# !!! NENAUDOKITE TUREDAMI BLOGU KESLU, NESUPRASDAMI KA DAROTE IR BETKOKIU ATVEJU NENAUDOKITE !!!
#                     autorius uz jusu atliekamus veiksmus nera atsakingas
#
# priklausomai nuo ieskomo zodzio, viso gali buti daugiau nei 1000 http uzklausu i
# searchdns.netcraft.com (kas gali buti traktuojama kaip DOS ataka), ieskant sriciu:
#
# com net org biz info co.uk co.nz co.il net.nz org.uk org.il org.nz com.ph co.za za
# ws vu vg us uk tv to tc st sh ro ph nz ms lt kz jp il gs fm dk de cc ca be as ac
# pro eu mobi ae at br cat ch cl tw com.tw net.tw org.tw cn fi gr hk hu io is kr li
# lv museum no nu pl se tm tr vn
#
# naudojimas : perl $0 <zodis srityje>
#
# naudojimo pvz:
#
# $ perl netcraft.pl ktu.lt
# www.stud.ktu.lt
# www.ktu.lt
# www.soften.ktu.lt
# ...
#
# nustatymas paieskos tipo keitimui:
#
# site starts with
# $type='site%20starts%20with';
# site ends with
# $type='site%20ends%20with';
# subdomain matches
# $type='subdomain%20matches';
# site contains
$type = 'site%20contains';

use IO::Socket;
$host    = 'searchdns.netcraft.com';
@domains = (
    'lt',     'com',    'net',   'org',    'biz',    'info',
    'co.uk',  'co.nz',  'co.il', 'net.nz', 'org.uk', 'org.il',
    'org.nz', 'com.ph', 'co.za', 'za',     'ws',     'vu',
    'vg',     'us',     'uk',    'tv',     'to',     'tc',
    'st',     'sh',     'ro',    'ph',     'nz',     'ms',
    'kz',     'jp',     'il',    'gs',     'fm',     'dk',
    'de',     'cc',     'ca',    'be',     'as',     'ac',
    'pro',    'eu',     'mobi',  'ae',     'at',     'br',
    'cat',    'ch',     'cl',    'tw',     'com.tw', 'net.tw',
    'org.tw', 'cn',     'fi',    'gr',     'hk',     'hu',
    'io',     'is',     'kr',    'li',     'lv',     'museum',
    'no',     'nu',     'pl',    'se',     'tm',     'tr',
    'vn'
);

if ( $ARGV[0] ) { @domains = shift; }
else            { die "ko ieskosime?\n"; }
foreach $search (@domains) {
    $url = '/?restriction=' . $type . '&host=' . $search . '&position=limited';
    $testi = 1;
    while ( $testi == 1 ) {
        $testi = 0;
        $query =
            "GET $url HTTP/1.1\015\012"
          . "Host: $host\015\012"
          . "Accept:*/*\015\012"
          . "Accept-Language: en-us,en-gb;q=0.7,en;q=0.3\015\012"
          . "Pragma: no-cache\015\012"
          . "Cache-Control: no-cache\015\012"
          . "Referer: http://$host\015\012"
          . "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)\015\012"
          . "Connection: close\015\012\015\012";
        $sock = IO::Socket::INET->new(
            Proto    => "tcp",
            PeerAddr => "$host",
            PeerPort => "80"
        ) || die "nesusijunge..\n";
        print $sock $query;
        while (<$sock>) {
            s/<a href="http:\/\/toolbar.netcraft.com//eg;
            if (/<a href="http:\/\/(.*)\/">/) {
                print "$1\n";
            }
            elsif (
/<A href="http:\/\/searchdns.netcraft.com(.*)"><b>Next page<\/b><\/a>/
              )
            {
                $url = $1;
                $url =~ s/\ /'%20'/eg;
                $testi = 1;
            }
        }
        sleep(3);
    }
}
 
 
 
2005.04.11 - 2012.05.21 © algirdas@perl.lt  
  Perl.lt programavimo savaitgaliai | Reklaminiai skydeliai | Perl.lt kodas