#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_add_headers'); $self->register_test('test_get_v2_query'); $self->register_test('test_get_v3_query'); $self->register_test('test_store_v2_results'); $self->register_test('test_store_v3_results'); $self->register_test('test_register_headers'); $self->register_test('test_register_genre_blocking'); $self->register_test('test_rcpt_handler'); $self->register_test('test_check_genre'); $self->register_test('test_exclude_connection'); $self->register_test('test_exclude_recipient'); } sub register_hook { # Override normal register_hook() to record behavior my $self = shift; $self->{_lastreg} = join ',', @_; } sub test_register_headers { my ( $self ) = @_; # reset last_register_args $self->register_hook(); delete $self->{_args}{add_headers}; $self->register_headers(); is( $self->{_lastreg}, 'data_post,add_headers', 'register_headers() registers data_post hook by default' ); $self->register_hook(); $self->{_args}{add_headers} = 'asdf'; $self->register_headers(); is( $self->{_lastreg}, 'data_post,add_headers', 'register_headers() registers data_post hook on invalid input' ); $self->register_hook(); $self->{_args}{add_headers} = 'true'; $self->register_headers(); is( $self->{_lastreg}, 'data_post,add_headers', 'register_headers() registers data_post hook when explicitly enabled' ); $self->register_hook(); $self->{_args}{add_headers} = 'false'; $self->register_headers(); is( $self->{_lastreg}, '', 'register_headers() does not register data_post hook when disabled' ); } sub test_register_genre_blocking { } sub test_rcpt_handler { } sub test_check_genre { } sub test_exclude_connection { } sub test_exclude_recipient { } sub test_add_headers { my ( $self ) = @_; $self->connection->notes( 'p0f', { genre => 'test genre', link_type => 'test link_type', } ); my $header = $self->transaction->header( Mail::Header->new ); my @tags = (qw( X-P0F-Genre X-P0F-Link-Type )); $header->add( $_ => 'DELETETHIS' ) for @tags; $self->add_headers($self->transaction); is( $self->all_headers('X-P0F-Genre'), 'test genre', 'X-P0F-Genre header added' ); is( $self->all_headers('X-P0F-Link-Type'), 'test link_type', 'X-P0F-Link-Type header added' ); } sub all_headers { # Return all instances of a given message header my ( $self, $tag ) = @_; return join " | ", map { chomp $_; $_ } $self->transaction->header->get($tag); } sub test_query_p0f_v2 { #TODO # get path to p0f socket # see if it exists # try to connect to it # if connection succeeds, send it a query # do we a) pick an IP that recently connected? # or b) create a connection to localhost... # or c) is there a p0f test value? # parse and validate the response # using $self->test_v2_response() } sub test_query_p0f_v3 { #TODO: similar to v2 .... } sub test_get_v2_query { my $self = shift; my $local_ip = '208.75.177.101'; my $remote = '108.60.149.81'; $self->{_args}{local_ip} = $local_ip; $self->qp->connection->local_ip($local_ip); $self->qp->connection->remote_ip($remote); $self->qp->connection->local_port(25); $self->qp->connection->remote_port(2500); my $r = $self->get_v2_query(); ok( $r, 'r +' ); } sub test_get_v3_query { my $self = shift; my $remote = '108.60.149.81'; $self->qp->connection->remote_ip($remote); my $r = $self->get_v3_query(); ok( $r, 'any +' ); } sub test_store_v2_results { my $self = shift; my $response = pack("L L C Z20 Z40 c Z30 Z30 C C C s S N", '233811181', '1336687857', '0', 'Windows', 'XP/2000 (RFC1323+, w+, tstamp-)', '11', 'ethernet/modem', '', '0', '0', '1', '-25600', '255', '255' ); my $r = $self->store_v2_results( $response ); ok( $r, "r: +") or return; ok( $r->{genre} =~ /windows/i, "genre +" ); } sub test_store_v3_results { my $self = shift; my $response = pack("L L L L L L L L L s C C A32 A32 A32 A32 A32 A32 A32", 1345340930, 16, 1336676595, 1336680290, 3, 0, 0, 0, 0, 13, 0, 0, 'Windows', '7 or 8', '', '', 'Ethernet or modem', '', ''); my $r = $self->store_v3_results( $response ); ok( $r, "result"); ok( $r->{genre} =~ /windows/i, "genre" ); }