package Net::SMTP::Server::Client;
require 5.001;

use strict;
use vars qw($VERSION @ISA @EXPORT);

require Exporter;
require AutoLoader;
use Carp;
use IO::Socket;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();

$VERSION = '1.2';

my %_cmds = (
	    DATA => \&_data,
	    EXPN => \&_noway,
	    HELO => \&_hello,
	    HELP => \&_help,
	    MAIL => \&_mail,
	    NOOP => \&_noop,
	    QUIT => \&_quit,
	    RCPT => \&_receipt,
	    RSET => \&_reset,
	    VRFY => \&_noway,		
		#
		EHLO => \&_ehlo,
	    AUTH => \&_auth,	    
	);
	
my %_auths = (
	PLAIN => \&_auth_plain,
	LOGIN => \&_auth_login,
);

# Utility functions.
sub _put {
$Net::SMTP::Server::Client::DEBUG and print STDOUT @_,"\r\n";
    print {shift->{SOCK}} @_, "\r\n";
}

sub _reset {
    my $self = shift;
    
    $self->{FROM} = undef;
    $self->{TO} = [];
    
    $self->_put("250 Fine fine.");
}

# New instance.
sub new {
    my($this, $sock) = @_;
    
    my $class = ref($this) || $this;
    my $self = {};
    $self->{FROM} = undef;
    $self->{TO} = [];
    $self->{MSG} = undef;
    $self->{SOCK} = $sock;
	
    $self->{authmethod} = undef;
    $self->{user} = undef;
    $self->{pass} = undef;
    
    bless($self, $class);
    
    croak("No client connection specified.") unless defined($self->{SOCK});
    $self->_put("220 MacGyver SMTP Ready.");
    return $self;
}

sub process {
    my $self = shift;
    my($cmd, @args);
    
    my $sock = $self->{SOCK};    
    while(my $line = <$sock>) {

$Net::SMTP::Server::Client::DEBUG and print STDOUT $line;

		# Clean up.
		chomp $line;
		$line =~ s/^\s+//;
		$line =~ s/\s+$//;
		if (!length $line) {
			$self->_put("500 Learn to type!");
			next;
		}
		
		($cmd, @args) = split(/\s+/,$line);
		
		$cmd =~ tr/a-z/A-Z/;
		
		if( !defined $_cmds{$cmd} ) {
			$self->_put("500 Learn to type!");
			next;
		}
		
		return(defined($self->{MSG}) ? 1 : 0) unless
			&{$_cmds{$cmd}}($self, \@args);
    }

    return undef;
}

# ------------------
use Sys::Hostname;
sub _ehlo {
	my $self = shift;
		
    my $host = Sys::Hostname::hostname;
	$self->_put("250 $host MacGyver SMTP");
	$self->_put("250-$host");
	$self->_put("250-AUTH " . join(" ",keys %_auths) );	
}

sub __check_login {
	my ($user,$pass) = @_;
	return if not length $user;
	return if not length $pass;
	
	if ( open my $db, '<', 'login.db' ) {
		my @logins = <$db>;
		chomp @logins;
		my ($line) = grep /^\Q$user\E\t/,@logins;
#warn $line;
		my ($found_user, $found_pass) = split/\s+/,$line;
#warn ("$found_user|$found_pass");
		return ($found_user eq $user and $found_pass eq $pass);
	} 
	else {
		croak "Login 'login.db' database missing!";
	}
}

sub _auth_plain {
	my $self = shift;
	
	$self->_put("334"); 
	my $sock = $self->{SOCK}; 
	my $line = <$sock>;
$Net::SMTP::Server::Client::DEBUG and print STDOUT $line;
	chomp $line;
	($self->{user}, $self->{pass}, undef) = (split /\x00/,$line);
}

use MIME::Base64;
sub _auth_login {
	my $self = shift;	
	my $sock = $self->{SOCK};   

	if (not length $self->{user} ) {
		$self->_put("334 VXNlcm5hbWU6"); # Username:
$Net::SMTP::Server::Client::DEBUG and print STDOUT $self->{user};
		$self->{user} = <$sock>;
		chomp $self->{user};		
		$self->{user} = decode_base64($self->{user});			
	} 
	if (not length $self->{pass} ) {		
		$self->_put("334 UGFzc3dvcmQ6"); # Password:
		$self->{pass} = <$sock>;
$Net::SMTP::Server::Client::DEBUG and print STDOUT $self->{pass};
		chomp $self->{pass};		
		$self->{pass} = decode_base64($self->{pass});
	}			
}

sub _auth {
	my $self = shift;	
	my $args = shift;
	
	$self->{authmethod} = $$args[0];
	$self->{loggedin} = undef;
	$self->{user} = undef;
    $self->{pass} = undef;
	
	if ( $_auths{ $self->{authmethod} } ) {
		&{ $_auths{ $self->{authmethod} } }($self); #get login with AUTH ....
		
		if ($self->{user} and $self->{pass} ) {
			$self->{loggedin} = __check_login($self->{user},$self->{pass});				
		}
		
		if (not length $self->{user} ) {
			$self->_put("503 OMG. I cant gess your user login!");		
		}
		elsif (not length $self->{pass} ) {
			$self->_put("503 Really? Give me your password!");
		}
		elsif ($self->{loggedin} ) {
			$self->_put("235 2.7.0 Authentication successful");
		}
		else {
			$self->_put("535 Authentication failed. Restarting authentication process.");
		}
	}	
	else {
		$self->_put("504 Authentication mechanism not supported.");
	}
}

# ----------

