test data copy tool
git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@87 3ce903b1-3385-4e86-93cd-f9a4a239f7ac
This commit is contained in:
Matti Aarnio
parent
512f280aaa
commit
4eee97f0fc
|
|
@ -0,0 +1,178 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
$VERSION = 'APRS-IS-XMIT version-1.0';
|
||||
|
||||
|
||||
use POSIX;
|
||||
|
||||
select STDOUT; $| = 1;
|
||||
|
||||
my $quit = 0;
|
||||
my $APRSIS;
|
||||
|
||||
my $mycall = 'OH2MQK-RO';
|
||||
my $filter = 'p/OH2R -p/OH2 p/OH ';
|
||||
|
||||
$APRSIS = APRS::IS->new('localhost:14580', $mycall, $filter);
|
||||
$ISIN = APRS::IS->new('finland.aprs2.net:10152', $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 = time + 5;
|
||||
|
||||
while (! $quit && $now < $last) {
|
||||
|
||||
local $line;
|
||||
local %aprs;
|
||||
|
||||
$now = time;
|
||||
$line = $APRSIS->getline;
|
||||
next if (!defined $line);
|
||||
chomp $line;
|
||||
printf "T> %s\n", $line;
|
||||
|
||||
$line = $ISIN->getline;
|
||||
next if (!defined $line);
|
||||
chomp $line;
|
||||
printf "A< %s\n", $line;
|
||||
$APRSIS->sendline($line);
|
||||
}
|
||||
|
||||
printf "\n";
|
||||
|
||||
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;
|
||||
|
||||
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(1);
|
||||
|
||||
undef;
|
||||
}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
Loading…
Reference in New Issue