dslinux/user/perl/lib/Net/Ping/t 100_load.t 110_icmp_inst.t 120_udp_inst.t 130_tcp_inst.t 140_stream_inst.t 150_syn_inst.t 190_alarm.t 200_ping_tcp.t 250_ping_hires.t 300_ping_stream.t 400_ping_syn.t 410_syn_host.t 450_service.t 500_ping_icmp.t 510_ping_udp.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:53 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Net/Ping/t
In directory antilope:/tmp/cvs-serv17422/lib/Net/Ping/t
Added Files:
100_load.t 110_icmp_inst.t 120_udp_inst.t 130_tcp_inst.t
140_stream_inst.t 150_syn_inst.t 190_alarm.t 200_ping_tcp.t
250_ping_hires.t 300_ping_stream.t 400_ping_syn.t
410_syn_host.t 450_service.t 500_ping_icmp.t 510_ping_udp.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: 500_ping_icmp.t ---
# Test to perform icmp protocol testing.
# Root access is required.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
if (($> and $^O ne 'VMS' and $^O ne 'cygwin')
or ($^O eq 'MSWin32'
and Win32::IsWinNT())
or ($^O eq 'VMS'
and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) {
skip "icmp ping requires root privileges.", 1;
} elsif ($^O eq 'MacOS') {
skip "icmp protocol not supported.", 1;
} else {
my $p = new Net::Ping "icmp";
ok $p->ping("127.0.0.1");
}
--- NEW FILE: 140_stream_inst.t ---
# Test to make sure object can be instantiated for stream protocol.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "stream";
ok !!$p;
--- NEW FILE: 450_service.t ---
# Testing service_check method using tcp and syn protocols.
BEGIN {
unless (eval "require IO::Socket") {
print "1..0 \# Skip: no IO::Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use strict;
use Test;
use Net::Ping;
# I'm lazy so I'll just use IO::Socket
# for the TCP Server stuff instead of doing
# all that direct socket() junk manually.
plan tests => 26, ($^O eq 'MSWin32' ? (todo => [18]) :
$^O eq "hpux" ? (todo => [9, 18]) : ());
# Everything loaded fine
ok 1;
# Start a tcp listen server on ephemeral port
my $sock1 = new IO::Socket::INET
LocalAddr => "127.0.0.1",
Proto => "tcp",
Listen => 8,
or warn "bind: $!";
# Make sure it worked.
ok !!$sock1;
# Start listening on another ephemeral port
my $sock2 = new IO::Socket::INET
LocalAddr => "127.0.0.1",
Proto => "tcp",
Listen => 8,
or warn "bind: $!";
# Make sure it worked too.
ok !!$sock2;
my $port1 = $sock1->sockport;
ok $port1;
my $port2 = $sock2->sockport;
ok $port2;
# Make sure the sockets are listening on different ports.
ok ($port1 != $port2);
$sock2->close;
# This is how it should be:
# 127.0.0.1:$port1 - service ON
# 127.0.0.1:$port2 - service OFF
#####
# First, we test using the "tcp" protocol.
# (2 seconds should be long enough to connect to loopback.)
my $p = new Net::Ping "tcp", 2;
# new() worked?
ok !!$p;
# Disable service checking
$p->service_check(0);
# Try on the first port
$p->{port_num} = $port1;
# Make sure it is reachable
ok $p -> ping("127.0.0.1");
# Try on the other port
$p->{port_num} = $port2;
# Make sure it is reachable
ok $p -> ping("127.0.0.1");
# Enable service checking
$p->service_check(1);
# Try on the first port
$p->{port_num} = $port1;
# Make sure service is on
ok $p -> ping("127.0.0.1");
# Try on the other port
$p->{port_num} = $port2;
# Make sure service is off
ok !$p -> ping("127.0.0.1");
# test 11 just finished.
#####
# Lastly, we test using the "syn" protocol.
$p = new Net::Ping "syn", 2;
# new() worked?
ok !!$p;
# Disable service checking
$p->service_check(0);
# Try on the first port
$p->{port_num} = $port1;
# Send SYN
if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";}
# IP should be reachable
ok $p -> ack();
# No more sockets?
ok !$p -> ack();
###
# Get a fresh object
$p = new Net::Ping "syn", 2;
# new() worked?
ok !!$p;
# Disable service checking
$p->service_check(0);
# Try on the other port
$p->{port_num} = $port2;
# Send SYN
if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";}
# IP should still be reachable
ok $p -> ack();
# No more sockets?
ok !$p -> ack();
###
# Get a fresh object
$p = new Net::Ping "syn", 2;
# new() worked?
ok !!$p;
# Enable service checking
$p->service_check(1);
# Try on the first port
$p->{port_num} = $port1;
# Send SYN
ok $p -> ping("127.0.0.1");
# Should have service on
ok ($p -> ack(),"127.0.0.1");
# No more good sockets?
ok !$p -> ack();
###
# Get a fresh object
$p = new Net::Ping "syn", 2;
# new() worked?
ok !!$p;
# Enable service checking
$p->service_check(1);
# Try on the other port
$p->{port_num} = $port2;
# Send SYN
if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";}
# No sockets should have service on
ok !$p -> ack();
--- NEW FILE: 510_ping_udp.t ---
# Test to perform udp protocol testing.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "udp";
ok $p->ping("127.0.0.1");
--- NEW FILE: 250_ping_hires.t ---
# Test to make sure hires feature works.
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
print "1..0 # Skip: network dependent test\n";
exit;
}
chdir 't' if -d 't';
@INC = qw(../lib);
}
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (eval "require Time::HiRes") {
print "1..0 \# Skip: no Time::HiRes\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 8;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "tcp";
# new() worked?
ok !!$p;
# Default is to not use Time::HiRes
ok !$Net::Ping::hires;
# Enable hires
$p -> hires();
ok $Net::Ping::hires;
# Make sure disable works
$p -> hires(0);
ok !$Net::Ping::hires;
# Enable again
$p -> hires(1);
ok $Net::Ping::hires;
# Test on the default port
my ($ret, $duration) = $p -> ping("localhost");
# localhost should always be reachable, right?
ok $ret;
# It is extremely likely that the duration contains a decimal
# point if Time::HiRes is functioning properly, except when it
# it is fast enough to be "zero".
print "# duration=[$duration]\n";
ok $duration =~ /\.|^0$/;
--- NEW FILE: 200_ping_tcp.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
print "1..0 # Skip: network dependent test\n";
exit;
}
chdir 't' if -d 't';
@INC = qw(../lib);
}
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
# Remote network test using tcp protocol.
#
# NOTE:
# Network connectivity will be required for all tests to pass.
# Firewalls may also cause some tests to fail, so test it
# on a clear network. If you know you do not have a direct
# connection to remote networks, but you still want the tests
# to pass, use the following:
#
# $ PERL_CORE=1 make test
use Test;
use Net::Ping;
plan tests => 13;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "tcp",9;
# new() worked?
ok !!$p;
# Test on the default port
ok $p -> ping("localhost");
# Change to use the more common web port.
# This will pull from /etc/services on UNIX.
# (Make sure getservbyname works in scalar context.)
ok ($p -> {port_num} = (getservbyname("http", "tcp") || 80));
# Test localhost on the web port
ok $p -> ping("localhost");
# Hopefully this is never a routeable host
ok !$p -> ping("172.29.249.249");
# Test a few remote servers
# Hopefully they are up when the tests are run.
ok $p -> ping("www.geocities.com");
ok $p -> ping("ftp.geocities.com");
ok $p -> ping("www.freeservers.com");
ok $p -> ping("ftp.freeservers.com");
ok $p -> ping("yahoo.com");
ok $p -> ping("www.yahoo.com");
ok $p -> ping("www.about.com");
--- NEW FILE: 150_syn_inst.t ---
# Test to make sure object can be instantiated for syn protocol.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "syn";
ok !!$p;
--- NEW FILE: 300_ping_stream.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
print "1..0 # Skip: network dependent test\n";
exit;
}
chdir 't' if -d 't';
@INC = qw(../lib);
}
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
if (my $port = getservbyname('echo', 'tcp')) {
socket(*ECHO, &Socket::PF_INET(), &Socket::SOCK_STREAM(), (getprotobyname 'tcp')[2]);
unless (connect(*ECHO, scalar &Socket::sockaddr_in($port, &Socket::inet_aton("localhost")))) {
print "1..0 \# Skip: loopback tcp echo service is off ($!)\n";
exit;
}
close (*ECHO);
} else {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
# Test of stream protocol using loopback interface.
#
# NOTE:
# The echo service must be enabled on localhost
# to really test the stream protocol ping. See
# the end of this document on how to enable it.
use Test;
use Net::Ping;
plan tests => 22;
my $p = new Net::Ping "stream";
# new() worked?
ok !!$p;
# Attempt to connect to the echo port
ok ($p -> ping("localhost"));
# Try several pings while it is connected
for (1..20) {
select (undef,undef,undef,0.1);
ok $p -> ping("localhost");
}
__END__
A simple xinetd configuration to enable the echo service can easily be made.
Just create the following file before restarting xinetd:
/etc/xinetd.d/echo:
# description: An echo server.
service echo
{
type = INTERNAL
id = echo-stream
socket_type = stream
protocol = tcp
user = root
wait = no
disable = no
}
Or if you are using inetd, before restarting, add
this line to your /etc/inetd.conf:
echo stream tcp nowait root internal
--- NEW FILE: 130_tcp_inst.t ---
# Test to make sure object can be instantiated for tcp protocol.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "tcp";
ok !!$p;
--- NEW FILE: 190_alarm.t ---
# Test to make sure alarm / SIGALM does not interfere
# with Net::Ping. (This test was derived to ensure
# compatibility with the "spamassassin" utility.)
# Based on code written by radu at netsoft.ro (Radu Greab).
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (eval {alarm 0; 1;}) {
print "1..0 \# Skip: alarm borks on $^O $^X $] ?\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use strict;
use Test;
use Net::Ping;
plan tests => 6;
# Everything compiled
ok 1;
eval {
my $timeout = 11;
ok 1; # In eval
local $SIG{ALRM} = sub { die "alarm works" };
ok 1; # SIGALRM can be set on this platform
alarm $timeout;
ok 1; # alarm() can be set on this platform
my $start = time;
while (1) {
my $ping = Net::Ping->new("tcp", 2);
# It does not matter if alive or not
$ping->ping("127.0.0.1");
$ping->ping("172.29.249.249");
die "alarm failed" if time > $start + $timeout + 1;
}
};
# Got out of "infinite loop" okay
ok 1;
# Make sure it died for a good excuse
ok $@ =~ /alarm works/ or die $@;
alarm 0; # Reset alarm
--- NEW FILE: 400_ping_syn.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
print "1..0 # Skip: network dependent test\n";
exit;
}
chdir 't' if -d 't';
@INC = qw(../lib);
}
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
unless (getservbyname('http', 'tcp')) {
print "1..0 \# Skip: no http port\n";
exit;
}
}
# Remote network test using syn protocol.
#
# NOTE:
# Network connectivity will be required for all tests to pass.
# Firewalls may also cause some tests to fail, so test it
# on a clear network. If you know you do not have a direct
# connection to remote networks, but you still want the tests
# to pass, use the following:
#
# $ PERL_CORE=1 make test
# Try a few remote servers
my $webs = {
# Hopefully this is never a routeable host
"172.29.249.249" => 0,
# Hopefully all these web ports are open
"www.geocities.com." => 1,
"www.freeservers.com." => 1,
"yahoo.com." => 1,
"www.yahoo.com." => 1,
"www.about.com." => 1,
"www.microsoft.com." => 1,
"127.0.0.1" => 1,
};
use strict;
use Test;
use Net::Ping;
plan tests => ((keys %{ $webs }) * 2 + 3);
# Everything loaded fine
ok 1;
my $can_alarm = eval {alarm 0; 1;};
sub Alarm {
alarm(shift) if $can_alarm;
}
Alarm(50);
$SIG{ALRM} = sub {
ok 0;
die "TIMED OUT!";
};
my $p = new Net::Ping "syn", 10;
# new() worked?
ok !!$p;
# Change to use the more common web port.
# (Make sure getservbyname works in scalar context.)
ok ($p -> {port_num} = getservbyname("http", "tcp"));
foreach my $host (keys %{ $webs }) {
# ping() does dns resolution and
# only sends the SYN at this point
Alarm(50); # (Plenty for a DNS lookup)
if (!ok $p -> ping($host)) {
print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n";
}
}
Alarm(20);
while (my $host = $p->ack()) {
if (!ok $webs->{$host}) {
print STDERR "SUPPOSED TO BE DOWN: http://$host/\n";
}
delete $webs->{$host};
}
Alarm(0);
foreach my $host (keys %{ $webs }) {
if (!ok !$webs->{$host}) {
print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n";
}
}
--- NEW FILE: 110_icmp_inst.t ---
# Test to make sure object can be instantiated for icmp protocol.
# Root access is required to actually perform icmp testing.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
if (($> and $^O ne 'VMS' and $^O ne 'cygwin')
or ($^O eq 'MSWin32'
and Win32::IsWinNT())
or ($^O eq 'VMS'
and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) {
skip "icmp ping requires root privileges.", 1;
} elsif ($^O eq 'MacOS') {
skip "icmp protocol not supported.", 1;
} else {
my $p = new Net::Ping "icmp";
ok !!$p;
}
--- NEW FILE: 120_udp_inst.t ---
# Test to make sure object can be instantiated for udp protocol.
# I do not know of any servers that support udp echo anymore.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'udp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
}
use Test;
use Net::Ping;
plan tests => 2;
# Everything loaded fine
ok 1;
my $p = new Net::Ping "udp";
ok !!$p;
--- NEW FILE: 100_load.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.t'
######################### We start with some black magic to print on failure.
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
}
use Test;
BEGIN { plan tests => 1; $loaded = 0}
END { ok $loaded;}
# Just make sure everything compiles
use Net::Ping;
$loaded = 1;
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
--- NEW FILE: 410_syn_host.t ---
# Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ).
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
print "1..0 # Skip: network dependent test\n";
exit;
}
chdir 't' if -d 't';
@INC = qw(../lib);
}
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
unless (getservbyname('echo', 'tcp')) {
print "1..0 \# Skip: no echo port\n";
exit;
}
unless (getservbyname('http', 'tcp')) {
print "1..0 \# Skip: no http port\n";
exit;
}
}
# Remote network test using syn protocol.
#
# NOTE:
# Network connectivity will be required for all tests to pass.
# Firewalls may also cause some tests to fail, so test it
# on a clear network. If you know you do not have a direct
# connection to remote networks, but you still want the tests
# to pass, use the following:
#
# $ PERL_CORE=1 make test
# Try a few remote servers
my $webs = {
# Hopefully this is never a routeable host
"172.29.249.249" => 0,
# Hopefully all these web ports are open
"www.geocities.com." => 1,
"www.freeservers.com." => 1,
"yahoo.com." => 1,
"www.yahoo.com." => 1,
"www.about.com." => 1,
"www.microsoft.com." => 1,
"127.0.0.1" => 1,
};
use strict;
use Test;
use Net::Ping;
plan tests => ((keys %{ $webs }) * 2 + 3);
# Everything loaded fine
ok 1;
my $can_alarm = eval {alarm 0; 1;};
sub Alarm {
alarm(shift) if $can_alarm;
}
Alarm(50);
$SIG{ALRM} = sub {
ok 0;
die "TIMED OUT!";
};
my $p = new Net::Ping "syn", 10;
# new() worked?
ok !!$p;
# Change to use the more common web port.
# (Make sure getservbyname works in scalar context.)
ok ($p -> {port_num} = getservbyname("http", "tcp"));
foreach my $host (keys %{ $webs }) {
# ping() does dns resolution and
# only sends the SYN at this point
Alarm(50); # (Plenty for a DNS lookup)
if (!ok($p -> ping($host))) {
print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n";
}
}
Alarm(20);
foreach my $host (sort keys %{ $webs }) {
my $on = $p->ack($host);
if (!ok (($on && $webs->{$host}) ||
(!$on && !$webs->{$host}))) {
if ($on) {
print STDERR "SUPPOSED TO BE DOWN: http://$host/\n";
} else {
print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n";
}
}
delete $webs->{$host};
Alarm(20);
}
Alarm(0);
More information about the dslinux-commit
mailing list