diff options
author | Mystery Man <unknown@mandriva.org> | 2002-07-08 07:45:08 +0000 |
---|---|---|
committer | Mystery Man <unknown@mandriva.org> | 2002-07-08 07:45:08 +0000 |
commit | be128d0615965c467107adeb2c8cecd1125318a1 (patch) | |
tree | 998f5b6803ad85a1411491ef4c499fa8b9760bb2 /perl-install/network/smb.pm | |
parent | 9555bb791920e8feace953f90cf908e864451b59 (diff) | |
download | drakx-backup-do-not-use-be128d0615965c467107adeb2c8cecd1125318a1.tar drakx-backup-do-not-use-be128d0615965c467107adeb2c8cecd1125318a1.tar.gz drakx-backup-do-not-use-be128d0615965c467107adeb2c8cecd1125318a1.tar.bz2 drakx-backup-do-not-use-be128d0615965c467107adeb2c8cecd1125318a1.tar.xz drakx-backup-do-not-use-be128d0615965c467107adeb2c8cecd1125318a1.zip |
This commit was manufactured by cvs2svn to create tag 'V1_1_8_2mdk'.V1_1_8_2mdk
Diffstat (limited to 'perl-install/network/smb.pm')
-rw-r--r-- | perl-install/network/smb.pm | 150 |
1 files changed, 0 insertions, 150 deletions
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm deleted file mode 100644 index d212f5122..000000000 --- a/perl-install/network/smb.pm +++ /dev/null @@ -1,150 +0,0 @@ -package network::smb; # $Id$ - -use strict; -use diagnostics; - -use common; -use fs; -use network::network; -use network::smbnfs; - - -our @ISA = 'network::smbnfs'; - -sub to_fstab_entry { - my ($class, $e) = @_; - 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) = @_; - $dev =~ m|//(.*?)/(.*)|; -} -sub to_dev_raw { - my ($class, $server, $name) = @_; - '//' . $server . '/' . $name; -} - -sub check { - my ($class, $in) = @_; - $class->raw_check($in, 'samba-client', '/usr/bin/nmblookup'); -} - -sub smbclient { - my ($server) = @_; - my $name = $server->{name} || $server->{ip}; - my $ip = $server->{ip} ? "-I $server->{ip}" : ''; - my $group = $server->{group} ? " -W $server->{group}" : ''; - - my $U = $server->{username} ? "$server->{domain}/$server->{username}%$server->{password}" : '%'; - `smbclient -U $U -L $name $ip$group`; -} - -sub find_servers { - my (undef, @l) = `nmblookup "*"`; - s/\s.*\n// foreach @l; - my @servers = grep { network::network::is_ip($_) } @l; - my %servers; - $servers{$_}{ip} = $_ foreach @servers; - my ($ip, $browse); - foreach (`nmblookup -A @servers`) { - my $nb = /^Looking up status of (\S+)/ .. /^$/ or next; - if ($nb == 1) { - $ip = $1; - } elsif (/<00>/) { - $servers{$ip}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/); - } elsif (/__MSBROWSE__/) { - $browse ||= $servers{$ip}; - } - } - if ($browse) { - my %l; - foreach (smbclient($browse)) { - my $nb = /^\s*Workgroup/ .. /^$/; - $nb > 2 or next; - my ($group, $name) = split(' ', lc($_)); - - # already done - next if grep { $group eq $_->{group} } values %servers; - - $l{$name} = $group; - } - if (my @l = keys %l) { - foreach (`nmblookup @l`) { - $servers{$1} = { name => $2, group => $l{$2} } if /(\S+)\s+([^<]+)<00>/; - } - } - } - values %servers; -} - -sub find_exports { - my ($class, $server) = @_; - my @l; - - foreach (smbclient($server)) { - 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 !~ /\$$/ && $name !~ /NETLOGON|SYSVOL/; - } - } - @l; -} - -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; |