Here's what I've got so far. There's a lot still to do, but it's reached the point of being able to convert the fstab on my laptop.
TODO:
- Only change device id in boot loader configurations that use an
initramfs
- Warn about configuration files that may need to be updated manually
- Run post-update commands for installed packages
- Review error handling
- Allow user to adjust the plan?
- Other debconf refinements
- Is there anything we can do about CD-ROMs? Can we add a 'scsi' path
rule in /etc/udev/rules.d/70-persistent-cd.rules after each 'ide' path
rule?
- Similarly for tape drives? (low priority as they're far less common)
- Get maintainers of all affected packages to review the relevant code
I was thinking of creating a new package linux-image-2.6-common that all
image packages will Depend on, and putting this in that package. Any
objections to that?
I don't know where I should commit this, as I don't want to hold up any
bug-fix uploads to sid. At the moment this is in a local git repo.
Ben.
#!/usr/bin/perl
# Copyright 2009 Ben Hutchings
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
use strict;
use warnings;
use Debconf::Client::ConfModule ':all';
use FileHandle;
use POSIX ();
### /etc/fstab
sub fstab_next {
# Based on my_getmntent() in mount_mntent.c
my ($file) = @_;
my $text = <$file>;
unless (defined($text)) {
return ();
}
my $line = $text;
$line =~ s/\r?\n$//;
$line =~ s/^[ \t]*//;
if ($line =~ /^(#|$)/) {
return ($text);
} else {
return ($text,
map({ s/\\([0-7][0-7][0-7])/chr(oct($1) & 0xff)/eg; $_; }
split(/[ \t]+/, $line)));
}
}
sub fstab_list {
my ($file) = @_;
my @bdevs;
while (1) {
my ($text, $bdev) = fstab_next($file);
last unless defined($text);
if (defined($bdev)) {
push @bdevs, $bdev;
}
}
return @bdevs;
}
sub fstab_update {
my ($old, $new, $map) = @_;
while (1) {
my ($text, $bdev) = fstab_next($old);
last unless defined($text);
if (defined($bdev) && defined(my $id = $map->{$bdev})) {
$text =~ s/^(\s*\S+)(.*)/# $1$2\n$id$2/;
}
$new->print("$text");
}
}
### Kernel parameters
sub kernel_list {
my ($cmd_line) = @_;
return ($cmd_line =~ /\broot=(\S+)/) ? ($1) : ();
}
sub kernel_update {
my ($cmd_line, $map) = @_;
if ($cmd_line =~ /\broot=(\S+)/ && defined(my $id = $map->{$1})) {
$cmd_line =~ s/\broot=(\S+)/root=$id/;
return $cmd_line;
} else {
return undef;
}
}
### shell script variable assignment
# Maintains enough context to find statement boundaries, and can parse
# variable definitions that do not include substitutions. I think.
sub shellvars_next {
my ($file) = @_;
my $text = '';
my @context = ('');
my $first = 1;
my $in_value = 0;
my ($name, $value);
my $unhandled = 0;
LINE:
while (<$file>) {
$text .= $_;
# variable assignment
if ($first && m/^\s*([A-Za-z_][A-Za-z0-9_]*)=/g) {
$name = $1;
$value = '';
$in_value = 1;
}
while (/\G(.*?)([#`'"(){}\s]|\\.|\$[({]?)/gs) {
my $end_pos = pos;
my $special = $2;
if ($in_value) {
# add non-special characters to the value verbatim
$value .= $1;
}
if ($context[$#context] eq '') {
# space outside quotes or brackets ends the value
if ($special =~ /^\s/) {
$in_value = 0;
if ($special eq "\n") {
last LINE;
}
}
# something else after the value means this is a command
# with an environment override, not a variable definition
elsif (defined($name) && !$in_value) {
$unhandled = 1;
}
}
# in single-quoted string
if ($context[$#context] eq "'") {
# only the terminating single-quote is special
if ($special eq "'") {
pop @context;
} else {
$value .= $special;
}
}
# backslash escape
elsif ($special =~ /^\\/) {
if ($in_value && $special ne "\\\n") {
$value .= substr($special, 1, 1);
}
}
# in backtick substitution
elsif ($context[$#context] eq '`') {
# backtick does not participate in nesting, so only the
# terminating backtick should be considered special
if ($special eq '`') {
pop @context;
}
}
# comment
elsif ($context[$#context] !~ /^['"]/ && $special eq '#') {
# ignore rest of the physical line, except the new-line
pos = $end_pos;
/\G.*/g;
next;
}
# start of backtick substitution
elsif ($special eq '`') {
push @context, '`';
$unhandled = 1;
}
# start of single/double-quoted string
elsif ($special =~ /^['"]/ && $context[$#context] !~ /^['"]/) {
push @context, $special;
}
# end of double-quoted string
elsif ($special eq '"' && $context[$#context] eq '"') {
pop @context;
}
# open bracket
elsif ($special =~ /^\$?\(/) {
push @context, ')';
$unhandled = 1;
} elsif ($special =~ /^\$\{/) {
push @context, '}';
$unhandled = 1;
}
# close bracket
elsif ($special =~ /^[)}]/ && $special eq $context[$#context]) {
pop @context;
}
# variable substitution
elsif ($special eq '$') {
$unhandled = 1;
}
# not a special character in this context (or a syntax error)
else {
if ($in_value) {
$value .= $special;
}
}
pos = $end_pos;
}
$first = 0;
}
if ($text eq '') {
return ();
} elsif ($unhandled) {
return ($text);
} else {
return ($text, $name, $value);
}
}
sub shellvars_quote {
my ($value) = @_;
$value =~ s/'/'\''/g;
return "'$value'";
}
### GRUB 1 (grub-legacy) config
sub grub1_next {
# Based on get_line_from_config() in stage2.c and find_command() in cmd.c
my ($file) = @_;
my $text = '';
my $line = '';
while (<$file>) {
$text .= $_;
s/\r//g;
s/\t/ /g;
# A backslash at the end of a line is a line continuation
# sequence, unless escaped by a preceding backslash. So we
# must check for an odd number of backslashes.
my $cont = s/((?:^|[^\\])(?:\\\\)*)\\\n$/$1 /;
$line .= $_;
last unless $cont;
}
if ($text eq '') {
return ();
} else {
$line =~ s/^ *(?:#.*)?//;
$line =~ s/\n$//;
$line =~ /^([^ =]*)(.*)/;
return ($text, $1, $2);
}
}
sub grub1_list {
my ($file) = @_;
my @bdevs;
while (1) {
my ($text, $command, $args) = grub1_next($file);
last unless defined($text);
if ($command eq 'kernel') {
push @bdevs, kernel_list($args);
}
}
return @bdevs;
}
sub grub1_update {
my ($old, $new, $map) = @_;
while (1) {
my ($text, $command, $args) = grub1_next($old);
last unless defined($text);
if ($command eq 'kernel' &&
defined(my $new_args = kernel_update($args))) {
$text = "# kernel$args\nkernel$new_args\n";
}
$new->print($text);
}
}
### GRUB 2 config
sub grub2_list {
my ($file) = @_;
my @bdevs;
while (1) {
my ($text, $name, $value) = shellvars_next($file);
last unless defined($text);
if (defined($name) && $name =~ /^GRUB_CMDLINE_LINUX(?:_DEFAULT)?$/) {
push @bdevs, kernel_list($value);
}
}
return @bdevs;
}
sub grub2_update {
my ($old, $new, $map) = @_;
my @bdevs;
while (1) {
my ($text, $name, $value) = shellvars_next($old);
last unless defined($text);
if (defined($name) && $name =~ /^GRUB_CMDLINE_LINUX(?:_DEFAULT)?$/ &&
defined(my $new_value = kernel_update($value, $map))) {
$text =~ s/^/# /gm;
$text .= sprintf("%s=%s\n", $name, shellvars_quote($new_value));
}
$new->print($text);
}
}
sub grub2_post {
system('grub-mkconfig', '-o', '/boot/grub/grub.cfg');
}
### LILO
sub lilo_tokenize {
# Based on cfg_get_token() and next() in cfg.c.
# Line boundaries are *not* significant (except as white space) so
# we tokenize the whole file at once.
my ($file) = @_;
my @tokens = ();
my $text = '';
my $token;
my $in_quote = 0;
while (<$file>) {
# If this is the continuation of a multi-line quote, skip
# leading space and push back the necessary context.
if ($in_quote) {
s/^[ \t]*/"/;
$text .= $&;
}
pos = 0;
while (/\G \s* (?:\#.*)?
(?: (=) |
" ((?:[^"] | \\[\\"n])*) (" | \\\r?\n) |
((?:[^\s\#="\\] | \\[^\r\n])+) (\\\r?\n)?)?
/gsx) {
my $cont;
my $new_text = $&;
if (defined($1)) {
# equals sign
$text = $new_text;
$token = $1;
$cont = 0;
} elsif (defined($2)) {
# quoted text
if (!$in_quote) {
$text = $new_text;
$token = $2;
} else {
$text .= substr($new_text, 1); # remove the quote again; ick
$token .= ' ' . $2;
}
$cont = $3 ne '"';
} elsif (defined($4)) {
# unquoted word
if (!defined($token)) {
$token = '';
}
$text .= $new_text;
$token .= $4;
$cont = defined($5);
} else {
$text .= $new_text;
$cont = $new_text eq '';
}
if (!$cont) {
if ($text =~ /(?:^|[^\\])\$/) {
# unhandled expansion
$token = undef;
} elsif (defined($token)) {
if ($in_quote) {
$token =~ s/\\(.)/$1 eq 'n' ? "\n" : $1/eg;
} else {
$token =~ s/\\(.)/$1/g;
}
}
push @tokens, [$text, $token];
$text = '';
$token = undef;
$in_quote = 0;
}
}
}
return @tokens;
}
sub lilo_list {
my ($file) = @_;
my @bdevs = ();
my @tokens = lilo_tokenize($file);
my $i = 0;
while ($i <= $#tokens) {
# Configuration items are either <name> "=" <value> or <name> alone.
if ($#tokens - $i >= 2 &&
defined($tokens[$i + 1][1]) && $tokens[$i + 1][1] eq '=') {
my ($name, $value) = ($tokens[$i][1], $tokens[$i + 2][1]);
if (defined($name) && defined($value)) {
if ($name =~ /^(?:boot|root)$/) {
push @bdevs, $value;
} elsif ($name =~ /^(?:addapend|append|literal)$/) {
push @bdevs, kernel_list($value);
}
}
$i += 3;
} else {
$i += 1;
}
}
return @bdevs;
}
sub lilo_update {
my ($old, $new, $map) = @_;
my @tokens = lilo_tokenize($old);
my $i = 0;
while ($i <= $#tokens) {
my $text = $tokens[$i][0];
if ($#tokens - $i >= 2 &&
defined($tokens[$i + 1][1]) && $tokens[$i + 1][1] eq '=') {
my ($name, $value) = ($tokens[$i][1], $tokens[$i + 2][1]);
my $new_value;
if (defined($name) && defined($value)) {
if ($name =~ /^(?:boot|root)$/) {
$new_value = $map->{$value};
} elsif ($name =~ /^(?:addapend|append|literal)$/) {
$new_value = kernel_update($value, $map);
}
}
if (defined($new_value)) {
$text = "\n# $name = $value\n$name = $new_value\n";
} else {
$text .= $tokens[$i + 1][0] . $tokens[$i + 2][0];
}
$i += 3;
} else {
$i += 1;
}
$new->print($text);
}
}
sub lilo_post {
system('lilo');
}
### ELILO
sub elilo_post {
system('elilo');
}
### PALO
sub palo_next {
my ($file, $expect_opt) = @_;
my $text = <$file>;
if (!defined($text) || $text eq '') {
return ();
}
my $arg = $text;
$arg =~ s/^\s*(?:#.*)?//s;
$arg =~ s/\s*$//;
# I would like to use Getopt::Long but it would make it
# impossible to determine which source text to replace.
if ($expect_opt && $arg =~ /^-(?!-)[?v]*(.)(.+)?$/) {
return ($text, "-$1", $2, defined($2));
} elsif ($expect_opt && $arg =~ /^(--[^=]+)(?:=(.*))?$/) {
return ($text, $1, $2, defined($2));
} elsif ($arg ne '') {
return ($text, undef, $arg, 1);
} else {
return ($text, undef, undef, $expect_opt);
}
}
sub palo_list {
my ($file) = @_;
my $optopt;
my @bdevs;
while (1) {
my ($text, $optarg, $complete);
if (defined($optopt)) {
($text, undef, $optarg, $complete) = palo_next($file, 0);
} else {
($text, $optopt, $optarg, $complete) = palo_next($file, 1);
}
last unless defined($text);
if ($complete && defined($optopt)) {
if ($optopt eq '-c' || $optopt eq '--commandline') {
push @bdevs, kernel_list($optarg);
} elsif ($optopt eq '-I' || $optopt eq '--init-partitioned') {
push @bdevs, $optarg;
}
$optopt = undef;
}
if (!defined($optopt) && defined($optarg) && $optarg eq '--') {
last;
}
}
return @bdevs;
}
sub palo_update {
my ($old, $new, $map) = @_;
my $optopt;
my $allow_opts = 1;
while (1) {
my ($text, $optarg, $complete);
if (defined($optopt)) {
($text, undef, $optarg, $complete) = palo_next($old, 0);
} else {
($text, $optopt, $optarg, $complete) = palo_next($old, $allow_opts);
}
last unless defined($text);
if (defined($optopt)) {
if ($optopt eq '-c' || $optopt eq '--commandline') {
$text = "# $text";
if ($complete) {
my $new_cmdline = kernel_update($optarg, $map);
if (!defined($new_cmdline)) {
$new_cmdline = $optarg;
}
$text .= "--commandline=$new_cmdline\n";
}
} elsif ($optopt eq '-I' || $optopt eq '--init-partitioned') {
$text = "# $text";
if ($complete) {
my $id = $map->{$optarg};
if (!defined($id)) {
$id = $optarg;
}
$text .= "--init-partitioned=$id\n";
}
}
$optopt = undef;
}
$new->print($text);
if (!defined($optopt) && defined($optarg) && $optarg eq '--') {
$allow_opts = 0;
}
}
}
sub palo_post {
system('palo');
}
### delo
sub delo_next {
# Based on getconfig() in config.c
my ($file) = @_;
my $text = <$file>;
if (!defined($text) || $text eq '') {
return ();
}
local $_ = $text;
s/[ \t]*(?:#.*)?\n//;
s/^[ \t]*//;
if (/^([a-z]+)=(.*)$/) {
return ($text, $1, $2);
} else {
return ($text);
}
}
sub delo_list {
my ($file) = @_;
my @bdevs;
while (1) {
my ($text, $name, $value) = arcboot_next($file);
last unless defined($text);
if (defined($name) && $name eq 'append') {
$value =~ s/^"([^"]*).*/$1/;
push @bdevs, kernel_list($value);
}
}
return @bdevs;
}
sub delo_update {
my ($old, $new, $map) = @_;
while (1) {
my ($text, $name, $value) = arcboot_next($old);
last unless defined($text);
if (defined($name) && $name eq 'append') {
$value =~ s/^"([^"]*).*/$1/;
my $new_cmdline = kernel_update($value, $map);
if (defined($new_cmdline)) {
$text = "# text" . "append=\"$new_cmdline\"\n";
}
}
$new->print($text);
}
}
### extlinux
sub extlinux_path {
for ('/boot/extlinux', '/boot/boot/exlinux', '/extlinux') {
if (-e) {
return "$_/options.cfg";
}
}
return undef;
}
sub extlinux_list {
my ($file) = @_;
while (<$file>) {
if (/^## ROOT=(.*)/) {
return kernel_list($1);
}
}
return ();
}
sub extlinux_update {
my ($old, $new, $map) = @_;
while (<$old>) {
my $text = $_;
if (/^## ROOT=(.*)/) {
my $new_params = kernel_update($1, $map);
if (defined($new_params)) {
$text = "## $text" . "## ROOT=$new_params\n";
}
}
$new->print($text);
}
}
sub extlinux_post {
system('update-extlinux');
}
### aboot
sub aboot_next {
my ($file) = @_;
my $text = <$file>;
if (!defined($text) || $text eq '') {
return ();
}
if ($text =~ /^([0-9]):([^ ]*) (.*)/) {
return ($text, $1, $2, $3);
} else {
return ($text);
}
}
sub aboot_list {
my ($file) = @_;
my @bdevs;
while (1) {
my ($text, $preset, $kernel, $params) = aboot_next($file);
last unless defined($text);
if (defined($params)) {
push @bdevs, kernel_list($params);
}
}
return @bdevs;
}
sub aboot_update {
my ($old, $new, $map) = @_;
while (1) {
my ($text, $preset, $kernel, $params) = aboot_next($old);
last unless defined($text);
if (defined($params)) {
my $new_params = kernel_update($params, $map);
if (defined($new_params)) {
$text = "# $text" . "$preset:$kernel $new_params\n";
}
}
$new->print($text);
}
}
### Filesystem relabelling
sub ext2_label {
my ($bdev, $label) = @_;
system('e2label', $bdev, $label) == 0 or die "e2label failed: $?";
}
sub jfs_label {
my ($bdev, $label) = @_;
system('jfs_tune', '-L', $label, $bdev) == 0 or die "jfs_tune failed: $?";
}
sub fat_label {
my ($bdev, $label) = @_;
system('dosfslabel', $bdev, $label) == 0 or die "dosfslabel failed: $?";;
}
sub ntfs_label {
my ($bdev, $label) = @_;
system('ntfslabel', $bdev, $label) == 0 or die "ntfslabel failed: $?";
}
sub reiserfs_label {
my ($bdev, $label) = @_;
system('reiserfstune', '--label', $label, $bdev)
or die "reiserfstune failed: $?";
}
# There is no command to relabel swap, and we mustn't run mkswap if
# the partition is already in use. Thankfully the header format is
# pretty simple; it starts with this structure:
# struct swap_header_v1_2 {
# char bootbits[1024]; /* Space for disklabel etc. */
# unsigned int version;
# unsigned int last_page;
# unsigned int nr_badpages;
# unsigned char uuid[16];
# char volume_name[16];
# unsigned int padding[117];
# unsigned int badpages[1];
# };
# and has the signature 'SWAPSPACE2' at the end of the first page.
use constant { SWAP_SIGNATURE => 'SWAPSPACE2',
SWAP_LABEL_OFFSET => 1052, SWAP_LABEL_LEN => 16 };
sub swap_label {
my ($bdev, $label) = @_;
my $pagesize = POSIX::sysconf(POSIX::_SC_PAGESIZE) or die "$!";
my ($length, $signature);
my $fd = POSIX::open($bdev, POSIX::O_RDWR);
defined($fd) or die "$!";
# Check the signature
POSIX::lseek($fd, $pagesize - length(SWAP_SIGNATURE), POSIX::SEEK_SET);
$length = POSIX::read($fd, $signature, length(SWAP_SIGNATURE));
if (!defined($length) || $signature ne SWAP_SIGNATURE) {
POSIX::close($fd);
die "swap signature not found on $bdev";
}
# Set the label
$label = pack('Z' . SWAP_LABEL_LEN, $label);
POSIX::lseek($fd, SWAP_LABEL_OFFSET, POSIX::SEEK_SET);
$length = POSIX::write($fd, $label, SWAP_LABEL_LEN);
if (!defined($length) || $length != SWAP_LABEL_LEN) {
my $error = "$!";
POSIX::close($fd);
die $error;
}
POSIX::close($fd);
}
sub ufs_label {
my ($bdev, $label) = @_;
system('tunefs.ufs', '-L', $label, $bdev) or die "tunefs.ufs failed: $?";
}
sub xfs_label {
my ($bdev, $label) = @_;
system('xfs_admin', '-L', $label, $bdev) or die "xfs_admin failed: $?";
}
my %label_types = (ext2 => { len => 16, relabel => \&ext2_label },
ext3 => { len => 16, relabel => \&ext2_label },
ext4 => { len => 16, relabel => \&ext2_label },
jfs => { len => 16, relabel => \&jfs_label },
msdos => { len => 11, relabel => \&fat_label },
ntfs => { len => 128, relabel => \&ntfs_label },
reiserfs => { len => 16, relabel => \&reiserfs_label },
swap => { len => SWAP_LABEL_LEN,
relabel => \&swap_label },
ufs => { len => 32, relabel => \&ufs_label },
vfat => { len => 11, relabel => \&fat_label },
xfs => { len => 12, relabel => \&xfs_label });
### general
my @config_files = ({packages => 'mount',
path => '/etc/fstab',
list => \&fstab_list,
update => \&fstab_update},
{packages => 'grub grub-legacy',
path => '/boot/grub/menu.lst',
list => \&grub1_list,
update => \&grub1_update},
{packages => 'grub-common',
path => '/etc/default/grub',
list => \&grub2_list,
update => \&grub2_update,
post_update => \&grub2_post},
{packages => 'lilo',
path => '/etc/lilo.conf',
list => \&lilo_list,
update => \&lilo_update,
post_update => \&lilo_post},
{packages => 'silo',
path => '/etc/silo.conf',
list => \&lilo_list,
update => \&lilo_update},
{packages => 'quik',
path => '/etc/quik.conf',
list => \&lilo_list,
update => \&lilo_update},
{packages => 'yaboot',
path => '/etc/yaboot.conf',
list => \&lilo_list,
update => \&lilo_update},
{packages => 'elilo',
path => '/etc/elilo.conf',
list => \&lilo_list,
update => \&lilo_update,
post_update => \&elilo_post},
{packages => 'palo',
path => '/etc/palo.conf',
list => \&palo_list,
update => \&palo_update,
post_update => \&palo_post},
{packages => 'delo',
path => '/etc/delo.conf',
list => \&delo_list,
update => \&delo_update},
{packages => 'arcboot',
path => '/etc/arcboot.conf',
list => \&delo_list,
update => \&delo_update},
{packages => 'extlinux',
path => extlinux_path(),
list => \&extlinux_list,
update => \&extlinux_update,
post_update => \&extlinux_post},
{packages => 'aboot',
path => '/etc/aboot.conf',
list => \&aboot_list,
update => \&aboot_update});
my %bdev_map = ();
my @matched_configs = ();
my %id_map;
sub scan_config_files {
# Find all IDE/SCSI disks mentioned in configurations
for my $config (@config_files) {
# Is the file present?
my $path = $config->{path};
if (!defined($path)) {
next;
}
my $file = new FileHandle($path, 'r');
if (!defined($file)) {
if ($! == POSIX::ENOENT) {
next;
}
die $!;
}
# Are any of the related packages wanted or installed?
my $wanted = 0;
my $installed = 0;
my $packages = $config->{packages};
for (`dpkg-query 2>/dev/null --showformat '\${status}\\n' -W $packages`)
{
$wanted = 1 if /^install /;
$installed = 1 if / installed\n$/;
}
if (!$wanted && !$installed) {
next;
}
my @matched_bdevs = ();
for my $bdev (&{$config->{list}}($file)) {
if ($bdev =~ m|^/dev/[hs]d[a-z](\d+)?$|) {
$bdev_map{$bdev} = {};
push @matched_bdevs, $bdev;
}
}
if (@matched_bdevs) {
push @matched_configs, {config => $config,
devices => \...@matched_bdevs,
installed => $installed};
}
}
my $fstab = new FileHandle('/etc/fstab', 'r');
while (1) {
my ($text, $bdev, $path, $type) = fstab_next($fstab);
last unless defined($text);
if (defined($type) && exists($bdev_map{$bdev})) {
$bdev_map{$bdev}->{path} = $path;
$bdev_map{$bdev}->{type} = $type;
}
}
$fstab->close();
}
sub add_tag {
# Map disks to labels/UUIDs and vice versa. Include all disks in
# the reverse mapping so we can detect ambiguity.
my ($bdev, $name, $value) = @_;
my $id = "$name=$value";
push @{$id_map{$id}}, $bdev;
if (exists($bdev_map{$bdev})) {
$bdev_map{$bdev}->{$name} = $value;
push @{$bdev_map{$bdev}->{ids}}, $id;
}
}
sub scan_devices {
for (`blkid -o device`) {
chomp;
my $bdev = $_;
for (`blkid -o udev -s LABEL -s UUID '$bdev'`) {
if (/^ID_FS_(LABEL|UUID)_ENC=(.*)\n$/) {
add_tag($bdev, $1, $2);
}
}
}
# Discard all device ids that are ambiguous.
for my $bdev (keys(%bdev_map)) {
@{$bdev_map{$bdev}->{ids}} = grep({ $#{$id_map{$_}} == 0 }
@{$bdev_map{$bdev}->{ids}});
}
}
sub assign_labels {
my $hostname = (POSIX::uname())[1];
# For all devices that have no alternate device ids, suggest labelling
# them based on fstab or just using a generic label.
for my $bdev (keys(%bdev_map)) {
if ($#{$bdev_map{$bdev}->{ids}} >= 0) {
my $id = $bdev_map{$bdev}->{ids}->[0];
} else {
my $type = $bdev_map{$bdev}->{type};
if (!exists($label_types{$type})) {
next;
}
my $label_len = $label_types{$type}->{len};
my $label;
use bytes; # string lengths are in bytes
if (defined($bdev_map{$bdev}->{path})) {
# Convert path/type to label; prepend hostname if possible;
# append numeric suffix if necessary.
my $base;
if ($bdev_map{$bdev}->{path} =~ m|^/|) {
$base = $bdev_map{$bdev}->{path};
} else {
$base = $bdev_map{$bdev}->{type};
}
$base =~ s/[^\w]+/-/g;
$base =~ s/^-//g;
$base =~ s/-$//g;
my $n = 0;
my $suffix = '';
do {
$label = "$hostname-$base$suffix";
if (length($label) > $label_len) {
$label = substr($base, 0, $label_len - length($suffix))
. $suffix;
}
$n++;
$suffix = "-$n";
} while (exists($id_map{"LABEL=$label"}));
} else {
my $n = 0;
my $suffix;
do {
$n++;
$suffix = "-$n";
$label = substr($hostname, 0, $label_len - length($suffix))
. $suffix;
} while (exists($id_map{"LABEL=$label"}));
}
add_tag($bdev, 'LABEL', $label);
$bdev_map{$bdev}->{relabel} = 1;
}
}
}
sub relabel {
for my $bdev (keys(%bdev_map)) {
my $bdev_info = $bdev_map{$bdev};
if ($bdev_info->{relabel}) {
my $relabel = $label_types{$bdev_info->{type}}->{relabel};
&{$relabel}($bdev, $bdev_info->{LABEL});
}
}
}
sub update_config {
my %map;
for my $bdev (keys(%bdev_map)) {
$map{$bdev} = $bdev_map{$bdev}->{ids}->[0];
}
for my $match (@matched_configs) {
# Generate a new config
my $path = $match->{config}->{path};
my $old = new FileHandle($path, 'r');
my $new = new FileHandle("$path.new", POSIX::O_WRONLY | POSIX::O_CREAT,
0600);
&{$match->{config}->{update}}($old, $new, \%map);
$old->close();
$new->close();
# New config should have same permissions as the old
my (undef, undef, $mode, undef, $uid, $gid) = stat($path) or die "$!";
chown($uid, $gid, "$path.new") or die "$!";
chmod($mode & 07777, "$path.new") or die "$!";
# Back up the old config and replace with the new
unlink("$path.old");
link($path, "$path.old") or die "$!";
rename("$path.new", $path) or die "$!";
}
}
### main
scan_config_files();
if ($#matched_configs < 0) {
exit 0;
}
my ($question, $answer, $ret, $seen);
$question = 'linux-image-2.6-common/disk-id-convert-auto';
($ret, $seen) = input('high', $question);
if ($ret && $ret != 30) {
die "Error setting debconf question $question: $seen";
}
($ret, $seen) = go();
if ($ret && $ret != 30) {
die "Error asking debconf question $question: $seen";
}
($ret, $answer) = get($question);
die "Error retrieving answer for $question: $answer" if $ret;
if (!$answer) {
exit 0;
}
scan_devices();
assign_labels();
$question = 'linux-image-2.6-common/disk-id-convert-plan';
($ret, $seen) = subst($question, 'relabel',
join("\\n",
map({sprintf("%s: %s", $_, $bdev_map{$_}->{LABEL})}
grep({$bdev_map{$_}->{relabel}}
keys(%bdev_map)))));
die "Error setting debconf substitutions in $question: $seen" if $ret;
($ret, $seen) = subst($question, 'id_map',
join("\\n",
map({sprintf("%s: %s", $_,
$bdev_map{$_}->{ids}->[0])}
grep({...@{$bdev_map{$_}->{ids}}}
keys(%bdev_map)))));
die "Error setting debconf substitutions in $question: $seen" if $ret;
($ret, $seen) = subst($question, 'files',
join(', ',
map({$_->{config}->{path}} @matched_configs)));
die "Error setting debconf substitutions in $question: $seen" if $ret;
($ret, $seen) = input('high', $question);
if ($ret && $ret != 30) {
die "Error setting debconf question $question: $seen";
}
($ret, $seen) = go();
if ($ret && $ret != 30) {
die "Error asking debconf question $question: $seen";
}
($ret, $answer) = get($question);
die "Error retrieving answer for $question: $answer" if $ret;
if (!$answer) {
# TODO: go back to the auto/manual question or allow editing the plan
exit 1;
}
relabel();
update_config();
--
Ben Hutchings
Kids! Bringing about Armageddon can be dangerous. Do not attempt it in
your own home. - Terry Pratchett and Neil Gaiman, `Good Omens'
signature.asc
Description: This is a digitally signed message part
