summaryrefslogtreecommitdiffstats
path: root/perl-install/resize_fat/main.pm
blob: 7268758377cfb7a073d131d0f429d6257b024cd4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
package resize_fat::main; # $Id$

# This is mainly a perl rewrite of the work of Andrew Clausen (libresize)

use diagnostics;
use strict;

use log;
use common;
use MDK::Common::System;
use resize_fat::boot_sector;
use resize_fat::info_sector;
use resize_fat::directory;
use resize_fat::io;
use resize_fat::fat;
use resize_fat::any;


1;

#- - reads in the boot sector/partition info., and tries to make some sense of it
sub new($$$) {
    my ($type, $device, $fs_name) = @_;
    my $fs = { device => $device, fs_name => $fs_name };

    eval {
	resize_fat::io::open($fs);
	resize_fat::boot_sector::read($fs);
	$resize_fat::isFAT32 and eval { resize_fat::info_sector::read($fs) };
	resize_fat::fat::read($fs);
	resize_fat::any::flag_clusters($fs);
    };
    if ($@) {
	close $fs->{fd};
	die;
    }
    bless $fs, $type;
}

sub DESTROY {
    my ($fs) = @_;
    close $fs->{fd};
    resize_fat::c_rewritten::free_all();
}

#- copy all clusters >= <start_cluster> to a new place on the partition, less
#- than <start_cluster>. Only copies files, not directories.
#- (use of buffer needed because the seeks slow like hell the hard drive)
sub copy_clusters {
    my ($fs, $cluster) = @_;
    my @buffer;
    my $flush = sub {
	while (@buffer) {
	    my $cluster = shift @buffer;
	    resize_fat::io::write_cluster($fs, $cluster, shift @buffer);
	}
    };
    for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
	resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::FILE or next;
	push @buffer, 
	  resize_fat::c_rewritten::fat_remap($cluster), 
	  resize_fat::io::read_cluster($fs, $cluster);
	@buffer > 50 and &$flush();
    }
    &$flush();
}

