summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/diskdrake/smbnfs_gtk.pm37
-rw-r--r--perl-install/fs.pm51
-rw-r--r--perl-install/network/smb.pm66
-rw-r--r--perl-install/network/smbnfs.pm2
4 files changed, 141 insertions, 15 deletions
diff --git a/perl-install/diskdrake/smbnfs_gtk.pm b/perl-install/diskdrake/smbnfs_gtk.pm
index e8519615b..e4cf415ed 100644
--- a/perl-install/diskdrake/smbnfs_gtk.pm
+++ b/perl-install/diskdrake/smbnfs_gtk.pm
@@ -151,10 +151,43 @@ sub import_ctree {
};
};
+ my $find_exports; $find_exports = sub {
+ my ($server) = @_;
+ my @l = eval { $kind->find_exports($server) };
+ return @l if !$@;
+
+ if ($server->{username}) {
+ $in->ask_warn('', _("Can't login using username %s (bad password?)", $server->{username}));
+ network::smb::remove_bad_credentials($server);
+ } else {
+ if (my @l = network::smb::authentifications_available($server)) {
+ my $user = $in->ask_from_list_(_("Domain Authentication Required"),
+ _("Which username"), [ @l, __("Another one") ]) or return;
+ if ($user ne 'Another one') {
+ network::smb::read_credentials($server, $user);
+ goto $find_exports;
+ }
+ }
+ }
+
+ if ($in->ask_from(_("Domain Authentication Required"),
+ _("Please enter your username, password and domain name to access this host."),
+ [
+ { label => _("Username"), val => \$server->{username} },
+ { label => _("Password"), val => \$server->{password} },
+ { label => _("Domain"), val => \$server->{domain} },
+ ])) {
+ goto $find_exports;
+ } else {
+ delete $server->{username};
+ ();
+ }
+ };
+
my $add_exports = sub {
my ($node) = @_;
$tree->expand($node);
- foreach ($kind->find_exports($wservers{$node->{_gtk}} || return)) { #- can't die here since insert_node provoque a tree_select_row before the %wservers is filled
+ foreach ($find_exports->($wservers{$node->{_gtk}} || return)) { #- can't die here since insert_node provoque a tree_select_row before the %wservers is filled
my $w = $tree->insert_node($node, undef, [$kind->to_string($_)], 5, (undef) x 4, 1, 0);
set_export_icon(find_fstab_entry($kind, $_), $w);
$wexports{$w->{_gtk}} = $_;
@@ -187,9 +220,7 @@ sub import_ctree {
if (!$curr->row->children) {
gtkset_mousecursor_wait($tree->window);
my_gtk::flush();
- $tree->freeze;
$add_exports->($curr);
- $tree->thaw;
gtkset_mousecursor_normal($tree->window);
}
$current_entry = undef;
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 9b5d6236f..cb8d751cd 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -4,6 +4,7 @@ use diagnostics;
use strict;
use MDK::Common::System;
+use MDK::Common::Various;
use common;
use log;
use devices;
@@ -62,6 +63,21 @@ sub read_fstab {
$h->{device} = $dev;
}
}
+
+ if ($h->{options} =~ /credentials=/) {
+ require network::smb;
+ #- remove credentials=file with username=foo,password=bar,domain=zoo
+ #- the other way is done in fstab_to_string
+ my ($options, $unknown) = mount_options_unpack($h);
+ my $file = delete $options->{'credentials='};
+ my $credentials = network::smb::read_credentials_raw("$prefix$file");
+ if ($credentials->{username}) {
+ $options->{"$_="} = $credentials->{$_} foreach qw(username password domain);
+ mount_options_pack($h, $options, $unknown);
+ }
+ }
+
+
$h;
} cat_("$prefix$file");
}
@@ -143,8 +159,8 @@ sub merge_info_from_fstab {
merge_fstabs($fstab, @l);
}
-sub fstab_to_string {
- my ($all_hds, $prefix) = @_;
+sub prepare_write_fstab {
+ my ($all_hds, $prefix, $keep_smb_credentials) = @_;
$prefix ||= '';
my @l1 = (fsedit::get_really_all_fstab($all_hds), @{$all_hds->{special}});
@@ -160,6 +176,7 @@ sub fstab_to_string {
}
my %new;
+ my @smb_credentials;
my @l = map {
my $device =
$_->{device} eq 'none' || member($_->{type}, qw(nfs smbfs)) ?
@@ -189,6 +206,15 @@ sub fstab_to_string {
$new{$mntpoint} = 1;
my $options = $_->{options};
+
+ if (isThisFs('smbfs', $_) && $options =~ /password=/ && !$keep_smb_credentials) {
+ require network::smb;
+ if (my ($opts, $smb_credentials) = network::smb::fstab_entry_to_credentials($_)) {
+ $options = $opts;
+ push @smb_credentials, $smb_credentials;
+ }
+ }
+
my $type = type2fs($_);
my $dev = $_->{device_alias} ? "/dev/$_->{device_alias}" : $device;
@@ -211,13 +237,21 @@ sub fstab_to_string {
}
} grep { $_->{device} && ($_->{mntpoint} || $_->{real_mntpoint}) && $_->{type} } (@l1, @l2);
- join('', map { join(' ', @$_) . "\n" } sort { $a->[1] cmp $b->[1] } @l);
+ join('', map { join(' ', @$_) . "\n" } sort { $a->[1] cmp $b->[1] } @l), \@smb_credentials;
+}
+
+sub fstab_to_string {
+ my ($all_hds, $prefix) = @_;
+ my ($s, undef) = prepare_write_fstab($all_hds, $prefix, 'keep_smb_credentials');
+ $s;
}
sub write_fstab {
my ($all_hds, $prefix) = @_;
log::l("writing $prefix/etc/fstab");
- output("$prefix/etc/fstab", fstab_to_string($all_hds, $prefix));
+ my ($s, $smb_credentials) = prepare_write_fstab($all_hds, $prefix, '');
+ output("$prefix/etc/fstab", $s);
+ network::smb::save_credentials($_) foreach @$smb_credentials;
}
sub auto_fs() {
@@ -290,7 +324,7 @@ sub mount_options_unpack {
\%options, $unknown;
}
-sub mount_options_pack {
+sub mount_options_pack_ {
my ($part, $options, $unknown) = @_;
my ($non_defaults, $user_implies) = mount_options();
@@ -308,7 +342,12 @@ sub mount_options_pack {
push @l, map_each { if_($::b, $::a =~ /=$/ ? "$::a$::b" : $::a) } %$options;
push @l, $unknown;
- $part->{options} = join(",", uniq(grep { $_ } @l));
+ join(",", uniq(grep { $_ } @l));
+}
+sub mount_options_pack {
+ my ($part, $options, $unknown) = @_;
+ $part->{options} = mount_options_pack_($part, $options, $unknown);
+ MDK::Common::Various::noreturn();
}
sub mount_options_help {
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm
index f03c3a435..820b7baf7 100644
--- a/perl-install/network/smb.pm
+++ b/perl-install/network/smb.pm
@@ -4,6 +4,7 @@ use strict;
use diagnostics;
use common;
+use fs;
use network::network;
use network::smbnfs;
@@ -12,7 +13,13 @@ our @ISA = 'network::smbnfs';
sub to_fstab_entry {
my ($class, $e) = @_;
- $class->to_fstab_entry_raw($e, 'smbfs');
+ my $part = $class->to_fstab_entry_raw($e, 'smbfs');
+ if ($e->{server}{username}) {
+ my ($options, $unknown) = fs::mount_options_unpack($part);
+ $options->{"$_="} = $e->{server}{$_} foreach qw(username password domain);
+ fs::mount_options_pack($part, $options, $unknown);
+ }
+ $part;
}
sub from_dev {
my ($class, $dev) = @_;
@@ -55,20 +62,67 @@ sub find_exports {
my $ip = $server->{ip} ? "-I $server->{ip}" : '';
my $group = $server->{group} ? " -W $server->{group}" : '';
- # WARNING: using smbclient -L is ugly. It can't handle more than 15
- # characters shared names
+ my $U = $server->{username} ? "$server->{domain}/$server->{username}%$server->{password}" : '%';
- foreach (`smbclient -U% -L $name $ip$group`) {
+ foreach (`smbclient -U $U -L $name $ip$group`) {
chomp;
s/^\t//;
+ /NT_STATUS_/ and die $_;
my ($name, $type, $comment) = unpack "A15 A10 A*", $_;
if ($name eq '---------' && $type eq '----' && $comment eq '-------' .. /^$/) {
push @l, { name => $name, type => $type, comment => $comment, server => $server }
- if $type eq 'Disk' && $name !~ /\$$/;
+ if $type eq 'Disk' && $name !~ /\$$/ && $name !~ /NETLOGON|SYSVOL/;
}
}
+
@l;
}
-1;
+sub authentifications_available {
+ my ($server) = @_;
+ map { if_(/^auth.\Q$server->{name}.\E(.*)/, $1) } all("/etc/samba");
+}
+
+sub to_credentials {
+ my ($server_name, $username) = @_;
+ $username or die 'to_credentials';
+ "/etc/samba/auth.$server_name.$username";
+}
+
+sub fstab_entry_to_credentials {
+ my ($part) = @_;
+
+ my ($server_name) = network::smb->from_dev($part->{device}) or return;
+
+ my ($options, $unknown) = fs::mount_options_unpack($part);
+ $options->{'username='} && $options->{'password='} or return;
+ my %h = map { $_ => delete $options->{"$_="} } qw(username domain password);
+ $h{file} = $options->{'credentials='} = to_credentials($server_name, $h{username});
+ fs::mount_options_pack_($part, $options, $unknown), \%h;
+}
+sub remove_bad_credentials {
+ my ($server) = @_;
+ unlink to_credentials($server->{name}, $server->{username});
+}
+
+sub save_credentials {
+ my ($credentials) = @_;
+ my $file = $credentials->{file};
+ output($file, map { "$_ = $credentials->{$_}\n" } qw(username domain password));
+ chmod(0640, $file);
+}
+
+
+sub read_credentials_raw {
+ my ($file) = @_;
+ my %h = map { /(.*?)\s*=\s*(.*)/ } cat_($file);
+ \%h;
+}
+
+sub read_credentials {
+ my ($server, $username) = @_;
+ put_in_hash($server, read_credentials_raw(to_credentials($server->{name}, $username)));
+}
+
+1;
diff --git a/perl-install/network/smbnfs.pm b/perl-install/network/smbnfs.pm
index d380aac0f..6b55f6fd0 100644
--- a/perl-install/network/smbnfs.pm
+++ b/perl-install/network/smbnfs.pm
@@ -3,6 +3,8 @@ package network::smbnfs; # $Id$
use strict;
use diagnostics;
+use fs;
+
sub new {
my ($class, $v) = @_;