perl-install/mouse.pm


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

package mouse;

use diagnostics;
use strict;

#-######################################################################################
#- misc imports
#-######################################################################################
use common qw(:common :system :functional :file);
use modules;
use detect_devices;
use run_program;
use devices;
use commands;
use modules;
use log;

my @mouses_fields = qw(nbuttons device MOUSETYPE XMOUSETYPE FULLNAME);
my @mouses = (
arch() =~ /^sparc/ ? (
  [ 3, "sunmouse", "sun",       "sun",            __("Sun - Mouse") ],
) : arch() eq "ppc" ? (
  [ 1, "adbmouse", "Busmouse",  "BusMouse",       __("Apple ADB Mouse") ],
  [ 2, "adbmouse", "Busmouse",  "BusMouse",       __("Apple ADB Mouse (2 Buttons)") ],
  [ 3, "adbmouse", "Busmouse",  "BusMouse",       __("Apple ADB Mouse (3+ Buttons)") ],
  [ 1, "usbmouse", "imps2",     "IMPS/2",         __("Apple USB Mouse") ],
  [ 2, "usbmouse", "imps2",     "IMPS/2",         __("Apple USB Mouse (2 Buttons)") ],
  [ 3, "usbmouse", "imps2",     "IMPS/2",         __("Apple USB Mouse (3+ Buttons)") ],
) : (
  [ 2, "psaux", "ps/2",         "PS/2",           __("Generic Mouse (PS/2)") ],
  [ 3, "psaux", "ps/2",         "PS/2",           __("Logitech MouseMan/FirstMouse (ps/2)") ],
  [ 3, "psaux", "ps/2",         "PS/2",           __("Generic 3 Button Mouse (PS/2)") ],
  [ 2, "psaux", "ps/2",      "GlidePointPS/2",    __("ALPS GlidePoint (PS/2)") ],
  [ 5, "psaux", "ps/2",      "MouseManPlusPS/2",  __("Logitech MouseMan+/FirstMouse+ (PS/2)") ],
  [ 5, "psaux", "ps/2",      "ThinkingMousePS/2", __("Kensington Thinking Mouse (PS/2)") ],
  [ 5, "psaux", "ps/2",         "NetMousePS/2",   __("ASCII MieMouse (PS/2)") ],
  [ 5, "psaux", "netmouse",     "NetMousePS/2",   __("Genius NetMouse (PS/2)") ],
  [ 5, "psaux", "netmouse",     "NetMousePS/2",   __("Genius NetMouse Pro (PS/2)") ],
  [ 5, "psaux", "netmouse",     "NetScrollPS/2",  __("Genius NetScroll (PS/2)") ],
  [ 5, "psaux", "imps2",        "IMPS/2",         __("Microsoft IntelliMouse (PS/2)") ],
  [ 2, "atibm",    "Busmouse",  "BusMouse",   	  __("ATI Bus Mouse") ],
  [ 2, "inportbm", "Busmouse",  "BusMouse",       __("Microsoft Bus Mouse") ],
  [ 3, "logibm",   "Busmouse",  "BusMouse",       __("Logitech Bus Mouse") ],
  [ 2, "usbmouse", "ps/2",      "PS/2",           __("USB Mouse") ],
  [ 3, "usbmouse", "ps/2",      "PS/2",           __("USB Mouse (3 buttons or more)") ],
),
  [ 0, "none",  "none",         "Microsoft",      __("No Mouse") ],
  [ 2, "ttyS",  "pnp",          "Auto",           __("Microsoft Rev 2.1A or higher (serial)") ],
  [ 3, "ttyS",  "logim",        "MouseMan",       __("Logitech CC Series (serial)") ],
  [ 5, "ttyS",  "pnp",          "IntelliMouse",   __("Logitech MouseMan+/FirstMouse+ (serial)") ],
  [ 5, "ttyS",  "ms3",          "IntelliMouse",   __("ASCII MieMouse (serial)") ],
  [ 5, "ttyS",  "ms3",          "IntelliMouse",   __("Genius NetMouse (serial)") ],
  [ 5, "ttyS",  "ms3",          "IntelliMouse",   __("Microsoft IntelliMouse (serial)") ],
  [ 2, "ttyS",  "MMSeries",     "MMSeries",       __("MM Series (serial)") ],
  [ 2, "ttyS",  "MMHitTab",     "MMHittab",       __("MM HitTablet (serial)") ],
  [ 3, "ttyS",  "Logitech",     "Logitech",       __("Logitech Mouse (serial, old C7 type)") ],
  [ 3, "ttyS",  "MouseMan",     "MouseMan",       __("Logitech MouseMan/FirstMouse (serial)") ],
  [ 2, "ttyS",  "Microsoft",    "Microsoft",  	  __("Generic Mouse (serial)") ],
  [ 2, "ttyS",  "Microsoft",    "Microsoft",      __("Microsoft compatible (serial)") ],
  [ 3, "ttyS",  "Microsoft",    "Microsoft",  	  __("Generic 3 Button Mouse (serial)") ],
  [ 2, "ttyS",  "MouseSystems", "MouseSystems",   __("Mouse Systems (serial)") ],
);
map_index {
    my %l; @l{@mouses_fields} = @$_;
    $mouses[$::i] = \%l;
} @mouses;

sub names { map { $_->{FULLNAME} } @mouses }

sub name2mouse {
    my ($name) = @_;
    foreach (@mouses) {
	return { %$_ } if $name eq $_->{FULLNAME};
    }
    die "$name not found";
}

sub serial_ports_names() {
    map { "ttyS" . ($_ - 1) . " / COM$_" } 1..4;
}
sub serial_ports_names2dev {
    local ($_) = @_;
    first(/(\w+)/);
}

sub read($) {
    my ($prefix) = @_;
    my %mouse = getVarsFromSh "$prefix/etc/sysconfig/mouse";
    $mouse{device} = readlink "$prefix/dev/mouse" or log::l("reading $prefix/dev/mouse symlink failed");
    %mouse;
}

