debian_pkg-listmaster/gandalf/Gandalf/Checks/HELO.pm

#!/usr/bin/perl
# 
#  Helo.pm - description
# 
#  Copyright (C) 2008 Martin Zobel-Helas
# 
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
# 
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
# 
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software Foundation,
#  Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA.
# 

# define the Package name
package Gandalf::Checks::HELO;

use warnings;
use strict;

use constant {GOOD => 1, BAD => 0};


use Time::HiRes qw(sleep);

use List::Util qw(sum);

my @tests = (helo_reverse => {function => \&test_helo_reverse,
			      bad      => 1,
			      good     => -0.5,
			     },
	     helo_numeric => {function => \&test_helo_numeric,
			      bad      => 1.5,
			      good     => 0,
			     },
	     helo_seems_dialup => {function => \&test_helo_seems_dialup,
				   bad      => 3.75,
				   good     => 0
				  },
	    );

my %tests = @tests;
# we want @tests[0,2,4,6,...] etc.
my @tests_order = @tests[map {$_ * 2} 0..(@tests/2-1)];


# called by the policy daemon; will need to be renamed and possibly
# reconfigured as needed
sub run {
    my ($policy,$config,$variables) = @_;

    # go through, and run the tests

    my %test_results;
    my @tests_to_run = @tests_order;
    my $test;
    my $loop_number = 0;
    my $time_start = time;
    while ($test = shift @tests_to_run) {
	$loop_number++;
	my ($status,$rerun) =
	    $tests{$test}{function}->(variables => $variables,
				      policy    => $policy,
				      config    => $config,
				      test_results => \%test_results,
				     );
	if (defined $rerun and $rerun) {
	    # if we've hit the timeout, and a test hasn't completed,
	    # bail out.
	    if ((time - $time_start) > $config->{helo_test_timeout}) {
		last;
	    }
	    # if we've looped around once and still have tests to run,
	    # wait.
	    if (@test_to_run < $loop_number) {
		sleep 0.5;
		$loop_number = 0;
	    }
	    push @tests_to_run,$test;
	}
	else {
	    $test_results{$test} = {status => $status,
				    score  => $status == GOOD? $tests{$test}{good}:$tests{$test}{bad},
				   };
	}
    }
    # calculate results
    my $final_score = sum(map {$->{score}} values %test_results);

    return $final_score;
}

my @test_common_options = (variables => HASHREF,
			   test_results => HASHREF,
			   policy       => OBJECT,
			   config       => HASHREF,
			   noblock      => {type => BOOLEAN,
					    default => 1,
					   },
			  );


sub test_helo_reverse {
     my %param = validate_with(params => \@_,
                               spec => {@test_common_options,
				       },
                              );

     my $helostring     = $param{variables}{helo_name};
     my $clientaddress  = $param{variables}{client_address};

     if ($helostring eq $clientaddress) {
          # Great, the client told us his correct name!
          return GOOD;
     } else {
          # That didn't match. Let's see.
          # try if the helo names resolves, and has perhaps more than one dns
          # record....
          my $results = resolve_dns(query => $helostring,
                                    noblock  => $param{noblock},
                                   );
          if ($param{noblock} and not defined $results or
              not ref $results) {
               return ($results,1);
          }
          if (first { $_->string() eq $clientaddress } $results->answer()) {
               return GOOD;
          }
     }
     # For now, just give "bad" score.
     return BAD;
}

sub test_helo_numeric {
     my %param = validate_with(params => \@_,
			       spec => {@test_common_options,
				       },
			      );

    my $helostring = $param{variables}{helo_name};
    if($helostring =~ /\d$/) {
	return GOOD;
    } else {
	return BAD;
    }
}

sub test_helo_seems_dialup {
     my %param = validate_with(params => \@_,
			       spec => {@test_common_options,
				       },
			      );

    my $helostring = $param{variables}{helo_name};
    if (($helostring =~
	    /(\.dip\.|cable|ppp|dial|dsl|dyn|client|rev.*?(ip|home)*).*?\..*?\./i
	) || ($helostring =~
	    /[a-z\.\-\_]+\d{1,3}[-._]\d{1,3}[-._]\d{1,3}[-._]\d{1,3}/i
	)) {
	# our client at least behaves correctly, we get a dialup pattern as helo string
	return BAD;
    }
    return GOOD;
}


# return a true value
1;
__END__