### Copyright notice

# SMB - A perl module for accessing SMB resources.
# Copyright (C) 1998 Remco van Mook

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# The author can be contacted by e-mail: mook@cs.utwente.nl

package SMB;
use Exporter ();

use strict;
use vars qw( @ISA @EXPORT );
@ISA = qw(Exporter);
@EXPORT = qw( GetSMBTar GetSMBFile GetSMBDir GetSMBShr
              GetSMBHosts GetSMBGroups
              PutSMBFile PutSMBTar
);

## Configuration

my %cfg = ();
$cfg{bindir}="/usr/local/bin";
$cfg{masterbrowser}="biereco";

#sort an array of hashes by $_->{name} (for GetSMBDir et al)

sub byname {
  (lc $a->{name}) cmp (lc $b->{name})
}

# Gets the file //$host/$share/$file, using $user and $pass, to $target.
# And return the error code. If $target is unspecified, 
# STDOUT is used (-).
# Syntax: $error = GetSMBFile ($host,$share,$file,$user,$pass,$target)

sub GetSMBFile {
  my ($host, $share, $file, $user, $pass, $target) = @_;
  if ( $target eq "") { $target = "-" };
  $file =~ s/^(.*)\/([^\/]*)$/$1$2/ ;
  if ( $user ne "" ) { $user="-U $user"; }
  if ( $pass ne "") { 
    if ( $user eq "" ) {
      $user = "-U guest";
    }
  } else { 
    $pass = "-N";
  }
  my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user",  "-d0", "-c", "get \"$file\" $target");
  return system (@args);
}

# Makes a TAR of //$host/$share/$dir, using $user and $pass, to $target.
# And return the error code. If $target is unspecified, 
# STDOUT is used (-).
# Syntax: $error = GetSMBTar ($host,$share,$dir,$user,$pass,$target)

sub GetSMBTar {
  my ($host, $share, $dir, $user, $pass, $target) = @_;
  if ( $target eq "") { $target = "-" };
  if ( $user ne "" ) { $user="-U $user"; }
  if ( $pass ne "") { 
    if ( $user eq "" ) {
      $user = "-U guest";
    }
  } else { 
    $pass = "-N";
  }
  my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user", "-d0", "-D", "$dir", "-Tc", "$target");
  return system (@args); 
}

# Return an array with sorted dir and filelisting
# Syntax: @output = GetSMBDir (host,share,dir,user,pass)
# array contains hashes; keys: name, attr, size, date

sub GetSMBDir {
  my ($host, $share, $dir, $user, $pass ) = @_; 
  my @dir = (); my @files = ();
  if (! $user eq "") { $user = "-U ".$user }
  if ( $pass eq "") { $pass = "-N" } 

  my $lookup = "$cfg{bindir}/smbclient \"//$_[0]/$_[1]\" \"$pass\" \"$user\" -d0 -c ls -D \"$_[2]\"";

  my @out = `$lookup`;
  my $line;
  foreach $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
    }
  } 
  my @ret = sort byname @dir;
  @files = sort byname @files;
  foreach $line ( @files ) {
    push @ret, $line;
  }
  return @ret; 
}

# Return an array with sorted share listing 
# Syntax: @output = GetSMBShr (host)
# array contains hashes; keys: name, type, comment