sub write($;$) {
    my ($prefix, $mouse) = @_;
    local $mouse->{FULLNAME} = qq("$mouse->{FULLNAME}");
    setVarsInSh("$prefix/etc/sysconfig/mouse", $mouse, qw(MOUSETYPE XMOUSETYPE FULLNAME XEMU3));
    symlinkf $mouse->{device}, "$prefix/dev/mouse" or log::l("creating $prefix/dev/mouse symlink failed");
}

sub mouseconfig {
    my ($t, $mouse, $wacom);

    foreach (0..1) { #- probe only ttyS0 and ttyS1.
	$t = detect_devices::probe_device("/dev/ttyS$_");
	if ($t->{CLASS} =~ /MOUSE/i) {
	    $t->{MFG} ||= $t->{MANUFACTURER};

	    $mouse = name2mouse("Microsoft IntelliMouse (serial)") if $t->{MFG} eq 'MSH' && $t->{MODEL} eq '0001';
	    $mouse = name2mouse("Logitech MouseMan/FirstMouse (serial)") if $t->{MFG} eq 'LGI' && $t->{MODEL} =~ /^80/;
	    $mouse = name2mouse("Genius NetMouse (serial)") if $t->{MFG} eq 'KYE' && $t->{MODEL} eq '0003';

	    $mouse ||= name2mouse("Generic Mouse (serial)"); #- generic by default.
	    $mouse->{device} = "ttyS$_";
	    last;
	} elsif ($t->{CLASS} eq "PEN" || $t->{MANUFACTURER} eq "WAC") {
	    $wacom = "ttyS$_";
	}
    }
    $mouse, $wacom;
}

sub detect() {
    return name2mouse("Sun - Mouse") if arch() =~ /^sparc/;

    if (arch() eq "ppc") {
        return name2mouse("Apple USB Mouse") if detect_devices::hasMouseMacUSB;
        # No need to search for an ADB mouse.  If I did, the PPC kernel would
        # find one whether or not I had one installed!  So..  default to it.
        return name2mouse("Apple ADB Mouse");
    }

    detect_devices::hasMousePS2 and return name2mouse("Generic Mouse (PS/2)");

    eval { commands::modprobe("serial") };
    my ($r, $wacom) = mouseconfig(); return ($r, $wacom) if $r;

    require pci_probing::main;
    if (my ($c) = pci_probing::main::probe("SERIAL_USB")) {
	eval { 
	    modules::load($c->[1], "SERIAL_USB");
	    modules::load("usbmouse");
	    modules::load("mousedev");
	   };
	sleep(1);
	do { 
	    $wacom or modules::unload("serial"); 
	    modules::load("usbkbd");
	    modules::load("keybdev");
	    return name2mouse("USB Mouse"), $wacom;
	} if !$@ && detect_devices::tryOpen("usbmouse");
	modules::unload("mousedev");
	modules::unload("usbmouse");
	modules::unload($c->[1], 'remove_alias');
    }

    #- defaults to generic ttyS0
    add2hash({ device => "ttyS0", unsafe => 1 }, name2mouse("Generic Mouse (serial)"));

#-    die "mouseconfig failed";
}
package diskdrake::interactive; # $Id: interactive.pm 269771 2010-06-03 11:50:24Z pterjan $

use diagnostics;
use strict;
use utf8;

use common;
use fs::type;
use fs::loopback;
use fs::format;
use fs::mount_options;
use fs;
use partition_table;
use partition_table::raw;
use detect_devices;
use run_program;
use devices;
use fsedit;
use raid;
use any;
use log;


=begin

=head1 SYNOPSYS

struct part {
  int active            # one of { 0 | 0x80 }  x86 only, primary only
  int start             # in sectors
  int size              # in sectors
  int pt_type           # 0x82, 0x83, 0x6 ...
  string fs_type        # 'ext2', 'nfs', ...
  string type_name      # 'Linux RAID', 'Linux Logical Volume Manager', ...

  int part_number       # 1 for hda1...
  string device         # 'hda5', 'sdc1' ...
  string device_LABEL   # volume label. LABEL=xxx or /dev/disk/by-label/xxx can be used in fstab instead of the device
  string device_UUID    # volume UUID. UUID=xxx or /dev/disk/by-uuid/xxx can be used in fstab instead of the device
  bool prefer_device_LABEL # should the {device_LABEL} or the {device} be used in fstab
  bool prefer_device_UUID # should the {device_UUID} or the {device} be used in fstab
  bool prefer_device    # should the {device} be used in fstab
  bool faked_device     # false if {device} is a real device, true for nfs/smb/dav/none devices. If the field does not exist, we do not know
  bool device_LABEL_changed # true if device_LABEL is different from the one on the disk

  string rootDevice     # 'sda', 'hdc' ... (can also be a VG_name)
  string real_mntpoint  # directly on real /, '/tmp/hdimage' ...
  string mntpoint       # '/', '/usr' ...
  string options        # 'defaults', 'noauto'
  string device_windobe # 'C', 'D' ...
  string encrypt_key    # [0-9A-Za-z./]{20,}
  string comment        # comment to have in fstab
  string volume_label   #

  bool is_removable     # is the partition on a removable drive
  bool isMounted

  bool isFormatted
  bool notFormatted
    #  isFormatted                  means the device is formatted
    # !isFormatted &&  notFormatted means the device is not formatted
    # !isFormatted && !notFormatted means we do not know which state we're in

  string raid       # for partitions of type isRawRAID and which isPartOfRAID, the raid device
  string lvm        # partition used as a PV for the VG with {lvm} as VG_name  #-#
  loopback loopback[]   # loopback living on this partition

  string dmcrypt_key
  string dm_name
  bool dm_active

  # internal
  string real_device     # '/dev/loop0', '/dev/loop1' ... (used for encrypted loopback)

  # internal CHS (Cylinder/Head/Sector)
  int start_cyl, start_head, start_sec, end_cyl, end_head, end_sec,
}

struct part_allocate inherits part {
  int maxsize        # in sectors (alike "size")
  int min_hd_size    # in sectors (do not allocate if the drive is smaller than the given size)
  int ratio          #
  string hd          # 'hda', 'hdc'
  string parts       # for creating raid partitions. eg: 'foo bar' where 'foo' and 'bar' are mntpoint
}

struct part_raid inherits part {
  string chunk-size  # in KiB, usually '64'
  string level       # one of { 0, 1, 4, 5, 'linear' }
  string UUID