sub _fromto {
    my $self = shift;
    my($which, $var, $args) = @_;
    
    if(!($$args[0] =~ /^$which\s*([^\s]+)/i)) {
	if(!$$args[1] || !($$args[0] =~ /^$which$/i)) {
	    $self->_put("501 Bzzzz.");
	    return -1;
	}
	
	ref($var) eq 'ARRAY' ? (push @$var, $$args[1]) : ($$var = $$args[1]);
    }
    
    ref($var) eq 'ARRAY' ? (push @$var, $1) : ($$var = $1) unless !defined($1);
    
    $self->_put("250 Ok...got it.");
}

sub _mail {
    my $self = shift;
	
	if (!$self->{loggedin}) {
		$self->_put("530 SMTP authentication is required.");
		return 0;
    }
	
    return $self->_fromto('FROM:', \$self->{FROM}, @_);
}

sub _receipt {
    my $self = shift;
	
	if (!$self->{loggedin}) {
		$self->_put("530 SMTP authentication is required.");
		return 0;
    }
	
    return $self->_fromto('TO:', \@{ $self->{TO} }, @_);
}

sub _data {
    my $self = shift;
    my $done = undef;
	
	if (!$self->{loggedin}) {
		$self->_put("530 SMTP authentication is required.");
		return 0;
    }
    
    if(!defined($self->{FROM})) {
	$self->_put("503 Yeah, right.  Tell me who you are first!");
	return 1;
    }
    
    if(!defined(@{$self->{TO}})) {
	$self->_put("503 You want me to read your mind?  Tell me who to send it to!");
	return 1;
    }

    $self->_put("354 Give it to me, big daddy.");

    my $sock = $self->{SOCK};
    
    while(<$sock>) {
	if(/^\.\r\n$/) {
	    $done = 1;
	    last;
	}
	
	# RFC 821 compliance.
	s/^\.\./\./;
	$self->{MSG} .= $_;
    }
    
    if(!defined($done)) {
	$self->_put("550 Fine...who needs you anyway!");
	return 1;
    }
    
    $self->_put("250 I got it darlin'.");
}

sub _noway {
    shift->_put("252 Nice try.");
}

sub _noop {
    shift->_put("250 Whatever.");
}

sub _help {
    my $self = shift;
    my $i = 0;
    my $str = "214-Commands\r\n";
    my $total = keys(%_cmds);
    
    foreach(sort(keys(%_cmds))) {
	if(!($i++ % 5)) {
	    if(($total - $i) < 5) {
		$str .= "\r\n214 ";
	    } else {
		$str .= "\r\n214-";
	    }
	} else {
	    $str .= ' ';
	}
	
	$str .= $_;
    }
    
    $self->_put($str);
}

sub _quit {
    my $self = shift;
    
    $self->_put("221 Good.");
    $self->{SOCK}->close;
    return 0;
}

sub _hello {
    shift->_put("250 You're polite.");
}



1;
__END__
# POD begins here.

=head1 NAME

Net::SMTP::Server::Client - Client session handling for Net::SMTP::Server.

=head1 SYNOPSIS

  use Carp;
  use Net::SMTP::Server;
  use Net::SMTP::Server::Client;
  use Net::SMTP::Server::Relay;

  $server = new Net::SMTP::Server('localhost', 25) ||
    croak("Unable to handle client connection: $!\n");

  while($conn = $server->accept()) {
    # We can perform all sorts of checks here for spammers, ACLs,
    # and other useful stuff to check on a connection.

    # Handle the client's connection and spawn off a new parser.
    # This can/should be a fork() or a new thread,
    # but for simplicity...
    my $client = new Net::SMTP::Server::Client($conn) ||
	croak("Unable to handle client connection: $!\n");

    # Process the client.  This command will block until
    # the connecting client completes the SMTP transaction.
    $client->process || next;
    
    # In this simple server, we're just relaying everything
    # to a server.  If a real server were implemented, you
    # could save email to a file, or perform various other
    # actions on it here.
    my $relay = new Net::SMTP::Server::Relay($client->{FROM},
					     $client->{TO},
					     $client->{MSG});
  }

=head1 DESCRIPTION

The Net::SMTP::Server::Client module implements all the session
handling required for a Net::SMTP::Server::Client connection.  The
above example demonstrates how to use Net::SMTP::Server::Client with
Net::SMTP::Server to handle SMTP connections.

$client = new Net::SMTP::Server::Client($conn)

Net::SMTP::Server::Client accepts one argument that must be a handle
to a connection that will be used for communication.

Once you have a new client session, simply call:

$client->process

This processes an SMTP transaction.  THIS MAY APPEAR TO HANG --
ESPECIALLY IF THERE IS A LARGE AMOUNT OF DATA BEING SENT.  Once this
method returns, the server will have processed an entire SMTP
transaction, and is ready to continue.

Once $client->process returns, various fields have been filled in.
Those are:

  $client->{TO}    -- This is an array containing the intended
                      recipients for this message.  There may be
                      multiple recipients for any given message.

  $client->{FROM}  -- This is the sender of the given message.
  $client->{MSG}   -- The actual message data. :)

=head1 AUTHOR AND COPYRIGHT
Net::SMTP::Server / SMTP::Server is Copyright(C) 1999, 
  MacGyver (aka Habeeb J. Dihu) <macgyver@tos.net>.  ALL RIGHTS RESERVED.

You may distribute this package under the terms of either the GNU
General Public License or the Artistic License, as specified in the
Perl README file. 

=head1 SEE ALSO

Net::SMTP::Server::Server, Net::SMTP::Server::Relay

=cut