diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/diskdrake/smbnfs_gtk.pm | 37 | ||||
| -rw-r--r-- | perl-install/fs.pm | 51 | ||||
| -rw-r--r-- | perl-install/network/smb.pm | 66 | ||||
| -rw-r--r-- | perl-install/network/smbnfs.pm | 2 |
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) = @_; |