#!/usr/bin/perl -sw-

# ----------------------------------------------------------
# 			  spfquery
#
# 		       Meng Weng Wong
#		  <mengwong+spf@pobox.com>
# $Id: spfquery,v 1.1 2004/04/19 17:50:29 dasenbro Exp $
# test an IP / helo / sender address tuple for pass/fail/softfail/unknown/error
#
# usage:
#        spfquery  -ipv4=127.0.0.1  -sender=myname@myhost.mydomain.com -helo=helohost.com
#
# echo "127.0.0.1 myname@myhost.mydomain.com helohost.com" | spfquery                    # preferred
# echo "myname@myhost.mydomain.com 127.0.0.1 helohost.com" | spfquery                    # deprecated
#
# output:
#
#   pass     (client localhost[1.2.3.4] is designated mailer for domain of sender myname@myhost.mydomain.com)
#   error    (temporary failure while resolving designated mailer status for domain of sender myname@myhost.mydomain.com)
#   unknown  (domain of sender myname@myhost.mydomain.com does not designate mailers)
#   fail     (client localhost[1.2.3.4] is not a designated mailer for domain of sender myname@myhost.mydomain.com)
#   softfail (client localhost[1.2.3.4] is not a designated mailer for transitioning domain of sender myname@myhost.mydomain.com)
#
# exit code: 0    fail
#            1    softfail
#            2    unknown
#            3    error
#            4    pass
#
# options:
# 
#  -guess_mechs="fasdfas fasf asdf"
#
# flags:  -q for quiet
#
# license: opensource.
#
# TODO: add ipv6 support
# ----------------------------------------------------------

# ----------------------------------------------------------
# 		       initialization
# ----------------------------------------------------------

my $looks_like_ipv4  = qr/\d+\.\d+\.\d+\.\d+/;
my $looks_like_email = qr/\S+\@\S+/;

# ----------------------------------------------------------
# 	 no user-serviceable parts below this line
# ----------------------------------------------------------

use strict;
use vars qw ($ipv4 $ip $sender $helo $fallback $debug $v $test $q $guess_mechs); $debug = defined $debug || defined $v;
use Mail::SPF::Query;

my $ExitCode = 255;

my @Fallbacks = grep { length } (defined $fallback ? split /,/, $fallback : defined $test ? "spf-test.mailzone.com" : "spf.mailzone.com");

my %Query = process_arguments();
if (exists $Query{ipv4}) {
  
  my $spfquery = new Mail::SPF::Query (%Query, debug=>$debug, fallbacks => \@Fallbacks);
      
  my ($passfail, $smtp_comment, $header_comment, $spf_record) = $spfquery->result;
  print STDERR "result=$passfail" . ($smtp_comment ? ": $smtp_comment" : "") . "\n" unless defined $q;
  print "Received-SPF: $passfail ($header_comment)\n" unless defined $q;

  my ($guess, $smtp_guess, $header_guess) = $spfquery->best_guess();
  print STDERR "guess=$guess" . ($smtp_guess ? ": $smtp_guess" : "") . "\n" unless defined $q;
  print "X-SPF-Guess: $guess ($header_guess)\n" if (not defined $q and $header_guess);

  exit0123($passfail);
}

my ($passfail, $text);
while (<>) {
  next if /^\s*\#/ || /^\s*$/;

  my %Query = process_line($_);
  my @output = ($Query{ipv4}, $Query{sender});
  my $Res;

  print STDERR "process_line got me @{[%Query]}\n" if $debug;

  my $spfquery = eval { new Mail::SPF::Query (%Query, debug=>defined $debug, fallbacks => \@Fallbacks, res=>$Res); };
  if ($@) { push @output, "error", $@; } # this conflates internal errors and DNS errors.
  else {
    $Res ||= $spfquery->resolver;
    ($passfail, $text) = $spfquery->result;
    push @output, $passfail, $text;
  }

  print join ("\t", @output), "\n";
}
exit0123($passfail);

# ----------------------------------------------------------
# 			 functions
# ----------------------------------------------------------

sub process_arguments {
  my %query;

  $query{guess_mechs} = $guess_mechs if defined $guess_mechs;
  $query{helo}   = $helo   if defined $helo;
  $query{ipv4}   = $ipv4   if defined $ipv4;
  $query{sender} = $sender if defined $sender;
  $query{ip}     = $ip     if defined $ip;
  $query{ipv4} = delete $query{ip} if $query{ip} and $query{ip} =~ $looks_like_ipv4;

  use Data::Dumper;

  { no warnings 'uninitialized';
    print STDERR "args: fallback=$query{fallback}, ip=$query{ip}, ipv4=$query{ipv4}, sender=$query{sender}\n" if $debug;
  }

  return %query;
}

sub process_line {
  my %query;
  local $_ = shift;

  s/\s+\#//;

  for (split) {
    $query{ipv4}   = $_ if /$looks_like_ipv4/;
    $query{sender} = $_ if /$looks_like_email/;
  }

  return %query;
}

sub exit0123 {
  my $passfail = shift;
  my $ExitCode = 255;

  $ExitCode=0 if $passfail eq "pass";
  $ExitCode=0 if $passfail eq "softfail";
  $ExitCode=1 if $passfail eq "fail";
  $ExitCode=2 if $passfail eq "error";
  $ExitCode=3 if $passfail eq "unknown";

  exit $ExitCode;
}

# ----------------------------------------------------------
# 		     format statements
# ----------------------------------------------------------