package Qpsmtpd::SMTP;
use Qpsmtpd;
@ISA = qw(Qpsmtpd);

package Qpsmtpd::SMTP;
use strict;
use Carp;

use Qpsmtpd::Plugin;
use Qpsmtpd::Constants;
use Qpsmtpd::Auth;
use Qpsmtpd::Address ();

use Mail::Header ();
use MIME::Base64;
#use Data::Dumper;
use POSIX qw(strftime);
use Net::DNS;

# this is only good for forkserver
# can't set these here, cause forkserver resets them
#$SIG{ALRM} = sub { respond(421, "Game over pal, game over. You got a timeout; I just can't wait that long..."); exit };
#$SIG{ALRM} = sub { warn "Connection Timed Out\n"; exit; };

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  my %args = @_;

  my $self = bless ({ args => \%args }, $class);

  my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit);
  my (%commands); @commands{@commands} = (1) x @commands;
  # this list of valid commands should probably be a method or a set of methods
  $self->{_commands} = \%commands;

  $self;
}

sub command_counter {
  my $self = shift;
  $self->{_counter} || 0;
}

sub dispatch {
  my $self = shift;
  my ($cmd) = lc shift;

  $self->{_counter}++; 

  if ( $self->authenticated == AUTH_PENDING ) {
      # must be in the middle of prompting for auth parameters
      return $self->auth_process($cmd,@_);
  }

  if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) {
    my ($rc, $msg) = $self->run_hooks("unrecognized_command", $cmd, @_);
    return $self->unrecognized_command_respond($rc, $msg, @_) unless $rc == CONTINUATION;
    return 1;
  }
  $cmd = $1;

  if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
    my ($result) = eval { $self->$cmd(@_) };
    $self->log(LOGERROR, "XX: $@") if $@;
    return $result if defined $result;
    return $self->fault("command '$cmd' failed unexpectedly");
  }

  return;
}

sub unrecognized_command_respond {
    my ($self, $rc, $msg) = @_;
    if ($rc == DENY_DISCONNECT) {
      $self->respond(521, $msg);
      $self->disconnect;
    }
    elsif ($rc == DENY) {
      $self->respond(500, $msg);
    }
    elsif ($rc != DONE) {
      $self->respond(500, "Unrecognized command");
    }
}

sub fault {
  my $self = shift;
  my ($msg) = shift || "program fault - command not performed";
  print STDERR "$0[$$]: $msg ($!)\n";
  return $self->respond(451, "Internal error - try again later - " . $msg);
}


sub start_conversation {
    my $self = shift;
    # this should maybe be called something else than "connect", see
    # lib/Qpsmtpd/TcpServer.pm for more confusion.
    my ($rc, $msg) = $self->run_hooks("connect");
    return $self->connect_respond($rc, $msg) unless $rc == CONTINUATION;
    return DONE;
}

sub connect_respond {
    my ($self, $rc, $msg) = @_;
    if ($rc == DENY) {
      $self->respond(550, ($msg || 'Connection from you denied, bye bye.'));
      $self->disconnect;
      return $rc;
    }
    elsif ($rc == DENYSOFT) {
      $self->respond(450, ($msg || 'Connection from you temporarily denied, bye bye.'));
      $self->disconnect;
      return $rc;
    }
    elsif ($rc == DONE) {
      return $rc;
    }
    elsif ($rc != DONE) {
      my $greets = $self->config('smtpgreeting');
      if ( $greets ) {
          $greets .= " ESMTP";
      }
      else {
          $greets = $self->config('me') 
            . " ESMTP qpsmtpd " 
            . $self->version 
            . " ready; send us your mail, but not your spam.";
      }

      $self->respond(220, $greets);
      return DONE;
    }
}

