#!/usr/bin/perl

# Sendmail "socket" map script to perform SRS functions.
#
# Code by Mark Kramer <admin@asarian-host.net>
#
# Version 0.31
#
# Last revision: November 2, 2004
#
# With thanks to Jim Allen for pointing out a missing
# "while (!eof($client))" loop, causing BROKEN PIPE errors
# on concurrent connections.
#
# Licensed under GPL
#
# For detailed installation notes, read:
#
#           http://asarian-host.net/srs/sendmailsrs.htm
#
# See also: http://www.anarres.org/projects/srs/
#           http://spf.pobox.com/
#
# This version requires at least Sendmail 8.13.0 + Mail::SRS 0.30

use IO::Socket;
use POSIX qw (:sys_wait_h);
use Sys::Syslog qw (:DEFAULT setlogsock);
use Mail::SRS;
use strict;

my ($user, $login, $pass, $uid, $gid, $data, $socket_map, $old_address, $new_address, $use_address, $client, $sock);
my $secret = 'REDACTED';
my $fwdomain = 'REDACTED';
my $srs = new Mail::SRS (Secret => $secret, MaxAge => 8, HashLength => 8, AlwaysRewrite => 1);

sub write_syslog {
    setlogsock ('unix');
    openlog ('socketmapd', 'pid,cons', 'lpr') or exit 1;
    syslog ('info', @_);
    closelog ();
}

sub log_error_and_exit {
    write_syslog (@_);
    exit 1;
}

sub netstringRead {
    my $sock = shift;
    my $saveSeparator = $/;
    $/ = ':';
    my $dataLength = <$sock>;
    write_syslog ("WARNING: cannot read netstring length") unless defined ($dataLength);
    chomp ($dataLength);
    my $data;
    if ($sock -> read ($data, $dataLength) == $dataLength) {
        ($sock -> getc () eq ',') or write_syslog ("WARNING: data misses closing ,");
    } else {
        write_syslog ("WARNING: received only " . length ($data) . " of $dataLength bytes");
    }
    $/ = $saveSeparator;
    return $data;
}

sub netstringWrite {
    my $sock = shift;
    my $data = "OK " . shift;
    write_syslog ("WARNING: $@") if (not eval {print $sock length ($data) . ':' . $data . ','});
}

sub handleChildConnection {
    my $client = shift;
    while (not eval {eof ($client)}) {
        if (eval {$data = netstringRead ($client)}) {
            if ($data =~ /^(\S+) (\S+)$/) {
                $socket_map = $1;
                $old_address = $2;
               ($use_address = $old_address) =~ s/[<>]//g;
                $use_address =~ s/\.$//g;
                if ($socket_map eq 'reverse_srs') {
                    if ($use_address =~ /^SRS[01][-+=]/i) {
                        $use_address = $_ while (eval {$_ = $srs -> reverse ($use_address)});
                        $use_address .= '.>';
                        $use_address =~ s/\@/<@/;
                        netstringWrite ($client, $use_address);
                    } elsif ($use_address =~ /^\|/) {
                        netstringWrite ($client, "\"$old_address\"");
                    } else {
                        netstringWrite ($client, $old_address);
                    }
                } elsif ($socket_map eq 'make_srs') {
                    if (eval {$new_address = $srs -> reverse ($use_address)}) {
                        netstringWrite ($client, $old_address);
                    } elsif (eval {$new_address = $srs -> forward ($use_address, $fwdomain)}) {
                        $new_address .= '.>';
                        $new_address =~ s/\@/<@/;
                        netstringWrite ($client, $new_address);
                    } else {
                        netstringWrite ($client, $old_address);
                    }
                } else {
                    write_syslog ("WARNING: unknown socketmap, '$socket_map'");
                }
            } else {
                write_syslog ("WARNING: incomplete data, '$data'");
            }
        } else {
            write_syslog ("WARNING: unable to read from client");
        }
    }
}

if (not $user = lc ($ARGV[0])) {
    print STDERR "Missing user\n";
    print STDERR "Usage: $0 <user to run as>\n";
    exit 1;
} elsif ($>) {
    print STDERR "You need to start socketmapd as root!\n";
    exit 1;
} else {
   ($login, $pass, $uid, $gid) = getpwnam ($user);
    if (not defined ($uid)) {
        log_error_and_exit ("$user is not a valid user on this system!");
    } elsif (not $uid) {
        log_error_and_exit ("You cannot run socketmapd as root!");
    }
}

open (STDIN, '/dev/null');
open (STDOUT, '>/dev/null');
open (STDERR, '>&STDOUT');

umask (0027);

unlink ('/var/run/socketmapd.pid');
unlink ('/var/run/socketmapd.sock');

if ($_ = fork ()) {
    open (USERLOG, ">".'/var/run/socketmapd.pid') or exit 1;
    flock (USERLOG, 2);
    seek (USERLOG, 0, 0);
    print USERLOG " $_";
    close (USERLOG);
    exit 0;
}

POSIX::setsid () || exit 1;

if (not (eval {$sock = new IO::Socket::UNIX (
              Listen => SOMAXCONN,
                Type => SOCK_STREAM,
               Local => '/var/run/socketmapd.sock')})) {
    log_error_and_exit ("ERROR: Unable to create UNIX domain socket!");
}

chown $uid, $gid, '/var/run/socketmapd.sock';

$0 = 'socketmapd';

$) = $gid;
$( = $gid;
$> = $uid;
$< = $uid;

write_syslog ("Dropped privileges on socketmap daemon");

while (eval {$client = $sock -> accept ()}) {
    if (fork) {
        eval {$client -> close ()};
        wait;
    } elsif (fork) {
        exit 0;
    } else {
        eval {$sock -> close ()};
        eval {handleChildConnection ($client)};
        eval {$client -> close ()};
        exit 0;
    }
}

write_syslog ("Unsuccessful exit from the socketmap daemon: $!");

eval {$sock -> close ()};

exit 0;
