summaryrefslogtreecommitdiffstats
path: root/perl-install/network/tools.pm
diff options
context:
space:
mode:
authorDamien Chaumette <dchaumette@mandriva.com>2002-09-12 18:06:44 +0000
committerDamien Chaumette <dchaumette@mandriva.com>2002-09-12 18:06:44 +0000
commit642d348c347f6c9389684148395829a2b3e7f4d0 (patch)
tree93640ad4686ecf1f2e6ed913e37b87b07cc34176 /perl-install/network/tools.pm
parent4c32fa0682b1703defb3b1e1a19643a263f2848e (diff)
downloaddrakx-642d348c347f6c9389684148395829a2b3e7f4d0.tar
drakx-642d348c347f6c9389684148395829a2b3e7f4d0.tar.gz
drakx-642d348c347f6c9389684148395829a2b3e7f4d0.tar.bz2
drakx-642d348c347f6c9389684148395829a2b3e7f4d0.tar.xz
drakx-642d348c347f6c9389684148395829a2b3e7f4d0.zip
- patch net_monitor
Diffstat (limited to 'perl-install/network/tools.pm')
-rw-r--r--perl-install/network/tools.pm52
1 files changed, 51 insertions, 1 deletions
diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm
index 95616a82a..d68f93747 100644
--- a/perl-install/network/tools.pm
+++ b/perl-install/network/tools.pm
@@ -8,7 +8,7 @@ use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_pro
use MDK::Common::System qw(getVarsFromSh);
@ISA = qw(Exporter);
-@EXPORT = qw(write_cnx_script write_secret_backend write_initscript ask_connect_now connect_backend disconnect_backend read_providers_backend ask_info2 type2interface connected connected_bg connected2 disconnected);
+@EXPORT = qw(write_cnx_script write_secret_backend write_initscript ask_connect_now connect_backend disconnect_backend read_providers_backend ask_info2 type2interface connected connected_bg test_connected connected2 disconnected);
@EXPORT_OK = qw($in);
sub write_cnx_script {
@@ -157,9 +157,59 @@ sub connected_bg {
1;
}
+# test if connected;
+# cmd = 0 : ask current status
+# return : 0 : not connected; 1 : connected; -1 : no test ever done; -2 : test in progress
+# cmd = 1 : start new connection test
+# return : -2
+# cmd = 2 : cancel current test
+# return : nothing
+# cmd = 3 : return current status even if a test is in progress
+my $kid_pipe_connect;
+my $kid_pid;
+my $current_connection_status;
+
+sub test_connected {
+ local $|=1;
+ my ($cmd) = @_;
+
+ if (!defined $current_connection_status) { $current_connection_status = -1; }
+
+ if ($cmd == 0) {
+ if (defined $kid_pipe_connect) {
+ local *F;
+ *F = *$kid_pipe_connect;
+ fcntl(F, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
+ my $a;
+ if (defined($a = <F>)) {
+ close($kid_pipe_connect) || warn "kid exited $?";
+ undef $kid_pipe_connect;
+ undef $kid_pid;
+ $current_connection_status = $a;
+ }
+ }
+ return $current_connection_status;
+ }
+
+ if ($cmd == 1) {
+ if ($current_connection_status != -2) {
+ $current_connection_status = -2;
+ $kid_pipe_connect = connected2();
+ }
+ }
+ if ($cmd == 2) {
+ if (defined($kid_pid)) {
+ kill -9, $kid_pid;
+ undef $kid_pid;
+ }
+ }
+ return $current_connection_status;
+}
+
sub connected2 {
my $pid = open(KID_TO_READ, "-|");
if ($pid) { # parent
+ $kid_pid = $pid;
return \*KID_TO_READ;
} else { # child
my $a = gethostbyname("mandrakesoft.com") ? 1 : 0;