  part disks[]

  # invalid: active, start, rootDevice, device_windobe?, CHS
}

struct part_dmcrypt inherits part {
  string dmcrypt_name

  # rootDevice is special here: it is the device hosting the dm
}

struct part_loopback inherits part {
  string loopback_file   # absolute file name which is relative to the partition
  part loopback_device   # where the loopback file live

  # device is special here: it is the absolute filename of the loopback file.

  # invalid: active, start, rootDevice, device_windobe, CHS
}

struct part_lvm inherits part {
  # invalid: active, start, device_windobe, CHS
  string lv_name
}


struct partition_table_elem {
  part normal[]     #
  part extended     # the main/next extended
  part raw[4]       # primary partitions
}

struct geom {
  int heads
  int sectors
  int cylinders
  int totalcylinders # for SUN, forget it
  int start          # always 0, forget it
}

struct hd {
  int totalsectors      # size in sectors
  string device         # 'hda', 'sdc' ...
  string device_alias   # 'cdrom', 'floppy' ...
  string media_type     # one of { 'hd', 'cdrom', 'fd', 'tape' }
  string capacity       # contain of the strings of { 'burner', 'DVD' }
  string info           # name of the hd, eg: 'QUANTUM ATLAS IV 9 WLS'

  bool readonly         # is it allowed to modify the partition table
  bool getting_rid_of_readonly_allowed # is it forbidden to write because the partition table is badly handled, or is it because we MUST not change the partition table
  bool isDirty          # does it need to be written to the disk
  list will_tell_kernel # list of actions to tell to the kernel so that it knows the new partition table
  bool rebootNeeded     # happens when a kernel reread failed
  list partitionsRenumbered # happens when you
                            # - remove an extended partition which is not the last one
                            # - add an extended partition which is the first extended partition
  list allPartitionsRenumbered # used to update bootloader configuration
  int bus, id

  bool is_removable     # is it a removable drive

  partition_table_elem primary
  partition_table_elem extended[]

  geom geom

  # internal
  string prefix         # for some RAID arrays device=>c0d0 and prefix=>c0d0p
  string file           # '/dev/hda' ...
}

struct hd_lvm inherits hd {
  int PE_size           # block size (granularity, similar to cylinder size on x86)
  string VG_name        # VG name

  part_lvm disks[]

  # invalid: bus, id, extended, geom
}

struct raw_hd inherits hd {
  string fs_type       # 'ext2', 'nfs', ...
  string mntpoint   # '/', '/usr' ...
  string options    # 'defaults', 'noauto'

  # invalid: isDirty, will_tell_kernel, rebootNeeded, primary, extended
}

struct all_hds {
  hd hds[]
  hd_lvm lvms[]
  part_raid raids[]
  part_dmcrypt dmcrypts[]
  part_loopback loopbacks[]
  raw_hd raw_hds[]
  raw_hd nfss[]
  raw_hd smbs[]
  raw_hd davs[]
  raw_hd special[]

  # internal: if fstab_to_string($all_hds) eq current_fstab then no need to save
  string current_fstab
}


=cut


sub main {
    my ($in, $all_hds, $do_force_reload) = @_;

    if ($in->isa('interactive::gtk')) {
	require diskdrake::hd_gtk;
	goto &diskdrake::hd_gtk::main;
    }

    my ($current_part, $current_hd);

    while (1) {
	my $choose_txt = $current_part ? N_("Choose another partition") : N_("Choose a partition");
	my $parts_and_holes = [ fs::get::fstab_and_holes($all_hds) ];
	my $choose_part = sub {
	    $current_part = $in->ask_from_listf('diskdrake', translate($choose_txt),
						sub {
						    my $hd = fs::get::part2hd($_[0] || return, $all_hds);
						    format_part_info_short($hd, $_[0]);
						}, $parts_and_holes, $current_part) || return;
	    $current_hd = fs::get::part2hd($current_part, $all_hds);
	};

	$choose_part->() if !$current_part;
	return if !$current_part;

	my %actions = my @actions = (
            if_($current_part,
          (map { my $s = $_; $_ => sub { $diskdrake::interactive::{$s}($in, $current_hd, $current_part, $all_hds) } } part_possible_actions($in, $current_hd, $current_part, $all_hds)),
		'____________________________' => sub {},
            ),
            if_(@$parts_and_holes > 1, $choose_txt => $choose_part),
	    if_($current_hd,
	  (map { my $s = $_; $_ => sub { $diskdrake::interactive::{$s}($in, $current_hd, $all_hds) } } hd_possible_actions_interactive($in, $current_hd, $all_hds)),
	    ),
	  (map { my $s = $_; $_ => sub { $diskdrake::interactive::{$s}($in, $all_hds) } } general_possible_actions($in, $all_hds)),
        );
	my ($actions) = list2kv(@actions);
	my $a;
	if ($current_part) {
	    $in->ask_from_({
			    cancel => N("Exit"),
			    title => 'diskdrake',
			    messages => format_part_info($current_hd, $current_part),
			   },
			   [ { val => \$a, list => $actions, format => \&translate, type => 'list', sort => 0, gtk => { use_boxradio => 0 } } ]) or last;
	    my $v = eval { $actions{$a}() };
	    if (my $err = $@) {
		$in->ask_warn(N("Error"), formatError($err));
	    }
	    if ($v eq 'force_reload') {
		$all_hds = $do_force_reload->();
	    }
	    $current_hd = $current_part = '' if !is_part_existing($current_part, $all_hds);
	} else {
	    $choose_part->();
	}
	partition_table::assign_device_numbers($_) foreach fs::get::hds($all_hds);
    }
    return if eval { Done($in, $all_hds) };
    if (my $err = $@) {
    	$in->ask_warn(N("Error"), formatError($err));
    }
    goto &main;
}


################################################################################
# general actions
################################################################################
sub general_possible_actions {
    my ($_in, $_all_hds) = @_;
    if_($::isInstall, N_("More"));
}

