- add authentification in diskdrake --smb (esp. for windows NT)

- use "credentials=" to put the passwords
(ideas and investigations from Stew Benedict,
 integrated by Pixel, but need testing)
Known bug: if you want to change the password when there are 2 entries in fstab
  using the same username=/password=, writing the credentials is done in random order,
  => you've got one chance in 2 that the password is changed :-(

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) = @_;