sub helo {
  my ($self, $hello_host, @stuff) = @_;
  return $self->respond (501,
    "helo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
  my $conn = $self->connection;
  return $self->respond (503, "but you already said HELO ...") if $conn->hello;

  my ($rc, $msg) = $self->run_hooks("helo", $hello_host, @stuff);
  return $self->helo_respond($rc, $msg, $hello_host, @stuff) unless $rc == CONTINUATION;
  return 1;
}

sub helo_respond {
  my ($self, $rc, $msg, $hello_host) = @_;
  if ($rc == DENY) {
    $self->respond(550, $msg);
  }
  elsif ($rc == DENYSOFT) {
    $self->respond(450, $msg);
  } elsif ($rc == DENY_DISCONNECT) {
      $self->respond(550, $msg);
      $self->disconnect;
  } elsif ($rc == DENYSOFT_DISCONNECT) {
      $self->respond(450, $msg);
      $self->disconnect;
  }
  elsif ($rc != DONE) {
    my $conn = $self->connection;
    $conn->hello("helo");
    $conn->hello_host($hello_host);
    $self->transaction;
    $self->respond(250, $self->config('me') ." Hi " . $conn->remote_info . 
                        " [" . $conn->remote_ip ."]; I am so happy to meet you.");
  }
}

sub ehlo {
  my ($self, $hello_host, @stuff) = @_;
  return $self->respond (501,
    "ehlo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
  my $conn = $self->connection;
  return $self->respond (503, "but you already said HELO ...") if $conn->hello;

  my ($rc, $msg) = $self->run_hooks("ehlo", $hello_host, @stuff);
  return $self->ehlo_respond($rc, $msg, $hello_host, @stuff) unless $rc == CONTINUATION;
  return 1;
}

sub ehlo_respond {
  my ($self, $rc, $msg, $hello_host) = @_;
  if ($rc == DENY) {
    $self->respond(550, $msg);
  }
  elsif ($rc == DENYSOFT) {
    $self->respond(450, $msg);
  } elsif ($rc == DENY_DISCONNECT) {
      $self->respond(550, $msg);
      $self->disconnect;
  } elsif ($rc == DENYSOFT_DISCONNECT) {
      $self->respond(450, $msg);
      $self->disconnect;
  }
  elsif ($rc != DONE) {
    my $conn = $self->connection;
    $conn->hello("ehlo");
    $conn->hello_host($hello_host);
    $self->transaction;

    my @capabilities = $self->transaction->notes('capabilities')
                        ? @{ $self->transaction->notes('capabilities') }
                        : ();

    # Check for possible AUTH mechanisms
    my %auth_mechanisms;
HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
        if ( $hook =~ m/^auth-?(.+)?$/ ) {
            if ( defined $1 ) {
                $auth_mechanisms{uc($1)} = 1;
            }
            else { # at least one polymorphous auth provider
                %auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5 LOGIN);
                last HOOK;
            }
        }
    }

    if ( %auth_mechanisms ) {
        push @capabilities, 'AUTH '.join(" ",keys(%auth_mechanisms));    
        $self->{_commands}->{'auth'} = "1";
    }

    $self->respond(250,
                 $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
                 "PIPELINING",
                 "8BITMIME",
                 ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
                 @capabilities,  
                );
  }
}

sub e64
{
  my ($arg) = @_;
  my $res = encode_base64($arg);
  chomp($res);
  return($res);
}

