#!/icg/bin/perl -sw

# simple forking daemon to provide SPF services
# mengwong+spf@pobox.com
# Tue Oct 28 00:46:44 EST 2003
# 
# echo "ip=IP\nhelo=HELOHOST\nsender=EMAILADDRESS\n" | nc localhost 5970
#
# or use Mail::Postfix::Attr to query spfd over a unix domain socket.
#
# ./spfd -port=5970                  # inet socket
# ./spfd -path=/var/spfd             # unix domain socket
#

use Mail::SPF::Query;
use Socket;

use strict;
use vars qw($port $path);

sub usage () {
  print "usage: spfd ( -port=5970 | -path=/var/spfd )\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);

DEBUG and print "$$: server is $server\n";

while (my $sock = $server->accept()) {
  if    (fork) { close $sock; wait; next; } # this is the grandfather trick.
  elsif (fork) {                    exit; } # the child exits immediately, so no zombies.

  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)} = $query->result();
    @a{qw(guess  smtp_guess   header_guess  )} = $query->best_guess();
  }

  if (DEBUG) {
    for (qw(result smtp_comment header_comment
	  guess  smtp_guess   header_guess)) {
      print "moo!  $_=$a{$_}\n";
    }
  }

  for (qw(result smtp_comment header_comment
	  guess  smtp_guess   header_guess)) {
    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;
}