sub Done {
    my ($in, $all_hds) = @_;
    eval { raid::verify($all_hds->{raids}) };
    if (my $err = $@) {
	$::expert or die;
	$in->ask_okcancel(N("Confirmation"), [ formatError($err), N("Continue anyway?") ]) or return;
    }
    foreach (@{$all_hds->{hds}}) {
	if (!write_partitions($in, $_, 'skip_check_rebootNeeded')) {
	    return if !$::isStandalone;
	    $in->ask_yesorno(N("Quit without saving"), N("Quit without writing the partition table?"), 1) or return;
	}
    }
    foreach (@{$all_hds->{raids}}) {
        raid::make($all_hds->{raids}, $_);
    }
    if (!$::isInstall) {
	my $new = fs::fstab_to_string($all_hds);
	if ($new ne $all_hds->{current_fstab} && $in->ask_yesorno(N("Confirmation"), N("Do you want to save the /etc/fstab modifications?"), 1)) {
	    $all_hds->{current_fstab} = $new;
	    fs::write_fstab($all_hds);
	}
	update_bootloader_for_renumbered_partitions($in, $all_hds);

	if (any { $_->{rebootNeeded} } @{$all_hds->{hds}}) {
	    $in->ask_warn(N("Partitioning"), N("You need to reboot for the partition table modifications to take effect"));
	    tell_wm_and_reboot();
	}
    }
    if (my $part = find { $_->{mntpoint} && !maybeFormatted($_) } fs::get::fstab($all_hds)) {
	$in->ask_okcancel(N("Warning"), N("You should format partition %s.
Otherwise no entry for mount point %s will be written in fstab.
Quit anyway?", $part->{device}, $part->{mntpoint})) or return if $::isStandalone;
    }
    1;
}

################################################################################
# per-hd actions
################################################################################
sub hd_possible_actions_base {
    my ($hd) = @_;
    (
     if_(!$hd->{readonly} || $hd->{getting_rid_of_readonly_allowed}, N_("Clear all")),
     if_(!$hd->{readonly} && $::isInstall, N_("Auto allocate")),
    );
}

sub hd_possible_actions_extra {
    my ($_hd) = @_;
    $::expert ? N_("Toggle to normal mode") : N_("Toggle to expert mode");
}


sub hd_possible_actions {
    my ($_in, $hd, $_all_hds) = @_;
    hd_possible_actions_base($hd);
    hd_possible_actions_extra($hd);
}

sub hd_possible_actions_interactive {
    my ($_in, $_hd, $_all_hds) = @_;
    &hd_possible_actions, N_("Hard disk drive information");
}

sub Clear_all {
    my ($in, $hd, $all_hds) = @_;
    return if detect_devices::is_xbox(); #- do not let them wipe the OS
    my @parts = partition_table::get_normal_parts($hd);
    foreach (@parts) {
	RemoveFromLVM($in, $hd, $_, $all_hds) if isPartOfLVM($_);
	RemoveFromRAID($in, $hd, $_, $all_hds) if isPartOfRAID($_);
	RemoveFromDm($in, $hd, $_, $all_hds) if $_->{dm_active};
    }
    if (isLVM($hd)) {
	lvm::lv_delete($hd, $_) foreach @parts;
    } else {
	$hd->{readonly} = 0; #- give a way out of readonly-ness. only allowed when getting_rid_of_readonly_allowed
	$hd->{getting_rid_of_readonly_allowed} = 0; #- we don't need this flag anymore
	fsedit::partition_table_clear_and_initialize($all_hds->{lvms}, $hd, $in);
    }
}

sub Auto_allocate {
    my ($in, $hd, $all_hds) = @_;
    my $suggestions = partitions_suggestions($in) or return;

    my %all_hds_ = %$all_hds;
    $all_hds_{hds} = [ sort { $a == $hd ? -1 : 1 } fs::get::hds($all_hds) ];

    eval { fsedit::auto_allocate(\%all_hds_, $suggestions) };
    if ($@) {
	$@ =~ /partition table already full/ or die;

	$in->ask_warn("", [
			   N("All primary partitions are used"),
			   N("I cannot add any more partitions"),
			   N("To have more partitions, please delete one to be able to create an extended partition"),
			  ]);
    }
}

sub More {
    my ($in, $_hd) = @_;

    my $r;
    $in->ask_from(N("More"), '',
	    [
	     { val => N("Reload partition table"), clicked_may_quit => sub { $r = 'force_reload'; 1 } },
	    ],
    ) && $r;
}

sub Hd_info {
    my ($in, $hd) = @_;
    $in->ask_warn(N("Warning"), [ N("Detailed information"), format_hd_info($hd) ]);
}

################################################################################
# per-part actions
################################################################################

sub part_possible_actions {
    my ($_in, $hd, $part, $all_hds) = @_;
    $part or return;

    my %actions = my @l = (
        N_("View")             => '!isSwap && !isNonMountable && maybeFormatted',
        N_("Mount point")      => '$part->{real_mntpoint} || (!isBusy && !isSwap && !isNonMountable)',
        N_("Type")             => '!isBusy && $::expert && (!readonly || $part->{pt_type} == 0x83)',
        N_("Options")          => '!isSwap($part) && !isNonMountable && $::expert',
        N_("Label")            => '!isNonMountable && $::expert && fs::format::canEditLabel($part)',
        N_("Resize")	       => '!isBusy && !readonly && !isSpecial || isLVM($hd) && LVM_resizable',
        N_("Format")           => '!isBusy && !isRawLVM && !isPartOfLVM && (!readonly && ($::expert || $::isStandalone) || fs::type::isRawLUKS($part))',
        N_("Mount")            => '!isBusy && (hasMntpoint || isSwap) && maybeFormatted && ($::expert || $::isStandalone)',
        N_("Add to RAID")      => '!isBusy && isRawRAID && (!isSpecial || isRAID)',
        N_("Add to LVM")       => '!isBusy && isRawLVM',
        N_("Use")              => '!isBusy && fs::type::isRawLUKS($part) && !$part->{notFormatted}',
        N_("Unmount")          => '!$part->{real_mntpoint} && isMounted',
        N_("Delete")	       => '!isBusy && !readonly',
        N_("Remove from RAID") => 'isPartOfRAID',
        N_("Remove from LVM")  => 'isPartOfLVM',
        N_("Remove from dm")   => '$part->{dm_active}',
        N_("Modify RAID")      => 'canModifyRAID',
        N_("Use for loopback") => '!$part->{real_mntpoint} && isMountableRW && !isSpecial && hasMntpoint && maybeFormatted && $::expert',
    );
    my ($actions_names) = list2kv(@l);
    my $_all_hds = $all_hds; #- help perl_checker know the $all_hds *is* used in the macro below
    my %macros = (
	readonly => '$hd->{readonly}',
        hasMntpoint => '$part->{mntpoint}',
	LVM_resizable => 'member($part->{fs_type}, qw(btrfs ext3 ext4 reiserfs xfs))',
	canModifyRAID => 'isPartOfRAID($part) && !isMounted(fs::get::device2part($part->{raid}, $all_hds->{raids}))',
    );
    if (isEmpty($part)) {
	if_(!$hd->{readonly}, N_("Create"));
    } elsif ($part->{pt_type} == 0xbf && detect_devices::is_xbox()) {
        #- XBox OS partitions, do not allow anything
        return;
    } else {
        grep {
    	    my $cond = $actions{$_};
    	    while (my ($k, $v) = each %macros) {
    	        $cond =~ s/$k/qq(($v))/e;
    	    }
    	    $cond =~ s/(^|[^:\$]) \b ([a-z]\w{3,}) \b ($|[\s&\)])/$1 . $2 . '($part)' . $3/exg;
    	    eval $cond;
        } @$actions_names;
    }
}

sub View {
    my ($in, $_hd, $part, $_all_hds) = @_;
    my $handle = any::inspect($part, $::prefix);
    if ($handle) {
      $in->ask_directory({ 'directory' => $handle->{dir} });
    } else {
      $in->ask_warn(N("Error"), N("Failed to mount partition"));
    }
}

#- in case someone use diskdrake only to create partitions,
#- ie without assigning a mount point,
#- do not suggest mount points anymore
my $do_suggest_mount_point = $::isInstall;

sub Create {
    my ($in, $hd, $part, $all_hds) = @_;
    my ($def_start, $def_size, $max) = ($part->{start}, $part->{size}, $part->{start} + $part->{size});

    $part->{maxsize} = $part->{size}; $part->{size} = 0;
    if (fsedit::suggest_part($part, $all_hds)) {
	$part->{mntpoint} = '' if !$do_suggest_mount_point;
    } else {
	$part->{size} = $part->{maxsize};
	fs::type::suggest_fs_type($part, defaultFS());
    }
    if (isLVM($hd)) {
	lvm::suggest_lv_name($hd, $part);
    }

    #- 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_name = fs::type::part2type_name($part);
    my $mb_size = to_Mb($part->{size});
    my $has_startsector = ($::expert || arch() !~ /i.86/) && !isLVM($hd);
    my $use_dmcrypt;
    my $requested_type;

    $in->ask_from(N("Create a new partition"), '',
        [
         { label => N("Create a new partition"), title => 1 },
           if_($has_startsector,
         { label => N("Start sector: "), val => \$part->{start}, min => $def_start, max => ($max - min_partition_size($hd)),
	   type => 'range', SpinButton => $::expert, changed => sub { $mb_size = min($mb_size, to_Mb($max - $part->{start})) } },
           ),
         { label => N("Size in MB: "), val => \$mb_size, min => to_Mb(min_partition_size($hd)), max => to_Mb($def_size),
	   type => 'range', SpinButton => $::expert, changed => sub { $part->{start} = min($part->{start}, $max - $mb_size * 2048) } },
         { label => N("Filesystem type: "), val => \$type_name, list => [ fs::type::type_names($::expert, $hd) ],
	   sort => 0, if_($::expert, gtk => { wrap_width => 2 }, do_not_ellipsize => 1) },
         { label => N("Mount point: "), val => \$part->{mntpoint}, list => [ fsedit::suggestions_mntpoint($all_hds), '' ],
           disabled => sub { my $p = fs::type::type_name2subpart($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") ] },
           ),
	   if_(isLVM($hd),
	 { label => N("Logical volume name "), val => \$part->{lv_name}, list => [ qw(root swap usr home var), '' ], sort => 0, not_edit => 0 },
           ),
        { label => N("Encrypt partition"), type => 'bool', val => \$use_dmcrypt, disabled => sub { $part->{mntpoint} eq "/boot" } },
	 { label => N("Encryption key "), val => \$part->{dmcrypt_key}, disabled => sub { !$use_dmcrypt }, hidden => 1, weakness_check => 1 },
	 { label => N("Encryption key (again)"), val => \$part->{dmcrypt_key2}, disabled => sub { !$use_dmcrypt }, hidden => 1 },
        ], 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
	    $do_suggest_mount_point = 0 if !$part->{mntpoint};
	    put_in_hash($part, fs::type::type_name2subpart($type_name));
	    $part->{mntpoint} = '' if isNonMountable($part);
	    $part->{mntpoint} = 'swap' if isSwap($part);
	    fs::mount_options::set_default($part, ignore_is_removable => 1);

	    # if user asked to encrypt the partition, use dm-crypt and create requested fs inside
	    if ($use_dmcrypt) {
		my $err;
		$err = N("The encryption keys do not match") unless $part->{dmcrypt_key} eq $part->{dmcrypt_key2};
		$err = N("Missing encryption key") unless $part->{dmcrypt_key};
		if ($err) {
		    $in->ask_warn(N("Error"), $err);
		    return 1;
	        }
		$requested_type = $type_name;
		$type_name = 'Encrypted';
	    }

	    put_in_hash($part, fs::type::type_name2subpart($type_name));
	    check($in, $hd, $part, $all_hds) or return 1;
	    $migrate_files = need_migration($in, $part->{mntpoint}) or return 1;

	    my $seen;
	    eval {
		catch_cdie { fsedit::add($hd, $part, $all_hds, { force => 1, primaryOrExtended => $primaryOrExtended }) }
		  sub { $seen = 1; $in->ask_okcancel('', formatError($@)) };
	    };
	    if (my $err = $@) {
		if ($err =~ /raw_add/ && $hd->hasExtended && !$hd->{primary}{extended}) {
		    $in->ask_warn(N("Error"), N("You cannot create a new partition
(since you reached the maximal number of primary partitions).
First remove a primary partition and create an extended partition."));
		    return 0;
		} else {
		    $in->ask_warn(N("Error"), formatError($err)) if !$seen;
		    return 1;
		}
	    }
	    0;
	},
    ) or return;

    if ($use_dmcrypt) {
	write_partitions($in, $hd) or return;
	# Initialize it and format it
	dmcrypt_format($in, $hd, $part, $all_hds);
	my $p = find { $part->{dm_name} eq $_->{dmcrypt_name} } @{$all_hds->{dmcrypts}};
	my $p2 = fs::type::type_name2subpart($requested_type);
        $p->{fs_type} = $p2->{fs_type};
	$p->{type_name} = $requested_type;
	$p->{mntpoint} = $part->{mntpoint};
	$part->{mntpoint} = '';
	if ($::isStandalone) {
	    fs::format::check_package_is_installed_format($in->do_pkgs, $p->{fs_type}) or log::l("Missing package");
	}
	if ($::expert && !member($p->{fs_type}, 'reiserfs', 'reiser4', 'xfs', 'hfs', 'ntfs', 'ntfs-3g')) {
	    $p->{toFormatCheck} = $in->ask_yesorno(N("Confirmation"), N("Check for bad blocks?"));
	}
	$p->{isFormatted} = 0; #- force format;
	# Wait for the newly created device to appear before formatting it
	my ($_w, $wait_message) = $in->wait_message_with_progress_bar;
	fs::format::part($all_hds, $p, $wait_message) unless isRawLVM($p);
    }

    warn_if_renumbered($in, $hd);

    if ($migrate_files eq 'migrate') {
        # FIXME check encrypt case
	format_($in, $hd, $part, $all_hds) or return;
	migrate_files($in, $hd, $part);
	fs::mount::part($part);
    }
}

sub Delete {
    my ($in, $hd, $part, $all_hds) = @_;
    if (fs::type::isLUKS($part)) {
	my $p = find { $_->{dm_name} eq $part->{dmcrypt_name} } partition_table::get_normal_parts($hd);
	RemoveFromDm($in, $hd, $p, $all_hds);
	$part = $p;
    }
    if (isRAID($part)) {
	raid::delete($all_hds->{raids}, $part);
    } elsif (isLVM($hd)) {
	lvm::lv_delete($hd, $part);
    } elsif (isLoopback($part)) {
	my $f = "$part->{loopback_device}{mntpoint}$part->{loopback_file}";
	if (-e $f && $in->ask_yesorno(N("Warning"), N("Remove the loopback file?"))) {
	    unlink $f;
	}
	my $l = $part->{loopback_device}{loopback};
	@$l = grep { $_ != $part } @$l;
	delete $part->{loopback_device}{loopback} if @$l == 0;
	fsedit::recompute_loopbacks($all_hds);
    } else {
	if (arch() =~ /ppc/) {
	    undef $partition_table::mac::bootstrap_part if isAppleBootstrap($part) && ($part->{device} = $partition_table::mac::bootstrap_part);
	}
	partition_table::remove($hd, $part);
	warn_if_renumbered($in, $hd);
    }
}

sub Type {
    my ($in, $hd, $part) = @_;

    my $warned;
    my $warn = sub {
	$warned = 1;
	if (maybeFormatted($part)) {
	    ask_alldatawillbelost($in, $part, N_("After changing type of partition %s, all data on this partition will be lost"));
	} else {
	    1;
	}
    };

    #- for ext2/ext3, warn after choosing as ext2->ext3 and ext*->ext4 can be achieved without loosing any data :)
    member($part->{fs_type}, qw(ext2 ext3)) || $part->{fs_type} =~ /ntfs/ or $warn->() or return;

    my @types = fs::type::type_names($::expert, $hd);

    #- when readonly, Type() is allowed only when changing {fs_type} but not {pt_type}
    #- eg: switching between ext2, ext3, ext4, reiserfs...
    @types = grep { fs::type::type_name2pt_type($_) == $part->{pt_type} } @types if $hd->{readonly};

    my $type_name = fs::type::part2type_name($part);
    $in->ask_from_({ title => N("Change partition type") },
		  [
		   { label => N("Which filesystem do you want?"), title => 1 },
		   { label => N("Type"), val => \$type_name, type => 'list', list => \@types, sort => 1, do_not_ellipsize => 1,
		     focus => sub { 1 }, not_edit => 1, gtk => { wrap_width => 2 } } ]) or return;

    my $type = $type_name && fs::type::type_name2subpart($type_name);

    if ($part->{fs_type} eq 'ext2' && $type->{fs_type} eq 'ext3') {
	my $_w = $in->wait_message(N("Please wait"), N("Switching from %s to %s", 'ext2', $type->{fs_type}));
	if (run_program::run("tune2fs", "-j", devices::make($part->{device}))) {
	    put_in_hash($part, $type);
	    set_isFormatted($part, 1); #- assume that if tune2fs works, partition is formatted

	    #- disable the fsck (do not do it together with -j in case -j fails?)
	    fs::format::disable_forced_fsck($part->{device});
	    return;
	}
    } elsif (member($part->{fs_type}, qw(ext2 ext3)) && $type->{fs_type} eq 'ext4') {
	# FIXME enable some nice flags
	put_in_hash($part, $type);
	return;
    } elsif ($type->{fs_type} =~ /ntfs/ && $part->{fs_type} =~ /ntfs/) {
	if ($type->{fs_type} eq 'ntfs-3g') {
	    local $::prefix = ''; # For draklive-install
	    $in->do_pkgs->ensure_binary_is_installed('ntfs-3g', 'mount.ntfs-3g') or return;
	}
	put_in_hash($part, $type);
	return;
    }
    #- either we switch to non-ext3 or switching losslessly to ext3 failed
    $warned or $warn->() or return;

    if (defined $type) {
	check_type($in, $type, $hd, $part) and fsedit::change_type($type, $hd, $part);
    }
}

sub Label {
    my ($in, $hd, $part) = @_;
    my $new_label = $part->{device_LABEL} || "";

    write_partitions($in, $hd) or return;

    $in->ask_from(N("Set volume label"),
                  maybeFormatted($part) ? 
                    N("Beware, this will be written to disk as soon as you validate!")
                    : N("Beware, this will be written to disk only after formatting!"),
                  [
		   { label => N("Which volume label?"), title => 1 },
		   { label => N("Label:"), val => \$new_label } ]) or return;

    fs::format::check_package_is_installed_label($in->do_pkgs, $part->{fs_type}) or return;
    $part->{prefer_device_LABEL} = to_bool($part->{device_LABEL}) && !isLVM($part);
    return if $new_label eq $part->{device_LABEL};
    $part->{device_LABEL} = $new_label;
    $part->{device_LABEL_changed} = 1;
    fs::format::clean_label($part);
    fs::format::write_label($part);
}

sub Mount_point {
    my ($in, $hd, $part, $all_hds) = @_;

    my $migrate_files;
    my $mntpoint = $part->{mntpoint} || do {
	my $part_ = { %$part };
	if (fsedit::suggest_part($part_, $all_hds)) {
	    fs::get::has_mntpoint('/', $all_hds) || $part_->{mntpoint} eq '/boot' ? $part_->{mntpoint} : '/';
	} else { '' }
    };
    my $msg = isLoopback($part) ? N("Where do you want to mount the loopback file %s?", $part->{loopback_file}) :
			    N("Where do you want to mount device %s?", $part->{device});
    $in->ask_from_({
		     callbacks => {
		         complete => sub {
	    !isPartOfLoopback($part) || $mntpoint or $in->ask_warn(N("Error"),
N("Cannot unset mount point as this partition is used for loop back.
Remove the loopback first")), return 1;
	    $part->{mntpoint} eq $mntpoint || check_mntpoint($in, $mntpoint, $part, $all_hds) or return 1;
    	    $migrate_files = need_migration($in, $mntpoint) or return 1;
	    0;
	} },
	},
	[
	  { label => $msg, title => 1 },
	  { label => N("Mount point"), val => \$mntpoint,
	    list => [ uniq(if_($mntpoint, $mntpoint), fsedit::suggestions_mntpoint($all_hds), '') ],
	    focus => sub { 1 },
	    not_edit => 0 } ],
    ) or return;
    $part->{mntpoint} = $mntpoint;

    if ($migrate_files eq 'migrate') {
	format_($in, $hd, $part, $all_hds) or return;
	migrate_files($in, $hd, $part);
	fs::mount::part($part);
    }
}
sub Mount_point_raw_hd {
    my ($in, $part, $all_hds, @propositions) = @_;

    my $mntpoint = $part->{mntpoint} || shift @propositions;
    $in->ask_from(
        N("Mount point"),
        '',
	[
	 { label => N("Where do you want to mount %s?", $part->{device}), title => 1 },
	 { label => N("Mount point"), val => \$mntpoint,
	    list => [ if_($mntpoint, $mntpoint), '', @propositions ],
	    not_edit => 0 } ],
	complete => sub {
	    $part->{mntpoint} eq $mntpoint || check_mntpoint($in, $mntpoint, $part, $all_hds) or return 1;
	    0;
	}
    ) or return;
    $part->{mntpoint} = $mntpoint;
}

sub Resize {
    my ($in, $hd, $part) = @_;
    my (%nice_resize);
    my $low_part = $part;

    if (isLUKS($part)) {
	$low_part = find { $_->{dm_name} eq $part->{dmcrypt_name} } partition_table::get_normal_parts($hd);
    }

    my ($min, $max) = (min_partition_size($hd), max_partition_resize($hd, $low_part));

    if (maybeFormatted($part)) {
	# here we may have a non-formatted or a formatted partition
	# -> doing as if it was formatted

	if ($part->{fs_type} eq 'vfat') {
	    write_partitions($in, $hd) or return;
	    #- try to resize without losing data
	    my $_w = $in->wait_message(N("Resizing"), N("Computing FAT filesystem bounds"));

	    require resize_fat::main;
	    $nice_resize{fat} = resize_fat::main->new($part->{device}, devices::make($part->{device}));
	    $min = max($min, $nice_resize{fat}->min_size);
	    $max = min($max, $nice_resize{fat}->max_size);
	} elsif (member($part->{fs_type}, qw(ext2 ext3 ext4))) {
	    write_partitions($in, $hd) or return;
	    require diskdrake::resize_ext2;
	    if ($nice_resize{ext2} = diskdrake::resize_ext2->new($part->{device}, devices::make($part->{device}))) {
		$min = max($min, $nice_resize{ext2}->min_size);
	    } else {
		delete $nice_resize{ext2};
	    }
	} elsif ($part->{fs_type} =~ /ntfs/) {
	    write_partitions($in, $hd) or return;
	    require diskdrake::resize_ntfs;
	    diskdrake::resize_ntfs::check_prog($in) or return;
	    $nice_resize{ntfs} = diskdrake::resize_ntfs->new($part->{device}, devices::make($part->{device}));
	    $min = $nice_resize{ntfs}->min_size or delete $nice_resize{ntfs};
	} elsif ($part->{fs_type} eq 'reiserfs') {
	    write_partitions($in, $hd) or return;
	    if ($part->{isMounted}) {
		$nice_resize{reiserfs} = 1;
		$min = $part->{size}; #- ensure the user can only increase
	    } elsif (defined(my $free = fs::df($part))) {
		$nice_resize{reiserfs} = 1;
		$min = max($min, $part->{size} - $free);
	    }
	} elsif ($part->{fs_type} eq 'xfs' && isLVM($hd) && $::isStandalone && $part->{isMounted}) {
	    $min = $part->{size}; #- ensure the user can only increase
	    $nice_resize{xfs} = 1;
	} elsif ($part->{fs_type} eq 'btrfs') {
	    write_partitions($in, $hd) or return;
	    if (defined(my $free = fs::df($part))) {
	        $nice_resize{btrfs} = 1;
		$min = max($min, $part->{size} - $free);
	    }
	}
	#- make sure that even after normalizing the size to cylinder boundaries, the minimun will be saved,
	#- this save at least a cylinder (less than 8Mb).
	$min += partition_table::raw::cylinder_size($hd);
	$min >= $max and return $in->ask_warn(N("Warning"), N("This partition is not resizeable"));

	#- for these, we have tools to resize partition table
	#- without losing data (or at least we hope so :-)
	if (%nice_resize) {
	    ask_alldatamaybelost($in, $part, N_("All data on this partition should be backed up")) or return;
	} else {
	    ask_alldatawillbelost($in, $part, N_("After resizing partition %s, all data on this partition will be lost")) or return;
	}
    }

    my $mb_size = to_Mb($part->{size});
    my ($gmin, $gmax) = (to_Mb($min), to_Mb($max));
    $in->ask_from(N("Resize"), '', [
		   { label => N("Choose the new size"), title => 1 },
		   { label => N("New size in MB: "), val => \$mb_size, min => $gmin, max => $gmax, type => 'range', SpinButton => $::expert },
		   { label => N("Minimum size: %s MB", $gmin) },
		   { label => N("Maximum size: %s MB", $gmax) },
		]) or return;


    my $size = from_Mb($mb_size, $min, $max);
    $part->{size} == $size and return;

    my $oldsize = $part->{size};
    $low_part->{size} = $part->{size} = $size;
    $hd->adjustEnd($low_part);

    undef $@;
    my $_b = before_leaving { $@ and $part->{size} = $oldsize };

    my $adjust = sub {
	my ($write_partitions) = @_;

	if (isLVM($hd)) {
	    lvm::lv_resize($low_part, $oldsize);
	} else {
	    if ($write_partitions && isLUKS($part)) {
		run_program::run('cryptsetup', 'luksClose', $part->{dmcrypt_name}) or die("Failed to resize partition, maybe it is mounted");
	    }
	    partition_table::will_tell_kernel($hd, resize => $low_part);
	    partition_table::adjust_local_extended($hd, $low_part);
	    partition_table::adjust_main_extended($hd);
	    write_partitions($in, $hd) or return if $write_partitions && %nice_resize;
	    if ($write_partitions && isLUKS($part)) {
		fs::dmcrypt::open_part([], $low_part);
	    }
	}
	1;
    };

    $adjust->(1) or return if $size > $oldsize;

    my $wait = $in->wait_message(N("Please wait"), N("Resizing"));

    if ($nice_resize{fat}) {
	local *log::l = sub { $wait->set(join(' ', @_)) };
	$nice_resize{fat}->resize($part->{size});
    } elsif ($nice_resize{ext2}) {
	$nice_resize{ext2}->resize($part->{size});
    } elsif ($nice_resize{ntfs}) {
	log::l("ntfs resize to $part->{size} sectors");
	$nice_resize{ntfs}->resize($part->{size});
	$wait = undef;
	$in->ask_warn(N("Warning"), N("To ensure data integrity after resizing the partition(s),
filesystem checks will be run on your next boot into Microsoft Windows®"));
    } elsif ($nice_resize{reiserfs}) {
	log::l("reiser resize to $part->{size} sectors");
	run_program::run_or_die('resize_reiserfs', '-f', '-q', '-s' . int($part->{size}/2) . 'K', devices::make($part->{device}));
    } elsif ($nice_resize{xfs}) {
	#- happens only with mounted LVM, see above
	run_program::run_or_die("xfs_growfs", $part->{mntpoint});
    } elsif ($nice_resize{btrfs}) {
        my $dir = "/tmp/tmp_resize_btrfs.$$";
	if ($part->{isMounted}) {
	    $dir = ($::prefix || '') . $part->{mntpoint};
	} else {
	    mkdir_p($dir);
	    fs::mount::mount(devices::make($part->{device}), $dir, $part->{fs_type});
	}
	if (!run_program::run("btrfsctl", "-r", $part->{size}*512, $dir)) {
	    $nice_resize{btrfs} = undef;
	    if (!$part->{isMounted}) {
		fs::mount::umount($dir);
		unlink($dir);
	    }
        }
    } elsif ($nice_resize{nilfs}) {
	run_program::run_or_die("nilfs-resize", $part->{mntpoint});
    }

    if (%nice_resize) {
	set_isFormatted($part, 1);
    } else {
	set_isFormatted($part, 0);
	partition_table::verifyParts($hd) if !isLVM($hd);
	$part->{mntpoint} = '' if isNonMountable($part); #- mainly for ntfs, which we cannot format
    }

    $adjust->(0) if $size < $oldsize;
}

sub Format {
    my ($in, $hd, $part, $all_hds) = @_;
    format_($in, $hd, $part, $all_hds);
}
sub Mount {
    my ($in, $hd, $part) = @_;

    ensure_we_have_encrypt_key_if_needed($in, $part) or return;
    write_partitions($in, $hd) or return;

    my $w;
    fs::mount::part($part, 0, sub {
        	my ($msg) = @_;
        	$w ||= $in->wait_message(N("Please wait"), $msg);
        	$w->set($msg);
    });
}

sub dmcrypt_open {
    my ($in, $_hd, $part, $all_hds) = @_;
    $part->{dm_name} ||= do {
	my $s = $part->{device};
	$s =~ s/[^\w]/_/g;
	"crypt_$s";
    };

    if (!$part->{dmcrypt_key}) {
	$in->ask_from_({
	    title => N("Filesystem encryption key"),
	    messages => N("Enter your filesystem encryption key"),
        }, [ { label => N("Encryption key"), val => \$part->{dmcrypt_key},
	       hidden => 1, focus => sub { 1 } } ]) or return;
    }

    eval { fs::dmcrypt::open_part($all_hds->{dmcrypts}, $part) };
    if ($@) {
	delete $part->{dmcrypt_key};
	die(($? >> 8) == 255 ? N("Invalid key") : $@);
    }
}

sub Add2RAID {
    my ($in, $_hd, $part, $all_hds) = @_;
    my $raids = $all_hds->{raids};

    my $md_part = $in->ask_from_listf(N("Add to RAID"), N("Choose an existing RAID to add to"),
				      sub { ref($_[0]) ? $_[0]{device} : $_[0] },
				      [ @$raids, N_("new") ]) or return;

    if (ref($md_part)) {
	raid::add($md_part, $part);
	raid::write_conf($raids) if $::isStandalone;
    } else {