path: root/perl-install/standalone/bootloader-config

#!/usr/bin/perl

use lib qw(/usr/lib/libDrakX);
use Getopt::Long;

use common;
use bootloader;

$::isStandalone = 1; #- not using standalone which messes with @ARGV and usage
c::openlog('bootloader-config' . "[$$]");

$ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";

my %options = (
	       'action=s' => \ (my $action),

	       'label=s' => \ (my $label),

	       'chainload=s' => \ (my $chainload),

	       'image=s' => \ (my $image), 
	       'kernel-version=s' => \ (my $kernel_version), 

	       'initrd-options=s' => \ (my $initrd_options),
	       'no-short-name' => \ (my $no_short_name),
	       'no-entry' => \ (my $no_entry),
	       'no-launch' => \ (my $no_launch),
	       'no-initrd' => \ (my $no_initrd),
	      );

GetOptions(%options) && $action or die <<'EOF';
usage: bootloader-config --action add-kernel (--image <vmlinuz> | --kernel-version <2.6.xxx>) [--label <...>] [--no-short-name] [--initrd-options <options>]
       bootloader-config --action remove-kernel (--image <vmlinuz> | --kernel-version <2.6.xxx>)

       bootloader-config --action add-entry (--image <image> | --chainload <device>) --label <...>
       bootloader-config --action remove-entry (--image <image> | --chainload <device> | --label <...>)

       bootloader-config --action update-splash
       bootloader-config --action remove-splash
       bootloader-config --action rebuild-initrds
       bootloader-config --action migrate-to-uuids
EOF

my @known_actions = qw(add-kernel remove-kernel update-splash remove-splash rebuild-initrds migrate-to-uuids detectloader add-entry remove-entry add-resume2);
$action && member($action, @known_actions) or die "<action> must be one of " . join(' ', @known_actions) . "\n";

if ($image) {
    if (my $ver = bootloader::vmlinuz2version($image)) {
	if ($kernel_version) {
	    $kernel_version eq $ver or die "$kernel_version and $ver do not match (hint: do not pass both --image and --kernel-version)\n";
	} else {
	    $kernel_version = $ver;
	}
    }
    $image = "/boot/$image" if $image !~ m!^/!;
} elsif ($kernel_version) {
    $image = "/boot/vmlinuz-$kernel_version";
}


my $all_hds = fsedit::get_hds();
fs::get_info_from_fstab($all_hds);

my $bootloader = bootloader::read($all_hds);
if (!$bootloader) {
    if (member($action, 'add-kernel', 'remove-kernel')) {
	warn "Cannot find a boot loader installed. Only taking care of initrd\n";
    } else {
	die "Cannot find a boot loader installed\n";
    }
}

$action =~ s/-/_/g;
$::{$action}->();


#-###############################################################################
sub remove_now_broken_boot_symlinks() {
    foreach (glob("/boot/vmlinuz*"), glob("/boot/initrd*")) {
	-l $_ && !-e $_ or next;
	log::l("removing now broken symlink $_");
	unlink $_;
    }
}
sub remove_kernel() {
    unlink "/lib/modules/$kernel_version/build";
    unlink "/lib/modules/$kernel_version/source";
    remove_now_broken_boot_symlinks();

    if (!$bootloader) {
	#- removing the initrd for weird configs where no mdv bootloader is configured
	my $kernel_str = bootloader::vmlinuz2kernel_str($image) or die "bad kernel name $image\n";
	my $initrd_long = bootloader::kernel_str2initrd_long($kernel_str);
	unlink "/boot/$initrd_long";
	return;
    }

    my %proposed_labels;
    my @new_entries;

    my ($to_remove, $to_keep) = partition {
	if ($_->{kernel_or_dev} && $_->{kernel_or_dev} eq $image) {
	    1;
	} else {
	    my $vmlinuz = $_->{kernel_or_dev} && bootloader::expand_vmlinuz_symlink($_->{kernel_or_dev});
	    if ($vmlinuz && "/boot/$vmlinuz" eq $image) {
		#- eg: removing kernel XXX and entry "linux" has /boot/vmlinuz -> vmlinuz-XXX
		#-     so finding out which kernel still installed is better suited to use label "linux"
		if (!%proposed_labels) {
		    %proposed_labels = bootloader::get_kernels_and_labels_before_kernel_remove($vmlinuz); 
		}
		if (my $kernel_str = $proposed_labels{$_->{label}}) {
		    push @new_entries, [ $kernel_str, $_ ];
		    1;
		} else {
		    0;
		}
	    } else {
		0;
	    }
	}
    } @{$bootloader->{entries}};

    $_->{initrd} && unlink $_->{initrd} foreach @$to_remove;

    @{$bootloader->{entries}} = @$to_keep;

    foreach (@new_entries) {
	my ($kernel_str, $v) = @$_;
	bootloader::add_kernel($bootloader, $kernel_str, $v);
    }

    modify_bootloader();
}    


