view release on metacpan or  search on metacpan

sbin/spfd  view on Meta::CPAN

deprecated_option('pathuser',   'socket-user',  $options);
deprecated_option('pathgroup',  'socket-group', $options);
deprecated_option('pathmode',   'socket-perms', $options);
deprecated_option('setuser',    'set-user',     $options);
deprecated_option('setgroup',   'set-group',    $options);

my $port                = $options->{port};
my $socket_path         = $options->{socket};
my $socket_user         = $options->{'socket-user'};
my $socket_group        = $options->{'socket-group'};
my $socket_perms        = $options->{'socket-perms'};
my $set_user            = $options->{'set-user'};
my $set_group           = $options->{'set-group'};

my $default_explanation = $options->{'default-explanation'};
my $hostname            = $options->{hostname};

my $debug               = defined($options->{debug}) ? $options->{debug} : $ENV{DEBUG};

if (defined($port) and defined($socket_path)) {
    usage();
    exit(255);
}

if (not defined($port) and not defined($socket_path)) {
    $port = default_port;
    STDERR->print("Using default TCP/IP port ($port).  Run `spfd --help` for supported options.\n");
}

# Main Program
##############################################################################

STDOUT->autoflush(TRUE);

my $listen_socket;

if (defined($port)) {
    require IO::Socket::INET;
    $listen_socket = IO::Socket::INET->new(
        Listen      => TRUE,
        LocalAddr   => '127.0.0.1',
        LocalPort   => $port,
        ReuseAddr   => TRUE
    );
    print("spfd (PID $$): Listening on TCP/IP port $port.\n");
    #$0 = "spfd listening on TCP port $port";
}
elsif (defined($socket_path)) {
    require IO::Socket::UNIX;
    unlink $socket_path
        if -S $socket_path;
    $listen_socket = IO::Socket::UNIX->new(
        Listen      => TRUE,
        Local       => $socket_path
    );
    print("spfd (PID $$): Listening on UNIX socket '$socket_path'.\n");
    #$0 = "spfd listening on UNIX socket $socket_path";

    $socket_user  = normalize_uid($socket_user);
    $socket_group = normalize_gid($socket_group);
    chown($socket_user, $socket_group, $socket_path)
        or die("Unable to chown($socket_user, $socket_group) socket '$socket_path'")
        if $socket_user != -1 or $socket_path != -1;

    chmod(oct($socket_perms), $socket_path)
        or die("Unable to chmod($socket_perms) socket '$socket_path': $!")
        if defined($socket_perms);
}

if (defined($set_group)) {
    $set_group = normalize_gid($set_group);
    $( = $) = $set_group;
    $( == $set_group and $) == $set_group
        or die("Unable to setgid($set_group): $!");
}

if (defined($set_user)) {
    $set_user = normalize_uid($set_user);
    $< = $> = $set_user;
    $< == $set_user and $> == $set_user
        or die("Unable to setuid($set_user): $!");
}

my $spf_server = Mail::SPF::Server->new(
    default_authority_explanation
                    => $default_explanation,
    hostname        => $hostname,

    # Black Magic:
    # TODO
    # max-dns-interactive-terms
    # max-name-lookups-per-term
    # more?
);

# Handle Client Connections
##############################################################################

while (my $socket = $listen_socket->accept()) {
    if (fork) {
        # Parent process.
        close($socket);
        wait;  # Reap our immediate child (the grand-child will run on its own).
        next;
    }
    elsif (fork) {
        # Child process, parent of grand-child process.
        # The child exits immediately in order to avoid zombies:
        exit;
    }

    # Grand-child process.

    my $time = gmtime;
    if ($debug) {
        my $peerinfo =
            $listen_socket->isa('IO::Socket::INET') ?
                sprintf(" from %s [%s]", scalar(gethostbyaddr($socket->peeraddr, AF_INET)), $socket->peerhost)
            :   '';
        print("\n");
        print("[$time] Incoming connection" . $peerinfo . "\n");
    }