Net::Daemon version (Re: Fork server)

[Charlie Brady]

On Thu, 18 Mar 2004, Charlie Brady wrote:

> > Here's a way to do number of child limiting:
> 
> Another is to use the facilities of Net::Daemon.

Here's a quick hack at using Net::Daemon. No access control, or tuning of 
number of children yet. Has had a miniscule amount of testing.

#! /usr/bin/perl -w
 
use strict;
 
require Net::Daemon;
use lib 'lib';
use Qpsmtpd::TcpServer;
use Qpsmtpd::Constants;
 
delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
 
package Qpsmtpd::Forking;
 
use vars qw($VERSION @ISA);
$VERSION = '0.01';
@ISA = qw(Net::Daemon); # to inherit from Net::Daemon
 
use IO::Socket;
use Socket;
 
sub Run
{
    my($self) = @_;
    my $sock = $self->{'socket'};
 
    my $localsockaddr = getsockname($sock);
    my ($lport, $laddr) = sockaddr_in($localsockaddr);
    $ENV{TCPLOCALIP} = inet_ntoa($laddr);
    my $hisaddr = $sock->connected;
    my ($port, $iaddr) = sockaddr_in($hisaddr);
    $ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
    $ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, 'AF_INET') || "Unknown";
     
    # dup to STDIN/STDOUT
    POSIX::dup2(fileno($sock), 0);
    POSIX::dup2(fileno($sock), 1);
     
    my $qpsmtpd = $self->{'qpsmtpd'};
    $qpsmtpd->start_connection();
    $qpsmtpd->run();
 
    exit;                                   # child leaves
}
 
package main;
 
# Load plugins here
my $plugin_loader = Qpsmtpd::TcpServer->new();
$plugin_loader->load_plugins;
 
my $server = Qpsmtpd::Forking->new(
    {
        'pidfile' => 'none',
        'mode' => 'fork',
        'logfile' => 'STDERR',
        'localport' => 25,
        'user' => 'smtpd',
        'group' => 'smtpd',
        'qpsmtpd' => $plugin_loader,
    });
$server->Bind();