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