#!/usr/bin/perl
#
# Check google spf vs ipf.conf or iptables
#
# $Header: /home/doke/work/nagios/RCS/check_google_spf,v 1.4 2016/05/02 13:45:15 doke Exp $


use strict;
use warnings;
use Getopt::Long;
#use Mail::SPF;
#use Mail::SPF::Query;
#use Data::Dumper;

use vars qw( $verbose $help @crits @warns @unknowns @oks @ignores %domains
    %nets %a_cache $domain $nlookups );

$ENV{PATH}='/usr/local/bin:/usr/sbin:/sbin:/usr/bin:/bin';

$verbose = 0;
$help = 0;
$nlookups = 0;


sub usage {
    my( $rc ) = @_;
    print "Usage: $0 [-vh] [domain]
    -v    verbose
    -h    help
";
    exit $rc;
    }

Getopt::Long::Configure ("bundling");
GetOptions(
    'v+' => \$verbose,
    'h' => \$help,
    );
&usage( 0 ) if ( $help );

$domain = shift || "google.com";

#&get_spf( $domain );
#count_spf();

#undef %nets, %domains;
&get_spf2( '+', $domain );
count_spf();

&check_ipf();
&check_iptables();

my $rc = 0;
my $sep = '';
if ( $#crits >= 0 ) {
    $rc = 2;
    print "CRITICAL ", join( ", ", @crits );
    $sep = '; ';
    }
if ( $#warns >= 0 ) {
    $rc = 1 if ( $rc == 0 );
    print $sep, "Warning ", join( ", ", @warns );
    $sep = '; ';
    }
if ( $#unknowns >= 0 ) {
    $rc = -1 if ( $rc == 0 );
    print $sep, "Unknown ", join( ", ", @unknowns );
    $sep = '; ';
    }
if ( $rc == 0 ) {
    print "Ok ", join( ", ", @oks );
    $sep = '; ';
    }
if ( $#ignores >= 0 ) {
    print $sep, "Ignoring ", join( ", ", @ignores );
    }

print "\n";
exit $rc;


##################

sub get_spf {
    my( $inherited_qualifier, $domain ) = @_;
    my( $spf_server, $request, $result, $term, $key, $global_mod, 
	$new_qualifier );

    print "get_spf( $inherited_qualifier, $domain )\n";

    $domains{ $domain } = 1;

    $spf_server  = Mail::SPF::Server->new();

    $request = Mail::SPF::Request->new(
        versions    => [1, 2],              # optional
        scope       => 'mfrom',             # or 'helo', 'pra'
        identity    => 'foo@google.com',
	authority_domain => $domain,
        ip_address  => '209.85.128.0',
	);

    eval { 
	$result = $spf_server->select_record($request);
	};
    $verbose && print "result dump ", Dumper( $result ), "\n";
    $nlookups++;

    foreach $term ( @{$result->{ terms }} ) { 
	$verbose && printf "%s %s %s\n", 
	    $term->text,
	    $term->qualifier,
	    $term->name;
	$new_qualifier = combine_qualifiers( $inherited_qualifier, 
	    $term->qualifier );
	if ( $term->name eq 'a' ) { 
	    $verbose && printf "    %s\n", $term->domain_spec->text;
	    get_spf( $new_qualifier, $term->domain_spec->text );
	    }
	elsif ( $term->name eq 'mx' ) { 
	    get_mx( $new_qualifier, $domain );
	    }
	elsif ( $term->name eq 'ip4' ) { 
	    $verbose && printf "    %s/%s\n", $term->ip_address, $term->ipv4_prefix_length;
	    if ( $new_qualifier eq '+' ) { 
		$nets{ $term->ip_address . '/' . $term->ipv4_prefix_length } = 1;
		}
	    }
	elsif ( $term->name eq 'ip6' ) { 
	    $verbose && printf "    %s/%s\n", $term->ip_address, $term->ipv6_prefix_length;
	    if ( $new_qualifier eq '+' ) { 
		#$nets{ $term->ip_address . '/' . $term->ipv6_prefix_length } = 1;
		}
	    }
	elsif ( $term->name eq 'exists' ) { 
	    $verbose && printf "    %s\n", $term->domain_spec->text;
	    get_spf( $new_qualifier, $term->domain_spec->text );
	    }
	elsif ( $term->name eq 'redirect' ) { 
	    $verbose && printf "    %s\n", $term->domain_spec->text;
	    get_spf( $new_qualifier, $term->domain_spec->text );
	    }
	elsif ( $term->name eq 'include' ) { 
	    $verbose && printf "    %s\n", $term->domain_spec->text;
	    get_spf( $new_qualifier, $term->domain_spec->text );
	    }
	elsif ( $term->name eq 'ptr' ) { 
	    $verbose && printf "    %s\n", $term->domain_spec->text;
	    get_spf( $new_qualifier, $term->domain_spec->text );
	    }
	else { 
	    $verbose && print "can't parse '$term->text'\n";
	    push @warns, "can't parse '$term->text'";
	    }
	}

    foreach $key ( keys %{$result->{ global_mods }} ) { 
	$global_mod = $result->{ global_mods }->{ $key },
	$verbose && printf "%s %s %s\n", 
	    $key,
	    $global_mod->text,
	    $global_mod->name;
	if ( $global_mod->name eq 'redirect' ) { 
	    $verbose && printf "    %s\n", $global_mod->domain_spec->text;
	    get_spf( $global_mod->domain_spec->text );
	    }
	}
    }  # get_spf 