sub GetSMBShr {
  my $share = $_[0];
  my @ret = ();
  my $lookup = "$cfg{bindir}/smbclient -L \'$share\' -d0";
  my @out = `$lookup`;
  my $line = shift @out;
  while ( (not $line =~ /^\s+Sharename/) and ($#out >= 0) ) {
    $line = shift @out;
  }
  if ($#out >= 0) {
    $line = shift @out;
    $line = shift @out; 
    while ( (not $line =~ /^$/) and ($#out >= 0) ) {
      if ( $line =~ /^\s+([\S ]*\S)\s+(Disk)\s+([\S ]*)/ ) {
        my $rec = {};
        $rec->{name} = $1;
        $rec->{type} = $2;
        $rec->{comment} = $3;
        push @ret, $rec;
      } 
      $line = shift @out;
    }
  }
  return sort byname @ret;
}

# Return an array with sorted host listing 
# Syntax: @output = GetSMBHosts (host,group)
# array contains hashes; keys: name, comment 

sub GetSMBHosts {
  my ($host,$workgroup) = @_;
  my @ret = ();
  my $lookup = "$cfg{bindir}/smbclient -L \"$host\" -W \"$workgroup\" -d0";
  my @out = `$lookup`;
  my $line = shift @out;

  while ((not $line =~ /^This machine has a browse list/) and ($#out >= 0) ) {
    $line = shift @out;
  }
  if ($#out >= 0) {
    $line = shift @out;
    $line = shift @out;
    $line = shift @out;
    $line = shift @out;
    while ((not $line =~ /^$/) and ($#out >= 0)) {
      if ( $line =~ /^\t([\S ]*\S) {5,}(\S[\S ]*|\S|)$/ ) {
        my $rec = {};
        $rec->{name} = $1;
        $rec->{comment} = $2;
        push @ret, $rec;
      }
      $line = shift @out;
    }
  }
  return sort byname @ret; 
}

# Return an array with sorted groups listing 
# Syntax: @output = GetSMBGroups ()
# array contains hashes; keys: name, master

sub GetSMBGroups {
  my @ret = ();
  my $lookup = "$cfg{bindir}/smbclient -L \"$cfg{masterbrowser}\" -d0";
  my @out = `$lookup`;
  my $line = shift @out;

  while ((not $line =~ /^This machine has a workgroup list/) and ($#out >= 0) ) {
    $line = shift @out;
  }
  if ($#out >= 0) {
    $line = shift @out;
    $line = shift @out;
    $line = shift @out;
    $line = shift @out;
    while ((not $line =~ /^$/) and ($#out >= 0) ) {
      if ( $line =~ /^\t([\S ]*\S) {2,}(\S[\S ]*)$/ ) {
        my $rec = {};
        $rec->{name} = $1;
        $rec->{master} = $2;
        push @ret, $rec;
      }
      $line = shift @out;
    }
  }
  return sort byname @ret;
}


# Puts the file $orig to //$host/$share/$file, using $user and $pass.
# And return the error code. If $orig is unspecified, 
# STDIN is used (-).
# Syntax: $error = PutSMBFile ($host,$share,$file,$user,$pass,$orig)

sub PutSMBFile {
  my ($host, $share, $file, $user, $pass, $orig) = @_;
  if ( $orig eq "") { $orig = "-" };
  $file =~ s/^(.*)\/([^\/]*)$/$1$2/ ;
  if ( $user ne "" ) { $user="-U $user"; }
  if ( $pass ne "") { 
    if ( $user eq "" ) {
      $user = "-U guest";
    }
  } else { 
    $pass = "-N";
  }
  my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user",  "-d0", "-c", "put \"$orig\" \"$file\"");
  return system (@args);
}

# Puts a TAR file $orig to //$host/$share/$dir, using $user and $pass.
# And return the error code. If $orig is unspecified, 
# STDIN is used (-).
# Syntax: $error = PutSMBTar ($host,$share,$dir,$user,$pass,$orig)

sub PutSMBTar {
  my ($host, $share, $dir, $user, $pass, $orig) = @_;
  if ( $orig eq "") { $orig = "-" };
  if ( $user ne "" ) { $user="-U $user"; }
  if ( $pass ne "") { 
    if ( $user eq "" ) {
      $user = "-U guest";
    }
  } else { 
    $pass = "-N";
  }
  my @args = ("$cfg{bindir}/smbclient", "//$host/$share", "$pass", "$user", "-d0", "-D", "$dir", "-Tx", "$orig");
  return system (@args); 
}