diff options
Diffstat (limited to 'perl-install/network/tools.pm')
| -rw-r--r-- | perl-install/network/tools.pm | 305 |
1 files changed, 0 insertions, 305 deletions
diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm deleted file mode 100644 index 5bf376dba..000000000 --- a/perl-install/network/tools.pm +++ /dev/null @@ -1,305 +0,0 @@ -package network::tools; # $Id$ - -use strict; -use common; -use run_program; -use fsedit; -use c; -use vars qw(@ISA @EXPORT @EXPORT_OK); -use MDK::Common::System qw(getVarsFromSh); - -@ISA = qw(Exporter); -@EXPORT = qw(connect_backend connected connected_bg disconnect_backend is_dynamic_ip passwd_by_login read_secret_backend set_cnx_script test_connected write_cnx_script remove_initscript write_secret_backend start_interface stop_interface); - -our $connect_prog = "/etc/sysconfig/network-scripts/net_cnx_pg"; -our $connect_file = "/etc/sysconfig/network-scripts/net_cnx_up"; -our $disconnect_file = "/etc/sysconfig/network-scripts/net_cnx_down"; - -sub set_cnx_script { - my ($netc, $type, $up, $down, $type2) = @_; - $netc->{internet_cnx}{$type}{$_->[0]} = $_->[1] foreach [$connect_file, $up], [$disconnect_file, $down]; - $netc->{internet_cnx}{$type}{type} = $type2; -} -sub write_cnx_script { - my ($netc) = @_; - 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 connect_backend { - my ($netc) = @_; - run_program::rooted($::prefix, "ifup $netc->{NET_INTERFACE} &"); -} - -sub disconnect_backend { - my ($netc) = @_; - run_program::rooted($::prefix, "ifdown $netc->{NET_INTERFACE} &"); -} - -sub bg_command_as_root { - my ($name, @args) = @_; - #- FIXME: duplicate code from common::require_root_capability - if (check_for_xserver() && fuzzy_pidofs(qr/\bkwin\b/) > 0) { - run_program::raw({ detach => 1 }, "kdesu", "--ignorebutton", "-c", "$name @args"); - } else { - run_program::raw({ detach => 1 }, [ 'consolehelper', $name ], @args); - } -} - -sub start_interface { - my ($intf) = @_; - bg_command_as_root('/sbin/ifup', $intf); -} - -sub stop_interface { - my ($intf) = @_; - bg_command_as_root('/sbin/ifdown', $intf); -} - -sub connected() { gethostbyname("mandrakesoft.com") ? 1 : 0 } - -# 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 not fcntl F_SETFL: $!"; - my $a = <$fd>; - $$status = $a if defined $a; - } else { $$kid_pipe = check_link_beat() } -} - -my $kid_pipe; -sub connected_bg { - my ($status) = @_; - connected_bg__raw(\$kid_pipe, $status); -} - -# 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 $current_connection_status; - -sub test_connected { - local $| = 1; - my ($cmd) = @_; - - $current_connection_status = -1 if !defined $current_connection_status; - - if ($cmd == 0) { - connected_bg__raw(\$kid_pipe_connect, \$current_connection_status); - } elsif ($cmd == 1) { - if ($current_connection_status != -2) { - $current_connection_status = -2; - $kid_pipe_connect = check_link_beat(); - } - } elsif ($cmd == 2) { - if (defined($kid_pipe_connect)) { - kill -9, $kid_pipe_connect->{pid}; - undef $kid_pipe_connect; - } - } - return $current_connection_status; -} - -sub check_link_beat() { - bg_command->new(sub { - require Net::Ping; - 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"); - } - print $p->ping("www.mandrakesoft.com") ? 1 : 0; - }); -} - -sub remove_initscript() { - $::testing and return; - if (-e "$::prefix/etc/rc.d/init.d/internet") { - run_program::rooted($::prefix, "/sbin/chkconfig", "--del", "internet"); - rm_rf("$::prefix/etc/rc.d/init.d/internet"); - log::explanations("Removed internet service"); - } -} - -sub use_windows { - my ($file) = @_; - my $all_hds = fsedit::get_hds(); - fs::get_info_from_fstab($all_hds); - if (my $part = find { $_->{device_windobe} eq 'C' } fs::get::fstab($all_hds)) { - my $source = find { -d $_ && -r "$_/$file" } map { "$part->{mntpoint}/$_" } qw(windows/system winnt/system windows/system32/drivers winnt/system32/drivers); - log::explanations("Seek in $source to find firmware"); - $source; - } else { - my $failed = N("No partition available"); - log::explanations($failed); - undef, $failed; - } -} - -sub use_floppy { - my ($in, $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; - if (eval { fs::mount(devices::make($floppy), '/mnt', 'vfat', 'readonly'); 1 }) { - log::explanations("Mounting floppy device $floppy in /mnt"); - '/mnt'; - } else { - my $failed = N("Floppy access error, unable to mount device %s", $floppy); - log::explanations($failed); - undef, $failed; - } -} - - -sub is_dynamic_ip { - my ($intf) = @_; - any { $_->{BOOTPROTO} !~ /^(none|static|)$/ } values %$intf; -} - -sub is_dynamic_host { - my ($intf) = @_; - any { defined $_->{DHCP_HOSTNAME} } values %$intf; -} - -sub convert_wep_key_for_iwconfig { - #- 5 or 13 characters, consider the key as ASCII and prepend "s:" - #- else consider the key as hexadecimal, do not strip dashes - #- always quote the key as string - my ($key) = @_; - member(length($key), (5, 13)) ? "s:$key" : $key; -} - -sub get_wep_key_from_iwconfig { - #- strip "s:" if the key is 5 or 13 characters (ASCII) - #- else the key as hexadecimal, do not modify - my ($key) = @_; - $key =~ s/^s:// if member(length($key), (7,15)); - $key; -} - - -#- returns interface whose IP address matchs given IP address, according to its network mask -sub find_matching_interface { - my ($intf, $address) = @_; - my @ip = split '\.', $address; - find { - my @intf_ip = split '\.', $intf->{$_}{IPADDR} or return; - my @mask = split '\.', $intf->{$_}{NETMASK} or return; - every { $_ } mapn { ($_[0] & $_[2]) == ($_[1] & $_[2]) } \@intf_ip, \@ip, \@mask; - } sort keys %$intf; -} - -#- returns gateway interface if found -sub get_default_gateway_interface { - my ($netc, $intf) = @_; - my @intfs = sort keys %$intf; - `$::prefix/sbin/ip route show` =~ /^default.*\s+dev\s+(\S+)/m && $1 || - $netc->{GATEWAYDEV} || - $netc->{GATEWAY} && find_matching_interface($intf, $netc->{GATEWAY}) || - (find { get_interface_type($intf->{$_}) eq 'adsl' } @intfs) || - (find { get_interface_type($intf->{$_}) eq 'isdn' && text2bool($intf->{$_}{DIAL_ON_IFUP}) } @intfs) || - (find { get_interface_type($intf->{$_}) eq 'modem' } @intfs) || - (find { get_interface_type($intf->{$_}) eq 'ethernet' && $intf->{$_}{BOOTPROTO} eq 'dhcp' } @intfs); -} - -sub get_interface_status { - my ($gw_intf) = @_; - my @routes = `$::prefix/sbin/ip route show`; - my $is_up = to_bool(grep { /\s+dev\s+$gw_intf(?:\s+|$)/ } @routes); - my ($gw_address) = join('', @routes) =~ /^default\s+via\s+(\S+).*\s+dev\s+$gw_intf(?:\s+|$)/m; - return $is_up, $gw_address; -} - -#- returns (gateway_interface, interface is up, gateway address, dns server address) -sub get_internet_connection { - my ($netc, $intf, $o_gw_intf) = @_; - my $gw_intf = $o_gw_intf || get_default_gateway_interface($netc, $intf) or return; - return $gw_intf, get_interface_status($gw_intf), $netc->{dnsServer}; -} - -sub get_interface_type { - my ($interface) = @_; - member($interface->{TYPE}, "xDSL", "ADSL") && "adsl" || - $interface->{DEVICE} =~ /^(eth|ath|wlan)/ && "ethernet" || - $interface->{DEVICE} =~ /^ippp/ && "isdn" || - $interface->{DEVICE} =~ /^ppp/ && "modem" || - "unknown"; -} - -sub get_default_metric { - my ($type) = @_; - my @known_types = ("ethernet_gigabit", "ethernet", "adsl", "isdn", "modem", "unknown"); - my $idx; - eval { $idx = find_index { $type eq $_ } @known_types }; - $idx = @known_types if $@; - $idx * 10; -} - -sub ndiswrapper_installed_drivers { - `ndiswrapper -l` =~ /(\w+)\s+driver present/mg; -} - -sub ndiswrapper_available_drivers { - `ndiswrapper -l` =~ /(\w+)\s+driver present, hardware present/mg; -} - -1; |