diff --git a/tests/libperl/Ham/APRS/IS.pm b/tests/libperl/Ham/APRS/IS.pm index d43c77f..a187c3e 100644 --- a/tests/libperl/Ham/APRS/IS.pm +++ b/tests/libperl/Ham/APRS/IS.pm @@ -325,6 +325,21 @@ sub getline_noncomment($;$) } } +sub send_packet($$) +{ + my($self, $line) = @_; + + return $self->sendline($line); +} + + +sub get_packet($;$) +{ + my($self, $timeout) = @_; + + return $self->getline_noncomment($timeout); +} + sub sendline($$;$$) { my($self, $line, $raw, $noflush) = @_; diff --git a/tests/libperl/Ham/APRS/IS2.pm b/tests/libperl/Ham/APRS/IS2.pm index ade0151..44b5495 100644 --- a/tests/libperl/Ham/APRS/IS2.pm +++ b/tests/libperl/Ham/APRS/IS2.pm @@ -61,6 +61,7 @@ sub new($$$;%) $self->{'error'} = "No errors yet."; $self->{'loginstate'} = 'init'; + $self->{'pqueue_in'} = []; return $self; } @@ -246,6 +247,10 @@ sub connect($;%) return 0; } + if (defined $self->{'filter'}) { + return $self->set_filter($self->{'filter'}); + } + return 1; } else { $self->{'error'} = "Wrong type of response received for LOGIN_REPLY: " . $l->type; @@ -284,6 +289,12 @@ sub send_packets($$) $self->{'sock'}->blocking(0); } +sub send_packet($) +{ + my($self, $packet) = @_; + $self->send_packets([$packet]); +} + sub get_packets($;$) { my($self, $timeout) = @_; @@ -311,17 +322,55 @@ sub get_packets($;$) return @pa; } else { - $self->{'error'} = "Wrong type of response received for LOGIN_REPLY: " . $l->type; - return 0; + $self->{'error'} = "Wrong type of frame received: " . $l->type; + return undef; } if (time() - $t > $timeout) { - $self->{'error'} = "Login command timed out"; - return 0; + $self->{'error'} = "get_packets timed out"; + return undef; } } } +sub get_packet($;$) +{ + my($self, $timeout) = @_; + + if (@{ $self->{'pqueue_in'} }) { + return shift @{ $self->{'pqueue_in'} }; + } + + my @p = $self->get_packets($timeout); + + if (@p) { + my $r = shift @p; + $self->{'pqueue_in'} = \@p; + return $r; + } + + return; +} + +sub set_filter($$) +{ + my($self, $filter) = @_; + + my $im = IS2Message->new({ + 'type' => IS2Message::Type::PARAMETER(), + 'parameter' => IS2Parameter->new({ + 'type' => IS2Parameter::Type::PARAMETER_SET(), + 'request_id' => 1, # todo: sequential + 'filter_string' => $filter + }) + }); + + $self->{'sock'}->blocking(1); + $self->is2_frame_out($im->encode); + $self->{'sock'}->blocking(0); + + return 1; +} sub is2_frame_out($$) { diff --git a/tests/libperl/Ham/APRS/IS_Fake_UDP.pm b/tests/libperl/Ham/APRS/IS_Fake_UDP.pm index 5a70feb..73c34d5 100644 --- a/tests/libperl/Ham/APRS/IS_Fake_UDP.pm +++ b/tests/libperl/Ham/APRS/IS_Fake_UDP.pm @@ -132,7 +132,14 @@ sub sendline($$) { my($self, $line) = @_; - #warn "udp sendline: $line\n"; + $self->send_packet($line); +} + +sub send_packet($$) +{ + my($self, $line) = @_; + + #warn "udp send_packet: $line\n"; return undef if ($self->{'state'} ne 'connected'); @@ -143,5 +150,4 @@ sub sendline($$) return 1; } - 1; diff --git a/tests/libperl/istest.pm b/tests/libperl/istest.pm index ba03a90..8e0098a 100644 --- a/tests/libperl/istest.pm +++ b/tests/libperl/istest.pm @@ -19,7 +19,7 @@ sub txrx($$$$$) my($ok, $i_tx, $i_rx, $tx, $rx) = @_; warn "sending: $tx\n" if ($debug); - my $sent = $i_tx->sendline($tx); + my $sent = $i_tx->send_packet($tx); warn "sent\n" if ($debug); @@ -34,7 +34,7 @@ sub txrx($$$$$) warn "receiving\n" if ($debug); - my $received = $i_rx->getline_noncomment(); + my $received = $i_rx->get_packet(); if (!defined $received) { if ($i_rx->{'state'} eq 'connected') { @@ -63,7 +63,7 @@ sub should_drop($$$$$;$$) $drop_key .= ' drop.' . int(rand(1000000)) if (!$no_random_drop); my $tx_drop = $tx . $drop_key; warn "sending for drop: $tx_drop\n" if ($debug); - my $sent = $i_tx->sendline($tx_drop); + my $sent = $i_tx->send_packet($tx_drop); if (!$sent) { &$ok($sent, 1, "Failed to send line to server: '$tx'"); @@ -74,14 +74,14 @@ sub should_drop($$$$$;$$) my $helper_l = $helper; $helper_l .= ' ' . $helper_key if (!$no_random_helper); warn "sending for pass: $helper_l\n" if ($debug); - $sent = $i_tx->sendline($helper_l); + $sent = $i_tx->send_packet($helper_l); if (!$sent) { &$ok($sent, 1, "Failed to send helper line to server: '$helper_l'"); return; } - my $received = $i_rx->getline_noncomment(); + my $received = $i_rx->get_packet(); if (!defined $received) { if ($i_rx->{'state'} eq 'connected') { @@ -129,7 +129,7 @@ sub should_drop($$$$$;$$) } # since we received an extra packet, get one more line to receive the helper - $i_rx->getline_noncomment(); + $i_rx->get_packet(); } sub read_and_disconnect($) diff --git a/tests/t/84is2-messaging.t b/tests/t/84is2-messaging.t new file mode 100644 index 0000000..3450f38 --- /dev/null +++ b/tests/t/84is2-messaging.t @@ -0,0 +1,237 @@ + +# +# Test messaging features: +# +# On a filtered igate port (14580), no messages should come out at first. +# When a position of a station has been heard, messages for that station +# should come out. +# After such a message, the next following position transmitted within +# 30 minutes by the originator should be passed to the recipient's socket, too. +# +# Messages transmitted to any SSID must be passed? +# +# Are messages transmitted to objects passed, too? No. +# +# When a position has been heard, positions for the same callsign-ssid +# from other igates should come out too, to assist TX igates to know +# the station is on the Internet. +# + +use Test; +BEGIN { plan tests => 8 + 9 + 1 + 2 + 3 + 2 + 6 + 4 + 1 }; +use runproduct; +use istest; +use Ham::APRS::IS2; +use Encode; +use utf8; + +my $enc_utf8 = find_encoding("UTF-8") || die "Could not load encoding UTF-8"; # note: strict UTF-8 + +ok(1); # If we made it this far, we're ok. + +my $p = new runproduct('is2-basic'); + +ok(defined $p, 1, "Failed to initialize product runner"); +ok($p->start(), 1, "Failed to start product"); + +my $server_call = "TESTING"; + +my $login_tx = "N0GATE"; +my $i_tx = new Ham::APRS::IS2("localhost:56580", $login_tx, + 'filter' => 'r/60.4752/25.0947/1'); +ok(defined $i_tx, 1, "Failed to initialize Ham::APRS::IS2"); + +# We set a filter on the rx so that the helper packets get through +my $login_rx = "N1GATE"; +my $i_rx = new Ham::APRS::IS2("localhost:56580", $login_rx, + 'filter' => 'r/60.4752/25.0947/1'); +ok(defined $i_rx, 1, "Failed to initialize Ham::APRS::IS2"); + +my $ret; +$ret = $i_tx->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_tx->{'error'}); + +$ret = $i_rx->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_rx->{'error'}); + +# do the actual tests + +my $msg_src = "M1SRC"; +my $msg_dst = "M1DST"; +my($tx, $rx, $helper); + +# 8. first, verify that a message packet is not passed to a filtered port +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,$login_tx,I::%-9.9s:message", $msg_dst); +$helper = "H1LP>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# 9. verify that a position packet from the message originator is not passed +# to a filtered port +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,$login_tx,I:!6428.51N/02545.98E#"); +$helper = "H1LP-5>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# now, transmit a position packet on the receiving filtered port +$tx = "$msg_dst-2>APRS,OH2RDG*,WIDE,$login_rx,I:!6028.51N/02505.68E# should pass"; +$rx = "$msg_dst-2>APRS,OH2RDG*,WIDE,qAR,$login_rx:!6028.51N/02505.68E# should pass"; +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +sleep(1); + +# now, transmit a position packet on the receiving filtered port +$tx = "$msg_dst>APRS,OH2RDG*,WIDE,$login_rx,I:!6028.51N/02505.68E# should pass"; +$rx = "$msg_dst>APRS,OH2RDG*,WIDE,qAR,$login_rx:!6028.51N/02505.68E# should pass"; +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# now, transmit a position packet on the receiving filtered port +$tx = "$msg_dst-3>APRS,OH2RDG*,WIDE,$login_rx,I:!6028.51N/02505.68E# should pass"; +$rx = "$msg_dst-3>APRS,OH2RDG*,WIDE,qAR,$login_rx:!6028.51N/02505.68E# should pass"; +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# then, a message packet should magically pass! +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message{123", $login_tx, $msg_dst); +$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message{123", $login_tx, $msg_dst); +istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); + +# and, its ACK packet should pass, too... +$tx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:ack123", $login_rx, $login_tx); +$rx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:ack123", $login_rx, $login_tx); +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# Another message! With UTF-8 content. +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:Blää blåå 日本語{1d", $login_tx, $msg_dst); +$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:Blää blåå 日本語{1d", $login_tx, $msg_dst); +$tx = $enc_utf8->encode($tx); +$rx = $enc_utf8->encode($rx); +istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); + +# Another message! With high-value binary content. +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:binary ", $login_tx, $msg_dst); +for (my $d = 127; $d <= 255; $d++) { + $tx .= chr($d); +} +$rx = $tx; +istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); + +# Also, it should pass to another SSID! +# NO, javaprssrvr does not pass this. +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message with SSID{a", $login_tx, $msg_dst . '-5'); +#$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message with SSID{a", $login_tx, $msg_dst . '-5'); +#istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); +$helper = "H1LP>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass5"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# now, after a message has been transmitted, the complimentary position should pass +$tx = "$msg_src>APRS,OH2RDG*,WIDE,$login_tx,I:!5528.51N/00505.68E# should pass compl"; +$rx = "$msg_src>APRS,OH2RDG*,WIDE,qAR,$login_tx:!5528.51N/00505.68E# should pass compl"; +istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); + +# try a second complimentary position - it must be dropped. +$tx = "$msg_src>APRS,OH2RDG*,WIDE,$login_tx,I:!5628.51N/00505.68E# should drop compl2"; +$helper = "H1LP-C>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# A position packet having TCPIP* in the path, coming from another connection, +# should be passed to the port where the station was heard without TCPIP*. +# "This is so the IGate can determine if there is a station it is hearing +# on RF is also directly connected to APRS-IS. If the RF station is heard +# directly on APRS-IS, the IGate should NOT gate messages for that station +# to RF." (Pete Loveall, 17 May 2012, APRSSIG) + +$rx = $tx = "$msg_src>APRS,TCPIP*,qAC,$msg_src:!5528.51N/00505.68E# should pass TCPIP*"; +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# +# Message to the client's callsign +# + +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message", $login_tx, $login_rx); +$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message", $login_tx, $login_rx); +istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); + +# with a different SSID +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message with ssid", $login_tx, $login_rx . "-9"); +$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message with ssid", $login_tx, $login_rx. "-9"); +$helper = "H1LP>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass diff ssid"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# +# Message to an OBJECT +# + +my $msg_obj = 'OBJDST'; +# transmit the object on the receiving filtered port +$tx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,$login_rx,I:;%-9.9s*111111z6028.51N/02505.68Ercomment", $msg_obj); +$rx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,qAR,$login_rx:;%-9.9s*111111z6028.51N/02505.68Ercomment", $msg_obj); +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# no, it should not pass at the moment +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message to object", $login_tx, $msg_obj); +#$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message to object", $login_tx, $msg_obj); +#istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); +$helper = "H1LP>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass6"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# +# Message to an ITEM +# + +my $msg_item = 'ITEDST'; +# transmit the item on the receiving filtered port +$tx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,$login_rx,I:)%s!6028.51N/02505.68Ercomment", $msg_item); +$rx = sprintf("$msg_dst>APRS,OH2RDG*,WIDE,qAR,$login_rx:)%s!6028.51N/02505.68Ercomment", $msg_item); +istest::txrx(\&ok, $i_rx, $i_tx, $tx, $rx); + +# no, it should not pass at the moment +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:message to item", $login_tx, $msg_item); +#$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:message to item", $login_tx, $msg_item); +#istest::txrx(\&ok, $i_tx, $i_rx, $tx, $rx); +$helper = "H1LP>APRS,OH2RDG*,WIDE:!6028.51N/02505.68E# should pass7"; +istest::should_drop(\&ok, $i_tx, $i_rx, $tx, $helper); + +# +# Connect another igate and see what happens when there are +# two gates hearing the same station! +# + +# We set a filter on the rx so that the helper packets get through +my $login_rx2 = "N2GATE"; +my $i_rx2 = new Ham::APRS::IS2("localhost:56580", $login_rx2, + 'filter' => 'r/60.4752/25.0947/1'); +ok(defined $i_rx2, 1, "Failed to initialize Ham::APRS::IS"); + +$ret = $i_rx2->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_rx2->{'error'}); + +# Now, transmit a position packet on the second receiving filtered port. +# It will come out on the first receiving filtered port due to the +# range filter *and* due to it being heard there, too. +$tx = "$msg_dst>APRS,OH2RDG*,WIDE,$login_rx,I:!6028.51N/02505.68E# should pass 2nd"; +$rx = "$msg_dst>APRS,OH2RDG*,WIDE,qAr,$login_rx:!6028.51N/02505.68E# should pass 2nd"; +istest::txrx(\&ok, $i_rx2, $i_tx, $tx, $rx); +my $read1 = $i_rx->get_packet(1); +ok($read1, $rx, "Got wrong line from first rx port"); + +# then, a message packet should magically pass! To both! +$tx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,%s,I::%-9.9s:two gates", $login_tx, $msg_dst); +$rx = sprintf("$msg_src>APRS,OH2RDG*,WIDE,qAR,%s::%-9.9s:two gates", $login_tx, $msg_dst); +istest::txrx(\&ok, $i_tx, $i_rx2, $tx, $rx); +$read1 = $i_rx->get_packet(1); +ok($read1, $rx, "Got wrong message line from first rx port"); + + +# disconnect + +$ret = $i_rx->disconnect(); +ok($ret, 1, "Failed to disconnect from the server: " . $i_rx->{'error'}); + +$ret = $i_rx2->disconnect(); +ok($ret, 1, "Failed to disconnect from the server: " . $i_rx2->{'error'}); + +$ret = $i_tx->disconnect(); +ok($ret, 1, "Failed to disconnect from the server: " . $i_tx->{'error'}); + +# stop + +ok($p->stop(), 1, "Failed to stop product"); +