sub auth {
    my ( $self, $mechanism, $prekey ) = @_;
    
    #they AUTH'd once already
    return $self->respond( 503, "but you already said AUTH ..." )
      if ( $self->authenticated == OK );
    return $self->respond( 503, "AUTH not defined for HELO" )
      if ( $self->connection->hello eq "helo" );

    # $DB::single = 1;

    $self->auth_mechanism($mechanism);
    $self->authenticated(AUTH_PENDING);
    if ( $prekey ) { # easy single step
        unless ( $mechanism =~ /^(plain|login)$/i ) {
            # must be plain or login
            $self->respond( 500, "Unrecognized authentification mechanism" );
            return DECLINED;
        }
        my ($passHash, $user, $passClear) = split /\x0/,decode_base64($prekey);
        # we have all of the elements ready to go now
        if ( $mechanism =~ /login/i ) {
            $self->auth_user($user);
            return $self->auth_process(e64($passClear));
        }
        else {
            return $self->auth_process($prekey);
        }
    }
    else {
        if ( $mechanism =~ /plain/i ) {
          $self->respond( 334, "Please continue" );
        }
        elsif ( $mechanism =~ /login/i ) {
          $self->respond( 334, e64("Username:") );
        }
        elsif ( $mechanism =~ /cram-md5/i ) {
        # rand() is not cryptographic, but we only need to generate a globally
        # unique number.  The rand() is there in case the user logs in more than
        # once in the same second, or if the clock is skewed.
            my $ticket = sprintf( "<%x.%x\@" . $self->config("me") . ">",
                rand(1000000), time() );

            # Store this for later
            $self->auth_ticket($ticket);
            # We send the ticket encoded in Base64
            $self->respond( 334, encode_base64( $ticket, "" ) );
        }
    }
    return DECLINED;
}
        
sub auth_process {
    my ($self, $line) = @_;
    my ( $user, $passClear, $passHash, $ticket, $mechanism );
    
    # do this once here
    $mechanism = $self->auth_mechanism;
    $user = $self->auth_user;
    $ticket = $self->auth_ticket;
    
    if ( $mechanism eq 'plain' ) {
        ( $passHash, $user, $passClear ) = split /\x0/,
          decode_base64($line);
    }
    elsif ( $mechanism eq 'login' ) {
        if ( $user ) {
            # must be getting the password now
            $passClear = decode_base64($line);
        }
        else {
            # must be getting the user now
            $user = decode_base64($line);
            $self->auth_user($user);
            $self->respond(334, e64("Password:"));
        }
    }
    elsif ( $mechanism eq "cram-md5" ) {
        $line =~ tr/[\r\n]//d; # cannot simply chomp CRLF

        ( $user, $passHash ) = split( ' ', decode_base64($line) );

    }
    else {
        $self->respond( 500, "Unrecognized authentification mechanism" );
        return DECLINED;
    }
    if ($user eq '*') {
        $self->respond(501, "Authentification canceled");
        return DECLINED;
    }

    # check to see if we can proceed with the hooks
    if ( $user and ( $passClear or $passHash ) ) {
        # try running the specific hooks first
        my ( $rc, $msg ) =
          $self->run_hooks( "auth-$mechanism",
            $mechanism, $user, $passClear,
            $passHash, $ticket );

        # try running the polymorphous hooks next
        if ( !$rc || $rc == DECLINED ) {    
            ( $rc, $msg ) =
              $self->run_hooks( "auth", $mechanism, $user, $passClear,
                $passHash, $ticket );
        }
        return $self->auth_respond($rc, $msg, $mechanism, $user)
            unless $rc == CONTINUATION;
    }
    else {
        return CONTINUATION;
    }
}


sub auth_respond {
    my ($self, $rc, $msg, $mechanism, $user) = @_;
    if ( $rc == OK ) {
        $msg = "Authentication successful for $user" .
            ( defined $msg ? " - " . $msg : "" );
        $self->respond( 235, $msg );
        $self->connection->relay_client(1);
        $self->log( LOGINFO, $msg );
        $self->authenticated(OK);

        return OK;
    }
    else {
        $msg = "Authentication failed for $user" .
            ( defined $msg ? " - " . $msg : "" );
        $self->respond( 535, $msg );
        $self->log( LOGERROR, $msg );
        return DENY;
    }
}