#- Constructs the new directory tree to match the new file locations.
sub construct_dir_tree {
    my ($fs) = @_;

    if ($resize_fat::isFAT32) {
	#- fat32's root must remain in the first 64k clusters
	#- so do not set it as DIRECTORY, it will be specially handled
	resize_fat::c_rewritten::set_flag($fs->{fat32_root_dir_cluster}, $resize_fat::any::FREE);
    }

    for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
	resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::DIRECTORY or next;

      resize_fat::io::write_cluster($fs,
				    resize_fat::c_rewritten::fat_remap($cluster),
				    resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
    }

    MDK::Common::System::sync();

    #- until now, only free clusters have been written. it's a null operation if we stop here.
    #- it means no corruption :)
    #
    #- now we must be as fast as possible!

    #- remapping non movable root directory
    if ($resize_fat::isFAT32) {
	my $cluster = $fs->{fat32_root_dir_cluster};

	resize_fat::io::write_cluster($fs,
		      resize_fat::c_rewritten::fat_remap($cluster),
		      resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
    } else {
	resize_fat::io::write($fs, $fs->{root_dir_offset}, $fs->{root_dir_size},
			      resize_fat::directory::remap($fs, resize_fat::io::read($fs, $fs->{root_dir_offset}, $fs->{root_dir_size})));
    }
}

sub min_size($) { &resize_fat::any::min_size }
sub max_size($) { &resize_fat::any::max_size }
sub used_size($) { &resize_fat::any::used_size }

#- resize
#- - size is in sectors
#- - checks boundaries before starting
#- - copies all data beyond new_cluster_count behind the frontier
sub resize {
    my ($fs, $size) = @_;

    my ($min, $max) = (min_size($fs), max_size($fs));

    $size += $min if $size =~ /^\+/;

    $size >= $min or die "Minimum filesystem size is $min sectors";
    $size <= $max or die "Maximum filesystem size is $max sectors";

    log::l("resize_fat: Partition size will be " . (($size * $SECTORSIZE) >> 20) . "Mb (well exactly ${size} sectors)");

    my $new_data_size = $size * $SECTORSIZE - $fs->{cluster_offset};
    my $new_nb_clusters = divide($new_data_size, $fs->{cluster_size});
    my $used_size = used_size($fs);

    log::l("resize_fat: Break point for moving files is " . (($used_size * $SECTORSIZE) >> 20) . " Mb ($used_size sectors)");
    if ($size < $used_size) {
	log::l("resize_fat: Allocating new clusters");
	resize_fat::fat::allocate_remap($fs, $new_nb_clusters);

	log::l("resize_fat: Copying files");
	copy_clusters($fs, $new_nb_clusters);

	log::l("resize_fat: Copying directories");
	construct_dir_tree($fs);

	log::l("Writing new FAT...");
	resize_fat::fat::update($fs);
	resize_fat::fat::write($fs);
    } else {
	log::l("resize_fat: Nothing need to be moved");
    }

    $fs->{nb_sectors} = $size;
    $fs->{nb_clusters} = $new_nb_clusters;
    $fs->{clusters}{count}{free} =
      $fs->{nb_clusters} - $fs->{clusters}{count}{used} - $fs->{clusters}{count}{bad} - 2;

    $fs->{system_id} = 'was here!';
    $fs->{small_nb_sectors} = 0;
    $fs->{big_nb_sectors} = $size;

    log::l("resize_fat: Writing new boot sector...");

    resize_fat::boot_sector::write($fs);

    $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; #- does not matter if this fails - its pretty useless!

    MDK::Common::System::sync();
    close $fs->{fd};
    log::l("resize_fat: done");
}

#n832'>832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959
package install::steps;

use diagnostics;
use strict;
use vars qw(@filesToSaveForUpgrade @filesNewerToUseAfterUpgrade);

#-######################################################################################
#- misc imports
#-######################################################################################
use common;
use install::any 'addToBeDone';
use partition_table;
use detect_devices;
use fs::any;
use fs::type;
use fs::partitioning;
use modules;
use run_program;
use lang;
use keyboard;
use fsedit;
use do_pkgs;
use install::pkgs;
use any;
use log;

our @ISA = qw(do_pkgs);

@filesToSaveForUpgrade = qw(
/etc/ld.so.conf /etc/fstab /etc/hosts /etc/conf.modules /etc/modules.conf
);

@filesNewerToUseAfterUpgrade = qw(
/etc/profile
);

#-######################################################################################
#- OO Stuff
#-######################################################################################
sub new($$) {
    my ($type, $o) = @_;

    bless $o, ref($type) || $type;
    return $o;
}

sub charsetChanged {
    my ($_o) = @_;
}

#-######################################################################################
#- In/Out Steps Functions
#-######################################################################################
sub enteringStep {
    my ($_o, $step) = @_;
    log::l("starting step `$step'");
}
sub leavingStep {
    my ($o, $step) = @_;
    log::l("step `$step' finished");

    if (-d "$::prefix/root/drakx") {
	eval { cp_af("/tmp/ddebug.log", "$::prefix/root/drakx") };
	output(install::any::auto_inst_file(), install::any::g_auto_install(1));
    }

    foreach my $s (@{$o->{orderedSteps}}) {
	#- the reachability property must be recomputed each time to take
	#- into account failed step.
	next if $o->{steps}{$s}{done} && !$o->{steps}{$s}{redoable};

	my $reachable = 1;
	if (my $needs = $o->{steps}{$s}{needs}) {
	    my @l = ref($needs) ? @$needs : $needs;
	    $reachable = min(map { $o->{steps}{$_}{done} || 0 } @l);
	}
	$o->{steps}{$s}{reachable} = 1 if $reachable;
    }
    $o->{steps}{$step}{reachable} = $o->{steps}{$step}{redoable};

    while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
	eval { &$f() };
	if (my $err = $@) {
	    $o->ask_warn(N("Error"), [
N("An error occurred, but I do not know how to handle it nicely.
Continue at your own risk."), formatError($err) || $err ]);
	}
    }
}

sub errorInStep { 
    my ($_o, $err) = @_;
    print "error :(\n"; 
    print "$err\n\n";
    c::_exit(1);
}
sub kill_action {}

#-######################################################################################
#- Steps Functions
#-######################################################################################
#------------------------------------------------------------------------------
sub selectLanguage {
    my ($o) = @_;

    $o->{locale}{langs} ||= { $o->{locale}{lang} => 1 };

    if (!exists $o->{locale}{country}) {
	lang::lang_changed($o->{locale});
    }

    add2hash_($o->{locale}, { utf8 => lang::utf8_should_be_needed($o->{locale}) });
    lang::set($o->{locale}, !$o->isa('interactive::gtk'));

    log::l("selectLanguage: pack_langs: ", lang::pack_langs($o->{locale}{langs}), " utf8-flag: ", to_bool($o->{locale}{utf8}));

    #- for auto_install compatibility with old $o->{keyboard} containing directly $o->{keyboard}{KEYBOARD}
    $o->{keyboard} = { KEYBOARD => $o->{keyboard} } if $o->{keyboard} && !ref($o->{keyboard});

    if (!$o->{keyboard} || $o->{keyboard}{unsafe}) {
	$o->{keyboard} = keyboard::default($o->{locale});
	$o->{keyboard}{unsafe} = 1;
	keyboard::setup_install($o->{keyboard});
    }

    $o->charsetChanged;

    addToBeDone {
	lang::write_langs($o->{locale}{langs});
    } 'formatPartitions';
    addToBeDone {
	lang::write_and_install($o->{locale}, $o->do_pkgs);
    } 'installPackages';
}
#------------------------------------------------------------------------------
sub selectKeyboard {
    my ($o) = @_;
    keyboard::setup_install($o->{keyboard});

    addToBeDone {
	#- the bkmap keymaps in installer are deficient, we need to load the real one before keyboard::write which will generate /etc/sysconfig/console/default.kmap
	run_program::rooted($::prefix, 'loadkeys', keyboard::keyboard2kmap($o->{keyboard}))
	    or log::l("loadkeys failed");
	keyboard::write($o->{keyboard});
    } 'installPackages' if !$o->{isUpgrade} || !$o->{keyboard}{unsafe};
}
#------------------------------------------------------------------------------
sub acceptLicense {}

#------------------------------------------------------------------------------
sub setupSCSI {
    my ($o) = @_;
    install::any::configure_pcmcia($o);
    modules::load(modules::category2modules('disk/cdrom'));
    modules::load_category($o->{modules_conf}, 'bus/firewire');
    modules::load_category($o->{modules_conf}, 'disk/scsi');
    #- load disk/scsi before disk/ide since libata is now the default
    #- (to prevent modules::load_category from loading ide-generic too early)
    modules::load_category($o->{modules_conf}, 'disk/ide|hardware_raid|sata|firewire');

    install::any::getHds($o);
}

#------------------------------------------------------------------------------
sub selectInstallClass {
    my ($o) = @_;

    if ($o->{partitioning}{use_existing_root} || $o->{isUpgrade}) {
	# either one root is defined (and all is ok), or we take the first one we find
	my $p = fs::get::root_($o->{fstab}) || (first(install::any::find_root_parts($o->{fstab}, $::prefix)) || die)->{part};
	$o->{migrate_device_names} = install::any::use_root_part($o->{all_hds}, $p);
	$o->{previous_release} = $p if $o->{isUpgrade};
    } 
}

#------------------------------------------------------------------------------
sub doPartitionDisksBefore {
    my ($o) = @_;
    log::l("fdisk before:\n" . `fdisk -l`);
    eval { 
	eval { fs::mount::umount("$::prefix/sys/kernel/debug/usb") };
	eval { fs::mount::umount("$::prefix/sys") };
	eval { fs::mount::umount("$::prefix/proc") };
	eval {          fs::mount::umount_all($o->{fstab}) };
	eval { sleep 1; fs::mount::umount_all($o->{fstab}) } if $@; #- HACK
    } if $o->{fstab} && !$::testing;
}

#------------------------------------------------------------------------------
sub doPartitionDisksAfter {
    my ($o) = @_;

    fs::any::write_hds($o->{all_hds}, $o->{fstab}, !$o->{isUpgrade}, sub { $o->rebootNeeded }, $o);
    log::l("fdisk after\n" . `fdisk -l`);

    if ($::local_install) {
	my $p = fs::get::mntpoint2part($::prefix, [ fs::read_fstab('', '/proc/mounts') ]);
	my $part = find { fs::get::is_same_hd($p, $_) } @{$o->{fstab}};
	$part ||= $o->{fstab}[0];
	$part->{mntpoint} = '/';
	$part->{isMounted} = 1;
    }

    fs::any::check_hds_boot_and_root($o->{all_hds}, $o->{fstab});

    if ($o->{partitioning}{use_existing_root}) {
	#- ensure those partitions are mounted so that they are not proposed in choosePartitionsToFormat
	fs::mount::part($_) foreach sort { $a->{mntpoint} cmp $b->{mntpoint} }
				    grep { $_->{mntpoint} && maybeFormatted($_) } @{$o->{fstab}};
    }
}

#------------------------------------------------------------------------------
sub doPartitionDisks {
    my ($o) = @_;

    if ($o->{partitioning}{auto_allocate}) {
	catch_cdie { fsedit::auto_allocate($o->{all_hds}, $o->{partitions}) } sub { 1 };
    }
}

#------------------------------------------------------------------------------

sub rebootNeeded($) {
    my ($_o) = @_;
    log::l("Rebooting...");
    c::_exit(0);
}

sub choosePartitionsToFormat {
    my ($o) = @_;
    fs::partitioning::guess_partitions_to_format($o->{fstab});
}

sub formatMountPartitions {
    my ($o) = @_;
    fs::format::formatMount_all($o->{all_hds}, $o->{fstab}, undef);
}

#------------------------------------------------------------------------------
sub setPackages {
    my ($o) = @_;

    install::any::setPackages($o);
}

sub ask_deselect_media__copy_on_disk {
    my (undef, $_hdlists, $_copy_rpms_on_disk) = @_;
    0;
}

sub ask_change_cd {
    my (undef, $phys_m) = @_;
    log::l("change to medium $phys_m refused (it can't be done automatically)");
    0;
}

sub selectSupplMedia { '' }

sub choosePackages {
    my ($o, $o_compssListLevel) = @_;

    #- clear the mirror cache before upgrading:
    eval { rm_rf("$::prefix/var/cache/urpmi/mirrors.cache") };
 
    #- now for upgrade, package that must be upgraded are
    #- selected first, after is used the same scheme as install.

    #- make sure we kept some space left for available else the system may
    #- not be able to start
    my $available = install::any::getAvailableSpace($o);
    my $availableCorrected = install::pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024);
    log::l(sprintf "available size %s (corrected %s)", formatXiB($available), formatXiB($availableCorrected));

    #- !! destroying user selection of packages (they may have done individual selection before)
    exists $o->{compssListLevel} || defined $o_compssListLevel
	  and install::pkgs::setSelectedFromCompssList($o->{packages}, $o->{rpmsrate_flags_chosen}, $o_compssListLevel || $o->{compssListLevel}, $availableCorrected);

    $availableCorrected;
}

sub live_patch_URPM() {

    sub prefering_mga {
	my ($lpkg, $rpkg_ver, $c) = @_;
	my $lpkg_ver = $lpkg->version . '-' . $lpkg->release;
	log::l($lpkg->name . ' ' . ': prefering ' . ($c == 1 ? "$lpkg_ver over $rpkg_ver" : "$rpkg_ver over $lpkg_ver"));
    }

    my $old_compare_pkg = \&URPM::Package::compare_pkg;
    undef *URPM::Package::compare_pkg;
    *URPM::Package::compare_pkg = sub {
	my ($lpkg, $rpkg) = @_;
	my $c = ($lpkg->release =~ /mga/ ? 1 : 0) - ($rpkg->release =~ /mga/ ? 1 : 0);
	if ($c) {
	    prefering_mga($lpkg, $rpkg->version . '-' . $rpkg->release, $c);
	    $c;
	} else {
	    &$old_compare_pkg;
	}
    };

    my $old_compare = \&URPM::Package::compare;
    undef *URPM::Package::compare;
    *URPM::Package::compare = sub {
	my ($lpkg, $rpkg_ver) = @_;
	my $c = ($lpkg->release =~ /mga/ ? 1 : 0) - ($rpkg_ver =~ /mga/ ? 1 : 0);
	if ($c) {
	    prefering_mga($lpkg, $rpkg_ver, $c);
	    return $c;
	}
	&$old_compare;
    };
}

sub upgrading_redhat() {
    #- remove weird config files that bother Xconfig::* too much
    unlink "$::prefix/etc/X11/XF86Config";
    unlink "$::prefix/etc/X11/XF86Config-4";
}

sub beforeInstallPackages {
    my ($o) = @_;

    read_bootloader_config($o);

    if ($o->{isUpgrade}) {
	$o->{modules_conf}->merge_into(modules::any_conf->read);

	#- save these files in case of upgrade failure.
	foreach (@filesToSaveForUpgrade) {
	    unlink "$::prefix/$_.mdkgisave";
	    if (-e "$::prefix/$_") {
		eval { cp_af("$::prefix/$_", "$::prefix/$_.mdkgisave") };
	    }
	}
	foreach (@filesNewerToUseAfterUpgrade) {
	    unlink "$::prefix/$_.rpmnew";
	}

	log::l("converting filesystem for usrmove");
	if (!run_program::run('/usr/lib/dracut/modules.d/30convertfs/convertfs.sh', $::prefix)) {
	    mkdir_p("$::prefix/root/drakx") if ! -d "$::prefix/root/drakx";
	    # logs are only copied to $::prefix/root/drakx at the end of each step, so do it manually now
	    eval { cp_af("/tmp/ddebug.log", "$::prefix/root/drakx") };
	    die "Unable to convert filesystem prior to upgrade. Check ddebug.log for details";
	}
    }

    #- mainly for upgrading redhat packages, but it can help other
    my @should_not_be_dirs = qw(/usr/share/locale/zh_TW/LC_TIME /usr/include/GL);
    my @should_be_dirs = qw(/etc/X11/xkb);
    my @to_remove = (
		     (grep { !-l $_ && -d $_          } map { "$::prefix$_" } @should_not_be_dirs),
		     (grep { -l $_ || !-d $_ && -e $_ } map { "$::prefix$_" } @should_be_dirs),
		    );
    rm_rf(@to_remove);

    live_patch_URPM() if $o->{isUpgrade} !~ /mageia/;

    if ($o->{isUpgrade} eq 'redhat') {
	upgrading_redhat();
    }

    if ($o->{isUpgrade} =~ /redhat|conectiva/) {
	#- to ensure supermount is removed (???)
	fs::mount_options::set_all_default($o->{all_hds}, %$o, lang::fs_options($o->{locale}));
    }
	

    #- some packages need such files for proper installation.
    install::any::write_fstab($o);

    #- resolv.conf will be modified at boot time
    #- the following will ensure we have a working DNS during install
    if (-e "/etc/resolv.conf" && ! -e "$::prefix/etc/resolv.conf") {
	cp_af("/etc/resolv.conf", "$::prefix/etc");
    }