diff options
Diffstat (limited to 'lib/network/tools.pm')
| -rw-r--r-- | lib/network/tools.pm | 255 |
1 files changed, 255 insertions, 0 deletions
diff --git a/lib/network/tools.pm b/lib/network/tools.pm new file mode 100644 index 0000000..4607979 --- /dev/null +++ b/lib/network/tools.pm @@ -0,0 +1,255 @@ +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; |