NFLpositionUpdater/nfl-apu.pl
2025-09-17 07:27:26 +00:00

294 lines
9.7 KiB
Perl

#!perl -w
use strict;
use Socket;
use Math::Trig qw(great_circle_distance deg2rad);
use Net::SMTP;
use Authen::SASL qw(Perl);
# auto-flush on socket
$| = 1;
my $VERSION="0.1";
print "NoForeignLand-AutomaticPositionUpdater $VERSION, by Frans Veldman s/v ZwerfCat (https://www.thefloatinglab.world)\n";
my $tcp=0;
my $gpsd=0;
my $daemon=0;
my $test=0;
my $interval=2;
my $extended=0;
my $user='';
my $pass='';
my $server='';
my $from='';
my $destination='tracking@noforeignland.com';
my $port=587;
my @sockets;
# Get command line options
foreach my $a(@ARGV) {
$daemon=1 if($a eq "-d" || $a eq "--daemon");
$test=1 if($a eq "-T" || $a eq "--test");
$tcp=1 if($a eq "-t" || $a eq "--tcp");
$tcp=1, $gpsd=1 if($a eq "-g" || $a eq "--gpsd");
$extended=1 if($a eq "-x" || $a eq "--extended");
$interval=$2 if($a=~/-(-interval|i)=(\d+)/);
$port=$2 if($a=~/-(-port|p)=(\d+)/);
$destination=$2 if($a=~/-(-override|o)=(\S+)/);
$server=$2 if($a=~/-(-server|s)=(\S+)/);
$user=$2 if($a=~/-(-user|u)=(\S+)/);
$pass=$2 if($a=~/-(-password|w)=(\S+)/);
$from=$2 if($a=~/-(-email|e)=(\S+)/);
if($a eq "-?" || $a eq "-h" || $a eq "--help") {
print "\nUsage:\n";
print "\tperl nfl-apu.pl [OPTIONS] <SOURCE IP:PORT>\n";
print "Control options:\n";
print "\t-h --help Display help\n";
print "\t-T --test Debug output\n";
print "\t-d --daemon Run as daemon\n";
print "NMEA connection options:\n";
print "\t-t --tcp Use TCP source instead of UDP\n";
print "\t-g --gpsd Use GPSD source\n";
print "Update options:\n";
print "\t-x --extended Extended updates (with SOG, COG, DPT)\n";
print "\t-i --interval=<NM> Nautical miles between position updates (default $interval). A value 0 means \"arrival updates only\"\n";
print "Email options:\n";
print "\t-u --user=<USERNAME> Email account inlog user\n";
print "\t-w --password=<PASSWORD> The password associated with the user account\n";
print "\t-s --server=<ADDRESS> SMTP server\n";
print "\t-p --port=<PORT> SMTP port (default $port)\n";
print "\t-e --email=<ADDRESS> Source email address\n";
print "\t-o --override=<ADDRESS> Override destination email address (default '$destination')\n";
print "Example:\n";
print "\tperl nfl-apu.pl -t -g -i=2 -x -u=Frans -s=mail.fransveldman.nl -e=noreply\@thefloatinglab.world 127.0.0.1:2947\n";
exit;
}
next if($a=~/^-/);
if($a=~/^((([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])\.){3}([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])):([0-9]+)$/) {
push @sockets,pack_sockaddr_in($5, inet_aton($1));
} else {
die "Error: $a is not a valid IP:PORT address!\n";
}
}
use Fcntl qw(LOCK_EX LOCK_NB);
open our $file, '<', $0 or die $!;
die "Another instance is already running!\n" unless (flock $file, LOCK_EX|LOCK_NB);
# Check that at least a source address has been specified
die "Error: No NMEA source specified!\n" unless(@sockets);
die "Error: No username specified!\n" if($user eq '');
die "Error: No smtp server specified!\n" if($server eq '');
die "Error: No email source specified!\n" if($from eq '');
while($pass eq '') {
print "Enter password: ";
$pass=<STDIN>;
chomp $pass;
print "\n";
}
$daemon=0 if($test);
daemonize() if($daemon);
my $sock;
sourceconnect();
my $datadetected=0;
my $positiondetected=0;
my $depthdetected=0;
my $starttime=time;
my $timer=0;
my $prevlat=0;
my $prevlon=0;
my $depth=0;
# just loop forever listening for packets
while (1) {
my $data=<$sock>;
if(length($data)==0) {
# We lost the connection, so re-establish it
close($sock) if($tcp);
sourceconnect();
next;
}
if(!$datadetected && $data=~/\$[A-Z]+,.*\*../) {
$datadetected++;
print "NMEA stream detected.\n";
}
if($data=~/\$\w\wDPT,(\d+\.?\d*),([+-]?\d*\.?\d*).*\*../) {
$depth=$1;
$depth+=$2 if(defined $2);
if(!$depthdetected) {
$depthdetected++;
print "Depth: $depth meters\n";
}
}
next if(time-$starttime<8 && !$depthdetected); # Just wait a little for NMEA data acquisition
# Get the position update
# $<TalkerID>RMC,<Timestamp>,<Status>,<Lat>,<N/S>,<Long>,<E/W>,<SOG>,<COG>,<Date>,<MagVar>,<MagVarDir>,<mode>,<NavStatus>*<checksum><CR><LF>
if($data=~/\$G[A-Z]RMC,\d*\.?\d*,A,(\d\d)(\d\d\.\d+),([NS]),(\d\d\d)(\d\d\.\d+),([EW]),([0-9]*\.?[0-9]*),(\d*)\.?\d*,.*\*../) {
my $latdeg=$1; my $latmin=$2; my $latdir=$3; my $londeg=$4; my $lonmin=$5; my $londir=$6; my $sog=$7; my $cog=$8;
my $lat=$latdeg+($latmin/60);
$lat=-$lat if($latdir eq 'S');
my $lon=$londeg+($lonmin/60);
$lon=-$lon if($londir eq 'W');
if(!$positiondetected) {
$positiondetected++;
print "Lat: $latdeg degrees $latmin minutes $latdir\nLon: $londeg degrees $lonmin minutes $londir\nSOG: $sog COG: $cog\n";
}
my $distance=gps_distance($lat,$lon,$prevlat,$prevlon);
# We want to be one unit behind, so that when arriving at a destination we are guaranteed to have a substantial distance from our previous waypoint.
# So, when the criteria for an update are met, we update a previous position, unless after we have arrived.
# If the speed is almost zero, and we have a distance between the previous reported position, it looks like we arrived somewhere.
my $arrived=0;
if($sog<0.4 && $distance>0.1) {
$timer=time if(!$timer);
$arrived=1 if(time-$timer>600);
} else {
$timer=0;
}
my $update=0;
$update=1 if($interval && $distance>$interval);
# At the start of the program, we broadcast the current position, so we update prevlat and prevlon right away. We also do this if we have arrived somewhere.
if((!$prevlat && !$prevlon) || $arrived) {
$prevlat=$lat;
$prevlon=$lon;
$update=1; # Force a position update
$arrived=1 if($sog<0.4); # Assume that we have arrived somewhere
}
if($update) {
# Submit position report
$latdir='N';
if($prevlat<0) {
$prevlat=-$prevlat;
$latdir='S';
}
$prevlat=~/(\d+)(\.\d+)/;
$latdeg=$1;
$latmin='0'.$2;
$latmin=sprintf("%.4f", $latmin*60);
$londir='E';
if($prevlon<0) {
$prevlon=-$prevlon;
$londir='W';
}
$prevlon=~/(\d+)(\.\d+)/;
$londeg=$1;
$lonmin='0'.$2;
$lonmin=sprintf("%.4f", $lonmin*60);
my $msgbody=<<END;
From: $from
To: $destination
Subject: Position update
LAT|$latdeg|$latmin|$latdir
LON|$londeg|$lonmin|$londir
END
if($extended) {
if($arrived) {
$msgbody.="Depth: $depth meters.\n";
} else {
$msgbody.="SOG: $sog kts, COG: $cog degrees.\n";
}
}
print "---\n$msgbody---\n" if(!$daemon);
print "Submitting position report... " if(!$daemon);
my $smtp = Net::SMTP->new($server, Port => $port, Timeout => 60, Debug => $test);
if($smtp) {
$smtp->starttls();
$smtp->auth($user,$pass) or die "Error: could not authenticate: $smtp->status, $smtp->message\n";
$smtp->mail($from);
$smtp->to($destination);
$smtp->data();
$smtp->datasend($msgbody);
$smtp->dataend;
$smtp->quit;
print "Done\n" if(!$daemon);
} else {
print "Failed\n" if(!$daemon);
}
$prevlat=$lat;
$prevlon=$lon;
}
}
}
sub gps_distance {
my ($lat0,$lon0,$lat1,$lon1) = @_;
return great_circle_distance(deg2rad($lon0), deg2rad(90-$lat0), deg2rad($lon1), deg2rad(90-$lat1), 3443.931); # nautical miles
}
sub sourceconnect {
if($tcp) {
# Connect for TCP source
print "Connecting... " if(!$daemon);
socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!";
setsockopt($sock, SOL_SOCKET, SO_KEEPALIVE, 1);
connect($sock,$sockets[0]) || die "Could not connect to TCP port!\n";
print "Connected!\n" if(!$daemon);
if($gpsd) {
# Configure GPSD output, and skip config messages
send($sock,'?WATCH={"enable":true,"json":false,"nmea":true,"raw":0,"scaled":false,"timing":false,"split24":false,"pps":false}',0);
while(my $line= <$sock>) {
last unless($line=~/\{/);
print $line if(!$daemon);
}
}
} else {
# Connect to UDP source
socket($sock, PF_INET, SOCK_DGRAM, getprotobyname('udp')) || die "socket: $!";
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
setsockopt($sock,SOL_SOCKET,SO_RCVBUF,100000);
bind($sock, $sockets[0]) || die "bind: $!";
}
}
sub daemonize {
use POSIX;
POSIX::setsid or die "setsid: $!";
my $pid = fork() // die $!; #//
if($pid) {
print "Started daemon (PID $pid)\n";
exit(0);
}
chdir "/";
umask 0;
open (STDIN, "</dev/null");
open (STDOUT, ">/dev/null");
open (STDERR, ">&STDOUT");
}