283 lines
7.0 KiB
Perl
Executable File
283 lines
7.0 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
$VERSION = 'APRS-IS-RX version-1.0';
|
|
|
|
use POSIX;
|
|
use IO::Multiplex;
|
|
|
|
select STDOUT; $| = 1;
|
|
|
|
my $quit = 0;
|
|
my $APRSIS;
|
|
|
|
my @args;
|
|
my $timestamp = 0;
|
|
my $filter;
|
|
foreach my $arg (@ARGV) {
|
|
if ($arg eq '-t') {
|
|
$timestamp = 1;
|
|
} elsif ($arg eq '-f') {
|
|
$filter = shift @ARGV;
|
|
} else {
|
|
push @args, $arg;
|
|
}
|
|
}
|
|
|
|
my($mycall, $server) = @args;
|
|
|
|
#my $mycall = 'OH2MQK-RR';
|
|
#$filter = 'p/OH2R -p/OH2 p/OH ';
|
|
#$filter = 'p/OH2R';
|
|
#$filter = 't/c*'; #'p/OH';
|
|
#$filter = 'p/OH';
|
|
|
|
#$APRSIS = APRS::IS->new('finland.aprs2.net:10152', $mycall, $filter);
|
|
#$APRSIS = APRS::IS->new('finland.aprs2.net:10152u', $mycall, $filter);
|
|
#$APRSIS = APRS::IS->new('finland.aprs2.net:14580u', $mycall, $filter);
|
|
#$APRSIS = APRS::IS->new('rotate.aprs.net:23', $mycall, $filter);
|
|
#$APRSIS = APRS::IS->new('first.aprs.net:10152u', $mycall, $filter );
|
|
#$APRSIS = APRS::IS->new('first.aprs.net:24579', $mycall, undef );
|
|
#$APRSIS = APRS::IS->new('localhost:10152u', $mycall, $filter );
|
|
#$APRSIS = APRS::IS->new('localhost:14580', $mycall, $filter );
|
|
#$APRSIS = APRS::IS->new('localhost:14580u', $mycall, $filter );
|
|
|
|
if (!defined $mycall || !defined $server) {
|
|
warn "Usage: aprs-is-rx [-t] [-f <filter>] <mycall> <server>\n"
|
|
. "\t-t\ttimestamp received packets\n";
|
|
exit 1;
|
|
}
|
|
|
|
$APRSIS = APRS::IS->new($server, $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 $MUX = new IO::Multiplex;
|
|
$MUX->add( $APRSIS->sock() );
|
|
my $Uclient = $APRSIS->socku();
|
|
$MUX->add( $Uclient ) if (defined($Uclient));
|
|
|
|
$MUX->set_callback_object(__PACKAGE__);
|
|
$MUX->loop();
|
|
|
|
exit 0;
|
|
|
|
|
|
sub mux_input {
|
|
my $package = shift;
|
|
my $MUX = shift;
|
|
my $fh = shift;
|
|
my $data = shift;
|
|
|
|
if ($MUX->is_udp($fh)) {
|
|
printf "%d\t%s\n", time, $$data;
|
|
$$data = '';
|
|
|
|
} else {
|
|
|
|
# Process each line in the input, leaving partial lines
|
|
# in the input buffer
|
|
while ($$data =~ s/^(.*?)\n//) {
|
|
if ($timestamp) {
|
|
printf "%d\t%s\n", time, $1;
|
|
} else {
|
|
print "$1\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
if (time > $last) {
|
|
$MUX->close($fh);
|
|
$MUX->remove($fh);
|
|
$MUX->endloop();
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
|
|
sub mux_eof {
|
|
my $package = shift;
|
|
my $MUX = shift;
|
|
my $fh = shift;
|
|
|
|
$MUX->close($fh);
|
|
$MUX->remove($fh);
|
|
$MUX->endloop();
|
|
}
|
|
|
|
|
|
# -------------------------------------------------------------------------
|
|
|
|
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 sock {
|
|
my $self = shift;
|
|
return $self->{sock};
|
|
}
|
|
sub socku {
|
|
my $self = shift;
|
|
return $self->{socku};
|
|
}
|
|
|
|
sub new {
|
|
my $that = shift;
|
|
my $class = ref($that) || $that;
|
|
my $udp = '';
|
|
# 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
|
|
if ($url =~ m/(.+?):(\d+?)u/) {
|
|
my $uurl = $1.":".$2;
|
|
$self->{sock} = IO::Socket::INET->new($uurl);
|
|
my $u = undef;
|
|
my $p = undef;
|
|
$u = IO::Socket::INET->new( Proto => 'udp',
|
|
PeerAddr => $uurl,
|
|
Blocking => 0 );
|
|
if (defined($u)) {
|
|
$self->{socku} = $u;
|
|
# Open local firewall...
|
|
$u->send("# pim\r\n");
|
|
$u->send("# pim\r\n");
|
|
# ..all right.. something was sent,
|
|
# and thus our udp socket was given
|
|
# a source address. Find it, and add
|
|
# on login message.
|
|
$p = $u->sockport();
|
|
$udp = " udp ".$p;
|
|
}
|
|
} else {
|
|
$self->{sock} = IO::Socket::INET->new($url);
|
|
}
|
|
|
|
if (!defined($self->{sock})) {
|
|
die(__PACKAGE__.": APRS::IS->new(".$url.") failure: $!\n");
|
|
}
|
|
|
|
|
|
$self->{aprsmycall} = $mycall;
|
|
$mycall =~ s/-.*//;
|
|
$self->{aprspass} = aprspass( uc($mycall) );
|
|
if ($self->{aprsmycall} =~ m/CW\d{4}/o) {
|
|
$self->{aprspass} = -1;
|
|
}
|
|
|
|
$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);
|
|
if (defined($self->{filterre})) {
|
|
$self->{sock}->printf( "user %s pass %s vers %s".$udp." 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".$udp."\n",
|
|
$self->{aprsmycall},
|
|
$self->{aprspass}, # -- but we are read-only !
|
|
$main::VERSION, $self->{filterre} );
|
|
} else {
|
|
$self->{sock}->printf( "user %s pass %s vers %s".$udp."\r\n",
|
|
$self->{aprsmycall},
|
|
$self->{aprspass}, # -- but we are read-only !
|
|
$main::VERSION );
|
|
printf( "user %s pass %s vers %s".$udp."\n",
|
|
$self->{aprsmycall},
|
|
$self->{aprspass}, # -- but we are read-only !
|
|
$main::VERSION );
|
|
}
|
|
|
|
$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 $l;
|
|
#if (@ready = $self->{select}->can_read(0.02)) { # Wait at most 0.02 seconds
|
|
# We have only one socket...
|
|
if (defined($self->{socku})) {
|
|
$self->{socku}->recv($l);
|
|
return $l if (defined($l));
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
# -------------------------------------------------------------------------
|