sub mail {
  my $self = shift;
  return $self->respond(501, "syntax error in parameters") if !$_[0] or $_[0] !~ m/^from:/i;

  # -> from RFC2821
  # The MAIL command (or the obsolete SEND, SOML, or SAML commands)
  # begins a mail transaction.  Once started, a mail transaction
  # consists of a transaction beginning command, one or more RCPT
  # commands, and a DATA command, in that order.  A mail transaction
  # may be aborted by the RSET (or a new EHLO) command.  There may be
  # zero or more transactions in a session.  MAIL (or SEND, SOML, or
  # SAML) MUST NOT be sent if a mail transaction is already open,
  # i.e., it should be sent only if no mail transaction had been
  # started in the session, or it the previous one successfully
  # concluded with a successful DATA command, or if the previous one
  # was aborted with a RSET.

  # sendmail (8.11) rejects a second MAIL command.

  # qmail-smtpd (1.03) accepts it and just starts a new transaction.
  # Since we are a qmail-smtpd thing we will do the same.

  $self->reset_transaction;

  unless ($self->connection->hello) {
    return $self->respond(503, "please say hello first ...");
  }
  
  my $from_parameter = join " ", @_;
  $self->log(LOGINFO, "full from_parameter: $from_parameter");

  my ($from) = ($from_parameter =~ m/^from:\s*(<[^>]*>)/i)[0];

  # support addresses without <> ... maybe we shouldn't?
  ($from) = "<" . ($from_parameter =~ m/^from:\s*(\S+)/i)[0] . ">"
    unless $from;

  $self->log(LOGALERT, "from email address : [$from]");

  if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") {
    $from = Qpsmtpd::Address->new("<>");
  } 
  else {
    $from = (Qpsmtpd::Address->parse($from))[0];
  }
  return $self->respond(501, "could not parse your mail from command") unless $from;

  my ($rc, $msg) = $self->run_hooks("mail", $from);
  return $self->mail_respond($rc, $msg, $from) unless $rc == CONTINUATION;
  return 1;
}

sub mail_respond {
  my ($self, $rc, $msg, $from) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == DENY) {
    $msg ||= $from->format . ', denied';
    $self->log(LOGINFO, "deny mail from " . $from->format . " ($msg)");
    $self->respond(550, $msg);
  }
  elsif ($rc == DENYSOFT) {
    $msg ||= $from->format . ', temporarily denied';
    $self->log(LOGINFO, "denysoft mail from " . $from->format . " ($msg)");
    $self->respond(450, $msg);
  }
  elsif ($rc == DENY_DISCONNECT) {
    $msg ||= $from->format . ', denied';
    $self->log(LOGINFO, "deny mail from " . $from->format . " ($msg)");
    $self->respond(550, $msg);
    $self->disconnect;
  }
  elsif ($rc == DENYSOFT_DISCONNECT) {
    $msg ||= $from->format . ', temporarily denied';
    $self->log(LOGINFO, "denysoft mail from " . $from->format . " ($msg)");
    $self->respond(450, $msg);
    $self->disconnect;
  }
  else { # includes OK
    $self->log(LOGINFO, "getting mail from ".$from->format);
    $self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
    $self->transaction->sender($from);
  }
}

sub rcpt {
  my $self = shift;
  return $self->respond(501, "syntax error in parameters") unless $_[0] and $_[0] =~ m/^to:/i;
  return $self->respond(503, "Use MAIL before RCPT") unless $self->transaction->sender;

  my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0];
  $rcpt = $_[1] unless $rcpt;
  $self->log(LOGALERT, "to email address : [$rcpt]");
  $rcpt = (Qpsmtpd::Address->parse($rcpt))[0];

  return $self->respond(501, "could not parse recipient") unless $rcpt;

  my ($rc, $msg) = $self->run_hooks("rcpt", $rcpt);
  return $self->rcpt_respond($rc, $msg, $rcpt) unless $rc == CONTINUATION;
  return 1;
}

