summaryrefslogtreecommitdiffstats
path: root/perl-install/network/smb.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2002-07-02 17:01:41 +0000
committerPascal Rigaux <pixel@mandriva.com>2002-07-02 17:01:41 +0000
commitf34c4b838d4746ccc4639bf4554e6200407ae157 (patch)
treea1de87484e140092d10ecf14d47f6b95b960a18d /perl-install/network/smb.pm
parentc622536a93e78868e92719761a20bc65e62f0bd7 (diff)
downloaddrakx-backup-do-not-use-f34c4b838d4746ccc4639bf4554e6200407ae157.tar
drakx-backup-do-not-use-f34c4b838d4746ccc4639bf4554e6200407ae157.tar.gz
drakx-backup-do-not-use-f34c4b838d4746ccc4639bf4554e6200407ae157.tar.bz2
drakx-backup-do-not-use-f34c4b838d4746ccc4639bf4554e6200407ae157.tar.xz
drakx-backup-do-not-use-f34c4b838d4746ccc4639bf4554e6200407ae157.zip
try harder to find the full list of servers available, using "smbclient -L" to
check the workgroup masters
Diffstat (limited to 'perl-install/network/smb.pm')
-rw-r--r--perl-install/network/smb.pm50
1 files changed, 36 insertions, 14 deletions
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm
index 820b7baf7..d212f5122 100644
--- a/perl-install/network/smb.pm
+++ b/perl-install/network/smb.pm
@@ -35,20 +35,48 @@ sub check {
$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);
+ my ($ip, $browse);
foreach (`nmblookup -A @servers`) {
- if (my $nb = /^Looking up status of (\S+)/ .. /^$/) {
- if ($nb == 1) {
- $ip = $1;
- } else {
- /<00>/ or next;
- $servers{$ip}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/);
+ 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>/;
}
}
}
@@ -58,13 +86,8 @@ sub find_servers {
sub find_exports {
my ($class, $server) = @_;
my @l;
- 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}" : '%';
- foreach (`smbclient -U $U -L $name $ip$group`) {
+ foreach (smbclient($server)) {
chomp;
s/^\t//;
/NT_STATUS_/ and die $_;
@@ -74,7 +97,6 @@ sub find_exports {
if $type eq 'Disk' && $name !~ /\$$/ && $name !~ /NETLOGON|SYSVOL/;
}
}
-
@l;
}