Filesys-SmbClientParser
view release on metacpan or search on metacpan
SmbClientParser.pm view on Meta::CPAN
sub GetHosts
{
my ($self,$host,$user,$pass,$wg,$ip) = @_;
my $out = _List(@_) || return undef;
my @out = @$out;
my @ret = ();
my $line = shift @out;
while ((not $line =~ /Server\s*Comment/) and ($#out >= 0) )
{$line = shift @out;}
if ($#out >= 0)
{
$line = shift @out;$line = shift @out;
while ((not $line =~ /^$/) and ($#out >= 0))
{
chomp($line);
if ( $line =~ /^\t([\S ]*\S) {5,}(\S|.*)$/ )
{
my $rec = {};
$rec->{name} = $1;
$rec->{comment} = $2;
push @ret, $rec;
}
$line = shift @out;
}
}
return sort byname @ret;
}
#------------------------------------------------------------------------------
# GetGroups
#------------------------------------------------------------------------------
sub GetGroups
{
my ($self,$host,$user,$pass,$wg,$ip) = @_;
my $out = _List(@_) || return undef;
my @ret = ();
my @out = @$out;
my $line = shift @out;
while ((not $line =~ /Workgroup/) and ($#out >= 0) )
{$line = shift @out;}
if ($#out >= 0)
{
$line = shift @out;
while ((not $line =~ /^$/) and ($#out >= 0) )
{
$line = shift @out;
if ( $line =~ /^\t([\S ]*\S) {2,}(\S[\S ]*)$/ )
{
my $rec = {};
$rec->{name} = $1;
$rec->{master} = $2;
push @ret, $rec;
}
}
}
return sort byname @ret;
}
#------------------------------------------------------------------------------
# sendWinpopupMessage
#------------------------------------------------------------------------------
sub sendWinpopupMessage
{
my ($self, $dest, $text) = @_;
my $args = "/bin/echo \"$text\" | ".$self->{SMBLIENT}." -M $dest";
return $self->command($args,"winpopup message");
}
#------------------------------------------------------------------------------
# cd
#------------------------------------------------------------------------------
sub cd
{
my $self = shift;
my $dir = shift;
if ($dir)
{
my $commande;
if ($dir ne ".."){$commande = "cd \"$dir\""; }
else { $commande = "cd .."; }
$self->SmbScript($commande, undef, @_) || return undef;
if ($dir=~/^\//) {$self->{DIR}=$dir;}
elsif ($dir=~/^..$/)
{if ($self->{DIR}=~/(.*\/)(.+?)$/) {$self->{DIR}=$1;}}
elsif($self->{DIR}=~/\/$/){ $self->{DIR}.=$dir; }
else{$self->{DIR}.='/'.$dir;}
return 1;
}
else {return $self->{DIR};}
}
#------------------------------------------------------------------------------
# dir
#------------------------------------------------------------------------------
sub dir {
my $self = shift;
my $dir = shift;
my (@dir,@files);
$dir = $self->{DIR} unless $dir;
my $cmd = "ls \"$dir/*\"";
$self->SmbScript($cmd,undef,@_) || return undef;
my $out = $self->LastResponse;
foreach my $line ( @$out ) {
if ($line=~/^ ([\S ]*\S|[\.]+) {5,}([HDRSA]+) +([0-9]+) (\S[\S ]+\S)$/g){
my $rec = {};
$rec->{name} = $1;
$rec->{attr} = $2;
$rec->{size} = $3;
$rec->{date} = $4;
if ($rec->{attr} =~ /D/) {push @dir, $rec;}
else {push @files, $rec;}
}
elsif ($line =~ /^ ([\S ]*\S|[\.]+) {6,}([0-9]+) (\S[\S ]+\S)$/) {
my $rec = {};
$rec->{name} = $1;
$rec->{attr} = "";
$rec->{size} = $2;
$rec->{date} = $3;
push @files, $rec; # No attributes at all, so it must be a file
}
}
return (sort byname @dir, sort byname @files);
}
#------------------------------------------------------------------------------
# mkdir
SmbClientParser.pm view on Meta::CPAN
elsif ($var=~/ERRgeneral/)
{$er="Cmd $command: General failure.";}
elsif ($var=~/ERRbadshare/)
{$er="Cmd $command: An open conflicts with an existing open.";}
elsif ($var=~/ERRlock/)
{$er="Cmd $command: A Lock request conflicted with an existing lock or specified an invalid mode, or an Unlock requested attempted to remove a lock held by another process.";}
elsif ($var=~/ERRwrongdisk/)
{$er="Cmd $command: The wrong disk was found in a drive.";}
elsif ($var=~/ERRFCBUnavail/)
{$er="Cmd $command: No FCBs are available to process request.";}
elsif ($var=~/ERRsharebufexc/)
{$er="Cmd $command: A sharing buffer has been exceeded.";}
elsif ($var=~/ERRDOS - 183 renaming files/)
{$er="Cmd $command: File target already exist.";}
# elsif ($var=~/ERR/) {$er="Cmd $command: reserved.";}
elsif ($var=~/(NT_STATUS_[^ \n]*)/ && $1 ne 'NT_STATUS_OK') {
$er = $1; }
$self->{LAST_REP} = \@var;
$self->{LAST_ERR} = $er if ($er);
return (defined($er) ? undef : 1);
}
#------------------------------------------------------------------------------
# POD DOCUMENTATION
#------------------------------------------------------------------------------
=head1 NAME
Filesys::SmbClientParser - Perl client to reach Samba ressources with smbclient
=head1 SYNOPSIS
use Filesys::SmbClientParser;
my $smb = new Filesys::SmbClientParser
(undef,
(
user => 'Administrateur',
password => 'password'
));
# Or like -A parameters:
$smb->Auth("/home/alian/.smbpasswd");
# Set host
$smb->Host('jupiter');
# List host available on this network machine
my @l = $smb->GetHosts;
foreach (@l) {print $_->{name},"\t",$_->{comment},"\n";}
# List share disk available
my @l = $smb->GetShr;
foreach (@l) {print $_->{name},"\n";}
# Choose a shared disk
$smb->Share('games2');
# List content
my @l = $smb->dir;
foreach (@l) {print $_->{name},"\n";}
# Send a Winpopup message
$smb->sendWinpopupMessage('jupiter',"Hello world !");
# File manipulation
$smb->cd('jdk1.1.8');
$smb->get("COPYRIGHT");
$smb->mkdir('tata');
$smb->cd('tata');
$smb->put("COPYRIGHT");
$smb->del("COPYRIGHT");
$smb->cd('..');
$smb->rmdir('tata');
# Archive method
$smb->tar('c','/tmp/jdk.tar');
$smb->cd('..');
$smb->mkdir('tatz');
$smb->cd('tatz');
$smb->tar('x','/tmp/jdk.tar');
See test.pl file for others examples.
=head1 DESCRIPTION
SmbClientParser work with output of bin smbclient, so it doesn't work
on win platform. (but query of win platform work of course)
A best method is work with a samba shared librarie and xs language,
but on Nov.2000 (Samba version prior to 2.0.8) there is no public
interface and shared library defined in Samba projet.
Request has been submit and accepted on Samba-technical mailing list,
so I've build another module called Filesys-SmbClient that use features
of this library. (libsmbclient.so)
For Samba client prior to 2.0.8, use this module !
SmbClientParser is adapted from SMB.pm make by Remco van Mook
mook@cs.utwente.nl on smb2www project.
=head1 INTERFACE
=head2 Objects methods
=over
=item new [PATH_OF_SMBCLIENT], [HASH_OF_PARAM]
Create a new FileSys::SmbClientParser instance. Search bin smbclient,
and fail if it can't find it in standard location.
(ENV{PATH}, /usr/bin, /usr/local/bin, /opt/bin or /usr/local/samba/bin/).
If it's on another directory, use parameter PATH_OF_SMBCLIENT.
HASH_OF_PARAM is a hash with key user,host,password,workgroup,ipadress,share
=item Host [HOSTNAME]
Get or set the remote host to be used to HOSTNAME.
=item User [USERNAME]
Get or set the username to be used to USERNAME.
=item Share [SHARENAME]
Get or set the share to be used on the remote host to SHARENAME.
=item Password [PASSWORD]
Get or set the password to be used to PASSWORD.
=item Workgroup [WORKGROUP]
Get or set the workgroup to be used to WORKGROUP.
See -W switch in smbclient man page.
=item IpAdress [IP]
Set or get the IP adress of the server to contact to IP
See -I switch in smbclient man page.
=item Debug [LEVEL]
Set or get the debug verbosity
0 = no output
1+ = more output
=item Auth AUTH_FILE
Use the file AUTH_FILE for username and password.
This uses User and Password instead of -A to be backwards
compatible. Return 1 if AUTH_FILE can be read, 0 else.
=back
=head2 Network methods
=over
=item GetGroups [HOSTNAME, USER, PASSWORD, WORKGROUP, IP]
If no parameters is given, field will be used.
Return an array with sorted workgroup listing that contains hashes;
keys: name, master
=item GetShr [HOSTNAME, USER, PASSWORD, WORKGROUP, IP]
If no parameters is given, field will be used.
Return an array with sorted share listing, that contains hashes;
keys: name, type, comment
=item GetHosts [HOSTNAME, USER, PASSWORD, WORKGROUP, IP]
Return an array with sorted host listing, that contains hashes;
keys: name, comment
=item sendWinpopupMessage DEST, TEXT
This method allows you to send messages, using the "WinPopup" protocol,
to another computer. If the receiving computer is running WinPopup the
user will receive the message and probably a beep. If they are not
running WinPopup the message will be lost, and no error message will occur.
The message is also automatically truncated if the message is over
1600 bytes, as this is the limit of the protocol.
Parameters :
DEST: name of host or user to send message
TEXT: text to send
=back
=head2 Operations
=over
=item cd [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
If DIR is specified, the current working directory on the server
will be changed to the directory specified. This operation will fail if for
any reason the specified directory is inaccessible. Return list.
If no directory name is specified, the current working directory on the server
will be reported.
=item dir [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
Return an array with sorted dir and filelisting that contains hashes;
keys: name, attr, size, date
=item mkdir NAME, [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
Create a new directory on the server with the specified name NAME
=item rmdir NAME, [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
Remove the specified directory NAME from the server. NAME can be a pattern.
=item get FILE, [TARGET, DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
Gets the file FILE from the server to the local machine, using USER and
PASSWORD, to TARGET on current SMB server and return the error code.
If TARGET is unspecified, current directory will be used.
If specified, name the local copy TARGET.
For use STDOUT, set target to '-'.
=item del FILE, [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
The client will request that the server attempt to delete
all files matching FILE from the current working directory
on the server
=item rename SOURCE, TARGET, [DIR, HOSTNAME ,USER, PASSWORD, WORKGROUP, IP]
The file matched by mask SOURCE will be moved to TARGET. These names
( run in 0.921 second using v1.01-cache-2.11-cpan-364913b4093 )