diff options
Diffstat (limited to 'perl-install/network/tools.pm')
| -rw-r--r-- | perl-install/network/tools.pm | 355 |
1 files changed, 0 insertions, 355 deletions
diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm deleted file mode 100644 index a15594ae4..000000000 --- a/perl-install/network/tools.pm +++ /dev/null @@ -1,355 +0,0 @@ -package network::tools; # $Id$ - -use strict; -use common; -use run_program; -use c; -use vars qw(@ISA @EXPORT @EXPORT_OK); -use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_prog $connect_file); -use MDK::Common::System qw(getVarsFromSh); - -@ISA = qw(Exporter); -@EXPORT = qw(ask_connect_now ask_info2 connect_backend connected connected_bg disconnect_backend disconnected is_wireless_intf passwd_by_login read_providers_backend read_secret_backend test_connected type2interface write_cnx_script write_initscript write_secret_backend); -@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; - } else { - foreach ($connect_file, $disconnect_file) { - output_with_perm("$prefix$_", 0755, -'#!/bin/bash -' . if_(!$netc->{at_boot}, 'if [ "x$1" == "x--boot_time" ]; then exit; fi -') . $netc->{internet_cnx}{$netc->{internet_cnx_choice}}{$_}); - } - } -} - -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; - } -} - -sub unquotify { - my ($word) = @_; - $$word =~ s/^(['"]?)(.*)\1$/$2/; -} - -sub read_secret_backend() { - my $conf; - foreach my $i ("pap-secrets", "chap-secrets") { - foreach (cat_("$prefix/etc/ppp/$i")) { - my ($login, $server, $passwd) = split(' '); - if ($login && $passwd) { - unquotify \$passwd; - unquotify \$login; - unquotify \$server; - push @$conf, {login => $login, - passwd => $passwd, - server => $server }; - } - } - } - $conf; -} - -sub passwd_by_login { - my ($login) = @_; - - unquotify \$login; - my $secret = read_secret_backend(); - foreach (@$secret) { - return $_->{passwd} if $_->{login} eq $login; - } -} - -sub ask_connect_now { - my ($type) = @_; - $::Wizard_no_previous = 1; - my $up = 1; - #- 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 the Internet.") . - if_($::isInstall, N("For security reasons, it will be disconnected now.")) : - N("The system doesn't seem to be connected to the Internet. -Try to reconfigure your connection."); - $::Wizard_no_previous = 1; - $::Wizard_finished = 1; - $in->ask_okcancel(N("Network Configuration"), $m, 1); - undef $::Wizard_no_previous; - undef $::Wizard_finished; - $::isInstall and disconnect_backend(); - } - undef $::Wizard_no_previous; - $up; -} - -sub connect_backend() { run_program::rooted($prefix, "$connect_file &") } - -sub disconnect_backend() { run_program::rooted($prefix, "$disconnect_file &") } - -sub read_providers_backend { my ($file) = @_; map { /(.*?)=>/ } catMaybeCompressed($file) } - -sub ask_info2 { - my ($cnx, $netc) = @_; - - $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} }), - { label => N("Account Login (user name)"), val => \$cnx->{login} }, - { 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; -} - -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 { - 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) or warn "kid exited $?"; - undef $kid_pipe; - $$ref = $a; - } - } else { $kid_pipe = connected2() } - 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) { - 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) or 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() { - if ($kid_pid = open(my $kid_to_read, "-|")) { - #- parent - $kid_to_read; - } else { - #- child - require Net::Ping; - print Net::Ping->new("icmp")->ping("mandrakesoft.com") ? 1 : 0; - c::_exit(0); - } -} - -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)); -#!/bin/bash -# -# internet Bring up/down internet connection -# -# chkconfig: 2345 11 89 -# description: Activates/Deactivates the internet interfaces -# -# dam's (damien@mandrakesoft.com) - -# Source function library. -. /etc/rc.d/init.d/functions - - case "$1" in - start) - if [ -e %s ]; then - action "Checking internet connections to start at boot" "%s --boot_time" - else - action "No connection to start" "true" - fi - touch /var/lock/subsys/internet - ;; - stop) - if [ -e %s ]; then - action "Stopping internet connection if needed: " "%s --boot_time" - else - action "No connection to stop" "true" - fi - rm -f /var/lock/subsys/internet - ;; - restart) - $0 stop - echo "Waiting 10 sec before restarting the internet connection." - sleep 10 - $0 start - ;; - status) - ;; - *) - echo "Usage: internet {start|stop|status|restart}" - exit 1 -esac -exit 0 -EOF - $::isStandalone ? system("/sbin/chkconfig --add internet") : do { - symlinkf("../init.d/internet", "$prefix/etc/rc.d/rc$_") foreach - '0.d/K11internet', '1.d/K11internet', '2.d/K11internet', '3.d/S89internet', '5.d/S89internet', '6.d/K11internet'; - }; -} - -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(airo aironet_cs aironet4500_cs airo_cs airport hermes orinoco_cs netwave_cs orinoco ray_cs wavelan_cs wvlan_cs)) -} - -1; |