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