522 lines
13 KiB
Perl
Executable File
522 lines
13 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
# FlightGear METAR proxy server
|
|
# Melchior FRANZ (c) 2005, <mfranz # aon : at>, GPL V2
|
|
# $Id$
|
|
#
|
|
# typical use
|
|
# 1) fill cache, for example with:
|
|
# $ metarproxy --download 3h
|
|
#
|
|
# 2) run proxy with FlightGear:
|
|
# $ metarproxy -c -v &
|
|
# $ fgfs --enable-real-weather-fetch --proxy=localhost:5509 --start-date-lat=2005:01:11:12:00:00
|
|
|
|
use strict;
|
|
use IO::Socket;
|
|
use Net::hostent;
|
|
use Time::Local;
|
|
|
|
my $HOME = $ENV{'HOME'} || ".";
|
|
my $FG_HOME = $ENV{'FG_HOME'} || $HOME . "/.fgfs";
|
|
my $BASE = $FG_HOME . "/metar";
|
|
my $SERVER = "tgftp.nws.noaa.gov";
|
|
my $PORT = 5509;
|
|
my $PROXY = $ENV{'http_proxy'};
|
|
my $METAR_MAX_AGE = 250 * 60;
|
|
my $METAR_DEFAULT = "00000KT 15KM CLR 15/00 A3000";
|
|
my @COLOR = ("31;1", "31", "32", "", "36;1");
|
|
my $USECOLOR = 0;
|
|
|
|
|
|
my $help = <<EOF;
|
|
Usage:
|
|
metarproxy [-v] [-b <path>] [-p <port>] [--serve]
|
|
metarproxy [-v] [-b <path>] [-y <proxy>] --download <list of: all|7|0-10|6h>
|
|
metarproxy [-v] [-b <path>] [-y <proxy>] --record [<list of station IDs>] [-f <path>]
|
|
metarproxy [-v] [-b <path>] --install <list of metar files>
|
|
metarproxy [-V]
|
|
metarproxy [-h]
|
|
|
|
server mode:
|
|
-s|--serve start proxy server (default)
|
|
-p|--port set port (default: $PORT)
|
|
|
|
download mode:
|
|
-d|--download <list of hours>
|
|
"all" ... whole day (24 files)
|
|
<number> ... this hour (example: 6)
|
|
<range> ... these hours (example: 2-5)
|
|
<period> ... last n hours (example: 3h)
|
|
-y|--proxy use proxy (default: off)
|
|
|
|
install mode:
|
|
-i|--install <list of files to install>
|
|
|
|
record mode:
|
|
-r|--record <list of METAR station IDs (ICAO)>
|
|
-f|--file <file containing list of station IDs>
|
|
-y|--proxy use proxy (default: off)
|
|
|
|
all modes:
|
|
-b|--base set base directory (default: \$FG_HOME/metar)
|
|
-c|--color toggle color mode (default: off)
|
|
-v|--verbose increase verbosity level (default: off; maximum: -vvvv)
|
|
|
|
-q|--quiet only show error messages
|
|
-h|--help this help
|
|
-V|--version return version number
|
|
|
|
Environment:
|
|
FG_HOME ... FlightGear home directory (default: \$HOME/.fgfs)
|
|
METARPROXY ... default options (e.g. export METARPROXY='-vv --color')
|
|
http_proxy ... system wide proxy setting (currently: '$PROXY')
|
|
|
|
Examples:
|
|
\$ metarproxy -b\$HOME/.fgfs/metar --download 3h
|
|
\$ metarproxy --proxy=http://localhost:3128 --download all
|
|
\$ metarproxy --download 3h 7 21-23
|
|
\$ metarproxy --record -f/tmp/list LOWW LOWL
|
|
\$ metarproxy -b/var/tmp/metar --install /tmp/*Z.TXT
|
|
\$ metarproxy -p5600 & fgfs --proxy=localhost:5600 --enable-real-weather-fetch
|
|
\$ http_proxy= metarproxy --record LOXL
|
|
|
|
Sources:
|
|
http://tgftp.nws.noaa.gov/data/observations/metar/{stations,cycles}/
|
|
ftp://tgftp.nws.noaa.gov/data/observations/metar/{stations,cycles}/
|
|
EOF
|
|
|
|
|
|
my $ERR = 0;
|
|
my $WARN = 1;
|
|
my $INFO = 2;
|
|
my $BULK = 3;
|
|
my $DEBUG = 4;
|
|
my $VERBOSITY = $INFO;
|
|
|
|
my @ITEMS;
|
|
my $PROXYHOST;
|
|
my $PROXYPORT;
|
|
|
|
|
|
# main =======================================================================
|
|
|
|
|
|
sub parse_options()
|
|
{
|
|
sub argument {
|
|
map { return $_ if defined $_ and $_ ne "" } @_;
|
|
shift @ARGV;
|
|
return $ARGV[0];
|
|
}
|
|
my $mode = 4;
|
|
unshift @ARGV, split /\s+/, $ENV{'METARPROXY'} if defined $ENV{'METARPROXY'};
|
|
while (1) {
|
|
$_ = $ARGV[0];
|
|
defined $_ or last;
|
|
if (!/^-/) {
|
|
push @ITEMS, $_;
|
|
} elsif (/^(-d|--download)$/) {
|
|
$mode = 1;
|
|
} elsif (/^(-i|--install)$/) {
|
|
$mode = 2;
|
|
} elsif (/^(-r|--record)$/) {
|
|
$mode = 3;
|
|
} elsif (/^(-s|--server?)$/) {
|
|
$mode = 4;
|
|
} elsif (/^(-b(.*)|--base(=(.*))?)/) {
|
|
my $path = &argument($2, $4);
|
|
defined $path or &fatal("-b|--base option lacks <path> argument");
|
|
$path =~ s/^~/$HOME/;
|
|
$BASE = $path;
|
|
&log($BULK, "set option --base: '$BASE'");
|
|
} elsif (/^(-f(.*)|--file(=(.*))?)$/) {
|
|
my $file = &argument($2, $4);
|
|
defined $file or &fatal("-f|--file option lacks <path> argument");
|
|
&log($BULK, "set option --file: '$file'");
|
|
&read_icao_file($file);
|
|
} elsif (/^(-p(.*)|--port(=(.*))?)$/) {
|
|
$PORT = &argument($2, $4);
|
|
defined $PORT or &fatal("--port option lacks <port number> argument");
|
|
&log($BULK, "set option --port: '$PORT'");
|
|
} elsif (/^(-y(.*)|--proxy(=(.*))?)$/) {
|
|
$PROXY = &argument($2, $4);
|
|
defined $PROXY or &fatal("--proxy option lacks <host> definition");
|
|
&log($BULK, "set option --proxy: '$PROXY'");
|
|
} elsif (/^--verbose$/) {
|
|
$VERBOSITY++;
|
|
} elsif (/^-(v+)$/) {
|
|
$VERBOSITY += length($1);
|
|
} elsif (/^(-q|--quiet)$/) {
|
|
$VERBOSITY = 0;
|
|
} elsif (/^(-h|--help)$/) {
|
|
print $help;
|
|
return 0;
|
|
} elsif (/^(-V|--version)$/) {
|
|
($_ = '$Revision$') =~ s/.*(\d+\.\d+).*/print "$1\n"/e;
|
|
return 0;
|
|
} elsif (/^(-c|--color)$/) {
|
|
$USECOLOR = !$USECOLOR;
|
|
} else {
|
|
&fatal("unknown option $_");
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
return $mode;
|
|
}
|
|
|
|
|
|
sub main()
|
|
{
|
|
undef $PROXY if $PROXY eq "";
|
|
my $mode = &parse_options();
|
|
exit if $mode == 0;
|
|
|
|
-d $FG_HOME or mkdir $FG_HOME or &fatal("cannot create directory $FG_HOME ($!)");
|
|
-d $BASE or mkdir $BASE or &fatal("cannot create directory $BASE ($!)");
|
|
|
|
if (defined $PROXY) {
|
|
$PROXY =~ m|^(http://)?([a-zA-Z][a-zA-Z0-9-.]*):(\d+)/?| or &fatal("invalid proxy address: '$PROXY'");
|
|
($PROXYHOST, $PROXYPORT) = ($2, $3);
|
|
}
|
|
|
|
my $ret = 0;
|
|
if ($mode == 1) {
|
|
$ret = &download;
|
|
} elsif ($mode == 2) {
|
|
$ret = &install();
|
|
} elsif ($mode == 3) {
|
|
$ret = &record();
|
|
} elsif ($mode == 4) {
|
|
&log($ERR, "ignoring command line args: " . (join ", ", @ITEMS)) if @ITEMS;
|
|
$ret = &serve();
|
|
}
|
|
exit $ret;
|
|
}
|
|
|
|
|
|
sub read_icao_file($)
|
|
{
|
|
my $path = shift;
|
|
$path =~ s/^\~/$HOME/;
|
|
|
|
if (!open(F, "<$path")) {
|
|
&log($ERR, "cannot open station list $path ($!)");
|
|
return;
|
|
}
|
|
while (<F>) {
|
|
s/\s+$//;
|
|
foreach (split) {
|
|
if (/^[A-Z][A-Z0-9]{3}$/) {
|
|
push @ITEMS, $_;
|
|
} else {
|
|
&log($ERR, "discarding suspicious station from $path: $_");
|
|
}
|
|
}
|
|
}
|
|
close F or &log($ERR, "cannot close station list $path ($!)");
|
|
}
|
|
|
|
|
|
# download ===================================================================
|
|
|
|
|
|
sub download()
|
|
{
|
|
my %h;
|
|
sub norm {
|
|
my $i = shift;
|
|
$i = 0 if $i < 0;
|
|
$i = 23 if $i > 23;
|
|
return $i;
|
|
}
|
|
foreach (@ITEMS) {
|
|
if (/^all$/) {
|
|
map { $h{$_} = 1 } (0 .. 23);
|
|
} elsif (/^(\d+)-(\d+)$/) {
|
|
map { $h{$_} = 1 } (&norm($1) .. &norm($2));
|
|
} elsif (/^(\d+)h$/) {
|
|
my $to = (gmtime(time))[2];
|
|
my $from = $to - &norm($1) + 1;
|
|
if ($from < 0) {
|
|
map { $h{$_} = 1 } ((24 + $from) .. 23);
|
|
$from = 0;
|
|
}
|
|
map { $h{$_} = 1 } ($from .. $to);
|
|
} elsif (/^(\d+)$/) {
|
|
$h{&norm($1)} = 1;
|
|
} else {
|
|
&log($ERR, "illegal download argument '$_' ignored");
|
|
}
|
|
}
|
|
@ITEMS = sort { $a <=> $b } keys %h;
|
|
@ITEMS or &fatal("nothing to download");
|
|
&log($INFO, "downloading: " . (join ", ", @ITEMS));
|
|
foreach (@ITEMS) {
|
|
my $file = sprintf "/pub/data/observations/metar/cycles/%02dZ.TXT", $_;
|
|
&install_metar_http($SERVER, "80", $file);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
# install ====================================================================
|
|
|
|
|
|
sub install()
|
|
{
|
|
foreach my $file (@ITEMS) {
|
|
&log($INFO, "installing $file");
|
|
if (! -f $file) {
|
|
&log($ERR, "file $file doesn't exist");
|
|
next;
|
|
}
|
|
if (!open (IN, "<$file")) {
|
|
&log($ERR, "cannot open $file ($!)");
|
|
next;
|
|
}
|
|
local $/ = "";
|
|
&install_metar($_) foreach <IN>;
|
|
close IN or &log($ERR, "cannot close $file ($!)");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
# install a METAR string KSFO under $FG_HOME/metar/2005-01-12/K/KS/KSFO
|
|
sub install_metar($)
|
|
{
|
|
my $metar = shift;
|
|
return unless $metar =~ /^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012([A-Z])([A-Z0-9])([A-Z0-9]{2})\s/s;
|
|
|
|
my $name = sprintf "$BASE/%04d-%02d-%02d", $1, $2, $3;
|
|
-d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
|
|
$name .= "/$6";
|
|
-d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
|
|
$name .= "/$6$7";
|
|
-d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
|
|
$name .= "/$6$7$8";
|
|
|
|
my $found;
|
|
if (open(F, "<$name")) {
|
|
local $/ = "";
|
|
while (<F>) {
|
|
if (m|^$1/$2/$3 $4:$5\s|s) {
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
close F or &log($ERR, "cannot close file $name ($!)");
|
|
return if defined $found;
|
|
}
|
|
&log($INFO, "writing to $name");
|
|
|
|
open(F, ">>$name") or &fatal("cannot append to file $name ($!)");
|
|
print F $metar;
|
|
close F or &log($ERR, "cannot close file $name ($!)");
|
|
}
|
|
|
|
|
|
|
|
sub install_metar_http($$$)
|
|
{
|
|
my ($server, $port, $addr) = @_;
|
|
&log($INFO, "installing data from http://$server:$port$addr");
|
|
if (defined $PROXYHOST) {
|
|
&log($INFO, "via proxy http://$PROXYHOST:$PROXYPORT");
|
|
$addr = "http://$server" . $addr;
|
|
($server, $port) = ($PROXYHOST, $PROXYPORT);
|
|
}
|
|
|
|
my $socket = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $server, PeerPort => $port);
|
|
$socket or &fatal("cannot connect to http://$server:$port$addr/ ($!)");
|
|
$socket->autoflush(1);
|
|
my $get = "GET $addr HTTP/1.0";
|
|
print $socket "$get\015\012\015\012";
|
|
&log($DEBUG, ":$get:");
|
|
|
|
# skip header
|
|
while (<$socket>) {
|
|
s/\s*$//;
|
|
last if /^$/;
|
|
&log($DEBUG, "[$_]");
|
|
}
|
|
local $/ = "";
|
|
foreach (<$socket>) {
|
|
&install_metar("$_\n");
|
|
}
|
|
close($socket) or &log($ERR, "cannot close INET socket ($!)");
|
|
return 0;
|
|
}
|
|
|
|
|
|
# record =====================================================================
|
|
|
|
|
|
sub record()
|
|
{
|
|
@ITEMS or &fatal("no stations given");
|
|
|
|
my %h;
|
|
# check for validity and remove duplicates
|
|
foreach (@ITEMS) {
|
|
if (/^[A-Z][A-Z0-9]{3}$/) {
|
|
$h{$_} = 1;
|
|
} else {
|
|
&log($ERR, "discarding invalid station '$_'");
|
|
}
|
|
}
|
|
@ITEMS = sort keys %h;
|
|
|
|
&log($INFO, "recording stations @ITEMS");
|
|
while (1) {
|
|
foreach (@ITEMS) {
|
|
&install_metar_http($SERVER, "80", "/pub/data/observations/metar/stations/$_.TXT");
|
|
}
|
|
&log($INFO, "sleeping ...");
|
|
sleep 15 * 60
|
|
}
|
|
}
|
|
|
|
|
|
# serve ======================================================================
|
|
|
|
|
|
sub serve()
|
|
{
|
|
my $server = IO::Socket::INET->new(Proto => 'tcp', LocalPort => $PORT, Listen => SOMAXCONN, Reuse => 1);
|
|
$server or &fatal("cannot setup server ($!)");
|
|
&log($BULK, "server $0 accepting clients on port $PORT");
|
|
my %last_metar;
|
|
|
|
while (my $client = $server->accept()) {
|
|
$client->autoflush(1);
|
|
my $hostinfo = gethostbyaddr($client->peeraddr);
|
|
my $clientname = $hostinfo->name || $client->peerhost;
|
|
my $addr = inet_ntoa(inet_aton($clientname));
|
|
|
|
my ($icao, $epoch);
|
|
while (<$client>) {
|
|
s/\s+$//;
|
|
&log($DEBUG, $_);
|
|
|
|
if (m|^GET\s+http://tgftp.nws.noaa.gov/.*/([A-Z][A-Z0-9]{3}).TXT\s+HTTP/|) {
|
|
$icao = $1;
|
|
} elsif (/X-Time: (\d+)/) {
|
|
$epoch = $1;
|
|
} elsif (/^$/) {
|
|
last;
|
|
} else {
|
|
&log($INFO, "$_") if $VERBOSITY < $DEBUG;
|
|
}
|
|
}
|
|
|
|
if (defined $icao and defined $epoch) {
|
|
my ($min, $hour, $day, $mon, $year) = (gmtime($epoch))[1 .. 5];
|
|
$year += 1900;
|
|
$mon++;
|
|
&log($BULK, sprintf "client '$clientname' [$addr] requests data for station $icao "
|
|
. "at %04d/%02d/%02d %02d:%02d", $year, $mon, $day, $hour, $min);
|
|
|
|
my ($metar, $age) = &get_metar($icao, $epoch);
|
|
if (defined $metar) {
|
|
if ($age <= $METAR_MAX_AGE) {
|
|
&log($BULK, "found (" . int($age / 60) . " min old)");
|
|
$metar =~ s/\s*$//s;
|
|
$last_metar{$addr} = $metar;
|
|
$last_metar{$addr} =~ s/.*\015?\012[A-Z0-9]{4}\s+[0-9]{6}Z\s+//s;
|
|
&log($DEBUG, "setting default for [$addr] to '$last_metar{$addr}'");
|
|
$metar =~ s/\015?\012/\015\012/g;
|
|
} else {
|
|
&log($INFO, "found, but too old (" . int($age / 60) . " min)");
|
|
undef $metar;
|
|
}
|
|
} else {
|
|
&log($WARN, "not found!");
|
|
}
|
|
|
|
if (!defined $metar) {
|
|
&log($INFO, "sending last successful data again");
|
|
$metar = sprintf "%04d/%02d/%02d %02d:%02d\015\012",
|
|
$year, $mon, $day, $hour, $min;
|
|
$metar .= sprintf "$icao %02d%02d%02dZ ", $day, $hour, $min;
|
|
$metar .= $last_metar{$addr} || $METAR_DEFAULT;
|
|
}
|
|
|
|
print $client "HTTP/1.0 200 OK\015\012";
|
|
print $client "Content-Type: text/plain\015\012"
|
|
. "X-MetarProxy: nasse Maus\015\012"
|
|
. "\015\012"
|
|
. "$metar\015\012";
|
|
&log($INFO, $metar);
|
|
} else {
|
|
&log($WARN, "incomplete request");
|
|
}
|
|
&log($BULK, "closing connection");
|
|
close $client;
|
|
}
|
|
}
|
|
|
|
|
|
sub get_metar($$)
|
|
{
|
|
my $icao = shift;
|
|
my $rq_epoch = shift;
|
|
$icao =~ /^([A-Z])([A-Z0-9])([A-Z0-9]{2})$/;
|
|
|
|
sub scan_file($$) {
|
|
my $time = shift;
|
|
my $list = shift;
|
|
my ($hour, $day, $mon, $year) = (gmtime($time))[2 .. 5];
|
|
my $name = sprintf "$BASE/%04d-%02d-%02d/$1/$1$2/$1$2$3", $year + 1900, $mon + 1, $day;
|
|
if (open (F, "<$name")) {
|
|
&log($BULK, "reading $name");
|
|
local $/ = "";
|
|
push @$list, <F>;
|
|
close F or &log($ERR, "cannot close file $name ($!)");
|
|
} else {
|
|
&log($BULK, "no file $name to read ($!)");
|
|
}
|
|
return $hour < 2;
|
|
}
|
|
my @list; # "today" (and maybe "yesterday")
|
|
&scan_file($rq_epoch, \@list) and &scan_file($rq_epoch - 24 * 60 * 60, \@list);
|
|
|
|
my $age = 99999999;
|
|
my ($epoch, $metar);
|
|
foreach (@list) {
|
|
/^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012$icao\s/s or next;
|
|
$epoch = timegm(0, $5, $4, $3, $2 - 1, $1 - 1900);
|
|
next if $epoch > $rq_epoch; # lies in the future
|
|
next if $rq_epoch - $epoch > $age; # older than previous entry
|
|
$metar = $_;
|
|
$age = $rq_epoch - $epoch;
|
|
}
|
|
return ($metar, $age);
|
|
}
|
|
|
|
|
|
# ==================================================================
|
|
|
|
|
|
sub fatal()
|
|
{
|
|
&log($ERR, "$0: @_");
|
|
exit -1;
|
|
}
|
|
|
|
|
|
sub log()
|
|
{
|
|
my $v = shift;
|
|
return if $v > $VERBOSITY;
|
|
$v = 4 if $v > 4;
|
|
print "\033[$COLOR[$v]m" if $USECOLOR;
|
|
print "@_";
|
|
print "\033[m" if $USECOLOR;
|
|
print "\n";
|
|
}
|
|
|
|
|
|
main
|
|
|