#-###############################################################################
sub add_kernel() {
    configure_ide_controller();
    bootloader::create_link_source();

    my $kernel_str = bootloader::vmlinuz2kernel_str($image) or die "bad kernel name $image\n";

    if (!$bootloader) {
	#- building the initrd for weird configs where no mdv bootloader is configured
	my $fake_bootloader = { vga => undef };
	my %opts = (initrd_options => $initrd_options);
	my $initrd_long = bootloader::kernel_str2initrd_long($kernel_str);
	bootloader::mkinitrd($kernel_str->{version}, $fake_bootloader, { %opts }, "/boot/$initrd_long");
	return;
    }

    my $root_part = fs::get::root([ fs::get::fstab($all_hds) ]) or die "can not find root partition\n";
    my %opts = (
		root => fs::wild_device::from_part('', $root_part), 
		initrd_options => $initrd_options,
		if_($label, label => $label),
		(grep_each { member($::a, 'vga', 'lock') } %{$bootloader->{default_options}}),
	       );
    #- short name
    bootloader::add_kernel($bootloader, $kernel_str, { %opts }, 0, $no_initrd) if !$no_short_name;

    #- long name
    $kernel_str->{use_long_name} = 1;
    bootloader::add_kernel($bootloader, $kernel_str, { %opts }, 1, $no_initrd);

    modify_bootloader();
}

sub configure_ide_controller {
    my $modules_conf = modules::any_conf->read;
    if ($modules_conf->get_alias('ide-controller') || 
        $modules_conf->get_probeall('ide-controller')) {
	#- already configured
    } elsif (my @l = detect_devices::probe_category('disk/ide')) {
	$modules_conf->add_probeall('ide-controller', $_->{driver}) foreach @l;
	$modules_conf->write;
    }
}

sub modify_bootloader() {
    !$no_entry or return;

    bootloader::action($bootloader, 'write', $all_hds);
    bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
}

#-###############################################################################
sub add_entry() {
    $label or die "you must give a label\n";
    ($image xor $chainload) or die "you must give an image or a chainload\n";

    my $entry = {
		  type => $image ? 'image' : 'other',
		  label => $label,
		  kernel_or_dev => $image || $chainload,
		 };
    bootloader::add_entry($bootloader, $entry);
    modify_bootloader();
}

sub _get_entry() {
    listlength(grep { $_ } $label, $image, $chainload) == 1 or die "you must give one of --label, --image and --chainload\n";

    $label ? bootloader::get_label($label, $bootloader) : 
             find { $_->{kernel_or_dev} && $_->{kernel_or_dev} eq ($image || $chainload) } @{$bootloader->{entries}};
}

sub remove_entry() {
    my $e = _get_entry() or return;

    @{$bootloader->{entries}} = grep { $_ != $e } @{$bootloader->{entries}};
    modify_bootloader();
}

sub add_resume2() {
    my $e = _get_entry() or return;
   
    my ($simple, $dict) = bootloader::unpack_append($e->{append});
    if (my $resume = find { $_->[0] eq 'resume' } @$dict) {
	if (!any { $_->[0] eq 'resume2' } @$dict) {
	    push @$dict, [ resume2 => "swap:$resume->[1]" ];
	    $e->{append} = bootloader::pack_append($simple, $dict);

	    modify_bootloader();
	}
    }
}

