1# Before `make install' is performed this script should be runnable with 2# `make test'. After `make install' it should work as `perl Net::Analysis-Utils.t' 3 4use warnings; 5use strict; 6use Data::Dumper; 7 8use Test::More tests => 3; 9use t::TestMockListener; 10use t::TestEtherealGlue; 11use Storable qw(nstore retrieve); 12 13use Net::Analysis::Dispatcher; 14use Net::Analysis::EventLoop; 15 16######################### 17 18BEGIN { use_ok('Net::Analysis::Listener::TCP') } 19 20#### Create Dispatcher, TCP listener, and mock object listening for TCP events 21# 22my ($d) = Net::Analysis::Dispatcher->new(); 23my ($l_tcp) = Net::Analysis::Listener::TCP->new (dispatcher => $d); 24my ($mock) = mock_listener (qw(tcp_session_start 25 tcp_session_end 26 tcp_monologue)); 27$d->add_listener (listener => $mock); 28 29#### Simple manual test for google ... 30# 31my ($el) = Net::Analysis::EventLoop->new (dispatcher => $d); 32$el->loop_file (filename => "t/t1_google.tcp"); 33 34my (@found_ev); 35while (my (@call) = $mock->next_call()) { 36 #print ">> $call[0] (". join(',', sort keys %{$call[1][2]} ).")\n"; 37 push (@found_ev, $call[0]); 38} 39 40# Now look at the emitted events - check they match what we expect from google 41my (@ev) = qw(tcp_session_start tcp_monologue tcp_monologue tcp_session_end); 42is_deeply (\@found_ev, \@ev, "basic TCP events for t1_google"); 43 44 45#### Test for max_session stuff 46# 47{ 48 my ($max_session_size) = (5000); 49 my ($d) = Net::Analysis::Dispatcher->new(); 50 my ($l_tcp) = Net::Analysis::Listener::TCP->new 51 (dispatcher => $d, 52 config => {max_session_size => $max_session_size} 53 ); 54 my ($mock) = mock_listener (qw(tcp_session_start 55 tcp_session_end 56 _internal_tcp_packet 57 tcp_monologue)); 58 $d->add_listener (listener => $mock); 59 60 my ($el) = Net::Analysis::EventLoop->new (dispatcher => $d); 61 $el->loop_file (filename => "t/t8_multi_pkt_mono.tcp"); 62 63 # Check that the final output monologue is only $max_session_size bytes. 64 # Check that not all packet events were emitted. 65 my (@found_ev); 66 my (@mono); 67 while (my (@call) = $mock->next_call()) { 68 #print ">> $call[0] (". join(',', sort keys %{$call[1][1]} ).")\n"; 69 push (@found_ev, $call[0]); 70 push (@mono, $call[1][1]{monologue}) if (exists $call[1][1]{monologue}); 71 } 72 73 # This mono would be 26125 bytes without truncation via max_session_size 74 is ($mono[1]->length(), 5792, "that mono is truncated"); 75} 76 77 78__END__ 79 80# I don't like these tests. They essentially repeat the 21_TCPSession tests in 81# a brittle fashion. 82 83#### Step through our TCP test files ... 84# 85foreach my $test_file (list_testfiles(qr/./)) { 86 my $fname = "t/$test_file.tcp"; 87 my (@calls); 88 89 # Create fresh objects, in case they leak state 90 my ($d) = Net::Analysis::Dispatcher->new(); 91 my ($l_tcp) = Net::Analysis::Listener::TCP->new (dispatcher => $d); 92 my ($el) = Net::Analysis::EventLoop->new (dispatcher => $d); 93 $d->add_listener (listener => $mock); # Reuse mock object 94 $el->loop_file (filename => $fname); 95 96 # Now look at the emitted events 97 while (my (@call) = $mock->next_call()) { 98 #print "-- $call[0]\n"; 99 push (@calls, \@call); 100 } 101 102 if (0) { 103 # When things look OK, use this to create events.TCP compare_file 104 nstore (\@calls, "t/$test_file.events.TCP") 105 || die "could not store into $test_file.events.TCP\n"; 106 #die Data::Dumper::Dumper (\@calls); 107 108 } else { 109 # Load in events file 110 my ($events) = retrieve("t/$test_file.events.TCP") 111 || die "could not retrieve from $test_file.events\n"; 112 113 is_deeply (\@calls, $events, "TCP events emitted for '$test_file'"); 114 } 115} 116