view release on metacpan or  search on metacpan

bin/spfd  view on Meta::CPAN

  'set-group|setgroup=s',
  'help!'
);

if ($opt{help}) {
  usage;
  exit 0;
}

if ($opt{port} and $opt{socket}) {
  usage;
  exit 1;
}

if (not $opt{port} and not $opt{socket}) {
  print STDERR "Using default TCP/IP port.  Run `spfd --help` for possible options.\n";
  $opt{port} = 5970;
}

$| = 1;

my @args;
my $sock_type;

if ($opt{port}) {
  $sock_type = 'inet';
  @args = (Listen    => 1,
           LocalAddr => '127.0.0.1',
           LocalPort => $opt{port},
           ReuseAddr => 1
           );
  print "$$: will listen on TCP port $opt{port}\n";
  $0 = "spfd listening on TCP port $opt{port}";
} elsif ($opt{socket}) {
  $sock_type = 'unix';
  unlink $opt{socket} if -S $opt{socket};
  @args = (Listen => 1,
           Local => $opt{socket},
           );
  print "$$: will listen at UNIX socket $opt{socket}\n";
  $0 = "spfd listening at UNIX socket $opt{socket}";
}

print "$$: creating server with args @args\n";

my $server = $sock_type eq 'inet' ? IO::Socket::INET->new(@args) : IO::Socket::UNIX->new(@args);

if ($opt{socket}) {
  if (defined $opt{'socket-user'} or defined $opt{'socket-group'}) {
    $opt{'socket-user'}  = -1 if not defined($opt{'socket-user'});
    $opt{'socket-group'} = -1 if not defined($opt{'socket-group'});

    if ($opt{'socket-user'} =~ /\D/) {
      $opt{'socket-user'} = getpwnam($opt{'socket-user'}) || die "User: $opt{'socket-user'} not found\n";
    }

    if ($opt{'socket-group'} =~ /\D/) {
      $opt{'socket-group'} = getgrnam($opt{'socket-group'}) || die "Group: $opt{'socket-group'} not found\n";
    }

    chown $opt{'socket-user'}, $opt{'socket-group'}, $opt{socket} or die "chown call failed on $opt{socket}: $!\n";
  }
  if (defined $opt{'socket-perms'}) {
    chmod oct($opt{'socket-perms'}), $opt{socket} or die "Cannot fixup perms on $opt{socket}: $!\n";
  }
}

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

if ($opt{'set-group'}) {
  if ($opt{'set-group'} =~ /\D/) {
    $opt{'set-group'} = getgrnam($opt{'set-group'}) || die "Group: $opt{'set-group'} not found\n";
  }
  $( = $opt{'set-group'};
  $) = $opt{'set-group'};
  unless ($( == $opt{'set-group'} and $) == $opt{'set-group'}) {
    die( "setgid($opt{'set-group'}) call failed: $!\n" );
  }
}

if ($opt{'set-user'}) {
  if ($opt{'set-user'} =~ /\D/) {
    $opt{'set-user'} = getpwnam($opt{'set-user'}) || die "User: $opt{'set-user'} not found\n"; 
  }
  $< = $opt{'set-user'};
  $> = $opt{'set-user'};
  unless ($< == $opt{'set-user'} and $> == $opt{'set-user'}) {
    die( "setuid($opt{'set-user'}) call failed: $!\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 guess_mechs trusted local );

  my %a;

  my $query = eval { Mail::SPF::Query->new(%q); };

  my $error = $@; for ($error) { s/\n/ /; s/\s+$//; }