summaryrefslogtreecommitdiffstats
path: root/perl-install/network
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2001-08-19 15:29:04 +0000
committerPascal Rigaux <pixel@mandriva.com>2001-08-19 15:29:04 +0000
commit1e75d751473c604972637807ed1bb75d7d8b4b5f (patch)
tree41fb4482298ae60c33fab24ff32743230780d7cb /perl-install/network
parentcae5d8a4be62874d71a3c84d94e94bbfe0df7bad (diff)
downloaddrakx-1e75d751473c604972637807ed1bb75d7d8b4b5f.tar
drakx-1e75d751473c604972637807ed1bb75d7d8b4b5f.tar.gz
drakx-1e75d751473c604972637807ed1bb75d7d8b4b5f.tar.bz2
drakx-1e75d751473c604972637807ed1bb75d7d8b4b5f.tar.xz
drakx-1e75d751473c604972637807ed1bb75d7d8b4b5f.zip
basic smb handling
Diffstat (limited to 'perl-install/network')
-rw-r--r--perl-install/network/smb.pm57
1 files changed, 57 insertions, 0 deletions
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm
new file mode 100644
index 000000000..d5c128b41
--- /dev/null
+++ b/perl-install/network/smb.pm
@@ -0,0 +1,57 @@
+package network::smb;
+
+use common;
+use network::network;
+
+sub check {
+ my ($in) = @_;
+ my $f = '/usr/bin/nmblookup';
+ -e $f or $in->do_pkgs->install('samba-client');
+ -e $f or $in->ask_warn('', "Mandatory package samba-client is missing"), return;
+ 1;
+}
+
+
+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);
+ 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+)/);
+ }
+ }
+ }
+ values %servers;
+}
+
+sub find_exports {
+ my ($server) = @_;
+ my @l;
+ my $name = $server->{name} ? " -L $server->{name}" : '';
+ my $group = $server->{group} ? " -W $server->{group}" : '';
+
+ # WARNING: using smbclient -L is ugly. It can't handle more than 15
+ # characters shared names
+
+ foreach (`smbclient -U% -L -I $server->{ip}$name$group`) {
+ chomp;
+ s/^\t//;
+ my ($name, $type, $comment) = unpack "A15 A10 A*", $_;
+ if ($name eq '---------' && $type eq '----' && $comment eq '-------' .. /^$/) {
+ push @l, { name => $name, type => $type, comment => $comment }
+ if $type eq 'Disk' && $name ne 'ADMIN$';
+ }
+ }
+ @l;
+}
+
+1;
+