package bootloader; # $Id: bootloader.pm 267511 2010-04-12 12:34:45Z cfergeau $
use diagnostics;
use strict;
#-######################################################################################
#- misc imports
#-######################################################################################
use common;
use fs::type;
use fs::get;
use fs::loopback;
use fs::proc_partitions;
use log;
use any;
use devices;
use detect_devices;
use partition_table::raw;
use run_program;
use modules;
#-#####################################################################################
#- Functions
#-#####################################################################################
my $vmlinuz_regexp = 'vmlinu[xz]|win4lin|uImage';
my $decompose_vmlinuz_name = qr/((?:$vmlinuz_regexp).*?)-(\d+\.\d+.*)/;
sub expand_vmlinuz_symlink {
my ($vmlinuz) = @_;
my $f = $::prefix . ($vmlinuz =~ m!^/! ? $vmlinuz : "/boot/$vmlinuz");
-l $f ? readlink($f) : $vmlinuz;
}
sub installed_vmlinuz_raw() { grep { /^($vmlinuz_regexp)/ } all("$::prefix/boot") }
sub installed_vmlinuz() { grep { ! -l "$::prefix/boot/$_" } installed_vmlinuz_raw() }
sub vmlinuz2version {
my ($vmlinuz) = @_;
expand_vmlinuz_symlink($vmlinuz) =~ /$decompose_vmlinuz_name/ && $2;
}
sub vmlinuz2kernel_str {
my ($vmlinuz) = @_;
my ($basename, $version) = expand_vmlinuz_symlink($vmlinuz) =~ /$decompose_vmlinuz_name/ or return;
{
basename => $basename,
version => $version,
$version =~ /([\d.]*)-(\D.*)-((\d+|0\.rc\d+.*)\.mga.*)$/ ? #- eg: 3.0.0-1.mga2
(ext => $2, version_no_ext => "$1-$3") :
$version =~ /(.*mga)-?(.*)/ ? #- (old) eg: 2.6.17-13mdventerprise
(ext => $2, version_no_ext => $1) : (version_no_ext => $version),
};
}
sub kernel_str2short_name {
my ($kernel) = @_;
$kernel->{basename};
}
sub basename2initrd_basename {
my ($basename) = @_;
$basename =~ s!(vmlinu[zx]|uImage)-?!!; #- here we do not use $vmlinuz_regexp since we explictly want to keep all that is not "vmlinuz"
'initrd' . ($basename ? "-$basename" : '');
}
sub kernel_str2vmlinuz_long {
my ($kernel) = @_;
$kernel->{basename} . '-' . $kernel->{version};
}
sub kernel_str2initrd_long {
my ($kernel) = @_;
basename2initrd_basename(kernel_str2short_name($kernel)) . '-' . $kernel->{version} . '.img';
}
sub kernel_str2vmlinuz_short {
my ($kernel) = @_;
if ($kernel->{use_long_name}) {
kernel_str2vmlinuz_long($kernel);
} else {
kernel_str2short_name($kernel);
}
}
sub kernel_str2initrd_short {
my ($kernel) = @_;
if ($kernel->{use_long_name}) {
kernel_str2initrd_long($kernel);
} else {
basename2initrd_basename(kernel_str2short_name($kernel)) . '.img';
}
}
sub kernel_str2label {
my ($kernel, $o_use_long_name) = @_;
if ($o_use_long_name || $kernel->{use_long_name}) {
_sanitize_ver($kernel);
} else {
my $short_name = kernel_str2short_name($kernel);
$kernel->{ext} =~ /^xen/ ? 'xen' : ($short_name eq 'vmlinuz' ? 'linux' : $short_name);
}
}
sub get {
my ($vmlinuz, $bootloader) = @_;
$_->{kernel_or_dev} && $_->{kernel_or_dev} eq $vmlinuz and return $_ foreach @{$bootloader->{entries}};
undef;
}
sub get_label {
my ($label, $bootloader) = @_;
$_->{label} && lc(make_label_lilo_compatible($_->{label})) eq lc(make_label_lilo_compatible($label)) and return $_ foreach @{$bootloader->{entries}};
undef;
}
sub mkinitrd {
my ($kernel_version, $bootloader, $entry, $initrd) = @_;
my $dir = dirname($initrd);
if ($::testing) {
log::l("Skipping initrd generation: testing mode");
return $initrd;
} elsif (-e "$::prefix/$initrd") {
log::l("Skipping initrd generation: already exists");
return $initrd;
} elsif ($initrd =~ /\(hd/) {
log::l("Skipping initrd generation: unrecognized partition");
return $initrd;
} elsif (!-d "$::prefix/$dir") {
log::l("Skipping initrd generation: dir doesn't exist (probably !mounted foreign part)");
return $initrd;
}
| 