summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--perl-install/any.pm2
-rw-r--r--perl-install/bootloader.pm2
-rw-r--r--perl-install/diskdrake/dav.pm2
-rw-r--r--perl-install/diskdrake/hd_gtk.pm24
-rw-r--r--perl-install/diskdrake/interactive.pm70
-rw-r--r--perl-install/diskdrake/removable.pm6
-rw-r--r--perl-install/fs.pm60
-rw-r--r--perl-install/fsedit.pm90
-rw-r--r--perl-install/install_any.pm12
-rw-r--r--perl-install/install_interactive.pm4
-rw-r--r--perl-install/install_steps.pm6
-rw-r--r--perl-install/install_steps_interactive.pm2
-rw-r--r--perl-install/lvm.pm4
-rw-r--r--perl-install/network/smbnfs.pm4
-rw-r--r--perl-install/partition_table.pm67
-rw-r--r--perl-install/partition_table/bsd.pm12
-rw-r--r--perl-install/partition_table/dos.pm10
-rw-r--r--perl-install/partition_table/gpt.pm16
-rw-r--r--perl-install/partition_table/mac.pm40
-rw-r--r--perl-install/partition_table/raw.pm4
-rw-r--r--perl-install/partition_table/sun.pm16
-rw-r--r--perl-install/raid.pm2
22 files changed, 231 insertions, 224 deletions
diff --git a/perl-install/any.pm b/perl-install/any.pm
index 68d76e52b..67d540631 100644
--- a/perl-install/any.pm
+++ b/perl-install/any.pm
@@ -265,7 +265,7 @@ sub setupBootloader__general {
if ($prev_clean_tmp != $clean_tmp) {
if ($clean_tmp && !fsedit::has_mntpoint('/tmp', $all_hds)) {
- push @{$all_hds->{special}}, { device => 'none', mntpoint => '/tmp', type => 'tmpfs' };
+ push @{$all_hds->{special}}, { device => 'none', mntpoint => '/tmp', pt_type => 'tmpfs' };
} else {
@{$all_hds->{special}} = grep { $_->{mntpoint} ne '/tmp' } @{$all_hds->{special}};
}
diff --git a/perl-install/bootloader.pm b/perl-install/bootloader.pm
index db9030ad1..9d6cbd8c3 100644
--- a/perl-install/bootloader.pm
+++ b/perl-install/bootloader.pm
@@ -700,7 +700,7 @@ wait for default boot.
} elsif (arch() !~ /ia64/) {
#- search for dos (or windows) boot partition. Don't look in extended partitions!
my @windows_boot_parts =
- grep { isFat_or_NTFS($_) && isFat_or_NTFS({ type => fsedit::typeOfPart($_->{device}) }) }
+ grep { isFat_or_NTFS($_) && isFat_or_NTFS({ pt_type => fsedit::typeOfPart($_->{device}) }) }
map { @{$_->{primary}{normal}} } @$hds;
each_index {
add_entry($bootloader,
diff --git a/perl-install/diskdrake/dav.pm b/perl-install/diskdrake/dav.pm
index 5d00fb4aa..23652413a 100644
--- a/perl-install/diskdrake/dav.pm
+++ b/perl-install/diskdrake/dav.pm
@@ -35,7 +35,7 @@ points, select \"New\".")) },
sub create {
my ($in, $all_hds) = @_;
- my $dav = { type => 'davfs' };
+ my $dav = { pt_type => 'davfs' };
ask_server($in, $dav, $all_hds) or return;
push @{$all_hds->{davs}}, $dav;
config($in, $dav, $all_hds);
diff --git a/perl-install/diskdrake/hd_gtk.pm b/perl-install/diskdrake/hd_gtk.pm
index 197bbf1d9..8ec9e80be 100644
--- a/perl-install/diskdrake/hd_gtk.pm
+++ b/perl-install/diskdrake/hd_gtk.pm
@@ -292,7 +292,7 @@ sub create_buttons4partitions {
last;
}
});
- $w->set_name("PART_" . type2name($entry->{type}));
+ $w->set_name("PART_" . pt_type2name($entry->{pt_type}));
$w->set_size_request($entry->{size} * $ratio + $minwidth, 0);
gtkpack__($kind->{display_box}, $w);
$w->grab_focus if $current_entry && fsedit::are_same_partitions($current_entry, $entry);
@@ -325,12 +325,12 @@ sub hd2kind {
sub filesystems_button_box() {
my @types = (N_("Ext2"), N_("Journalised FS"), N_("Swap"), arch() =~ /sparc/ ? N_("SunOS") : arch() eq "ppc" ? N_("HFS") : N_("Windows"),
N_("Other"), N_("Empty"));
- my %name2type = (Ext2 => 0x83, 'Journalised FS' => 0x483, Swap => 0x82, Other => 1, "Windows" => 0xb, HFS => 0x402);
+ my %name2pt_type = (Ext2 => 0x83, 'Journalised FS' => 0x483, Swap => 0x82, Other => 1, "Windows" => 0xb, HFS => 0x402);
gtkpack(Gtk2::HBox->new(0,0),
N("Filesystem types:"),
map { my $w = Gtk2::Button->new(translate($_));
- my $t = $name2type{$_};
+ my $t = $name2pt_type{$_};
$w->signal_connect(clicked => sub { try_('', \&createOrChangeType, $t, current_hd(), current_part()) });
$w->can_focus(0);
$w->set_name($_);
@@ -339,20 +339,20 @@ sub filesystems_button_box() {
}
sub createOrChangeType {
- my ($in, $type, $hd, $part, $all_hds) = @_;
+ my ($in, $pt_type, $hd, $part, $all_hds) = @_;
$part ||= !fsedit::get_fstab($hd) &&
- { type => 0, start => 1, size => $hd->{totalsectors} - 1 };
+ { pt_type => 0, start => 1, size => $hd->{totalsectors} - 1 };
$part or return;
- if ($type == 1) {
- $in->ask_warn('', N("Use ``%s'' instead", $part->{type} ? N("Type") : N("Create")));
- } elsif (!$type) {
- $in->ask_warn('', N("Use ``%s'' instead", N("Delete"))) if $part->{type};
- } elsif ($part->{type}) {
- return if $type == $part->{type};
+ if ($pt_type == 1) {
+ $in->ask_warn('', N("Use ``%s'' instead", $part->{pt_type} ? N("Type") : N("Create")));
+ } elsif (!$pt_type) {
+ $in->ask_warn('', N("Use ``%s'' instead", N("Delete"))) if $part->{pt_type};
+ } elsif ($part->{pt_type}) {
+ return if $pt_type == $part->{pt_type};
$in->ask_warn('', isBusy($part) ? N("Use ``Unmount'' first") : N("Use ``%s'' instead", N("Type")));
} else {
- $part->{type} = $type;
+ $part->{pt_type} = $pt_type;
diskdrake::interactive::Create($in, $hd, $part, $all_hds);
}
}
diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm
index 8a029c26b..a5e4a6f7d 100644
--- a/perl-install/diskdrake/interactive.pm
+++ b/perl-install/diskdrake/interactive.pm
@@ -25,7 +25,7 @@ struct part {
int active # one of { 0 | 0x80 } x86 only, primary only
int start # in sectors
int size # in sectors
- int type # 0x82, 0x83, 0x6 ...
+ int pt_type # 0x82, 0x83, 0x6 ...
string device # 'hda5', 'sdc1' ...
string devfs_device # 'ide/host0/bus0/target0/lun0/part5', ...
string prefer_devfs_name # should the {devfs_device} or the {device} be used in fstab
@@ -144,7 +144,7 @@ struct hd_lvm inherits hd {
}
struct raw_hd inherits hd {
- string type # 0x82, 0x83, 'nfs', ...
+ string pt_type # 0x82, 0x83, 'nfs', ...
string mntpoint # '/', '/usr' ...
string options # 'defaults', 'noauto'
@@ -411,7 +411,7 @@ sub part_possible_actions {
my %actions = my @l = (
N_("Mount point") => '($part->{real_mntpoint} && common::usingRamdisk()) || (!isBusy && !isSwap && !isNonMountable)',
- N_("Type") => '!isBusy && $::expert && (!readonly || ($part->{type} & 0xff) == 0x83)',
+ N_("Type") => '!isBusy && $::expert && (!readonly || ($part->{pt_type} & 0xff) == 0x83)',
N_("Options") => '$::expert',
N_("Resize") => '!isBusy && !readonly && !isSpecial || isLVM($hd) && isMounted && isThisFs("xfs", $part)',
N_("Move") => '!isBusy && !readonly && !isSpecial && $::expert && 0', # disable for the moment
@@ -432,7 +432,7 @@ sub part_possible_actions {
hasMntpoint => '$part->{mntpoint}',
isPrimary => 'isPrimary($part, $hd)',
);
- if ($part->{type} eq '0') {
+ if ($part->{pt_type} eq '0') {
if_(!$hd->{readonly}, N_("Create"));
} else {
grep {
@@ -453,14 +453,14 @@ sub Create {
$part->{maxsize} = $part->{size}; $part->{size} = 0;
if (!fsedit::suggest_part($part, $all_hds)) {
$part->{size} = $part->{maxsize};
- $part->{type} ||= 0x483;
+ $part->{pt_type} ||= 0x483;
}
#- update adjustment for start and size, take into account the minimum partition size
#- including one less sector for start due to a capacity to increase the adjustement by
#- one.
my ($primaryOrExtended, $migrate_files);
- my $type = type2name($part->{type});
+ my $type_name = pt_type2name($part->{pt_type});
my $mb_size = $part->{size} >> 11;
my $has_startsector = ($::expert || arch() !~ /i.86/) && !isLVM($hd);
@@ -470,9 +470,9 @@ sub Create {
{ label => N("Start sector: "), val => \$part->{start}, min => $def_start, max => ($max - min_partition_size($hd)), type => 'range' },
),
{ label => N("Size in MB: "), val => \$mb_size, min => min_partition_size($hd) >> 11, max => $def_size >> 11, type => 'range' },
- { label => N("Filesystem type: "), val => \$type, list => [ partition_table::important_types() ], sort => 0 },
+ { label => N("Filesystem type: "), val => \$type_name, list => [ partition_table::important_types() ], sort => 0 },
{ label => N("Mount point: "), val => \$part->{mntpoint}, list => [ fsedit::suggestions_mntpoint($all_hds), '' ],
- disabled => sub { my $p = { type => name2type($type) }; isSwap($p) || isNonMountable($p) }, type => 'combo', not_edit => 0,
+ disabled => sub { my $p = { pt_type => name2pt_type($type_name) }; isSwap($p) || isNonMountable($p) }, type => 'combo', not_edit => 0,
},
if_($::expert && $hd->hasExtended,
{ label => N("Preference: "), val => \$primaryOrExtended, list => [ '', "Extended", "Primary", if_($::expert, "Extended_0x85") ] },
@@ -492,7 +492,7 @@ sub Create {
}
}, complete => sub {
$part->{size} = from_Mb($mb_size, min_partition_size($hd), $max - $part->{start}); #- need this to be able to get back the approximation of using MB
- $part->{type} = name2type($type);
+ $part->{pt_type} = name2pt_type($type_name);
$part->{mntpoint} = '' if isNonMountable($part);
$part->{mntpoint} = 'swap' if isSwap($part);
fs::set_default_options($part);
@@ -564,21 +564,21 @@ sub Type {
my @types = partition_table::important_types();
#- when readonly, Type() is allowed only when changing between various { 0x83, 0x183, ... }
- @types = grep { (name2type($_) & 0xff) == 0x83 } @types if $hd->{readonly};
+ @types = grep { (name2pt_type($_) & 0xff) == 0x83 } @types if $hd->{readonly};
- my $type_name = type2name($part->{type});
+ my $type_name = pt_type2name($part->{pt_type});
$in->ask_from_({ title => N("Change partition type"),
messages => N("Which filesystem do you want?"),
focus_first => 1,
},
[ { label => N("Type"), val => \$type_name, list => \@types, sort => 0, not_edit => !$::expert } ]) or return;
- my $type = $type_name && name2type($type_name);
+ my $pt_type = $type_name && name2pt_type($type_name);
- if (isExt2($part) && isThisFs('ext3', { type => $type })) {
+ if (isExt2($part) && isThisFs('ext3', { pt_type => $pt_type })) {
my $_w = $in->wait_message('', N("Switching from ext2 to ext3"));
if (run_program::run("tune2fs", "-j", devices::make($part->{device}))) {
- $part->{type} = $type;
+ $part->{pt_type} = $pt_type;
$part->{isFormatted} = 1; #- assume that if tune2fs works, partition is formatted
#- disable the fsck (don't do it together with -j in case -j fails?)
@@ -589,8 +589,8 @@ sub Type {
#- either we switch to non-ext3 or switching losslessly to ext3 failed
!isExt2($part) or $warn->() or return;
- if (defined $type) {
- check_type($in, $type, $hd, $part) and fsedit::change_type($type, $hd, $part);
+ if (defined $pt_type) {
+ check_pt_type($in, $pt_type, $hd, $part) and fsedit::change_pt_type($pt_type, $hd, $part);
}
}
@@ -870,16 +870,16 @@ sub Loopback {
my $part = { maxsize => $max, size => 0, loopback_device => $real_part, notFormatted => 1 };
if (!fsedit::suggest_part($part, $all_hds)) {
$part->{size} = $part->{maxsize};
- $part->{type} ||= 0x483;
+ $part->{pt_type} ||= 0x483;
}
delete $part->{mntpoint}; # we don't want the suggested mntpoint
- my $type = type2name($part->{type});
+ my $type_name = pt_type2name($part->{pt_type});
my $mb_size = $part->{size} >> 11;
$in->ask_from(N("Loopback"), '', [
{ label => N("Loopback file name: "), val => \$part->{loopback_file} },
{ label => N("Size in MB: "), val => \$mb_size, min => $min >> 11, max => $max >> 11, type => 'range' },
- { label => N("Filesystem type: "), val => \$type, list => [ partition_table::important_types() ], not_edit => !$::expert, sort => 0 },
+ { label => N("Filesystem type: "), val => \$type_name, list => [ partition_table::important_types() ], not_edit => !$::expert, sort => 0 },
],
complete => sub {
$part->{loopback_file} or $in->ask_warn('', N("Give a file name")), return 1, 0;
@@ -894,7 +894,7 @@ sub Loopback {
}
0;
}) or return;
- $part->{type} = name2type($type);
+ $part->{pt_type} = name2pt_type($type_name);
push @{$real_part->{loopback}}, $part;
fsedit::recompute_loopbacks($all_hds);
}
@@ -1018,16 +1018,16 @@ sub partitions_suggestions {
$fsedit::suggestions{$t};
}
-sub check_type {
- my ($in, $type, $hd, $part) = @_;
- eval { fsedit::check_type($type, $hd, $part) };
+sub check_pt_type {
+ my ($in, $pt_type, $hd, $part) = @_;
+ eval { fsedit::check_pt_type($pt_type, $hd, $part) };
if (my $err = $@) {
$in->ask_warn('', formatError($err));
return;
}
if ($::isStandalone) {
- if (my $pkg = fsedit::package_needed_for_partition_type({ type => $type })) {
- my $fs = type2fs({ type => $type });
+ if (my $pkg = fsedit::package_needed_for_partition_type({ pt_type => $pt_type })) {
+ my $fs = type2fs({ pt_type => $pt_type });
if (!-x "/sbin/mkfs.$fs") {
$in->ask_yesorno('', N("The package %s is needed. Install it?", $pkg), 1) or return;
$in->do_pkgs->install($pkg);
@@ -1052,7 +1052,7 @@ sub check_mntpoint {
}
sub check {
my ($in, $hd, $part, $all_hds) = @_;
- check_type($in, $part->{type}, $hd, $part) &&
+ check_pt_type($in, $part->{pt_type}, $hd, $part) &&
check_mntpoint($in, $part->{mntpoint}, $hd, $part, $all_hds);
}
@@ -1159,15 +1159,15 @@ sub format_part_info {
if (arch() eq "ppc") {
my $new_value = $part->{pType};
$new_value =~ s/[^A-Za-z0-9_]//g;
- $info .= N("Type: ") . $new_value . ($::expert ? sprintf " (0x%x)", $part->{type} : '') . "\n";
+ $info .= N("Type: ") . $new_value . ($::expert ? sprintf " (0x%x)", $part->{pt_type} : '') . "\n";
if (defined $part->{pName}) {
$new_value = $part->{pName};
$new_value =~ s/[^A-Za-z0-9_]//g;
$info .= N("Name: ") . $new_value . "\n";
}
- } elsif ($part->{type}) {
- my $type = substr(type2name($part->{type}), 0, 40); # limit the length
- $info .= N("Type: ") . $type . ($::expert ? sprintf " (0x%x)", $part->{type} : '') . "\n";
+ } elsif ($part->{pt_type}) {
+ my $type_name = substr(pt_type2name($part->{pt_type}), 0, 40); # limit the length
+ $info .= N("Type: ") . $type_name . ($::expert ? sprintf " (0x%x)", $part->{pt_type} : '') . "\n";
} else {
$info .= N("Empty") . "\n";
}
@@ -1176,7 +1176,7 @@ sub format_part_info {
$info .= sprintf " (%s%%)", int 100 * $part->{size} / $hd->{totalsectors} if $hd->{totalsectors};
$info .= N(", %s sectors", $part->{size}) if $::expert;
$info .= "\n";
- $info .= N("Cylinder %d to %d\n", $part->{start} / $hd->cylinder_size, ($part->{start} + $part->{size} - 1) / $hd->cylinder_size) if ($::expert || !$part->{type}) && !isSpecial($part) && !isLVM($hd);
+ $info .= N("Cylinder %d to %d\n", $part->{start} / $hd->cylinder_size, ($part->{start} + $part->{size} - 1) / $hd->cylinder_size) if ($::expert || !$part->{pt_type}) && !isSpecial($part) && !isLVM($hd);
$info .= N("Number of logical extents: %d", $part->{size} / $hd->cylinder_size) if $::expert && isLVM($hd);
$info .= N("Formatted\n") if $part->{isFormatted};
$info .= N("Not formatted\n") if !$part->{isFormatted} && $part->{notFormatted};
@@ -1205,7 +1205,7 @@ sub format_part_info {
sub format_part_info_short {
my ($hd, $part) = @_;
- $part->{type} ?
+ $part->{pt_type} ?
partition_table::description($part) :
format_part_info($hd, $part);
}
@@ -1231,9 +1231,9 @@ sub format_raw_hd_info {
my $info = '';
$info .= N("Mount point: ") . "$raw_hd->{mntpoint}\n" if $raw_hd->{mntpoint};
$info .= format_hd_info($raw_hd);
- if ($raw_hd->{type}) {
- my $type = substr(type2name($raw_hd->{type}), 0, 40); # limit the length
- $info .= N("Type: ") . $type . "\n";
+ if ($raw_hd->{pt_type}) {
+ my $type_name = substr(pt_type2name($raw_hd->{pt_type}), 0, 40); # limit the length
+ $info .= N("Type: ") . $type_name . "\n";
}
if (my $s = $raw_hd->{options}) {
$s =~ s/password=([^\s,]*)/'password=' . ('x' x length($1))/e;
diff --git a/perl-install/diskdrake/removable.pm b/perl-install/diskdrake/removable.pm
index 6862225c5..905f6a2c4 100644
--- a/perl-install/diskdrake/removable.pm
+++ b/perl-install/diskdrake/removable.pm
@@ -43,11 +43,11 @@ sub mount_point {
sub type {
my ($in, $raw_hd) = @_;
my @fs = ('auto', fs::auto_fs());
- my $type = $raw_hd->{type};
+ my $pt_type = $raw_hd->{pt_type};
$in->ask_from(N("Change type"),
N("Which filesystem do you want?"),
- [ { label => N("Type"), val => \$type, list => [@fs], not_edit => !$::expert } ]) or return;
- $raw_hd->{type} = $type;
+ [ { label => N("Type"), val => \$pt_type, list => [@fs], not_edit => !$::expert } ]) or return;
+ $raw_hd->{pt_type} = $pt_type;
}
1;
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 06a864f25..c5b26fbf4 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -41,17 +41,17 @@ sub read_fstab {
$comments{$l[-1]} = $comment if $comment;
map {
- my ($dev, $mntpoint, $type, $options, $freq, $passno) = split;
+ my ($dev, $mntpoint, $fs_type, $options, $freq, $passno) = split;
my $comment = $comments{$_};
$options = 'defaults' if $options eq 'rw'; # clean-up for mtab read
- $type = fs2type($type);
- if ($type eq 'supermount') {
+ my $pt_type = fs2pt_type($fs_type);
+ if ($pt_type eq 'supermount') {
# normalize this bloody supermount
$options = join(",", 'supermount', grep {
if (/fs=(.*)/) {
- $type = $1;
+ $pt_type = $1;
0;
} elsif (/dev=(.*)/) {
$dev = $1;
@@ -62,15 +62,15 @@ sub read_fstab {
1;
}
} split(',', $options));
- } elsif ($type eq 'smb') {
+ } elsif ($pt_type eq 'smb') {
# prefering type "smbfs" over "smb"
- $type = 'smbfs';
+ $pt_type = 'smbfs';
}
$mntpoint =~ s/\\040/ /g;
$dev =~ s/\\040/ /g;
my $h = {
- mntpoint => $mntpoint, type => $type,
+ mntpoint => $mntpoint, pt_type => $pt_type,
options => $options, comment => $comment,
if_(member('keep_freq_passno', @reading_options), freq => $freq, passno => $passno),
};
@@ -110,16 +110,16 @@ sub merge_fstabs {
$p->{mntpoint} = $p2->{mntpoint} if delete $p->{unsafeMntpoint};
- $p->{type} = $p2->{type} if $p2->{type} && !$loose;
+ $p->{pt_type} = $p2->{pt_type} if $p2->{pt_type} && !$loose;
$p->{options} = $p2->{options} if $p2->{options} && !$loose;
#- important to get isMounted property else DrakX may try to mount already mounted partitions :-(
add2hash($p, $p2);
$p->{device_alias} ||= $p2->{device_alias} || $p2->{device} if $p->{device} ne $p2->{device} && $p2->{device} !~ m|/|;
- $p->{type} && $p2->{type} && $p->{type} ne $p2->{type} && type2fs($p) ne type2fs($p2) &&
- $p->{type} ne 'auto' && $p2->{type} ne 'auto' and
+ $p->{pt_type} && $p2->{pt_type} && $p->{pt_type} ne $p2->{pt_type} && type2fs($p) ne type2fs($p2) &&
+ $p->{pt_type} ne 'auto' && $p2->{pt_type} ne 'auto' and
log::l("err, fstab and partition table do not agree for $p->{device} type: " .
- (type2fs($p) || type2name($p->{type})) . " vs ", (type2fs($p2) || type2name($p2->{type})));
+ (type2fs($p) || pt_type2name($p->{pt_type})) . " vs ", (type2fs($p2) || pt_type2name($p2->{pt_type})));
}
@l;
}
@@ -200,7 +200,7 @@ sub merge_info_from_mtab {
my ($fstab) = @_;
my @l1 = map { my $l = $_;
- my %l = (type => fs2type('swap'));
+ my %l = (pt_type => fs2pt_type('swap'));
$l{$_} = $l->{$_} foreach qw(device major minor);
\%l;
} read_fstab('', '/proc/swaps');
@@ -255,7 +255,7 @@ sub prepare_write_fstab {
my $device =
isLoopback($_) ?
($_->{mntpoint} eq '/' ? "/initrd/loopfs" : $_->{loopback_device}{mntpoint}) . $_->{loopback_file} :
- part2device($o_prefix, $_->{prefer_devfs_name} ? $_->{devfs_device} : $_->{device}, $_->{type});
+ part2device($o_prefix, $_->{prefer_devfs_name} ? $_->{devfs_device} : $_->{device}, $_->{pt_type});
my $real_mntpoint = $_->{mntpoint} || ${{ '/tmp/hdimage' => '/mnt/hd' }}{$_->{real_mntpoint}};
mkdir_p("$o_prefix$real_mntpoint") if $real_mntpoint =~ m|^/|;
@@ -283,7 +283,7 @@ sub prepare_write_fstab {
}
}
- my $type = type2fs($_, 'auto');
+ my $fs_type = type2fs($_, 'auto');
my $dev =
$_->{prefer_device_LABEL} ? 'LABEL=' . $_->{device_LABEL} :
@@ -297,19 +297,19 @@ sub prepare_write_fstab {
my @l = grep { $_ ne 'supermount' } split(',', $options);
my @l1 = grep { member($_, 'ro', 'exec') } @l;
my @l2 = difference2(\@l, \@l1);
- $options = join(",", "dev=$dev", "fs=$type", @l1, if_(@l2, '--', @l2));
- ($dev, $type) = ('none', 'supermount');
+ $options = join(",", "dev=$dev", "fs=$fs_type", @l1, if_(@l2, '--', @l2));
+ ($dev, $fs_type) = ('none', 'supermount');
} else {
#- if we were using supermount, the type could be something like ext2:vfat
#- but this can't be done without supermount, so switching to "auto"
- $type = 'auto' if $type =~ /:/;
+ $fs_type = 'auto' if $fs_type =~ /:/;
}
- [ $mntpoint, $_->{comment} . join(' ', $dev, $mntpoint, $type, $options || 'defaults', $freq, $passno) . "\n" ];
+ [ $mntpoint, $_->{comment} . join(' ', $dev, $mntpoint, $fs_type, $options || 'defaults', $freq, $passno) . "\n" ];
} else {
()
}
- } grep { $_->{device} && ($_->{mntpoint} || $_->{real_mntpoint}) && $_->{type} && ($_->{isFormatted} || !$_->{notFormatted}) } @$fstab;
+ } grep { $_->{device} && ($_->{mntpoint} || $_->{real_mntpoint}) && $_->{pt_type} && ($_->{isFormatted} || !$_->{notFormatted}) } @$fstab;
join('', map { $_->[1] } sort { $a->[0] cmp $b->[0] } @l), \@smb_credentials;
}
@@ -331,8 +331,8 @@ sub write_fstab {
}
sub part2device {
- my ($prefix, $dev, $type) = @_;
- $dev eq 'none' || member($type, qw(nfs smbfs davfs)) ?
+ my ($prefix, $dev, $pt_type) = @_;
+ $dev eq 'none' || member($pt_type, qw(nfs smbfs davfs)) ?
$dev :
do {
my $dir = $dev =~ m!^(/|LABEL=)! ? '' : '/dev/';
@@ -373,13 +373,13 @@ sub mount_options_unpack {
push @{$per_fs{$_}}, 'usrquota', 'grpquota' foreach 'ext2', 'ext3', 'xfs';
while (my ($fs, $l) = each %per_fs) {
- isThisFs($fs, $part) || $part->{type} eq 'auto' && member($fs, @auto_fs) or next;
+ isThisFs($fs, $part) || $part->{pt_type} eq 'auto' && member($fs, @auto_fs) or next;
$non_defaults->{$_} = 1 foreach @$l;
}
$non_defaults->{encrypted} = 1 if !$part->{isFormatted} || isSwap($part);
- $non_defaults->{supermount} = 1 if $part->{type} =~ /:/ || member(type2fs($part), 'auto', @auto_fs);
+ $non_defaults->{supermount} = 1 if $part->{pt_type} =~ /:/ || member(type2fs($part), 'auto', @auto_fs);
my $defaults = { reverse %$non_defaults };
my %options = map { $_ => '' } keys %$non_defaults;
@@ -504,7 +504,7 @@ sub set_default_options {
if ($part->{is_removable}) {
$options->{supermount} = $opts{useSupermount} && !($opts{useSupermount} eq 'magicdev' && $part->{media_type} eq 'cdrom');
- $part->{type} = !$options->{supermount} ? 'auto' :
+ $part->{pt_type} = !$options->{supermount} ? 'auto' :
$part->{media_type} eq 'cdrom' ? 'udf:iso9660' : 'ext2:vfat';
}
@@ -532,7 +532,7 @@ sub set_default_options {
if (isThisFs('smbfs', $part)) {
add2hash($options, { 'username=' => '%' }) if !$options->{'credentials='};
}
- if (isFat($part) || member('vfat', split(':', $part->{type})) || isThisFs('auto', $part)) {
+ if (isFat($part) || member('vfat', split(':', $part->{pt_type})) || isThisFs('auto', $part)) {
put_in_hash($options, {
user => 1, noexec => 0,
@@ -548,7 +548,7 @@ sub set_default_options {
'umask=0' => $opts{security} < 3, 'umask=0022' => $opts{security} < 4,
});
}
- if (member('iso9660', split(':', $part->{type})) || isThisFs('auto', $part)) {
+ if (member('iso9660', split(':', $part->{pt_type})) || isThisFs('auto', $part)) {
put_in_hash($options, { user => 1, noexec => 0, 'iocharset=' => $opts{iocharset} });
}
if (isThisFs('reiserfs', $part)) {
@@ -613,8 +613,8 @@ sub get_raw_hds {
$all_hds->{davs} = [ grep { isThisFs('davfs', $_) } @fstab ];
$all_hds->{special} = [
(grep { isThisFs('tmpfs', $_) } @fstab),
- { device => 'none', mntpoint => '/proc', type => 'proc' },
- { device => 'none', mntpoint => '/dev/pts', type => 'devpts', options => 'mode=0620' },
+ { device => 'none', mntpoint => '/proc', pt_type => 'proc' },
+ { device => 'none', mntpoint => '/dev/pts', pt_type => 'devpts', options => 'mode=0620' },
];
}
@@ -672,7 +672,7 @@ sub real_format_part {
my $dev = $part->{real_device} || $part->{device};
my @options = if_($part->{toFormatCheck}, "-c");
- log::l("formatting device $dev (type ", type2name($part->{type}), ")");
+ log::l("formatting device $dev (type ", pt_type2name($part->{pt_type}), ")");
if (isExt2($part)) {
push @options, "-F" if isLoopback($part);
@@ -699,7 +699,7 @@ sub real_format_part {
my $check_blocks = any { /^-c$/ } @options;
swap::make($dev, $check_blocks);
} else {
- die N("I don't know how to format %s in type %s", $part->{device}, type2name($part->{type}));
+ die N("I don't know how to format %s in type %s", $part->{device}, pt_type2name($part->{pt_type}));
}
$part->{isFormatted} = 1;
}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 89e999b01..ce09f1873 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -19,26 +19,26 @@ use fs;
%suggestions = (
N_("simple") => [
- { mntpoint => "/", size => 300 << 11, type =>0x483, ratio => 5, maxsize => 6000 << 11 },
- { mntpoint => "swap", size => 64 << 11, type => 0x82, ratio => 1, maxsize => 500 << 11 },
- { mntpoint => "/home", size => 300 << 11, type =>0x483, ratio => 3 },
+ { mntpoint => "/", size => 300 << 11, pt_type =>0x483, ratio => 5, maxsize => 6000 << 11 },
+ { mntpoint => "swap", size => 64 << 11, pt_type => 0x82, ratio => 1, maxsize => 500 << 11 },
+ { mntpoint => "/home", size => 300 << 11, pt_type =>0x483, ratio => 3 },
], N_("with /usr") => [
- { mntpoint => "/", size => 250 << 11, type =>0x483, ratio => 1, maxsize => 2000 << 11 },
- { mntpoint => "swap", size => 64 << 11, type => 0x82, ratio => 1, maxsize => 500 << 11 },
- { mntpoint => "/usr", size => 300 << 11, type =>0x483, ratio => 4, maxsize => 4000 << 11 },
- { mntpoint => "/home", size => 100 << 11, type =>0x483, ratio => 3 },
+ { mntpoint => "/", size => 250 << 11, pt_type =>0x483, ratio => 1, maxsize => 2000 << 11 },
+ { mntpoint => "swap", size => 64 << 11, pt_type => 0x82, ratio => 1, maxsize => 500 << 11 },
+ { mntpoint => "/usr", size => 300 << 11, pt_type =>0x483, ratio => 4, maxsize => 4000 << 11 },
+ { mntpoint => "/home", size => 100 << 11, pt_type =>0x483, ratio => 3 },
], N_("server") => [
- { mntpoint => "/", size => 150 << 11, type =>0x483, ratio => 1, maxsize => 800 << 11 },
- { mntpoint => "swap", size => 64 << 11, type => 0x82, ratio => 2, maxsize => 800 << 11 },
- { mntpoint => "/usr", size => 300 << 11, type =>0x483, ratio => 4, maxsize => 4000 << 11 },
- { mntpoint => "/var", size => 200 << 11, type =>0x483, ratio => 3 },
- { mntpoint => "/home", size => 150 << 11, type =>0x483, ratio => 3 },
- { mntpoint => "/tmp", size => 150 << 11, type =>0x483, ratio => 2, maxsize => 1000 << 11 },
+ { mntpoint => "/", size => 150 << 11, pt_type =>0x483, ratio => 1, maxsize => 800 << 11 },
+ { mntpoint => "swap", size => 64 << 11, pt_type => 0x82, ratio => 2, maxsize => 800 << 11 },
+ { mntpoint => "/usr", size => 300 << 11, pt_type =>0x483, ratio => 4, maxsize => 4000 << 11 },
+ { mntpoint => "/var", size => 200 << 11, pt_type =>0x483, ratio => 3 },
+ { mntpoint => "/home", size => 150 << 11, pt_type =>0x483, ratio => 3 },
+ { mntpoint => "/tmp", size => 150 << 11, pt_type =>0x483, ratio => 2, maxsize => 1000 << 11 },
],
);
foreach (values %suggestions) {
if (arch() =~ /ia64/) {
- @$_ = ({ mntpoint => "/boot/efi", size => 50 << 11, type => 0xef, ratio => 1, maxsize => 150 << 11 }, @$_);
+ @$_ = ({ mntpoint => "/boot/efi", size => 50 << 11, pt_type => 0xef, ratio => 1, maxsize => 150 << 11 }, @$_);
}
}
@@ -113,10 +113,10 @@ sub raids {
my @raw_mdparts = map { /([^\[]+)/ } split ' ', $mdparts;
- my $type = typeOfPart("md$nb");
- log::l("RAID: found md$nb (raid $level) chunks $chunks ", if_($type, "type $type "), "with parts ", join(", ", @raw_mdparts));
- $raids[$nb] = { 'chunk-size' => $chunks, type => $type || 0x83, raw_mdparts => \@raw_mdparts,
- device => "md$nb", notFormatted => !$type, level => $level };
+ my $pt_type = typeOfPart("md$nb");
+ log::l("RAID: found md$nb (raid $level) chunks $chunks ", if_($pt_type, "type $pt_type "), "with parts ", join(", ", @raw_mdparts));
+ $raids[$nb] = { 'chunk-size' => $chunks, pt_type => $pt_type || 0x83, raw_mdparts => \@raw_mdparts,
+ device => "md$nb", notFormatted => !$pt_type, level => $level };
}
my %devname2part = map { $_->{dev} => { %$_, device => $_->{dev} } } devices::read_proc_partitions_raw();
@@ -127,7 +127,7 @@ sub raids {
my $mdpart = $devname2part{$_} || { device => $_ };
if (my $part = find { is_same_hd($mdpart, $_) } @parts, @raids) {
$part->{raid} = $::i;
- $part->{type} = 0xfd;
+ $part->{pt_type} = 0xfd;
delete $part->{mntpoint};
$part;
} else {
@@ -205,7 +205,7 @@ sub hds {
if ($hd->{readonly}) {
log::l("using /proc/partitions since diskdrake failed :(");
use_proc_partitions($hd);
- } elsif (exists $hd->{usb_description} && ($hd->{type} ||= typeOfPart($hd->{device}))) {
+ } elsif (exists $hd->{usb_description} && ($hd->{pt_type} ||= typeOfPart($hd->{device}))) {
push @raw_hds, $hd;
next;
} elsif ($o_ask_before_blanking && $o_ask_before_blanking->($hd->{device}, $err)) {
@@ -221,13 +221,13 @@ sub hds {
}
# special case for Various type
- $_->{type} = typeOfPart($_->{device}) || 0x100 foreach grep { $_->{type} == 0x100 } partition_table::get_normal_parts($hd);
+ $_->{pt_type} = typeOfPart($_->{device}) || 0x100 foreach grep { $_->{pt_type} == 0x100 } partition_table::get_normal_parts($hd);
#- special case for type overloading (eg: reiserfs is 0x183)
- foreach (grep { isExt2($_) || $_->{type} == 0x7 || $_->{type} == 0x17 } partition_table::get_normal_parts($hd)) {
- my $wanted_type = $_->{type} == 0x17 ? 0x7 : $_->{type};
- my $type = typeOfPart($_->{device});
- $_->{type} = $type if ($type & 0xff) == $wanted_type || $type && $hd->isa('partition_table::gpt');
+ foreach (grep { isExt2($_) || $_->{pt_type} == 0x7 || $_->{pt_type} == 0x17 } partition_table::get_normal_parts($hd)) {
+ my $wanted_pt_type = $_->{pt_type} == 0x17 ? 0x7 : $_->{pt_type};
+ my $pt_type = typeOfPart($_->{device});
+ $_->{pt_type} = $pt_type if ($pt_type & 0xff) == $wanted_pt_type || $pt_type && $hd->isa('partition_table::gpt');
}
foreach (partition_table::get_normal_parts($hd)) {
@@ -303,7 +303,7 @@ sub read_proc_partitions {
$part->{device} = $dev;
$part->{size} *= 2; # from KB to sectors
- $part->{type} = typeOfPart($dev);
+ $part->{pt_type} = typeOfPart($dev);
$part->{start} = $prev_part ? $prev_part->{start} + $prev_part->{size} : 0;
$prev_part = $part;
delete $part->{dev}; # cleanup
@@ -338,7 +338,7 @@ sub is_same_hd {
#- are_same_partitions() do not look at the device name since things may have changed
sub are_same_partitions {
my ($part1, $part2) = @_;
- foreach ('start', 'size', 'type', 'rootDevice') {
+ foreach ('start', 'size', 'pt_type', 'rootDevice') {
$part1->{$_} eq $part2->{$_} or return;
}
1;
@@ -360,7 +360,7 @@ sub get_fstab_and_holes {
if (isLVM($_)) {
my @parts = partition_table::get_normal_parts($_);
my $free = $_->{totalsectors} - sum map { $_->{size} } @parts;
- my $free_part = { start => 0, size => $free, type => 0, rootDevice => $_->{VG_name} };
+ my $free_part = { start => 0, size => $free, pt_type => 0, rootDevice => $_->{VG_name} };
@parts, if_($free >= $_->cylinder_size, $free_part);
} else {
partition_table::get_normal_parts_and_holes($_);
@@ -368,7 +368,7 @@ sub get_fstab_and_holes {
} @_;
}
sub get_holes {
- grep { $_->{type} == 0 } get_fstab_and_holes(@_);
+ grep { $_->{pt_type} == 0 } get_fstab_and_holes(@_);
}
sub get_all_fstab {
@@ -390,7 +390,7 @@ sub get_all_fstab_and_holes {
}
sub get_all_holes {
my ($all_hds) = @_;
- grep { $_->{type} == 0 } get_all_fstab_and_holes($all_hds);
+ grep { $_->{pt_type} == 0 } get_all_fstab_and_holes($all_hds);
}
sub all_free_space {
@@ -485,13 +485,13 @@ sub suggest_part {
my ($best) =
grep { !$_->{maxsize} || $part->{size} <= $_->{maxsize} }
grep { $_->{size} <= ($part->{maxsize} || $part->{size}) }
- grep { !$part->{type} || $part->{type} == $_->{type} || isTrueFS($part) && isTrueFS($_) }
+ grep { !$part->{pt_type} || $part->{pt_type} == $_->{pt_type} || isTrueFS($part) && isTrueFS($_) }
@local_suggestions;
defined $best or return; #- sorry no suggestion :(
$part->{mntpoint} = $best->{mntpoint};
- $part->{type} = $best->{type} if !(isTrueFS($best) && isTrueFS($part));
+ $part->{pt_type} = $best->{pt_type} if !(isTrueFS($best) && isTrueFS($part));
$part->{size} = computeSize($part, $best, $all_hds, \@local_suggestions);
foreach ('options', 'lv_name', 'encrypt_key') {
$part->{$_} = $best->{$_} if $best->{$_};
@@ -519,11 +519,11 @@ sub get_root_ {
}
sub get_root { &get_root_ || {} }
-#- do this before modifying $part->{type}
-sub check_type {
- my ($type, $_hd, $part) = @_;
- isThisFs("jfs", { type => $type }) && $part->{size} < 16 << 11 and die N("You can't use JFS for partitions smaller than 16MB");
- isThisFs("reiserfs", { type => $type }) && $part->{size} < 32 << 11 and die N("You can't use ReiserFS for partitions smaller than 32MB");
+#- do this before modifying $part->{pt_type}
+sub check_pt_type {
+ my ($pt_type, $_hd, $part) = @_;
+ isThisFs("jfs", { pt_type => $pt_type }) && $part->{size} < 16 << 11 and die N("You can't use JFS for partitions smaller than 16MB");
+ isThisFs("reiserfs", { pt_type => $pt_type }) && $part->{size} < 32 << 11 and die N("You can't use ReiserFS for partitions smaller than 32MB");
}
sub package_needed_for_partition_type {
@@ -648,7 +648,7 @@ sub auto_allocate_raids {
my %h = %$md;
delete @h{'hd', 'parts'};
- put_in_hash($part, \%h); # mntpoint, level, chunk-size, type
+ put_in_hash($part, \%h); # mntpoint, level, chunk-size, pt_type
raid::updateSize($part);
}
}
@@ -762,14 +762,14 @@ sub move {
}
}
-sub change_type {
- my ($type, $hd, $part) = @_;
- $type != $part->{type} or return;
- check_type($type, $hd, $part);
+sub change_pt_type {
+ my ($pt_type, $hd, $part) = @_;
+ $pt_type != $part->{pt_type} or return;
+ check_pt_type($pt_type, $hd, $part);
$hd->{isDirty} = 1;
$part->{mntpoint} = '' if isSwap($part) && $part->{mntpoint} eq "swap";
- $part->{mntpoint} = '' if isRawLVM({ type => $type }) || isRawRAID({ type => $type });
- $part->{type} = $type;
+ $part->{mntpoint} = '' if isRawLVM({ pt_type => $pt_type }) || isRawRAID({ pt_type => $pt_type });
+ $part->{pt_type} = $pt_type;
$part->{notFormatted} = 1;
$part->{isFormatted} = 0;
fs::rationalize_options($part);
@@ -784,7 +784,7 @@ sub rescuept($) {
local $_;
while (<$F>) {
my ($st, $si, $id) = /start=\s*(\d+),\s*size=\s*(\d+),\s*Id=\s*(\d+)/ or next;
- my $part = { start => $st, size => $si, type => hex($id) };
+ my $part = { start => $st, size => $si, pt_type => hex($id) };
if (isExtended($part)) {
$ext = $part;
} else {
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 8ab92f8fd..f1c052877 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -793,7 +793,7 @@ sub g_auto_install {
require pkgs;
$o->{default_packages} = pkgs::selected_leaves($::o->{packages});
- my @fields = qw(mntpoint type size);
+ my @fields = qw(mntpoint pt_type size);
$o->{partitions} = [ map { my %l; @l{@fields} = @$_{@fields}; \%l } grep { $_->{mntpoint} } @{$::o->{fstab}} ];
exists $::o->{$_} and $o->{$_} = $::o->{$_} foreach qw(locale authentication mouse netc timezone superuser intf keyboard users partitioning isUpgrade manualFstab nomouseprobe crypto security security_user libsafe netcnx useSupermount autoExitInstall X services); #- TODO modules bootloader
@@ -977,6 +977,12 @@ sub loadO {
$O and add2hash_($o ||= {}, $O);
}
$O and bless $o, ref $O;
+
+ #- handle backward compatibility for things that changed
+ foreach (@{$o->{partitions} || []}, @{$o->{manualFstab} || []}) {
+ $_->{pt_type} ||= $_->{type};
+ }
+
$o;
}
@@ -1104,7 +1110,7 @@ sub getHds {
$o->{fstab} = [ fsedit::get_really_all_fstab($all_hds) ];
fs::merge_info_from_mtab($o->{fstab});
- my @win = grep { isFat_or_NTFS($_) && isFat_or_NTFS({ type => fsedit::typeOfPart($_->{device}) }) } @{$o->{fstab}};
+ my @win = grep { isFat_or_NTFS($_) && isFat_or_NTFS({ pt_type => fsedit::typeOfPart($_->{device}) }) } @{$o->{fstab}};
log::l("win parts: ", join ",", map { $_->{device} } @win) if @win;
if (@win == 1) {
#- Suggest /boot/efi on ia64.
@@ -1116,7 +1122,7 @@ sub getHds {
}
}
- my @sunos = grep { isSunOS($_) && type2name($_->{type}) =~ /root/i } @{$o->{fstab}}; #- take only into account root partitions.
+ my @sunos = grep { isSunOS($_) && pt_type2name($_->{pt_type}) =~ /root/i } @{$o->{fstab}}; #- take only into account root partitions.
if (@sunos) {
my $v = '';
map { $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/sunos" . ($v && ++$v) } @sunos;
diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm
index 186397e37..e86c10bb6 100644
--- a/perl-install/install_interactive.pm
+++ b/perl-install/install_interactive.pm
@@ -121,8 +121,8 @@ sub partitionWizardSolutions {
{ label => N("Swap partition size in MB: "), val => \$s_swap, min => $min_swap >> 11, max => $max_swap >> 11, type => 'range' },
]) or return;
push @{$part->{loopback}},
- { type =>0x483, loopback_file => '/lnx4win/linuxsys.img', mntpoint => '/', size => $s_root << 11, loopback_device => $part, notFormatted => 1 },
- { type => 0x82, loopback_file => '/lnx4win/swapfile', mntpoint => 'swap', size => $s_swap << 11, loopback_device => $part, notFormatted => 1 };
+ { pt_type =>0x483, loopback_file => '/lnx4win/linuxsys.img', mntpoint => '/', size => $s_root << 11, loopback_device => $part, notFormatted => 1 },
+ { pt_type => 0x82, loopback_file => '/lnx4win/swapfile', mntpoint => 'swap', size => $s_swap << 11, loopback_device => $part, notFormatted => 1 };
fsedit::recompute_loopbacks($all_hds);
1;
} ];
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index eda66496e..ec83e3fd9 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -215,7 +215,7 @@ sub doPartitionDisksAfter {
cat_("/proc/mounts") =~ m|(\S+)\s+/tmp/nfsimage| &&
!any { $_->{mntpoint} eq "/mnt/nfs" } @{$o->{all_hds}{nfss}} and
- push @{$o->{all_hds}{nfss}}, { type => 'nfs', mntpoint => "/mnt/nfs", device => $1, options => "noauto,ro,nosuid,soft,rsize=8192,wsize=8192" };
+ push @{$o->{all_hds}{nfss}}, { pt_type => 'nfs', mntpoint => "/mnt/nfs", device => $1, options => "noauto,ro,nosuid,soft,rsize=8192,wsize=8192" };
}
#------------------------------------------------------------------------------
@@ -243,7 +243,7 @@ sub ask_mntpoint_s {#-}}}
$m{$m} = 1;
#- in case the type does not correspond, force it to ext3
- $_->{type} = 0x483 if $m =~ m|^/| && !isTrueFS($_) && !isOtherAvailableFS($_);
+ $_->{pt_type} = 0x483 if $m =~ m|^/| && !isTrueFS($_) && !isOtherAvailableFS($_);
}
1;
}
@@ -269,7 +269,7 @@ sub choosePartitionsToFormat($$) {
my $t = fsedit::typeOfPart($_->{device});
$_->{toFormatUnsure} ||=
#- if detected dos/win, it's not precise enough to just compare the types (too many of them)
- (!$t || isOtherAvailableFS({ type => $t }) ? !isOtherAvailableFS($_) : $t != $_->{type});
+ (!$t || isOtherAvailableFS({ pt_type => $t }) ? !isOtherAvailableFS($_) : $t != $_->{pt_type});
}
}
}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index d7a3369bd..92f4fa805 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -286,7 +286,7 @@ sub doPartitionDisks {
log::l("creating bootstrap partition on drive /dev/$freepart->{hd}{device}, block $freepart->{start}");
$partition_table::mac::bootstrap_part = $freepart->{part};
log::l("bootstrap now at $partition_table::mac::bootstrap_part");
- fsedit::add($freepart->{hd}, { start => $freepart->{start}, size => 1 << 11, type => 0x401, mntpoint => '' }, $o->{all_hds}, { force => 1, primaryOrExtended => 'Primary' });
+ fsedit::add($freepart->{hd}, { start => $freepart->{start}, size => 1 << 11, pt_type => 0x401, mntpoint => '' }, $o->{all_hds}, { force => 1, primaryOrExtended => 'Primary' });
$new_bootstrap = 1;
} else {
$o->ask_warn('', N("No free space for 1MB bootstrap! Install will continue, but to boot your system, you'll need to create the bootstrap partition in DiskDrake"));
diff --git a/perl-install/lvm.pm b/perl-install/lvm.pm
index 0770bf2b9..c660e4d95 100644
--- a/perl-install/lvm.pm
+++ b/perl-install/lvm.pm
@@ -92,10 +92,10 @@ sub get_lvs {
[
map {
my $device = "$lvm->{VG_name}/$_";
- my $type = -e "/dev/$device" && fsedit::typeOfPart($device);
+ my $pt_type = -e "/dev/$device" && fsedit::typeOfPart($device);
{ device => $device,
- type => $type || 0x83,
+ type => $pt_type || 0x83,
size => get_lv_size($device) }
} @l
];
diff --git a/perl-install/network/smbnfs.pm b/perl-install/network/smbnfs.pm
index 97f2bd6e6..d9b53aedb 100644
--- a/perl-install/network/smbnfs.pm
+++ b/perl-install/network/smbnfs.pm
@@ -35,8 +35,8 @@ sub to_fullstring {
$class->to_dev($e) . ($comment ? " ($comment)" : '');
}
sub to_fstab_entry_raw {
- my ($class, $e, $type) = @_;
- my $fs_entry = { device => $class->to_dev($e), type => $type };
+ my ($class, $e, $pt_type) = @_;
+ my $fs_entry = { device => $class->to_dev($e), pt_type => $pt_type };
fs::set_default_options($fs_entry);
$fs_entry;
}
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index b8f96fb1a..c7f968c6f 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @important_types2 @fie
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- types => [ qw(type2name type2fs name2type fs2type isExtended isExt2 isThisFs isTrueLocalFS isTrueFS isSwap isDos isWin isFat isFat_or_NTFS isSunOS isOtherAvailableFS isPrimary isRawLVM isRawRAID isRAID isLVM isMountableRW isNonMountable isPartOfLVM isPartOfRAID isPartOfLoopback isLoopback isMounted isBusy isSpecial maybeFormatted isApple isAppleBootstrap isEfi) ],
+ types => [ qw(pt_type2name type2fs name2pt_type fs2pt_type isExtended isExt2 isThisFs isTrueLocalFS isTrueFS isSwap isDos isWin isFat isFat_or_NTFS isSunOS isOtherAvailableFS isPrimary isRawLVM isRawRAID isRAID isLVM isMountableRW isNonMountable isPartOfLVM isPartOfRAID isPartOfLoopback isLoopback isMounted isBusy isSpecial maybeFormatted isApple isAppleBootstrap isEfi) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -27,7 +27,7 @@ use log;
@bad_types = ('Empty', 'DOS 3.3+ Extended Partition', 'Win95: Extended partition, LBA-mapped', 'Linux extended partition');
-my %types = (
+my %pt_types = (
0x0 => 'Empty',
if_(arch() =~ /^ppc/,
0x183 => 'Journalised FS: ReiserFS',
@@ -177,7 +177,7 @@ if_(arch() =~ /^ppc/,
0xff => 'Xenix Bad Block Table',
);
-my %type2fs = (
+my %pt_type2fs = (
arch() =~ /^ppc/ ? (
0x07 => 'hpfs',
) : (
@@ -215,41 +215,42 @@ arch() !~ /sparc/ ? (
0x402 => 'hfs',
);
-my %types_rev = reverse %types;
-my %fs2type = reverse %type2fs;
+my %pt_types_rev = reverse %pt_types;
+my %fs2pt_type = reverse %pt_type2fs;
1;
sub important_types() {
- my @l = (@important_types, if_($::expert, @important_types2, sort values %types));
+ my @l = (@important_types, if_($::expert, @important_types2, sort values %pt_types));
difference2(\@l, \@bad_types);
}
sub type2fs {
my ($part, $o_default) = @_;
- my $type = $part->{type};
- $type2fs{$type} || $type =~ /^(\d+)$/ && $o_default || $type;
+ my $pt_type = $part->{pt_type};
+ $pt_type2fs{$pt_type} || $pt_type =~ /^(\d+)$/ && $o_default || $pt_type;
}
-sub fs2type { $fs2type{$_[0]} || $_[0] }
-sub type2name { $types{$_[0]} || $_[0] }
-sub name2type {
+sub fs2pt_type { $fs2pt_type{$_[0]} || $_[0] }
+sub pt_type2name { $pt_types{$_[0]} || $_[0] }
+sub name2pt_type {
local ($_) = @_;
- /0x(.*)/ ? hex $1 : $types_rev{$_} || $_;
+ /0x(.*)/ ? hex $1 : $pt_types_rev{$_} || $_;
}
+#sub name2type { { pt_type => name2pt_type($_[0]) } }
-sub isEfi { arch() =~ /ia64/ && $_[0]{type} == 0xef }
-sub isWholedisk { arch() =~ /^sparc/ && $_[0]{type} == 5 }
-sub isExtended { arch() !~ /^sparc/ && ($_[0]{type} == 5 || $_[0]{type} == 0xf || $_[0]{type} == 0x85) }
-sub isRawLVM { $_[0]{type} == 0x8e }
-sub isRawRAID { $_[0]{type} == 0xfd }
+sub isEfi { arch() =~ /ia64/ && $_[0]{pt_type} == 0xef }
+sub isWholedisk { arch() =~ /^sparc/ && $_[0]{pt_type} == 5 }
+sub isExtended { arch() !~ /^sparc/ && ($_[0]{pt_type} == 5 || $_[0]{pt_type} == 0xf || $_[0]{pt_type} == 0x85) }
+sub isRawLVM { $_[0]{pt_type} == 0x8e }
+sub isRawRAID { $_[0]{pt_type} == 0xfd }
sub isSwap { type2fs($_[0]) eq 'swap' }
sub isExt2 { type2fs($_[0]) eq 'ext2' }
-sub isDos { arch() !~ /^sparc/ && ${{ 1 => 1, 4 => 1, 6 => 1 }}{$_[0]{type}} }
-sub isWin { ${{ 0xb => 1, 0xc => 1, 0xe => 1, 0x1b => 1, 0x1c => 1, 0x1e => 1 }}{$_[0]{type}} }
+sub isDos { arch() !~ /^sparc/ && ${{ 1 => 1, 4 => 1, 6 => 1 }}{$_[0]{pt_type}} }
+sub isWin { ${{ 0xb => 1, 0xc => 1, 0xe => 1, 0x1b => 1, 0x1c => 1, 0x1e => 1 }}{$_[0]{pt_type}} }
sub isFat { isDos($_[0]) || isWin($_[0]) }
-sub isFat_or_NTFS { isDos($_[0]) || isWin($_[0]) || $_[0]{type} == 0x107 }
-sub isSunOS { arch() =~ /sparc/ && ${{ 0x1 => 1, 0x2 => 1, 0x4 => 1, 0x6 => 1, 0x7 => 1, 0x8 => 1 }}{$_[0]{type}} }
+sub isFat_or_NTFS { isDos($_[0]) || isWin($_[0]) || $_[0]{pt_type} == 0x107 }
+sub isSunOS { arch() =~ /sparc/ && ${{ 0x1 => 1, 0x2 => 1, 0x4 => 1, 0x6 => 1, 0x7 => 1, 0x8 => 1 }}{$_[0]{pt_type}} }
sub isApple { type2fs($_[0]) eq 'apple' && defined $_[0]{isDriver} }
sub isAppleBootstrap { type2fs($_[0]) eq 'apple' && defined $_[0]{isBoot} }
sub isHiddenMacPart { defined $_[0]{isMap} }
@@ -289,7 +290,7 @@ sub description {
formatXiB($hd->{totalsectors} || $hd->{size}, 512),
$hd->{info} && ", $hd->{info}",
$hd->{mntpoint} && ", " . $hd->{mntpoint},
- $hd->{type} && ", " . type2name($hd->{type});
+ $hd->{pt_type} && ", " . pt_type2name($hd->{pt_type});
}
sub isPrimary {
@@ -399,11 +400,11 @@ sub assign_device_numbers {
#- isFat_or_NTFS isn't true for 0x7 partitions, only for 0x107.
#- alas 0x107 is not set correctly at this stage
#- solution: don't bother with 0x7 vs 0x107 here
- my ($c, @others) = grep { isFat_or_NTFS($_) || $_->{type} == 0x7 || $_->{type} == 0x17 } @{$hd->{primary}{normal}};
+ my ($c, @others) = grep { isFat_or_NTFS($_) || $_->{pt_type} == 0x7 || $_->{pt_type} == 0x17 } @{$hd->{primary}{normal}};
$i = ord 'C';
$c->{device_windobe} = chr($i++) if $c;
- $_->{device_windobe} = chr($i++) foreach grep { isFat_or_NTFS($_) || $_->{type} == 0x7 || $_->{type} == 0x17 } map { $_->{normal} } @{$hd->{extended}};
+ $_->{device_windobe} = chr($i++) foreach grep { isFat_or_NTFS($_) || $_->{pt_type} == 0x7 || $_->{pt_type} == 0x17 } map { $_->{normal} } @{$hd->{extended}};
$_->{device_windobe} = chr($i++) foreach @others;
}
@@ -435,7 +436,7 @@ sub adjust_main_extended {
$start = min($start, $_->{start});
$end = max($end, $_->{start} + $_->{size});
$only_linux &&= isTrueLocalFS($_) || isSwap($_);
- $has_win_lba ||= $_->{type} == 0xc || $_->{type} == 0xe;
+ $has_win_lba ||= $_->{pt_type} == 0xc || $_->{pt_type} == 0xe;
}
$l->{start} = $hd->{primary}{extended}{start} = $start;
$l->{size} = $hd->{primary}{extended}{size} = $end - $start;
@@ -474,12 +475,12 @@ sub get_normal_parts_and_holes {
my @l = map {
my $current = $start;
$start = $_->{start} + $_->{size};
- my $hole = { start => $current, size => $_->{start} - $current, type => 0, rootDevice => $hd->{device} };
+ my $hole = { start => $current, size => $_->{start} - $current, pt_type => 0, rootDevice => $hd->{device} };
$hole, $_;
} sort { $a->{start} <=> $b->{start} } grep { !isWholedisk($_) } get_normal_parts($hd);
- push @l, { start => $start, size => $last - $start, type => 0, rootDevice => $hd->{device} };
- grep { $_->{type} || $_->{size} >= $hd->cylinder_size } @l;
+ push @l, { start => $start, size => $last - $start, pt_type => 0, rootDevice => $hd->{device} };
+ grep { $_->{pt_type} || $_->{size} >= $hd->cylinder_size } @l;
}
sub read_one($$) {
@@ -516,8 +517,8 @@ sub read_one($$) {
}
my @extended = $hd->hasExtended ? grep { isExtended($_) } @$pt : ();
- my @normal = grep { $_->{size} && $_->{type} && !isExtended($_) } @$pt;
- my $nb_special_empty = int(grep { $_->{size} && $_->{type} == 0 } @$pt);
+ my @normal = grep { $_->{size} && $_->{pt_type} && !isExtended($_) } @$pt;
+ my $nb_special_empty = int(grep { $_->{size} && $_->{pt_type} == 0 } @$pt);
@extended > 1 and die "more than one extended partition";
@@ -733,7 +734,7 @@ sub remove {
0;
}
-# create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
+# create of partition at starting at `start', of size `size' and of type `pt_type' (nice comment, uh?)
sub add_primary {
my ($hd, $part) = @_;
@@ -777,13 +778,13 @@ The only solution is to move your primary partitions to have the hole next to th
$l->{start} = round_down($l->{normal}{start} - 1, $hd->cylinder_size);
$l->{size} = $l->{normal}{start} + $l->{normal}{size} - $l->{start};
my $ext = { %$l };
- unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
+ unshift @{$hd->{extended}}, { pt_type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
#- size will be autocalculated :)
} else {
my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
($hd->{primary}, -1) : #- -1 size will be computed by adjust_main_extended
(top(@{$hd->{extended}}), $part->{size});
- my %ext = (type => $extended_type || 5, start => $part->{start}, size => $ext_size);
+ my %ext = (pt_type => $extended_type || 5, start => $part->{start}, size => $ext_size);
$hd->raw_add($ext->{raw}, \%ext);
$ext->{extended} = \%ext;
diff --git a/perl-install/partition_table/bsd.pm b/perl-install/partition_table/bsd.pm
index e6af4e997..cdf18e6d1 100644
--- a/perl-install/partition_table/bsd.pm
+++ b/perl-install/partition_table/bsd.pm
@@ -12,11 +12,11 @@ use partition_table;
use c;
#- very bad and rough handling :(
-my %typeToDos = (
+my %pt_typeToDos = (
8 => 0x83,
1 => 0x82,
);
-my %typeFromDos = reverse %typeToDos;
+my %pt_typeFromDos = reverse %pt_typeToDos;
my ($main_format, $main_fields) = list2kv(
I => 'magic',
@@ -52,7 +52,7 @@ my ($main_format, $main_fields) = list2kv(
);
$main_format = join '', @$main_format;
-my @fields = qw(size start fsize type frag cpg);
+my @fields = qw(size start fsize pt_type frag cpg);
my $format = "I I I C C S";
my $magic = 0x82564557;
my $nb_primary = 8;
@@ -73,7 +73,7 @@ sub read($$) {
my $size = psizeof($format);
my @pt = map {
my %h; @h{@fields} = unpack $format, $_;
- $h{type} = $typeToDos{$h{type}} || $h{type};
+ $h{pt_type} = $pt_typeToDos{$h{pt_type}} || $h{pt_type};
\%h;
} $info{partitions} =~ /(.{$size})/g;
@@ -85,7 +85,7 @@ sub read($$) {
}
# write the partition table (and extended ones)
-# for each entry, it uses fields: start, size, type, active
+# for each entry, it uses fields: start, size, pt_type, active
sub write($$$;$) {
my ($hd, $sector, $pt, $info) = @_;
@@ -105,7 +105,7 @@ sub write($$$;$) {
@$pt == $nb_primary or die "partition table does not have $nb_primary entries";
$info->{partitions} = join '', map {
- local $_->{type} = $typeFromDos{$_->{type}} || $_->{type};
+ local $_->{pt_type} = $pt_typeFromDos{$_->{pt_type}} || $_->{pt_type};
pack $format, @$_{@fields};
} @$pt;
diff --git a/perl-install/partition_table/dos.pm b/perl-install/partition_table/dos.pm
index 86f2c0256..38cdf60ed 100644
--- a/perl-install/partition_table/dos.pm
+++ b/perl-install/partition_table/dos.pm
@@ -11,7 +11,7 @@ use partition_table::raw;
use partition_table;
use c;
-my @fields = qw(active start_head start_sec start_cyl type end_head end_sec end_cyl start size);
+my @fields = qw(active start_head start_sec start_cyl pt_type end_head end_sec end_cyl start size);
my $format = "C8 V2";
my $magic = "\x55\xAA";
my $nb_primary = 4;
@@ -52,7 +52,7 @@ sub compute_CHS {
sub CHS_from_part_rawCHS {
my ($part) = @_;
- $part->{start} || $part->{type} or return;
+ $part->{start} || $part->{pt_type} or return;
my ($raw_chs_start, $raw_chs_end) = get_rawCHS($part);
rawCHS2CHS($raw_chs_start), rawCHS2CHS($raw_chs_end);
@@ -61,7 +61,7 @@ sub CHS_from_part_rawCHS {
sub CHS_from_part_linear {
my ($geom, $part) = @_;
- $part->{start} || $part->{type} or return;
+ $part->{start} || $part->{pt_type} or return;
sector2CHS($geom, $part->{start}), sector2CHS($geom, $part->{start} + $part->{size} - 1);
}
@@ -197,7 +197,7 @@ sub read {
}
# write the partition table (and extended ones)
-# for each entry, it uses fields: start, size, type, active
+# for each entry, it uses fields: start, size, pt_type, active
sub write($$$;$) {
my ($hd, $sector, $pt) = @_;
@@ -215,7 +215,7 @@ sub write($$$;$) {
foreach (@$pt) {
compute_CHS($hd, $_);
local $_->{start} = $_->{local_start} || 0;
- $_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; #- for no warning
+ $_->{active} ||= 0; $_->{pt_type} ||= 0; $_->{size} ||= 0; #- for no warning
syswrite $F, pack($format, @$_{@fields}), psizeof($format) or return 0;
}
syswrite $F, $magic, length $magic or return 0;
diff --git a/perl-install/partition_table/gpt.pm b/perl-install/partition_table/gpt.pm
index bb1cb82a4..2f1506bbd 100644
--- a/perl-install/partition_table/gpt.pm
+++ b/perl-install/partition_table/gpt.pm
@@ -130,8 +130,8 @@ sub read_partitionEntries {
sysread $F, $tmp, psizeof($partitionEntry_format) or die "error while reading partition table in sector $info->{partitionEntriesLBA}";
my %h; @h{@$partitionEntry_fields} = unpack $partitionEntry_format, $tmp;
$h{size} = $h{ending} - $h{start} + 1;
- $h{type} = $gpt_types_rev{$h{gpt_type}};
- $h{type} = 0x100 if !defined $h{type};
+ $h{pt_type} = $gpt_types_rev{$h{gpt_type}};
+ $h{pt_type} = 0x100 if !defined $h{pt_type};
\%h;
} (1 .. $info->{nbPartitions});
\@pt;
@@ -141,9 +141,9 @@ sub read {
my ($hd, $sector) = @_;
my $l = partition_table::dos::read($hd, $sector);
- my @l = grep { $_->{size} && $_->{type} && !partition_table::isExtended($_) } @$l;
+ my @l = grep { $_->{size} && $_->{pt_type} && !partition_table::isExtended($_) } @$l;
@l == 1 or die "bad PMBR";
- $l[0]{type} == 0xee or die "bad PMBR";
+ $l[0]{pt_type} == 0xee or die "bad PMBR";
my $myLBA = $l[0]{start};
my $F = partition_table::raw::openit($hd) or die "failed to open device";
@@ -159,14 +159,14 @@ sub read {
}
# write the partition table (and extended ones)
-# for each entry, it uses fields: start, size, type, active
+# for each entry, it uses fields: start, size, pt_type, active
sub write {
my ($hd, $sector, $pt, $info) = @_;
foreach (@$pt) {
$_->{ending} = $_->{start} + $_->{size} - 1;
$_->{guid} ||= generate_guid();
- $_->{gpt_type} = $gpt_types{$_->{type}} || $_->{gpt_type} || $gpt_types{0x83};
+ $_->{gpt_type} = $gpt_types{$_->{pt_type}} || $_->{gpt_type} || $gpt_types{0x83};
}
my $partitionEntries = join('', map {
pack($partitionEntry_format, @$_{@$partitionEntry_fields})
@@ -184,7 +184,7 @@ sub write {
{
# write the PMBR
my $pmbr = partition_table::dos::clear_raw();
- $pmbr->{raw}[0] = { type => 0xee, local_start => $info->{myLBA}, size => $info->{alternateLBA} - $info->{myLBA} + 1 };
+ $pmbr->{raw}[0] = { pt_type => 0xee, local_start => $info->{myLBA}, size => $info->{alternateLBA} - $info->{myLBA} + 1 };
partition_table::dos::write($hd, $sector, $pmbr->{raw});
}
@@ -210,7 +210,7 @@ sub write {
sub raw_removed {
my ($_hd, $raw) = @_;
- @$raw = grep { $_->{size} && $_->{type} } @$raw;
+ @$raw = grep { $_->{size} && $_->{pt_type} } @$raw;
}
sub can_raw_add {
my ($hd) = @_;
diff --git a/perl-install/partition_table/mac.pm b/perl-install/partition_table/mac.pm
index 2a8fe8df5..219b6434d 100644
--- a/perl-install/partition_table/mac.pm
+++ b/perl-install/partition_table/mac.pm
@@ -139,7 +139,7 @@ sub read($$) {
$h{start} = ($h{pPBlockStart} * $info{bzBlkSize}) / 512;
if ($h{pType} =~ /^Apple_UNIX_SVR2/i) {
- $h{pName} =~ /swap/i ? ($h{type} = 0x82) : ($h{type} = 0x83);
+ $h{pName} =~ /swap/i ? ($h{pt_type} = 0x82) : ($h{pt_type} = 0x83);
} elsif ($h{pType} =~ /^Apple_Free/i) {
#- need to locate a 1MB partition to setup a bootstrap on
if ($freepart && $freepart->{size} >= 1) {
@@ -148,10 +148,10 @@ sub read($$) {
$freepart = { start => $h{start}, size => $h{size}/2048, hd => $hd, part => "/dev/$hd->{device}" . ($i+1) };
log::l("free apple partition found on drive /dev/$freepart->{hd}{device}, block $freepart->{start}, size $freepart->{size}");
}
- $h{type} = 0x0;
+ $h{pt_type} = 0x0;
$h{pName} = 'Extra';
} elsif ($h{pType} =~ /^Apple_HFS/i) {
- $h{type} = 0x402;
+ $h{pt_type} = 0x402;
if (defined $macos_part) {
#- swag at identifying MacOS - 1st HFS partition
} else {
@@ -159,10 +159,10 @@ sub read($$) {
log::l("found MacOS at partition $macos_part");
}
} elsif ($h{pType} =~ /^Apple_Partition_Map/i) {
- $h{type} = 0x401;
+ $h{pt_type} = 0x401;
$h{isMap} = 1;
} elsif ($h{pType} =~ /^Apple_Bootstrap/i) {
- $h{type} = 0x401;
+ $h{pt_type} = 0x401;
$h{isBoot} = 1;
if (defined $bootstrap_part) {
#found a bootstrap already - use it, but log the find
@@ -172,7 +172,7 @@ sub read($$) {
log::l("found apple bootstrap at partition $bootstrap_part");
}
} else {
- $h{type} = 0x401;
+ $h{pt_type} = 0x401;
$h{isDriver} = 1;
};
@@ -218,7 +218,7 @@ sub write($$$;$) {
if ($last->{start} + $last->{size} < $part->{start}) {
#There is a gap between partitions. Fill it and move on.
push @partstowrite, {
- type => 0x0,
+ pt_type => 0x0,
start => $last->{start} + $last->{size},
size => $part->{start} - ($last->{start} + $last->{size}),
};
@@ -229,7 +229,7 @@ sub write($$$;$) {
# now, fill a gap at the end if there is one.
if ($last->{start} + $last->{size} < $hd->{totalsectors}) {
push @partstowrite, {
- type => 0x0,
+ pt_type => 0x0,
start => $last->{start} + $last->{size},
size => $hd->{totalsectors} - ($last->{start} + $last->{size}),
};
@@ -281,15 +281,15 @@ sub write($$$;$) {
$_->{pBootArgs} = "\0";
$_->{pReserved} = "\0";
- if ($_->{type} == 0x402) {
+ if ($_->{pt_type} == 0x402) {
$_->{pType} = "Apple_HFS";
$_->{pName} = "MacOS";
$_->{pFlags} = 0x4000037F;
- } elsif ($_->{type} == 0x401 && $_->{start} == 1) {
+ } elsif ($_->{pt_type} == 0x401 && $_->{start} == 1) {
$_->{pType} = "Apple_Partition_Map";
$_->{pName} = "Apple";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x401) {
+ } elsif ($_->{pt_type} == 0x401) {
$_->{pType} = "Apple_Bootstrap";
$_->{pName} = "bootstrap";
$_->{pFlags} = 0x33;
@@ -297,31 +297,31 @@ sub write($$$;$) {
log::l("writing a bootstrap at /dev/$_->{device}");
$install_steps_interactive::new_bootstrap = 1 if !(defined $partition_table::mac::bootstrap_part);
$bootstrap_part = "/dev/" . $_->{device};
- } elsif ($_->{type} == 0x82) {
+ } elsif ($_->{pt_type} == 0x82) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "swap";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x83) {
+ } elsif ($_->{pt_type} == 0x83) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "Linux Native";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x183) {
+ } elsif ($_->{pt_type} == 0x183) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "Linux ReiserFS";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x283) {
+ } elsif ($_->{pt_type} == 0x283) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "Linux XFS";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x383) {
+ } elsif ($_->{pt_type} == 0x383) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "Linux JFS";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x483) {
+ } elsif ($_->{pt_type} == 0x483) {
$_->{pType} = "Apple_UNIX_SVR2";
$_->{pName} = "Linux ext3";
$_->{pFlags} = 0x33;
- } elsif ($_->{type} == 0x0) {
+ } elsif ($_->{pt_type} == 0x0) {
$_->{pType} = "Apple_Free";
$_->{pName} = "Extra";
$_->{pFlags} = 0x31;
@@ -361,13 +361,13 @@ sub clear_raw {
#- handle special case for partition 1 which is the partition map.
$pt->{raw}[0] = {
- type => 0x401,
+ pt_type => 0x401,
start => 1,
size => 63,
isMap => 1,
};
# $pt->{raw}[1] = {
-# type => 0x0,
+# pt_type => 0x0,
# start => 64,
# size => $hd->{totalsectors} - 64,
# isMap => 0,
diff --git a/perl-install/partition_table/raw.pm b/perl-install/partition_table/raw.pm
index e01f9c1c3..8cbe0ec14 100644
--- a/perl-install/partition_table/raw.pm
+++ b/perl-install/partition_table/raw.pm
@@ -124,14 +124,14 @@ sub raw_removed {
}
sub can_raw_add {
my ($hd) = @_;
- $_->{size} || $_->{type} or return 1 foreach @{$hd->{primary}{raw}};
+ $_->{size} || $_->{pt_type} or return 1 foreach @{$hd->{primary}{raw}};
0;
}
sub raw_add {
my ($_hd, $raw, $part) = @_;
foreach (@$raw) {
- $_->{size} || $_->{type} and next;
+ $_->{size} || $_->{pt_type} and next;
$_ = $part;
return;
}
diff --git a/perl-install/partition_table/sun.pm b/perl-install/partition_table/sun.pm
index 951a4b471..7c8a6beb9 100644
--- a/perl-install/partition_table/sun.pm
+++ b/perl-install/partition_table/sun.pm
@@ -32,7 +32,7 @@ my ($main_format, $main_fields) = list2kv(
);
$main_format = join '', @$main_format;
-my ($fields1, $fields2) = ([ qw(type flags) ], [ qw(start_cylinder size) ]);
+my ($fields1, $fields2) = ([ qw(pt_type flags) ], [ qw(start_cylinder size) ]);
my ($format1, $format2) = ("xCxC", "N2");
my $magic = 0xDABE;
my $nb_primary = 8;
@@ -92,10 +92,10 @@ sub read($$) {
my @infos_up = unpack $format1 x $nb_primary, $info{infos};
my @partitions_up = unpack $format2 x $nb_primary, $info{partitions};
foreach (0..$nb_primary-1) {
- my $h = { type => $infos_up[2 * $_], flag => $infos_up[1 + 2 * $_],
+ my $h = { pt_type => $infos_up[2 * $_], flag => $infos_up[1 + 2 * $_],
start_cylinder => $partitions_up[2 * $_], size => $partitions_up[1 + 2 * $_] };
$h->{start} = $sector + $h->{start_cylinder} * $hd->cylinder_size;
- $h->{type} && $h->{size} or $h->{$_} = 0 foreach keys %$h;
+ $h->{pt_type} && $h->{size} or $h->{$_} = 0 foreach keys %$h;
push @pt, $h;
}
@@ -105,7 +105,7 @@ sub read($$) {
# @h{@$fields1} = unpack $format1, $_[0];
# @h{@$fields2} = unpack $format2, $_[1];
# $h{start} = $sector + $h{start_cylinder} * $hd->cylinder_size();
-# $h{type} && $h{size} or $h{$_} = 0 foreach keys %h;
+# $h{pt_type} && $h{size} or $h{$_} = 0 foreach keys %h;
# \%h;
# } [ grep { $_ } split /(.{$size1})/o, $info{infos} ], [ grep { $_ } split /(.{$size2})/o, $info{partitions} ];
@@ -113,7 +113,7 @@ sub read($$) {
}
# write the partition table (and extended ones)
-# for each entry, it uses fields: start, size, type, active
+# for each entry, it uses fields: start, size, pt_type, active
sub write($$$;$) {
my ($hd, $sector, $pt, $info) = @_;
# my ($csize, $wdsize) = (0, 0);
@@ -130,8 +130,8 @@ sub write($$$;$) {
($info->{infos}, $info->{partitions}) = map { join '', @$_ } list2kv map {
$_->{start} % $hd->cylinder_size == 0 or die "partition not at beginning of cylinder";
-# $csize += $_->{size} if $_->{type} != 5;
-# $wdsize += $_->{size} if $_->{type} == 5;
+# $csize += $_->{size} if $_->{pt_type} != 5;
+# $wdsize += $_->{size} if $_->{pt_type} == 5;
$_->{flags} |= 0x10 if $_->{mntpoint} eq '/';
$_->{flags} |= 0x01 if partition_table::isSwap($_);
local $_->{start_cylinder} = $_->{start} / $hd->cylinder_size - $sector;
@@ -188,7 +188,7 @@ sub clear_raw {
#- handle special case for partition 2 which is whole disk.
$pt->{raw}[2] = {
- type => 5, #- the whole disk type.
+ pt_type => 5, #- the whole disk type.
flags => 0,
start_cylinder => 0,
size => $hd->{geom}{cylinders} * $hd->cylinder_size,
diff --git a/perl-install/raid.pm b/perl-install/raid.pm
index 7237af929..8579c26ac 100644
--- a/perl-install/raid.pm
+++ b/perl-install/raid.pm
@@ -23,7 +23,7 @@ sub nb {
sub new {
my ($raids, @parts) = @_;
my $nb = @$raids;
- $raids->[$nb] = { 'chunk-size' => "64k", type => 0x483, disks => [ @parts ], device => "md$nb", notFormatted => 1, level => 1 };
+ $raids->[$nb] = { 'chunk-size' => "64k", pt_type => 0x483, disks => [ @parts ], device => "md$nb", notFormatted => 1, level => 1 };
foreach my $part (@parts) {
$part->{raid} = $nb;
delete $part->{mntpoint};
n> %ftp_files_info) { my ($lfile) = /\/([^\/]*)$/ or next; #- strange if we can't parse it correctly. my $ltime = Date::Manip::ParseDate(scalar gmtime((stat $1)[9])); $ltime =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour. -s $lfile == $ftp_files_info{$_}{size} && $ftp_files_info{$_}{time} eq $ltime or push @ftp_files, $_; } } } #- http files (and other files) are correctly managed by curl to conditionnal download. #- options for ftp files, -R (-O <file>)* #- options for http files, -R (-z file -O <file>)* if (my @all_files = ((map { ("-O", $_ ) } @ftp_files), (map { /\/([^\/]*)$/ ? ("-z", $1, "-O", $_) : () } @other_files))) { system "/usr/bin/curl", (ref $options && set_proxy({type => "curl", proxy => $options->{proxy}})), (ref $options && $options->{quiet} ? ("-s") : ()), "-R", "-f", @all_files; $? == 0 or die _("curl failed: exited with %d or signal %d\n", $? >> 8, $? & 127); } } sub sync_rsync { -x "/usr/bin/rsync" or die _("rsync is missing\n"); my $options = shift @_; foreach (@_) { my $count = 10; #- retry count on error (if file exists). my $basename = (/^.*\/([^\/]*)$/ && $1) || $_; do { /^rsync:\/\/(.*)/ or next; system "/usr/bin/rsync", (ref $options && $options->{quiet} ? qw(-q) : qw(--progress -v)), qw(--partial --no-whole-file), $1, (ref $options ? $options->{dir} : $options); } while ($? != 0 && --$count > 0 && (-e (ref $options ? $options->{dir} : $options) . "/$basename")); } $? == 0 or die _("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127); } sub sync_ssh { -x "/usr/bin/rsync" or die _("rsync is missing\n"); -x "/usr/bin/ssh" or die _("ssh is missing\n"); my $options = shift @_; foreach (@_) { my $count = 10; #- retry count on error (if file exists). my $basename = (/^.*\/([^\/]*)$/ && $1) || $_; do { system "/usr/bin/rsync", (ref $options && $options->{quiet} ? qw(-q) : qw(--progress -v)), qw(--partial -e ssh), $_, (ref $options ? $options->{dir} : $options); } while ($? != 0 && --$count > 0 && (-e (ref $options ? $options->{dir} : $options) . "/$basename")); } $? == 0 or die _("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127); } #- read /etc/urpmi/urpmi.cfg as config file, keep compability with older #- configuration file by examining if one entry is of the form #- <name> <url> { #- ... #- } #- else only this form is used #- <name> <url> #- <name> <ftp_url> with <relative_path_hdlist> sub read_config { my ($urpm, %options) = @_; #- keep in mind if it has been called before. $urpm->{media} and return; $urpm->{media} ||= []; #- check urpmi.cfg content, if the file is old keep track #- of old format used. local (*F, $_); open F, $urpm->{config}; #- no filename can be allowed on some case while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/ and do { #- urpmi.cfg format extention my $medium = { name => unquotespace($1), clear_url => unquotespace($2) }; while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /^hdlist\s*:\s*(.*)$/ and $medium->{hdlist} = $1, next; /^with_hdlist\s*:\s*(.*)$/ and $medium->{with_hdlist} = $1, next; /^list\s*:\s*(.*)$/ and $medium->{list} = $1, next; /^removable\s*:\s*(.*)$/ and $medium->{removable} = $1, next; /^update\s*$/ and $medium->{update} = 1, next; /^ignore\s*$/ and $medium->{ignore} = 1, next; /^synthesis\s*$/ and $medium->{synthesis} = 1, next; /^modified\s*$/ and next; # IGNORED TO AVOID EXCESIVE REMOVE $medium->{modified} = 1, next; $_ eq '}' and last; $_ and $urpm->{error}(_("syntax error in config file at line %s", $.)); } $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium; next; }; /^(.*?[^\\])\s+(.*?[^\\])\s+with\s+(.*)$/ and do { #- urpmi.cfg old format for ftp my $medium = { name => unquotespace($1), clear_url => unquotespace($2), with_hdlist => unquotespace($3) }; $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium; next; }; /^(.*?[^\\])\s+(?:(.*?[^\\])\s*)?$/ and do { #- urpmi.cfg old format (assume hdlist.<name>.cz2?) my $medium = { name => unquotespace($1), clear_url => unquotespace($2) }; $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium; next; }; $_ and $urpm->{error}(_("syntax error in config file at line %s", $.)); } close F; #- keep in mind when an hdlist/list file is used, really usefull for #- the next probe. my (%hdlists, %lists); foreach (@{$urpm->{media}}) { exists $hdlists{$_->{hdlist}} and $_->{ignore} = 1, $urpm->{error}(_("medium \"%s\" trying to use an already used hdlist, medium ignored", $_->{name})); $hdlists{$_->{hdlist}} = undef; if ($_->{list}) { exists $lists{$_->{list}} and $_->{ignore} = 1, $urpm->{error}(_("medium \"%s\" trying to use an already used list, medium ignored", $_->{name})); $lists{$_->{list}} = undef; } } #- urpmi.cfg if old is not enough to known the various media, track #- directly into /var/lib/urpmi, foreach (glob("$urpm->{statedir}/hdlist.*")) { if (/\/hdlist\.((.*)\.cz2?)$/) { #- check if it has already been detected above. exists $hdlists{"hdlist.$1"} and next; #- if not this is a new media to take care if #- there is a list file. if (-s "$urpm->{statedir}/list.$2") { if (exists $lists{"list.$2"}) { $urpm->{error}(_("unable to take care of medium \"%s\" as list file is already used by another medium", $2)); } else { my $medium; foreach (@{$urpm->{media}}) { $_->{name} eq $2 and $medium = $_, last; } $medium and $urpm->{error}(_("unable to use name \"%s\" for unnamed medium because it is already used", $2)), next; $medium = { name => $2, hdlist => "hdlist.$1", list => "list.$2" }; $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium; } } else { $urpm->{error}(_("unable to take medium \"%s\" into account as no list file [%s] exists", $2, "$urpm->{statedir}/list.$2")); } } else { $urpm->{error}(_("unable to determine medium of this hdlist file [%s]", $_)); } } #- check the presence of hdlist file and list file if necessary. unless ($options{nocheck_access}) { foreach (@{$urpm->{media}}) { $_->{ignore} and next; -r "$urpm->{statedir}/$_->{hdlist}" || -r "$urpm->{statedir}/synthesis.$_->{hdlist}" && $_->{synthesis} or $_->{ignore} = 1, $urpm->{error}(_("unable to access hdlist file of \"%s\", medium ignored", $_->{name})); $_->{list} && -r "$urpm->{statedir}/$_->{list}" || defined $_->{url} or $_->{ignore} = 1, $urpm->{error}(_("unable to access list file of \"%s\", medium ignored", $_->{name})); } } } #- probe medium to be used, take old medium into account too. sub probe_medium { my ($urpm, $medium, %options) = @_; local $_; my $existing_medium; foreach (@{$urpm->{media}}) { $_->{name} eq $medium->{name} and $existing_medium = $_, last; } $existing_medium and $urpm->{error}(_("trying to bypass existing medium \"%s\", avoiding", $medium->{name})), return; $medium->{url} ||= $medium->{clear_url}; unless ($medium->{ignore} || $medium->{hdlist}) { $medium->{hdlist} = "hdlist.$medium->{name}.cz"; -e "$urpm->{statedir}/$medium->{hdlist}" or $medium->{hdlist} = "hdlist.$medium->{name}.cz2"; -e "$urpm->{statedir}/$medium->{hdlist}" or $medium->{ignore} = 1, $urpm->{error}(_("unable to find hdlist file for \"%s\", medium ignored", $medium->{name})); } unless ($medium->{ignore} || $medium->{list}) { unless (defined $medium->{url}) { $medium->{list} = "list.$medium->{name}"; unless (-e "$urpm->{statedir}/$medium->{list}") { $medium->{ignore} = 1, $urpm->{error}(_("unable to find list file for \"%s\", medium ignored", $medium->{name})); } } } #- there is a little more to do at this point as url is not known, inspect directly list file for it. unless ($medium->{url}) { my %probe; if (-r "$urpm->{statedir}/$medium->{list}") { local *L; open L, "$urpm->{statedir}/$medium->{list}"; while (<L>) { #- /./ is end of url marker in list file (typically generated by a #- find . -name "*.rpm" > list #- for exportable list file. /^(.*)\/\.\// and $probe{$1} = undef; /^(.*)\/[^\/]*$/ and $probe{$1} = undef; } close L; } foreach (sort { length($a) <=> length($b) } keys %probe) { if ($medium->{url}) { $medium->{url} eq substr($_, 0, length($medium->{url})) or $medium->{ignore} || $urpm->{error}(_("incoherent list file for \"%s\", medium ignored", $medium->{name})), $medium->{ignore} = 1, last; } else { $medium->{url} = $_; } } unless ($options{nocheck_access}) { $medium->{url} or $medium->{ignore} || $urpm->{error}(_("unable to inspect list file for \"%s\", medium ignored", $medium->{name})), $medium->{ignore} = 1; #, last; keeping it cause perl to exit caller loop ... } } #- probe removable device. $urpm->probe_removable_device($medium); #- clear URLs for trailing /es. $medium->{url} and $medium->{url} =~ s|(.*?)/*$|$1|; $medium->{clear_url} and $medium->{clear_url} =~ s|(.*?)/*$|$1|; $medium; } #- probe device associated with a removable device. sub probe_removable_device { my ($urpm, $medium) = @_; if ($medium->{url} && $medium->{url} =~ /^removable_?([^_:]*)(?:_[^:]*)?:/) { $medium->{removable} ||= $1 && "/dev/$1"; } else { delete $medium->{removable}; } #- try to find device to open/close for removable medium. if (exists $medium->{removable}) { if (my ($dir) = $medium->{url} =~ /(?:file|removable)[^:]*:\/(.*)/) { my @mntpoints2devices = $urpm->find_mntpoints($dir, 'device'); if (@mntpoints2devices > 2) { #- return value is suitable for an hash. $urpm->{log}(_("too many mount points for removable medium \"%s\"", $medium->{name})); $urpm->{log}(_("taking removable device as \"%s\"", $mntpoints2devices[-1])); #- take the last one. } if (@mntpoints2devices) { if ($medium->{removable} && $medium->{removable} ne $mntpoints2devices[-1]) { $urpm->{log}(_("using different removable device [%s] for \"%s\"", $mntpoints2devices[-1], $medium->{name})); } $medium->{removable} = $mntpoints2devices[-1]; } else { $urpm->{error}(_("unable to retrieve pathname for removable medium \"%s\"", $medium->{name})); } } else { $urpm->{error}(_("unable to retrieve pathname for removable medium \"%s\"", $medium->{name})); } } } #- write back urpmi.cfg code to allow modification of medium listed. sub write_config { my ($urpm) = @_; #- avoid trashing exiting configuration in this case. $urpm->{media} or return; local *F; open F, ">$urpm->{config}" or $urpm->{fatal}(6, _("unable to write config file [%s]", $urpm->{config})); foreach my $medium (@{$urpm->{media}}) { printf F "%s %s {\n", quotespace($medium->{name}), quotespace($medium->{clear_url}); foreach (qw(hdlist with_hdlist list removable)) { $medium->{$_} and printf F " %s: %s\n", $_, $medium->{$_}; } foreach (qw(update ignore synthesis modified)) { $medium->{$_} and printf F " %s\n", $_; } printf F "}\n\n"; } close F; $urpm->{log}(_("write config file [%s]", $urpm->{config})); #- everything should be synced now. delete $urpm->{modified}; } #- read urpmi.cfg file as well as synthesis file needed. sub configure { my ($urpm, %options) = @_; $urpm->clean; if ($options{parallel}) { my ($parallel_options, $parallel_handler); #- handle parallel configuration, examine all module available that #- will handle the parallel mode (configuration is /etc/urpmi/parallel.cfg). local ($_, *PARALLEL); open PARALLEL, "/etc/urpmi/parallel.cfg"; while (<PARALLEL>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /\s*([^:]*):(.*)/ or $urpm->{error}(_("unable to parse \"%s\" in file [%s]", $_, "/etc/urpmi/parallel.cfg")), next; $1 eq $options{parallel} and $parallel_options = ($parallel_options && "\n") . $2; } close PARALLEL; #- if a configuration options has been found, use it else fatal error. if ($parallel_options) { foreach my $dir (grep { -d $_ } map { "$_/urpm" } @INC) { local *DIR; opendir DIR, $dir; while ($_ = readdir DIR) { -f "$dir/$_" or next; $urpm->{log}->(_("examining parallel handler in file [%s]", "$dir/$_")); eval { require "$dir/$_"; $parallel_handler = $urpm->handle_parallel_options($parallel_options) }; $parallel_handler and last; } closedir DIR; $parallel_handler and last; } } if ($parallel_handler) { if ($parallel_handler->{nodes}) { $urpm->{log}->(_("found parallel handler for nodes: %s", join(', ', keys %{$parallel_handler->{nodes}}))); } if (!$options{media} && $parallel_handler->{media}) { $options{media} = $parallel_handler->{media}; $urpm->{log}->(_("using associated media for parallel mode: %s", $options{media})); } $urpm->{parallel_handler} = $parallel_handler; } else { $urpm->{fatal}(1, _("unable to use parallel option \"%s\"", $options{parallel})); } } else { #- parallel is exclusive against root options. $urpm->{root} = $options{root}; } if ($options{synthesis}) { if ($options{synthesis} ne 'none') { #- synthesis take precedence over media, update options. $options{media} || $options{update} || $options{parallel} and $urpm->{fatal}(1, _("--synthesis cannot be used with --media, --update or --parallel")); $urpm->parse_synthesis($options{synthesis}); } } else { $urpm->read_config(%options); if ($options{media}) { $urpm->select_media(split ',', $options{media}); foreach (grep { !$_->{modified} } @{$urpm->{media} || []}) { #- this is only a local ignore that will not be saved. $_->{ignore} = 1; } } foreach (grep { !$_->{ignore} && (!$options{update} || $_->{update}) } @{$urpm->{media} || []}) { delete @{$_}{qw(start end)}; if ($options{callback}) { if ($options{hdlist} && -s "$urpm->{statedir}/$_->{hdlist}" > 32) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1, callback => $options{callback}) }; } else { $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$_->{hdlist}", callback => $options{callback}) }; unless (defined $_->{start} && defined $_->{end}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1, callback => $options{callback}) }; } } unless (defined $_->{start} && defined $_->{end}) { $urpm->{error}(_("problem reading hdlist file of medium \"%s\"", $_->{name})); $_->{ignore} = 1; } } else { if (-s "$urpm->{statedir}/synthesis.$_->{hdlist}" > 32) { $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$_->{hdlist}") }; } unless (defined $_->{start} && defined $_->{end}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1) }; unless (defined $_->{start} && defined $_->{end}) { $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $_->{name})); $_->{ignore} = 1; } } } } } if ($options{bug}) { #- and a dump of rpmdb itself as synthesis file. my $db = URPM::DB::open($options{root}); my $sig_handler = sub { undef $db; exit 3 }; local $SIG{INT} = $sig_handler; local $SIG{QUIT} = $sig_handler; local *RPMDB; $db or $urpm->{fatal}(_"unable to open rpmdb"); open RPMDB, "| " . ($ENV{LD_LOADER} || '') . " gzip -9 >'$options{bug}/rpmdb.cz'"; $db->traverse(sub{ my ($p) = @_; #- this is not right but may be enough. my $files = join '@', grep { exists $urpm->{provides}{$_} } $p->files; $p->pack_header; $p->build_info(fileno *RPMDB, $files); }); close RPMDB; } } #- add a new medium, sync the config file accordingly. sub add_medium { my ($urpm, $name, $url, $with_hdlist, %options) = @_; #- make sure configuration has been read. $urpm->{media} or $urpm->read_config(); #- if a medium with that name has already been found #- we have to exit now my ($medium); if (defined $options{index_name}) { my $i = $options{index_name}; do { ++$i; undef $medium; foreach (@{$urpm->{media}}) { $_->{name} eq $name.$i and $medium = $_; } } while ($medium); $name .= $i; } else { foreach (@{$urpm->{media}}) { $_->{name} eq $name and $medium = $_; } } $medium and $urpm->{fatal}(5, _("medium \"%s\" already exists", $medium->{name})); #- clear URLs for trailing /es. $url =~ s|(.*?)/*$|$1|; #- creating the medium info. $medium = { name => $name, url => $url, hdlist => "hdlist.$name.cz", list => "list.$name", update => $options{update}, modified => 1, }; #- check if a password is visible, if not set clear_url. $url =~ m|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)| or $medium->{clear_url} = $url; #- check to see if the medium is using file protocol or removable medium. $url =~ /^(removable[^:]*|file):\/(.*)/ and $urpm->probe_removable_device($medium); #- all flags once everything has been computed. $with_hdlist and $medium->{with_hdlist} = $with_hdlist; #- create an entry in media list. push @{$urpm->{media}}, $medium; #- keep in mind the database has been modified and base files need to be updated. #- this will be done automatically by transfering modified flag from medium to global. $urpm->{log}(_("added medium %s", $name)); } #- add distribution media, according to url given. sub add_distrib_media { my ($urpm, $name, $url, %options) = @_; my ($hdlists_file); #- make sure configuration has been read. $urpm->{media} or $urpm->read_config(); #- try to copy/retrive Mandrake/basehdlists file. if (my ($dir) = $url =~ /^(?:removable[^:]*|file):\/(.*)/) { $hdlists_file = reduce_pathname("$dir/Mandrake/base/hdlists"); $urpm->try_mounting($hdlists_file) or $urpm->{error}(_("unable to access first installation medium")), return; if (-e $hdlists_file) { unlink "$urpm->{cachedir}/partial/hdlists"; $urpm->{log}(_("copying hdlists file...")); system("cp", "-pR", $hdlists_file, "$urpm->{cachedir}/partial/hdlists") ? $urpm->{log}(_("...copying failed")) : $urpm->{log}(_("...copying done")); } else { $urpm->{error}(_("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return; } } else { #- try to get the description if it has been found. unlink "$urpm->{cachedir}/partial/hdlists"; eval { $urpm->{log}(_("retrieving hdlists file...")); $urpm->{sync}({dir => "$urpm->{cachedir}/partial", quiet => 0, proxy => $urpm->{proxy}}, reduce_pathname("$url/Mandrake/base/hdlists")); $urpm->{log}(_("...retrieving done")); }; $@ and $urpm->{log}(_("...retrieving failed: %s", $@)); if (-e "$urpm->{cachedir}/partial/hdlists") { $hdlists_file = "$urpm->{cachedir}/partial/hdlists"; } else { $urpm->{error}(_("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return; } } #- cosmetic update of name if it contains blank char. $name =~ /\s/ and $name .= ' '; #- at this point, we have found an hdlists file, so parse it #- and create all necessary medium according to it. local *HDLISTS; if (open HDLISTS, $hdlists_file) { my $medium = 1; foreach (<HDLISTS>) { chomp; s/\s*#.*$//; /^\s*$/ and next; m/^\s*(?:noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or $urpm->{error}(_("invalid hdlist description \"%s\" in hdlists file"), $_); my ($hdlist, $rpmsdir, $descr) = ($1, $2, $3); $urpm->add_medium($name ? "$descr ($name$medium)" : $descr, "$url/$rpmsdir", "../base/$hdlist", %options); ++$medium; } close HDLISTS; } else { $urpm->{error}(_("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return; } } sub select_media { my $urpm = shift; my %media; @media{@_} = undef; foreach (@{$urpm->{media}}) { if (exists $media{$_->{name}}) { $media{$_->{name}} = 1; #- keep it mind this one has been selected. #- select medium by setting modified flags, do not check ignore. $_->{modified} = 1; } } #- check if some arguments does not correspond to medium name. #- in such case, try to find the unique medium (or list candidate #- media found). foreach (keys %media) { unless ($media{$_}) { my $q = quotemeta; my (@found, @foundi); foreach my $medium (@{$urpm->{media}}) { $medium->{name} =~ /$q/ and push @found, $medium; $medium->{name} =~ /$q/i and push @foundi, $medium; } if (@found == 1) { $found[0]{modified} = 1; } elsif (@foundi == 1) { $foundi[0]{modified} = 1; } elsif (@found == 0 && @foundi == 0) { $urpm->{error}(_("trying to select inexistent medium \"%s\"", $_)); } else { #- multiple element in found or foundi list. $urpm->{log}(_("selecting multiple media: %s", join(", ", map { _("\"%s\"", $_->{name}) } (@found ? @found : @foundi)))); #- changed behaviour to select all occurence by default. foreach (@found ? @found : @foundi) { $_->{modified} = 1; } } } } } sub remove_selected_media { my ($urpm) = @_; my @result; foreach (@{$urpm->{media}}) { if ($_->{modified}) { $urpm->{log}(_("removing medium \"%s\"", $_->{name})); #- mark to re-write configuration. $urpm->{modified} = 1; #- remove file associated with this medium. foreach ($_->{hdlist}, $_->{list}, "synthesis.$_->{hdlist}", "descriptions.$_->{name}", "$_->{name}.cache") { $_ and unlink "$urpm->{statedir}/$_"; } } else { push @result, $_; #- not removed so keep it } } #- restore newer media list. $urpm->{media} = \@result; } #- update urpmi database regarding the current configuration. #- take care of modification and try some trick to bypass #- computational of base files. #- allow options : #- all -> all medium are rebuilded. #- force -> try to force rebuilding base files (1) or hdlist from rpm files (2). #- probe_with_hdlist -> probe synthesis or hdlist. #- ratio -> use compression ratio (with gzip, default is 4) #- noclean -> keep header directory cleaned. sub update_media { my ($urpm, %options) = @_; #- do not trust existing hdlist and try to recompute them. my ($cleaned_cache); #- take care of some options. $cleaned_cache = !$options{noclean}; #- avoid trashing existing configuration in this case. $urpm->{media} or return; #- now we need additional methods not defined by default in URPM. require URPM::Build; #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base). my ($LOCK_EX, $LOCK_NB, $LOCK_UN) = (2, 4, 8); #- lock urpmi database. local (*LOCK_FILE); open LOCK_FILE, $urpm->{statedir}; flock LOCK_FILE, $LOCK_EX|$LOCK_NB or $urpm->{fatal}(7, _("urpmi database locked")); #- examine each medium to see if one of them need to be updated. #- if this is the case and if not forced, try to use a pre-calculated #- hdlist file else build it from rpm files. $urpm->clean; foreach my $medium (@{$urpm->{media}}) { #- take care of modified medium only or all if all have to be recomputed. $medium->{ignore} and next; #- and create synthesis file associated if it does not already exists... -s "$urpm->{statedir}/synthesis.$medium->{hdlist}" > 32 or $medium->{modified_synthesis} = 1; #- but do not take care of removable media for all. $medium->{modified} ||= $options{all} && $medium->{url} !~ /removable/; unless ($medium->{modified}) { #- the medium is not modified, but for computing dependencies, #- we still need to read it and all synthesis will be written if #- a unresolved provides is found. #- to speed up the process, we only read the synthesis at the begining. $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1) }; unless (defined $medium->{start} && defined $medium->{end}) { #- this is almost a fatal error, ignore it by default? $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name})); $medium->{ignore} = 1; } } next; } #- list of rpm files for this medium, only available for local medium where #- the source hdlist is not used (use force). my ($prefix, $dir, $error, @files); #- always delete a remaining list file in cache. unlink "$urpm->{cachedir}/partial/list"; #- check to see if the medium is using file protocol or removable medium. if (($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) { #- try to figure a possible hdlist_path (or parent directory of searched directory. #- this is used to probe possible hdlist file. my $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/..")); #- the directory given does not exist and may be accessible #- by mounting some other. try to figure out these directory and #- mount everything necessary. $urpm->try_mounting($options{force} < 2 && ($options{probe_with_hdlist} || $medium->{with_hdlist}) ? $with_hdlist_dir : $dir) or $urpm->{error}(_("unable to access medium \"%s\"", $medium->{name})), next; #- try to probe for possible with_hdlist parameter, unless #- it is already defined (and valid). if ($options{probe_with_hdlist} && (!$medium->{with_hdlist} || ! -e "$dir/$medium->{with_hdlist}")) { my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/; if (-s "$dir/synthesis.hdlist.cz" > 32) { $medium->{with_hdlist} = "./synthesis.hdlist.cz"; } elsif (-s "$dir/synthesis.hdlist$suffix.cz" > 32) { $medium->{with_hdlist} = "./synthesis.hdlist$suffix.cz"; } elsif (defined $suffix && !$suffix && -s "$dir/synthesis.hdlist1.cz" > 32) { $medium->{with_hdlist} = "./synthesis.hdlist1.cz"; } elsif (defined $suffix && !$suffix && -s "$dir/synthesis.hdlist2.cz" > 32) { $medium->{with_hdlist} = "./synthesis.hdlist2.cz"; } elsif (-s "$dir/../synthesis.hdlist$suffix.cz" > 32) { $medium->{with_hdlist} = "../synthesis.hdlist$suffix.cz"; } elsif (defined $suffix && !$suffix && -s "$dir/../synthesis.hdlist1.cz" > 32) { $medium->{with_hdlist} = "../synthesis.hdlist1.cz"; } elsif (-s "$dir/../base/hdlist$suffix.cz" > 32) { $medium->{with_hdlist} = "../base/hdlist$suffix.cz"; } elsif (defined $suffix && !$suffix && -s "$dir/../base/hdlist1.cz" > 32) { $medium->{with_hdlist} = "../base/hdlist1.cz"; } #- redo... $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/..")); } #- try to get the description if it has been found. unlink "$urpm->{statedir}/descriptions.$medium->{name}"; if (-e "$dir/../descriptions") { $urpm->{log}(_("copying description file of \"%s\"...", $medium->{name})); system("cp", "-pR", "$dir/../descriptions", "$urpm->{statedir}/descriptions.$medium->{name}") ? $urpm->{log}(_("...copying failed")) : $urpm->{log}(_("...copying done")); } #- if the source hdlist is present and we are not forcing using rpms file if ($options{force} < 2 && $medium->{with_hdlist} && -e $with_hdlist_dir) { unlink "$urpm->{cachedir}/partial/$medium->{hdlist}"; $urpm->{log}(_("copying source hdlist (or synthesis) of \"%s\"...", $medium->{name})); system("cp", "-pR", "$with_hdlist_dir", "$urpm->{cachedir}/partial/$medium->{hdlist}") ? $urpm->{log}(_("...copying failed")) : $urpm->{log}(_("...copying done")); -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32 or $error = 1, $urpm->{error}(_("copy of [%s] failed", "$with_hdlist_dir")); #- examine if a local MD5SUM file is available. if (!$options{force} && -s reduce_pathname("$dir/$with_hdlist_dir/../MD5SUM")) { my ($basename) = $with_hdlist_dir =~ /^.*\/([^\/]+)$/; $urpm->{log}(_("examining MD5SUM file")); local (*F, $_); open F, reduce_pathname("$dir/$with_hdlist_dir/../MD5SUM"); while (<F>) { my ($md5sum, $file) = /(\S+)\s+(\S+)/ or next; if ($file eq $basename) { $options{force} ||= (split ' ', `md5sum '$urpm->{cachedir}/partial/$medium->{hdlist}'`)[0] ne $md5sum; last; } } close F; } #- check if the file are equals... and no force copy... unless ($error || $options{force} || ! -e "$urpm->{statedir}/synthesis.$medium->{hdlist}") { my @sstat = stat "$urpm->{cachedir}/partial/$medium->{hdlist}"; my @lstat = stat "$urpm->{statedir}/$medium->{hdlist}"; if ($sstat[7] == $lstat[7] && $sstat[9] == $lstat[9]) { #- the two files are considered equal here, the medium is so not modified. $medium->{modified} = 0; unlink "$urpm->{cachedir}/partial/$medium->{hdlist}"; #- as previously done, just read synthesis file here, this is enough, but only #- if synthesis exists, else it need to be recomputed. $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1) }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name})); $medium->{ignore} = 1; } } next; } } #- examine if a local list file is available (always probed according to with_hdlist #- and check hdlist has not be named very strangely... if ($medium->{hdlist} ne 'list') { my $local_list = $medium->{with_hdlist} =~ /hd(list.*)\.cz$/ ? $1 : 'list'; if (-s "$dir/$local_list") { $urpm->{log}(_("copying source list of \"%s\"...", $medium->{name})); system("cp", "-pR", "$dir/$local_list", "$urpm->{cachedir}/partial/list") ? $urpm->{log}(_("...copying failed")) : $urpm->{log}(_("...copying done")); } } } else { #- try to find rpm files, use recursive method, added additional #- / after dir to make sure it will be taken into account if this #- is a symlink to a directory. #- make sure rpm filename format is correct and is not a source rpm #- which are not well managed by urpmi. @files = split "\n", `find '$dir/' -name "*.rpm" -print`; #- check files contains something good! if (@files > 0) { #- we need to rebuild from rpm files the hdlist. eval { $urpm->{log}(_("reading rpm files from [%s]", $dir)); my @unresolved_before = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}}; $medium->{start} = @{$urpm->{depslist}}; $medium->{headers} = [ $urpm->parse_rpms_build_headers(dir => "$urpm->{cachedir}/headers", rpms => \@files, clean => $cleaned_cache, ) ]; $medium->{end} = $#{$urpm->{depslist}}; if ($medium->{start} > $medium->{end}) { #- an error occured (provided there are files in input. delete $medium->{start}; delete $medium->{end}; die "no rpms read\n"; } else { $cleaned_cache = 0; #- make sure the headers will not be removed for another media. my @unresolved_after = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}}; @unresolved_before == @unresolved_after or $urpm->{second_pass} = 1; } }; $@ and $error = 1, $urpm->{error}(_("unable to read rpm files from [%s]: %s", $dir, $@)); $error and delete $medium->{headers}; #- do not propagate these. $error or delete $medium->{synthesis}; #- when building hdlist by ourself, drop synthesis property. } else { $error = 1; $urpm->{error}(_("no rpm files found from [%s]", $dir)); } } } else { my $basename; #- try to get the description if it has been found. unlink "$urpm->{cachedir}/partial/descriptions"; if (-e "$urpm->{statedir}/descriptions.$medium->{name}") { rename("$urpm->{statedir}/descriptions.$medium->{name}", "$urpm->{cachedir}/partial/descriptions") or system("mv", "$urpm->{statedir}/descriptions.$medium->{name}", "$urpm->{cachedir}/partial/descriptions"); } eval { $urpm->{log}(_("retrieving description file of \"%s\"...", $medium->{name})); $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy} }, reduce_pathname("$medium->{url}/../descriptions")); $urpm->{log}(_("...retrieving done")); }; if (-e "$urpm->{cachedir}/partial/descriptions") { rename("$urpm->{cachedir}/partial/descriptions", "$urpm->{statedir}/descriptions.$medium->{name}") or system("mv", "$urpm->{cachedir}/partial/descriptions", "$urpm->{statedir}/descriptions.$medium->{name}"); } #- try to probe for possible with_hdlist parameter, unless #- it is already defined (and valid). $urpm->{log}(_("retrieving source hdlist (or synthesis) of \"%s\"...", $medium->{name})); if ($options{probe_with_hdlist}) { my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/; foreach ($medium->{with_hdlist} ? ($medium->{with_hdlist}) : (), "synthesis.hdlist.cz", "synthesis.hdlist$suffix.cz", !$suffix ? ("synthesis.hdlist1.cz", "synthesis.hdlist2.cz") : (), "../synthesis.hdlist$suffix.cz", !$suffix ? ("../synthesis.hdlist1.cz") : (), "../base/hdlist$suffix.cz", !$suffix ? ("../base/hdlist1.cz") : (), ) { $basename = (/^.*\/([^\/]*)$/ && $1) || $_ or next; unlink "$urpm->{cachedir}/partial/$basename"; eval { $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy} }, reduce_pathname("$medium->{url}/$_")); }; if (!$@ && -s "$urpm->{cachedir}/partial/$basename" > 32) { $medium->{with_hdlist} = $_; $urpm->{log}(_("found probed hdlist (or synthesis) as %s", $basename)); last; #- found a suitable with_hdlist in the list above. } } } else { $basename = ($medium->{with_hdlist} =~ /^.*\/([^\/]*)$/ && $1) || $medium->{with_hdlist}; #- try to sync (copy if needed) local copy after restored the previous one. unlink "$urpm->{cachedir}/partial/$basename"; if ($medium->{synthesis}) { $options{force} || ! -e "$urpm->{statedir}/synthesis.$medium->{hdlist}" or system("cp", "-pR", "$urpm->{statedir}/synthesis.$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename"); } else { $options{force} || ! -e "$urpm->{statedir}/$medium->{hdlist}" or system("cp", "-pR", "$urpm->{statedir}/$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename"); } eval { $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 0, proxy => $urpm->{proxy}}, reduce_pathname("$medium->{url}/$medium->{with_hdlist}")); }; if ($@) { $urpm->{log}(_("...retrieving failed: %s", $@)); unlink "$urpm->{cachedir}/partial/$basename"; } } if (-s "$urpm->{cachedir}/partial/$basename" > 32) { $urpm->{log}(_("...retrieving done")); unless ($options{force}) { #- examine if a distant MD5SUM file is available. unlink "$urpm->{cachedir}/partial/MD5SUM"; eval { $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy} }, reduce_pathname("$medium->{url}/$medium->{with_hdlist}/../MD5SUM")); }; if (!$@ && -s "$urpm->{cachedir}/partial/MD5SUM" > 32) { $urpm->{log}(_("examining MD5SUM file")); local (*F, $_); open F, "$urpm->{cachedir}/partial/MD5SUM"; while (<F>) { my ($md5sum, $file) = /(\S+)\s+(\S+)/ or next; if ($file eq $basename) { $options{force} ||= (split ' ', `md5sum '$urpm->{cachedir}/partial/$basename'`)[0] ne $md5sum; last; } } close F; } unless ($options{force}) { my @sstat = stat "$urpm->{cachedir}/partial/$basename"; my @lstat = stat "$urpm->{statedir}/$medium->{hdlist}"; if ($sstat[7] == $lstat[7] && $sstat[9] == $lstat[9]) { #- the two files are considered equal here, the medium is so not modified. $medium->{modified} = 0; unlink "$urpm->{cachedir}/partial/$basename"; #- as previously done, just read synthesis file here, this is enough. $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}")); eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}", packing => 1) }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name})); $medium->{ignore} = 1; } } next; } } } #- the file are different, update local copy. rename("$urpm->{cachedir}/partial/$basename", "$urpm->{cachedir}/partial/$medium->{hdlist}"); #- retrieve of hdlist (or synthesis has been successfull, check if a list file is available. #- and check hdlist has not be named very strangely... if ($medium->{hdlist} ne 'list') { my $local_list = $medium->{with_hdlist} =~ /hd(list.*)\.cz$/ ? $1 : 'list'; eval { $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy}}, reduce_pathname("$medium->{url}/$local_list")); $local_list ne 'list' and rename("$urpm->{cachedir}/partial/$local_list", "$urpm->{cachedir}/partial/list"); }; $@ and unlink "$urpm->{cachedir}/partial/list"; } } else { $error = 1; $urpm->{error}(_("retrieve of source hdlist (or synthesis) failed")); } } #- build list file according to hdlist used. unless ($medium->{headers} || -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32) { $error = 1; $urpm->{error}(_("no hdlist file found for medium \"%s\"", $medium->{name})); } #- make sure group and other does not have any access to this file. unless ($error) { #- sort list file contents according to id. my %list; if ($medium->{headers}) { #- rpm files have already been read (first pass), there is just a need to #- build list hash. foreach (@files) { /\/([^\/]*\.rpm)$/ or next; $list{$1} and $urpm->{error}(_("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next; $list{$1} = "$prefix:/$_\n"; } } else { #- read first pass hdlist or synthesis, try to open as synthesis, if file #- is larger than 1MB, this is problably an hdlist else a synthesis. #- anyway, if one tries fails, try another mode. my @unresolved_before = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}}; if (!$medium->{synthesis} || -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 262144) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1) }; if (defined $medium->{start} && defined $medium->{end}) { delete $medium->{synthesis}; } else { $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}") }; defined $medium->{start} && defined $medium->{end} and $medium->{synthesis} = 1; } } else { $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}") }; if (defined $medium->{start} && defined $medium->{end}) { $medium->{synthesis} = 1; } else { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1) }; defined $medium->{start} && defined $medium->{end} and delete $medium->{synthesis}; } } unless (defined $medium->{start} && defined $medium->{end}) { $error = 1; $urpm->{error}(_("unable to parse hdlist file of \"%s\"", $medium->{name})); #- we will have to read back the current synthesis file unmodified. } unless ($error) { my @unresolved_after = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}}; @unresolved_before == @unresolved_after or $urpm->{second_pass} = 1; if ($medium->{hdlist} ne 'list' && -s "$urpm->{cachedir}/partial/list") { local (*F, $_); open F, "$urpm->{cachedir}/partial/list"; while (<F>) { /\/([^\/]*\.rpm)$/ or next; $list{$1} and $urpm->{error}(_("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next; $list{$1} = "$medium->{url}/$_"; } close F; } else { #- if url is clear and no relative list file has been downloaded, #- there is no need for a list file. if ($medium->{url} ne $medium->{clear_url}) { foreach ($medium->{start} .. $medium->{end}) { my $filename = $urpm->{depslist}[$_]->filename; $list{$filename} = "$medium->{url}/$filename\n"; } } } } } unless ($error) { if (%list) { #- write list file. local *LIST; my $mask = umask 077; open LIST, ">$urpm->{cachedir}/partial/$medium->{list}" or $error = 1, $urpm->{error}(_("unable to write list file of \"%s\"", $medium->{name})); umask $mask; print LIST values %list; close LIST; #- check if at least something has been written into list file. if (-s "$urpm->{cachedir}/partial/$medium->{list}") { $urpm->{log}(_("writing list file for medium \"%s\"", $medium->{name})); } else { $error = 1, $urpm->{error}(_("nothing written in list file for \"%s\"", $medium->{name})); } } else { #- the flag is no more necessary. delete $medium->{list}; unlink "$urpm->{statedir}/$medium->{list}"; } } } if ($error) { #- an error has occured for updating the medium, we have to remove tempory files. unlink "$urpm->{cachedir}/partial/$medium->{hdlist}"; $medium->{list} and unlink "$urpm->{cachedir}/partial/$medium->{list}"; #- read default synthesis (we have to make sure nothing get out of depslist). $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")); eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") }; unless (defined $medium->{start} && defined $medium->{end}) { $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name})); $medium->{ignore} = 1; } } else { #- make sure to rebuild base files and clean medium modified state. $medium->{modified} = 0; $urpm->{modified} = 1; #- but use newly created file. unlink "$urpm->{statedir}/$medium->{hdlist}"; $medium->{synthesis} and unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}"; $medium->{list} and unlink "$urpm->{statedir}/$medium->{list}"; unless ($medium->{headers}) { rename("$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ? "$urpm->{statedir}/synthesis.$medium->{hdlist}" : "$urpm->{statedir}/$medium->{hdlist}") or system("mv", "$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ? "$urpm->{statedir}/synthesis.$medium->{hdlist}" : "$urpm->{statedir}/$medium->{hdlist}"); } if ($medium->{list}) { rename("$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}") or system("mv", "$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}"); } #- and create synthesis file associated. $medium->{modified_synthesis} = !$medium->{synthesis}; } } #- some unresolved provides may force to rebuild all synthesis, #- a second pass will be necessary. if ($urpm->{second_pass}) { $urpm->{log}(_("performing second pass to compute dependencies\n")); $urpm->unresolved_provides_clean; } #- second pass consist of reading again synthesis or hdlist. foreach my $medium (@{$urpm->{media}}) { #- take care of modified medium only or all if all have to be recomputed. $medium->{ignore} and next; #- a modified medium is an invalid medium, we have to read back the previous hdlist #- or synthesis which has not been modified by first pass above. if ($medium->{headers} && !$medium->{modified}) { if ($urpm->{second_pass}) { $urpm->{log}(_("reading headers from medium \"%s\"", $medium->{name})); ($medium->{start}, $medium->{end}) = $urpm->parse_headers(dir => "$urpm->{cachedir}/headers", headers => $medium->{headers}, ); } $urpm->{log}(_("building hdlist [%s]", "$urpm->{statedir}/$medium->{hdlist}")); #- finish building operation of hdlist. $urpm->build_hdlist(start => $medium->{start}, end => $medium->{end}, dir => "$urpm->{cachedir}/headers", hdlist => "$urpm->{statedir}/$medium->{hdlist}", ); #- synthesis need to be created for sure, since the medium has been built from rpm files. $urpm->build_synthesis(start => $medium->{start}, end => $medium->{end}, synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}", ); $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name})); #- keep in mind we have modified database, sure at this point. $urpm->{modified} = 1; } elsif ($medium->{synthesis}) { if ($urpm->{second_pass}) { $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")); ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}"); } } else { if ($urpm->{second_pass}) { $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}")); ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", 1); } #- check if synthesis file can be built. if (($urpm->{second_pass} || $medium->{modified_synthesis}) && !$medium->{modified}) { $urpm->build_synthesis(start => $medium->{start}, end => $medium->{end}, synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}", ); $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name})); #- keep in mind we have modified database, sure at this point. $urpm->{modified} = 1; } } } #- clean headers cache directory to remove everything that is no more #- usefull according to depslist used. if ($urpm->{modified}) { if ($options{noclean}) { local (*D, $_); my %headers; opendir D, "$urpm->{cachedir}/headers"; while (defined($_ = readdir D)) { /^([^\/]*-[^-]*-[^-]*\.[^\.]*)(?::\S*)?$/ and $headers{$1} = $_; } closedir D; $urpm->{log}(_("found %d headers in cache", scalar(keys %headers))); foreach (@{$urpm->{depslist}}) { delete $headers{$_->fullname}; } $urpm->{log}(_("removing %d obsolete headers in cache", scalar(keys %headers))); foreach (values %headers) { unlink "$urpm->{cachedir}/headers/$_"; } } #- this file is written in any cases. $urpm->write_config(); } #- now everything is finished. system("sync"); #- release lock on database. flock LOCK_FILE, $LOCK_UN; close LOCK_FILE; } #- clean params and depslist computation zone. sub clean { my ($urpm) = @_; $urpm->{depslist} = []; $urpm->{provides} = {}; foreach (@{$urpm->{media} || []}) { delete $_->{start}; delete $_->{end}; } } #- check if supermount is used. sub is_using_supermount { my ($urpm, $device_mntpoint) = @_; local (*F, $_); #- read /etc/fstab and check for existing mount point. open F, "/etc/fstab"; while (<F>) { my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next; $mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,; if ($fstype eq 'supermount') { $device_mntpoint eq $mntpoint and return 1; $options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ && $device_mntpoint eq $1 and return 1; } } return 0; } #- find used mount point from a pathname, use a optional mode to allow #- filtering according the next operation (mount or umount). sub find_mntpoints { my ($urpm, $dir, $mode) = @_; #- fast mode to check according to next operation. $mode eq 'mount' && -e $dir and return; $mode eq 'umount' && ! -e $dir and return; #- really check and find mount points here. my ($fdir, $pdir, $v, %fstab, @mntpoints) = $dir; local (*F, $_); #- read /etc/fstab and check for existing mount point. open F, "/etc/fstab"; while (<F>) { my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next; $mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,; $fstab{$mntpoint} = 0; if ($mode eq 'device') { if ($fstype eq 'supermount') { $options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ and $fstab{$mntpoint} = $1; } elsif ($device eq 'none') { next; } else { $fstab{$mntpoint} = $device; } } } open F, "/etc/mtab"; while (<F>) { my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next; $mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,; $fstab{$mntpoint} = 1; if ($mode eq 'device') { if ($fstype eq 'supermount') { $options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ and $fstab{$mntpoint} = $1; } elsif ($device eq 'none') { next; } else { $fstab{$mntpoint} = $device; } } } close F; #- try to follow symlink, too complex symlink graph may not #- be seen. while ($v = readlink $fdir) { if ($fdir =~ /^\//) { $fdir = $v; } else { while ($v =~ /^\.\.\/(.*)/) { $v = $1; $fdir =~ s/^(.*)\/[^\/]+\/*/$1/; } $fdir .= "/$v"; } } #- check the possible mount point. foreach (split '/', $fdir) { length($_) or next; $pdir .= "/$_"; $pdir =~ s,/+,/,g; $pdir =~ s,/$,,; if (exists $fstab{$pdir}) { $mode eq 'mount' && ! $fstab{$pdir} and push @mntpoints, $pdir; $mode eq 'umount' && $fstab{$pdir} and unshift @mntpoints, $pdir; $mode eq 'device' and push @mntpoints, $pdir, $fstab{$pdir}; } } @mntpoints; } #- reduce pathname by removing <something>/.. each time it appears (or . too). sub reduce_pathname { my ($url) = @_; #- take care if this is a true url and not a simple pathname. my ($host, $dir) = $url =~ /([^:\/]*:\/\/[^\/]*\/)?(.*)/; #- remove any multiple /s or trailing /. #- then split all components of pathname. $dir =~ s/\/+/\//g; $dir =~ s/\/$//; my @paths = split '/', $dir; #- reset $dir, recompose it, and clean trailing / added by algorithm. $dir = ''; foreach (@paths) { if ($_ eq '..') { $dir =~ s/([^\/]+)\/$// or $dir .= "../"; } elsif ($_ ne '.') { $dir .= "$_/"; } } $dir =~ s/\/$//; $host . $dir; } #- check for necessity of mounting some directory to get access sub try_mounting { my ($urpm, $dir, $removable) = @_; $dir = reduce_pathname($dir); foreach ($urpm->find_mntpoints($dir, 'mount')) { $urpm->{log}(_("mounting %s", $_)); `mount '$_' 2>/dev/null`; $removable and $urpm->{removable_mounted}{$_} = undef; } -e $dir; } sub try_umounting { my ($urpm, $dir) = @_; $dir = reduce_pathname($dir); foreach ($urpm->find_mntpoints($dir, 'umount')) { $urpm->{log}(_("unmounting %s", $_)); `umount '$_' 2>/dev/null`; delete $urpm->{removable_mounted}{$_}; } ! -e $dir; } sub try_umounting_removables { my ($urpm) = @_; foreach (keys %{$urpm->{removable_mounted}}) { $urpm->try_umounting($_); } delete $urpm->{removable_mounted}; } #- relocate depslist array id to use only the most recent packages, #- reorder info hashes to give only access to best packages. sub relocate_depslist_provides { my ($urpm, %options) = @_; my $relocated_entries = $urpm->relocate_depslist; $urpm->{log}($relocated_entries ? _("relocated %s entries in depslist", $relocated_entries) : _("no entries relocated in depslist")); $relocated_entries; } #- register local packages for being installed, keep track of source. sub register_rpms { my ($urpm, @files) = @_; my ($start, $id, $error, %requested); #- examine each rpm and build the depslist for them using current #- depslist and provides environment. $start = @{$urpm->{depslist}}; foreach (@files) { /\.rpm$/ or $error = 1, $urpm->{error}(_("invalid rpm file name [%s]", $_)), next; #- allow url to be given. if (my ($basename) = /^[^:]*:\/.*\/([^\/]*\.rpm)$/) { unlink "$urpm->{cachedir}/partial/$basename"; eval { $urpm->{log}(_("retrieving rpm file [%s] ...", $_)); $urpm->{sync}({dir => "$urpm->{cachedir}/partial", quiet => 0, proxy => $urpm->{proxy}}, $_); $urpm->{log}(_("...retrieving done")); $_ = "$urpm->{cachedir}/partial/$basename"; }; $@ and $urpm->{log}(_("...retrieving failed: %s", $@)); } else { -r $_ or $error = 1, $urpm->{error}(_("unable to access rpm file [%s]", $_)), next; } ($id, undef) = $urpm->parse_rpm($_); my $pkg = defined $id && $urpm->{depslist}[$id]; $pkg or $urpm->{error}(_("unable to register rpm file")), next; $urpm->{source}{$id} = $_; } $error and $urpm->{fatal}(1, _("error registering local packages")); $start <= $id and @requested{($start .. $id)} = (1) x ($id-$start+1); #- distribute local packages to distant nodes directly in cache of each machine. @files && $urpm->{parallel_handler} and $urpm->{parallel_handler}->parallel_register_rpms(@_); %requested; } #- search packages registered by their name by storing their id into packages hash. sub search_packages { my ($urpm, $packages, $names, %options) = @_; my (%exact, %exact_a, %exact_ra, %found, %foundi); foreach my $v (@$names) { my $qv = quotemeta $v; unless ($options{fuzzy}) { #- try to search through provides. if (my @l = grep { defined $_ } map { $_ && ($options{src} ? $_->arch eq 'src' : $_->is_arch_compat) && ($options{use_provides} || $_->name eq $v) ? $_->id : undef } map { $urpm->{depslist}[$_] } keys %{$urpm->{provides}{$v} || {}}) { #- we assume that if the there is at least one package providing the resource exactly, #- this should be the best ones that is described. $exact{$v} = join '|', @l; next; } } if ($options{use_provides} && $options{fuzzy}) { foreach (keys %{$urpm->{provides}}) { #- search through provides to find if a provide match this one. #- but manages choices correctly (as a provides may be virtual or #- multiply defined. if (/$qv/) { my @list = grep { defined $_ } map { my $pkg = $urpm->{depslist}[$_]; $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef } keys %{$urpm->{provides}{$_} || {}}; @list > 0 and push @{$found{$v}}, join '|', @list; } if (/$qv/i) { my @list = grep { defined $_ } map { my $pkg = $urpm->{depslist}[$_]; $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef } keys %{$urpm->{provides}{$_} || {}}; @list > 0 and push @{$found{$v}}, join '|', @list; } } } foreach my $id (0 .. $#{$urpm->{depslist}}) { my $pkg = $urpm->{depslist}[$id]; ($options{src} ? $pkg->arch eq 'src' : $pkg->is_arch_compat) or next; my $pack_ra = $pkg->name . '-' . $pkg->version; my $pack_a = "$pack_ra-" . $pkg->release; my $pack = "$pack_a." . $pkg->arch; unless ($options{fuzzy}) { if ($pack eq $v) { $exact{$v} = $id; next; } elsif ($pack_a eq $v) { push @{$exact_a{$v}}, $id; next; } elsif ($pack_ra eq $v) { push @{$exact_ra{$v}}, $id; next; } } $pack =~ /$qv/ and push @{$found{$v}}, $id; $pack =~ /$qv/i and push @{$foundi{$v}}, $id; } } my $result = 1; foreach (@$names) { if (defined $exact{$_}) { $packages->{$exact{$_}} = 1; } else { #- at this level, we need to search the best package given for a given name, #- always prefer already found package. my %l; foreach (@{$exact_a{$_} || $exact_ra{$_} || $found{$_} || $foundi{$_} || []}) { my $pkg = $urpm->{depslist}[$_]; push @{$l{$pkg->name}}, $pkg; } if (values(%l) == 0) { $urpm->{error}(_("no package named %s", $_)); $result = 0; } elsif (values(%l) > 1 && !$options{all}) { $urpm->{error}(_("The following packages contain %s: %s", $_, join(' ', keys %l))); $result = 0; } else { foreach (values %l) { my $best; foreach (@$_) { if ($best && $best != $_) { $_->compare_pkg($best) > 0 and $best = $_; } else { $best = $_; } } $packages->{$best->id} = 1; } } } } #- return true if no error have been encoutered, else false. $result; } #- do the resolution of dependencies. sub resolve_dependencies { my ($urpm, $state, $requested, %options) = @_; if ($options{install_src}) { #- only src will be installed, so only update $state->{selected} according #- to src status of files. foreach (%$requested) { my $pkg = $urpm->{depslist}[$_] or next; $pkg->arch eq 'src' or next; $state->{selected}{$_} = undef; } } if ($urpm->{parallel_handler}) { #- build the global synthesis file first. my $file = "$urpm->{cachedir}/partial/parallel.cz"; unlink $file; foreach (@{$urpm->{media}}) { defined $_->{start} && defined $_->{end} or next; system "cat '$urpm->{statedir}/synthesis.$_->{hdlist}' >> $file"; } #- let each node determine what is requested, according to handler given. $urpm->{parallel_handler}->parallel_resolve_dependencies($file, @_); } else { my $db; require URPM::Resolve; if ($options{rpmdb}) { $db = new URPM; $db->parse_synthesis($options{rpmdb}); } else { $db = URPM::DB::open($urpm->{root}); $db or $urpm->{fatal}(_"unable to open rpmdb"); } my $sig_handler = sub { undef $db; exit 3 }; local $SIG{INT} = $sig_handler; local $SIG{QUIT} = $sig_handler; #- auto select package for upgrading the distribution. $options{auto_select} and $urpm->request_packages_to_upgrade($db, $state, $requested, requested => undef); $urpm->resolve_requested($db, $state, $requested, %options); } } #- get out of package that should not be upgraded. sub deselect_unwanted_packages { my ($urpm, $packages, %options) = @_; my (%skip, %remove); local ($_, *F); open F, $urpm->{skiplist}; while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; if (my ($n, $s) = /^([^\s\[]+)(?:\[\*\])?\[?\s*([^\s\]]*\s*[^\s\]]*)/) { $skip{$n}{$s} = undef; } } close F; %skip or return; foreach (grep { $options{force} || (exists $packages->{$_} && ! defined $packages->{$_}) } keys %$packages) { my $pkg = $urpm->{depslist}[$_] or next; my $remove_it; #- check if fullname is matching a regexp. if (grep { exists $skip{$_}{''} && /^\/(.*)\/$/ && $pkg->fullname =~ /$1/ } keys %skip) { delete $packages->{$pkg->id}; } else { #- check if a provides match at least one package. foreach ($pkg->provides) { if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) { foreach my $sn ($n, grep { /^\/(.*)\/$/ && $n =~ /$1/ } keys %skip) { foreach (keys %{$skip{$sn} || {}}) { URPM::ranges_overlap($_, $s) and delete $packages->{$pkg->id}; } } } } } } 1; } #- select source for package selected. #- according to keys given in the packages hash. #- return a list of list containing the source description for each rpm, #- match exactly the number of medium registered, ignored medium always #- have a null list. sub get_source_packages { my ($urpm, $packages, %options) = @_; my ($id, $error, %local_sources, @list, %fullname2id, %file2fullnames, %examined); local (*D, *F, $_); #- build association hash to retrieve id and examine all list files. foreach (keys %$packages) { my $p = $urpm->{depslist}[$_]; if ($urpm->{source}{$_}) { $local_sources{$_} = $urpm->{source}{$_}; } else { $fullname2id{$p->fullname} = $_.''; } } #- examine each medium to search for packages. #- now get rpm file name in hdlist to match list file. foreach my $pkg (@{$urpm->{depslist} || []}) { $file2fullnames{($pkg->filename =~ /(.*)\.rpm$/ && $1) || $pkg->fullname}{$pkg->fullname} = undef; } #- examine the local repository, which is trusted (no gpg or pgp signature check but md5 is now done). opendir D, "$urpm->{cachedir}/rpms"; while (defined($_ = readdir D)) { if (my ($filename) = /^([^\/]*)\.rpm$/) { my $filepath = "$urpm->{cachedir}/rpms/$filename.rpm"; if (!$options{clean_all} && -s $filepath && URPM::verify_rpm($filepath, nogpg => 1, nopgp => 1) =~ /md5 OK/) { if (keys(%{$file2fullnames{$filename} || {}}) > 1) { $urpm->{error}(_("there are multiple packages with the same rpm filename \"%s\""), $filename); next; } elsif (keys(%{$file2fullnames{$filename} || {}}) == 1) { my ($fullname) = keys(%{$file2fullnames{$filename} || {}}); if (defined($id = delete $fullname2id{$fullname})) { $local_sources{$id} = $filepath; } else { $options{clean_other} and unlink $filepath; } } else { $options{clean_other} and unlink $filepath; } } else { #- this is an invalid file in cache, remove it and ignore it. #- or clean options has been given meaning ignore any file in cache #- remove it too. unlink $filepath; } } #- no error on unknown filename located in cache (because .listing) } closedir D; foreach my $medium (@{$urpm->{media} || []}) { my %sources; unless ($medium->{ignore}) { #- always prefer a list file is available. if ($medium->{list} && -r "$urpm->{statedir}/$medium->{list}") { open F, "$urpm->{statedir}/$medium->{list}"; while (<F>) { if (my ($filename) = /\/([^\/]*)\.rpm$/) { if (keys(%{$file2fullnames{$filename} || {}}) > 1) { $urpm->{error}(_("there are multiple packages with the same rpm filename \"%s\""), $filename); next; } elsif (keys(%{$file2fullnames{$filename} || {}}) == 1) { my ($fullname) = keys(%{$file2fullnames{$filename} || {}}); defined($id = $fullname2id{$fullname}) and $sources{$id} = $_; $examined{$fullname} = undef; } } else { chomp; $error = 1; $urpm->{error}(_("unable to correctly parse [%s] on value \"%s\"", "$urpm->{statedir}/$medium->{list}", $_)); last; } } close F; } elsif (defined $medium->{url} && defined $medium->{start} && defined $medium->{end}) { foreach ($medium->{start} .. $medium->{end}) { my $pkg = $urpm->{depslist}[$_]; my ($filename) = $pkg->filename =~ /([^\/]*)\.rpm$/; if (keys(%{$file2fullnames{$filename} || {}}) > 1) { $urpm->{error}(_("there are multiple packages with the same rpm filename \"%s\""), $filename); next; } elsif (keys(%{$file2fullnames{$filename} || {}}) == 1) { my ($fullname) = keys(%{$file2fullnames{$filename} || {}}); defined($id = $fullname2id{$fullname}) and $sources{$id} = "$medium->{url}/".$pkg->filename; $examined{$fullname} = undef; } } } else { $error = 1; $urpm->{error}(_("medium \"%s\" does not define any location for rpm files", $medium->{name})); } } push @list, \%sources; } #- examine package list to see if a package has not been found. foreach (grep { ! exists $examined{$_} } keys %fullname2id) { $error = 1; $urpm->{error}(_("package %s is not found.", $_)); } $error ? () : ( \%local_sources, \@list ); } #- download package that may need to be downloaded. #- make sure header are available in the appropriate directory. #- change location to find the right package in the local #- filesystem for only one transaction. #- try to mount/eject removable media here. #- return a list of package ready for rpm. sub download_source_packages { my ($urpm, $local_sources, $list, %options) = @_; my (%sources, %error_sources, %removables); #- make sure everything is correct on input... @{$urpm->{media} || []} == @$list or return; #- examine if given medium is already inside a removable device. my $check_notfound = sub { my ($id, $dir, $removable) = @_; $dir and $urpm->try_mounting($dir, $removable); if (!$dir || -e $dir) { foreach (values %{$list->[$id]}) { /^(removable_?[^_:]*|file):\/(.*\/([^\/]*))/ or next; unless ($dir) { $dir = $2; $urpm->try_mounting($dir, $removable); } -r $2 or return 1; } } else { return 2; } return 0; }; #- removable media have to be examined to keep mounted the one that has #- more package than other (size is better ?). my $examine_removable_medium = sub { my ($id, $device, $copy) = @_; my $medium = $urpm->{media}[$id]; if (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) { #- the directory given does not exist or may be accessible #- by mounting some other. try to figure out these directory and #- mount everything necessary. while ($check_notfound->($id, $dir, 'removable')) { $options{ask_for_medium} or $urpm->{fatal}(4, _("medium \"%s\" is not selected", $medium->{name})); $urpm->try_umounting($dir); system("eject", $device); $options{ask_for_medium}($medium->{name}, $medium->{removable}) or $urpm->{fatal}(4, _("medium \"%s\" is not selected", $medium->{name})); } if (-e $dir) { my @removable_sources; while (my ($i, $url) = each %{$list->[$id]}) { $url =~ /^(removable[^:]*|file):\/(.*\/([^\/]*))/ or next; if (-r $2) { if ($copy) { push @removable_sources, $2; $sources{$i} = "$urpm->{cachedir}/rpms/$3"; } else { $sources{$i} = $2; } } else { $urpm->{error}(_("unable to read rpm file [%s] from medium \"%s\"", $2, $medium->{name})); } } if (@removable_sources) { system("cp", "-pR", @removable_sources, "$urpm->{cachedir}/rpms"); } } else { $urpm->{error}(_("medium \"%s\" is not selected", $medium->{name})); } } else { #- we have a removable device that is not removable, well... $urpm->{error}(_("incoherent medium \"%s\" marked removable but not really", $medium->{name})); } }; #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base). my ($LOCK_EX, $LOCK_UN) = (2, 8); #- lock urpmi database, but keep lock to wait for an urpmi.update to finish. local (*LOCK_FILE); open LOCK_FILE, $urpm->{statedir}; flock LOCK_FILE, $LOCK_EX or $urpm->{fatal}(7, _("urpmi database locked")); foreach (0..$#$list) { values %{$list->[$_]} or next; my $medium = $urpm->{media}[$_]; #- examine non removable device but that may be mounted. if ($medium->{removable}) { push @{$removables{$medium->{removable}} ||= []}, $_; } elsif (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) { -e $dir || $urpm->try_mounting($dir) or $urpm->{error}(_("unable to access medium \"%s\"", $medium->{name})), next; } } foreach my $device (keys %removables) { #- here we have only removable device. #- if more than one media use this device, we have to sort #- needed package to copy first the needed rpm files. if (@{$removables{$device}} > 1) { my @sorted_media = sort { values %{$list->[$a]} <=> values %{$list->[$b]} } @{$removables{$device}}; #- check if a removable device is already mounted (and files present). if (my ($already_mounted_medium) = grep { !$check_notfound->($_) } @sorted_media) { @sorted_media = grep { $_ ne $already_mounted_medium } @sorted_media; unshift @sorted_media, $already_mounted_medium; } #- mount all except the biggest one. foreach (@sorted_media[0 .. $#sorted_media-1]) { $examine_removable_medium->($_, $device, 'copy'); } #- now mount the last one... $removables{$device} = [ $sorted_media[-1] ]; } #- mount the removable device, only one or the important one. #- if supermount is used on the device, it is preferable to copy #- the file instead (because it is so slooooow). $examine_removable_medium->($removables{$device}[0], $device, $urpm->is_using_supermount($device) && 'copy'); } #- get back all ftp and http accessible rpms file into the local cache #- if necessary (as used by checksig or any other reasons). foreach (0..$#$list) { my %distant_sources; #- ignore as well medium that contains nothing about the current set of files. values %{$list->[$_]} or next; #- examine all files to know what can be indexed on multiple media. while (my ($i, $url) = each %{$list->[$_]}) { #- it is trusted that the url given is acceptable, so the file can safely be ignored. defined $sources{$i} and next; if ($url =~ /^(removable[^:]*|file):\/(.*\.rpm)$/) { if (-r $2) { $sources{$i} = $2; } else { $error_sources{$i} = $2; } } elsif ($url =~ /^([^:]*):\/(.*\/([^\/]*\.rpm))$/) { if ($options{force_local} || $1 ne 'ftp' && $1 ne 'http') { #- only ftp and http protocol supported by grpmi. $sources{$i} = "$urpm->{cachedir}/rpms/$3"; $distant_sources{$i} = "$1:/$2"; } else { $sources{$i} = "$1:/$2"; } } else { $urpm->{error}(_("malformed input: [%s]", $url)); } } #- download files from the current medium. if (%distant_sources) { eval { $urpm->{log}(_("retrieving rpm files from medium \"%s\"...", $urpm->{media}[$_]{name})); foreach (map { m|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)| ? "$1xxxx$2" : $_ } values %distant_sources) { $urpm->{log}(" $_") ; } $urpm->{sync}({ dir => "$urpm->{cachedir}/rpms", quiet => 0, verbose => $options{verbose}, proxy => $urpm->{proxy}}, values %distant_sources); $urpm->{log}(_("...retrieving done")); }; if ($@) { $urpm->{log}(_("...retrieving failed: %s", $@)); } #- clean files that have not been downloaded, but keep mind there #- has been problem downloading them at least once, this is #- necessary to keep track of failing download in order to #- present the error to the user. foreach (keys %distant_sources) { -s $sources{$_} or $error_sources{$_} = delete $sources{$_}; } } } #- clean failed download which have succeeded. delete @error_sources{keys %sources}; #- now everything is finished. system("sync"); #- release lock on database. flock LOCK_FILE, $LOCK_UN; close LOCK_FILE; #- return the hash of rpm file that have to be installed, they are all local now. %$local_sources, %sources, %error_sources; } #- extract package that should be installed instead of upgraded, #- sources is a hash of id -> source rpm filename. sub extract_packages_to_install { my ($urpm, $sources) = @_; my %inst; local ($_, *F); open F, $urpm->{instlist}; while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; foreach (keys %{$urpm->{provides}{$_} || {}}) { my $pkg = $urpm->{depslist}[$_] or next; #- some package with specific naming convention to avoid upgrade problem #- should not be taken into account here. #- these package have version=1 and release=1mdk, and name contains version and release. $pkg->version eq '1' && $pkg->release eq '1mdk' && $pkg->name =~ /^.*-[^\-]*mdk$/ and next; exists $sources->{$pkg->id} and $inst{$pkg->id} = delete $sources->{$pkg->id}; } } close F; \%inst; } #- install logger (ala rpm) sub install_logger { my ($urpm, $type, $id, $subtype, $amount, $total) = @_; my $pkg = defined $id && $urpm->{depslist}[$id]; my $progress_size = 50; if ($subtype eq 'start') { $urpm->{logger_progress} = 0; if ($type eq 'trans') { $urpm->{logger_id} = 0; printf "%-28s", _("Preparing..."); } else { printf "%4d:%-23s", ++$urpm->{logger_id}, ($pkg && $pkg->name); } } elsif ($subtype eq 'stop') { if ($urpm->{logger_progress} < $progress_size) { print '#' x ($progress_size - $urpm->{logger_progress}); print "\n"; } } elsif ($subtype eq 'progress') { my $new_progress = $total > 0 ? int($progress_size * $amount / $total) : $progress_size; if ($new_progress > $urpm->{logger_progress}) { print '#' x ($new_progress - $urpm->{logger_progress}); $urpm->{logger_progress} = $new_progress; $urpm->{logger_progress} == $progress_size and print "\n"; } } } #- install packages according to each hashes (install or upgrade). sub install { my ($urpm, $remove, $install, $upgrade, %options) = @_; my $db = URPM::DB::open($urpm->{root}, !$options{test}); #- open in read/write mode unless testing installation. $db or $urpm->{fatal}(_"unable to open rpmdb"); my $trans = $db->create_transaction($urpm->{root}); my ($update, @l, %file2pkg) = (0); local *F; foreach (@$remove) { $trans->remove($_) or $urpm->{error}(_("unable to remove package %s", $_)); } foreach my $mode ($install, $upgrade) { foreach (keys %$mode) { my $pkg = $urpm->{depslist}[$_]; $file2pkg{$mode->{$_}} = $pkg; $pkg->update_header($mode->{$_}); $trans->add($pkg, update => $update, $options{excludepath} ? (excludepath => [ split ',', $options{excludepath} ]) : ()) or $urpm->{error}(_("unable to install package %s", $install->{$_})); } ++$update; } if (!$options{nodeps} and @l = $trans->check) { if ($options{translate_message}) { foreach (@l) { my ($type, $needs, $conflicts) = split '@', $_; $_ = ($type eq 'requires' ? _("%s is needed by %s", $needs, $conflicts) : _("%s conflicts with %s", $needs, $conflicts)); } } return @l; } !$options{noorder} and @l = $trans->order and return @l; #- assume default value for some parameter. $options{delta} ||= 1000; $options{callback_open} ||= sub { my ($data, $type, $id) = @_; open F, $install->{$id} || $upgrade->{$id} or $urpm->{error}(_("unable to access rpm file [%s]", $install->{$id} || $upgrade->{$id})); return fileno F; }; $options{callback_close} ||= sub { close F }; if (keys %$install || keys %$upgrade) { $options{callback_inst} ||= \&install_logger; $options{callback_trans} ||= \&install_logger; } @l = $trans->run($urpm, %options); #- in case of error or testing, do not try to check rpmdb #- for packages being upgraded or not. @l || $options{test} and return @l; #- examine the local repository to delete package which have been installed. if ($options{post_clean_cache}) { foreach (keys %$install, keys %$upgrade) { my $pkg = $urpm->{depslist}[$_]; $db->traverse_tag('name', [ $pkg->name ], sub { my ($p) = @_; $p->fullname eq $pkg->fullname or return; unlink "$urpm->{cachedir}/rpms/".$pkg->filename; }); } } return @l; } #- install all files to node as remembered according to resolving done. sub parallel_install { my ($urpm, $remove, $install, $upgrade, %options) = @_; $urpm->{parallel_handler}->parallel_install(@_); } #- find packages to remove. sub find_packages_to_remove { my ($urpm, $state, $l, %options) = @_; if ($urpm->{parallel_handler}) { #- invoke parallel finder. $urpm->{parallel_handler}->parallel_find_remove($urpm, $state, $l, %options, find_packages_to_remove => 1); } else { my $db = URPM::DB::open($options{root}); my (@m, @notfound); $db or $urpm->{fatal}(_"unable to open rpmdb"); if (!$options{matches}) { foreach (@$l) { my ($n, $found); #- check if name-version-release may have been given. if (($n) = /^(.*)-[^\-]*-[^\-]*\.[^\.\-]*$/) { $db->traverse_tag('name', [ $n ], sub { my ($p) = @_; $p->fullname eq $_ or return; $urpm->resolve_closure_ask_remove($db, $state, $p); push @m, join('-', ($p->fullname)[0..2]); $found = 1; }); $found and next; } #- check if name-version-release may have been given. if (($n) = /^(.*)-[^\-]*-[^\-]*$/) { $db->traverse_tag('name', [ $n ], sub { my ($p) = @_; join('-', ($p->fullname)[0..2]) eq $_ or return; $urpm->resolve_closure_ask_remove($db, $state, $p); push @m, join('-', ($p->fullname)[0..2]); $found = 1; }); $found and next; } #- check if name-version may have been given. if (($n) = /^(.*)-[^\-]*$/) { $db->traverse_tag('name', [ $n ], sub { my ($p) = @_; join('-', ($p->fullname)[0..1]) eq $_ or return; $urpm->resolve_closure_ask_remove($db, $state, $p); push @m, join('-', ($p->fullname)[0..2]); $found = 1; }); $found and next; } #- check if only name may have been given. $db->traverse_tag('name', [ $_ ], sub { my ($p) = @_; $p->name eq $_ or return; $urpm->resolve_closure_ask_remove($db, $state, $p); push @m, join('-', ($p->fullname)[0..2]); $found = 1; }); $found and next; push @notfound, $_; } if (@notfound && ($options{auto} || @$l > 1)) { $options{callback_notfound} and $options{callback_notfound}->($urpm, @notfound) or return (); } } if ($options{matches} || @notfound) { my $match = join "|", map { quotemeta } @$l; #- reset what has been already found. %$state = (); @m = (); #- search for package that matches, and perform closure again. $db->traverse(sub { my ($p) = @_; $p->fullname =~ /$match/ or return; $urpm->resolve_closure_ask_remove($db, $state, $p); push @m, join('-', ($p->fullname)[0..2]); }); if (@notfound) { unless (@m) { $options{callback_notfound} and $options{callback_notfound}->($urpm, @notfound) or return (); } else { $options{callback_fuzzy} and $options{callback_fuzzy}->($urpm, $match, @m) or return (); } } } #- check if something need to be removed. if ($options{callback_base} && %{$state->{ask_remove} || {}}) { my @base = qw(basesystem); my (@base_to_remove, %basepackages, %base); #- check if a package to be removed is a part of basesystem requires. while (defined($_ = shift @base)) { exists $basepackages{$_} and next; $db->traverse_tag(/^\// ? 'path' : 'whatprovides', [ $_ ], sub { my ($p) = @_; push @{$basepackages{$_} ||= []}, join '-', ($p->fullname)[0..2]; push @base, $p->requires_nosense; }); } foreach (values %basepackages) { my $n = @$_; foreach (@$_) { $base{$_} = \$n; } } foreach (keys %{$state->{ask_remove}}) { my $rn = $base{$_}; if ($rn) { $$rn == 1 and push @base_to_remove, $_; --$$rn; } } @base_to_remove and $options{callback_base}->($urpm, @base_to_remove) || return (); } } keys %{$state->{ask_remove}}; } #- remove packages from node as remembered according to resolving done. sub parallel_remove { my ($urpm, $remove, %options) = @_; my $state = {}; my $callback = sub { $urpm->{fatal}(1, "internal distributed remove fatal error") }; $urpm->{parallel_handler}->parallel_find_remove($urpm, $state, $remove, %options, callback_notfound => $callback, callback_fuzzy => $callback, callback_base => $callback, ); } 1;