diff options
Diffstat (limited to 'perl-install/modules')
| -rw-r--r-- | perl-install/modules/any_conf.pm | 213 | ||||
| -rw-r--r-- | perl-install/modules/interactive.pm | 88 | ||||
| -rw-r--r-- | perl-install/modules/modprobe_conf.pm | 164 | ||||
| -rw-r--r-- | perl-install/modules/modules_conf.pm | 71 | ||||
| -rw-r--r-- | perl-install/modules/parameters.pm | 47 |
5 files changed, 504 insertions, 79 deletions
diff --git a/perl-install/modules/any_conf.pm b/perl-install/modules/any_conf.pm new file mode 100644 index 000000000..c235e84f4 --- /dev/null +++ b/perl-install/modules/any_conf.pm @@ -0,0 +1,213 @@ +package modules::any_conf; + +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 (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+$//; + + 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 index 51c58cc85..dae135889 100644 --- a/perl-install/modules/interactive.pm +++ b/perl-install/modules/interactive.pm @@ -1,41 +1,42 @@ package modules::interactive; -use interactive; + use modules; use common; sub config_window { my ($in, $data) = @_; require modules; - modules::mergein_conf('/etc/modules.conf'); - my %conf = modules::get_parameters($data->{driver}); + 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, $format, $description) = @$_; - push @l, { label => $name, help => join("\n", $description, if_(c::kernel_version() !~ /^\Q2.6/, "[$format]")), - val => \$conf{$name}, allow_empty_list => 1 }; + 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; } - # BUG: once we've released mdk9.2 and unfreeze cooker, morph this - # into a proper error dialog with a nice error message (but - # for now we cannot due to string freeze :-() - @l = { label => N("Parameters"), help => "", val => N("NONE"), allow_empty_list => 1 } if !@l; 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); - if ($options) { - modules::set_options($data->{driver}, $options); - modules::write_conf(); - } + my $options = join(' ', map { if_($conf{$_} =~ /^\S+$/, "$_=$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, $category, $b_auto, $b_at_least_one) = @_; + 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($category, $wait_message); + @l = modules::load_category($modules_conf, $category, $wait_message); undef $w; #- help perl_checker } if (my @err = grep { $_ } map { $_->{error} } @l) { @@ -47,72 +48,85 @@ sub load_category { @l = map { $_->{description} } @l; if ($b_at_least_one && !@l) { - @l = load_category__prompt($in, $category) or return; + @l = load_category__prompt($in, $modules_conf, $category) or return; } - load_category__prompt_for_more($in, $category, @l); + load_category__prompt_for_more($in, $modules_conf, $category, @l); } sub load_category__prompt_for_more { - my ($in, $category, @l) = @_; + my ($in, $modules_conf, $category, @l) = @_; (my $msg_type = $category) =~ s/\|.*//; while (1) { my $msg = @l ? - [ N("Found %s %s interfaces", join(", ", map { qq("$_") } @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/scsi|, interactive_help_id => 'setupSCSI'), + 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, $category) || next; + 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/card_reader|ide|scsi|hardware_raid|sata|firewire|virtual' => 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) = @_; - $in->wait_message('', - [ - #-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), if_($::expert, N("(module %s)", $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) = @_; - my @parameters = map { [ @$_[0, 1, 2] ] } @$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] . ($_->[1] ? " ($_->[1])" : ''), help => $_->[2], val => \$_->[3] } } @parameters ], + [ map { { label => $_->[0], help => $_->[1], val => \$_->[2] } } @parameters ], ) or return; - [ map { if_($_->[3], "$_->[0]=$_->[3]") } @parameters ]; + 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; - [ split ' ', $s ]; + $s; } } sub load_category__prompt { - my ($in, $category) = @_; + my ($in, $modules_conf, $category) = @_; (my $msg_type = $category) =~ s/\|.*//; - my %available_modules = map_each { $::a => $::b ? "$::a ($::b)" : $::a } modules::category2modules_and_description($category); + + 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), @@ -135,7 +149,7 @@ not cause any damage.", $module_descr)), [ N_("Autoprobe"), N_("Specify options" 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([ $module, @$options ]); + modules::load_and_configure($modules_conf, $module, $options); }; return $module_descr if !$@; diff --git a/perl-install/modules/modprobe_conf.pm b/perl-install/modules/modprobe_conf.pm new file mode 100644 index 000000000..7989096f8 --- /dev/null +++ b/perl-install/modules/modprobe_conf.pm @@ -0,0 +1,164 @@ +package modules::modprobe_conf; + +use log; +use common; +# perl_checker: require modules::any_conf + +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..be4b8fca4 --- /dev/null +++ b/perl-install/modules/modules_conf.pm @@ -0,0 +1,71 @@ +package modules::modules_conf; + +use log; +use common; +# perl_checker: require modules::any_conf + +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 index 66590f7d8..36990b5d1 100644 --- a/perl-install/modules/parameters.pm +++ b/perl-install/modules/parameters.pm @@ -1,4 +1,4 @@ -package modules::parameters; # $Id$ +package modules::parameters; use diagnostics; use strict; @@ -13,48 +13,11 @@ use modules; sub parameters { my ($module) = @_; - if (!$::isStandalone && !$::testing) { - ($module) = modules::extract_modules('/tmp', $module); - } - - my @parameters; - foreach (common::join_lines(run_program::get_stdout('modinfo', '-p', $module))) { + map { chomp; - next if /^warning:/; - (my $name, $_) = /(\w+)(?::|\s+)(.*)/s or warn "modules::parameters::get_options_name($module): unknown line\n"; - if (c::kernel_version() =~ /^\Q2.6/) { - push @parameters, [ $name, '', $_ ]; - next; - } - - my $c_types = 'int|string|short|byte|char|long'; - my ($is_a_number, $description, $min, $max) = (0, '', 1, 1); - if (/^($c_types) array \(min = (\d+), max = (\d+)\),?\s*(.*)/s) { - $_ = $4; - #- seems like "char" are buggy entries - ($is_a_number, $min, $max) = ($1 ne 'string', $2, $3) if $1 ne 'char'; - } elsif (/^($c_types),?\s*(.*)/s) { - $_ = $2; - #- here "char" really are size-limited strings, modinfo doesn't display the size limit (but since we don't care about it, it doesn't matter :) - $is_a_number = $1 ne 'string' if $1 ne 'char'; - } else { - #- for things like "no format character" or "unknown format character" - } - if (/^description "(.*)",?\s*/s) { - ($description, $_) = ($1, $2); - } - #- print "STILL HAVE ($_)\n" if $_; - - my $format = $min == 1 && $max == 1 ? - ($is_a_number ? N("a number") : '') : - $min == $max ? - ($is_a_number ? N("%d comma separated numbers", $min) : N("%d comma separated strings", $min)) : - $min == 1 ? - ($is_a_number ? N("comma separated numbers") : N("comma separated strings")) : - ''; #- too weird and buggy, do not display it - push @parameters, [ $name, $format, $description ]; - } - @parameters; + (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; |