#!/usr/bin/perl -w

use strict;
use Getopt::Std;
use vars qw(%aliases $opt_d $opt_a);
use subs qw(validate_recipient process_message read_aliases);
use Net::Server::Mail::ESMTP;

getopt('a:');

my $smtp = new Net::Server::Mail::ESMTP;
$smtp->set_callback(RCPT => \&validate_recipient);
$smtp->set_callback(DATA => \&process_message);

read_aliases;
$smtp->process;

#--

sub validate_recipient {
  my($session, $recipient) = @_;
  $recipient =~ s/^<//;
  $recipient =~ s/\@.*$//;
  return(0, 550, "Unknown user $recipient") unless exists $aliases{$recipient};
  return(1);
}

sub process_message {
  my($session, $data) = @_;

  #warn "DATA: ". $$data;

  my @recipients = $session->get_recipients();
  return(0, 554, 'Error: no valid recipients')
    unless(@recipients);

  foreach my $recipient ( @recipients ) {
    $recipient =~ s/^<//;
    $recipient =~ s/\@.*$//;

    open(PIPE, '|'.$aliases{$recipient})
      or return(0, 451, "Can't fork: $!" );
    print PIPE $$data
      or return(0, 451, "Can't write to pipe: $!" );
    close PIPE
      or return(0, 451, "Can't close: status=$?" );

  }

  return(1, 250, 'message piped');

}

#--

sub read_aliases {
  open(ALIASES, $opt_a || '/etc/aliases' ) or die $!;

  while(<ALIASES>) {
    chomp;
    s/^\s+//; s/\s+$//;
    next if /^$/ or /^#/;
    /^([\w\-\+\.]+):\s*("?)\|(.*)\2\s*$/ or next;
    #$aliases{$1} = [ split(/\s+/, $3) ];
    $aliases{$1} = $3;
  }

}

=head1 NAME

_smtpd - UnderSMTPD, the underscore SMTP daemon

=head1 SYNOPSIS

  #make some aliases
  echo 'username: "|someprogram and args"' > /etc/aliases

  #inetd setup
  echo "smtp stream tcp nowait mail /usr/local/bin/_smtpd" >>/etc/inetd.conf
  echo "_smtpd: my.mail.server.ip"                         >>/etc/hosts.allow
  echo "_smtpd: ALL"                                       >>/etc/hosts.deny

  #or add an smtp file to /etc/xinetd.d/
  service smtp
  {
  	socket_type = stream
  	protocol    = tcp
  	wait        = no
  	user        = mail
  	server      = /usr/local/bin/_smtpd
  }

=head1 DESCRIPTION

This is a minimal SMTP server which only forwards mail to pipe destinations
in /etc/aliases.  It does nothing else.  Its intended function is on an
internal mail server that forwards mail to other programs on a per address
basis.

UnderSMTPD reads /etc/aliases for usernames; if a match is identified
the message is piped to the given program.  Any problems executing the program
will cause a temporary SMTP error to be returned to the connecting client.

Other kinds of aliases are not recognized and cause a permanent SMTP error
to be returned to the connecting client, as do usernames not found in
/etc/aliases

UnderSMTP was originally written to be used with the Request Tracker ticketing
system.

UnderSMTP uses Net::SMTP::Mail to do all the hard work.

=head1 OPTIONS

=over 4

=item -a filename: Alternate aliases file

=back

=head1 ALIASES FORMAT

  username: |program and args
  username: "|program and args"

Quotes are not necessary around the pipe symbol, program and arguments but are
stripped if present.  Line continuations are not supported.

=head1 RT ALIASES EXAMPLE

  support: |/opt/rt3/bin/rt-mailgate --queue support --action correspond --url http://rt.example.com/
  billing: |/opt/rt3/bin/rt-mailgate --queue billing --action correspond --url http://rt.example.com/

=head1 BUGS

Yes.

=head1 AUTHOR

Ivan Kohler <ivan-undersmtpd@420.am>

=head1 SEE ALSO

L<Net::SMTP::Mail>

=cut

1;