#!/usr/bin/perl 

$VERSION = 'APRS-IS-RX version-1.0';

use POSIX;
use IO::Multiplex;

select STDOUT; $| = 1;    

my $quit = 0;
my $APRSIS;
my $filter = undef;
my $mycall = 'OH2MQK-RR';
#$filter = 'p/OH2R -p/OH2 p/OH ';
#$filter = 'p/OH2R';
#$filter = 't/c*'; #'p/OH';
#$filter = 'p/OH';
#$filter = 't/qs';
$filter = 'p/D';

#$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('db0erf.de:10152', $mycall, $filter);
$APRSIS = APRS::IS->new('db0erf.de:14580', $mycall, $filter);
#$APRSIS = APRS::IS->new('localhost:10152', $mycall, $filter );
#$APRSIS = APRS::IS->new('localhost:14580', $mycall, $filter );
#$APRSIS = APRS::IS->new('localhost:14580u', $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//) {
	    printf "%d\t%s\n", time, $1;
	}
    }

    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;
}

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