summaryrefslogtreecommitdiffstats
path: root/perl-install/network
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-07-28 07:12:39 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-07-28 07:12:39 +0000
commitb03c2c31b637587f40066fe4bb2eaa189c437679 (patch)
tree48eec8b5e955f8fcefefa6c10712274a4cab6faf /perl-install/network
parentd9b79dab0a06ab11e13bd6e7ca77b32ce4e08e53 (diff)
downloaddrakx-b03c2c31b637587f40066fe4bb2eaa189c437679.tar
drakx-b03c2c31b637587f40066fe4bb2eaa189c437679.tar.gz
drakx-b03c2c31b637587f40066fe4bb2eaa189c437679.tar.bz2
drakx-b03c2c31b637587f40066fe4bb2eaa189c437679.tar.xz
drakx-b03c2c31b637587f40066fe4bb2eaa189c437679.zip
- use option -g for smbclient -L, this fixes bad parsing of formatted smbclient output
- skip "netlogon" Disk share (lowercase letters)
Diffstat (limited to 'perl-install/network')
-rw-r--r--perl-install/network/smb.pm34
1 files changed, 20 insertions, 14 deletions
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm
index 4ef3f45a4..2deeb9507 100644
--- a/perl-install/network/smb.pm
+++ b/perl-install/network/smb.pm
@@ -42,7 +42,15 @@ sub smbclient {
my $group = $server->{group} ? " -W $server->{group}" : '';
my $U = $server->{username} ? sprintf("%s/%s%%%s", @$server{'domain', 'username', 'password'}) : '%';
- `smbclient -U $U -L $name $ip$group 2>/dev/null`;
+ my %h;
+ foreach (`smbclient -g -U $U -L $name $ip$group 2>/dev/null`) {
+ if (my ($type, $v1, $v2) = /(.*)\|(.*)\|(.*)/) {
+ push @{$h{$type}}, [ $v1, $v2 ];
+ } elsif (/^Error returning browse list/) {
+ push @{$h{Error}}, $_;
+ }
+ }
+ \%h;
}
sub find_servers {
@@ -64,10 +72,9 @@ sub find_servers {
}
if ($browse) {
my %l;
- foreach (smbclient($browse)) {
- my $nb = /^\s*Workgroup/ .. /^$/;
- $nb > 2 or next;
- my ($group, $name) = split(' ', lc($_));
+ my $workgroups = smbclient($browse)->{Workgroup} || [];
+ foreach (@$workgroups) {
+ my ($group, $name) = map { lc($_) } @$_;
# already done
next if any { $group eq $_->{group} } values %servers;
@@ -87,15 +94,14 @@ 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/;
- }
+ my $browse = smbclient($server);
+ if (my $err = find { /NT_STATUS_/ } @{$browse->{Error} || []}) {
+ die $err;
+ }
+ foreach (@{$browse->{Disk} || []}) {
+ my ($name, $comment) = @$_;
+ push @l, { name => $name, type => 'Disk', comment => $comment, server => $server }
+ if $name !~ /\$$/ && $name !~ /netlogon|NETLOGON|SYSVOL/;
}
@l;
}