#!/usr/bin/perl -Tw
# Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
# The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
#
# For more information see http://develooper.com/code/qpsmtpd/
#
#

use lib 'lib';
use Qpsmtpd::TcpServer;
use Qpsmtpd::Constants;
use IO::Socket;
use IO::Select;
use Qpsmtpd::PollServer;
use Socket;
use Getopt::Long;
use POSIX qw(:sys_wait_h :errno_h :signal_h);
use strict;
$| = 1;

# Configuration
my $MAXCONN   = 15;                  # max simultaneous connections
my $PORT      = 2525;                # port number
my @LOCALADDR;                       # ip address(es) to bind to
my $USER      = 'smtpd';             # user to suid to
my $MAXCONNIP = 5;                   # max simultaneous connections from one IP
my $PID_FILE   = '';                 # file to which server PID will be written
our $DEBUG = 0;

sub usage {
        print <<"EOT";
usage: qpsmtpd-forkserver [ options ]
 -l, --listen-address addr : listen on specific address(es); can be specified
                             multiple times for multiple bindings.  Default is
			     0.0.0.0 (all interfaces).
 -p, --port P              : listen on a specific port; default 2525
 -c, --limit-connections N : limit concurrent connections to N; default 15
 -u, --user U              : run as a particular user (default 'smtpd')
 -m, --max-from-ip M       : limit connections from a single IP; default 5
     --pid-file P          : print main servers PID to file P
EOT
        exit 0;
}

GetOptions('h|help' => \&usage,
           'l|listen-address=s' => \@LOCALADDR,
           'c|limit-connections=i' => \$MAXCONN,
           'm|max-from-ip=i' => \$MAXCONNIP,
           'p|port=i' => \$PORT,
           'u|user=s' => \$USER,
           'pid-file=s' => \$PID_FILE,
           'd|debug+' => \$DEBUG,
	  ) || &usage;

# detaint the commandline
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
@LOCALADDR = ( '0.0.0.0' ) if !@LOCALADDR;
for (0..$#LOCALADDR) {
  if ($LOCALADDR[$_] =~ /^([\d\w\-.]+)$/) {
    $LOCALADDR[$_] = $1;
  } else {
    &usage;
  }
}
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage }
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage }

delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';

my %childstatus = ();

sub REAPER {
  while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
    last unless $chld > 0;
    ::log(LOGINFO,"cleaning up after $chld");
    delete $childstatus{$chld};
  }
}

sub HUNTSMAN {
  $SIG{CHLD} = 'DEFAULT';
  kill 'INT' => keys %childstatus;
  if ($PID_FILE && -e $PID_FILE) {
    unlink $PID_FILE or ::log(LOGERROR, "unlink: $PID_FILE: $!");
  }
  exit(0);
}

$SIG{INT} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN;

my $select = new IO::Select;

# establish SERVER socket(s), bind and listen.
for my $listen_addr (@LOCALADDR) {
  my $server = IO::Socket::INET->new(LocalPort => $PORT,
                                     LocalAddr => $listen_addr,
                                     Proto     => 'tcp',
                                     Reuse     => 1,
                                     Blocking  => 0,
                                     Listen    => SOMAXCONN )
    or die "Creating TCP socket $listen_addr:$PORT: $!\n";
  IO::Handle::blocking($server, 0);
  $select->add($server);
}

if ($PID_FILE) {
  if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage }
  if (-e $PID_FILE) {
    open PID, "+<$PID_FILE"
      or die "open pid_file: $!\n";
    my $running_pid = <PID>; chomp $running_pid;
    if ($running_pid =~ /(\d+)/) {
      $running_pid = $1;
      if (kill 0, $running_pid) {
        die "Found an already running qpsmtpd with pid $running_pid.\n";
      }
    }
    seek PID, 0, 0
      or die "Could not seek back to beginning of $PID_FILE: $!\n";
    truncate PID, 0
      or die "Could not truncate $PID_FILE at 0: $!";
  } else {
    open PID, ">$PID_FILE"
      or die "open pid_file: $!\n";
  }
  print PID $$,"\n";
  close PID;
}

# Load plugins here
my $qpsmtpd = Qpsmtpd::TcpServer->new();
$qpsmtpd->load_plugins;

