add mes5-2.6.33 branch

author: Antoine Ginies <aginies@mandriva.com> 2011-01-19 10:44:49 +0000
committer: Antoine Ginies <aginies@mandriva.com> 2011-01-19 10:44:49 +0000
commit: 530a16ec071db0e24e6e949e265a96848864967c (patch)
tree: fe40cacd28d67b98186754c551b7fd339ebc7e17 /perl-install/diskdrake
download: drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar
drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.gz
drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.bz2
drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.xz
drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.zip
8 files changed, 2505 insertions, 0 deletions
diff --git a/perl-install/diskdrake/dav.pm b/perl-install/diskdrake/dav.pm
new file mode 100644
index 000000000..a358c987a
--- /dev/null
+++ b/perl-install/diskdrake/dav.pm
@@ -0,0 +1,115 @@
+package diskdrake::dav; # $Id: dav.pm 215411 2007-04-25 12:26:16Z pixel $
+
+use diagnostics;
+use strict;
+use diskdrake::interactive;
+use common;
+
+sub main {
+    my ($in, $all_hds) = @_;
+    my $davs = $all_hds->{davs};
+
+    $in->do_pkgs->ensure_binary_is_installed('davfs2', 'mount.davfs2') or return;
+    
+    my $quit;
+    do {
+	$in->ask_from_({ ok => '', messages => formatAlaTeX(
+N("WebDAV is a protocol that allows you to mount a web server's directory
+locally, and treat it like a local filesystem (provided the web server is
+configured as a WebDAV server). If you would like to add WebDAV mount
+points, select \"New\".")) },
+		       [ 
+			(map { 
+			    my $dav = $_;
+			    { label => $dav->{device}, val => $dav->{mntpoint}, clicked_may_quit => sub { config($in, $dav, $all_hds); 1 } } } @$davs),
+			 { val => N("New"), clicked_may_quit => sub { create($in, $all_hds); 1 } },
+			 { val => N("Quit"), clicked_may_quit => sub { $quit = 1 } },
+		       ]);
+    } until $quit;
+
+    diskdrake::interactive::Done($in, $all_hds);
+}
+
+sub create {
+    my ($in, $all_hds) = @_;
+
+    my $dav = { fs_type => 'davfs2' };
+    ask_server($in, $dav, $all_hds) or return;
+    push @{$all_hds->{davs}}, $dav;
+    config($in, $dav, $all_hds);
+}
+
+sub config {
+    my ($in, $dav_, $all_hds) = @_;
+
+    my $dav = { %$dav_ }; #- working on a local copy so that "Cancel" works
+
+    my $action;
+    while ($action ne 'Done') {
+	my %actions = my @actions = actions($dav);
+	$action = $in->ask_from_list_('', format_dav_info($dav), 
+					 [ map { $_->[0] } group_by2 @actions ], 'Done') or return;
+	$actions{$action}->($in, $dav, $all_hds);    
+    }
+    %$dav_ = %$dav; #- applying
+}
+
+sub actions {
+    my ($dav) = @_;
+
+    (
+     if_($dav && $dav->{isMounted}, N_("Unmount") => sub { try('Unmount', @_) }),
+     if_($dav && $dav->{mntpoint} && !$dav->{isMounted}, N_("Mount") => sub { try('Mount', @_) }),
+     N_("Server") => \&ask_server,
+     N_("Mount point") => \&mount_point,
+     N_("Options") => \&options,
+     N_("Done") => sub {},
+    );
+}
+
+sub try {
+    my ($name, $in, $dav) = @_;
+    my $f = $diskdrake::interactive::{$name} or die "unknown function $name";
+    eval { $f->($in, {}, $dav) };
+    if (my $err = $@) {
+	$in->ask_warn(N("Error"), formatError($err));
+    }
+}
+
+sub ask_server {
+    my ($in, $dav, $_all_hds) = @_;
+
+    my $server = $dav->{device};
+    $in->ask_from_({ messages => N("Please enter the WebDAV server URL"),
+		     focus_first => 1,
+		     callbacks => {
+		         complete => sub {
+			     $server =~ m!https?://! or $in->ask_warn('', N("The URL must begin with http:// or https://")), return 1;
+			     0;
+			 },
+		     } },
+		  [ { val => \$server } ]) or return;
+    $dav->{device} = $server;
+}
+
+sub options {
+    my ($in, $dav, $all_hds) = @_;
+    diskdrake::interactive::Options($in, {}, $dav, $all_hds);
+}
+sub mount_point { 
+    my ($in, $dav, $all_hds) = @_;
+    my $proposition = $dav->{device} =~ /(\w+)/ ? "/mnt/$1" : "/mnt/dav";
+    diskdrake::interactive::Mount_point_raw_hd($in, $dav, $all_hds, $proposition);
+}
+
+sub format_dav_info {
+    my ($dav) = @_;
+
+    my $info = '';
+    $info .= N("Server: ") . "$dav->{device}\n" if $dav->{device};
+    $info .= N("Mount point: ") . "$dav->{mntpoint}\n" if $dav->{mntpoint};
+    $info .= N("Options: %s", $dav->{options}) if $dav->{options};
+    $info;
+}
+
+1;
diff --git a/perl-install/diskdrake/diskdrake.html b/perl-install/diskdrake/diskdrake.html
new file mode 100644
index 000000000..cba732084
--- /dev/null
+++ b/perl-install/diskdrake/diskdrake.html
@@ -0,0 +1,139 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+  <head>
+    <title>DiskDrake</title>
+  </head>
+  <body bgcolor="#ffffff">
+
+<center>
+<table width=80% border=0 cellpadding=10 cellspacing=10>
+<tr>
+<td bgcolor=#ffffff>
+
+    <p>
+    <img src="images/diskdrake1-def.jpg" alt="diskdrake logo" width=400 height=100>
+    <p>  
+
+    <H2>I- What's it?</H2>
+
+      The purpose of the DiskDrake project is to make easier the hard disk
+      partitionning. It is graphical, simple and powerful. The license is
+      the GPL (General Public License).
+      <BR>
+      Different skill levels will be available (newbie, advanced user, expert).
+      <BR>
+      It's written entirely in Perl and Perl/Gtk. It uses resize_fat which is
+      a perl rewrite of the work of Andrew Clausen (libresize).
+      <P>
+      DiskDrake is a project from Mandrakesoft, the company behind the popular
+      <a href="http://www.linux-mandrake.com">Linux-Mandrake</a>
+      operating-system.
+      <P>
+      A <A href="http://www.eatel.net/~john/diskdrake/faq.html">FAQ</A> is in construction.
+
+    <H2>II - What's available now</H2>
+
+    DiskDrake should be usable now...
+
+    it can:
+    <UL>
+	<LI> create partitions
+	<LI> delete partitions
+	<LI> change type of partition
+	<LI> format partitions
+	<LI> assign a mount point (<IMG SRC="/images/updated.gif" ALT="updated"><SMALL>(21/07/99)</SMALL> propose a list
+	of classic mount points and verify the mount point is valid)
+	<LI> mount partitions
+	<LI> resize fat partitions
+	<LI> resize partitions (when not caring loosing its data)
+	<LI> clear partition table
+	<LI> auto allocation (usefull for install)
+	<LI> write fstab
+    </UL>
+
+with nice contextual menu (shortcuts available, but dangerous as all actions are
+available, whereas with the contextual menu these actions are hidden. This will
+change)
+
+    <P><IMG SRC="/images/updated.gif" ALT="updated"><SMALL>(25/07/99)</SMALL> 
+    A new Expert button appear now. It toggles between
+    expert and normal mode. Some changes in information displayed:
+    <UL>
+       <LI> when you click (or focus) the drive tab (eg: hda), you get
+       information about your drive: size, geometry
+       (cylinders/sectors/heads number), type (eg: IBM DDRS-39130D), and bus/id.
+       In normal mode you have only the size.
+       <LI> the windows drive letter (eg: C: D: ...)
+       <LI> the `start sector' information from normal mode, it still appears in
+       expert mode
+       <LI> the start&end cylinder of each partition is now displayed in expert
+       mode
+       <LI> the type is displayed numerically in expert mode
+    </UL>
+
+    <P><IMG SRC="/images/updated.gif" ALT="updated"><SMALL>(25/07/99)</SMALL>
+    The mount point in the `Create' window and `Change type' window is now a
+    combo box. It lets you choose between classical mount points (/ /usr /var
+    ...) but with already allocated mount points removed.
+
+    <H2>III - Actual developpment</H2>
+
+    We need people!!!
+
+    <UL>
+      <LI><B>Tests</B> and remove bugs (no known yet :)
+      <LI>integrate ext2resize (which has been release in version 1.0.0 <IMG
+      SRC="/images/updated.gif" ALT="updated"><SMALL>(26/07/99)</SMALL>)
+      <LI>add possibility to move partition without loosing data (by copying all
+      data) <IMG SRC="/images/updated.gif" ALT="updated">
+      <LI>Improve the look
+      <LI>Add a text-only version
+      <LI>Help text, tutorial...
+      <LI>Internationalization
+      <LI>Add some features...
+      <LI>Packaging (rpm, deb, slp...)
+    </UL>
+	
+    <H2>IV- ScreenShot</H2>
+
+    Warning: features was the main focus, so don't be too hard :)
+
+    <P>
+      <CENTER><IMG SRC="1.gif"></IMG></CENTER>
+      <CENTER>DiskDrake main interface</CENTER>      
+      
+      <BR>
+      <CENTER><IMG SRC="3.gif"></IMG></CENTER>
+      <CENTER>create dialog box</CENTER>      
+      
+    <H2>V - Contacts</H2>
+    
+    A Mailing List has been created to allow developpers to discuss about DiskDrake.<BR>
+
+    <P>
+    Send a mail to: <A HREF="mailto:sympa@linux-mandrake.com">sympa@linux-mandrake.com</A>
+
+    <BR>Put in the subject: subscribe diskdrake
+    <BR>When you're subscribed, send your messages to: <A HREF="mailto:diskdrake@linux-mandrake.com">diskdrake@linux-mandrake.com</A>
+
+    <P>Otherwise you can contact directly the <A HREF="mailto:pixel@linux-mandrake.com">project leader</A>.
+
+    <H2>VI - Download</H2>
+    
+    Warning: You must have <a href="http://www.perl.com/CPAN/modules/by-module/Gtk/Gtk-Perl-0.5121.tar.gz">Gtk-Perl</a>.
+    You can get the rpm from the <a href="http://linux-mandrake.com/cooker/">Cooker</a> distribution.
+   
+    <P>You also need perl version 5.00503 or better
+
+    <P> Here you can find the plain tgz or a rpm:
+    <a href="ftp://ftp.phys.ttu.edu/pub/mandrake-devel/contrib/others/diskdrake/">diskdrake</a> (Other mirrors in <a href="http://linux-mandrake.com/cooker/">Cooker</a>)
+
+</td>
+</tr>
+</table>
+<p>
+<a href="/en/fpowerpack.php3"><img src="/images/mandrake6.0-loop.gif" width=468 height=60 alt="Mandrake 6.0 PowerPack"></a>
+</center>    
+  </body>
+  <address><a href="mailto:pixel@linux-mandrake.com"></a></address>
+</html>
diff --git a/perl-install/diskdrake/hd_gtk.pm b/perl-install/diskdrake/hd_gtk.pm
new file mode 100644
index 000000000..4568448c6
--- /dev/null
+++ b/perl-install/diskdrake/hd_gtk.pm
@@ -0,0 +1,450 @@
+package diskdrake::hd_gtk; # $Id: hd_gtk.pm 257107 2009-04-27 15:25:10Z pterjan $
+
+use diagnostics;
+use strict;
+
+use common;
+use mygtk2 qw(gtknew);
+use ugtk2 qw(:helpers :wrappers :create);
+use partition_table;
+use fs::type;
+use detect_devices;
+use diskdrake::interactive;
+use run_program;
+use devices;
+use log;
+use fsedit;
+use feature qw(state);
+
+my ($width, $height, $minwidth) = (400, 50, 5);
+my ($all_hds, $in, $do_force_reload, $current_kind, $current_entry, $update_all);
+my ($w, @notebook, $done_button);
+
+=begin
+
+
+=head1 SYNOPSYS
+
+struct {
+  string name      # which is displayed in tab of the notebook
+  bool no_auto     # wether the kind can disappear after creation
+  string type      # one of { 'hd', 'raid', 'lvm', 'loopback', 'removable', 'nfs', 'smb' }
+  hd | hd_lvm | part_raid[] | part_dmcrypt[] | part_loopback[] | raw_hd[]  val
+
+  # 
+  widget main_box
+  widget display_box
+  widget action_box
+  widget info_box
+} current_kind
+
+part current_entry
+
+notebook current_kind[]
+
+=cut
+
+sub main {
+    ($in, $all_hds, $do_force_reload) = @_;
+
+    @notebook = ();
+
+    local $in->{grab} = 1;
+
+    $w = ugtk2->new(N("Partitioning"));
+    $::main_window = $w->{real_window} if !$::isEmbedded && !$::isInstall;
+    my $rc = "/usr/share/libDrakX/diskdrake.rc";
+    -r $rc or $rc = dirname(__FILE__) . "/../diskdrake.rc";
+    -r $rc or $rc = dirname(__FILE__) . "/../share/diskdrake.rc";
+    Gtk2::Rc->parse($rc);
+
+    # TODO
+#    is_empty_array_ref($all_hds->{raids}) or raid::stopAll;
+#    updateLoopback();
+
+    gtkadd($w->{window},
+	   gtkpack_(Gtk2::VBox->new(0,7),
+		    0, gtknew(($::isInstall ? ('Title1', 'label') : ('Label_Left', 'text'))
+                                => N("Click on a partition, choose a filesystem type then choose an action"),
+                              # workaround infamous 6 years old gnome bug #101968:
+                              width => mygtk2::get_label_width()
+                            ),
+		    1, (my $notebook_widget = Gtk2::Notebook->new),
+		    0, (my $per_kind_action_box = gtknew('HButtonBox', layout => 'edge')),
+		    0, (my $per_kind_action_box2 = gtknew('HButtonBox', layout => 'end')),
+		    0, Gtk2::HSeparator->new,
+		    0, (my $general_action_box  = gtknew('HBox', spacing => 5)),
+		   ),
+	  );
+    my ($lock, $initializing) = (undef, 1);
+    $update_all = sub {
+	state $not_first;
+	return if $initializing && $not_first;
+	$not_first = 1;
+	$lock and return;
+	$lock = 1;
+	partition_table::assign_device_numbers($_) foreach fs::get::hds($all_hds);
+	create_automatic_notebooks($notebook_widget);
+	general_action_box($general_action_box);
+	per_kind_action_box($per_kind_action_box, $per_kind_action_box2, $current_kind);
+	current_kind_changed($in, $current_kind);
+	current_entry_changed($current_kind, $current_entry);
+	$lock = 0;
+    };
+    create_automatic_notebooks($notebook_widget);
+
+    $notebook_widget->signal_connect(switch_page => sub {
+	$current_kind = $notebook[$_[2]];
+	$current_entry = '';
+	$update_all->();
+    });
+    # ensure partitions bar is properlyz size on first display:
+    $notebook_widget->signal_connect(realize => $update_all);
+    $w->sync;
+    $done_button->grab_focus;
+    $in->ask_from_list_(N("Read carefully"), N("Please make a backup of your data first"), 
+			[ N_("Exit"), N_("Continue") ], N_("Continue")) eq N_("Continue") or return
+      if $::isStandalone;
+
+    undef $initializing;
+    $w->main;
+}
+
+sub try {
+    my ($name, @args) = @_;
+    my $f = $diskdrake::interactive::{$name} or die "unknown function $name";
+    try_($name, \&$f, @args);
+}
+sub try_ {
+    my ($name, $f, @args) = @_;
+
+    my $v = eval { $f->($in, @args, $all_hds) };
+    if (my $err = $@) {
+	$in->ask_warn(N("Error"), formatError($err));
+    }
+    if ($v eq 'force_reload') {	
+	$all_hds = $do_force_reload->();
+    }
+
+    $current_entry = '' if !diskdrake::interactive::is_part_existing($current_entry, $all_hds);
+    $update_all->();
+
+    Gtk2->main_quit if $v && member($name, 'Done');
+}
+
+sub get_action_box_size() {
+    $::isStandalone ? 200 : 150, $::isEmbedded ? 150 : 180;
+}
+
+################################################################################
+# generic: helpers
+################################################################################
+sub add_kind2notebook {
+    my ($notebook_widget, $kind) = @_;
+    die if $kind->{main_box};
+
+    $kind->{display_box} = gtkset_size_request(Gtk2::HBox->new(0,0), $width, $height);
+    $kind->{action_box} = gtkset_size_request(Gtk2::VBox->new(), get_action_box_size());
+    $kind->{info_box} = Gtk2::VBox->new(0,0);
+    my $box =
+      gtkpack_(Gtk2::VBox->new(0,7),
+	       0, $kind->{display_box},
+	       0, filesystems_button_box(),
+	       1, $kind->{info_box});
+    $kind->{main_box} = gtknew('HBox', spacing => 5, children => [
+        1, $box,
+        0, $kind->{action_box},
+    ]);
+    ugtk2::add2notebook($notebook_widget, $kind->{name}, $kind->{main_box});
+    push @notebook, $kind;
+    $kind;
+}
+
+sub interactive_help() {
+    if ($::isInstall) {
+        my $func = $in->interactive_help_sub_display_id('diskdrake');
+        $func and $func->();
+    } else {
+        require run_program;
+        run_program::raw({ detach => 1 }, 'drakhelp', '--id', 'diskdrake');
+    }
+}
+
+sub general_action_box {
+    my ($box) = @_;
+    $_->destroy foreach $box->get_children;
+
+    my $box_start = gtknew('HButtonBox', layout => 'start', children_tight => [ 
+        gtknew('Install_Button', text => N("Help"), clicked => \&interactive_help)
+    ]);
+
+    my @actions = (
+		   diskdrake::interactive::general_possible_actions($in, $all_hds), 
+		   N_("Done"));
+    my $box_end = gtknew('HButtonBox', layout => 'end', spacing => 5);
+    foreach my $s (@actions) {
+	my $button = Gtk2::Button->new(translate($s));
+	$done_button = $button if $s eq 'Done';
+	gtkadd($box_end, gtksignal_connect($button, clicked => sub { try($s) }));
+    }
+    gtkadd($box, $box_start, $box_end);
+}
+sub per_kind_action_box {
+    my ($box, $box2, $kind) = @_;
+    $_->destroy foreach $box->get_children, $box2->get_children;
+
+    $kind->{type} =~ /hd|lvm/ or return;
+
+    foreach my $s (diskdrake::interactive::hd_possible_actions_base($in, kind2hd($kind), $all_hds)) {
+	gtkadd($box, 
+	       gtksignal_connect(Gtk2::Button->new(translate($s)),
+				 clicked => sub { try($s, kind2hd($kind)) }));
+    }
+    foreach my $s (diskdrake::interactive::hd_possible_actions_extra($in, kind2hd($kind), $all_hds)) {
+	gtkadd($box2, 
+	       gtksignal_connect(Gtk2::Button->new(translate($s)),
+				 clicked => sub { try($s, kind2hd($kind)) }));
+    }
+}
+sub per_entry_action_box {
+    my ($box, $kind, $entry) = @_;
+    $_->destroy foreach $box->get_children;
+
+    if ($entry) {
+	my @buttons = map { 
+	    my $s = $_;
+	    my $w = Gtk2::Button->new(translate($s));
+	    $w->signal_connect(clicked => sub { try($s, kind2hd($kind), $entry) });
+	    $w;
+	} diskdrake::interactive::part_possible_actions($in, kind2hd($kind), $entry, $all_hds);
+
+	gtkadd($box, create_scrolled_window(gtkpack__(Gtk2::VBox->new(), @buttons), undef, 'none')) if @buttons;
+    } else {
+	my $txt = !$::isStandalone && fsedit::is_one_big_fat_or_NT($all_hds->{hds}) ?
+N("You have one big Microsoft Windows partition.
+I suggest you first resize that partition
+(click on it, then click on \"Resize\")") : N("Please click on a partition");
+	gtkpack($box, gtktext_insert(Gtk2::TextView->new, $txt));
+    }
+}
+
+sub per_entry_info_box {
+    my ($box, $kind, $entry) = @_;
+    $_->destroy foreach $box->get_children;
+    my $info;
+    if ($entry) {
+	$info = diskdrake::interactive::format_part_info(kind2hd($kind), $entry);
+    } elsif ($kind->{type} =~ /hd|lvm/) {
+	$info = diskdrake::interactive::format_hd_info($kind->{val});
+    }
+    gtkpack($box, gtkadd(gtkcreate_frame(N("Details")), 
+                         gtknew('HBox', border_width => 5, children_loose => [
+                         gtkset_alignment(gtkset_justify(Gtk2::Label->new($info), 'left'), 0, 0) ])));
+}
+
+sub current_kind_changed {
+    my ($_in, $kind) = @_;
+
+    $_->destroy foreach $kind->{display_box}->get_children;
+
+    my $v = $kind->{val};
+    my @parts = 
+      $kind->{type} eq 'raid' ? grep { $_ } @$v :
+      $kind->{type} eq 'dmcrypt' ? @$v :
+      $kind->{type} eq 'loopback' ? @$v : fs::get::hds_fstab_and_holes($v);
+    my $totalsectors = 
+      $kind->{type} =~ /raid|dmcrypt|loopback/ ? sum(map { $_->{size} } @parts) : $v->{totalsectors};
+    create_buttons4partitions($kind, $totalsectors, @parts);
+}
+
+sub current_entry_changed {
+    my ($kind, $entry) = @_;
+    $current_entry = $entry;
+    if ($kind) {
+	per_entry_action_box($kind->{action_box}, $kind, $entry);
+	per_entry_info_box($kind->{info_box}, $kind, $entry);
+    }
+}
+
+sub create_automatic_notebooks {
+    my ($notebook_widget) = @_;
+
+    $_->{marked} = 0 foreach @notebook;
+    my $may_add = sub {
+	my ($kind) = @_;
+	my @l = grep { $kind->{val} == $_->{val} } @notebook;
+	@l > 1 and log::l("weird: create_automatic_notebooks");
+	$kind = $l[0] || add_kind2notebook($notebook_widget, $kind);
+	$kind->{marked} = 1;
+    };
+    $may_add->(hd2kind($_)) foreach @{$all_hds->{hds}};
+    $may_add->(lvm2kind($_)) foreach @{$all_hds->{lvms}};
+    $may_add->(raid2kind()) if @{$all_hds->{raids}};
+    $may_add->(dmcrypt2kind()) if @{$all_hds->{dmcrypts}};
+    $may_add->(loopback2kind()) if @{$all_hds->{loopbacks}};
+
+    @notebook = grep_index {
+	my $b = $_->{marked} or $notebook_widget->remove_page($::i);
+	$b;
+    } @notebook;
+    @notebook or $in->ask_warn(N("Error"), N("No hard drives found")), $in->exit(1);
+}
+
+################################################################################
+# parts: helpers
+################################################################################
+sub create_buttons4partitions {
+    my ($kind, $totalsectors, @parts) = @_;
+
+    $width = first($w->{window}->window->get_size) - first(get_action_box_size()) - 25 if $w->{window}->window;
+
+    my $ratio = $totalsectors ? ($width - @parts * $minwidth) / $totalsectors : 1;
+    while (1) {
+	my $totalwidth = sum(map { $_->{size} * $ratio + $minwidth } @parts);
+	$totalwidth <= $width and last;
+	$ratio /= $totalwidth / $width * 1.1;
+    }
+
+    my $current_button;
+    my $set_current_button = sub {
+	my ($w) = @_;
+	$current_button->set_active(0) if $current_button;
+	($current_button = $w)->set_active(1);
+    };
+
+    foreach my $entry (@parts) {
+	my $info = $entry->{mntpoint};
+	$info .= "\n" . ($entry->{size} ? formatXiB($entry->{size}, 512) : N("Unknown")) if $info;
+	my $w = Gtk2::ToggleButton->new_with_label($info) or internal_error('new_with_label');
+	$w->signal_connect(clicked => sub { 
+	    $current_button != $w or return;
+	    current_entry_changed($kind, $entry); 
+	    $set_current_button->($w);
+	});
+	$w->signal_connect(key_press_event => sub {
+	    my (undef, $event) = @_;
+	    member('control-mask', @{$event->state}) && $w == $current_button or return; 
+	    my $c = chr $event->keyval;
+
+	    foreach my $s (diskdrake::interactive::part_possible_actions($in, kind2hd($kind), $entry, $all_hds)) {
+		${{
+		    Create => 'c', Delete => 'd', Format => 'f', 
+		    Loopback => 'l', Resize => 'r', Type => 't', 
+		    Mount => 'M', Unmount => 'u', 'Mount point' => 'm',
+		    'Add to LVM' => 'L', 'Remove from LVM' => 'L', 
+		    'Add to RAID' => 'R', 'Remove from RAID' => 'R',
+		}}{$s} eq $c or next;
+
+		try($s, kind2hd($kind), $entry);
+		last;
+	    }
+	});
+	my @colorized_fs_types = qw(ext3 ext4dev xfs swap vfat ntfs ntfs-3g);
+	$w->set_name("PART_" . (isEmpty($entry) ? 'empty' : 
+				$entry->{fs_type} && member($entry->{fs_type}, @colorized_fs_types) ? $entry->{fs_type} :
+				'other'));
+	$w->set_size_request($entry->{size} * $ratio + $minwidth, 0);
+	gtkpack__($kind->{display_box}, $w);
+	if ($current_entry && fsedit::are_same_partitions($current_entry, $entry)) {
+	    $set_current_button->($w);
+	    $w->grab_focus;
+	}
+    }
+}
+
+
+################################################################################
+# disks: helpers
+################################################################################
+sub current_hd() { 
+    $current_kind->{type} =~ /hd|lvm/ or die 'current_hd called but $current_kind is not an hd';
+    $current_kind->{val};
+}
+sub current_part() {
+    current_hd();
+    $current_entry;
+}
+
+sub kind2hd {
+    my ($kind) = @_;
+    $kind->{type} =~ /hd|lvm/ ? $kind->{val} : bless({}, 'partition_table::raw');
+}
+
+sub hd2kind {
+    my ($hd) = @_;
+    { type => 'hd', name => $hd->{device}, val => $hd };
+}
+
+sub filesystems_button_box() {
+    my @types = (N_("Ext3"), N_("XFS"), N_("Swap"), arch() =~ /sparc/ ? N_("SunOS") : arch() eq "ppc" ? N_("HFS") : N_("Windows"),
+		 N_("Other"), N_("Empty"));
+    my %name2fs_type = (Ext3 => 'ext3', Ext4 => 'ext4dev', 'XFS' => 'xfs', Swap => 'swap', Other => 'other', "Windows" => 'vfat', HFS => 'hfs');
+
+    gtkpack(Gtk2::HBox->new(), 
+	    map {
+		  my $t = $name2fs_type{$_};
+                  my $w = gtknew('Button', text => translate($_), widget_name => 'PART_' . ($t || 'empty'),
+                                 tip => N("Filesystem types:"),
+                                 clicked => sub { try_('', \&createOrChangeType, $t, current_hd(), current_part()) });
+		  $w->can_focus(0);
+		  $w;
+	    } @types);
+}
+
+sub createOrChangeType {
+    my ($in, $fs_type, $hd, $part, $all_hds) = @_;
+
+    $part ||= !fs::get::hds_fstab($hd) && 
+              { pt_type => 0, start => 1, size => $hd->{totalsectors} - 1 };
+    $part or return;
+    if ($fs_type eq 'other') {
+        if (isEmpty($part)) {
+            try('Create', $hd, $part);
+        } else {
+            try('Type', $hd, $part);
+        }
+    } elsif (!$fs_type) {
+        if (isEmpty($part)) {
+            $in->ask_warn(N("Warning"), N("This partition is already empty"));
+        } else {
+            try('Delete', $hd, $part);
+        }
+    } elsif (isEmpty($part)) {
+	fs::type::set_fs_type($part, $fs_type);
+	diskdrake::interactive::Create($in, $hd, $part, $all_hds);
+    } else {
+	return if $fs_type eq $part->{fs_type};
+	$in->ask_warn('', isBusy($part) ? N("Use ``Unmount'' first") : N("Use ``%s'' instead (in expert mode)", N("Type")));
+    }
+}
+
+################################################################################
+# lvms: helpers
+################################################################################
+sub lvm2kind {
+    my ($lvm) = @_;
+    { type => 'lvm', name => $lvm->{VG_name}, val => $lvm };
+}
+
+################################################################################
+# raids: helpers
+################################################################################
+sub raid2kind() {
+    { type => 'raid', name => 'raid', val => $all_hds->{raids} };
+}
+
+################################################################################
+# loopbacks: helpers
+################################################################################
+sub dmcrypt2kind() {
+    { type => 'dmcrypt', name => 'dmcrypt', val => $all_hds->{dmcrypts} };
+}
+
+################################################################################
+# loopbacks: helpers
+################################################################################
+sub loopback2kind() {
+    { type => 'loopback', name => 'loopback', val => $all_hds->{loopbacks} };
+}
+
+1;
diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm
new file mode 100644
index 000000000..5c184c9f4
--- /dev/null
+++ b/perl-install/diskdrake/interactive.pm
@@ -0,0 +1,1405 @@
+package diskdrake::interactive; # $Id: interactive.pm 246710 2008-09-26 09:24:08Z pixel $
+
+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
+
+  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
+  
+  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;
+	}
+    }
+    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 /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 place"));
+	    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 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 can not 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_("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',
+        N_("Resize")	       => '!isBusy && !readonly && !isSpecial || isLVM($hd) && LVM_resizable',
+        N_("Format")           => '!isBusy && (!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 => '$part->{fs_type} eq "reiserfs" || (isMounted ? $part->{fs_type} eq "xfs" : member($part->{fs_type}, qw(ext3 ext4dev)))',
+	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;
+    }
+}
+
+#- 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 = 1;
+
+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, 'ext3');
+    }
+    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);
+
+    $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 => 4 }, 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_($::expert && isLVM($hd),
+	 { label => N("Logical volume name "), val => \$part->{lv_name}, list => [ qw(root swap usr home var), '' ], sort => 0, not_edit => 0 },
+           ),
+        ], 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
+	    put_in_hash($part, fs::type::type_name2subpart($type_name));
+	    $do_suggest_mount_point = 0 if !$part->{mntpoint};
+	    $part->{mntpoint} = '' if isNonMountable($part);
+	    $part->{mntpoint} = 'swap' if isSwap($part);
+	    fs::mount_options::set_default($part, ignore_is_removable => 1);
+
+	    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 can not 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;
+
+    warn_if_renumbered($in, $hd);
+
+    if ($migrate_files eq 'migrate') {
+	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 (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; 
+	ask_alldatawillbelost($in, $part, N_("After changing type of partition %s, all data on this partition will be lost"));
+    };
+
+    #- for ext2, warn after choosing as ext2->ext3 can be achieved without loosing any data :)
+    $part->{fs_type} eq 'ext2' || $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, ext4dev, 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, list => \@types, sort => 0, do_not_ellipsize => 1,
+		     focus => sub { 1 }, not_edit => 1, gtk => { wrap_width => 4 } } ]) or return;
+
+    my $type = $type_name && fs::type::type_name2subpart($type_name);
+
+    if (member($type->{fs_type}, qw(ext2 ext3 ext4dev))) {
+	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 ($type->{fs_type} =~ /ntfs/ && $part->{fs_type} =~ /ntfs/) {
+	if ($type->{fs_type} eq 'ntfs-3g') {
+	    $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) = @_;
+    $in->ask_from(N("Which volume label?"), '',
+
+		  [
+		   { label => N("Which volume label?"), title => 1 },
+		   { label => N("Label:"), val => \$part->{device_LABEL} } ]) or return;
+    $part->{prefer_device_LABEL} = to_bool($part->{device_LABEL});
+}
+
+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("Can not 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 ($min, $max) = (min_partition_size($hd), max_partition_resize($hd, $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 ext4dev))) {
+	    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;
+	}
+	#- 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};
+    $part->{size} = $size;
+    $hd->adjustEnd($part);
+
+    undef $@;
+    my $_b = before_leaving { $@ and $part->{size} = $oldsize };
+
+    my $adjust = sub {
+	my ($write_partitions) = @_;
+
+	if (isLVM($hd)) {
+	    lvm::lv_resize($part, $oldsize);
+	} else {
+	    partition_table::will_tell_kernel($hd, resize => $part);
+	    partition_table::adjust_local_extended($hd, $part);
+	    partition_table::adjust_main_extended($hd);
+	    write_partitions($in, $hd) or return if $write_partitions && %nice_resize;
+	}
+	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});
+    }
+
+    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 can not 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 {
+	raid::check_prog($in) or return;
+	my $md_part = raid::new($raids, disks => [ $part ]);
+	modifyRAID($in, $raids, $md_part) or return raid::delete($raids, $md_part);
+    }
+}
+sub Add2LVM {
+    my ($in, $hd, $part, $all_hds) = @_;
+    my $lvms = $all_hds->{lvms};
+    write_partitions($in, $_) or return foreach isRAID($part) ? @{$all_hds->{hds}} : $hd;
+
+    my $lvm = $in->ask_from_listf_(N("Add to LVM"), N("Choose an existing LVM to add to"),
+				  sub { ref($_[0]) ? $_[0]{VG_name} : $_[0] },
+				  [ @$lvms, N_("new") ]) or return;
+    require lvm;
+    if (!ref $lvm) {
+	# create new lvm
+        # FIXME: when mdv2006 is out: remove the question mark from the dialog title
+	my $name = $in->ask_from_entry(N("LVM name?"), N("LVM name?")) or return;
+	$lvm = new lvm($name);
+	push @$lvms, $lvm;
+    }
+    raid::make($all_hds->{raids}, $part) if isRAID($part);
+    lvm::check($in->do_pkgs) if $::isStandalone;
+    lvm::add_to_VG($part, $lvm);
+}
+sub Unmount {
+    my ($_in, $_hd, $part) = @_;
+    fs::mount::umount_part($part);
+}
+sub RemoveFromRAID { 
+    my ($_in, $_hd, $part, $all_hds) = @_;
+    raid::removeDisk($all_hds->{raids}, $part);
+}
+sub RemoveFromDm { 
+    my ($_in, $_hd, $part, $all_hds) = @_;
+    fs::dmcrypt::close_part($all_hds->{dmcrypts}, $part);
+}
+sub RemoveFromLVM {
+    my ($in, $_hd, $part, $all_hds) = @_;
+    isPartOfLVM($part) or die;
+    my ($lvm, $other_lvms) = partition { $_->{VG_name} eq $part->{lvm} } @{$all_hds->{lvms}};
+    if (@{$lvm->[0]{disks}} > 1) {
+	my ($used, $_total) = lvm::pv_physical_extents($part);
+	if ($used) {
+	    $in->ask_yesorno(N("Warning"), N("Physical volume %s is still in use.
+Do you want to move used physical extents on this volume to other volumes?", $part->{device})) or return;
+	    my $_w = $in->wait_message(N("Please wait"), N("Moving physical extents"));
+	    lvm::pv_move($part);
+	}
+	lvm::vg_reduce($lvm->[0], $part);
+    } else {
+	lvm::vg_destroy($lvm->[0]);
+	$all_hds->{lvms} = $other_lvms;
+    }
+}
+sub ModifyRAID { 
+    my ($in, $_hd, $part, $all_hds) = @_;
+    modifyRAID($in, $all_hds->{raids}, fs::get::device2part($part->{raid}, $all_hds->{raids}));
+}
+sub Loopback {
+    my ($in, $hd, $real_part, $all_hds) = @_;
+
+    write_partitions($in, $hd) or return;
+
+    my $handle = any::inspect($real_part) or $in->ask_warn(N("Error"), N("This partition can not be used for loopback")), return;
+
+    my ($min, $max) = (1, fs::loopback::getFree($handle->{dir}, $real_part));
+    $max = min($max, 1 << (31 - 9)) if $real_part->{fs_type} eq 'vfat'; #- FAT does not handle file size bigger than 2GB
+    my $part = { maxsize => $max, size => 0, loopback_device => $real_part, notFormatted => 1 };
+    if (!fsedit::suggest_part($part, $all_hds)) {
+	$part->{size} = $part->{maxsize};
+	fs::type::suggest_fs_type($part, 'ext3');
+    }
+    delete $part->{mntpoint}; # we do not want the suggested mntpoint
+
+    my $type_name = fs::type::part2type_name($part);
+    my $mb_size = to_Mb($part->{size});
+    $in->ask_from(N("Loopback"), '', [
+		  { label => N("Loopback file name: "), val => \$part->{loopback_file} },
+		  { label => N("Size in MB: "), val => \$mb_size, min => to_Mb($min), max => to_Mb($max), type => 'range', SpinButton => $::expert },
+		  { label => N("Filesystem type: "), val => \$type_name, list => [ fs::type::type_names($::expert, $hd) ], not_edit => !$::expert, sort => 0 },
+             ],
+	     complete => sub {
+		 $part->{loopback_file} or $in->ask_warn(N("Give a file name"), N("Give a file name")), return 1, 0;
+		 $part->{loopback_file} =~ s|^([^/])|/$1|;
+		 if (my $size = fs::loopback::verifFile($handle->{dir}, $part->{loopback_file}, $real_part)) {
+		     $size == -1 and $in->ask_warn(N("Warning"), N("File is already used by another loopback, choose another one")), return 1, 0;
+		     $in->ask_yesorno(N("Warning"), N("File already exists. Use it?")) or return 1, 0;
+		     delete $part->{notFormatted};
+		     $part->{size} = divide($size, 512);
+		 } else {
+		     $part->{size} = from_Mb($mb_size, $min, $max);
+		 }
+		 0;
+	     }) or return;
+    put_in_hash($part, fs::type::type_name2subpart($type_name));
+    push @{$real_part->{loopback}}, $part;
+    fsedit::recompute_loopbacks($all_hds);
+}
+
+sub Options {
+    my ($in, $hd, $part, $all_hds) = @_;
+
+    my @simple_options = qw(users noauto username= password=);
+
+    my (undef, $user_implies) = fs::mount_options::list();
+    my ($options, $unknown) = fs::mount_options::unpack($part);
+    my %help = fs::mount_options::help();
+
+    my %callbacks = (
+	# we don't want both user and users
+	user => sub { $options->{users} = 0; $options->{$_} = $options->{user} foreach @$user_implies },
+	users => sub { $options->{user} = 0; $options->{$_} = $options->{users} foreach @$user_implies },
+	# we don't want both relatime and noatime
+	relatime => sub { $options->{noatime} = 0 },
+	noatime => sub { $options->{relatime} = 0 },
+    );
+	
+
+    $in->ask_from(N("Mount options"),
+		  '',
+		  [ 
+		    { label => N("Mount options"), title => 1 },
+		   (map { 
+			 { label => $_, text => scalar warp_text(formatAlaTeX($help{$_}), 60), val => \$options->{$_}, hidden => scalar(/password/),
+			   advanced => !$part->{rootDevice} && !member($_, @simple_options), if_(!/=$/, type => 'bool'),
+			   if_($callbacks{$_}, changed => $callbacks{$_}),
+		       };
+		     } keys %$options),
+		    { label => N("Various"), val => \$unknown, advanced => 1 },
+		  ],
+		  complete => sub {
+		      if (($options->{usrquota} || $options->{grpquota}) && !$::isInstall) {
+			  $in->do_pkgs->ensure_binary_is_installed('quota', 'quotacheck');
+		      }
+		      if ($options->{encrypted}) {
+			  # modify $part->{options} for the check
+			  local $part->{options};
+			  fs::mount_options::pack($part, $options, $unknown);
+			  if (!check($in, $hd, $part, $all_hds)) {
+			      $options->{encrypted} = 0;
+			  } elsif (!$part->{encrypt_key} && !isSwap($part)) {
+			      if (my ($encrypt_key, $encrypt_algo) = choose_encrypt_key($in, $options, '')) {
+				  $options->{'encryption='} = $encrypt_algo;
+				  $part->{encrypt_key} = $encrypt_key;
+			      } else {
+				  $options->{encrypted} = 0;
+			      }
+			  }
+			  #- don't be sure of anything
+			  set_isFormatted($part, 0);
+			  $part->{notFormatted} = 0;
+		      } else {
+			  delete $options->{'encryption='};
+			  delete $part->{encrypt_key};
+		      }
+		  }) or return;
+
+    fs::mount_options::pack($part, $options, $unknown);
+    1;
+}
+
+
+{ 
+    no strict; 
+    *{'Toggle to normal mode'} = sub() { $::expert = 0 };
+    *{'Toggle to expert mode'} = sub() { $::expert = 1 };
+    *{'Clear all'} = \&Clear_all;
+    *{'Auto allocate'} = \&Auto_allocate;
+    *{'Mount point'} = \&Mount_point;
+    *{'Modify RAID'} = \&ModifyRAID;
+    *{'Add to RAID'} = \&Add2RAID;
+    *{'Remove from RAID'} = \&RemoveFromRAID; 
+    *{'Use'} = \&dmcrypt_open;
+    *{'Remove from dm'} = \&RemoveFromDm; 
+    *{'Add to LVM'} = \&Add2LVM;
+    *{'Remove from LVM'} = \&RemoveFromLVM; 
+    *{'Use for loopback'} = \&Loopback;
+    *{'Hard drive information'} = \&Hd_info;
+}
+
+
+################################################################################
+# helpers
+################################################################################
+
+sub is_part_existing {
+    my ($part, $all_hds) = @_;
+    $part && any { fsedit::are_same_partitions($part, $_) } fs::get::fstab_and_holes($all_hds);
+}
+
+sub modifyRAID {
+    my ($in, $raids, $md_part) = @_;
+    my $new_device = $md_part->{device};
+    $in->ask_from(N("Options"), '',
+		  [
+{ label => N("device"), val => \$new_device, list => [ $md_part->{device}, raid::free_mds($raids) ], sort => 0 },
+{ label => N("level"), val => \$md_part->{level}, list => [ qw(0 1 4 5 6 linear) ] },
+{ label => N("chunk size in KiB"), val => \$md_part->{'chunk-size'} },
+		  ],
+		 ) or return;
+    raid::change_device($md_part, $new_device);
+    raid::updateSize($md_part); # changing the raid level changes the size available
+    raid::write_conf($raids) if $::isStandalone;
+    1;
+}
+
+
+sub ask_alldatamaybelost {
+    my ($in, $part, $msg) = @_;
+
+    maybeFormatted($part) or return 1;
+
+    #- here we may have a non-formatted or a formatted partition
+    #- -> doing as if it was formatted
+    $in->ask_okcancel(N("Read carefully"), 
+		      [ N("Be careful: this operation is dangerous."), sprintf(translate($msg), $part->{device}) ], 1);
+}
+sub ask_alldatawillbelost {
+    my ($in, $part, $msg) = @_;
+
+    maybeFormatted($part) or return 1;
+
+    #- here we may have a non-formatted or a formatted partition
+    #- -> doing as if it was formatted
+    $in->ask_okcancel(N("Read carefully"), sprintf(translate($msg), $part->{device}), 1);
+}
+
+sub partitions_suggestions {
+    my ($in) = @_;
+    my $t = $::expert ? 
+      $in->ask_from_list_(N("Partitioning Type"), N("What type of partitioning?"), [ keys %fsedit::suggestions ]) :
+      'simple';
+    $fsedit::suggestions{$t};
+}
+
+sub check_type {
+    my ($in, $type, $hd, $part) = @_;
+    eval { fs::type::check($type->{fs_type}, $hd, $part) };
+    if (my $err = $@) {
+	$in->ask_warn(N("Error"), formatError($err));
+	return;
+    }
+    if ($::isStandalone && $type->{fs_type} && fs::format::known_type($type)) {
+	fs::format::check_package_is_installed($in->do_pkgs, $type->{fs_type}) or return;
+    }
+    1;
+}
+sub check_mntpoint {
+    my ($in, $mntpoint, $part, $all_hds) = @_;
+    my $seen;
+    eval { 
+	catch_cdie { fsedit::check_mntpoint($mntpoint, $part, $all_hds) }
+	  sub { $seen = 1; $in->ask_okcancel(N("Error"), formatError($@)) };
+    };
+    if (my $err = $@) {
+	$in->ask_warn(N("Error"), formatError($err)) if !$seen;
+	return;
+    }
+    1;
+}
+sub check {
+    my ($in, $hd, $part, $all_hds) = @_;
+    check_type($in, $part, $hd, $part) &&
+      check_mntpoint($in, $part->{mntpoint}, $part, $all_hds);
+}
+
+sub check_rebootNeeded {
+    my ($_in, $hd) = @_;
+    $hd->{rebootNeeded} and die N("You'll need to reboot before the modification can take place");
+}
+
+sub write_partitions {
+    my ($in, $hd, $b_skip_check_rebootNeeded) = @_;
+    check_rebootNeeded($in, $hd) if !$b_skip_check_rebootNeeded;
+    $hd->{isDirty} or return 1;
+    isLVM($hd) and return 1;
+
+    $in->ask_okcancel(N("Read carefully"), N("Partition table of drive %s is going to be written to disk", $hd->{device}), 1) or return;
+    partition_table::write($hd) if !$::testing;
+    check_rebootNeeded($in, $hd) if !$b_skip_check_rebootNeeded;
+    # fix resizing's failures due to udev's race when writing the partition table
+    run_program::run('udevadm', 'settle');
+    1;
+}
+
+sub ensure_we_have_encrypt_key_if_needed {
+    my ($in, $part) = @_;
+
+    if ($part->{options} =~ /encrypted/ && !$part->{encrypt_key}) {
+	my ($options, $_unknown) = fs::mount_options::unpack($part);
+	$part->{encrypt_key} = choose_encrypt_key($in, $options, 'skip_encrypt_algo') or return;
+    } elsif (fs::type::isRawLUKS($part)) {
+	$part->{dmcrypt_key} ||= choose_encrypt_key($in, {}, 'skip_encrypt_algo') or return;
+    }
+    1;
+}
+
+sub dmcrypt_format {
+    my ($in, $hd, $part, $all_hds) = @_;
+    my $_wait = $in->wait_message(N("Please wait"), N("Formatting partition %s", $part->{device}));
+    require fs::dmcrypt;
+    fs::dmcrypt::format_part($part);
+    # we open it now:
+    &dmcrypt_open;
+}
+
+sub format_ {
+    my ($in, $hd, $part, $all_hds) = @_;
+
+    ensure_we_have_encrypt_key_if_needed($in, $part) or return;
+    write_partitions($in, $_) or return foreach isRAID($part) ? @{$all_hds->{hds}} : $hd;
+
+    ask_alldatawillbelost($in, $part, N_("After formatting partition %s, all data on this partition will be lost")) or return;
+
+    if (fs::type::isRawLUKS($part)) {
+	return &dmcrypt_format;
+    }
+    if ($::isStandalone) {
+	fs::format::check_package_is_installed($in->do_pkgs, $part->{fs_type}) or return;
+    }
+    if ($::expert && !member($part->{fs_type}, 'reiserfs', 'xfs')) {
+	$part->{toFormatCheck} = $in->ask_yesorno(N("Confirmation"), N("Check bad blocks?"));
+    }
+    $part->{isFormatted} = 0; #- force format;
+    my ($_w, $wait_message) = $in->wait_message_with_progress_bar;
+    fs::format::part($all_hds, $part, $wait_message);
+    1;
+}
+
+sub need_migration {
+    my ($in, $mntpoint) = @_;
+
+    my @l = grep { $_ ne "lost+found" } all($mntpoint);
+    if (@l && $::isStandalone) {
+	my $choice;
+	my @choices = (N_("Move files to the new partition"), N_("Hide files"));
+	$in->ask_from(N("Warning"), N("Directory %s already contains data
+(%s)
+
+You can either choose to move the files into the partition that will be mounted there or leave them where they are (which results in hiding them by the contents of the mounted partition)",
+                         $mntpoint, formatList(5, @l)), 
+		      [ { val => \$choice, list => \@choices, type => 'list', format => sub { translate($_[0]) } } ]) or return;
+	$choice eq $choices[0] ? 'migrate' : 'hide';
+    } else {
+	'hide';
+    }    
+}
+
+sub migrate_files {
+    my ($in, $_hd, $part) = @_;
+
+    my $wait = $in->wait_message(N("Please wait"), N("Moving files to the new partition"));
+    my $handle = any::inspect($part, '', 'rw');
+    my @l = glob_("$part->{mntpoint}/*");
+    foreach (@l) {
+	$wait->set(N("Copying %s", $_)); 
+	system("cp", "-a", $_, $handle->{dir}) == 0 or die "copying failed";
+    }
+    foreach (@l) {
+	$wait->set(N("Removing %s", $_)); 
+	system("rm", "-rf", $_) == 0 or die "removing files failed";
+    }
+}
+
+sub warn_if_renumbered {
+    my ($in, $hd) = @_;
+    my $l = delete $hd->{partitionsRenumbered};
+    return if is_empty_array_ref($l);
+
+    push @{$hd->{allPartitionsRenumbered}}, @$l;
+
+    my @l = map { 
+	my ($old, $new) = @$_;
+	N("partition %s is now known as %s", $old, $new) } @$l;
+    $in->ask_warn(N("Warning"), join("\n", N("Partitions have been renumbered: "), @l));
+}
+
+#- unit of $mb is mega bytes, min and max are in sectors, this
+#- function is used to convert back to sectors count the size of
+#- a partition ($mb) given from the interface (on Resize or Create).
+#- modified to take into account a true bounding with min and max.
+sub from_Mb {
+    my ($mb, $min, $max) = @_;
+    $mb <= to_Mb($min) and return $min;
+    $mb >= to_Mb($max) and return $max;
+    $mb * 2048;
+}
+
+sub to_Mb {
+    my ($size_sector) = @_;
+    to_int($size_sector / 2048);
+}
+
+sub format_part_info {
+    my ($hd, $part) = @_;
+
+    my $info = '';
+
+    $info .= N("Mount point: ") . "$part->{mntpoint}\n" if $part->{mntpoint};
+    $info .= N("Device: ") . "$part->{device}\n" if $part->{device} && !isLoopback($part);
+    $info .= N("Volume label: ") . "$part->{device_LABEL}\n" if $part->{device_LABEL} && $::expert;
+    $info .= N("UUID: ") . "$part->{device_UUID}\n" if $::expert && $part->{device_UUID};
+    $info .= N("DOS drive letter: %s (just a guess)\n", $part->{device_windobe}) if $part->{device_windobe};
+    if (arch() eq "ppc") {
+	my $pType = $part->{pType};
+	$pType =~ s/[^A-Za-z0-9_]//g;
+	$info .= N("Type: ") . $pType . ($::expert ? sprintf " (0x%x)", $part->{pt_type} : '') . "\n";
+	if (defined $part->{pName}) {
+	    my $pName = $part->{pName};
+	    $pName =~ s/[^A-Za-z0-9_]//g;
+	    $info .= N("Name: ") . $pName . "\n";
+	}
+    } elsif (isEmpty($part)) {
+	$info .= N("Empty") . "\n";
+    } else {
+	$info .= N("Type: ") . (fs::type::part2type_name($part) || $part->{fs_type}) . ($::expert ? sprintf " (0x%x)", $part->{pt_type} : '') . "\n";
+    }
+    $info .= N("Start: sector %s\n", $part->{start}) if $::expert && !isSpecial($part) && !isLVM($hd);
+    $info .= N("Size: %s", formatXiB($part->{size}, 512));
+    $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 || isEmpty($part)) && !isSpecial($part) && !isLVM($hd) && $hd->cylinder_size;
+    $info .= N("Number of logical extents: %d\n", $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};
+    $info .= N("Mounted\n") if $part->{isMounted};
+    $info .= N("RAID %s\n", $part->{raid}) if isPartOfRAID($part);
+    if (fs::type::isRawLUKS($part)) {
+	$info .= N("Encrypted") . ($part->{dm_active} && $part->{dm_name} ? N(" (mapped on %s)", $part->{dm_name}) : 
+				     $part->{dm_name} ? N(" (to map on %s)", $part->{dm_name}) :
+				       N(" (inactive)")) . "\n";
+    }
+    if (isPartOfLVM($part)) {
+	$info .= sprintf "LVM %s\n", $part->{lvm};
+	$info .= sprintf "Used physical extents %d / %d\n", lvm::pv_physical_extents($part);
+    }
+    $info .= N("Loopback file(s):\n   %s\n", join(", ", map { $_->{loopback_file} } @{$part->{loopback}})) if isPartOfLoopback($part);
+    $info .= N("Partition booted by default\n    (for MS-DOS boot, not for lilo)\n") if $part->{active} && $::expert;
+    if (isRAID($part)) {
+	$info .= N("Level %s\n", $part->{level});
+	$info .= N("Chunk size %d KiB\n", $part->{'chunk-size'});
+	$info .= N("RAID-disks %s\n", join ", ", map { $_->{device} } @{$part->{disks}});
+    } elsif (isLoopback($part)) {
+	$info .= N("Loopback file name: %s", $part->{loopback_file});
+    }
+    if (isApple($part)) {
+	$info .= N("\nChances are, this partition is\na Driver partition. You should\nprobably leave it alone.\n");
+    }
+    if (isAppleBootstrap($part)) {
+	$info .= N("\nThis special Bootstrap\npartition is for\ndual-booting your system.\n");
+    }
+    # restrict the length of the lines
+    $info =~ s/(.{60}).*/$1.../mg;
+    $info;
+}
+
+sub format_part_info_short { 
+    my ($hd, $part) = @_;
+    isEmpty($part) ? N("Free space on %s (%s)", $hd->{device}, formatXiB($part->{size}, 512))
+                   : partition_table::description($part);
+}
+
+sub format_hd_info {
+    my ($hd) = @_;
+
+    my $info = '';
+    $info .= N("Device: ") . "$hd->{device}\n";
+    $info .= N("Read-only") . "\n" if $hd->{readonly};
+    $info .= N("Size: %s\n", formatXiB($hd->{totalsectors}, 512)) if $hd->{totalsectors};
+    $info .= N("Geometry: %s cylinders, %s heads, %s sectors\n", $hd->{geom}{cylinders}, $hd->{geom}{heads}, $hd->{geom}{sectors}) if $::expert && $hd->{geom};
+    $info .= N("Name: ") . $hd->{info} . "\n" if $hd->{info};
+    $info .= N("Medium type: ") . $hd->{media_type} . "\n" if $hd->{media_type} && $::expert;
+    $info .= N("LVM-disks %s\n", join ", ", map { $_->{device} } @{$hd->{disks}}) if isLVM($hd) && $hd->{disks};
+    $info .= N("Partition table type: %s\n", $1) if $::expert && ref($hd) =~ /_([^_]+)$/;
+    $info .= N("on channel %d id %d\n", $hd->{channel}, $hd->{id}) if $::expert && exists $hd->{channel};
+    $info;
+}
+
+sub format_raw_hd_info {
+    my ($raw_hd) = @_;
+
+    my $info = '';
+    $info .= N("Mount point: ") . "$raw_hd->{mntpoint}\n" if $raw_hd->{mntpoint};
+    $info .= format_hd_info($raw_hd);
+    if (!isEmpty($raw_hd)) {
+	$info .= N("Type: ") . (fs::type::part2type_name($raw_hd) || $raw_hd->{fs_type}) . "\n";
+    }
+    if (my $s = $raw_hd->{options}) {
+	$s =~ s/password=([^\s,]*)/'password=' . ('x' x length($1))/e;
+	$info .= N("Options: %s", $s);
+    }
+    $info;
+}
+
+#- get the minimal size of partition in sectors to help diskdrake on
+#- limit cases, include a cylinder + start of a eventually following
+#- logical partition.
+sub min_partition_size { $_[0]->cylinder_size + 2*$_[0]{geom}{sectors} }
+
+sub max_partition_resize {
+    my ($hd, $part) = @_;
+    if (isLVM($hd)) {
+	$part->{size} + fs::get::vg_free_space($hd);
+    } else {
+	partition_table::next_start($hd, $part) - $part->{start};
+    }
+}
+
+sub choose_encrypt_key {
+    my ($in, $options, $skip_encrypt_algo) = @_;
+
+    my ($encrypt_key, $encrypt_key2);
+    my @algorithms = map { "AES$_" } 128, 196, 256, 512, 1024, 2048;
+    my $encrypt_algo = $options->{'encryption='} || "AES128";
+
+    $in->ask_from_(
+		       {
+         title => N("Filesystem encryption key"), 
+	 messages => N("Choose your filesystem encryption key"),
+	 callbacks => { 
+	     complete => sub {
+		 length $encrypt_key < 6 and $in->ask_warn(N("Warning"), N("This encryption key is too simple (must be at least %d characters long)", 6)), return 1,0;
+		 $encrypt_key eq $encrypt_key2 or $in->ask_warn(N("Error"), [ N("The encryption keys do not match"), N("Please try again") ]), return 1,1;
+		 return 0;
+        } } }, [
+{ label => N("Encryption key"), val => \$encrypt_key,  hidden => 1, focus => sub { 1 } },
+{ label => N("Encryption key (again)"), val => \$encrypt_key2, hidden => 1 },
+if_(!$skip_encrypt_algo,
+{ label => N("Encryption algorithm"), type => 'list', val => \$encrypt_algo, list => \@algorithms },
+),
+    ]) or return;
+
+    $skip_encrypt_algo ? $encrypt_key : ($encrypt_key, $encrypt_algo);
+}
+
+
+sub tell_wm_and_reboot() {
+    my ($wm, $pid) = any::running_window_manager();
+
+    if (!$wm) {
+	system('reboot');
+    } else {    
+	any::ask_window_manager_to_logout_then_do($wm, $pid, 'reboot');
+    }
+}
+
+sub update_bootloader_for_renumbered_partitions {
+    my ($in, $all_hds) = @_;
+    my @renumbering = map { @{$_->{allPartitionsRenumbered} || []} } @{$all_hds->{hds}} or return;
+
+    require bootloader;
+    bootloader::update_for_renumbered_partitions($in, \@renumbering, $all_hds);
+}
diff --git a/perl-install/diskdrake/removable.pm b/perl-install/diskdrake/removable.pm
new file mode 100644
index 000000000..0ed8e0f80
--- /dev/null
+++ b/perl-install/diskdrake/removable.pm
@@ -0,0 +1,52 @@
+package diskdrake::removable; # $Id: removable.pm 215411 2007-04-25 12:26:16Z pixel $
+
+use diagnostics;
+use strict;
+use diskdrake::interactive;
+use common;
+use fs;
+
+sub main {
+    my ($in, $all_hds, $raw_hd) = @_;
+    my %actions = my @actions = actions();
+    my $action;
+    while ($action ne 'Done') {
+	$action = $in->ask_from_list_('', 
+					 diskdrake::interactive::format_raw_hd_info($raw_hd), 
+					 [ map { $_->[0] } group_by2 @actions ], 'Done') or return;
+	$actions{$action}->($in, $raw_hd, $all_hds);
+    }
+}
+
+sub actions() {
+    (
+     N_("Mount point") => \&mount_point,
+     N_("Options") => \&options,
+     N_("Type") => \&type,
+     N_("Done") => \&done,
+    );
+}
+
+sub done {
+    my ($in, $_raw_hd, $all_hds) = @_;
+    diskdrake::interactive::Done($in, $all_hds);
+}
+sub options {
+    my ($in, $raw_hd, $all_hds) = @_;
+    diskdrake::interactive::Options($in, {}, $raw_hd, $all_hds);
+}
+sub mount_point { 
+    my ($in, $raw_hd, $all_hds) = @_;
+    diskdrake::interactive::Mount_point_raw_hd($in, $raw_hd, $all_hds, "/media/$raw_hd->{device}");
+}
+sub type {
+    my ($in, $raw_hd) = @_;
+    my @fs = ('auto', fs::type::guessed_by_mount());
+    my $fs_type = $raw_hd->{fs_type};
+    $in->ask_from(N("Change type"),
+			      N("Which filesystem do you want?"),
+			      [ { label => N("Type"), val => \$fs_type, list => [@fs] } ]) or return;
+    $raw_hd->{fs_type} = $fs_type;
+}
+
+1;
diff --git a/perl-install/diskdrake/resize_ext2.pm b/perl-install/diskdrake/resize_ext2.pm
new file mode 100644
index 000000000..ca222b35a
--- /dev/null
+++ b/perl-install/diskdrake/resize_ext2.pm
@@ -0,0 +1,37 @@
+package diskdrake::resize_ext2; # $Id: resize_ext2.pm 214945 2006-02-13 16:10:35Z tvignaud $
+
+use diagnostics;
+use strict;
+
+use run_program;
+use common;
+
+
+sub new {
+    my ($type, $_device, $dev) = @_;
+
+    my $o = bless { dev => $dev }, $type;
+
+    my $r = run_program::get_stdout('dumpe2fs', $dev);
+    $o->{block_count} = $r =~ /^Block count:\s*(\d+)/m && $1;
+    $o->{free_block} = $r =~ /^Free blocks:\s*(\d+)/m && $1;
+    $o->{block_size} = $r =~ /^Block size:\s*(\d+)/m && $1;
+    log::l("dumpe2fs $dev gives: Block_count=$o->{block_count}, Free_blocks=$o->{free_block}, Block_size=$o->{block_size}");
+
+    $o->{block_size} && $o;
+}
+
+sub min_size {
+    my ($o) = @_;
+    ($o->{block_count} - $o->{free_block}) * ($o->{block_size} / 512);
+}
+
+sub resize {
+    my ($o, $size) = @_;
+
+    my $s = int($size / ($o->{block_size} / 512));
+    log::l("resize2fs $o->{dev} to size $s in block of $o->{block_size} bytes");
+    run_program::raw({ timeout => 60 * 60 }, "resize2fs", "-pf", $o->{dev}, $s) or die "resize2fs failed";
+}
+
+1;
diff --git a/perl-install/diskdrake/resize_ntfs.pm b/perl-install/diskdrake/resize_ntfs.pm
new file mode 100644
index 000000000..c6364fec6
--- /dev/null
+++ b/perl-install/diskdrake/resize_ntfs.pm
@@ -0,0 +1,36 @@
+package diskdrake::resize_ntfs;
+
+use diagnostics;
+use strict;
+
+use run_program;
+use common;
+
+
+sub new {
+    my ($type, $_device, $dev) = @_;
+    bless { dev => $dev }, $type;
+}
+
+sub check_prog {
+    my ($in) = @_;
+    #- ensure_binary_is_installed checks binary chrooted, whereas we run the binary non-chrooted (pb for Mandriva One)
+    $::isInstall || whereis_binary('ntfsresize') || $in->do_pkgs->ensure_binary_is_installed('ntfsprogs', 'ntfsresize');
+}
+
+sub min_size {
+    my ($o) = @_;
+    my $r;
+    run_program::run('ntfsresize', '>', \$r, '-f', '-i', $o->{dev}) or die "ntfsresize failed:\n$r\n";
+    $r =~ /minimal size: (\d+) KiB/ && $1 * 2; 
+}
+
+sub resize {
+    my ($o, $size) = @_;
+    my @l = ('-ff', '-s' . int($size / 2) . 'ki', $o->{dev});
+    my $r;
+    run_program::run('ntfsresize', '>', \$r, '-n', @l) or die "ntfsresize failed: $r\n";
+    run_program::raw({ timeout => 'never' }, 'ntfsresize', '>', \$r, @l) or die "ntfsresize failed: $r\n";
+}
+
+1;
diff --git a/perl-install/diskdrake/smbnfs_gtk.pm b/perl-install/diskdrake/smbnfs_gtk.pm
new file mode 100644
index 000000000..b5ddfbe53
--- /dev/null
+++ b/perl-install/diskdrake/smbnfs_gtk.pm
@@ -0,0 +1,271 @@
+package diskdrake::smbnfs_gtk; # $Id: smbnfs_gtk.pm 243679 2008-07-29 11:55:58Z tv $
+
+use diagnostics;
+use strict;
+
+use fs::get;
+use diskdrake::interactive;
+use common;
+use interactive;
+use fs::remote::smb;
+use fs::remote::nfs;
+use mygtk2 qw(gtknew gtkset);
+use ugtk2 qw(:helpers :wrappers :create);
+
+my ($all_hds, $in, $tree_model, $current_entry, $current_leaf, %icons);
+
+sub main {
+    ($in, $all_hds, my $type) = @_;
+    my ($kind) = $type eq 'smb' ? smb2kind() : nfs2kind();
+    $kind->check($in) or return;
+
+    my $w = ugtk2->new(N("Partitioning"));
+
+    add_smbnfs($w->{window}, $kind);
+    $w->{rwindow}->set_default_size(400, 300) if $w->{rwindow}->can('set_default_size');
+    $w->{window}->show_all;
+    $w->main;
+}
+
+################################################################################
+# nfs/smb: helpers
+################################################################################
+sub try {
+    my ($kind, $name, @args) = @_;
+    my $f = $diskdrake::interactive::{$name} or die "unknown function $name";
+    try_($kind, $name, \&$f, @args);
+}
+sub try_ {
+    my ($kind, $name, $f, @args) = @_;
+    eval { $f->($in, @args, $all_hds) };
+    if (my $err = $@) {
+	$in->ask_warn(N("Error"), formatError($err));
+    }
+    update($kind);
+    Gtk2->main_quit if member($name, 'Cancel', 'Done');
+}
+
+sub raw_hd_options {
+    my ($in, $raw_hd) = @_;
+    diskdrake::interactive::Options($in, {}, $raw_hd, fs::get::empty_all_hds());
+}
+sub raw_hd_mount_point {
+    my ($in, $raw_hd) = @_;
+    my ($default) = $raw_hd->{device} =~ m|([^/]+)$|;
+    $default =~ s/\s+/-/g;
+    diskdrake::interactive::Mount_point_raw_hd($in, $raw_hd, $all_hds, "/mnt/$default");
+}
+
+sub per_entry_info_box {
+    my ($box, $kind, $entry) = @_;
+    my $info = $entry ? diskdrake::interactive::format_raw_hd_info($entry) : '';
+    $kind->{per_entry_info_box}->destroy if $kind->{per_entry_info_box};
+    gtkpack($box, $kind->{per_entry_info_box} = gtknew('Frame', text => N("Details"), child => gtknew('Label', text => $info, justify => 'left')));
+}
+
+sub per_entry_action_box {
+    my ($box, $kind, $entry) = @_;
+    $_->destroy foreach $box->get_children;
+
+    my @buttons;
+
+    push @buttons, map {
+	  my $s = $_;
+	  gtknew('Button', text => translate($s), clicked => sub { try($kind, $s, {}, $entry) });
+      } (if_($entry->{isMounted}, N_("Unmount")),
+	 if_($entry->{mntpoint} && !$entry->{isMounted}, N_("Mount"))) if $entry;
+
+    my @l = (
+	     if_($entry, N_("Mount point") => \&raw_hd_mount_point),
+	     if_($entry && $entry->{mntpoint}, N_("Options") => \&raw_hd_options),
+	     N_("Cancel") => sub {},
+	     N_("Done") => \&done,
+	    );
+    push @buttons, map {
+        my ($txt, $f) = @$_;
+        $f ? gtknew('Button', text => translate($txt), clicked => sub { try_($kind, $txt, $f, $entry) })
+          : gtknew('Label', text => "");
+    } group_by2(@l);
+    
+    gtkadd($box, gtknew('HBox', children_loose => [ @buttons]));
+}
+
+sub done {
+    my ($in) = @_;
+    diskdrake::interactive::Done($in, $all_hds);
+}
+
+sub export_icon {
+    my ($entry) = @_;
+    $entry ||= {};
+    $icons{$entry->{isMounted} ? 'mounted' : $entry->{mntpoint} ? 'has_mntpoint' : 'default'};
+}
+
+sub update {
+    my ($kind) = @_;
+    per_entry_action_box($kind->{action_box}, $kind, $current_entry);
+    per_entry_info_box($kind->{info_box}, $kind, $current_entry);
+    $tree_model->set($current_leaf, 0 => export_icon($current_entry)) if $current_entry;
+}
+
+sub find_fstab_entry {
+    my ($kind, $e, $b_add_or_not) = @_;
+
+    my $fs_entry = $kind->to_fstab_entry($e);
+
+    if (my $fs_entry_ = find { $fs_entry->{device} eq $_->{device} } @{$kind->{val}}) {
+	$fs_entry_;
+    } elsif ($b_add_or_not) {
+	push @{$kind->{val}}, $fs_entry;
+	$fs_entry;
+    } else {
+	undef;
+    }
+}
+
+sub import_tree {
+    my ($kind, $info_box) = @_;
+    my (%servers_displayed, %wservers, %wexports);
+
+    $tree_model = Gtk2::TreeStore->new("Gtk2::Gdk::Pixbuf", "Glib::String");
+    my $tree = Gtk2::TreeView->new_with_model($tree_model);
+    $tree->get_selection->set_mode('browse');
+
+    my $col = Gtk2::TreeViewColumn->new;
+    $col->pack_start(my $pixrender = Gtk2::CellRendererPixbuf->new, 0);
+    $col->add_attribute($pixrender, 'pixbuf', 0);
+    $col->pack_start(my $texrender = Gtk2::CellRendererText->new, 1);
+    $col->add_attribute($texrender, 'text', 1);
+    $tree->append_column($col);
+
+    $tree->set_headers_visible(0);
+
+    foreach ('default', 'server', 'has_mntpoint', 'mounted') {
+	$icons{$_} = gtknew('Pixbuf', file => "smbnfs_$_");
+    }
+
+    my $add_server = sub {
+	my ($server) = @_;
+	my $identifier = $server->{ip} || $server->{name};
+	my $name = $server->{name} || $server->{ip};
+	$servers_displayed{$identifier} ||= do {
+	    my $w = $tree_model->append_set(undef, [ 0 => $icons{server}, 1 => $name ]);
+	    $wservers{$tree_model->get_path_str($w)} = $server;
+	    $w;
+	};
+    };
+
+    my $find_exports; $find_exports = sub {
+	my ($server) = @_;
+	my @l = eval { $kind->find_exports($server) };
+	return @l if !$@;
+
+	if ($server->{username}) {
+	    $in->ask_warn('', N("Can not login using username %s (bad password?)", $server->{username}));
+	    fs::remote::smb::remove_bad_credentials($server);
+	} else {
+	    if (my @l = fs::remote::smb::authentications_available($server)) {
+		my $user = $in->ask_from_list_(N("Domain Authentication Required"),
+					       N("Which username"), [ @l, N_("Another one") ]) or return;
+		if ($user ne 'Another one') {
+		    fs::remote::smb::read_credentials($server, $user);
+		    goto $find_exports;
+		}
+	    }
+	}
+
+	if ($in->ask_from(N("Domain Authentication Required"),
+		      N("Please enter your username, password and domain name to access this host."),
+		      [ 
+		       { label => N("Username"), val => \$server->{username} },
+		       { label => N("Password"), val => \$server->{password}, hidden => 1 },
+		       { label => N("Domain"), val => \$server->{domain} },
+		      ])) {
+	    goto $find_exports;
+	} else {
+	    delete $server->{username};
+	    ();
+	}	
+    };
+
+    my $add_exports = sub {
+	my ($node) = @_;
+
+	my $path = $tree_model->get_path($node);
+	$tree->expand_row($path, 0);
+
+	foreach ($find_exports->($wservers{$tree_model->get_path_str($node)} || return)) { #- can not die here since insert_node provoque a tree_select_row before the %wservers is filled
+	    my $s = $kind->to_string($_);
+	    my $w = $tree_model->append_set($node, [ 0 => export_icon(find_fstab_entry($kind, $_)), 
+						     1 => $s ]);
+	    $wexports{$tree_model->get_path_str($w)} = $_;
+	}
+    };
+
+    { 
+	my $search = gtknew('Button', text => N("Search servers"));
+	gtkpack__($info_box, 
+		  gtksignal_connect($search,
+				    clicked => sub {
+					$add_server->($_) foreach sort { $a->{name} cmp $b->{name} } $kind->find_servers;
+					gtkset($search, text => N("Search new servers"));
+				    }));
+    }
+
+    foreach (uniq(map { ($kind->from_dev($_->{device}))[0] } @{$kind->{val}})) {
+	my $node = $add_server->({ name => $_ });
+	$add_exports->($node);
+    }
+
+    $tree->get_selection->signal_connect(changed => sub {
+	my ($_model, $curr) = $_[0]->get_selected;
+	$curr or return;
+
+	if ($tree_model->iter_parent($curr)) {
+	    $current_leaf = $curr;
+	    $current_entry = find_fstab_entry($kind, $wexports{$tree_model->get_path_str($curr)} || die(''), 'add');
+	} else {
+	    if (!$tree_model->iter_has_child($curr)) {
+		gtkset_mousecursor_wait($tree->window);
+		ugtk2::flush();
+		$add_exports->($curr);		
+		gtkset_mousecursor_normal($tree->window);
+	    }
+	    $current_entry = undef;
+	}
+	update($kind);
+    });
+    $tree;
+}
+
+sub add_smbnfs {
+    my ($widget, $kind) = @_;
+    die if $kind->{main_box};
+
+    $kind->{info_box} = gtknew('VBox');
+    $kind->{display_box} = gtknew('ScrolledWindow', child => import_tree($kind, $kind->{info_box}));
+    $kind->{action_box} = gtknew('HBox');
+    $kind->{main_box} =
+      gtknew('VBox', spacing => 7, children => [
+	       1, gtknew('HBox', spacing => 7, children_loose => [
+			  gtkset($kind->{display_box}, width => 200),
+			  $kind->{info_box}]),
+	       0, $kind->{action_box},
+	     ]);
+
+    $widget->add($kind->{main_box});
+    $current_entry = undef;
+    update($kind);
+    $kind;
+}
+
+sub nfs2kind() {
+    fs::remote::nfs->new({ type => 'nfs', name => 'NFS', val => $all_hds->{nfss}, no_auto => 1 });
+}
+
+sub smb2kind() {
+    fs::remote::smb->new({ type => 'smb', name => 'Samba', val => $all_hds->{smbs}, no_auto => 1 });
+}
+
+
+1;
author	Antoine Ginies <aginies@mandriva.com>	2011-01-19 10:44:49 +0000
committer	Antoine Ginies <aginies@mandriva.com>	2011-01-19 10:44:49 +0000
commit	530a16ec071db0e24e6e949e265a96848864967c (patch)
tree	fe40cacd28d67b98186754c551b7fd339ebc7e17 /perl-install/diskdrake
download	drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.gz drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.bz2 drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.tar.xz drakx-backup-do-not-use-530a16ec071db0e24e6e949e265a96848864967c.zip