spf_lookup.pl

#!/usr/bin/perl
#
# Simple script to extract certain parts of a SPF record
# and send those addresses out the the stdoutput.
#
# Useful for integrating into other scripts
#
# Author:	pblair(at)tucows(dot)comt
# Updated:	Mon Nov 30 10:41:16 EST 2009
#
use strict;
use Net::DNS;

my $res = Net::DNS::Resolver->new;

sub lookup_txt {
	my ($q) = @_;
	my @response;
	my $packet = $res->search( $q, 'TXT' );
	my @answer = $packet->answer;
	push( @response, $_->txtdata) for @answer;
	return \@response;
}

sub lookup_a {
	my ($q) = @_;
	my @response;
	my $packet = $res->search( $q, 'A' );
	my @answer = $packet->answer;
	push( @response, $_->address) for @answer;
	return \@response;
}

my $domain = $ARGV[0] or die ( "Please give a domain name as a parameter\n" );
my @cidr;
my $debug = 0;
my %seen;
my @domains;
push ( @domains, $domain );

while ( scalar @domains ) {
    $domain = pop ( @domains );

    # Avoid endless loops
    next if $seen{$domain};
    $seen{$domain}++;

    if ( $domain eq '' ) {
        next;
    }
    print "Inspecting $domain\n" if $debug;
    my $a_txt = lookup_txt( $domain );
    TXT: for my $txt ( @$a_txt ) {
        $txt =~ s/\"//g;
        print "txt: $txt" if $debug;
        unless ( $txt =~ /^v=spf1.*/o ) {
            print "skipping.. not a valid SPFv1 record\n" if $debug;
            next TXT;
        }

        my @opts = split ( /\s+/, $txt );

        for ( @opts ) {
            print "opt: $_\n" if $debug;
            if ( /^ip4:(\S+)/ ) {
                print "pushing $1 onto \@cidr\n" if $debug;
                push ( @cidr, $1 );
            } elsif ( /^include:(\S+)/ ) {
                print "Pushing $1 onto \@domains\n" if $debug;
                push ( @domains, $1 );
            } elsif ( /^a:(\S+)/ ) {
                print "Inspecting $1\n" if $debug;
                my $a = lookup_a( $1 );
                for ( @$a ) {
                    chomp;
                    print "Pushing $_ onto \@cidr\n" if $debug;
                    push ( @cidr, $_ );
                }
            } ## end elsif ( /^a:(\S+)/ )
        } ## end for ( @opts )
    } ## end for my $txt ( @a_txt )
} ## end while ( scalar @domains )

print join ( "\n", @cidr ) . "\n";