# -*- perl -*-
#
# $Id: SMBClient.pm,v 1.4 1997/01/10 01:30:43 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/SMBClient.pm,v $
# $Author: ejb $
#

require 5.001;
use strict;

package SMBClient;
my $package = "SMBClient";

# Field names
my $f_tochild = "tochild";
my $f_fromchild = "fromchild";
my $f_mypid = "mypid";
my $f_childpid = "childpid";
my $f_errorcode = "errorcode";
my $f_initialized = "initialized";

# Static Variables
my $id = 0;

# Routines

sub new
{
    my $class = shift;
    my $rep = +{$package => {} };

    if (@_ != 4)
    {
	die "usage: new $package(host, service, user, pass)\n";
    }
    my ($host, $service, $user, $pass) = @_;

    local(*CHILDIN, *TOCHILD, *FROMCHILD, *CHILDOUT);
    pipe CHILDIN, TOCHILD or
	die "$package: can't create child stdin pipe: $!\n";
    pipe FROMCHILD, CHILDOUT or
	die "$package: can't create child stdin pipe: $!\n";

    defined(my $pid = fork) or die "$package: fork failed: $!\n";
    if ($pid == 0)
    {
	close(TOCHILD);
	close(FROMCHILD);
	open(STDIN, "<&CHILDIN");
	open(STDOUT, ">&CHILDOUT");
	select(STDOUT);
	$| = 1;

	#
	# smbclient unbuffers its input and output, and prevents the
	# password from being visible to a user running ps, so this
	# actually works acceptably in most cases.
	#

	my $user_arg = ($user ne "" ? "-U $user" : "");
	my $pass_arg = ($pass eq "" ? "-N" : $pass);
	exec("smbclient '\\\\$host\\$service' $pass_arg $user_arg");

	# XXX Just kills child process....
	die "$package: exec of smbclient failed: $!\n";
    }

    select((select(TOCHILD), $| = 1)[0]);

    $rep->{$package}{$f_mypid} = $$;
    $rep->{$package}{$f_childpid} = $pid;
    $rep->{$package}{$f_tochild} = *TOCHILD;
    $rep->{$package}{$f_fromchild} = *FROMCHILD;
    $rep->{$package}{$f_errorcode} = "";
    $rep->{$package}{$f_initialized} = 0;

    kill 0, $pid
	or die "$package: child process appears to have failed to start\n";

    bless $rep, $class;

    my $response = $rep->p_read_from_client();
    if ($response !~ m/smb: \\> $/)
    {
	die "$package: unknown response from client:\n$response\n";
    }

    $rep->{$package}{$f_initialized} = 1;

    $rep;
}

sub DESTROY
{
    my $rep = shift;
    return unless $rep->initialized();
    if ($rep->p_mypid() == $$)
    {
	my $pid = $rep->p_childpid();
	kill 15, $pid;
	waitpid $pid, 0;
    }
    1;
}

sub p_mypid
{
    my $rep = shift;
    $rep->{$package}{$f_mypid};
}

sub p_childpid
{
    my $rep = shift;
    $rep->{$package}{$f_childpid};
}

sub p_tochild
{
    my $rep = shift;
    $rep->{$package}{$f_tochild};
}

sub p_fromchild
{
    my $rep = shift;
    $rep->{$package}{$f_fromchild};
}

sub initialized
{
    my $rep = shift;
    $rep->{$package}{$f_initialized};
}

sub p_read_from_client
{
    my $rep = shift;

    local(*FROMCHILD) = $rep->p_fromchild();
    
    my $oread_fds = '';
    my $fd = fileno(FROMCHILD);
    vec($oread_fds, $fd, 1) = 1;
    my $buf = "";

    my $len = sysread(FROMCHILD, $buf, 1);
    while ($len)
    {
	my $read_fds = $oread_fds;
	select($read_fds, undef, undef, 0);
	if (vec($read_fds, $fd, 1))
	{
	    my $len = sysread(FROMCHILD, $buf, 1, length($buf));
	}
	else
	{
	    last;
	}
    }

    $buf;
}

