[aprssig] Small PC program to send APRS location via Internet

Arne Stahre sm6vyf at gatugarden.com
Sun Oct 2 14:13:59 EDT 2005


  Hi!

  This is relatively small (except that you'll need perl - 
http://www.perl.org/ or http://aspn.activestate.com/ASPN/).
  Somewhat tested with Linux and Windows 2000.

  73 de SM6VYF/Arne

#!/usr/bin/perl -w
# 2005-10-02 de SM6VYF/Arne
use strict;
use Socket;

our $PROGNAME = 'SmallPC';
our $PROGVERSION = '0.9';

our $HOST = 'northwest.aprs2.net', # cf. http://www.aprs2.net/
our $PORT = 14580,                 # cf. http://www.aprs2.net/
our $TTY = '/dev/ttyS0';           # or, e.g., 'COM1' for Windows

our ($CALL, $TABLE, $SYMBOL, $COMMENT) = ('MYCALL', '/', '-', "$PROGNAME 
$PROGVERSION");
our $INTERVAL = 30;

our $DEBUG = 1;

our $TIMEOUT = 10;

sub nmea_checksum {
   my ($str) = @_;

   my ($cs, $i, $sum);

   if ($str =~ /\$(.*?)\*([0-9A-F]{2})/) {
     $str = $1;
     $cs = hex($2);
     $sum = 0;
     for ($i = 0; $i < length($str); $i += 1) {
       $sum ^= ord(substr($str, $i, 1));
     }
     return ($cs == $sum);
   }
   return 0;
}

sub parse_rmc {
   my ($str) = @_;

   if (my ($hour, $min, $sec, $statc,
	  $lat, $latmin, $latc,
	  $lon, $lonmin, $lonc,
	  $sog, $tmg,
	  $day, $month, $year) =
       ($str =~ m/\$GPRMC,(\d{2})(\d{2})(\d{2})\.\d+,(.),
                  (\d{2})(\d+\.\d*),(.),
                  (\d{3})(\d+\.\d*),(.),
                  (\d+\.\d*),(\d+\.\d*),
                  (\d{2})(\d{2})(\d{2})/x)) {
      if ($statc eq 'A') {
        if (nmea_checksum($str)) {
	return (sprintf('%02d%05.2f%s', $lat, $latmin, $latc),
		sprintf('%03d%05.2f%s', $lon, $lonmin, $lonc),
		sprintf('%02d%02d%02d', $day, $hour, $min),
		sprintf('%03d', $tmg),
		sprintf('%03d', $sog));
        }
      }
    }
    return ();
}

sub aprspass {
    my ($call) = @_;

    $call =~ m/([^\-]+)/i;	# skip SSID
    my @call = split(//, $1);
    my $hash = 0x73e2;
    for (my $i = 0; $i < $#call; $i += 2) {
      $hash ^= ord($call[$i]) << 8;
      $hash ^= ord($call[$i + 1]);
    }
    return $hash;
}

my $proto = getprotobyname('tcp');
socket(\*H, AF_INET, SOCK_STREAM, $proto) or die "socket:$!";
my $in_addr = (gethostbyname($HOST))[4];
my $addr = sockaddr_in($PORT, $in_addr);
connect(\*H, $addr) or die "connect:$!";

my $pass = aprspass("$CALL");
syswrite(\*H, "user $CALL pass $pass vers $PROGNAME $PROGVERSION\r");
sleep(1);

my $nmea;
my $timestamp = 0;

system("stty 4800 -echo -cstopb raw < $TTY") if $^O eq 'linux';
if (open(GPS, "+<$TTY")) {
    my $running = 1;

    $SIG{INT} = sub { $running = 0 };

    while ($running) {
      eval {
        local $SIG{ALRM} = sub { die "alarm\n" };
        alarm($TIMEOUT);
        $nmea = <GPS>;
        alarm(0);
      };
      if ($@) {
        die unless $@ eq "alarm\n";
      } elsif (! $nmea) {
        $running = 0;
      } elsif (length $nmea ne 0) {
        if (time() - $timestamp > $INTERVAL) {
	 my ($lat, $lon, $time, $cse, $spd) = parse_rmc($nmea);
	 if ($lat && $lon) {
	   my $beacon = 
"$CALL>APZ001,TCPIP:/${time}z$lat$TABLE$lon$SYMBOL$cse/$spd $COMMENT";
	   print "$beacon\n" if $DEBUG;
	   syswrite(\*H, "$beacon\r");
	   $timestamp = time();
	 }
        }
      }
      print " $nmea" if $DEBUG;
    }
    close(GPS);
}

close(\*H);




More information about the aprssig mailing list