summaryrefslogtreecommitdiffstats
path: root/perl-install/diskdrake/smbnfs_gtk.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/diskdrake/smbnfs_gtk.pm')
-rw-r--r--perl-install/diskdrake/smbnfs_gtk.pm247
1 files changed, 247 insertions, 0 deletions
diff --git a/perl-install/diskdrake/smbnfs_gtk.pm b/perl-install/diskdrake/smbnfs_gtk.pm
new file mode 100644
index 000000000..c692e11ac
--- /dev/null
+++ b/perl-install/diskdrake/smbnfs_gtk.pm
@@ -0,0 +1,247 @@
+package diskdrake::smbnfs_gtk; # $Id$
+
+use diagnostics;
+use strict;
+
+use any;
+use fs;
+use diskdrake::interactive;
+use common;
+use interactive;
+use network::smb;
+use network::nfs;
+use my_gtk qw(:helpers :wrappers :ask);
+
+my ($all_hds, $in);
+
+sub main {
+ ($in, $all_hds, my $type) = @_;
+ my ($check, $create) = $type eq 'smb' ? (\&network::smb::check, \&smb_create) : (\&network::nfs::check, \&nfs_create);
+ $check->($in) or return;
+
+ my $w = my_gtk->new('DiskDrake');
+ $create->($w->{window});
+ $w->{rwindow}->set_default_size(400, 300);
+ $w->{window}->show_all;
+ $w->main;
+}
+
+################################################################################
+# nfs/smb: helpers
+################################################################################
+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) = @_;
+ eval { $f->($in, @args, $all_hds); };
+ if (my $err = $@) {
+ $in->ask_warn(_("Error"), formatError($err));
+ }
+ Gtk->main_quit if $name eq 'Done';
+}
+
+sub per_entry_info_box {
+ my ($box, $kind, $entry) = @_;
+ $_->widget->destroy foreach $box->children;
+ my $info;
+ if ($entry) {
+ $info = diskdrake::interactive::format_raw_hd_info($entry);
+ }
+ gtkpack($box, gtkadd(new Gtk::Frame(_("Details")), gtkset_justify(new Gtk::Label($info), 'left')));
+}
+
+sub raw_hd_options {
+ my ($in, $raw_hd) = @_;
+ diskdrake::interactive::Options($in, {}, $raw_hd);
+}
+sub raw_hd_mount_point {
+ my ($in, $raw_hd) = @_;
+ diskdrake::interactive::Mount_point_raw_hd($in, $raw_hd, $all_hds);
+}
+
+
+sub per_entry_action_box {
+ my ($box, $kind, $entry) = @_;
+ $_->widget->destroy foreach $box->children;
+
+ my @buttons = map {
+ my $s = $_;
+ gtksignal_connect(new Gtk::Button(translate($s)), clicked => sub { try($s, {}, $entry) });
+ } (if_($entry->{isMounted}, __("Unmount")),
+ if_($entry->{mntpoint} && !$entry->{isMounted}, __("Mount"))) if $entry;
+
+ my @l = (
+ if_($entry, __("Mount point") => \&raw_hd_mount_point),
+ if_($entry && $entry->{mntpoint}, __("Options") => \&raw_hd_options),
+ __("Export") => \&any::fileshare_config,
+ __("Done") => \&done,
+ );
+ push @buttons, map {
+ my ($txt, $f) = @$_;
+ gtksignal_connect(new Gtk::Button(translate($txt)), clicked => sub { try_($txt, $f, $entry) });
+ } group_by2(@l);
+
+ gtkadd($box, gtkpack(new Gtk::HBox(0,0), @buttons));
+}
+
+sub done {
+ my ($in) = @_;
+ diskdrake::interactive::Done($in, $all_hds);
+}
+
+sub current_entry_changed {
+ my ($kind, $entry) = @_;
+ per_entry_action_box($kind->{action_box}, $kind, $entry);
+ per_entry_info_box($kind->{info_box}, $kind, $entry);
+}
+
+sub import_ctree {
+ my ($kind, $imported, $find_servers, $find_exports, $create) = @_;
+ my (%name2server, %wservers, %name2export, $inside);
+
+ my $tree = Gtk::CTree->new(1, 0);
+ $tree->set_column_auto_resize(0, 1);
+ $tree->set_selection_mode('browse');
+ $tree->set_row_height($tree->style->font->ascent + $tree->style->font->descent + 1);
+
+ my $add_server = sub {
+ my ($server) = @_;
+ my $name = $server->{name} || $server->{ip};
+ $name2server{$name} = $server;
+ $wservers{$name} ||= $tree->insert_node(undef, undef, [$name], 5, (undef) x 4, 0, 0);
+ $wservers{$name}
+ };
+
+ my $add_exports = sub {
+ my ($node) = @_;
+ $tree->expand($node);
+ my $name = first $tree->node_get_pixtext($node, 0);
+ foreach ($find_exports->($name2server{$name})) {
+ my $name = $_->{name} . ($_->{comment} ? " ($_->{comment})" : '');
+ $name2export{$name} = $_;
+ $tree->insert_node($node, undef, [$name], 5, (undef) x 4, 1, 0);
+ }
+ };
+
+ my $click_here = $tree->insert_node(undef, undef, [_("click here")], 5, (undef) x 4, 0, 0);
+ foreach (@$imported) {
+ my $node = $add_server->($_->{server});
+ $add_exports->($node);
+ }
+
+ $tree->signal_connect(tree_select_row => sub {
+ my $curr = $_[1];
+ $inside and return;
+ $inside = 1;
+ if ($curr->row->is_leaf) {
+ my ($export) = $tree->node_get_pixtext($curr, 0);
+ $export =~ s/ \(.*?\)$//;
+ my ($server) = $tree->node_get_pixtext($curr->row->parent, 0);
+ my $entry = $create->($server, $export);
+ if (my ($e) = grep { $entry->{device} eq $_->{device} } @{$kind->{val}}) {
+ $entry = $e;
+ } else {
+ push @{$kind->{val}}, $entry;
+ }
+ current_entry_changed($kind, $entry);
+ } elsif (!$curr->row->children) {
+ $tree->freeze;
+ if ($curr == $click_here) {
+ $add_server->($_) foreach sort { $a->{name} cmp $b->{name} } $find_servers->();
+ $tree->remove_node($click_here);
+ } else {
+ $add_exports->($curr);
+ }
+ $tree->thaw;
+ }
+ $inside = 0;
+ });
+ $tree;
+}
+
+sub add_smbnfs {
+ my ($widget, $kind, $find_servers, $find_exports, $create) = @_;
+ die if $kind->{main_box};
+
+ my $imported = [];
+
+ $kind->{display_box} = createScrolledWindow(import_ctree($kind, $imported, $find_servers, $find_exports, $create));
+ $kind->{action_box} = new Gtk::HBox(0,0);
+ $kind->{info_box} = new Gtk::VBox(0,0);
+ $kind->{main_box} =
+ gtkpack_(new Gtk::VBox(0,7),
+ 1, gtkpack(new Gtk::HBox(0,7),
+ gtkset_usize($kind->{display_box}, 200, 0),
+ $kind->{info_box}),
+ 0, $kind->{action_box},
+ );
+
+ $widget->add($kind->{main_box});
+ current_entry_changed($kind, undef);
+ $kind;
+}
+
+################################################################################
+# nfs: helpers
+################################################################################
+sub nfs2kind {
+ my ($l) = @_;
+ { type => 'nfs', name => 'NFS', val => $l, no_auto => 1 };
+}
+
+sub nfs_create {
+ my ($widget) = @_;
+
+ my $find_servers = sub {
+ my $w = $in->wait_message('', _("Scanning available nfs shared resource"));
+ &network::nfs::find_servers;
+ };
+ my $find_exports = sub {
+ my ($server) = @_;
+ my $w = $in->wait_message('', _("Scanning available nfs shared resource of server %s", $server->{name}));
+ &network::nfs::find_exports;
+ };
+ my $create = sub {
+ my ($server, $export) = @_;
+
+ my $nfs = { device => "$server:$export", type => 'nfs' };
+ fs::set_default_options($nfs);
+ $nfs;
+ };
+ add_smbnfs($widget, nfs2kind($all_hds->{nfss}), $find_servers, $find_exports, $create);
+}
+
+################################################################################
+# smb: helpers
+################################################################################
+sub smb2kind {
+ my ($l) = @_;
+ { type => 'smb', name => 'Samba', val => $l, no_auto => 1 };
+}
+
+sub smb_create {
+ my ($widget) = @_;
+
+ my $find_servers = sub {
+ my $w = $in->wait_message('', _("Scanning available samba shared resource"));
+ &network::smb::find_servers;
+ };
+ my $find_exports = sub {
+ my ($server) = @_;
+ my $w = $in->wait_message('', _("Scanning available samba shared resource of server %s", $server->{name}));
+ &network::smb::find_exports;
+ };
+ my $create = sub {
+ my ($server, $export) = @_;
+
+ my $smb = { device => "//$server/$export", type => 'smbfs', options => 'username=%' };
+ fs::set_default_options($smb);
+ $smb;
+ };
+ add_smbnfs($widget, smb2kind($all_hds->{smbs}), $find_servers, $find_exports, $create);
+}
+
+1;