diff options
Diffstat (limited to 'perl-install/network/tools.pm')
-rw-r--r-- | perl-install/network/tools.pm | 262 |
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; |