Branch for updates

5 files changed, 645 insertions, 0 deletions

diff --git a/perl-install/modules/any_conf.pm b/perl-install/modules/any_conf.pm
new file mode 100644
index 000000000..3873955b3
--- /dev/null
+++ b/perl-install/modules/any_conf.pm
@@ -0,0 +1,221 @@
+package modules::any_conf; # $Id: any_conf.pm 215411 2007-04-25 12:26:16Z pixel $
+
+use log;
+use common;
+
+
+sub vnew {
+    require modules::modprobe_conf;
+    modules::modprobe_conf->new;
+}
+
+
+sub new {
+    my ($type) = @_;
+    bless {}, ref($type) || $type;
+}
+
+sub modules {
+    my ($conf) = @_;
+    keys %$conf;
+}
+
+sub get_alias {
+    my ($conf, $alias) = @_;
+    $conf->{$alias}{alias};
+}
+sub get_options {
+    my ($conf, $module) = @_;
+    $module = $conf->mapping($module);
+    $conf->{$module}{options};
+}
+sub set_options {
+    my ($conf, $module, $new_option) = @_;
+    $module = $conf->mapping($module);
+    log::explanations(qq(set option "$new_option" for module "$module"));
+    $conf->{$module}{options} = $new_option;
+}
+sub get_parameters {
+    my ($conf, $module) = @_;
+    $module = $conf->mapping($module);
+    map { if_(/(.*)=(.*)/, $1 => $2) } split(' ', $conf->get_options($module));
+}
+
+sub get_probeall {
+    my ($conf, $alias) = @_;
+    $conf->{$alias}{probeall};
+}
+sub _set_probeall {
+    my ($conf, $alias, $modules) = @_;
+    $conf->{$alias}{probeall} = $modules;
+    log::explanations("setting probeall $alias to $modules");
+}
+sub add_probeall {
+    my ($conf, $alias, $module) = @_;
+    $module = $conf->mapping($module);
+    my $modules = join(' ', uniq(split(' ', $conf->{$alias}{probeall}), $module));
+    _set_probeall($conf, $alias, $modules);
+}
+sub remove_probeall {
+    my ($conf, $alias, $module) = @_;
+    $module = $conf->mapping($module);
+    my $modules = join(' ', grep { $_ ne $module } split(' ', $conf->{$alias}{probeall}));
+    _set_probeall($conf, $alias, $modules);
+}
+
+sub set_alias { 
+    my ($conf, $alias, $module) = @_;
+    $module =~ /ignore/ and return;
+    $module = $conf->mapping($module);
+    /\Q$alias/ && $conf->{$_}{alias} && $conf->{$_}{alias} eq $module and return $_ foreach keys %$conf;
+    log::explanations("adding alias $alias to $module");
+    $conf->{$alias}{alias} = $module;
+    $alias;
+}
+
+
+sub remove_alias {
+    my ($conf, $name) = @_;
+    log::explanations(qq(removing alias "$name"));
+    $conf->remove_alias_regexp("^$name\$");
+}
+
+sub remove_alias_regexp {
+    my ($conf, $aliased) = @_;
+    log::explanations(qq(removing all aliases that match "$aliased"));
+    foreach (keys %$conf) {
+        delete $conf->{$_}{alias} if /$aliased/;
+    }
+}
+
+sub remove_alias_regexp_byname {
+    my ($conf, $name) = @_;
+    log::explanations(qq(removing all aliases which names match "$name"));
+    foreach (keys %$conf) {
+        delete $conf->{$_} if /$name/;
+    }
+}
+
+sub remove_module {
+    my ($conf, $module) = @_;
+    return if !$module;
+    $module = $conf->mapping($module);
+    foreach my $file ("$::prefix/etc/modules", "$::prefix/etc/modprobe.preload") {
+        substInFile {
+            undef $_ if /^$module/;
+        } $file;
+    }
+    
+    $conf->remove_alias($module);
+    log::explanations("removing module $module");
+    delete $conf->{$module};
+    0;
+}
+
+sub set_sound_slot {
+    my ($conf, $alias, $module) = @_;
+    $module = $conf->mapping($module);
+    if (my $old = $conf->get_alias($alias)) {
+	$conf->set_above($old, undef);
+    }
+    $conf->set_alias($alias, $module);
+    $conf->set_above($module, 'snd-pcm-oss') if $module =~ /^snd-/;
+}
+
+
+sub read {
+    my (undef, $o_file) = @_;
+
+    my $conf = vnew();
+    $conf->read($o_file);
+}
+
+sub write {
+    my ($conf, $o_file) = @_;
+    my $file = $o_file || $::prefix . $conf->file;
+
+    my %written;
+
+    #- Substitute new config (if config has changed)
+    substInFile {
+	my ($type, $module, $val) = split(' ', chomp_($_), 3);
+	if ($type eq 'post-install' && $module eq 'supermount') {	    
+	    #- remove the post-install supermount stuff.
+	    $_ = '';
+	} elsif (member($type, $conf->handled_fields)) {
+	    my $new_val = $conf->{$module}{$type};
+	    if (!$new_val) {
+		$_ = '';
+	    } elsif ($new_val ne $val) {
+		$_ = "$type $module $new_val\n";
+	    }
+	}
+	$written{$module}{$type} = 1;
+    } $file;
+
+    my $to_add;
+    while (my ($module, $h) = each %$conf) {
+	while (my ($type, $v) = each %$h) {
+	    if ($v && !$written{$module}{$type}) {
+		$to_add .= "$type $module $v\n";
+	    }
+	}
+    }
+    append_to_file($file, $to_add);
+
+    modules::write_preload_conf($conf);
+}
+
+sub merge_into {
+    my ($conf, $conf2) = @_;
+
+    if (ref($conf) eq ref($conf2)) {
+	log::l("merging " . ref($conf));
+	add2hash($conf, $conf2);
+    } else {
+	log::l("not merging modules_conf " . ref($conf2) . " into " . ref($conf));	
+    }
+}
+
+################################################################################
+sub read_handled {
+    my ($conf, $o_file) = @_;
+    my $file = $o_file || $::prefix . $conf->file;
+    my $raw_conf = read_raw($file);
+
+    foreach my $module (keys %$raw_conf) {
+	my $raw = $raw_conf->{$module};
+	my $keep = $conf->{$module} = {};
+	foreach ($conf->handled_fields) {
+	    $keep->{$_} = $raw->{$_} if $raw->{$_};
+	}
+    }
+
+    $conf;
+}
+
+sub read_raw {
+    my ($file) = @_;
+    my %c;
+
+    foreach (cat_($file)) {
+	next if /^\s*#/;
+	s/#.*$//;
+	s/\s+$//;
+
+	# Fix upgrade from ALSA < 0.9.0:
+	s/\b(snd-card-)/snd-/g;
+	# Fix upgrade for unified VIA driver:
+	s/\b(snd-via686|snd-via8233)\b/snd-via82xx/g;
+
+	my ($type, $module, $val) = split(' ', $_, 3) or next;
+
+	$c{$module}{$type} = $val;
+    }
+
+    #- NB: not copying alias options to the module anymore, hopefully not useful :)
+
+    \%c;
+}
+
+1;
diff --git a/perl-install/modules/interactive.pm b/perl-install/modules/interactive.pm
new file mode 100644
index 000000000..8419c16f3
--- /dev/null
+++ b/perl-install/modules/interactive.pm
@@ -0,0 +1,164 @@
+package modules::interactive; # $Id: interactive.pm 253241 2009-02-25 09:28:44Z tv $
+
+use modules;
+use common;
+
+sub config_window {
+    my ($in, $data) = @_;
+    require modules;
+    my $modules_conf = modules::any_conf->read;
+    my %conf = $modules_conf->get_parameters($data->{driver});
+    require modules::parameters;
+    my @l;
+    foreach (modules::parameters::parameters($data->{driver})) {
+	   my ($name, $description) = @$_;
+	   push @l, { label => $name, help => $description,
+		      val => \$conf{$name}, allow_empty_list => 1 };
+    }
+    if (!@l) {
+        $in->ask_warn(N("Error"), N("This driver has no configuration parameter!"));
+        return;
+    }
+    if ($in->ask_from(N("Module configuration"), N("You can configure each parameter of the module here."), \@l)) {
+	   my $options = join(' ', map { if_($conf{$_}, "$_=$conf{$_}") } keys %conf);
+	   my $old_options = $modules_conf->get_options($data->{driver});
+	   if ($options ne $old_options) {
+	       $modules_conf->set_options($data->{driver}, $options);
+	       $modules_conf->write;
+	   }
+    }
+}
+
+sub load_category {
+    my ($in, $modules_conf, $category, $b_auto, $b_at_least_one) = @_;
+
+    my @l;
+    {
+	my $w;
+	my $wait_message = sub { undef $w; $w = wait_load_module($in, $category, @_) };
+	@l = modules::load_category($modules_conf, $category, $wait_message);
+	undef $w; #- help perl_checker
+    }
+    if (my @err = grep { $_ } map { $_->{error} } @l) {
+	my $return = $in->ask_warn('', join("\n", @err));
+	$in->exit(1) if !defined($return);
+    }
+    return @l if $b_auto && (@l || !$b_at_least_one);
+
+    @l = map { $_->{description} } @l;
+
+    if ($b_at_least_one && !@l) {
+	@l = load_category__prompt($in, $modules_conf, $category) or return;
+    }
+
+    load_category__prompt_for_more($in, $modules_conf, $category, @l);
+}
+
+sub load_category__prompt_for_more {
+    my ($in, $modules_conf, $category, @l) = @_;
+
+    (my $msg_type = $category) =~ s/\|.*//;
+
+    while (1) {
+	my $msg = @l ?
+	  [ N("Found %s interfaces", join(", ", map { qq("$_") } @l)),
+	    N("Do you have another one?") ] :
+	  N("Do you have any %s interfaces?", $msg_type);
+
+	my $r = 'No';
+	$in->ask_from_({ messages => $msg,
+			 if_($category =~ m!disk/.*(ide|sata|scsi|hardware_raid|usb|firewire)!, interactive_help_id => 'setupSCSI'),
+		       }, 
+		       [ { list => [ N_("Yes"), N_("No"), N_("See hardware info") ], val => \$r, type => 'list', format => \&translate } ]);
+	if ($r eq "No") { return @l }
+	if ($r eq "Yes") {
+	    push @l, load_category__prompt($in, $modules_conf, $category) || next;
+	} else {
+	    $in->ask_warn('', join("\n", detect_devices::stringlist()));
+	}
+    }
+}
+
+my %category2text = (
+    'bus/usb' => N_("Installing driver for USB controller"),
+    'bus/firewire' => N_("Installing driver for firewire controller %s"),
+    'disk/ide|scsi|hardware_raid|sata|firewire' => N_("Installing driver for hard disk drive controller %s"),
+    list_modules::ethernet_categories() => N_("Installing driver for ethernet controller %s"),
+);
+
+sub wait_load_module {
+    my ($in, $category, $text, $_module) = @_;
+    my $msg = do {
+	if (my $t = $category2text{$category}) {
+	    sprintf(translate($t), $text);
+	} else {
+	    #-PO: the first %s is the card type (scsi, network, sound,...)
+	    #-PO: the second is the vendor+model name
+	    N("Installing driver for %s card %s", $category, $text);
+	}
+    };
+    $in->wait_message(N("Configuring Hardware"), $msg);
+}
+
+sub load_module__ask_options {
+    my ($in, $module_descr, $parameters) = @_;
+
+    #- deep copying
+    my @parameters = map { [ @$_[0, 1] ] } @$parameters;
+
+    if (@parameters) {
+	$in->ask_from('', 
+		      N("You may now provide options to module %s.\nNote that any address should be entered with the prefix 0x like '0x123'", $module_descr), 
+		      [ map { { label => $_->[0], help => $_->[1], val => \$_->[2] } } @parameters ],
+		     ) or return;
+	join(' ', map { if_($_->[2], "$_->[0]=$_->[2]") } @parameters);
+    } else {
+	my $s = $in->ask_from_entry('',
+N("You may now provide options to module %s.
+Options are in format ``name=value name2=value2 ...''.
+For instance, ``io=0x300 irq=7''", $module_descr), N("Module options:")) or return;
+	$s;
+    }
+}
+
+sub load_category__prompt {
+    my ($in, $modules_conf, $category) = @_;
+
+    (my $msg_type = $category) =~ s/\|.*//;
+
+    my %available_modules = map_each { my $dsc = $::b; $dsc =~ s/\s+/ /g; $::a => $dsc ? "$::a ($dsc)" : $::a } modules::category2modules_and_description($category);
+    my $module = $in->ask_from_listf('',
+#-PO: the %s is the driver type (scsi, network, sound,...)
+			       N("Which %s driver should I try?", $msg_type),
+			       sub { $available_modules{$_[0]} },
+			       [ keys %available_modules ]) or return;
+    my $module_descr = $available_modules{$module};
+
+    my $options;
+    require modules::parameters;
+    my @parameters = modules::parameters::parameters($module);
+    if (@parameters && $in->ask_from_list_('',
+formatAlaTeX(N("In some cases, the %s driver needs to have extra information to work
+properly, although it normally works fine without them. Would you like to specify
+extra options for it or allow the driver to probe your machine for the
+information it needs? Occasionally, probing will hang a computer, but it should
+not cause any damage.", $module_descr)), [ N_("Autoprobe"), N_("Specify options") ], 'Autoprobe') ne 'Autoprobe') {
+	$options = load_module__ask_options($in, $module_descr, \@parameters) or return;
+    }
+    while (1) {
+	eval {
+	    my $_w = wait_load_module($in, $category, $module_descr, $module);
+	    log::l("user asked for loading module $module (type $category, desc $module_descr)");
+	    modules::load_and_configure($modules_conf, $module, $options);
+	};
+	return $module_descr if !$@;
+
+	$in->ask_yesorno('',
+N("Loading module %s failed.
+Do you want to try again with other parameters?", $module_descr), 1) or return;
+
+	$options = load_module__ask_options($in, $module_descr, \@parameters) or return;
+    }
+}
+
+1;
diff --git a/perl-install/modules/modprobe_conf.pm b/perl-install/modules/modprobe_conf.pm
new file mode 100644
index 000000000..7c80ee687
--- /dev/null
+++ b/perl-install/modules/modprobe_conf.pm
@@ -0,0 +1,163 @@
+package modules::modprobe_conf; # $Id: modprobe_conf.pm 259199 2009-08-13 10:18:59Z pterjan $
+
+use log;
+use common;
+
+our @ISA = qw(modules::any_conf);
+
+
+sub file { '/etc/modprobe.conf' }
+sub handled_fields { qw(alias options install remove) }
+
+sub mapping {
+    my ($_conf, @modules) = @_;
+    my @l = map { modules::mapping_24_26($_) } @modules;
+    wantarray() ? @l : $l[0];
+}
+
+sub get_above {
+    my ($conf, $module) = @_;
+    $module = $conf->mapping($module);
+
+    my (undef, $after) = parse_non_virtual($module, $conf->{$module}{install}) or return;
+    my ($l, $_other_cmds) = partition_modprobes($after);
+    @$l;
+}
+sub set_above {
+    my ($conf, $module, $o_modules) = @_;
+    $module = $conf->mapping($module);
+    my @modules = $conf->mapping(split(' ', $o_modules || ''));
+
+    { #- first add to "install" command
+	my ($before, $after) = parse_non_virtual($module, $conf->{$module}{install});
+	my ($_previous_modules, $other_cmds) = partition_modprobes($after || '');
+	$after = join('; ', @$other_cmds, map { "/sbin/modprobe $_" } @modules);
+	$conf->{$module}{install} = unparse_non_virtual($module, '--ignore-install', $before, $after);
+    }
+    { #- then to "remove" command
+	my ($before, $after) = parse_non_virtual($module, $conf->{$module}{remove});
+	my ($_previous_modules, $other_cmds) = partition_modprobes($before || '');
+	$before = join('; ', @$other_cmds, map { "/sbin/modprobe -r $_" } @modules);
+	$conf->{$module}{remove} = unparse_non_virtual($module, '-r --ignore-remove', $before, $after);
+    }
+}
+
+sub create_from_old() {
+    #- use module-init-tools script
+    run_program::rooted($::prefix, "/sbin/generate-modprobe.conf", ">", file());
+}
+
+sub read {
+    my ($type, $o_file) = @_;
+
+    my $file = $o_file || do {
+	my $f = $::prefix . file();
+	if (!-e $f && -e "$::prefix/etc/modules.conf") {
+	    create_from_old();
+	}
+	$f;
+    };
+
+    my $conf = modules::any_conf::read_handled($type, $file);
+
+    extract_probeall_field($conf);
+
+    $conf;
+}
+
+sub write {
+    my ($conf, $o_file) = @_;
+
+    remove_probeall_field($conf);
+
+    my $_b = before_leaving { extract_probeall_field($conf) };
+
+    modules::any_conf::write($conf, $o_file);
+}
+
+
+
+################################################################################
+sub remove_braces {
+    my ($s) = @_;
+    $s =~ s/^\s*\{\s*(.*)\s*;\s*\}\s*$/$1/;
+    $s;
+}
+
+sub parse_non_virtual {
+    my ($module, $s) = @_;
+    my ($before, $options, $after) = 
+      $s =~ m!^(?:(.*);)?
+              \s*(?:/sbin/)?modprobe\s+(-\S+\s+)*\Q$module\E
+              \s*(?:&&\s*(.*))?$!x 
+		or return;
+    $options =~ /--ignore-(install|remove)\b/ or return;
+
+    ($before, $after) = map { remove_braces($_ || '') } $before, $after;
+    $after =~ s!\s*;\s*/bin/true$!!;
+
+    $before, $after;
+}
+
+sub unparse_non_virtual {
+    my ($module, $mode, $before, $after) = @_;
+    ($before ? "$before; " : '')
+      . (($before || $after) ? "/sbin/modprobe --first-time $mode $module" : '')
+	. ($after ? " && { $after; /bin/true; }" : '');    
+}
+
+sub partition_modprobes {
+    my ($s) = @_;
+
+    my (@modprobes, @other_cmds);
+    my @l = split(/\s*;\s*/, $s);
+    foreach (@l) {
+	if (m!^(?:/sbin/)?modprobe\s+(?:-r\s+)?(\S+)$!) {
+	    push @modprobes, $1;
+	} else {
+	    push @other_cmds, $1;
+	}
+    }
+    \@modprobes, \@other_cmds;
+}
+
+sub parse_for_probeall {
+    my ($module, $s) = @_;
+
+    parse_non_virtual($module, $s) and return;
+    if ($s =~ /[{&|]/) {
+	log::l("weird install line in modprobe.conf for $module: $s");
+	return;
+    }
+    $s ne '/bin/true' or return; #- we have "alias $module off" here
+
+    $s =~ s!\s*;\s*/bin/true$!!;
+
+    my ($l, $other_cmds) = partition_modprobes($s);
+
+    @$other_cmds ? undef : $l;
+}
+
+sub extract_probeall_field {
+    my ($conf) = @_;
+
+    foreach my $module (keys %$conf) {
+	$conf->{$module}{install} or next;
+	my $l = parse_for_probeall($module, $conf->{$module}{install}) or next;
+
+	$conf->{$module}{probeall} = join(' ', @$l);
+	delete $conf->{$module}{install};
+    }
+}
+
+sub remove_probeall_field {
+    my ($conf) = @_;
+
+    foreach my $module (keys %$conf) {
+	my $modules = delete $conf->{$module}{probeall} or next;
+
+	$conf->{$module}{install} = join('; ', (map { "/sbin/modprobe $_" }    split(' ', $modules)), '/bin/true');
+    }
+}
+
+1;
diff --git a/perl-install/modules/modules_conf.pm b/perl-install/modules/modules_conf.pm
new file mode 100644
index 000000000..b75c4e026
--- /dev/null
+++ b/perl-install/modules/modules_conf.pm
@@ -0,0 +1,70 @@
+package modules::modules_conf; # $Id: modules_conf.pm 228209 2007-09-16 23:09:00Z blino $
+
+use log;
+use common;
+
+our @ISA = qw(modules::any_conf);
+
+
+sub file { '/etc/modules.conf' }
+sub handled_fields { qw(alias above options probeall) }
+
+sub mapping {
+    my ($_conf, @modules) = @_;
+    my @l = map { modules::mapping_26_24($_) } @modules;
+    wantarray() ? @l : $l[0];
+}
+
+sub get_above {
+    my ($conf, $module) = @_;
+    $module = $conf->mapping($module);
+
+    $conf->{$module} && split(' ', $conf->{$module}{above});
+}
+sub set_above {
+    my ($conf, $module, $o_modules) = @_;
+    $module = $conf->mapping($module);
+
+    if ($o_modules) {
+	my $modules = join(' ', $conf->mapping(split(' ', $o_modules)));
+	$conf->{$module}{above} = $modules;
+    } else {
+	delete $conf->{$module}{above};
+    }
+}
+
+sub read {
+    my ($type, $o_file) = @_;
+
+    my $conf = modules::any_conf::read_handled($type, $o_file);
+
+    #- convert old aliases to new probeall
+    foreach my $name ('scsi_hostadapter', 'usb-interface') {
+	my @old_aliases = 
+	  map { $_->[0] } sort { $a->[1] <=> $b->[1] } 
+	  map { if_(/^$name(\d*)/ && $conf->{$_}{alias}, [ $_, $1 || 0 ]) } keys %$conf;
+	foreach my $alias (@old_aliases) {
+	    $conf->add_probeall($name, delete $conf->{$alias}{alias});
+	}
+    }
+
+    $conf;
+}
+
+sub write {
+    my ($conf, $o_file) = @_;
+    my $file = $o_file || do {
+	my $f = $::prefix . file();
+	rename "$::prefix/etc/conf.modules", $f; #- make the switch to new name if needed
+	$f;
+    };
+
+    modules::any_conf::write($conf, $file);
+
+    if ($::isInstall) {
+	require modules::modprobe_conf;
+	modules::modprobe_conf::create_from_old();
+    }
+}
+
+1;
diff --git a/perl-install/modules/parameters.pm b/perl-install/modules/parameters.pm
new file mode 100644
index 000000000..2a6d9df8f
--- /dev/null
+++ b/perl-install/modules/parameters.pm
@@ -0,0 +1,27 @@
+package modules::parameters; # $Id: parameters.pm 215411 2007-04-25 12:26:16Z pixel $
+
+use diagnostics;
+use strict;
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use common;
+use modules;
+
+
+sub parameters {
+  my ($module) = @_;
+
+  if (!$::isStandalone && !$::testing) {
+      ($module) = modules::extract_modules('/tmp', $module);
+  }
+
+  map {
+      chomp;
+      (my $name, $_) = /(\w+):(.*)/s or warn "modules::parameters::parameters($module): unknown line\n";
+      [ $name, $_ ];
+  } common::join_lines(run_program::get_stdout('modinfo', '-p', $module));
+}
+
+1;