# get_spf2
# try to parse it ourselves out of dig
# 
sub get_spf2 {
    my( $inherited_qualifier, $domain ) = @_;
    my( $spf, @directives, $directive, $qualifier, $mechanism, $net,
	$domain2, $txtH, $new_qualifier );

    $verbose && print "get_spf2( $inherited_qualifier, $domain )\n";

    if ( $domains{ $domain } ) { 
	# already did this one
	return;
	}
    $domains{ $domain } = 1;

    # This routine is recursive, so keep the file pointer in a 
    # my variable.
    if ( ! open( $txtH, '-|', "dig txt '$domain'" ) ) { 
    	push @unknowns, "can't dig txt $domain";
	return;
	}
    $nlookups++;

    while ( <$txtH> ) { 
	$verbose >= 2 && print "< $_";
	chomp;
    	if ( m/\sTXT\s+"v=spf1 (.*)"/i ) { 
	    $spf = $1; 
	    $spf =~ s/"\s+"//g; 
	    $verbose && print "> $_\n";
	    @directives = split( m/\s+/, $spf ); 
	    foreach $directive ( @directives ) { 
		$verbose >= 2 && print "directive $directive\n";
		if ( $directive =~ m/^([~?+-]?)a:(.*)/i ) { 
		    $qualifier = $1 || '+';
		    $domain2 = $2;
		    $new_qualifier = combine_qualifiers( $inherited_qualifier, 
			$qualifier );
		    get_a( $new_qualifier, $domain2 );
		    }
		elsif ( $directive =~ m/^([~?+-]?)mx$/ ) { 
		    $qualifier = $1 || '+';
		    $new_qualifier = combine_qualifiers( $inherited_qualifier, 
			$qualifier );
		    get_mx( $new_qualifier, $domain );
		    }
		elsif ( $directive =~ m/^([~?+-]?)(ip[46]):(.*)/i ) { 
		    $qualifier = $1 || '+';
		    $mechanism = lc $2;
		    $net = $3;

		    $verbose >= 2 && print "qualifier $qualifier, mechanism $mechanism, net $net\n";

		    $new_qualifier = combine_qualifiers( $inherited_qualifier, 
			$qualifier );
		    if ( $new_qualifier eq '+' ) { 
			if ( $mechanism eq 'ip4' ) { 
			    $nets{ $net } = 1;
			    }
			elsif ( $mechanism eq 'ip6' ) { 
			    # ignore for now
			    # $nets{ $net } = 1;
			    }
			}
		    }
		elsif ( $directive =~ m/^([~?+-]?)exists:(.*)/ ) { 
		    # You've got to be kidding
		    $nlookups++;  # pretend we looked it up
		    }
		elsif ( $directive =~ m/^([~?+-]?)redirect=(.*)/ ) { 
		    $qualifier = $1 || '+';
		    $domain2 = $2;
		    $new_qualifier = combine_qualifiers( $inherited_qualifier, 
			$qualifier );
		    get_spf2( $new_qualifier, $domain2 );
		    }
		elsif ( $directive =~ m/^([~?+-]?)include:(.*)/ ) { 
		    $qualifier = $1 || '+';
		    $domain2 = $2;
		    $new_qualifier = combine_qualifiers( $inherited_qualifier, 
			$qualifier );
		    get_spf2( $new_qualifier, $domain2 );
		    }
		elsif ( $directive =~ m/^([~?+-]?)all$/ ) { 
		    # skip all
		    }
		elsif ( $directive =~ m/^([~?+-]?)ptr$/ ) { 
		    # skip ptr
		    $nlookups++;  # pretend we looked it up
		    }
		else { 
		    $verbose && print "can't parse '$directive'\n";
		    push @warns, "can't parse '$directive'";
		    }
		}
	    }
	}
    close $txtH;
    }  # get_spf2







