summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/network/test.pm158
1 files changed, 158 insertions, 0 deletions
diff --git a/perl-install/network/test.pm b/perl-install/network/test.pm
new file mode 100644
index 000000000..2b07234d2
--- /dev/null
+++ b/perl-install/network/test.pm
@@ -0,0 +1,158 @@
+package network::test; # $Id
+
+use strict;
+use MDK::Common;
+use run_program;
+use Socket;
+
+sub new {
+ my ($class, $o_hostname) = @_;
+ bless {
+ hostname => $o_hostname || "mandrakesoft.com"
+ }, $class;
+}
+
+#- launch synchronous test, will hang until the test finishes
+sub test_synchronous {
+ my ($o) = @_;
+ ($o->{address}, $o->{ping}) = resolve_and_ping($o->{hostname});
+ $o->{done} = 1;
+}
+
+#- launch asynchronous test, won't hang
+sub start {
+ my ($o) = @_;
+ $o->{done} = 0;
+ $o->{kid} = bg_command->new(sub {
+ my ($address, $ping) = resolve_and_ping($o->{hostname});
+ print "$address|$ping\n";
+ });
+}
+
+#- abort asynchronous test
+sub abort {
+ my ($o) = @_;
+ if ($o->{kid}) {
+ kill -9, $o->{kid}{pid};
+ undef $o->{kid};
+ }
+}
+
+#- returns a true value if the test is finished, usefull for asynchronous tests
+sub is_done {
+ my ($o) = @_;
+ $o->update_status;
+ to_bool($o->{done});
+}
+
+#- return a true value if the connection works (hostname resolution and ping)
+sub is_connected {
+ my ($o) = @_;
+ to_bool(defined($o->{hostname}) && defined($o->{ping}));
+}
+
+#- get hostname used in test for resolution and ping
+sub get_hostname {
+ my ($o) = @_;
+ $o->{hostname};
+}
+
+#- get resolved address (if any) of given hostname
+sub get_address {
+ my ($o) = @_;
+ $o->{address};
+}
+
+#- get ping (if any) to given hostname
+sub get_ping {
+ my ($o) = @_;
+ $o->{ping};
+}
+
+sub resolve_and_ping {
+ my ($hostname) = @_;
+ require Net::Ping;
+ require Time::HiRes;
+ my $p;
+ if ($>) {
+ $p = Net::Ping->new('tcp');
+ # Try connecting to the www port instead of the echo port
+ $p->{port_num} = getservbyname('http', 'tcp');
+ } else {
+ $p = Net::Ping->new('icmp');
+ }
+ $p->Net::Ping::hires; #- get ping as float
+ #- default timeout is 5 seconds
+ my ($ret, $ping, $address) = $p->Net::Ping::ping($hostname, 5);
+ if ($ret) {
+ return $address, $ping;
+ } elsif (defined($ret)) {
+ return $address;
+ }
+}
+
+sub update_status {
+ my ($o) = @_;
+ if ($o->{kid}) {
+ my $fd = $o->{kid}{fd};
+ fcntl($fd, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
+ local $| = 1;
+ if (defined(my $output = <$fd>)) {
+ ($o->{address}, $o->{ping}) = $output =~ /^([\d\.]+)\|([\d\.]+)*$/;
+ $o->{done} = 1;
+ undef $o->{kid};
+ }
+ }
+}
+
+1;
+
+=head1 network::test
+
+=head2 Test synchronously
+
+#- resolve and get ping to hostname from command line if given, else to Mandrakesoft
+use lib qw(/usr/lib/libDrakX);
+use network::test;
+
+my $net_test = network::test->new($ARGV[0]);
+$net_test->test_synchronous;
+
+my $is_connected = $net_test->is_connected;
+my $hostname = $net_test->get_hostname;
+my $address = $net_test->get_address;
+my $ping = $net_test->get_ping;
+
+print "connected: $is_connected
+host: $hostname
+resolved host: $address
+ping to host: $ping
+";
+
+=head2 Test asynchronously
+
+#- resolve and get ping to hostname from command line if given, else to Mandrakesoft
+#- prints a "." every 10 miliseconds during connection test
+use lib qw(/usr/lib/libDrakX);
+use network::test;
+
+my $net_test = network::test->new($ARGV[0]);
+$net_test->start;
+
+do {
+ print ".\n";
+ select(undef, undef, undef, 0.01);
+} while !$net_test->is_done;
+
+my $is_connected = $net_test->is_connected;
+my $hostname = $net_test->get_hostname;
+my $address = $net_test->get_address;
+my $ping = $net_test->get_ping;
+
+print "connected: $is_connected
+host: $hostname
+resolved host: $address
+ping to host: $ping
+";
+
+=cut