re-sync after the big svn loss

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;