diff options
Diffstat (limited to 'perl-install/modules')
| -rw-r--r-- | perl-install/modules/any_conf.pm | 117 | ||||
| -rw-r--r-- | perl-install/modules/interactive.pm | 32 | ||||
| -rw-r--r-- | perl-install/modules/modprobe_conf.pm | 108 | ||||
| -rw-r--r-- | perl-install/modules/modules_conf.pm | 40 |
4 files changed, 281 insertions, 16 deletions
diff --git a/perl-install/modules/any_conf.pm b/perl-install/modules/any_conf.pm new file mode 100644 index 000000000..10d21e712 --- /dev/null +++ b/perl-install/modules/any_conf.pm @@ -0,0 +1,117 @@ +package modules::any_conf; + +use log; +use common; + + +sub vnew { + if (0 && c::kernel_version() =~ /^\Q2.6/) { + require modules::modprobe_conf; + modules::modprobe_conf->new; + } else { + require modules::modules_conf; + modules::modules_conf->new; + } +} + + +sub new { + my ($type) = @_; + bless {}, ref($type) || $type; +} + +sub read { + my ($_type, $o_file) = @_; + + my $conf = vnew(); + my $raw_conf = modules::read_conf($o_file || "$::prefix/etc/modules.conf"); + foreach my $key (keys %$raw_conf) { + my $raw = $raw_conf->{$key}; + my $keep = $conf->{$key} = {}; + $keep->{alias} ||= $raw->{alias}; + $keep->{above} ||= $raw->{above}; + $keep->{options} = $raw->{options} if $raw->{options}; + push @{$keep->{probeall} ||= []}, deref($raw->{probeall}) if $raw->{probeall}; + } + $conf; +} + +sub write { + my ($conf) = @_; + modules::write_conf($conf); +} + +sub modules { + my ($conf) = @_; + keys %$conf; +} + +sub get_alias { + my ($conf, $alias) = @_; + $conf->{$alias}{alias}; +} +sub get_options { + my ($conf, $name) = @_; + $conf->{$name}{options}; +} +sub set_options { + my ($conf, $name, $new_option) = @_; + log::l(qq(set option "$new_option" for module "$name")); + $conf->{$name}{options} = $new_option; +} +sub get_parameters { + my ($conf, $name) = @_; + map { if_(/(.*)=(.*)/, $1 => $2) } split(' ', $conf->get_options($name)); +} + + +sub set_alias { + my ($conf, $alias, $module) = @_; + $module =~ /ignore/ and return; + /\Q$alias/ && $conf->{$_}{alias} && $conf->{$_}{alias} eq $module and return $_ foreach keys %$conf; + log::l("adding alias $alias to $module"); + $conf->{$alias}{alias} = $module; + $alias; +} + + +sub remove_alias { + my ($conf, $name) = @_; + log::l(qq(removing alias "$name")); + $conf->remove_alias_regexp("^$name\$"); +} + +sub remove_alias_regexp { + my ($conf, $aliased) = @_; + log::l(qq(removing all aliases that match "$aliased")); + foreach (keys %$conf) { + delete $conf->{$_}{alias} if /$aliased/; + } +} + +sub remove_alias_regexp_byname { + my ($conf, $name) = @_; + log::l(qq(removing all aliases which names match "$name")); + foreach (keys %$conf) { + delete $conf->{$_} if /$name/; + } +} + +sub remove_module { + my ($conf, $name) = @_; + $conf->remove_alias($name); + log::l("removing module $name"); + delete $conf->{$name}; + 0; +} + +sub set_sound_slot { + my ($conf, $alias, $module) = @_; + if (my $old = $conf->get_alias($alias)) { + $conf->remove_above($old); + } + $conf->set_alias($alias, $module); + $conf->set_above($module, 'snd-pcm-oss') if $module =~ /^snd-/; +} + +1; diff --git a/perl-install/modules/interactive.pm b/perl-install/modules/interactive.pm index 2faf84a0c..a05f0a39e 100644 --- a/perl-install/modules/interactive.pm +++ b/perl-install/modules/interactive.pm @@ -6,8 +6,8 @@ use common; sub config_window { my ($in, $data) = @_; require modules; - modules::mergein_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})) { @@ -22,20 +22,20 @@ sub config_window { 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(); - } + $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,20 +47,20 @@ 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); @@ -71,7 +71,7 @@ sub load_category__prompt_for_more { [ { 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())); } @@ -98,18 +98,18 @@ sub load_module__ask_options { 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 ], ) or return; - [ map { if_($_->[3], "$_->[0]=$_->[3]") } @parameters ]; + join(' ', map { if_($_->[3], "$_->[0]=$_->[3]") } @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); @@ -135,7 +135,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..8b1e8305f --- /dev/null +++ b/perl-install/modules/modprobe_conf.pm @@ -0,0 +1,108 @@ +package modules::modprobe_conf; + +use log; +use common; + +our @ISA = qw(modules::any_conf); + + +sub get_above { + my ($conf, $name) = @_; + after_modules($name, $conf->{$name}{install}); +} +sub set_above { + my ($conf, $name, $modules) = @_; + #TODO +} + +sub get_probeall { + my ($conf, $alias) = @_; + #TODO +} +sub add_probeall { + my ($conf, $alias, $module) = @_; + + #TODO + my $l = $conf->{$alias}{probeall} ||= []; + @$l = uniq(@$l, $module); + log::l("setting probeall $alias to @$l"); +} +sub remove_probeall { + my ($conf, $alias, $module) = @_; + + #TODO + my $l = $conf->{$alias}{probeall} ||= []; + @$l = grep { $_ ne $module } @$l; + log::l("setting probeall $alias to @$l"); +} + + + +################################################################################ +sub remove_braces { + my ($s) = @_; + $s =~ s/^\s*\{\s*(.*)\s*;\s*\}\s*$/$1/; + $s; +} + +sub 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 after_modules { + my ($module, $s) = @_; + my (undef, $after) = non_virtual($module, $s) or return; + +} + +sub probeall { + my ($module, $s) = @_; + + 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 = split(/\s*;\s*/, $s); + + [ map { + if (m!^(?:/sbin/)?modprobe\s+(\S+)$!) { + $1 + } else { + log::l("weird probeall string $_ (from install $module $s)"); + (); + } + } @l ]; +} + +sub parse { + my ($type, $module, $s) = @_; + + member($type, 'install', 'remove') or return; + + if (my ($before, $after) = non_virtual($module, $s)) { + [ + if_($after, [ "post-$type", $after ]), + if_($before, [ "pre-$type", $before ]), + ]; + } elsif (my $l = probeall($module, $s)) { + [ [ 'probeall', @$l ] ]; + } +} + +1; diff --git a/perl-install/modules/modules_conf.pm b/perl-install/modules/modules_conf.pm new file mode 100644 index 000000000..2a720fc70 --- /dev/null +++ b/perl-install/modules/modules_conf.pm @@ -0,0 +1,40 @@ +package modules::modules_conf; + +use log; +use common; + +our @ISA = qw(modules::any_conf); + +sub get_above { + my ($conf, $name) = @_; + $conf->{$name} && $conf->{$name}{above}; +} +sub set_above { + my ($conf, $name, $modules) = @_; + $conf->{$name}{above} = $modules; +} +sub remove_above { + my ($conf, $name) = @_; + delete $conf->{$name}{above}; +} + +sub get_probeall { + my ($conf, $alias) = @_; + $conf->{$alias}{probeall}; +} +sub add_probeall { + my ($conf, $alias, $module) = @_; + + my $l = $conf->{$alias}{probeall} ||= []; + @$l = uniq(@$l, $module); + log::l("setting probeall $alias to @$l"); +} +sub remove_probeall { + my ($conf, $alias, $module) = @_; + + my $l = $conf->{$alias}{probeall} ||= []; + @$l = grep { $_ ne $module } @$l; + log::l("setting probeall $alias to @$l"); +} + +1; |