#-###############################################################################
sub rebuild_initrds() {    
    bootloader::rebuild_initrds($bootloader);
    bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
}

#-###############################################################################
sub migrate_to_uuids() {    
    foreach (fs::get::fstab($all_hds)) {
	_add_uuid_to_swap($_) if $_->{fs_type} eq 'swap' && !$_->{device_UUID};
    }

    _migrate_to_uuids__fstab();

    my $fstab = [ fs::get::fstab($all_hds) ];
    my $bootloader_migrated;
    my $may_migrate = sub {
	my ($label, $dev_ref) = @_;
	my $dev_ = _migrate_dev_to_uuid($fstab, $$dev_ref) or return;

	log::l("migrate_to_uuids: migrating bootloader $label=$$dev_ref entry");
	$$dev_ref = $dev_;
	$bootloader_migrated = 1;
    };
    # migrate root=
    $may_migrate->('root', \$_->{root}) foreach grep { !$_->{keep_verbatim} } @{$bootloader->{entries}};

    # migrate resume=
    bootloader::modify_append($bootloader, sub {
	my ($_simple, $dict) = @_;
	foreach (grep { $_->[0] eq 'resume' } @$dict) {
	    $may_migrate->($_->[0], \$_->[1]);
	}
    });

    if ($bootloader_migrated) {
	bootloader::action($bootloader, 'write', $all_hds, '.before-migrate-to-uuids');
	bootloader::action($bootloader, 'when_config_changed');
    }
}

sub _migrate_to_uuids__fstab() {
    my $fstab_migrated;
    foreach my $part (fs::get::really_all_fstab($all_hds)) {	
	if (_set_prefer_device_UUID($part)) {
	    log::l("migrate_to_uuids: migrating fstab $part->{device} entry");
	    $fstab_migrated = 1;
	}
    }
    if ($fstab_migrated) {
	cp_af('/etc/fstab', '/etc/fstab.before-migrate-to-uuids');
	fs::write_fstab($all_hds);
    }
}

sub _migrate_dev_to_uuid {
    my ($fstab, $dev) = @_;
    $dev && $dev =~ m!/dev/! or next;

    my $part = fs::get::device2part($dev, $fstab);
    $part && $part->{device_UUID} && "UUID=$part->{device_UUID}";
}

sub _set_prefer_device_UUID {
    my ($part) = @_;
    $part->{device_UUID} && !$part->{prefer_device_UUID} && !$part->{prefer_device_LABEL} or return;
    $part->{prefer_device_UUID} = 1;
    $part->{prefer_device} = 0;
    1;
}

# add UUID to swap v.2 in case the swap was created long ago when mkswap didn't do it by default
sub _add_uuid_to_swap {
    my ($part) = @_;

    my $ids = fs::type::call_vol_id($part);
    $ids->{ID_FS_VERSION} eq '2' 
      or log::l("ERROR: do not know swap version $ids->{ID_FS_VERSION}, so can not add UUID to it"), return;

    my $uuid = run_program::get_stdout('uuidgen');
    log::l("adding UUID=$uuid to $part->{device}");
    $uuid =~ s/-//g; 
    $uuid =~ s/(..)/chr(hex($1))/ge;

    {
	my $F;
	sysopen($F, devices::make($part->{device}), 2) or die "error opening device $part->{device} for writing";
	sysseek($F, 1036, 0) && syswrite($F, $uuid) or log::l("writing UUID failed");
    }

    if (my $p = fs::type::type_subpart_from_magic($part)) {
	$part->{device_UUID} = $p->{device_UUID};
    }
}

#-###############################################################################
sub update_splash() {
    bootloader::update_splash($bootloader);
    bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
}

sub remove_splash() {
    foreach (@{$bootloader->{entries}}) {
	bootloader::remove_boot_splash($_->{initrd}) if $_->{initrd};
    }
    bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
}

sub detectloader() {
    print uc(bootloader::main_method($bootloader->{method})), "\n" if $bootloader;
}