development tools
git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@137 3ce903b1-3385-4e86-93cd-f9a4a239f7ac
This commit is contained in:
Matti Aarnio
parent
3b64205ad1
commit
82f9ac48fb
|
|
@ -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) {
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
|
|
@ -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";
|
||||
|
|
|
|||
Loading…
Reference in New Issue