sub combine_qualifiers { 
    my( $inherited_qualifier, $qualifier ) = @_;
    my( $new_qualifier );

    if ( $inherited_qualifier eq '' || $inherited_qualifier eq '+' 
	    || $inherited_qualifier eq '?'
	    || $inherited_qualifier eq '~' ) {
	$inherited_qualifier = '+';
	}
    elsif ( $inherited_qualifier eq '-' ) { 
	$inherited_qualifier = '-';
	}
    else { 
	push @warns, "invalid inherited_qualifier $inherited_qualifier";
	$inherited_qualifier = '+';
	}

    if ( $qualifier eq '' || $qualifier eq '+' 
	    || $qualifier eq '?' || $qualifier eq '~' ) {
	$qualifier = '+';
	}
    elsif ( $qualifier eq '-' ) { 
	$qualifier = '-';
	}
    else { 
	push @warns, "invalid qualifier $qualifier";
	$qualifier = '+';
	}

    if ( $inherited_qualifier eq '+' ) { 
	$new_qualifier = $qualifier;
	}
    else { 
	if ( $qualifier eq '+' ) { 
	    $new_qualifier = '-';
	    }
	else { 
	    $new_qualifier = '+';
	    }
	}
    return $new_qualifier;
    }  # combine_qualifiers 
    





sub get_a { 
    my( $qualifier, $domain ) = @_; 
    my( $ipaddr );

    print "get_a( $qualifier, $domain )\n";

    if ( $qualifier eq '+' && $a_cache{ $domain } ) { 
	foreach $ipaddr ( keys %{$a_cache{ $domain }} ) {
	    $nets{ $ipaddr } = 1;
	    }
	}

    if ( ! open( aH, '-|', "dig a '$domain'" ) ) { 
    	push @unknowns, "can't dig a $domain";
	return;
	}
    $nlookups++;

    while ( <aH> ) { 
	$verbose >= 2 && print "< $_";
	chomp;
    	if ( m/^$domain\.\s.*\sA\s+(\d+\.\d+\.\d+\.\d+)\b/i ) { 
	    $ipaddr = $1;
	    $verbose && print "> $ipaddr\n";
	    $a_cache{ $domain }{ $ipaddr } = 1;
	    if ( $qualifier eq '+' ) { 
		$nets{ $ipaddr } = 1;
		}
	    }
	}
    close aH;
    }






