aprsc/tools/aprs-is-file-feed

#!/usr/bin/perl 

$VERSION = 'filefeed 1.0';


use POSIX;
use Time::HiRes qw(time sleep);

select STDOUT; $| = 1;    

my $quit = 0;
my $APRSIS;

my $mycall = sprintf('F0FED-%d', rand(15));
my $filter; # 'p/OH2R -p/OH2 p/OH ';

$APRSIS = APRS::IS->new('127.0.0.1:55580', $mycall, $filter);

if (!defined($APRSIS)) {
    printf "aprsazel: Failed to open APRS-IS socket!\n";
    exit 4;
}

print "connected\n";

my $sleeprange = 12;

my $now = time;
my $last = $now + 60*60;
my $next = 100;
my $cnt = 0;

my $next_sleep;
$next_sleep = $now + rand($sleeprange) if ($sleeprange);

my $rin;
vec($rin, $APRSIS->{'sock'}, 1) = 1;

while (<>) {
    my $line = $_;
    chomp $line;
    next if ($line !~ /^(\d+) (.*)$/);
    $line = $2;
    
    if ($sleeprange) {
        $now = time();
        if ($now >= $next_sleep) {
            my $sl = rand($sleeprange);
            warn sprintf("sleeping %.3f s\n", $sl);
            sleep($sl);
            warn "done sleeping\n";
            $next_sleep = time() + rand(3);
        }
    }

#    $APRSIS->sendline(sprintf("%d",$now)."\t".$line);
    $APRSIS->sendline("$line\r\n");
    #print "$line\n";

    ++$cnt;
    $APRSIS->flush() if ($cnt % 3 == 0);
    
    my $rout;
    while (select($rout = $rin, '', '', 0)) {
        my $in = $APRSIS->getline();
        last if ($in eq '');
        warn "got: $in\n";
    }

    #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";

exit(0);


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} = $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);
    my $filter = '';
    $filter = "filter " . $self->{filterre} if ($self->{filterre});
    $self->{sock}->printf( "user %s pass %s vers %s%s\r\n",
			   $self->{aprsmycall},
			   $self->{aprspass}, # -- but we are read-only !
			   $main::VERSION, $filter
    );

    printf( "user %s pass %s vers %s%s\n",
	    $self->{aprsmycall},
	    $self->{aprspass}, # -- but we are read-only !
	    $main::VERSION, $filter );
    $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;
}

# -------------------------------------------------------------------------