sub rcpt_respond {
  my ($self, $rc, $msg, $rcpt) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == DENY) {
    $msg ||= 'relaying denied';
    $self->respond(550, $msg);
  }
  elsif ($rc == DENYSOFT) {
    $msg ||= 'relaying denied';
    return $self->respond(450, $msg);
  }
  elsif ($rc == DENY_DISCONNECT) {
      $msg ||= 'delivery denied';
      $self->log(LOGINFO, "delivery denied ($msg)");
      $self->respond(550, $msg);
      $self->disconnect;
  }
  elsif ($rc == DENYSOFT_DISCONNECT) {
    $msg ||= 'relaying denied';
    $self->log(LOGINFO, "delivery denied ($msg)");
    $self->respond(421, $msg);
    $self->disconnect;
  }
  elsif ($rc == OK) {
    $self->respond(250, $rcpt->format . ", recipient ok");
    return $self->transaction->add_recipient($rcpt);
  }
  else {
    return $self->respond(450, "No plugin decided if relaying is allowed");
  }
  return 0;
}

sub help {
  my $self = shift;
  $self->respond(214, 
          "This is qpsmtpd " . 
          $self->config('smtpgreeting') ? '' : $self->version,
          "See http://smtpd.develooper.com/",
          'To report bugs or send comments, mail to <ask@develooper.com>.');
}

sub noop {
  my $self = shift;
  $self->respond(250, "OK");
}

sub vrfy {
  my $self = shift;

  # Note, this doesn't support the multiple ambiguous results
  # documented in RFC2821#3.5.1
  # I also don't think it provides all the proper result codes.

  my ($rc, $msg) = $self->run_hooks("vrfy");
  return $self->vrfy_respond($rc, $msg) unless $rc == CONTINUATION;
  return 1;
}

sub vrfy_respond {
  my ($self, $rc, $msg) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == DENY) {
    $self->respond(554, $msg || "Access Denied");
    $self->reset_transaction();
    return 1;
  }
  elsif ($rc == OK) {
    $self->respond(250, $msg || "User OK");
    return 1;
  }
  else { # $rc == DECLINED or anything else
    $self->respond(252, "Just try sending a mail and we'll see how it turns out ...");
    return 1;
  }
}

sub rset {
  my $self = shift;
  $self->reset_transaction;
  $self->respond(250, "OK");
}

sub quit {
  my $self = shift;
  my ($rc, $msg) = $self->run_hooks("quit");
  return $self->quit_respond($rc, $msg) unless $rc == CONTINUATION;
  return 1;
}

sub quit_respond {
  my ($self, $rc, $msg) = @_;
  if ($rc != DONE) {
    $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day.");
  }
  $self->disconnect();
}

sub disconnect {
  my $self = shift;
  $self->run_hooks("disconnect");
  $self->reset_transaction;
}

sub disconnect_respond { }

sub data {
  my $self = shift;
  my ($rc, $msg) = $self->run_hooks("data");
  return $self->data_respond($rc, $msg) unless $rc == CONTINUATION;
  return 1;
}

