From 82f9ac48fb2627714b570c33e909c6672f9d5352 Mon Sep 17 00:00:00 2001 From: Matti Aarnio Date: Thu, 13 Mar 2008 16:02:41 +0000 Subject: [PATCH] development tools git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@137 3ce903b1-3385-4e86-93cd-f9a4a239f7ac --- tools/aprs-is-copy | 2 +- tools/aprs-is-file-feed | 215 ++++++++++++++++++++++++++++++++++++++++ tools/aprs-is-multirx | 171 ++++++++++++++++++++++++++++++++ tools/aprs-is-rx | 7 +- 4 files changed, 391 insertions(+), 4 deletions(-) create mode 100644 tools/aprs-is-file-feed create mode 100644 tools/aprs-is-multirx diff --git a/tools/aprs-is-copy b/tools/aprs-is-copy index acef526..e6cad20 100644 --- a/tools/aprs-is-copy +++ b/tools/aprs-is-copy @@ -25,7 +25,7 @@ if (!defined($APRSIS)) { my $now = time; -my $last = $now + 60*60; +my $last = $now + 10*60; my $next = time + 5; while (! $quit && $now < $last) { diff --git a/tools/aprs-is-file-feed b/tools/aprs-is-file-feed new file mode 100644 index 0000000..7dd5c8f --- /dev/null +++ b/tools/aprs-is-file-feed @@ -0,0 +1,215 @@ +#!/usr/bin/perl + +$VERSION = 'APRS-IS-XMIT version-1.0'; + + +use POSIX; + +select STDOUT; $| = 1; + +my $quit = 0; +my $APRSIS; + +my $mycall = 'OH2MQK-WR'; +my $filter = 'p/OH2R -p/OH2 p/OH '; + +$APRSIS = APRS::IS->new('127.0.0.1:10190', $mycall, $filter); + +if (!defined($APRSIS)) { + printf "aprsazel: Failed to open APRS-IS socket!\n"; + exit 4; +} + + + + +my $now = time; +my $last = $now + 60*60; +my $next = 100; +my $cnt = 0; + +while (<>) { + + local $line = $_; + local %aprs; + + $APRSIS->sendline(sprintf("%d",$now)."\t".$line); + + ++$cnt; + $now += 0.03; ## magic + + if ($cnt >= $next) { + $APRSIS->flush(); + while ($line = $APRSIS->getline) { + ; + } + $next += 1000; + } + +# next if (!defined $line); + +# chomp $line; +# printf "%d\t%s\n", time, $line; +} + +$APRSIS->flush(); + +printf "\n cnt = $cnt\n"; + +printf "Last tick: %s\n", $now; + +$last = $now + 3000; +while ($now < $last) { + $now += 200; + $APRSIS->sendline(sprintf("%s\t# tick\r\n", $now)); + $APRSIS->flush(); + sleep 1; +} + +exit 0; + +# ------------------------------------------------------------------------- + +package APRS::IS; + +use 5.006; +use strict; +use warnings; + +use IO::Socket::INET; +use IO::Select; + +sub aprspass { + my ($a, $h) = (0, 0); + map($h ^= ord(uc) << ($a^=8), + pop =~ m/./g); + return ($h ^ 29666); +} + + +sub new { + my $that = shift; + my $class = ref($that) || $that; + # my %atts = @_; + my ($url, $mycall, $target_filter_re) = @_; # Just one arg: APRS-IS URL (host:port) + + # Register the callers package. + my $self = { caller_pkg => (caller)[0] }; + + bless ($self, $class); + + # parse attrs + $self->{sock} = IO::Socket::INET->new($url); + + if (!defined($self->{sock})) { + die(__PACKAGE__.": APRS::IS->new(".$url.") failure: ".$!."\n"); + } + + + $self->{select} = IO::Select->new( $self->{sock} ); + + $self->{aprsmycall} = uc( $mycall ); + $mycall =~ s/-.*//; + $self->{aprspass} = aprspass( uc($mycall) ); + + $self->{filterre} = $target_filter_re; + +# printf ( "APRS::IS->new() mycall='%s' aprspass=%d filterre='%s'\n", +# $self->{aprsmycall}, $self->{aprspass}, $self->{filterre} ); + + +## +## * Need to send on initial connect the following logon line: +## user callsign pass passcode vers appname versionnum rest_of_line +## +## callsign = login callsign-SSID +## passcode = login passcode per APRS-IS algorithm, -1 = read-only +## appname = application name (1 word) +## versionnum = application version number (no spaces) +## rest_of_line = server command if connecting to a port that supports commands (see Server Commands) +## +## (appname and versionnum should not exceed 15 characters) +## +## +## * Need to recognize both TCPIP and TCPXX as TCP/IP stations +## * Need to provide a means to perform the user validation. This can either be a user entered password, +## or a client program can automatically figure out the password given the callsign. +## If the later is used, it is the client programmer's responsibility to be certain that non-amateurs +## are not given registrations that can validate themselves in APRS-IS. +## * Probably a good idea to perform some feedback about the limitations of TCPIP without a registration number. +## + + $self->{sock}->blocking(1); + $self->{sock}->printf( "user %s pass %s vers %s filter %s\r\n", + $self->{aprsmycall}, + $self->{aprspass}, # -- but we are read-only ! + $main::VERSION, $self->{filterre} + ); + + printf( "user %s pass %s vers %s filter %s\n", + $self->{aprsmycall}, + $self->{aprspass}, # -- but we are read-only ! + $main::VERSION, $self->{filterre} ); + $self->{sock}->flush; + + $self->{sock}->blocking(1); + + # my $discard = $self->getline(); + + $self; +} + +# ------------------------------------------------------------------------- +# Get a line, or wait 1 sec + +sub getline { + my $self = shift; + + my @ready; + + $self->{sock}->blocking(0); + # if (@ready = $self->{select}->can_read(1)) { # Wait at most 1.0 seconds + +# We have only one socket... + + my $l = $self->{sock}->getline; + + $self->{sock}->blocking(1); + return $l; + +# } + + undef; +} + +sub sendline { + my $self = shift; + my $line = shift; + + my @ready; + +# $self->{sock}->blocking(1); + + $self->{buf} .= $line; + +# $self->{sock}->printf( "%s", $line); +# $self->{sock}->flush; + +# $self->{sock}->blocking(0); + + undef; +} + +sub flush { + my $self = shift; + my $line = shift; + + my @ready; + + $self->{sock}->blocking(1); + $self->{sock}->write($self->{buf}); + $self->{buf} = ''; + $self->{sock}->flush; +} + +# ------------------------------------------------------------------------- diff --git a/tools/aprs-is-multirx b/tools/aprs-is-multirx new file mode 100644 index 0000000..7c85b19 --- /dev/null +++ b/tools/aprs-is-multirx @@ -0,0 +1,171 @@ +#!/usr/bin/perl + +$VERSION = 'APRS-IS-RX version-1.0'; + +use POSIX; + +select STDOUT; $| = 1; + +my $quit = 0; +my $APRSIS; + +my $mycall = 'MRX-'; +#my $filter = 'p/OH2R'; +#my $filter = 'p/OH'; +my $filter = 'p/OH2R -p/OH2 p/OH '; + +#$APRSIS = APRS::IS->new('finland.aprs2.net:10152', $mycall, $filter); + +my @APRS = (); + +my $n = 500; + +foreach my $i (1 .. 500) { + my $call = sprintf("%s%d",$mycall,$i); + $APRSIS = APRS::IS->new('localhost:14580', $call, $filter ); + if (!defined($APRSIS)) { + printf "aprsazel: Failed to open APRS-IS socket!\n"; + exit 4; + } + push @APRS, $APRSIS; +} + + +my $now = time; +my $last = $now + 60*60; +local $line; + +while (1) { + $now = time; + foreach my $A (@APRS) { + $line = $A->getline; + } +} +exit 0; + +# ------------------------------------------------------------------------- + +package APRS::IS; + +use 5.006; +use strict; +use warnings; + +use IO::Handle '_IOFBF'; +use IO::Socket::INET; +use IO::Select; + +sub aprspass { + my ($a, $h) = (0, 0); + map($h ^= ord(uc) << ($a^=8), + pop =~ m/./g); + return ($h ^ 29666); +} + + +sub new { + my $that = shift; + my $class = ref($that) || $that; + # my %atts = @_; + my ($url, $mycall, $target_filter_re) = @_; # Just one arg: APRS-IS URL (host:port) + + # Register the callers package. + my $self = { caller_pkg => (caller)[0] }; + + bless ($self, $class); + + # parse attrs + $self->{sock} = IO::Socket::INET->new($url); + + if (!defined($self->{sock})) { + die(__PACKAGE__.": APRS::IS->new(".$url.") failure: ".$!."\n"); + } + + + #$self->{select} = IO::Select->new( $self->{sock} ); + + $self->{aprsmycall} = uc( $mycall ); + $mycall =~ s/-.*//; + $self->{aprspass} = aprspass( uc($mycall) ); + + $self->{filterre} = $target_filter_re; + +# printf ( "APRS::IS->new() mycall='%s' aprspass=%d filterre='%s'\n", +# $self->{aprsmycall}, $self->{aprspass}, $self->{filterre} ); + + +## +## * Need to send on initial connect the following logon line: +## user callsign pass passcode vers appname versionnum rest_of_line +## +## callsign = login callsign-SSID +## passcode = login passcode per APRS-IS algorithm, -1 = read-only +## appname = application name (1 word) +## versionnum = application version number (no spaces) +## rest_of_line = server command if connecting to a port that supports commands (see Server Commands) +## +## (appname and versionnum should not exceed 15 characters) +## +## +## * Need to recognize both TCPIP and TCPXX as TCP/IP stations +## * Need to provide a means to perform the user validation. This can either be a user entered password, +## or a client program can automatically figure out the password given the callsign. +## If the later is used, it is the client programmer's responsibility to be certain that non-amateurs +## are not given registrations that can validate themselves in APRS-IS. +## * Probably a good idea to perform some feedback about the limitations of TCPIP without a registration number. +## + + $self->{sock}->blocking(1); + $self->{sock}->printf( "user %s pass %s vers %s filter %s\r\n", + $self->{aprsmycall}, + $self->{aprspass}, # -- but we are read-only ! + $main::VERSION, $self->{filterre} + ); + + printf( "user %s pass %s vers %s filter %s\n", + $self->{aprsmycall}, + $self->{aprspass}, # -- but we are read-only ! + $main::VERSION, $self->{filterre} ); + $self->{sock}->flush; + +# $self->{rbuf} = ' ' x 16000; ############## grr.. not avaibale +# $self->{sock}->setbuf( $self->{rbuf} ); + + $self->{sock}->blocking(0); + +# my $discard = $self->getline(); + + $self; +} + +# ------------------------------------------------------------------------- +# Get a line, or wait 1 sec + +sub getline { + my $self = shift; + + my @ready; + +# if (@ready = $self->{select}->can_read(1)) { # Wait at most 1.0 seconds + # We have only one socket... + return $self->{sock}->getline; +# } +# undef; +} + +sub sendline { + my $self = shift; + my $line = shift; + + my @ready; + + $self->{sock}->blocking(1); + $self->{sock}->printf( "%s\r\n", $line); + $self->{sock}->flush; + + $self->{sock}->blocking(0); + + undef; +} + +# ------------------------------------------------------------------------- diff --git a/tools/aprs-is-rx b/tools/aprs-is-rx index 83c4678..a3c5023 100755 --- a/tools/aprs-is-rx +++ b/tools/aprs-is-rx @@ -9,12 +9,13 @@ select STDOUT; $| = 1; my $quit = 0; my $APRSIS; -my $mycall = 'OH2MQK-RO'; +my $mycall = 'OH2MQK-RR'; my $filter = 'p/OH2R -p/OH2 p/OH '; #my $filter = 'p/OH2R'; -$filter = undef; +$filter = 'p/OH'; -$APRSIS = APRS::IS->new('finland.aprs2.net:10152', $mycall, $filter); +#$APRSIS = APRS::IS->new('finland.aprs2.net:10152', $mycall, $filter); +$APRSIS = APRS::IS->new('localhost:14580', $mycall, $filter ); if (!defined($APRSIS)) { printf "aprsazel: Failed to open APRS-IS socket!\n";