# Drop privileges
my (undef, undef, $quid, $qgid) = getpwnam $USER or
      die "unable to determine uid/gid for $USER\n";
my $groups = "$qgid $qgid";
while (my ($name,$passwd,$gid,$members) = getgrent()) {
    my @m = split(/ /, $members);
    if (grep {$_ eq $USER} @m) {
	::log(LOGINFO,"$USER is member of group $name($gid)");
	$groups .= " $gid";
    }
}
$) = $groups;
POSIX::setgid($qgid) or
      die "unable to change gid: $!\n";
POSIX::setuid($quid) or
      die "unable to change uid: $!\n";
$> = $quid;

::log(LOGINFO,"Listening on port $PORT");
::log(LOGINFO, 'Running as user '.
	(getpwuid($>) || $>) .
	', group '.
	(getgrgid($)) || $)));

while (1) {
  REAPER();
  my $running = scalar keys %childstatus;
  if ($running >= $MAXCONN) {
    ::log(LOGINFO,"Too many connections: $running >= $MAXCONN.  Waiting one second.");
    sleep(1);
    next;
  }
  my @ready = $select->can_read(1);
  next if !@ready;
  while (my $server = shift @ready) {
    my ($client, $hisaddr) = $server->accept;
  
    if (!$hisaddr) {
      # possible something condition...
      next;
    }
    
    # Make this client blocking while we figure out if we actually want to
    # do something with it.
    IO::Handle::blocking($client, 1);
    my ($port, $iaddr) = sockaddr_in($hisaddr);
    if ($MAXCONNIP) {
      my $num_conn = 1; # seed with current value
  
      foreach my $rip (values %childstatus) {
        ++$num_conn if (defined $rip && $rip eq $iaddr);
      }
  
      if ($num_conn > $MAXCONNIP) {
        my $rem_ip = inet_ntoa($iaddr);
        ::log(LOGINFO,"Too many connections from $rem_ip: "
                     ."$num_conn > $MAXCONNIP. Denying connection.");
        $client->autoflush(1);
        print $client "451 Sorry, too many connections from $rem_ip, try again later\r\n";
        close $client;
        next;
      }
    }
    my $pid = safe_fork();
    if ($pid) {
      # parent
      $childstatus{$pid} = $iaddr;	# add to table
      # $childstatus{$pid} = 1;	# add to table
      $running++;
      close($client);
      next;
    }
    # otherwise child
  
    # all children should have different seeds, to prevent conflicts
    srand( time ^ ($$ + ($$ << 15)) );
  
    close($server);
  
    $SIG{$_} = 'DEFAULT' for keys %SIG;
    $SIG{ALRM} = sub { 
       print $client "421 Connection Timed Out\n";
       ::log(LOGINFO, "Connection Timed Out"); 
       exit; };
  
    ::log(LOGINFO, "Accepted connection $running/$MAXCONN");
    
    $::LineMode = 1;
    
    # Make this client non-blocking so it works with the Danga framework
    IO::Handle::blocking($client, 0);
    my $qp = Qpsmtpd::PollServer->new($client);
    $qp->load_plugins;
    $qp->init_logger;
    $qp->push_back_read("Connect\n");
    Qpsmtpd::PollServer->AddTimer(0.1, sub { });
    while (1) {
        $qp->enable_read;
        my $line = $qp->get_line;
        last if !defined($line);
        my $output = $qp->process_line($line);
        $qp->write($output) if $output;
    }
    
    exit;                                   # child leaves
  }
}

sub log {
  my ($level,$message) = @_;
  $qpsmtpd->log($level,$message);
}

### routine to protect process during fork
sub safe_fork {
  
  ### block signal for fork
  my $sigset = POSIX::SigSet->new(SIGINT);
  POSIX::sigprocmask(SIG_BLOCK, $sigset)
    or die "Can't block SIGINT for fork: [$!]\n";
  
  ### fork off a child
  my $pid = fork;
  unless( defined $pid ){
    die "Couldn't fork: [$!]\n";
  }

  ### make SIGINT kill us as it did before
  $SIG{INT} = 'DEFAULT';

  ### put back to normal
  POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
    or die "Can't unblock SIGINT for fork: [$!]\n";

  return $pid;
}

__END__

1;