sub data_respond {
  my ($self, $rc, $msg) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == DENY) {
    $self->respond(554, $msg || "Message denied");
    $self->reset_transaction();
    return 1;
  }
  elsif ($rc == DENYSOFT) {
    $self->respond(451, $msg || "Message denied temporarily");
    $self->reset_transaction();
    return 1;
  } 
  elsif ($rc == DENY_DISCONNECT) {
    $self->respond(554, $msg || "Message denied");
    $self->disconnect;
    return 1;
  }
  elsif ($rc == DENYSOFT_DISCONNECT) {
    $self->respond(421, $msg || "Message denied temporarily");
    $self->disconnect;
    return 1;
  }
  $self->respond(503, "MAIL first"), return 1 unless $self->transaction->sender;
  $self->respond(503, "RCPT first"), return 1 unless $self->transaction->recipients;
  $self->respond(354, "go ahead");
  
  my $buffer = '';
  my $size = 0;
  my $i = 0;
  my $max_size = ($self->config('databytes'))[0] || 0;  # this should work in scalar context
  my $blocked = "";
  my %matches;
  my $in_header = 1;
  my $complete = 0;

  $self->log(LOGDEBUG, "max_size: $max_size / size: $size");

  my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE");

  my $timeout = $self->config('timeout');
  while (defined($_ = $self->getline($timeout))) {
    $complete++, last if $_ eq ".\r\n";
    $i++;

    # should probably use \012 and \015 in these checks instead of \r and \n ...

    # Reject messages that have either bare LF or CR. rjkaes noticed a
    # lot of spam that is malformed in the header.

    ($_ eq ".\n" or $_ eq ".\r")
        and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
        and return $self->disconnect;

    # add a transaction->blocked check back here when we have line by line plugin access...
    unless (($max_size and $size > $max_size)) {
      s/\r\n$/\n/;
      s/^\.\./\./;
      if ($in_header and m/^\s*$/) {
        $in_header = 0;
        my @headers = split /^/m, $buffer;

        # ... need to check that we don't reformat any of the received lines.
        #
        # 3.8.2 Received Lines in Gatewaying
        #   When forwarding a message into or out of the Internet environment, a
        #   gateway MUST prepend a Received: line, but it MUST NOT alter in any
        #   way a Received: line that is already in the header.

        $header->extract(\@headers);
        #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");

        $buffer = "";

        # FIXME - call plugins to work on just the header here; can
        # save us buffering the mail content.

        # Save the start of just the body itself        
        $self->transaction->set_body_start();

      }

      # grab a copy of all of the header lines
      if ($in_header) {
        $buffer .= $_;  
      }

      # copy all lines into the spool file, including the headers
      # we will create a new header later before sending onwards
      $self->transaction->body_write($_);
      $size += length $_;
    }
    #$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
  }

  $self->log(LOGDEBUG, "max_size: $max_size / size: $size");

  $self->transaction->header($header);

  my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
  my $authheader = ($self->authenticated == OK)
    ? "(smtp-auth username $self->auth_user, mechanism $self->auth_mechanism)\n"
    : "";

  $header->add("Received", "from ".$self->connection->remote_info
               ." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
               . ")\n  $authheader  by ".$self->config('me')." (qpsmtpd/".$self->version
               .") with $smtp; ". (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)),
               0);

  # if we get here without seeing a terminator, the connection is
  # probably dead.
  $self->respond(451, "Incomplete DATA"), return 1 unless $complete;

  #$self->respond(550, $self->transaction->blocked),return 1 if ($self->transaction->blocked);
  $self->respond(552, "Message too big!"),return 1 if $max_size and $size > $max_size;

  ($rc, $msg) = $self->run_hooks("data_post");
  return $self->data_post_respond($rc, $msg) unless $rc == CONTINUATION;
}

sub data_post_respond {
  my ($self, $rc, $msg) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == DENY) {
    $self->respond(552, $msg || "Message denied");
  }
  elsif ($rc == DENYSOFT) {
    $self->respond(452, $msg || "Message denied temporarily");
  } 
  else {
    $self->queue($self->transaction);    
  }

  # DATA is always the end of a "transaction"
  return $self->reset_transaction;
}

sub getline {
  my ($self, $timeout) = @_;
  
  alarm $timeout;
  my $line = <STDIN>; # default implementation
  alarm 0;
  return $line;
}

sub queue {
  my ($self, $transaction) = @_;

  my ($rc, $msg) = $self->run_hooks("queue");
  return $self->queue_respond($rc, $msg) unless $rc == CONTINUATION;
  return 1;
}

sub queue_respond {
  my ($self, $rc, $msg) = @_;
  if ($rc == DONE) {
    return 1;
  }
  elsif ($rc == OK) {
    $self->respond(250, ($msg || 'Queued'));
  }
  elsif ($rc == DENY) {
    $self->respond(552, $msg || "Message denied");
  }
  elsif ($rc == DENYSOFT) {
    $self->respond(452, $msg || "Message denied temporarily");
  } 
  else {
    $self->respond(451, $msg || "Queuing declined or disabled; try again later" );
  }
}


1;