From 4eee97f0fcfac829e1fe837a01925b91b2db8147 Mon Sep 17 00:00:00 2001
From: Matti Aarnio <oh2mqk@sral.fi>
Date: Mon, 10 Mar 2008 07:04:20 +0000
Subject: [PATCH] test data copy tool

git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@87 3ce903b1-3385-4e86-93cd-f9a4a239f7ac
---
 tools/aprs-is-copy | 178 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 178 insertions(+)
 create mode 100644 tools/aprs-is-copy

diff --git a/tools/aprs-is-copy b/tools/aprs-is-copy
new file mode 100644
index 0000000..45fa76f
--- /dev/null
+++ b/tools/aprs-is-copy
@@ -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;
+}
+
+# -------------------------------------------------------------------------