#!/usr/bin/env perl ## aprs-output provided by daniestevez ## axudp extensions provided by dl9rdz use strict; use warnings; use IO::Socket::INET; use Getopt::Long; my $filename = undef; my $date = undef; my $mycallsign; my $passcode; my $comment; my $udp; GetOptions("u=s" => \$udp) or die "Error in command line arguments\n"; while (@ARGV) { $mycallsign = shift @ARGV; $passcode = shift @ARGV; $comment = shift @ARGV; $filename = shift @ARGV; } my $fpi; if (defined $filename) { open($fpi, "<", $filename) or die "Could not open $filename: $!"; } else { $fpi = *STDIN; } my $fpo = *STDOUT; my $line; my $hms; my $lat; my $lon; my $alt; my $sign = 1; my $NS; my $EW; my $str; my $speed = 0.00; my $course = 0.00; my $callsign; my $temp; # axudp: encodecall: encode single call sign ("AB0CDE-12*") up to 6 letters/numbers, ssid 0..15, optional "*"; last: set in last call sign (dst/via) sub encodecall{ my $call = shift; my $last = shift; if(!($call =~ /^([A-Z0-9]{1,6})(-\d+|)(\*|)$/)) { die "Callsign $call not properly formatted"; }; my $callsign = $1 . ' 'x(6-length($1)); my $ssid = length($2)>0 ? 0-$2 : 0; my $hbit = $3 eq '*' ? 0x80 : 0; my $encoded = join('',map chr(ord($_)<<1),split //,$callsign); $encoded .= chr($hbit | 0x60 | ($ssid<<1) | ($last?1:0)); return $encoded; } # kissmkhead: input: list of callsigns (dest, src, repeater list); output: raw kiss frame header data sub kissmkhead { my @calllist = @_; my $last = pop @calllist; my $enc = join('',map encodecall($_),@calllist); $enc .= encodecall($last, 1); return $enc; } #create CRC tab my @CRCL; my @CRCH; my ($c, $crc,$i); for $c (0..255) { $crc = 255-$c; for $i (0..7) { $crc = ($crc&1) ? ($crc>>1)^0x8408 : ($crc>>1); } $CRCL[$c] = $crc&0xff; $CRCH[$c] = (255-($crc>>8))&0xff; } sub appendcrc { $_ = shift; my @data = split //,$_; my ($b, $l, $h)=(0,0,0); for(@data) { $b = ord($_) ^ $l; $l = $CRCL[$b] ^ $h; $h = $CRCH[$b]; } $_ .= chr($l) . chr($h); return $_; } my ($sock,$kissheader); if($udp) { my ($udpserver,$udpport)=split ':',$udp; $udpserver = "127.0.0.1" unless $udpserver; $sock = new IO::Socket::INET(PeerAddr => $udpserver, PeerPort => $udpport, Proto => "udp", Timeout => 1) or die "Error creating socket"; # $kissheader = kissmkhead("APRS",uc($mycallsign),"TCPIP*"); $kissheader = kissmkhead("APRS",uc($mycallsign)); } print $fpo "user $mycallsign pass $passcode vers \"RS decoder\"\n"; while ($line = <$fpi>) { print STDERR $line; ## entweder: alle Zeilen ausgeben if ($line =~ /(\d\d):(\d\d):(\d\d\.?\d?\d?\d?).*\ +lat:\ *(-?\d*)(\.\d*).*\ +lon:\ *(-?\d*)(\.\d*).*\ +alt:\ *(-?\d*\.\d*).*/) { #print STDERR $line; ## oder: nur Zeile mit Koordinaten ausgeben $hms = $1*10000+$2*100+$3; if ($4 < 0) { $NS="S"; $sign *= -1; } else { $NS="N"; $sign = 1} $lat = $sign*$4*100+$5*60; if ($6 < 0) { $EW="W"; $sign = -1; } else { $EW="E"; $sign = 1; } $lon = $sign*$6*100+$7*60; $alt = $8*3.28084; ## m -> feet if ($line =~ /(\d\d\d\d)-(\d\d)-(\d\d).*/) { $date = $3*10000+$2*100+($1%100); } if ( ($line =~ /vH:\ *(\d+\.\d+)\ +D:\ *(\d+\.\d+).*/) or ($line =~ /vH:\ *(\d+\.\d+)m\/s\ +D:\ *(\d+\.\d+).*/) ) { $speed = $1*3.6/1.852; ## m/s -> knots $course = $2; } # match either (id) or (type:id) and return id if ($line =~ /\(.*?([\w]+)\)/) { $callsign = $1; } if ($line =~ /T=(-?[\d.]+)C/) { $temp = " T=$1C"; } else { $temp = ""; } $str = sprintf("$mycallsign>APRS,TCPIP*:;%-9s*%06dh%07.2f$NS/%08.2f${EW}O%03d/%03d/A=%06d$comment$temp", $callsign, $hms, $lat, $lon, $course, $speed, $alt); print $fpo "$str\n"; if($sock) { $str = (split(":",$str))[1]; print $sock appendcrc($kissheader.chr(0x03).chr(0xf0).$str); } } #elsif ($line =~ / # xdata = (.*)/) { ## nicht, wenn (oben) alle Zeilen ausgeben werden # if ($1) { # print STDERR $line; # } #} } close $fpi; close $fpo;