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