sub p_read_response
{
    my $rep = shift;
    my $response = $rep->p_read_from_client();
    $response =~ s/^smb:.*> $//m;
    $response;
}

sub p_command
{
    my $rep = shift;
    my $command = shift;
    local(*TOCHILD) = $rep->p_tochild();
    print TOCHILD $command, "\r\n";
    $rep->p_read_response();
}

sub p_process_response
{
    my $rep = shift;
    my $response = shift;
    my $okay = shift;

    my $result = 0;
    if ($response =~ m/^ERRDOS - (.*)$/m)
    {
	$rep->errorcode($1);
    }
    elsif ($response =~ m/$okay/)
    {
	$result = 1;
    }
    else
    {
	chomp $response;
	$rep->errorcode($response);
    }

    $result;
}

sub errorcode
{
    my $rep = shift;
    $rep->{$package}{$f_errorcode} = $_[0] if @_;
    $rep->{$package}{$f_errorcode};
}

sub chdir
{
    my $rep = shift;
    my $dir = shift;
    my $response = $rep->p_command("cd $dir");
    if ($response =~ m/ERRDOS - (.*)$/m)
    {
	$rep->errorcode($1);
	0;
    }
    else
    {
	1;
    }
}

sub get
{
    my $rep = shift;
    my ($remote, $local) = @_;
    $rep->p_process_response($rep->p_command("get $remote $local"),
			     '^getting');
}

sub put
{
    my $rep = shift;
    my ($local, $remote) = @_;
    $rep->p_process_response($rep->p_command("put $local $remote"),
			     '^putting');
}

sub delete
{
    my $rep = shift;
    my $file = shift;
    $rep->p_command("del $file");
}

sub mkdir
{
    my $rep = shift;
    my $dir = shift;
    my $response = $rep->p_command("mkdir $dir");
    if ($response =~ m/ERRDOS - (.*)$/m)
    {
	$rep->errorcode($1);
	0;
    }
    else
    {
	1;
    }
}

sub rmdir
{
    my $rep = shift;
    my $dir = shift;
    my $response = $rep->p_command("rmdir $dir");
    if ($response =~ m/ERRDOS - (.*)$/m)
    {
	$rep->errorcode($1);
	0;
    }
    else
    {
	1;
    }
}

sub list
{
    my $rep = shift;
    my $pattern = shift;
    my $response = $rep->p_command("ls $pattern");
    $response =~ s/\n\s+.*blocks.*blocks.*available.*$//;
    my @lines = split("\n", $response);
    my @files = ();
    for (@lines)
    {
	my @fields = (m/^  (.*?)\s+([RHSDANTC]*)\s+(\d+)\s+\w{3} (\w{3}) +(\d+) +(\d+):(\d+):(\d+) +(\d+)$/);
	push(@files, $1) if (defined($1) && ($1 ne ".") && ($1 ne ".."));
    }
    @files;
}

sub exists
{
    my $rep = shift;
    my $file = shift;
    my @files = $rep->list("$file");
    scalar(@files);
}

sub test
{
    shift;
    my $smb = new SMBClient(@_);
    print +($smb->chdir("test") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->chdir("qtest") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->get("passwd", "/trash") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->get("trash", "/tmp/aa") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->get("passwd", "/tmp/p") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->put("/tmp/p", "/not/here") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->put("/trash", "z") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->put("/tmp/p", "z") ? "ok" : $smb->errorcode()), "\n";
    print join(', ', $smb->list("")), "\n";
    print $smb->exists("z"), "\n";
    $smb->delete("z");
    print $smb->exists("z"), "\n";
    print +($smb->mkdir("z") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->mkdir("z") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->rmdir("z") ? "ok" : $smb->errorcode()), "\n";
    print +($smb->rmdir("z") ? "ok" : $smb->errorcode()), "\n";
    my $pid = $smb->p_childpid();
    system("ps $pid");
    undef $smb;
    system("ps $pid");
}

1;

#
# END OF SMBClient
#