summaryrefslogtreecommitdiffstats
path: root/perl-install/modules
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/modules')
-rw-r--r--perl-install/modules/any_conf.pm209
-rw-r--r--perl-install/modules/interactive.pm151
-rw-r--r--perl-install/modules/modprobe_conf.pm163
-rw-r--r--perl-install/modules/modules_conf.pm70
-rw-r--r--perl-install/modules/parameters.pm60
5 files changed, 0 insertions, 653 deletions
diff --git a/perl-install/modules/any_conf.pm b/perl-install/modules/any_conf.pm
deleted file mode 100644
index 28e22bf9b..000000000
--- a/perl-install/modules/any_conf.pm
+++ /dev/null
@@ -1,209 +0,0 @@
-package modules::any_conf; # $Id$
-
-use log;
-use common;
-
-
-sub vnew {
- if (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 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::l(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::l("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::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, $module) = @_;
- $module = $conf->mapping($module);
- $conf->remove_alias($module);
- log::l("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 = modules::any_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 read_handled {
- my ($conf, $o_file) = @_;
- my $file = $o_file || $::prefix . $conf->file;
- my $raw_conf = modules::any_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+$//;
-
- s/\b(snd-card-)/snd-/g;
- 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
deleted file mode 100644
index 0788bb83c..000000000
--- a/perl-install/modules/interactive.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-package modules::interactive;
-use interactive;
-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, $format, $description) = @$_;
- push @l, { label => $name, help => join("\n", $description, if_(c::kernel_version() !~ /^\Q2.6/, "[$format]")),
- val => \$conf{$name}, allow_empty_list => 1 };
- }
- # 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_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/scsi|, 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()));
- }
- }
-}
-
-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))
- ]);
-}
-
-sub load_module__ask_options {
- my ($in, $module_descr, $parameters) = @_;
-
- my @parameters = map { [ @$_[0, 1, 2] ] } @$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 ],
- ) or return;
- 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;
- $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
deleted file mode 100644
index b2a57717d..000000000
--- a/perl-install/modules/modprobe_conf.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-package modules::modprobe_conf; # $Id$
-
-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);
- join(' ', @$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; " : '')
- . "/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
deleted file mode 100644
index afcf08b35..000000000
--- a/perl-install/modules/modules_conf.pm
+++ /dev/null
@@ -1,70 +0,0 @@
-package modules::modules_conf; # $Id$
-
-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} && $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
deleted file mode 100644
index 66590f7d8..000000000
--- a/perl-install/modules/parameters.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package modules::parameters; # $Id$
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common;
-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))) {
- 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;
-}
-
-1;
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-22 16:11:54 +0000