sub get_mx { 
    my( $qualifier, $domain ) = @_; 
    my( $mx, $ipaddr, %mxs, $domain2 );

    print "get_mx( $qualifier, $domain )\n";

    if ( ! open( mxH, '-|', "dig mx '$domain'" ) ) { 
    	push @unknowns, "can't dig mx $domain";
	return;
	}
    $nlookups++;

    while ( <mxH> ) { 
	$verbose >= 2 && print "< $_";
	chomp;
    	if ( m/^$domain\.\s.*\sMX\s+\d+\s+(_?[\d\w\.-]+)\.\s*$/i ) { 
	    $mx = $1;
	    print "> mx $mx\n";
	    if ( $mx =~ m/^(\d+\.\d+\.\d+\.\d+)\b/i ) {
		$ipaddr = $1;
		if ( $qualifier eq '+' ) { 
		    $nets{ $ipaddr } = 1;
		    }
		}
	    else { 
		$mxs{ $mx } = 1;
		}
	    }
    	elsif ( m/^(_?[\w\d\.-])\.\s.*\sA\s+(\d+\.\d+\.\d+\.\d+)\b/i ) { 
	    # cache any ipaddrs from the additional info
	    $domain2 = $1;
	    $ipaddr = $2;
	    $a_cache{ $domain2 } = $ipaddr;
	    }
	}
    close mxH;

    # look up any mx names that we didn't get additional info for 
    foreach $mx ( keys %mxs ) { 
	get_a( $qualifier, $mx );
	}
    }





		
		 
# count the entries
# warn if too many dns lookups
# create ok count messages  
sub count_spf { 
    my( $domain, $net ); 

    $verbose && print "count_spf()\n";

    if ( $nlookups > 10 ) { 
	push @warns, sprintf "%d dns lookups", $nlookups;
	}
    else { 
	push @oks, sprintf "%d dns lookups", $nlookups;
	}
    push @oks, sprintf "%d domains", scalar( keys %domains );
    push @oks, sprintf "%d nets", scalar( keys %nets );

    if ( $verbose )  { 
	printf "\ndns lookups: %d\n", $nlookups;
	printf "\ndomains: %d\n", scalar( keys %domains );
	foreach $domain ( sort keys %domains ) { 
	    print "$domain\n";
	    }

	printf "\nnets: %d\n", scalar( keys %nets );
	foreach $net ( sort ipv4_sorter keys %nets ) { 
	    print "$net\n";
	    }
	print "\n";
	}
    }  # count_spf







# compare netblocks from SPF with ipf firewall on solaris
sub check_ipf { 
    my( $ipfstat, $cmd, $lines, %sources, $net, $first );

    $verbose && print "check_ipf()\n";

    $ipfstat = "/usr/sbin/ipfstat"; 

    if ( ! -x $ipfstat ) {
	#push @unknowns, "$ipf not found";
	return;
	}

    $cmd = "sudo -S $ipfstat -iR";
    $verbose && print "+ $cmd\n";
    if ( ! open( pH, "$cmd < /dev/null 2>&1 |" ) ) {
	push @unknowns, "can't run $cmd: $!";
	return;
	}
    while( <pH> ) {
	chomp;
	$verbose >= 2 && print "< $_\n";
	if ( m%^pass in .* from (\d+\.\d+\.\d+\.\d+/\d+) .*to .* port = 25\b%i ) {
	    $verbose && print "> $1\n";
	    $sources{ $1 } = 1;
	    }
	elsif ( m/illegal option/i ) { 
	    # old version of ipf.

	    # could run "echo 'fr_statesize/;fr_statemax/' | mdb -k"
	    # but that makes me nervous

	    # punt and assume defaults
	    # we're unlikely to change it on these old machines

	    }
	elsif ( m/^Password:|is not in the sudoers file/ ) { 
	    # sudo configuration is wrong
	    push @unknowns, "sudoers is misconfigured";
	    return;
	    }
	elsif ( m/must be setuid root/ ) { 
	    push @unknowns, "sudo is not setuid root";
	    return;
	    }
	# else ignore it
	}
    $lines = $.;
    close pH;
    $verbose && print "lines $lines\n";
    if ( $lines < 1 ) { 
	push @unknowns, "no output from ipf -T list";
	return;
	}

    # make sure all the spf netblocks are in the sources list
    $first = 1;
    foreach $net ( sort ipv4_sorter keys %nets ) {
	if ( ! $sources{ $net } ) { 
	    if ( $first ) { 
		push @crits, "ipf missing $net";
		$first = 0;
		}
	    else {
		push @crits, $net;
		}
	    }
	}
    }  # check_ipf







