diff options
Diffstat (limited to 'perl-install/network/tools.pm')
| -rw-r--r-- | perl-install/network/tools.pm | 255 |
1 files changed, 0 insertions, 255 deletions
diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm deleted file mode 100644 index 460797959..000000000 --- a/perl-install/network/tools.pm +++ /dev/null @@ -1,255 +0,0 @@ -package network::tools; # $Id$ - -use strict; -use common; -use run_program; -use c; -use Socket; - -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 wrap_command_for_root { - my ($name, @args) = @_; - #- FIXME: duplicate code from common::require_root_capability - check_for_xserver() && fuzzy_pidofs(qr/\bkwin\b/) > 0 ? - ("kdesu", "--ignorebutton", "-c", "$name @args") : - ([ 'consolehelper', $name ], @args); -} - -sub run_interface_command { - my ($command, $intf, $detach) = @_; - my @command = - !$> || system("/usr/sbin/usernetctl $intf report") == 0 ? - ($command, $intf, if_(!$::isInstall, "daemon")) : - wrap_command_for_root($command, $intf); - run_program::raw({ detach => $detach, root => $::prefix }, @command); -} - -sub start_interface { - my ($intf, $detach) = @_; - run_interface_command('/sbin/ifup', $intf, $detach); -} - -sub stop_interface { - my ($intf, $detach) = @_; - run_interface_command('/sbin/ifdown', $intf, $detach); -} - -sub start_net_interface { - my ($net, $detach) = @_; - start_interface($net->{net_interface}, $detach); -} - -sub stop_net_interface { - my ($net, $detach) = @_; - stop_interface($net->{net_interface}, $detach); -} - -sub connected() { gethostbyname("www.mandriva.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.mandriva.com") ? 1 : 0; - }); -} - -sub is_dynamic_ip { - my ($net) = @_; - any { $_->{BOOTPROTO} !~ /^(none|static|)$/ } values %{$net->{ifcfg}}; -} - -sub is_dynamic_host { - my ($net) = @_; - any { defined $_->{DHCP_HOSTNAME} } values %{$net->{ifcfg}}; -} - -#- returns interface whose IP address matchs given IP address, according to its network mask -sub find_matching_interface { - my ($net, $address) = @_; - my @ip = split '\.', $address; - find { - my @intf_ip = split '\.', $net->{ifcfg}{$_}{IPADDR} or return; - my @mask = split '\.', $net->{ifcfg}{$_}{NETMASK} or return; - every { $_ } mapn { ($_[0] & $_[2]) == ($_[1] & $_[2]) } \@intf_ip, \@ip, \@mask; - } sort keys %{$net->{ifcfg}}; -} - -#- returns the current gateway, with lowest metric -sub get_current_gateway_interface() { - my $routes = get_routes(); - first(sort { $routes->{$a}{metric} <=> $routes->{$b}{metric} } grep { exists $routes->{$_}{gateway} } keys %$routes); -} - -#- returns gateway interface if found -sub get_default_gateway_interface { - my ($net) = @_; - my @intfs = sort keys %{$net->{ifcfg}}; - get_current_gateway_interface() || - $net->{network}{GATEWAYDEV} || - $net->{network}{GATEWAY} && find_matching_interface($net, $net->{network}{GATEWAY}) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'adsl' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'isdn' && text2bool($net->{ifcfg}{$_}{DIAL_ON_IFUP}) } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'modem' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'wifi' && $net->{ifcfg}{$_}{BOOTPROTO} eq 'dhcp' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'ethernet' && $net->{ifcfg}{$_}{BOOTPROTO} eq 'dhcp' } @intfs); -} - -sub get_interface_status { - my ($intf) = @_; - my $routes = get_routes(); - return $routes->{$intf}{network}, $routes->{$intf}{gateway}; -} - -#- returns (gateway_interface, interface is up, gateway address, dns server address) -sub get_internet_connection { - my ($net, $o_gw_intf) = @_; - my $gw_intf = $o_gw_intf || get_default_gateway_interface($net) or return; - return $gw_intf, get_interface_status($gw_intf), $net->{resolv}{dnsServer}; -} - -sub get_interface_type { - my ($interface, $o_module) = @_; - require detect_devices; - member($interface->{TYPE}, "xDSL", "ADSL") && "adsl" || - $interface->{DEVICE} =~ /^ippp/ && "isdn" || - $interface->{DEVICE} =~ /^ppp/ && "modem" || - (detect_devices::is_wireless_interface($interface->{DEVICE}) || exists $interface->{WIRELESS_MODE}) && "wifi" || - detect_devices::is_lan_interface($interface->{DEVICE}) && - ($o_module && member($o_module, list_modules::category2modules('network/gigabit')) ? "ethernet_gigabit" : "ethernet") || - "unknown"; -} - -sub get_default_metric { - my ($type) = @_; - my @known_types = ("ethernet_gigabit", "ethernet", "adsl", "wifi", "isdn", "modem", "unknown"); - my $idx; - eval { $idx = find_index { $type eq $_ } @known_types }; - $idx = @known_types if $@; - $idx * 10; -} - -sub get_interface_ip_address { - my ($net, $interface) = @_; - `/sbin/ip addr show dev $interface` =~ /^\s*inet\s+([\d.]+)/m && $1 || - $net->{ifcfg}{$interface}{IPADDR}; -} - -sub host_hex_to_dotted { - my ($address) = @_; - inet_ntoa(pack('N', unpack('L', pack('H8', $address)))); -} - -sub get_routes() { - my %routes; - foreach (cat_("/proc/net/route")) { - if (/^(\S+)\s+([0-9A-F]+)\s+([0-9A-F]+)\s+[0-9A-F]+\s+\d+\s+\d+\s+(\d+)\s+([0-9A-F]+)/) { - if (hex($2)) { $routes{$1}{network} = host_hex_to_dotted($2) } - elsif (hex($3)) { $routes{$1}{gateway} = host_hex_to_dotted($3) } - if ($4) { $routes{$1}{metric} = $4 } - } - } - #- TODO: handle IPv6 with /proc/net/ipv6_route - \%routes; -} - -1; |