From 4026ee6b73851ac1dc2c9a77c85f6c3138456c5b Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Fri, 28 Jun 2002 21:15:04 +0000 Subject: - 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 :-( --- perl-install/network/smb.pm | 66 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 60 insertions(+), 6 deletions(-) (limited to 'perl-install/network/smb.pm') 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; -- cgit v1.2.1