# compare netblocks from SPF with iptables firewall on linux
sub check_iptables { 
    my( $cmd, $nlines, $chain, %chain_policy, %chain_references,
	%chain_rules, $chain_index, $nrules, $i, $source, $net, %sources,
	$first );

    $verbose && print "check_iptables()\n";

    return unless ( -e "/sbin/iptables" );

    $cmd = "sudo iptables -L -v -n";
    $verbose && print "+ $cmd\n";
    if ( ! open( pH, '-|', $cmd ) ) { 
	push @unknowns, "can't sudo iptables: $!";
	return;
	}

    $nlines = 0;
    while ( <pH> ) { 
	$nlines ++;
	if ( m/^Chain (\S+) \(policy (\w+)/i ) { 
	    $chain = $1;
	    $chain_policy{ $chain } = $2;
	    $chain_index = 0; 
	    $verbose >= 2 && print "> $chain policy $2\n";
	    }
	elsif ( m/^Chain (\S+) \((\d+) references/i ) { 
	    $chain = $1;
	    $chain_references{ $chain } = $2;
	    $chain_index = 0; 
	    $verbose >= 2 && print "> $chain $2 references\n";
	    }
	elsif ( m/^\s*pkts\s+bytes/i )  { 
	    # header, ignore
	    next;
	    }
	elsif ( m%^ \s* (\d+[kmg]?) \s+ (\d+[kmg]?) \s+ (\S+) \s+ (\S+) 
		\s+ (\S+) \s+ (\S+) \s+ (\S+) 
		\s+ ([\d\.\/]+) \s+ ([\d\.\/]+) 
		\s* (\S.*)? %ix ) { 
	    $verbose >= 2 && print "> $chain $chain_index $3 $8\n";
	    $chain_rules{ $chain }[ $chain_index ]{ pkts } = $1;
	    $chain_rules{ $chain }[ $chain_index ]{ bytes } = $2;
	    $chain_rules{ $chain }[ $chain_index ]{ target } = $3;
	    $chain_rules{ $chain }[ $chain_index ]{ protocol } = $4;
	    $chain_rules{ $chain }[ $chain_index ]{ opt } = $5;
	    $chain_rules{ $chain }[ $chain_index ]{ int_in } = $6;
	    $chain_rules{ $chain }[ $chain_index ]{ int_out } = $7;
	    $chain_rules{ $chain }[ $chain_index ]{ source } = $8;
	    $chain_rules{ $chain }[ $chain_index ]{ dest } = $9;
	    $chain_rules{ $chain }[ $chain_index ]{ module_options } = $10;
	    $chain_index ++;
	    }
	}
    close pH;

    if ( ! $nlines ) { 
	push @crits, "iptables -L produced no output";
	return;
	}

    # find all the sources
    foreach $chain ( sort keys %chain_rules ) {  
	$nrules = scalar( @{$chain_rules{ $chain }} );  
	foreach $i ( 0 .. $nrules - 1 ) {  
	    $source = $chain_rules{ $chain }[ $i ]{ source };
	    if ( $source ) { 
		if ( $source !~ m%/\d+$% ) { 
		    $source .= '/32';
		    }
		$verbose >= 2 && print "$chain $i $source\n";
		$sources{ $source } = 1;
		}
	    }
	}

    # make sure all the spf netblocks are in the sources list
    $first = 1;
    foreach $net ( sort ipv4_sorter keys %nets ) {
	if ( ! $sources{ $net } ) { 
	    if ( $first ) { 
		push @crits, "missing $net";
		$first = 0;
		}
	    else { 
		push @crits, $net;
		}
	    }
	}
    }  # check_iptables






sub ipv4_sorter {
    my( @a, @b, $n, $i );

    #print "ipv4_sorter( $a, $b )\n";
    if ( $a =~ m/\s*(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\b/ ) {
        $a[0] = $1;
        $a[1] = $2;
        $a[2] = $3;
        $a[3] = $4;

        if ( $b =~ m/\s*(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\b/ ) {
            $b[0] = $1;
            $b[1] = $2;
            $b[2] = $3;
            $b[3] = $4;

            foreach $i ( 0 .. 3 ) {
                if ( $a[$i] < $b[$i] ) {
                    return -1;
                    }
                elsif ( $a[$i] > $b[$i] ) {
                    return 1;
                    }
                }
            return 0;
            }
        }

    return ( $a cmp $b );
    }