summaryrefslogtreecommitdiffstats
path: root/perl-install/install/any.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/install/any.pm')
-rw-r--r--perl-install/install/any.pm1690
1 files changed, 1690 insertions, 0 deletions
diff --git a/perl-install/install/any.pm b/perl-install/install/any.pm
new file mode 100644
index 000000000..4ea2ce45d
--- /dev/null
+++ b/perl-install/install/any.pm
@@ -0,0 +1,1690 @@
+package install::any;
+
+use strict;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(addToBeDone);
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use feature 'state';
+use common;
+use run_program;
+use fs::type;
+use fs::format;
+use fs::any;
+use partition_table;
+use devices;
+use modules;
+use detect_devices;
+use install::media 'getFile_';
+use lang;
+use any;
+use log;
+
+=head1 SYNOPSYS
+
+Misc installer specific functions
+
+=head1 Functions
+
+=over
+
+=cut
+
+our @advertising_images;
+
+=item drakx_version($o)
+
+Returns DrakX version as stored in C<install/stage2/VERSION> file
+
+=cut
+
+sub drakx_version {
+ my ($o) = @_;
+
+ my $version = cat__(getFile_($o->{stage2_phys_medium}, "install/stage2/VERSION"));
+ sprintf "DrakX v%s", chomp_($version);
+}
+
+#-######################################################################################
+#- Functions
+#-######################################################################################
+sub dont_run_directly_stage2() {
+ readlink("/usr/bin/runinstall2") eq "runinstall2.sh";
+}
+
+=item is_network_install($o)
+
+Is it a network install?
+
+=cut
+
+sub is_network_install {
+ my ($o) = @_;
+ member($o->{method}, qw(ftp http nfs));
+}
+
+=item spawnShell()
+
+Starts a shell on tty2
+
+=cut
+
+sub spawnShell() {
+ return if $::local_install || $::testing;
+
+ my $shellpid_file = '/var/run/drakx_shell.pid';
+ return if -e $shellpid_file && -d '/proc/' . chomp_(cat_($shellpid_file));
+
+ if (my $shellpid = fork()) {
+ output($shellpid_file, $shellpid);
+ return;
+ }
+
+ #- why not :pp
+ $ENV{DISPLAY} ||= ":0" if $::o->{interactive} eq "gtk";
+
+ local *F;
+ sysopen F, "/dev/tty2", 2 or log::l("cannot open /dev/tty2 -- no shell will be provided: $!"), goto cant_spawn;
+
+ open STDIN, "<&F" or goto cant_spawn;
+ open STDOUT, ">&F" or goto cant_spawn;
+ open STDERR, ">&F" or goto cant_spawn;
+ close F;
+
+ print drakx_version($::o), "\n";
+
+ c::setsid();
+
+ ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!";
+
+ my @args; -e '/etc/bashrc' and @args = qw(--rcfile /etc/bashrc);
+ foreach (qw(/bin/bash /usr/bin/busybox /bin/sh)) {
+ -x $_ or next;
+ my $program_name = /busybox/ ? "/bin/sh" : $_; #- since perl_checker is too dumb
+ exec { $_ } $program_name, @args or log::l("exec of $_ failed: $!");
+ }
+
+ log::l("cannot open any shell");
+cant_spawn:
+ c::_exit(1);
+}
+
+=item getAvailableSpace($o)
+
+Returns available space
+
+=cut
+
+sub getAvailableSpace {
+ my ($o) = @_;
+ fs::any::getAvailableSpace($o->{fstab});
+}
+
+sub preConfigureTimezone {
+ my ($o) = @_;
+ require timezone;
+
+ #- cannot be done in install cuz' timeconfig %post creates funny things
+ add2hash($o->{timezone}, timezone::read()) if $o->{isUpgrade};
+
+ $o->{timezone}{timezone} ||= timezone::bestTimezone($o->{locale}{country});
+
+ my $utc = every { !isFat_or_NTFS($_) } @{$o->{fstab}};
+ my $ntp = timezone::ntp_server();
+ add2hash_($o->{timezone}, { UTC => $utc, ntp => $ntp });
+
+ #- Make the timezone available to urpm::mirrors.
+ write_installer_timezone($o->{timezone});
+}
+
+=item write_installer_timezone($timezone)
+
+Writes a minimal version of $timezone to /etc/sysconfig/clock for use by urpm::mirrors
+
+=cut
+
+sub write_installer_timezone {
+ my ($timezone) = @_;
+ mkdir_p('/etc/sysconfig/');
+ setVarsInSh('/etc/sysconfig/clock', { ZONE => $timezone->{timezone} });
+}
+
+=item ask_suppl_media_method($o)
+
+Enables to add supplementary media
+
+=cut
+
+sub ask_suppl_media_method {
+ my ($o) = @_;
+ our $suppl_already_asked;
+
+ my $msg = $suppl_already_asked
+ ? N("Do you have further supplementary media?")
+ : formatAlaTeX(
+#-PO: keep the double empty lines between sections, this is formatted a la LaTeX
+ N("The following media have been found and will be used during install: %s.
+
+
+Do you have a supplementary installation medium to configure?",
+ "\n\n\n" . join(",\n\n", map { "- $_->{name}" . ($_->{ignore} ? " (disabled)" : '') } install::media::allMediums($o->{packages}))));
+
+ my %l = my @l = (
+ '' => N("None"),
+ 'http' => N("Network (HTTP)"),
+ 'ftp' => N("Network (FTP)"),
+ 'nfs' => N("Network (NFS)"),
+ );
+
+ $o->ask_from_({ messages => $msg,
+ interactive_help_id => 'add_supplemental_media',
+ },
+ [ {
+ val => \my $suppl,
+ list => [ map { $_->[0] } group_by2(@l) ],
+ type => 'list',
+ format => sub { $l{$_[0]} },
+ } ],
+ );
+
+ $suppl_already_asked = 1;
+ $suppl;
+}
+
+=item prep_net_suppl_media($o)
+
+If the supplementary media is networked, but not the main one, network
+support must be installed and network started.
+
+=cut
+
+sub prep_net_suppl_media {
+ my ($o) = @_;
+
+ require network::tools;
+ return if our $net_suppl_media_configured && network::tools::has_network_connection();
+ $net_suppl_media_configured = 1;
+
+ # needed so that one can install basesystem-minimal before adding suppl network media:
+ install::media::update_media($o->{packages});
+ require urpm::media;
+ urpm::media::configure($o->{packages});
+
+ #- install basesystem-minimal now
+ $o->do_pkgs->ensure_is_installed('basesystem-minimal', undef, 1);
+
+ # in case of no network install:
+ $o->{net} ||= {};
+ require network::netconnect;
+ network::netconnect::real_main($o->{net}, $o, $o->{modules_conf});
+ require install::interactive;
+ install::interactive::upNetwork($o);
+ sleep(3);
+}
+
+sub ask_suppl_media_url {
+ my ($o, $method, $o_url) = @_;
+
+ if (member($method, qw(ftp http))) {
+ preConfigureTimezone($o);
+ any::ask_mirror_and_downloader($o, $o->{options}, 'downloader_only');
+ $o->{packages}{options}{downloader} = $o->{options}{downloader};
+ any::ask_mirror($o, 'distrib', $o_url);
+ } elsif ($method eq 'nfs') {
+ my ($host, $dir) = $o_url ? $o_url =~ m!nfs://(.*?)(/.*)! : ();
+ $o->ask_from_(
+ { title => N("NFS setup"),
+ messages => N("Please enter the hostname and directory of your NFS media"),
+ focus_first => 1,
+ callbacks => {
+ complete => sub {
+ $host or $o->ask_warn('', N("Hostname missing")), return 1, 0;
+ $dir eq '' || begins_with($dir, '/') or $o->ask_warn('', N("Directory must begin with \"/\"")), return 1, 1;
+ 0;
+ },
+ } },
+ [ { label => N("Hostname of the NFS mount ?"), val => \$host },
+ { label => N("Directory"), val => \$dir } ],
+ ) or return;
+ $dir =~ s!/+$!!;
+ $dir ||= '/';
+ "nfs://$host$dir";
+ } else { internal_error("bad method $method") }
+}
+
+
+=item selectSupplMedia($o)
+
+Offers to add a supplementary media. If yes, ask which mirror to use, ...
+
+=cut
+
+sub selectSupplMedia {
+ my ($o) = @_;
+ my $url;
+
+ ask_method:
+ my $method = ask_suppl_media_method($o) or return;
+
+ #- configure network if needed
+ if (!scalar keys %{$o->{net}{ifcfg}} && $method !~ /^(?:disk)/ && !$::local_install) {
+ prep_net_suppl_media($o);
+ }
+
+ ask_url:
+ $url = ask_suppl_media_url($o, $method, $url) or goto ask_method;
+
+ my $phys_medium = install::media::url2mounted_phys_medium($o, $url, undef, N("Supplementary")) or $o->ask_warn('', formatError($@)), goto ask_url;
+ $phys_medium->{is_suppl} = 1;
+ $phys_medium->{unknown_CD} = 1;
+
+ my $arch = $o->{product_id}{arch};
+ my $field = $phys_medium->{device} ? 'rel_path' : 'url';
+ my $val = $phys_medium->{$field};
+ my $val0 = $val =~ m!^(.*?)(/media)?/?$! && "$1/media";
+ my $val2 = $val =~ m!^(.*?)(/\Q$arch\E)?(/media)?/?$! && "$1/$arch/media";
+
+ foreach (uniq($val0, $val, $val2)) {
+ log::l("trying with $field set to $_");
+ $phys_medium->{$field} = $_;
+
+ #- first, try to find a media.cfg file
+ eval { install::media::get_media_cfg($o, $phys_medium, $o->{packages}, undef, 'force_rpmsrate') };
+ if (!$@) {
+ delete $phys_medium->{unknown_CD}; #- we have a known CD now
+ return 1;
+ }
+ }
+ #- restore it
+ $phys_medium->{$field} = $val;
+
+ #- try using media_info/hdlist.cz
+ my $medium_id = int(@{$o->{packages}{media}});
+ eval { install::media::get_standalone_medium($o, $phys_medium, $o->{packages}, { name => "Supplementary media $medium_id" }) };
+ if (!$@) {
+ log::l("read suppl hdlist (via $method)");
+ delete $phys_medium->{unknown_CD}; #- we have a known CD now
+ return 1;
+ }
+
+ install::media::umount_phys_medium($phys_medium);
+ install::media::remove_from_fstab($o->{all_hds}, $phys_medium);
+ $o->ask_warn('', N("Can't find a package list file on this mirror. Make sure the location is correct."));
+ goto ask_url;
+}
+
+=item load_rate_files($o)
+
+Loads the package rates file (C<rpmsrate>) as well as the C<compssUsers.pl>
+file which contains the package groups GUI.
+
+Both files came from the C<meta-task> package.
+
+=cut
+
+sub load_rate_files {
+ my ($o) = @_;
+ #- must be done after getProvides
+
+ require pkgs;
+ pkgs::read_rpmsrate($o->{packages}, $o->{rpmsrate_flags_chosen}, '/tmp/rpmsrate', $o->{match_all_hardware});
+
+ ($o->{compssUsers}, $o->{gtk_display_compssUsers}) = install::pkgs::readCompssUsers('/tmp/compssUsers.pl');
+
+ defined $o->{compssUsers} or die "Can't read compssUsers.pl file, aborting installation\n";
+}
+
+sub _core_medium() { N("Core Release") }
+
+sub _tainted_medium() { N("Tainted Release") }
+
+sub _nonfree_medium() { N("Nonfree Release") }
+
+# FIXME: move me in ../any.pm or in harddrake::*, might be needed by rpmdrake/harddrake:
+sub is_firmware_needed_ {
+ my ($o) = @_;
+ require list_firmwares;
+ my @l = map { $_->{driver} } detect_devices::probeall();
+ my @need = intersection(\@l, \@list_firmwares::modules_with_nonfree_firmware);
+ log::l("the following driver(s) need nonfree firmware(s): " . join(', ', @need)) if @need;
+
+ require pkgs;
+ my @xpkgs = pkgs::detect_graphical_drivers($o->do_pkgs, undef, 'firmware-only');
+ log::l("the following nonfree firmware(s) are needed for X.org: " . join(', ', @xpkgs)) if @xpkgs;
+
+ my $need_microcode = detect_devices::hasCPUMicrocode();
+ log::l("nonfree firmware is needed for the CPU (microcode)") if $need_microcode;
+
+ if_(@need, 'kernel-firmware-nonfree'), @xpkgs, if_($need_microcode, 'microcode');
+}
+
+=item is_firmware_needed($o)
+
+Is a firmware needed by some HW?
+
+=cut
+
+sub is_firmware_needed {
+ my ($o) = @_;
+ state $res;
+ $res = is_firmware_needed_($o) if !defined $res;
+ $res;
+}
+
+sub msg_if_firmware_needed {
+ my ($o) = @_;
+ return if !is_firmware_needed($o);
+ join("\n",
+ # FIXME: actually can be proprietary drivers (same medium eventually):
+ N("Some hardware on your machine needs some non free firmwares in order for the free software drivers to work."),
+ N("You should enable \"%s\"", _nonfree_medium()),
+ );
+}
+
+=item enable_nonfree_media($medium)
+
+Enable a disabled Nonfree medium.
+
+=cut
+
+sub enable_nonfree_media {
+ my ($medium) = @_;
+ return if $medium->{name} !~ /Nonfree/ || $medium->{name} =~ /32bit/ || !$medium->{ignore};
+ log::l("preselecting $medium->{name}");
+ $medium->{temp_enabled} = 1;
+}
+
+=item enable_core_32bit_media($medium)
+
+Enable a disabled Core 32bit medium.
+
+=cut
+
+sub enable_core_32bit_media {
+ my ($medium) = @_;
+ return if $medium->{name} !~ /Core/ || $medium->{name} !~ /32bit/ || !$medium->{ignore};
+ log::l("preselecting $medium->{name}");
+ $medium->{temp_enabled} = 1;
+}
+
+=item media_screen($o)
+
+Lists available media with their status (enabled/disabled).
+Suggests to enable Nonfree media if needed.
+
+=cut
+
+sub media_screen {
+ my ($o) = @_;
+
+ my $urpm = $o->{packages};
+ # FIXME:
+ # - nice info
+ # - ignore already failed media (such as 32bit media on NFS)
+ # - detect if non-free/tainted were selected previously / are now needed
+ # rpm -qa |grep tainted/non-free
+ # - use red color in that case (gtk+ version? interactive::gtk version?)
+ # - present media as trees (eg 3 main branches (core/nonfree/tainted and sub medium below (release/updates/...)
+ # - enable to add media from the media screen
+ # - introduce 'mandatory' keyword for guessing media that can *not* be disabled
+ my %descriptions = (
+ 'Core Release' => N("\"%s\" contains the various pieces of the systems and its applications", _core_medium()),
+ 'Nonfree Release' => N("\"%s\" contains non free software.\n", _nonfree_medium()) . " " .
+ N("It also contains firmwares needed for certain devices to operate (eg: some ATI/AMD graphic cards, some network cards, some RAID cards, ...)"),
+ 'Tainted Release' => N("\"%s\" contains software that can not be distributed in every country due to software patents.", _tainted_medium()) . " " .
+ N("It also contains software from \"%s\" rebuild with additional capabilities.", _core_medium()),
+ );
+
+ my $nonfree_is_needed = is_firmware_needed($o);
+
+ $o->ask_from_({ messages => join("\n",
+ N("Here you can enable more media if you want."),
+ msg_if_firmware_needed($o)
+ ),
+ interactive_help_id => 'media_selection',
+ focus_first => sub { 1 } }, [
+ map {
+ my $medium = $_;
+ $medium->{temp_enabled} = !$medium->{ignore};
+ my $name = $medium->{name};
+ my ($distribconf, $medium_path) = @{$_->{mediacfg}};
+ my @media_types = split(':', $distribconf->getvalue($medium_path, 'media_type'));
+ my $parent = $distribconf->getvalue($distribconf->getvalue($medium_path, 'updates_for'), 'name');
+ my $non_regular_medium = intersection(\@media_types, [ qw(backports debug source testing) ]);
+ enable_nonfree_media($medium) if $nonfree_is_needed && !$non_regular_medium;
+ enable_core_32bit_media($medium) if arch() eq 'x86_64' && uefi_type() eq 'ia32' && !$non_regular_medium;
+ $non_regular_medium ? () :
+ +{
+ val => \$medium->{temp_enabled}, type => 'bool', text => $name,
+ help => $medium->{update} ? N("This medium provides package updates for medium \"%s\"", $parent) : $descriptions{$name},
+ # 'Core Release' cannot be unselected:
+ disabled => sub {
+ state $parent_media = $parent && urpm::media::name2medium($urpm, $parent);
+ $name =~ /^(?:Core|Main) Release$/ || $parent_media ? !$parent_media->{temp_enabled} : 0;
+ },
+ };
+ } @{$urpm->{media}},
+ ]);
+}
+
+sub enable_choosen_media {
+ my ($o) = @_;
+ my $urpm = $o->{packages};
+
+ # is there some media to enable?
+ my $todo;
+ foreach my $medium (@{$urpm->{media}}) {
+ if ($medium->{temp_enabled} == $medium->{ignore}) {
+ $medium->{ignore} = !$medium->{temp_enabled};
+ if (!$medium->{ignore}) {
+ delete $medium->{ignore};
+ log::l("Medium '$medium->{name}' needs to be updated to be usable");
+ urpm::media::select_media($urpm, $medium->{name});
+ $todo = 1;
+ }
+ }
+ delete $medium->{temp_enabled};
+ }
+ return if !$todo;
+ urpm::media::update_media($urpm, allow_failures => 1, nolock => 1, noclean => 1,
+ callback => \&urpm::download::sync_logger
+ );
+}
+
+=item setPackages($o)
+
+=over 4
+
+=item * Initialize urpmi
+
+=item * Retrieves media.cfg
+
+=item * Offers to add supplementary media (according to the install method)
+
+=item * Offers to enable some disabled media
+
+=item * Ensure we have a kernel and basesystem
+
+=item * Flags package rates
+
+=item * Select default packages according to the computer
+
+=back
+
+=cut
+
+sub setPackages {
+ my ($o) = @_;
+
+ my $urpm;
+ require install::pkgs;
+ {
+ #- clean shared regions very early
+ # (update_media will open rpmdb for listing existing pubkeys,
+ # which may fail when rpm version mistmatches between drakx & chrooted env)
+ install::pkgs::clean_rpmdb_shared_regions();
+ $urpm = $o->{packages} = install::pkgs::empty_packages($o->{keep_unrequested_dependencies});
+
+ my $media = $o->{media} || [ { type => 'media_cfg', url => 'drakx://media' } ];
+ my ($suppl_method, $copy_rpms_on_disk);
+
+ {
+ install::pkgs::start_pushing_error();
+ ($suppl_method, $copy_rpms_on_disk) = install::media::get_media($o, $media, $urpm);
+
+ if ($suppl_method) {
+ 1 while $o->selectSupplMedia;
+ }
+ install::media::update_media($urpm);
+ install::pkgs::popup_errors();
+ }
+
+ install::pkgs::start_pushing_error();
+
+ # in auto-install mode, we enforce selected media, else we respect media.cfg's default:
+ if ($::auto_install && !is_empty_array_ref($o->{enabled_media})) {
+ # respect enabled/disabled media selection:
+ foreach my $medium (@{$urpm->{media}}) {
+ $medium->{temp_enabled} = member($medium->{name}, @{$o->{enabled_media}});
+ }
+ }
+ media_screen($o) if !$::auto_install || member('chooseMedia', @{$::o->{interactiveSteps}});
+ enable_choosen_media($o);
+ my @choosen_media = map { $_->{name} } grep { !$_->{ignore} } @{$urpm->{media}};
+ log::l("choosen media: ", join(', ', @choosen_media));
+ die "no choosen media" if !@choosen_media;
+
+ # actually read synthesis now we have all the ones we want:
+ require urpm::media;
+ urpm::media::configure($urpm);
+
+ install::pkgs::popup_errors();
+
+ install::media::adjust_paths_in_urpmi_cfg($urpm);
+ log::l('urpmi completely set up');
+
+ #- open rpm db according to right mode needed
+ $urpm->{rpmdb} ||= install::pkgs::rpmDbOpen('rebuild_if_needed');
+
+ {
+ my $_wait = $o->wait_message('', N("Looking at packages already installed..."));
+ install::pkgs::selectPackagesAlreadyInstalled($urpm);
+ }
+
+ remove_package_for_upgrade($o);
+
+ mark_skipped_packages($o);
+
+ #- always try to select basic kernel (else on upgrade, kernel will never be updated provided a kernel is already
+ #- installed and provides what is necessary).
+ my $kernel_pkg = install::pkgs::bestKernelPackage($urpm, $o->{match_all_hardware});
+ install::pkgs::selectPackage($urpm, $kernel_pkg, 1);
+ if ($o->{isUpgrade} && $urpm->{sizes}{dkms} && $kernel_pkg =~ /(.*)-latest/) {
+ my $devel_kernel_pkg = "$1-devel-latest";
+ log::l("selecting $devel_kernel_pkg (since dkms was installed)");
+ install::pkgs::select_by_package_names($urpm, [ $devel_kernel_pkg ], 1);
+ }
+
+ install::pkgs::select_by_package_names_or_die($urpm, default_bootloader(), 1) if !$o->{isUpgrade} && !$o->{match_all_hardware};
+ install::pkgs::select_by_package_names_or_die($urpm, ['basesystem'], 1);
+
+ my $rpmsrate_flags_was_chosen = $o->{rpmsrate_flags_chosen};
+
+ put_in_hash($o->{rpmsrate_flags_chosen} ||= {}, rpmsrate_always_flags($o)); #- must be done before pkgs::read_rpmsrate()
+ load_rate_files($o);
+
+ install::media::copy_rpms_on_disk($o) if $copy_rpms_on_disk;
+
+ set_rpmsrate_default_category_flags($o, $rpmsrate_flags_was_chosen);
+
+ push @{$o->{default_packages}}, default_packages($o);
+ select_default_packages($o);
+ }
+
+ if ($o->{isUpgrade}) {
+ my $_w = $o->wait_message('', N("Finding packages to upgrade..."));
+ install::pkgs::selectPackagesToUpgrade($urpm);
+ }
+}
+
+=item remove_package_for_upgrade($o)
+
+Removes packages that must be uninstalled prior to upgrade
+
+=cut
+
+sub remove_package_for_upgrade {
+ my ($o) = @_;
+ my $extension = $o->{upgrade_by_removing_pkgs_matching};
+
+ return if !$extension;
+
+ my $time = time();
+ my ($_w, $wait_message) = $o->wait_message_with_progress_bar;
+ $wait_message->(N("Removing packages prior to upgrade..."));
+ my ($current, $total);
+ my $callback = sub {
+ my (undef, $type, $_id, $subtype, $amount) = @_;
+ if ($type eq 'user') {
+ ($current, $total) = (0, $amount);
+ } elsif ($type eq 'uninst' && $subtype eq 'stop') {
+ $wait_message->('', $current++, $total);
+ }
+ };
+ push @{$o->{default_packages}}, install::pkgs::upgrade_by_removing_pkgs($o->{packages}, $callback, $extension, $o->{isUpgrade});
+ log::l("Removing packages took: ", formatTimeRaw(time() - $time));
+}
+
+=item count_files($dir)
+
+Returns the number of files in $dir
+
+=cut
+
+sub count_files {
+ my ($dir) = @_;
+ -d $dir or return 0;
+ opendir my $dh, $dir or return 0;
+ my @list = grep { !/^\.\.?$/ } readdir $dh;
+ closedir $dh;
+ my $c = 0;
+ foreach my $n (@list) {
+ my $p = "$dir/$n";
+ if (-d $p) { $c += count_files($p) } else { ++$c }
+ }
+ $c;
+}
+
+sub cp_with_progress {
+ my $wait_message = shift;
+ my $_current = shift;
+ my $total = shift;
+ my $dest = pop @_;
+ cp_with_progress_({ keep_special => 1 }, $wait_message, $total, \@_, $dest);
+}
+sub cp_with_progress_ {
+ my ($options, $wait_message, $total, $list, $dest) = @_;
+ @$list or return;
+ @$list == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n";
+
+ -d $dest or $dest = dirname($dest);
+ _cp_with_progress($options, $wait_message, 0, $total, $list, $dest);
+}
+sub _cp_with_progress {
+ my ($options, $wait_message, $current, $total, $list, $dest) = @_;
+
+ foreach my $src (@$list) {
+ my $dest = $dest;
+ -d $dest and $dest .= '/' . basename($src);
+
+ unlink $dest;
+
+ if (-l $src && $options->{keep_special}) {
+ unless (symlink(readlink($src) || die("readlink failed: $!"), $dest)) {
+ warn "symlink: can't create symlink $dest: $!\n";
+ }
+ } elsif (-d $src) {
+ -d $dest or mkdir $dest, (stat($src))[2] or die "mkdir: can't create directory $dest: $!\n";
+ _cp_with_progress($options, $wait_message, $current, $total, [ glob_($src) ], $dest);
+ } else {
+ open(my $F, $src) or die "can't open $src for reading: $!\n";
+ open(my $G, ">", $dest) or die "can't cp to file $dest: $!\n";
+ local $/ = \4096;
+ local $_; while (<$F>) { print $G $_ }
+ chmod((stat($src))[2], $dest);
+ $wait_message->('', ++$current, $total);
+ }
+ }
+ 1;
+}
+
+sub set_rpmsrate_default_category_flags {
+ my ($o, $rpmsrate_flags_was_chosen) = @_;
+
+ #- if no cleaning needed, populate by default, clean is used for second or more call to this function.
+ if ($::auto_install && ($o->{rpmsrate_flags_chosen} || {})->{CAT_ALL}) {
+ $o->{rpmsrate_flags_chosen}{"CAT_$_"} = 1 foreach map { @{$_->{flags}} } @{$o->{compssUsers}};
+ }
+ if (!$rpmsrate_flags_was_chosen && !$o->{isUpgrade}) {
+ #- use default selection seen in compssUsers directly.
+ $_->{selected} = $_->{default_selected} foreach @{$o->{compssUsers}};
+ set_rpmsrate_category_flags($o, $o->{compssUsers});
+ }
+}
+
+sub set_rpmsrate_category_flags {
+ my ($o, $compssUsers) = @_;
+
+ $o->{rpmsrate_flags_chosen}{$_} = 0 foreach grep { /^CAT_/ } keys %{$o->{rpmsrate_flags_chosen}};
+ $o->{rpmsrate_flags_chosen}{"CAT_$_"} = 1 foreach map { @{$_->{flags}} } grep { $_->{selected} } @$compssUsers;
+ $o->{rpmsrate_flags_chosen}{CAT_SYSTEM} = 1;
+ $o->{rpmsrate_flags_chosen}{CAT_MINIMAL_DOCS} = 1;
+}
+
+
+sub rpmsrate_always_flags {
+ my ($o) = @_;
+
+ my $rpmsrate_flags_chosen = {};
+ $rpmsrate_flags_chosen->{qq(META_CLASS"$o->{meta_class}")} = 1;
+ $rpmsrate_flags_chosen->{uc($_)} = 1 foreach grep { $o->{match_all_hardware} || detect_devices::probe_category("multimedia/$_") } modules::sub_categories('multimedia');
+ $rpmsrate_flags_chosen->{uc($_)} = 1 foreach detect_devices::probe_name('Flag');
+ $rpmsrate_flags_chosen->{UTF8} = $o->{locale}{utf8};
+ $rpmsrate_flags_chosen->{BURNER} = 1 if $o->{match_all_hardware} || detect_devices::burners();
+ $rpmsrate_flags_chosen->{DVD} = 1 if $o->{match_all_hardware} || detect_devices::dvdroms();
+ $rpmsrate_flags_chosen->{USB} = 1 if $o->{match_all_hardware} || $o->{modules_conf}->get_probeall("usb-interface");
+ $rpmsrate_flags_chosen->{PCMCIA} = 1 if $o->{match_all_hardware} || detect_devices::hasPCMCIA();
+ $rpmsrate_flags_chosen->{HIGH_SECURITY} = 1 if $o->{security} > 1;
+ $rpmsrate_flags_chosen->{BIGMEM} = 1 if detect_devices::BIGMEM();
+ $rpmsrate_flags_chosen->{SMP} = 1 if $o->{match_all_hardware} || detect_devices::hasSMP();
+ if (!$o->{match_all_hardware} && !defined $o->{compssListLevel} && detect_devices::need_light_desktop()) {
+ log::l("activation light desktop mode (for low resources systems or netbook/nettops)");
+ $rpmsrate_flags_chosen->{LIGHT} = 1;
+ }
+ # FIXME: to be updated!!!
+ $rpmsrate_flags_chosen->{'3D'} = 1 if
+ $o->{match_all_hardware} ||
+ detect_devices::matching_desc__regexp('Matrox.* G[245][05]0') ||
+ detect_devices::matching_desc__regexp('Rage X[CL]') ||
+ detect_devices::matching_desc__regexp('3D Rage (?:LT|Pro)') ||
+ detect_devices::matching_desc__regexp('Voodoo [35]') ||
+ detect_devices::matching_desc__regexp('Voodoo Banshee') ||
+ detect_devices::matching_desc__regexp('8281[05].* CGC') ||
+ detect_devices::matching_desc__regexp('Rage 128') ||
+ detect_devices::matching_desc__regexp('Radeon ') || #- all Radeon card are now 3D with 4.3.0
+ detect_devices::matching_desc__regexp('[nN]Vidia.*T[nN]T2') || #- TNT2 cards
+ detect_devices::matching_desc__regexp('[nN][vV]idia.*NV[56]') ||
+ detect_devices::matching_desc__regexp('[nN][vV]idia.*Vanta') ||
+ detect_devices::matching_desc__regexp('[nN][vV]idia.*[gG]e[fF]orce') || #- GeForce cards
+ detect_devices::matching_desc__regexp('[nN][vV]idia.*NV1[15]') ||
+ detect_devices::matching_desc__regexp('[nN][vV]idia.*Quadro');
+
+ foreach (lang::langsLANGUAGE($o->{locale}{langs})) {
+ $rpmsrate_flags_chosen->{qq(LOCALES"$_")} = 1;
+ }
+ $rpmsrate_flags_chosen->{'CHARSET"' . lang::l2charset($o->{locale}{lang}) . '"'} = 1;
+
+ $rpmsrate_flags_chosen;
+}
+
+sub default_bootloader() {
+ require bootloader;
+ my (undef, $p) = bootloader::get_grub2_pkg();
+ if (is_uefi()) {
+ log::l("defaulting to grub2-efi");
+ } else {
+ log::l("defaulting to grub2");
+ }
+ [ $p ];
+}
+
+=item default_packages($o)
+
+Selects default packages to install according to configuration (FS, HW, ...)
+
+=cut
+
+sub default_packages {
+ my ($o) = @_;
+ my @l;
+
+ sub add_n_log {
+ my ($reason, @packages) = @_;
+ if (@packages) {
+ log::l("selecting " . join(',', @packages) . " because of $reason");
+ push @l, @packages;
+ }
+ }
+
+ add_n_log("/proc/cmdline=~/brltty=/", "brltty") if cat_("/proc/cmdline") =~ /brltty=/;
+ add_n_log("method==nfs", "nfs-utils") if $o->{method} eq "nfs";
+ add_n_log("have RAID", "mdadm") if !is_empty_array_ref($o->{all_hds}{raids});
+ add_n_log("have LVM", "lvm2") if !is_empty_array_ref($o->{all_hds}{lvms});
+ add_n_log("have crypted DM", qw(cryptsetup dmsetup)) if !is_empty_array_ref($o->{all_hds}{dmcrypts});
+ add_n_log("some disks are fake RAID", qw(mdadm dmraid)) if any { fs::type::is_dmraid($_) } @{$o->{all_hds}{hds}};
+ add_n_log("CPU needs microcode", "microcode_ctl") if detect_devices::hasCPUMicrocode();
+ add_n_log("either CPU or GFX needs firmware", is_firmware_needed($o)) if is_firmware_needed($o);
+ add_n_log("CPU needs cpupower", 'cpupower') if detect_devices::hasCPUFreq();
+ add_n_log("APM support needed", 'apmd') if -e "/proc/apm";
+ add_n_log("needed by hardware", detect_devices::probe_name('Pkg'));
+ my @ltmp = map { $_->{BOOTPROTO} eq 'dhcp' ? $_->{DHCP_CLIENT} || 'dhcp-client' : () } values %{$o->{net}{ifcfg}};
+ add_n_log("needed by networking", @ltmp) if @ltmp;
+ # will get auto selected at summary stage for bootloader:
+ add_n_log("needed later at summary stage", qw(acpi acpid));
+ # will get auto selected at summary stage for firewall:
+ add_n_log("needed for firewall/security", qw(shorewall shorewall-ipv6 mandi-ifw));
+ # only needed for CDs/DVDs installations:
+ add_n_log("method='cdrom'", 'perl-Hal-Cdroms') if $o->{method} eq 'cdrom';
+
+ my $dmi_BIOS = detect_devices::dmidecode_category('BIOS');
+ my $dmi_Base_Board = detect_devices::dmidecode_category('Base Board');
+ if ($dmi_BIOS->{Vendor} eq 'COMPAL' && $dmi_BIOS->{Characteristics} =~ /Function key-initiated network boot is supported/
+ || $dmi_Base_Board->{Manufacturer} =~ /^ACER/ && $dmi_Base_Board->{'Product Name'} =~ /TravelMate 610/) {
+ #- FIXME : append correct options (wireless, ...)
+ modules::append_to_modules_loaded_at_startup_for_all_kernels('acerhk');
+ }
+
+ add_n_log("some fs is mounted with quota options", 'quota') if any { $_->{options} =~ /usrquota|grpquota/ } @{$o->{fstab}};
+ @ltmp = uniq(grep { $_ } map { fs::format::package_needed_for_partition_type($_) } @{$o->{fstab}});
+ add_n_log("needed by some fs", @ltmp) if @ltmp;
+
+ # handle locales with specified scripting:
+ my @languages = map { s/\@.*//; $_ } lang::langsLANGUAGE($o->{locale}{langs});
+ my @locale_pkgs = map { URPM::packages_providing($o->{packages}, 'locales-' . $_) } @languages;
+ unshift @l, uniq(map { $_->name } @locale_pkgs);
+
+ uniq(@l);
+}
+
+sub mark_skipped_packages {
+ my ($o) = @_;
+ install::pkgs::skip_packages($o->{packages}, $o->{skipped_packages}) if $o->{skipped_packages};
+}
+
+sub select_default_packages {
+ my ($o) = @_;
+ install::pkgs::select_by_package_names($o->{packages}, $o->{default_packages});
+}
+
+sub unselectMostPackages {
+ my ($o) = @_;
+ install::pkgs::unselectAllPackages($o->{packages});
+ select_default_packages($o);
+}
+
+sub warnAboutRemovedPackages {
+ my ($o, $packages) = @_;
+ my @removedPackages = keys %{$packages->{state}{ask_remove} || {}} or return;
+ if (!$o->ask_yesorno('',
+formatAlaTeX(
+ #-PO: keep the double empty lines between sections, this is formatted a la LaTeX
+ N("The following packages will be removed to allow upgrading your system: %s
+
+
+Do you really want to remove these packages?
+", join(", ", @removedPackages))), 1)) {
+ $packages->{state}{ask_remove} = {};
+ }
+}
+
+sub addToBeDone(&$) {
+ my ($f, $step) = @_;
+
+ return &$f() if $::o->{steps}{$step}{done};
+
+ push @{$::o->{steps}{$step}{toBeDone}}, $f;
+}
+
+sub set_authentication {
+ my ($o) = @_;
+
+ my $when_network_is_up = sub {
+ my ($f) = @_;
+ #- defer running xxx - no network yet
+ addToBeDone {
+ require install::steps;
+ install::steps::upNetwork($o, 'pppAvoided');
+ $f->();
+ } 'configureNetwork';
+ };
+ require authentication;
+ authentication::set($o, $o->{net}, $o->{authentication} ||= {}, $when_network_is_up);
+}
+
+#-###############################################################################
+#- kde stuff
+#-###############################################################################
+sub kdemove_desktop_file {
+ my ($prefix) = @_;
+ my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk);
+
+ #- remove any existing save in Trash of each user and
+ #- move appropriate file there after an upgrade.
+ foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) {
+ renamef("$dir/$_", "$dir/Trash/$_")
+ foreach grep { -e "$dir/$_" } @toMove, grep { /\.rpmorig$/ } all($dir);
+ }
+}
+
+sub log_system_info {
+ my ($o) = @_;
+ log::l("second stage install running (", drakx_version($o), ")");
+ log::l(sprintf("Virtualization=%s", detect_devices::virt_technology() || "none"));
+ log::l(sprintf("Is UEFI=%s", bool2yesno(is_uefi())));
+}
+
+
+#-###############################################################################
+#- auto_install stuff
+#-###############################################################################
+sub auto_inst_file() { "$::prefix/root/drakx/auto_inst.cfg.pl" }
+
+sub report_bug() {
+ any::report_bug('auto_inst' => g_auto_install('', 1));
+}
+
+sub g_auto_install {
+ my ($b_replay, $b_respect_privacy) = @_;
+ my $o = {};
+
+ require install::pkgs;
+ $o->{default_packages} = [ sort @{ install::pkgs::selected_leaves($::o->{packages}) } ];
+
+ my @fields = qw(fs_type hd level mntpoint options parts size VG_name);
+ $o->{partitions} = [ map {
+ my %l; @l{@fields} = @$_{@fields}; \%l;
+ } grep {
+ $_->{mntpoint} && fs::format::known_type($_);
+ } @{$::o->{fstab}} ];
+
+ exists $::o->{$_} and $o->{$_} = $::o->{$_} foreach qw(locale authentication mouse net timezone superuser keyboard users partitioning isUpgrade manualFstab nomouseprobe crypto security security_user autoExitInstall X services postInstall postInstallNonRooted); #- TODO modules bootloader
+
+ local $o->{partitioning}{auto_allocate} = !$b_replay;
+ $o->{autoExitInstall} = !$b_replay;
+ $o->{interactiveSteps} = [ 'doPartitionDisks', 'formatPartitions' ] if $b_replay;
+
+ #- deep copy because we're modifying it below
+ $o->{users} = $b_respect_privacy ? [] : [ @{$o->{users} || []} ];
+
+ # remember selected media:
+ local $o->{enabled_media} = [ map { $_->{name} } grep { !$_->{ignore} } @{$::o->{packages}{media}} ];
+
+ my @user_info_to_remove = (
+ if_($b_respect_privacy, qw(realname pw)),
+ qw(oldu oldg password password2),
+ );
+ $_ = { %{$_ || {}} }, delete @$_{@user_info_to_remove} foreach $o->{superuser}, @{$o->{users} || []};
+
+ if ($b_respect_privacy && $o->{net}) {
+ if (my $type = $o->{net}{type}) {
+ my @net_type_to_remove = qw(passwd login phone_in phone_out);
+ $_ = { %{$_ || {}} }, delete @$_{@net_type_to_remove} foreach $o->{net}{$type};
+ }
+ }
+ my $warn_privacy = $b_respect_privacy ? "!! This file has been simplified to respect privacy when reporting problems.
+# You should use /root/drakx/auto_inst.cfg.pl instead !!\n#" : '';
+
+ require Data::Dumper;
+ my $str = join('',
+"#!/usr/bin/perl -cw
+# $warn_privacy
+# You should check the syntax of this file before using it in an auto-install.
+# You can do this with 'perl -cw auto_inst.cfg.pl' or by executing this file
+# (note the '#!/usr/bin/perl -cw' on the first line).
+", Data::Dumper->Dump([$o], ['$o']));
+ $str =~ s/ {8}/\t/g; #- replace all 8 space char by only one tabulation, this reduces file size so much :-)
+ $str;
+}
+
+sub getAndSaveAutoInstallFloppies {
+ my ($o, $replay) = @_;
+ my $name = ($replay ? 'replay' : 'auto') . '_install';
+ my $dest_dir = "$::prefix/root/drakx";
+
+ eval { modules::load('loop') };
+
+ my $mountdir = "$::prefix/root/aif-mount"; -d $mountdir or mkdir $mountdir, 0755;
+ my $param = 'kickstart=floppy ' . generate_automatic_stage1_params($o);
+
+ my $img = install::media::getAndSaveInstallFloppies($o, $dest_dir, $name) or return;
+
+ {
+ my $dev = devices::set_loop($img) or log::l("couldn't set loopback device"), return;
+ find { eval { fs::mount::mount($dev, $mountdir, $_, 0); 1 } } qw(ext2 vfat ntfs-3g) or return;
+
+ if (-e "$mountdir/menu.lst") {
+ # hd_grub boot disk is different than others
+ substInFile {
+ s/^(\s*timeout.*)/timeout 1/;
+ s/\bautomatic=method:disk/$param/;
+ } "$mountdir/menu.lst";
+ } elsif (-e "$mountdir/syslinux.cfg") {
+ #- make room first
+ unlink "$mountdir/help.msg", "$mountdir/boot.msg";
+
+ substInFile {
+ s/timeout.*/$replay ? 'timeout 1' : ''/e;
+ s/^(\s*append)/$1 $param/;
+ } "$mountdir/syslinux.cfg";
+
+ output "$mountdir/boot.msg", $replay ? '' : "\n0c" .
+"!! If you press enter, an auto-install is going to start.
+ All data on this computer is going to be lost,
+ including any Windows partitions !!
+" . "07\n";
+ }
+
+ {
+ local $o->{partitioning}{clearall} = !$replay;
+ eval { output("$mountdir/auto_inst.cfg", g_auto_install($replay)) };
+ $@ and log::l("Warning: <", formatError($@), ">");
+ }
+
+ fs::mount::umount($mountdir);
+ devices::del_loop($dev);
+ }
+ rmdir $mountdir;
+ $img;
+}
+
+
+sub g_default_packages {
+ my ($o) = @_;
+
+ my ($_h, $file) = media_browser($o, 'save', 'package_list.pl') or return;
+ output($file, selected_leaves_pl($o));
+}
+
+sub selected_leaves_pl {
+ my ($o) = @_;
+
+ require Data::Dumper;
+ my $str = Data::Dumper->Dump([ { default_packages => install::pkgs::selected_leaves($o->{packages}) } ], ['$o']);
+ $str =~ s/ {8}/\t/g;
+
+ "# You should always check the syntax with 'perl -cw auto_inst.cfg.pl'\n" .
+ "# before testing. To use it, boot with ``linux defcfg=floppy''\n" .
+ $str;
+}
+
+sub loadO {
+ my ($O, $f) = @_; $f ||= auto_inst_file();
+ if ($f =~ /^(floppy|patch)$/) {
+ my $f = $f eq "floppy" ? 'auto_inst.cfg' : "patch";
+ my $o;
+ foreach (removable_media__early_in_install()) {
+ my $dev = devices::make($_->{device});
+ foreach my $fs (qw(ext4 vfat ntfs-3g)) {
+ eval { fs::mount::mount($dev, '/mnt', $fs, 'readonly'); 1 } or next;
+ if (my $abs_f = find { -e $_ } "/mnt/$f", "/mnt/$f.pl") {
+ $o = loadO_($O, $abs_f);
+ }
+ fs::mount::umount("/mnt");
+ goto found if $o;
+ }
+ }
+ die "Could not find $f";
+ found:
+ modules::unload(qw(vfat fat));
+ $o;
+ } else {
+ loadO_($O, $f);
+ }
+}
+
+sub loadO_ {
+ my ($O, $f) = @_;
+
+ my $o;
+ {
+ my $fh;
+ if (ref $f) {
+ $fh = $f;
+ } else {
+ -e "$f.pl" and $f .= ".pl" unless -e $f;
+
+ $fh = -e $f ? common::open_file($f) : getFile_($O->{stage2_phys_medium}, $f) || die N("Error reading file %s", $f);
+ }
+ my $s = cat__($fh);
+ close $fh;
+ {
+ no strict;
+ eval $s;
+ $@ and die;
+ }
+ $O and add2hash_($o ||= {}, $O);
+ }
+ $O and bless $o, ref $O;
+
+ handle_old_auto_install_format($o);
+
+ $o;
+}
+
+sub handle_old_auto_install_format {
+ my ($o) = @_;
+
+ #- handle backward compatibility for things that changed
+ foreach (@{$o->{partitions} || []}, @{$o->{manualFstab} || []}) {
+ if (my $type = delete $_->{type}) {
+ if ($type =~ /^(0x)?(\d*)$/) {
+ fs::type::set_pt_type($_, $type);
+ } else {
+ fs::type::set_fs_type($_, $type);
+ }
+ }
+ }
+ #- {rpmsrate_flags_chosen} was called {compssUsersChoice}
+ if (my $rpmsrate_flags_chosen = delete $o->{compssUsersChoice}) {
+ $o->{rpmsrate_flags_chosen} = $rpmsrate_flags_chosen;
+ }
+ #- compssUsers flags are now named CAT_XXX
+ if ($o->{rpmsrate_flags_chosen} &&
+ ! any { /^CAT_/ } keys %{$o->{rpmsrate_flags_chosen}}) {
+ #- we don't really know if this is needed for compatibility, but it won't hurt :)
+ foreach (keys %{$o->{rpmsrate_flags_chosen}}) {
+ $o->{rpmsrate_flags_chosen}{"CAT_$_"} = $o->{rpmsrate_flags_chosen}{$_};
+ }
+ #- it used to be always selected
+ $o->{rpmsrate_flags_chosen}{CAT_SYSTEM} = 1;
+ }
+ if ($o->{updates} && $o->{updates}{mirror}) {
+ $o->{updates}{url} = delete $o->{updates}{mirror};
+ }
+
+ #- backward compatibility for network fields
+ exists $o->{intf} and $o->{net}{ifcfg} = delete $o->{intf};
+ exists $o->{netcnx}{type} and $o->{net}{type} = delete $o->{netcnx}{type};
+ exists $o->{netc}{NET_INTERFACE} and $o->{net}{net_interface} = delete $o->{netc}{NET_INTERFACE};
+ my %netc_translation = (
+ resolv => [ qw(dnsServer dnsServer2 dnsServer3 DOMAINNAME DOMAINNAME2 DOMAINNAME3) ],
+ network => [ qw(NETWORKING FORWARD_IPV4 NETWORKING_IPV6 HOSTNAME GATEWAY GATEWAYDEV NISDOMAIN) ],
+ auth => [ qw(LDAPDOMAIN WINDOMAIN) ],
+ );
+ foreach my $dest (keys %netc_translation) {
+ exists $o->{netc}{$_} and $o->{net}{$dest}{$_} = delete $o->{netc}{$_} foreach @{$netc_translation{$dest}};
+ }
+ delete @$o{qw(netc netcnx)};
+
+ $o;
+}
+
+sub generate_automatic_stage1_params {
+ my ($o) = @_;
+
+ my $method = $o->{method};
+ my @ks;
+
+ if ($o->{method} eq 'http') {
+ $ENV{URLPREFIX} =~ m!(http|ftp)://([^/:]+)(.*)! or die;
+ $method = $1; #- in stage1, FTP via HTTP proxy is available through FTP config, not HTTP
+ @ks = (server => $2, directory => $3);
+ } elsif ($o->{method} eq 'ftp') {
+ require install::ftp;
+ my @l = install::ftp::parse_ftp_url($ENV{URLPREFIX});
+ @ks = (server => $l[0], directory => $l[1], user => $l[2], pass => $l[3]);
+ } elsif ($o->{method} eq 'nfs') {
+ cat_("/proc/mounts") =~ m|(\S+):(\S+)\s+/tmp/media| or internal_error("cannot find nfsimage");
+ @ks = (server => $1, directory => $2);
+ }
+ @ks = (method => $method, @ks);
+
+ if (is_network_install($o)) {
+ if ($ENV{PROXY}) {
+ push @ks, proxy_host => $ENV{PROXY}, proxy_port => $ENV{PROXYPORT};
+ }
+ my $intf = first(values %{$o->{net}{ifcfg}});
+ push @ks, interface => $intf->{DEVICE};
+ if ($intf->{BOOTPROTO} eq 'dhcp') {
+ push @ks, network => 'dhcp';
+ } else {
+ push @ks, network => 'static', ip => $intf->{IPADDR}, netmask => $intf->{NETMASK}, gateway => $o->{net}{network}{GATEWAY};
+ require network::network;
+ if (my @dnss = network::network::dnsServers($o->{net})) {
+ push @ks, dns => $dnss[0];
+ }
+ }
+ }
+
+ #- sync it with ../mdk-stage1/automatic.c
+ my %aliases = (method => 'met', network => 'netw', interface => 'int', gateway => 'gat', netmask => 'netm',
+ adsluser => 'adslu', adslpass => 'adslp', hostname => 'hos', domain => 'dom', server => 'ser',
+ directory => 'dir', user => 'use', pass => 'pas', disk => 'dis', partition => 'par');
+
+ 'automatic=' . join(',', map { ($aliases{$_->[0]} || $_->[0]) . ':' . $_->[1] } group_by2(@ks));
+}
+
+sub find_root_parts {
+ my ($fstab, $prefix) = @_;
+
+ grep { $_->{release} =~ /\b(mandrake|mandrakelinux|mandriva|conectiva|mageia)\b/i }
+ _find_root_parts($fstab, $prefix);
+}
+
+sub _find_root_parts {
+ my ($fstab, $prefix) = @_;
+
+ if ($::local_install) {
+ my $f = common::release_file('/mnt') or return;
+ return common::parse_release_file('/mnt', $f, {});
+ }
+
+ map {
+ my $handle = any::inspect($_, $prefix);
+ if (my $f = $handle && common::release_file($handle->{dir})) {
+ common::parse_release_file($handle->{dir}, $f, $_);
+ } else { () }
+ } grep { isTrueLocalFS($_) } @$fstab;
+}
+
+sub migrate_device_names {
+ my ($all_hds, $from_fstab, $new_root, $root_from_fstab, $o_in) = @_;
+
+ log::l("warning: fstab says root partition is $root_from_fstab->{device}, whereas we were reading fstab from $new_root->{device}");
+ my ($old_prefix, $old_part_number) = devices::simple_partition_scan($root_from_fstab);
+ my ($new_prefix, $new_part_number) = devices::simple_partition_scan($new_root);
+
+ if ($old_part_number != $new_part_number) {
+ log::l("argh, $root_from_fstab->{device} and $old_part_number->{device} are not the same partition number");
+ return;
+ }
+
+ log::l("replacing $old_prefix with $new_prefix");
+
+ my %h;
+ foreach (@$from_fstab) {
+ if ($_->{device} =~ s!^\Q$old_prefix!$new_prefix!) {
+ #- this is simple to handle, nothing more to do
+ } elsif ($_->{part_number}) {
+ my $device_prefix = devices::part_prefix($_);
+ push @{$h{$device_prefix}}, $_;
+ } else {
+ #- hopefully this does not need anything special
+ }
+ }
+ my @from_fstab_per_hds = values %h or return;
+
+
+ my @current_hds = grep { $new_root->{rootDevice} ne $_->{device} } fs::get::hds($all_hds);
+
+ found_one:
+ @from_fstab_per_hds or return;
+
+ foreach my $from_fstab_per_hd (@from_fstab_per_hds) {
+ my ($matching, $other) = partition {
+ my $hd = $_;
+ every {
+ my $wanted = $_;
+ my $part = find { $_->{part_number} eq $wanted->{part_number} } partition_table::get_normal_parts($hd);
+ $part && $part->{fs_type} && fs::type::can_be_this_fs_type($wanted, $part->{fs_type});
+ } @$from_fstab_per_hd;
+ } @current_hds;
+ @$matching == 1 or next;
+
+ my ($hd) = @$matching;
+ @current_hds = @$other;
+ @from_fstab_per_hds = grep { $_ != $from_fstab_per_hd } @from_fstab_per_hds;
+
+ log::l("$hd->{device} nicely corresponds to " . join(' ', map { $_->{device} } @$from_fstab_per_hd));
+ foreach (@$from_fstab_per_hd) {
+ partition_table::compute_device_name($_, $hd);
+ }
+ goto found_one;
+ }
+
+ #- we cannot find one and only one matching hd
+ my @from_fstab_not_handled = map { @$_ } @from_fstab_per_hds;
+ log::l("we still do not know what to do with: " . join(' ', map { $_->{device} } @from_fstab_not_handled));
+
+
+ if (!$o_in) {
+ log::l("well, ignoring them!");
+ return;
+ }
+
+ my $propositions_valid = every {
+ my $wanted = $_;
+ my @parts = grep { $_->{part_number} eq $wanted->{part_number}
+ && $_->{fs_type} && fs::type::can_be_this_fs_type($wanted, $_->{fs_type}) } fs::get::hds_fstab(@current_hds);
+ $wanted->{propositions} = \@parts;
+ @parts > 0;
+ } @from_fstab_not_handled;
+
+ $o_in->ask_from('',
+ N("The following disk(s) were renamed:"),
+ [ map {
+ { label => N("%s (previously named as %s)", $_->{mntpoint}, $_->{device}),
+ val => \$_->{device}, format => sub { $_[0] && $_->{device} },
+ list => [ '',
+ $propositions_valid ? @{$_->{propositions}} :
+ fs::get::hds_fstab(@current_hds) ] };
+ } @from_fstab_not_handled ]);
+}
+
+sub use_root_part {
+ my ($all_hds, $part, $o_in) = @_;
+ return if $::local_install;
+
+ my $migrate_device_names;
+ {
+ my $handle = any::inspect($part, $::prefix) or internal_error();
+
+ my @from_fstab = fs::read_fstab($handle->{dir}, '/etc/fstab', 'keep_default');
+
+ my $root_from_fstab = fs::get::root_(\@from_fstab);
+ if (!fs::get::is_same_hd($root_from_fstab, $part)) {
+ $migrate_device_names = 1;
+ log::l("from_fstab contained: $_->{device} $_->{mntpoint}") foreach @from_fstab;
+ migrate_device_names($all_hds, \@from_fstab, $part, $root_from_fstab, $o_in);
+ log::l("from_fstab now contains: $_->{device} $_->{mntpoint}") foreach @from_fstab;
+ }
+ fs::add2all_hds($all_hds, @from_fstab);
+ log::l("fstab is now: $_->{device} $_->{mntpoint}") foreach fs::get::fstab($all_hds);
+ }
+ isSwap($_) and $_->{mntpoint} = 'swap' foreach fs::get::really_all_fstab($all_hds); #- use all available swap.
+ $migrate_device_names;
+}
+
+sub getHds {
+ my ($o, $o_in) = @_;
+ fs::any::get_hds($o->{all_hds} ||= {}, $o->{fstab} ||= [],
+ $o->{manualFstab}, $o->{partitioning}, $::local_install, $o_in);
+}
+
+sub removable_media__early_in_install() {
+ eval { modules::load('usb_storage', 'sd_mod') } if detect_devices::usbStorage();
+ my $all_hds = fsedit::get_hds({});
+ fs::get_raw_hds('', $all_hds);
+
+ my @l1 = grep { detect_devices::isKeyUsb($_) } @{$all_hds->{hds}};
+ my @l2 = grep { $_->{media_type} eq 'fd' || detect_devices::isKeyUsb($_) } @{$all_hds->{raw_hds}};
+ (fs::get::hds_fstab(@l1), @l2);
+}
+
+my %media_browser;
+sub media_browser {
+ my ($in, $save, $o_suggested_name) = @_;
+
+ my %media_type2text = (
+ fd => N("Floppy"),
+ hd => N("Hard Disk"),
+ cdrom => N("CDROM"),
+ );
+ my @network_protocols = (if_(!$save, N_("HTTP")), if_(0, N_("FTP")), N_("NFS"));
+
+ my $to_text = sub {
+ my ($hd) = @_;
+ ($media_type2text{$hd->{media_type}} || $hd->{media_type}) . ': ' . partition_table::description($hd);
+ };
+
+ ask_media:
+ my $all_hds = fsedit::get_hds({}, $in);
+ fs::get_raw_hds('', $all_hds);
+
+ my @raw_hds = grep { !$save || $_->{media_type} ne 'cdrom' } @{$all_hds->{raw_hds}};
+ my @dev_and_text = group_by2(
+ (map { $_ => $to_text->($_) } @raw_hds),
+ (map {
+ my $hd = $to_text->($_);
+ map { $_ => join('\1', $hd, partition_table::description($_)) } grep { isTrueFS($_) || isOtherAvailableFS($_) } fs::get::hds_fstab($_);
+ } fs::get::hds($all_hds)),
+ if_(is_network_install($::o) || install::steps::hasNetwork($::o),
+ map { $_ => join('\1', N("Network"), translate($_)) } @network_protocols),
+ );
+
+ $in->ask_from_({
+ messages => N("Please choose a media"),
+ }, [
+ { val => \$media_browser{dev}, separator => '\1', list => [ map { $_->[1] } @dev_and_text ] },
+ ]) or return;
+
+ my $dev = (find { $_->[1] eq $media_browser{dev} } @dev_and_text)->[0];
+
+ my $browse = sub {
+ my ($dir) = @_;
+
+ browse:
+ my $file = $in->ask_filename({ save => $save,
+ directory => $dir,
+ if_($o_suggested_name, file => "$dir/$o_suggested_name"),
+ }) or return;
+ if (-e $file && $save) {
+ $in->ask_yesorno('', N("File already exists. Overwrite it?")) or goto browse;
+ }
+ if ($save) {
+ if (!open(my $_fh, ">>$file")) {
+ $in->ask_warn('', N("Permission denied"));
+ goto browse;
+ }
+ $file;
+ } else {
+ common::open_file($file) || goto browse;
+ }
+ };
+ my $inspect_and_browse = sub {
+ my ($dev) = @_;
+
+ if (my $h = any::inspect($dev, $::prefix, $save)) {
+ if (my $file = $browse->($h->{dir})) {
+ return $h, $file;
+ }
+ undef $h; #- help perl
+ } else {
+ $in->ask_warn(N("Error"), formatError($@));
+ }
+ ();
+ };
+
+ if (member($dev, @network_protocols)) {
+ require install::interactive;
+ install::interactive::upNetwork($::o);
+
+ if ($dev eq 'HTTP') {
+ require install::http;
+ $media_browser{url} ||= 'http://';
+
+ while (1) {
+ $in->ask_from('', 'URL', [
+ { val => \$media_browser{url} }
+ ]) or last;
+
+ if ($dev eq 'HTTP') {
+ my $fh = install::http::getFile($media_browser{url});
+ $fh and return '', $fh;
+ }
+ }
+ } elsif ($dev eq 'NFS') {
+ while (1) {
+ $in->ask_from('', 'NFS', [
+ { val => \$media_browser{nfs} }
+ ]) or last;
+
+ my ($kind) = fs::wild_device::analyze($media_browser{nfs});
+ if ($kind ne 'nfs') {
+ $in->ask_warn('', N("Bad NFS name"));
+ next;
+ }
+
+ my $nfs = fs::wild_device::to_subpart($media_browser{nfs});
+ $nfs->{fs_type} = 'nfs';
+
+ if (my ($h, $file) = $inspect_and_browse->($nfs)) {
+ return $h, $file;
+ }
+ }
+ } else {
+ $in->ask_warn('', 'todo');
+ goto ask_media;
+ }
+ } else {
+ if (!$dev->{fs_type} || $dev->{fs_type} eq 'auto' || $dev->{fs_type} =~ /:/) {
+ if (my $p = fs::type::type_subpart_from_magic($dev)) {
+ add2hash($p, $dev);
+ $dev = $p;
+ } else {
+ $in->ask_warn(N("Error"), N("Bad media %s", partition_table::description($dev)));
+ goto ask_media;
+ }
+ }
+
+ if (my ($h, $file) = $inspect_and_browse->($dev)) {
+ return $h, $file;
+ }
+
+ goto ask_media;
+ }
+}
+
+sub X_options_from_o {
+ my ($o) = @_;
+ {
+ freedriver => $o->{freedriver},
+ allowFB => $o->{allowFB},
+ ignore_bad_conf => $o->{isUpgrade} =~ /redhat|conectiva/,
+ };
+}
+
+sub screenshot_dir__and_move() {
+ my ($dir0, $dir1, $dir2) = ('/root', "$::prefix/root", '/tmp');
+ if (-e $dir0 && ! -e '/root/non-chrooted-marker.DrakX') {
+ ($dir0, 'nowarn'); #- it occurs during pkgs install when we are chrooted
+ } elsif (-e $dir1) {
+ my $path = "$dir2/DrakX-screenshots";
+ if (-e $path) {
+ cp_af($path, $dir1);
+ rm_rf($path);
+ }
+ $dir1;
+ } else {
+ $dir2;
+ }
+}
+
+my $warned;
+sub take_screenshot {
+ my ($in) = @_;
+ my ($base_dir, $nowarn) = screenshot_dir__and_move();
+ my $dir = "$base_dir/DrakX-screenshots";
+ if (!-e $dir) {
+ mkdir $dir or $in->ask_warn('', N("Cannot make screenshots before partitioning")), return;
+ }
+ my $nb = 1;
+ $nb++ while -e "$dir/$nb.png";
+ run_program::run('scrot', "$dir/$nb.png");
+
+ # help doesn't remember warning has been shown (one shot processes):
+ $warned ||= -e "$dir/2.png";
+
+ if (!$warned && !$nowarn) {
+ $warned = 1;
+ $in->ask_warn('', N("Screenshots will be available after install in %s", "/root/DrakX-screenshots"));
+ }
+}
+
+sub copy_advertising {
+ my ($o) = @_;
+
+ return if $::rootwidth < 800;
+
+ my $f;
+ my $source_dir = "install/extra/advertising";
+ foreach ("." . $o->{locale}{lang}, "." . substr($o->{locale}{lang},0,2), '') {
+ $f = getFile_($o->{stage2_phys_medium}, "$source_dir$_/list") or next;
+ $source_dir = "$source_dir$_";
+ }
+ if (my @files = <$f>) {
+ my $dir = "$::prefix/tmp/drakx-images";
+ mkdir $dir;
+ unlink glob_("$dir/*");
+ foreach (@files) {
+ chomp;
+ install::media::getAndSaveFile_($o->{stage2_phys_medium}, "$source_dir/$_", "$dir/$_");
+ (my $pl = $_) =~ s/\.png/.pl/;
+ install::media::getAndSaveFile_($o->{stage2_phys_medium}, "$source_dir/$pl", "$dir/$pl");
+ }
+ @advertising_images = map { "$dir/$_" } @files;
+ }
+}
+
+sub remove_advertising() {
+ eval { rm_rf("$::prefix/tmp/drakx-images") };
+ @advertising_images = ();
+}
+
+sub disable_user_view() {
+ substInFile { s/^Browser=.*/Browser=0/ } "$::prefix/etc/X11/gdm/custom.conf";
+ #TODO: Needed for sddm ?
+}
+
+sub set_security {
+ my ($o) = @_;
+ require security::various;
+ return if !-x "$::prefix/usr/sbin/msec";
+ security::level::set($o->{security});
+ security::various::config_security_user($::prefix, $o->{security_user});
+}
+
+sub write_fstab {
+ my ($o) = @_;
+ return if $::local_install || $o->{isUpgrade} && $o->{isUpgrade} !~ /redhat|conectiva/ && !$o->{migrate_device_names};
+ fs::write_fstab($o->{all_hds}, $::prefix);
+}
+
+=item adjust_files_mtime_to_timezone() {
+
+Fixes mtime of a couple important files according to timezone in order to:
+
+=over 4
+
+=item * to ensure linuxconf does not cry against those files being in the future
+
+=item * to ensure fc-cache works correctly on fonts installed after reboot
+
+=back
+
+=cut
+
+sub adjust_files_mtime_to_timezone() {
+ my $timezone_shift = run_program::rooted_get_stdout($::prefix, 'date', '+%z');
+ my ($h, $m) = $timezone_shift =~ /\+(..)(..)/ or return;
+ my $now = time() - ($h * 60 + $m * 60) * 60;
+
+ my @files = (
+ (map { "$::prefix/$_" } '/etc/modules.conf', '/etc/crontab', '/etc/sysconfig/mouse', '/etc/sysconfig/network', '/etc/X11/fs/config'),
+ glob_("$::prefix/var/cache/fontconfig/*"),
+ );
+ log::l("adjust_files_mtime_to_timezone: setting time back $h:$m for files " . join(' ', @files));
+ foreach (@files) {
+ utime $now, $now, $_;
+ }
+}
+
+
+sub move_compressed_image_to_disk {
+ my ($o) = @_;
+
+ our $compressed_image_on_disk;
+ return if $compressed_image_on_disk || $::local_install;
+
+ my $name = 'mdkinst.sqfs';
+ my ($loop, $current_image) = devices::find_compressed_image($name) or return;
+ my $compressed_image_size = (-s $current_image) / 1024; #- put in KiB
+
+ my $dir;
+ if (availableRamMB() > 400) {
+ $dir = '/tmp'; #- on tmpfs
+ } else {
+ my $tmp = fs::get::mntpoint2part('/tmp', $o->{fstab});
+ if ($tmp && fs::df($tmp, $::prefix) / 2 > $compressed_image_size * 1.2) { #- we want at least 20% free afterwards
+ $dir = "$::prefix/tmp";
+ } else {
+ my $root = fs::get::mntpoint2part('/', $o->{fstab});
+ my $root_free_MB = fs::df($root, $::prefix) / 2 / 1024;
+ my $wanted_size_MB = $o->{isUpgrade} || fs::get::mntpoint2part('/usr', $o->{fstab}) ? 150 : 300;
+ log::l("compressed image: root free $root_free_MB MB, wanted at least $wanted_size_MB MB");
+ if ($root_free_MB > $wanted_size_MB) {
+ $dir = $tmp ? $::prefix : "$::prefix/tmp";
+ } else {
+ $dir = '/tmp'; #- on tmpfs
+ if (availableRamMB() < 200) {
+ log::l("ERROR: not much ram (" . availableRamMB() . " MB), we're going in the wall!");
+ }
+ }
+ }
+ }
+ $compressed_image_on_disk = "$dir/$name";
+
+ if ($current_image ne $compressed_image_on_disk) {
+ log::l("move_compressed_image_to_disk: copying $current_image to $compressed_image_on_disk");
+ cp_af($current_image, $compressed_image_on_disk);
+ run_program::run('losetup', '-r', $loop, $compressed_image_on_disk);
+ unlink $current_image if $current_image eq "/tmp/$name";
+ }
+}
+
+sub deploy_server_notify {
+ my ($o) = @_;
+ my $fallback_intf = "eth0";
+ my $fallback_port = 3710;
+
+ my ($server, $port) = $o->{deploy_server} =~ /^(.*?)(?::(\d+))?$/;
+ if ($server) {
+ require network::tools;
+ require IO::Socket;
+ $port ||= $fallback_port;
+ my $intf = network::tools::get_current_gateway_interface() || $fallback_intf;
+ my $mac = c::get_hw_address($intf);
+ my $sock = IO::Socket::INET->new(PeerAddr => $server, PeerPort => $port, Proto => 'tcp');
+ if ($sock) {
+ print $sock "$mac\n";
+ close($sock);
+ log::l(qq(successfully notified deploy server $server on port $port));
+ } else {
+ log::l(qq(unable to contact deploy server $server on port $port));
+ }
+ } else {
+ log::l(qq(unable to parse deploy server in string $o->{deploy_server}));
+ }
+}
+
+#-###############################################################################
+#- pcmcia various
+#-###############################################################################
+sub configure_pcmcia {
+ my ($o) = @_;
+ my $controller = detect_devices::pcmcia_controller_probe();
+ $o->{pcmcia} ||= $controller && $controller->{driver} or return;
+ log::l("configuring PCMCIA controller ($o->{pcmcia})");
+ symlink "/tmp/stage2/$_", $_ foreach "/etc/pcmcia";
+ eval { modules::load($o->{pcmcia}, 'pcmcia') };
+ run_program::run("/lib/udev/pcmcia-socket-startup");
+}
+
+=back
+
+=cut
+
+1;
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-23 21:42:31 +0000