package pkgs; use diagnostics; use strict; use vars qw($fd); use common qw(:common :file); use install_any; use log; use smp; use fs; use lang; my @skipThesesPackages = qw(XFree86-8514 XFree86-AGX XFree86-FBDev XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-VGA16 XFree86-W32 XFree86-I128 XFree86-Sun XFree86-SunMono XFree86-Xnest postfix XFree86-Sun24 XFree86-3DLabs kernel-boot metroess metrotmpl); 1; sub skipThisPackage { member($_[0], @skipThesesPackages) } sub Package { my ($packages, $name) = @_; $packages->{$name} or die "unknown package $name"; } sub select($$;$) { my ($packages, $p, $base) = @_; $p->{selected} = -1; # selected by user my @l = @{$p->{deps}}; while (@l) { my $n = shift @l; $n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice my $i = Package($packages, $n); $i->{base} = $base; $i->{deps} or log::l("missing deps for $n"); push @l, @{$i->{deps} || []} unless $i->{selected}; $i->{selected}++ unless $i->{selected} == -1; } } sub unselect($$) { my ($packages, $p) = @_; my $set = set_new($p->{name}); my $l = $set->{list}; # get the list of provided packages foreach my $q (@$l) { my $i = Package($packages, $q); $i->{selected} && !$i->{base} or next; $i->{selected} = 1; # that way, its counter will be zero the first time set_add($set, @{$i->{provides} || []}); } while (@$l) { my $n = shift @$l; my $i = Package($packages, $n); $i->{selected} <= 0 and next; if (--$i->{selected} == 0) { push @$l, @{$i->{deps} || []}; } } # garbage collect for circular dependencies my $changed = 1; while ($changed) { $changed = 0; NEXT: foreach my $p (grep { $_->{selected} > 0 } values %$packages) { my $set = set_new(@{$p->{provides}}); foreach (@{$set->{list}}) { my $q = Package($packages, $_); $q->{selected} == -1 and next NEXT; set_add($set, @{$q->{provides}}) if $q->{selected}; } $p->{selected} = 0; $changed = 1; } } } sub toggle($$) { my ($packages, $p) = @_; $p->{selected} ? unselect($packages, $p) : &select($packages, $p); } sub set($$$) { my ($packages, $p, $val) = @_; $val ? &select($packages, $p) : unselect($packages, $p); } sub addInfosFromHeader($$;$) { my ($packages, $header, $file) = @_; my $name = c::headerGetEntry($header, 'name'); $packages->{$name} = { name => $name, file => $file, selected => 0, deps => [], header => $header, size => c::headerGetEntry($header, 'size'), }; } sub psUsingDirectory(;$) { my ($dirname) = @_; my %packages; $dirname ||= install_any::imageGetFile(''); log::l("scanning $dirname for packages"); foreach (all("$dirname")) { my ($name, $version, $release) = /(.*)-([^-]+)-([^-.]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next; $packages{$name} = { name => $name, version => $version, release => $release, file => "$dirname/$_", selected => 0, deps => [], }; } \%packages; } sub getDeps($) { my ($packages) = @_; local *F; open F, install_any::imageGetFile("depslist") or die "can't find dependencies list"; foreach () { my ($name, $size, @deps) = split; $packages->{$name}->{size} = $size; $packages->{$name}->{deps} = \@deps; map { push @{$packages->{$_}->{provides}}, $name } @deps; } } sub readCompss($) { my ($packages) = @_; my (@compss, $ps, $category); local *F; open F, install_any::imageGetFile("compss") or die "can't find compss"; foreach () { /^\s*$/ || /^#/ and next; s/#.*//; my ($options, $name) = /^(\S*)\s+(.*?)\s*$/ or die "bad line in compss: $_"; if ($name =~ /(.*):$/) { if ($category) { push @compss, $category; $ps = []; } $category = { options => $options, name => $1, packages => $ps }; } else { my $p = $packages->{$name} or log::l("unknown package $name (in compss)"), next; $p->{options} = $options; push @$ps, $p; } } [ @compss, $category ]; } sub setCompssSelected($$$) { my ($compss, $packages, $install_class, $select) = @_; my $l = substr($install_class, 0, 1); my $L = uc $l; my $verif_lang = sub { $_[0] =~ /-([^-]*)$/; $1 eq $ENV{LANG} || eval { lang::text2lang($1) eq $ENV{LANG} } && !$@; }; foreach my $c (@$compss) { $c->{show} = bool($c->{options} =~ /($l|\*)/); my $nb = 0; foreach my $p (@{$c->{packages}}) { local $_ = $p->{options}; $p->{show} = ! (/$L/); &select($packages, $p, $p->{base}), $nb++ if /$l|\*/ && (!/l/ || &$verif_lang($p->{name})) || $p->{base}; } $c->{selected} = $nb; } } sub psFromHeaderListDesc { my ($fd, $noSeek) = @_; my %packages; my $end; unless ($noSeek) { my $current = sysseek $fd, 0, 1 or die "seek failed"; $end = sysseek $fd, 0, 2 or die "seek failed"; sysseek $fd, $current, 0 or die "seek failed"; } while (1) { my $header = c::headerRead(fileno($fd), 1); unless ($header) { $noSeek and last; die "error reading header at offset ", sysseek($fd, 0, 1); } addInfosFromHeader(\%packages, $header); $noSeek or $end <= sysseek($fd, 0, 1) and last; } log::l("psFromHeaderListDesc read " . scalar keys(%packages) . " headers"); \%packages; } sub psFromHeaderListFile { my ($file) = @_; local *F; sysopen F, $file, 0 or die "error opening header file $file: $!"; psFromHeaderListDesc(\*F, 0); } sub init_db { my ($prefix, $isUpgrade) = @_; my $f = "$prefix/tmp/" . ($isUpgrade ? "upgrade" : "install") . ".log"; open(F, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept."); $fd = fileno(F) || log::fd() || 2; c::rpmErrorSetCallback($fd); # c::rpmSetVeryVerbose(); log::l("reading /usr/lib/rpm/rpmrc"); c::rpmReadConfigFiles() or die "can't read rpm config files"; log::l("\tdone"); $isUpgrade ? c::rpmdbRebuild($prefix) : c::rpmdbInit($prefix, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString(); } sub getHeader($) { my ($p) = @_; unless ($p->{header}) { local *F; open F, $p->{file} or die "error opening package $p->{name} (file $p->{file})"; $p->{header} = c::rpmReadPackageHeader(fileno F); } $p->{header}; } sub install { my ($prefix, $toInstall, $isUpgrade, $force) = @_; c::rpmReadConfigFiles() or die "can't read rpm config files"; my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString(); log::l("opened rpm database"); my $trans = c::rpmtransCreateSet($db, $prefix); my ($total, $nb); foreach my $p (@$toInstall) { c::rpmtransAddPackage($trans, getHeader($p), $p->{file}, $isUpgrade); $nb++; $total += $p->{size}; } c::rpmdepOrder($trans) or c::rpmdbClose($db), c::rpmtransFree($trans), die "error ordering package list: ", c::rpmErrorString(); c::rpmtransSetScriptFd($trans, $fd); eval { fs::mount("/proc", "$prefix/proc", "proc", 0) }; log::ld("starting installation: ", $nb, " packages, ", $total, " bytes"); # !! do not translate these messages, they are used when catched (cf install_steps_graphical) my $callbackStart = sub { log::ld("starting installing package ", $_[0]) }; my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) }; if (my @probs = c::rpmRunTransactions($trans, $callbackStart, $callbackProgress, $force)) { die "installation of rpms failed:\n ", join("\n ", @probs); } c::rpmtransFree($trans); c::rpmdbClose($db); log::l("rpm database closed"); } ='#n39'>39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

package network::ethernet; # $Id$

use c;
use network::network;
use modules;
use modules::interactive;
use detect_devices;
use common;
use run_program;
use network::tools;

our @dhcp_clients = qw(dhclient dhcpcd pump dhcpxd);

sub install_dhcp_client {
    my ($in, $ethntf) = @_;
    my %packages = (
        "dhclient" => "dhcp-client",
    );
    my $client = $ethntf->{DHCP_CLIENT};
    #- use default dhcp client if none is provided
    $client ||= $dhcp_clients[0];
    $client = $packages{$client} if exists $packages{$client};
    $in->do_pkgs->install($client);
}

sub write_ether_conf {
    my ($in, $modules_conf, $netcnx, $netc, $intf) = @_;
    configureNetwork2($in, $modules_conf, $::prefix, $netc, $intf);
    $netc->{NETWORKING} = "yes";
    if ($netc->{GATEWAY} || any { $_->{BOOTPROTO} =~ /dhcp/ } values %$intf) {
	$netcnx->{type} = 'lan';
	$netcnx->{NET_DEVICE} = $netc->{NET_DEVICE} = '';
	$netcnx->{NET_INTERFACE} = 'lan'; #$netc->{NET_INTERFACE};
    }
    $::isStandalone and $modules_conf->write;
    1;
}


sub mapIntfToDevice {
    my ($interface) = @_;
    my $hw_addr = c::getHwIDs($interface);
    return {} if $hw_addr =~ /^usb/;
    my ($bus, $slot, $func) = map { hex($_) } ($hw_addr =~ /([0-9a-f]+):([0-9a-f]+)\.([0-9a-f]+)/);
    $hw_addr && (every { defined $_ } $bus, $slot, $func) ?
      grep { $_->{pci_bus} == $bus && $_->{pci_device} == $slot && $_->{pci_function} == $func } detect_devices::probeall() : {};
}


# return list of [ intf_name, module, device_description ] tuples such as:
# [ "eth0", "3c59x", "3Com Corporation|3c905C-TX [Fast Etherlink]" ]
#
# this function try several method in order to get interface's driver and description in order to support both:
# - hotplug managed devices (USB, firewire)
# - special interfaces (IP aliasing, VLAN)
sub get_eth_cards {
    my ($modules_conf) = @_;
    my @all_cards = detect_devices::getNet();

    my @devs = detect_devices::pcmcia_probe();
    my $saved_driver;
    # compute device description and return (interface, driver, description) tuples:
    return map {
        my $interface = $_;
        my $description;
        # 1) get interface's driver through ETHTOOL ioctl:
        my ($a, $detected_through_ethtool);
        $a = c::getNetDriver($interface);
        if ($a) {
            $detected_through_ethtool = 1;
        } else {
            # 2) get interface's driver through module aliases:
            $a = $modules_conf->get_alias($interface);
        }

        # workaround buggy drivers that returns a bogus driver name for the GDRVINFO command of the ETHTOOL ioctl:
        my %fixes = (
                     "p80211_prism2_cs"  => 'prism2_cs',
                     "p80211_prism2_pci" => 'prism2_pci',
                     "p80211_prism2_usb" => 'prism2_usb',
                     "ip1394" => "eth1394",
                     "DL2K" => "dl2k",
                     "hostap" => undef, #- should be either "hostap_plx", "hostap_pci" or "hostap_cs"
                    );
        $a = $fixes{$a} if exists $fixes{$a};

        # 3) try to match a PCMCIA device for device description:
        if (my $b = find { $_->{device} eq $interface } @devs) { # PCMCIA case
            $a = $b->{driver};
            $description = $b->{description};
        } else {
            # 4) try to lookup a device by hardware address for device description:
            #    maybe should have we try sysfs first for robustness?
            ($description) = (mapIntfToDevice($interface))[0]->{description};
        }
        # 5) try to match a device through sysfs for driver & device description:
        #     (eg: ipw2100 driver for intel centrino do not support ETHTOOL)
        if (!$description) {
            my $drv = readlink("/sys/class/net/$interface/driver");
            if ($drv && $drv =~ s!.*/!!) {
                $a = $drv unless $detected_through_ethtool;
                my %l;
                my $dev_path = "/sys/class/net/$interface/device";
                my $sysfs_fields = detect_devices::get_sysfs_device_id_map($dev_path);
                $l{$_} = hex(chomp_(cat_("$dev_path/" . $sysfs_fields->{$_}))) foreach keys %$sysfs_fields;
                my @cards = grep { my $dev = $_; every { $dev->{$_} eq $l{$_} } keys %l } detect_devices::probeall();
                $description = $cards[0]{description} if @cards == 1;
            }
        }
        # 6) try to match a device by driver for device description:
        #    (eg: madwifi, ndiswrapper, ...)
        if (!$description) {
            my @cards = grep { $_->{driver} eq ($a || $saved_driver) } detect_devices::probeall();
            $description = $cards[0]{description} if @cards == 1;
        }
        $a and $saved_driver = $a; # handle multiple cards managed by the same driver
        [ $interface, $saved_driver, if_($description, $description) ];
    } @all_cards;
}

sub get_eth_cards_names {
    my (@all_cards) = @_;
    map { $_->[0] => join(': ', $_->[0], $_->[2]) } @all_cards;
}

#- returns (link_type, mac_address)
sub get_eth_card_mac_address {
    my ($intf) = @_;
    `LC_ALL= LANG= $::prefix/sbin/ip -o link show $intf 2>/dev/null` =~ m|.*link/(\S+)\s([0-9a-z:]+)\s|;
}

#- write interfaces MAC address in iftab
sub update_iftab() {
    foreach my $intf (detect_devices::getNet()) {
        my ($link_type, $mac_address) = get_eth_card_mac_address($intf) or next;
        #- do not write zeroed MAC addresses in iftab, it confuses ifrename
        $mac_address =~ /^[0:]+$/ and next;
        my $descriptor = ${{ ether => 'mac', ieee1394 => 'mac_ieee1394' }}{$link_type} or next;
        substInFile {
            s/^$intf\s+.*\n//;
            s/^.*\s+$mac_address\n//;
            $_ .= qq($intf\t$descriptor $mac_address\n) if eof;
        } "$::prefix/etc/iftab";
    }
}

# automatic net aliases configuration
sub configure_eth_aliases {
    my ($modules_conf) = @_;
    my @pcmcia_interfaces = map { $_->{device} } detect_devices::pcmcia_probe();
    foreach my $card (get_eth_cards($modules_conf)) {
        if (member($card->[0], @pcmcia_interfaces)) {
            #- do not write aliases for pcmcia cards, or cardmgr will not be loaded
            $modules_conf->remove_alias($card->[0]);
        } else {
            $modules_conf->set_alias($card->[0], $card->[1]);
        }
    }
}

1;