This commit was manufactured by cvs2svn to create tag 'V9_3_15mdk'.V9_3_15mdk

1 files changed, 158 insertions, 104 deletions

diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm
index 9735aef4b..489e0d966 100644
--- a/perl-install/network/tools.pm
+++ b/perl-install/network/tools.pm
@@ -1,6 +1,5 @@
-package network::tools; # $Id$
+package network::tools;
 
-use strict;
 use common;
 use run_program;
 use c;
@@ -9,14 +8,14 @@ use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_pro
 use MDK::Common::System qw(getVarsFromSh);
 
 @ISA = qw(Exporter);
-@EXPORT = qw(ask_info2 connect_backend connected connected_bg disconnect_backend is_dynamic_ip is_wireless_intf passwd_by_login read_providers_backend read_secret_backend test_connected write_cnx_script write_initscript write_secret_backend);
+@EXPORT = qw(write_cnx_script write_secret_backend read_secret_backend passwd_by_login 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 {
-    my ($netc, $o_type, $o_up, $o_down, $o_type2) = @_;
-    if ($o_type) {
-	$netc->{internet_cnx}{$o_type}{$_->[0]} = $_->[1] foreach [$connect_file, $o_up], [$disconnect_file, $o_down];
-	$netc->{internet_cnx}{$o_type}{type} = $o_type2;
+    my ($netc, $type, $up, $down, $type2) = @_;
+    if ($type) {
+	$netc->{internet_cnx}{$type}{$_->[0]} = $_->[1] foreach [$connect_file, $up], [$disconnect_file, $down];
+	$netc->{internet_cnx}{$type}{type} = $type2;
     } else {
 	foreach ($connect_file, $disconnect_file) {
 	    output_with_perm("$prefix$_", 0755,
@@ -29,19 +28,18 @@ sub write_cnx_script {
 
 sub write_secret_backend {
     my ($a, $b) = @_;
-    foreach my $i ("$prefix/etc/ppp/pap-secrets", "$prefix/etc/ppp/chap-secrets") {
-	substInFile { s/^'$a'.*\n//; $_ .= "\n'$a' * '$b' * \n" if eof  } $i;
-	#- restore access right to secrets file, just in case.
-	chmod 0600, $i;
+    foreach my $i ("pap-secrets", "chap-secrets") {
+	substInFile { s/^'$a'.*\n//; $_ .= "\n'$a' * '$b' * \n" if eof  } "$prefix/etc/ppp/$i";
     }
 }
 
 sub unquotify {
     my ($word) = @_;
-    $$word =~ s/^(['"]?)(.*)\1$/$2/;
+    my ($a, $b, $c) = $$word =~ /"(.*)"|'(.*)'|(.*)/;
+    $$word = $a ? $a : $b ? $b : $c;
 }
 
-sub read_secret_backend() {
+sub read_secret_backend {
     my $conf;
     foreach my $i ("pap-secrets", "chap-secrets") {
 	foreach (cat_("$prefix/etc/ppp/$i")) {
@@ -69,30 +67,124 @@ sub passwd_by_login {
     }
 }
 
-sub connect_backend() { run_program::rooted($prefix, "$connect_file &") }
+sub ask_connect_now {
+    my ($type) = @_;
+    $::Wizard_no_previous = 1;
+    my $up;
+    #- FIXME : code the exception to be generated by ask_yesorno, to be able to remove the $::Wizard_no_previous=1;
+    if ($in->ask_yesorno(N("Internet configuration"),
+			 N("Do you want to try to connect to the Internet now?")
+			)) {
+	{
+	    my $_w = $in->wait_message('', N("Testing your connection..."), 1);
+	    connect_backend();
+	    my $s = 30;
+	    $type =~ /modem/ and $s = 50;
+	    $type =~ /adsl/ and $s = 35;
+	    $type =~ /isdn/ and $s = 20;
+	    sleep $s;
+	    $up = connected();
+	}
+	my $m = $up ? N("The system is now connected to Internet.") .
+	  if_($::isInstall, N("For security reason, it will be disconnected now.")) :
+	    N("The system doesn't seem to be connected to internet.
+Try to reconfigure your connection.");
+	if ($::isWizard) {
+	    $::Wizard_no_previous = 1;
+	    $::Wizard_finished = 1;
+	    $in->ask_okcancel(N("Network Configuration"), $m, 1);
+	    undef $::Wizard_no_previous;
+	    undef $::Wizard_finished;
+	} else {  $in->ask_warn('', $m) }
+	$::isInstall and disconnect_backend();
+    }
+    undef $::Wizard_no_previous;
+    $up;
+}
+
+sub connect_backend { run_program::rooted($prefix, "$connect_prog &") }
 
-sub disconnect_backend() { run_program::rooted($prefix, "$disconnect_file &") }
+sub disconnect_backend { run_program::rooted($prefix, "$disconnect_file &") }
 
 sub read_providers_backend { my ($file) = @_; map { /(.*?)=>/ } catMaybeCompressed($file) }
 
-sub connected() { gethostbyname("mandrakesoft.com") ? 1 : 0 }
+sub ask_info2 {
+    my ($cnx, $netc) = @_;
+    $::isInstall and $in->set_help('configureNetworkDNS');
+    $in->ask_from(N("Connection Configuration"),
+		  N("Please fill or check the field below"),
+		  [
+		   if__($cnx->{irq}, { label => N("Card IRQ"), val => \$cnx->{irq} }),
+		   if__($cnx->{mem}, { label => N("Card mem (DMA)"), val => \$cnx->{mem} }),
+		   if__($cnx->{io}, { label => N("Card IO"), val => \$cnx->{io} }),
+		   if__($cnx->{io0}, { label => N("Card IO_0"), val => \$cnx->{io0} }),
+		   if__($cnx->{io1}, { label => N("Card IO_1"), val => \$cnx->{io1} }),
+		   if__($cnx->{phone_in}, { label => N("Your personal phone number"), val => \$cnx->{phone_in} }),
+		   if__($netc->{DOMAINNAME2}, { label => N("Provider name (ex provider.net)"), val => \$netc->{DOMAINNAME2} }),
+		   if__($cnx->{phone_out}, { label => N("Provider phone number"), val => \$cnx->{phone_out} }),
+		   if__($netc->{dnsServer2}, { label => N("Provider dns 1 (optional)"), val => \$netc->{dnsServer2} }),
+		   if__($netc->{dnsServer3}, { label => N("Provider dns 2 (optional)"), val => \$netc->{dnsServer3} }),
+		   if__($cnx->{vpivci}, { label => N("Choose your country"), val => \$netc->{vpivci}, list => detect_timezone() }),
+		   if__($cnx->{dialing_mode}, { label => N("Dialing mode"), val => \$cnx->{dialing_mode},list => ["auto", "manual"] }),
+		   if__($cnx->{speed}, { label => N("Connection speed"), val => \$cnx->{speed}, list => ["64 Kb/s", "128 Kb/s"] }),
+		   if__($cnx->{huptimeout}, { label => N("Connection timeout (in sec)"), val => \$cnx->{huptimeout} }),
+		   if__($cnx->{login}, { label => N("Account Login (user name)"), val => \$cnx->{login} }),
+		   if__($cnx->{passwd}, { label => N("Account Password"),  val => \$cnx->{passwd}, hidden => 1 }),
+		  ]
+		 ) or return;
+    if ($netc->{vpivci}) {
+	foreach ([N("Netherlands"), '8_48'], [N("France"), '8_35'], [N("Belgium"), '8_35'], [N("Italy"), '8_35'], [N("United Kingdom"), '0_38'], [N("United States"), '8_35']) {
+	    $netc->{vpivci} eq $_->[0] and $netc->{vpivci} = $_->[1];
+	}
+    }
+    1;
+}
+
+sub detect_timezone {
+    my %tmz2country = ( 
+		       'Europe/Paris' => N("France"),
+		       'Europe/Amsterdam' => N("Netherlands"),
+		       'Europe/Rome' => N("Italy"),
+		       'Europe/Brussels' => N("Belgium"), 
+		       'America/New_York' => N("United States"),
+		       'Europe/London' => N("United Kingdom") 
+		      );
+    my %tm_parse = MDK::Common::System::getVarsFromSh('/etc/sysconfig/clock');
+    my @country;
+    foreach (keys %tmz2country) {
+	if ($_ eq $tm_parse{ZONE}) {
+	    unshift @country, $tmz2country{$_};
+	} else { push @country, $tmz2country{$_} };
+    }
+    \@country;
+}
 
-# request a ref on a bg_connect and a ref on a scalar
-sub connected_bg__raw {
-    my ($kid_pipe, $status) = @_;
-    local $| = 1;
-    if (ref($kid_pipe) && ref($$kid_pipe)) {
-	my $fd = $$kid_pipe->{fd};
-	fcntl($fd, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
-	my $a  = <$fd>;
-     $$status = $a if defined $a;
-    } else { $$kid_pipe = check_link_beat() }
+sub type2interface {
+    my ($i) = @_;
+    $i =~ /$_->[0]/ and return $_->[1] foreach [ modem => 'ppp' ],
+					     [ isdn_internal => 'ippp' ],
+					     [ isdn_external => 'ppp' ],
+					     [ adsl => 'ppp' ],
+					     [ cable => 'eth' ],
+					     [ lan => 'eth' ];
 }
 
+sub connected { gethostbyname("mandrakesoft.com") ? 1 : 0 }
+
 my $kid_pipe;
 sub connected_bg {
-    my ($status) = @_;
-    connected_bg__raw(\$kid_pipe, $status);
+    local $| = 1;
+    my ($ref) = @_;
+    if (defined $kid_pipe) {
+	fcntl($kid_pipe, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
+	my $a;
+  	if (defined($a = <$kid_pipe>)) {
+	    close($kid_pipe) || warn "kid exited $?";
+	    undef $kid_pipe;
+	    $$ref = $a;
+  	}
+    } else { $kid_pipe = connected2() }
+    1;
 }
 
 # test if connected;
@@ -104,38 +196,60 @@ sub connected_bg {
 #    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) = @_;
-    
-    $current_connection_status = -1 if !defined $current_connection_status;
-    
+
+    if (!defined $current_connection_status) { $current_connection_status = -1 }
+
     if ($cmd == 0) {
-        connected_bg__raw(\$kid_pipe_connect, \$current_connection_status);
-    } elsif ($cmd == 1) {
+        if (defined $kid_pipe_connect) {
+	    fcntl($kid_pipe_connect, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
+	    my $a;
+	    if (defined($a = <$kid_pipe_connect>)) {
+		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 = check_link_beat();
+             $kid_pipe_connect = connected2();
         }
-    } elsif ($cmd == 2) {
-        if (defined($kid_pipe_connect)) {
-	    kill -9, $kid_pipe_connect->{pid};
-	    undef $kid_pipe_connect;
+    }
+    if ($cmd == 2) {
+        if (defined($kid_pid)) {
+	    kill -9, $kid_pid;
+	    undef $kid_pid;
         }
     }
     return $current_connection_status;
 }
 
-sub check_link_beat() {
-    bg_command->new(sub {
-                        require Net::Ping;
-                        print Net::Ping->new("icmp")->ping("mandrakesoft.com") ? 1 : 0;
-                    });
+sub connected2 {
+    if ($kid_pid = open(my $kid_to_read, "-|")) {
+	#- parent
+	$kid_to_read;
+    } else {      
+	#- child
+	my $a = gethostbyname("mandrakesoft.com") ? 1 : 0;
+	print $a;
+	c::_exit(0);
+    }
 }
 
-sub write_initscript() {
+sub disconnected {}
+
+
+sub write_initscript {
     $::testing and return;
     output_with_perm("$prefix/etc/rc.d/init.d/internet", 0755,
 		     sprintf(<<'EOF', $connect_file, $connect_file, $disconnect_file, $disconnect_file));
@@ -188,64 +302,4 @@ EOF
     };
 }
 
-sub copy_firmware {
-    my ($device, $destination, $file) = @_;
-    my ($source, $failed, $mounted);
-
-    $device eq 'floppy'  and do { $mounted = 1; ($source, $failed) = use_floppy($file) };
-    $device eq 'windows' and ($source, $failed) = use_windows();
-    
-    $source eq $failed and return;
-    $mounted and my $_b = before_leaving { fs::umount('/mnt') };
-    if ($failed) {
-	eval { $in->ask_warn('', $failed) }; $in->exit if $@ =~ /wizcancel/;
-	return;
-    }
-
-    if (-e "$source/$file") { cp_af("$source/$file", $destination) }
-    else { $failed = N("Firmware copy failed, file %s not found", $file) }
-    eval { $in->ask_warn('', $failed || N("Firmware copy succeeded")) }; $in->exit if $@ =~ /wizcancel/;
-    log::explanations($failed || "Firmware copy $file in $destination succeeded");
-
-    $failed ? 0 : 1;  
-}
-
-sub use_windows() {
-    my $all_hds = fsedit::get_hds({}, undef); 
-    fs::get_info_from_fstab($all_hds, '');
-    my $part = find { $_->{device_windobe} eq 'C' } fsedit::get_fstab(@{$all_hds->{hds}});
-    $part or my $failed = N("No partition available");
-    my $source = -d "$part->{mntpoint}/windows/" ? "$part->{mntpoint}/windows/system" : "$part->{mntpoint}/winnt/system";
-    log::explanations($failed || "Seek in $source to find firmware");
-
-    return $source, $failed;
-}
-
-sub use_floppy {
-    my ($file) = @_;
-    my $floppy = detect_devices::floppy();
-    $in->ask_okcancel(N("Insert floppy"),
-		      N("Insert a FAT formatted floppy in drive %s with %s in root directory and press %s", $floppy, $file, N("Next"))) or return;
-    eval { fs::mount(devices::make($floppy), '/mnt', 'vfat', 'readonly'); 1 } or my $failed = N("Floppy access error, unable to mount device %s", $floppy);
-    log::explanations($failed || "Mounting floppy device $floppy in /mnt");
-
-    return '/mnt', $failed;
-}
-
-
-sub is_wireless_intf {
-    my ($module) = @_;
-    member($module, qw(acx100_pci airo aironet_cs aironet4500_cs airo_cs airport at76c503 hermes netwave_cs orinoco_cs prism2_usb orinoco ray_cs usbvnet_rfmd wavelan_cs wvlan_cs))
-}
-
-sub is_dynamic_ip {
-  my ($intf) = @_;
-  any { $_->{BOOTPROTO} !~ /^(none|static|)$/ } values %$intf;
-}
-
-sub is_dynamic_host {
-  my ($intf) = @_;
-  any { defined $_->{DHCP_HOSTNAME} } values %$intf;
-}
-
 1;