eval 'exec /usr/local/bin/perl -sw -S $0 ${1+"$@"}'
if 0;
use Mail::SPF::Query;
use Socket;
use strict;
use vars qw($port $path $pathuser $pathgroup $pathmode $setuser $setgroup);
sub usage () {
print "usage: spfd ( -port=5970 | -path=/var/spfd ) [-setuser=(uid|username)] [-setgroup=(gid|groupname)]\n";
print "usage: [ -pathuser=(uid|username)] [ -pathgroup=(gid|groupname)] [-pathmode=mode]\n";
print "usage: spfd assuming -port=5970\n";
}
sub DEBUG () { $ENV{DEBUG} }
if (not $port and not $path) {
usage;
$port=5970;
}
if ($port and $path) {
usage;
exit 1;
}
$|++;
my @args;
my $sock_type;
if ($port) {
$sock_type = "inet";
@args = (Listen => 1,
LocalAddr => "127.0.0.1",
LocalPort => $port,
ReuseAddr => 1
);
print "$$ will listen on $port\n";
$0 = "spfd listening on $port";
} elsif ($path) {
$sock_type = "unix";
unlink $path if -S $path;
@args = (Listen => 1,
Local => $path,
);
print "$$ will listen at $path\n";
$0 = "spfd listening at $path";
}
print "$$: creating server with args @args\n";
my $server = $sock_type eq "inet" ? IO::Socket::INET->new(@args) : IO::Socket::UNIX->new(@args);
if ($path) {
if (defined $pathuser or defined $pathgroup) {
unless ( defined $pathuser ) { $pathuser = -1 }
unless ( defined $pathgroup ) { $pathgroup = -1 }
if ($pathuser =~ /\D/) {
$pathuser = getpwnam($pathuser) || die "User: $pathuser not found\n";
}
if ($pathgroup =~ /\D/) {
$pathgroup = getgrnam($pathgroup) || die "Group: $pathgroup not found\n";
}
chown $pathuser, $pathgroup, $path or die "chown call failed on $path: $!\n";
}
if (defined $pathmode) {
chmod oct($pathmode), $path or die "Cannot fixup perms on $path -- $!\n";
}
}
DEBUG and print "$$: server is $server\n";
if ($setgroup) {
if ($setgroup =~ /\D/) {
$setgroup = getgrnam($setgroup) || die "Group: $setgroup not found\n";
}
$( = $setgroup;
$) = $setgroup;
unless ($( == $setgroup and $) == $setgroup) {
die( "setgid($setgroup) call failed: $!\n" );
}
}
if ($setuser) {
if ($setuser =~ /\D/) {
$setuser = getpwnam($setuser) || die "User: $setuser not found\n";
}
$< = $setuser;
$> = $setuser;
unless ($< == $setuser and $> == $setuser) {
die( "setuid($setuser) call failed: $!\n" );
}
}
while (my $sock = $server->accept()) {
if (fork) { close $sock; wait; next; } elsif (fork) { exit; }
my $oldfh = select($sock); $| = 1; select($oldfh);
my %in;
while (<$sock>) {
chomp; chomp;
last if (/^$/);
my ($lhs, $rhs) = split /=/, $_, 2;
$in{lc $lhs} = $rhs;
}
my $peerinfo = $sock_type eq "inet" ? ($sock->peerhost . "/" . gethostbyaddr($sock->peeraddr, AF_INET)) : "";
my $time = localtime;
DEBUG and print "$time $peerinfo\n";
foreach my $key (sort keys %in) { DEBUG and print "learned $key = $in{$key}\n" };
my %q = map { exists $in{$_} ? ($_ => $in{$_}) : () } qw ( ip ipv4 ipv6 sender helo fallbacks guess_mechs );
my %a;
my $query = eval { Mail::SPF::Query->new(%q); };
my $error = $@; for ($error) { s/\n/ /; s/\s+$//; }
if ($@) { @a{qw(result smtp_comment header_comment)} = ("unknown", $error, "SPF error: $error"); }
else {
@a{qw(result smtp_comment header_comment spf_record)} = $query->result();
@a{qw(guess smtp_guess header_guess )} = $query->best_guess();
@a{qw(guess_tf smtp_tf header_tf )} = $query->trusted_forwarder();
}
if (DEBUG) {
for (qw(result smtp_comment header_comment
guess smtp_guess header_guess
guess_tf smtp_tf header_tf
spf_record
)) {
print "moo! $_=$a{$_}\n";
}
}
for (qw(result smtp_comment header_comment
guess smtp_guess header_guess
guess_tf smtp_tf header_tf
spf_record
)) {
no warnings 'uninitialized';
print $sock "$_=$a{$_}\n";
}
DEBUG and print "moo! output all done.\n";
print $sock "\n";
DEBUG and print "\n";
close $sock;
exit;
}