From b03c2c31b637587f40066fe4bb2eaa189c437679 Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Wed, 28 Jul 2004 07:12:39 +0000
Subject: - use option -g for smbclient -L, this fixes bad parsing of formatted
 smbclient output - skip "netlogon" Disk share (lowercase letters)

---
 perl-install/network/smb.pm | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

(limited to 'perl-install/network/smb.pm')

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;
 }
-- 
cgit v1.2.1