utils/metarproxy/metarproxy

   1 #!/usr/bin/perl -w
   2 # FlightGear METAR proxy server
   3 # Melchior FRANZ (c) 2005, <mfranz # aon : at>, GPL V2
   4 # $Id$
   5 #
   6 # typical use
   7 # 1) fill cache, for example with:
   8 #    $ metarproxy --download 3h
   9 #
  10 # 2) run proxy with FlightGear:
  11 #    $ metarproxy -c -v &
  12 #    $ fgfs --enable-real-weather-fetch --proxy=localhost:5509 --start-date-lat=2005:01:11:12:00:00
  13
  14 use strict;
  15 use IO::Socket;
  16 use Net::hostent;
  17 use Time::Local;
  18
  19 my $HOME = $ENV{'HOME'} || ".";
  20 my $FG_HOME = $ENV{'FG_HOME'} || $HOME . "/.fgfs";
  21 my $BASE = $FG_HOME . "/metar";
  22 my $SERVER = "weather.noaa.gov";
  23 my $PORT = 5509;
  24 my $PROXY = $ENV{'http_proxy'};
  25 my $METAR_MAX_AGE = 250 * 60;
  26 my $METAR_DEFAULT = "00000KT 15KM CLR 15/00 A3000";
  27 my @COLOR = ("31;1", "31", "32", "", "36;1");
  28 my $USECOLOR = 0;
  29
  30
  31 my $help = <<EOF;
  32 Usage:
  33        metarproxy [-v] [-b <path>] [-p <port>] [--serve]
  34        metarproxy [-v] [-b <path>] [-y <proxy>] --download <list of: all|7|0-10|6h>
  35        metarproxy [-v] [-b <path>] [-y <proxy>] --record  [<list of station IDs>] [-f <path>]
  36        metarproxy [-v] [-b <path>]              --install  <list of metar files>
  37        metarproxy [-V]
  38        metarproxy [-h]
  39
  40 server mode:
  41        -s|--serve    start proxy server          (default)
  42        -p|--port     set port                    (default: $PORT)
  43
  44 download mode:
  45        -d|--download <list of hours>
  46                      "all"    ... whole day (24 files)
  47                      <number> ... this hour      (example: 6)
  48                      <range>  ... these hours    (example: 2-5)
  49                      <period> ... last n hours   (example: 3h)
  50        -y|--proxy    use proxy                   (default: off)
  51
  52 install mode:
  53        -i|--install  <list of files to install>
  54
  55 record mode:
  56        -r|--record   <list of METAR station IDs (ICAO)>
  57        -f|--file     <file containing list of station IDs>
  58        -y|--proxy    use proxy                   (default: off)
  59
  60 all modes:
  61        -b|--base     set base directory          (default: \$FG_HOME/metar)
  62        -c|--color    toggle color mode           (default: off)
  63        -v|--verbose  increase verbosity level    (default: off; maximum: -vvvv)
  64
  65        -q|--quiet    only show error messages
  66        -h|--help     this help
  67        -V|--version  return version number
  68
  69 Environment:
  70        FG_HOME    ... FlightGear home directory  (default: \$HOME/.fgfs)
  71        METARPROXY ... default options (e.g. export METARPROXY='-vv --color')
  72        http_proxy ... system wide proxy setting  (currently: '$PROXY')
  73
  74 Examples:
  75        \$ metarproxy -b\$HOME/.fgfs/metar --download 3h
  76        \$ metarproxy --proxy=http://localhost:3128 --download all
  77        \$ metarproxy --download 3h 7 21-23
  78        \$ metarproxy --record -f/tmp/list LOWW LOWL
  79        \$ metarproxy -b/var/tmp/metar --install /tmp/*Z.TXT
  80        \$ metarproxy -p5600 & fgfs --proxy=localhost:5600 --enable-real-weather-fetch
  81        \$ http_proxy= metarproxy --record LOXL
  82
  83 Sources:
  84        http://weather.noaa.gov/pub/data/observations/metar/{stations,cycles}/
  85        ftp://weather.noaa.gov/data/observations/metar/{stations,cycles}/
  86 EOF
  87
  88
  89 my $ERR = 0;
  90 my $WARN = 1;
  91 my $INFO = 2;
  92 my $BULK = 3;
  93 my $DEBUG = 4;
  94 my $VERBOSITY = $INFO;
  95
  96 my @ITEMS;
  97 my $PROXYHOST;
  98 my $PROXYPORT;
  99
 100
 101 # main =======================================================================
 102
 103
 104 sub parse_options()
 105 {
 106         sub argument {
 107                 map { return $_ if defined $_ and $_ ne "" } @_;
 108                 shift @ARGV;
 109                 return $ARGV[0];
 110         }
 111         my $mode = 4;
 112         unshift @ARGV, split /\s+/, $ENV{'METARPROXY'} if defined $ENV{'METARPROXY'};
 113         while (1) {
 114                 $_ = $ARGV[0];
 115                 defined $_ or last;
 116                 if (!/^-/) {
 117                         push @ITEMS, $_;
 118                 } elsif (/^(-d|--download)$/) {
 119                         $mode = 1;
 120                 } elsif (/^(-i|--install)$/) {
 121                         $mode = 2;
 122                 } elsif (/^(-r|--record)$/) {
 123                         $mode = 3;
 124                 } elsif (/^(-s|--server?)$/) {
 125                         $mode = 4;
 126                 } elsif (/^(-b(.*)|--base(=(.*))?)/) {
 127                         my $path = &argument($2, $4);
 128                         defined $path or &fatal("-b|--base option lacks <path> argument");
 129                         $path =~ s/^~/$HOME/;
 130                         $BASE = $path;
 131                         &log($BULK, "set option --base: '$BASE'");
 132                 } elsif (/^(-f(.*)|--file(=(.*))?)$/) {
 133                         my $file = &argument($2, $4);
 134                         defined $file or &fatal("-f|--file option lacks <path> argument");
 135                         &log($BULK, "set option --file: '$file'");
 136                         &read_icao_file($file);
 137                 } elsif (/^(-p(.*)|--port(=(.*))?)$/) {
 138                         $PORT = &argument($2, $4);
 139                         defined $PORT or &fatal("--port option lacks <port number> argument");
 140                         &log($BULK, "set option --port: '$PORT'");
 141                 } elsif (/^(-y(.*)|--proxy(=(.*))?)$/) {
 142                         $PROXY = &argument($2, $4);
 143                         defined $PROXY or &fatal("--proxy option lacks <host> definition");
 144                         &log($BULK, "set option --proxy: '$PROXY'");
 145                 } elsif (/^--verbose$/) {
 146                         $VERBOSITY++;
 147                 } elsif (/^-(v+)$/) {
 148                         $VERBOSITY += length($1);
 149                 } elsif (/^(-q|--quiet)$/) {
 150                         $VERBOSITY = 0;
 151                 } elsif (/^(-h|--help)$/) {
 152                         print $help;
 153                         return 0;
 154                 } elsif (/^(-V|--version)$/) {
 155                         ($_ = '$Revision$') =~ s/.*(\d+\.\d+).*/print "$1\n"/e;
 156                         return 0;
 157                 } elsif (/^(-c|--color)$/) {
 158                         $USECOLOR = !$USECOLOR;
 159                 } else {
 160                         &fatal("unknown option $_");
 161                 }
 162                 shift @ARGV;
 163         }
 164         return $mode;
 165 }
 166
 167
 168 sub main()
 169 {
 170         undef $PROXY if $PROXY eq "";
 171         my $mode = &parse_options();
 172         exit if $mode == 0;
 173
 174         -d $FG_HOME or mkdir $FG_HOME or &fatal("cannot create directory $FG_HOME ($!)");
 175         -d $BASE or mkdir $BASE or &fatal("cannot create directory $BASE ($!)");
 176
 177         if (defined $PROXY) {
 178                 $PROXY =~ m|^(http://)?([a-zA-Z][a-zA-Z0-9-.]*):(\d+)/?| or &fatal("invalid proxy address: '$PROXY'");
 179                 ($PROXYHOST, $PROXYPORT) = ($2, $3);
 180         }
 181
 182         my $ret = 0;
 183         if ($mode == 1) {
 184                 $ret = &download;
 185         } elsif ($mode == 2) {
 186                 $ret = &install();
 187         } elsif ($mode == 3) {
 188                 $ret = &record();
 189         } elsif ($mode == 4) {
 190                 &log($ERR, "ignoring command line args: " . (join ", ", @ITEMS)) if @ITEMS;
 191                 $ret = &serve();
 192         }
 193         exit $ret;
 194 }
 195
 196
 197 sub read_icao_file($)
 198 {
 199         my $path = shift;
 200         $path =~ s/^\~/$HOME/;
 201
 202         if (!open(F, "<$path")) {
 203                 &log($ERR, "cannot open station list $path ($!)");
 204                 return;
 205         }
 206         while (<F>) {
 207                 s/\s+$//;
 208                 foreach (split) {
 209                         if (/^[A-Z][A-Z0-9]{3}$/) {
 210                                 push @ITEMS, $_;
 211                         } else {
 212                                 &log($ERR, "discarding suspicious station from $path: $_");
 213                         }
 214                 }
 215         }
 216         close F or &log($ERR, "cannot close station list $path ($!)");
 217 }
 218
 219
 220 # download ===================================================================
 221
 222
 223 sub download()
 224 {
 225         my %h;
 226         sub norm {
 227                 my $i = shift;
 228                 $i = 0 if $i < 0;
 229                 $i = 23 if $i > 23;
 230                 return $i;
 231         }
 232         foreach (@ITEMS) {
 233                 if (/^all$/) {
 234                         map { $h{$_} = 1 } (0 .. 23);
 235                 } elsif (/^(\d+)-(\d+)$/) {
 236                         map { $h{$_} = 1 } (&norm($1) .. &norm($2));
 237                 } elsif (/^(\d+)h$/) {
 238                         my $to = (gmtime(time))[2];
 239                         my $from = $to - &norm($1) + 1;
 240                         if ($from < 0) {
 241                                 map { $h{$_} = 1 } ((24 + $from) .. 23);
 242                                 $from = 0;
 243                         }
 244                         map { $h{$_} = 1 } ($from .. $to);
 245                 } elsif (/^(\d+)$/) {
 246                         $h{&norm($1)} = 1;
 247                 } else {
 248                         &log($ERR, "illegal download argument '$_' ignored");
 249                 }
 250         }
 251         @ITEMS = sort { $a <=> $b } keys %h;
 252         @ITEMS or &fatal("nothing to download");
 253         &log($INFO, "downloading: " . (join ", ", @ITEMS));
 254         foreach (@ITEMS) {
 255                 my $file = sprintf "/pub/data/observations/metar/cycles/%02dZ.TXT", $_;
 256                 &install_metar_http($SERVER, "80", $file);
 257         }
 258         return 0;
 259 }
 260
 261
 262 # install ====================================================================
 263
 264
 265 sub install()
 266 {
 267         foreach my $file (@ITEMS) {
 268                 &log($INFO, "installing $file");
 269                 if (! -f $file) {
 270                         &log($ERR, "file $file doesn't exist");
 271                         next;
 272                 }
 273                 if (!open (IN, "<$file")) {
 274                         &log($ERR, "cannot open $file ($!)");
 275                         next;
 276                 }
 277                 local $/ = "";
 278                 &install_metar($_) foreach <IN>;
 279                 close IN or &log($ERR, "cannot close $file ($!)");
 280         }
 281         return 0;
 282 }
 283
 284
 285 # install a METAR string KSFO under $FG_HOME/metar/2005-01-12/K/KS/KSFO
 286 sub install_metar($)
 287 {
 288         my $metar = shift;
 289         return unless $metar =~ /^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012([A-Z])([A-Z0-9])([A-Z0-9]{2})\s/s;
 290
 291         my $name = sprintf "$BASE/%04d-%02d-%02d", $1, $2, $3;
 292         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 293         $name .= "/$6";
 294         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 295         $name .= "/$6$7";
 296         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 297         $name .= "/$6$7$8";
 298
 299         my $found;
 300         if (open(F, "<$name")) {
 301                 local $/ = "";
 302                 while (<F>) {
 303                         if (m|^$1/$2/$3 $4:$5\s|s) {
 304                                 $found = 1;
 305                                 last;
 306                         }
 307                 }
 308                 close F or &log($ERR, "cannot close file $name ($!)");
 309                 return if defined $found;
 310         }
 311         &log($INFO, "writing to $name");
 312
 313         open(F, ">>$name") or &fatal("cannot append to file $name ($!)");
 314         print F $metar;
 315         close F or &log($ERR, "cannot close file $name ($!)");
 316 }
 317
 318
 319
 320 sub install_metar_http($$$)
 321 {
 322         my ($server, $port, $addr) = @_;
 323         &log($INFO, "installing data from http://$server:$port$addr");
 324         if (defined $PROXYHOST) {
 325                 &log($INFO, "via proxy http://$PROXYHOST:$PROXYPORT");
 326                 $addr = "http://$server" . $addr;
 327                 ($server, $port) = ($PROXYHOST, $PROXYPORT);
 328         }
 329
 330         my $socket = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $server, PeerPort => $port);
 331         $socket or &fatal("cannot connect to http://$server:$port$addr/ ($!)");
 332         $socket->autoflush(1);
 333         my $get = "GET $addr HTTP/1.0";
 334         print $socket "$get\015\012\015\012";
 335         &log($DEBUG, ":$get:");
 336
 337         # skip header
 338         while (<$socket>) {
 339                 s/\s*$//;
 340                 last if /^$/;
 341                 &log($DEBUG, "[$_]");
 342         }
 343         local $/ = "";
 344         foreach (<$socket>) {
 345                 &install_metar("$_\n");
 346         }
 347         close($socket) or &log($ERR, "cannot close INET socket ($!)");
 348         return 0;
 349 }
 350
 351
 352 # record =====================================================================
 353
 354
 355 sub record()
 356 {
 357         @ITEMS or &fatal("no stations given");
 358
 359         my %h;
 360         # check for validity and remove duplicates
 361         foreach (@ITEMS) {
 362                 if (/^[A-Z][A-Z0-9]{3}$/) {
 363                         $h{$_} = 1;
 364                 } else {
 365                         &log($ERR, "discarding invalid station '$_'");
 366                 }
 367         }
 368         @ITEMS = sort keys %h;
 369
 370         &log($INFO, "recording stations @ITEMS");
 371         while (1) {
 372                 foreach (@ITEMS) {
 373                         &install_metar_http($SERVER, "80", "/pub/data/observations/metar/stations/$_.TXT");
 374                 }
 375                 &log($INFO, "sleeping ...");
 376                 sleep 15 * 60
 377         }
 378 }
 379
 380
 381 # serve ======================================================================
 382
 383
 384 sub serve()
 385 {
 386         my $server = IO::Socket::INET->new(Proto => 'tcp', LocalPort => $PORT, Listen => SOMAXCONN, Reuse => 1);
 387         $server or &fatal("cannot setup server ($!)");
 388         &log($BULK, "server $0 accepting clients on port $PORT");
 389         my %last_metar;
 390
 391         while (my $client = $server->accept()) {
 392                 $client->autoflush(1);
 393                 my $hostinfo = gethostbyaddr($client->peeraddr);
 394                 my $clientname = $hostinfo->name || $client->peerhost;
 395                 my $addr = inet_ntoa(inet_aton($clientname));
 396
 397                 my ($icao, $epoch);
 398                 while (<$client>) {
 399                         s/\s+$//;
 400                         &log($DEBUG, $_);
 401
 402                         if (m|^GET\s+http://weather.noaa.gov/.*/([A-Z][A-Z0-9]{3}).TXT\s+HTTP/|) {
 403                                 $icao = $1;
 404                         } elsif (/X-Time: (\d+)/) {
 405                                 $epoch = $1;
 406                         } elsif (/^$/) {
 407                                 last;
 408                         } else {
 409                                 &log($INFO, "$_") if $VERBOSITY < $DEBUG;
 410                         }
 411                 }
 412
 413                 if (defined $icao and defined $epoch) {
 414                         my ($min, $hour, $day, $mon, $year) = (gmtime($epoch))[1 .. 5];
 415                         $year += 1900;
 416                         $mon++;
 417                         &log($BULK, sprintf "client '$clientname' [$addr] requests data for station $icao "
 418                                         . "at %04d/%02d/%02d %02d:%02d", $year, $mon, $day, $hour, $min);
 419
 420                         my ($metar, $age) = &get_metar($icao, $epoch);
 421                         if (defined $metar) {
 422                                 if ($age <= $METAR_MAX_AGE) {
 423                                         &log($BULK, "found (" . int($age / 60) . " min old)");
 424                                         $metar =~ s/\s*$//s;
 425                                         $last_metar{$addr} = $metar;
 426                                         $last_metar{$addr} =~ s/.*\015?\012[A-Z0-9]{4}\s+[0-9]{6}Z\s+//s;
 427                                         &log($DEBUG, "setting default for [$addr] to '$last_metar{$addr}'");
 428                                         $metar =~ s/\015?\012/\015\012/g;
 429                                 } else {
 430                                         &log($INFO, "found, but too old (" . int($age / 60) . " min)");
 431                                         undef $metar;
 432                                 }
 433                         } else {
 434                                 &log($WARN, "not found!");
 435                         }
 436
 437                         if (!defined $metar) {
 438                                 &log($INFO, "sending last successful data again");
 439                                 $metar = sprintf "%04d/%02d/%02d %02d:%02d\015\012",
 440                                                 $year, $mon, $day, $hour, $min;
 441                                 $metar .= sprintf "$icao %02d%02d%02dZ ", $day, $hour, $min;
 442                                 $metar .= $last_metar{$addr} || $METAR_DEFAULT;
 443                         }
 444
 445                         print $client "HTTP/1.0 200 OK\015\012";
 446                         print $client "Content-Type: text/plain\015\012"
 447                                         . "X-MetarProxy: nasse Maus\015\012"
 448                                         . "\015\012"
 449                                         . "$metar\015\012";
 450                         &log($INFO, $metar);
 451                 } else {
 452                         &log($WARN, "incomplete request");
 453                 }
 454                 &log($BULK, "closing connection");
 455                 close $client;
 456         }
 457 }
 458
 459
 460 sub get_metar($$)
 461 {
 462         my $icao = shift;
 463         my $rq_epoch = shift;
 464         $icao =~ /^([A-Z])([A-Z0-9])([A-Z0-9]{2})$/;
 465
 466         sub scan_file($$) {
 467                 my $time = shift;
 468                 my $list = shift;
 469                 my ($hour, $day, $mon, $year) = (gmtime($time))[2 .. 5];
 470                 my $name = sprintf "$BASE/%04d-%02d-%02d/$1/$1$2/$1$2$3", $year + 1900, $mon + 1, $day;
 471                 if (open (F, "<$name")) {
 472                         &log($BULK, "reading $name");
 473                         local $/ = "";
 474                         push @$list, <F>;
 475                         close F or &log($ERR, "cannot close file $name ($!)");
 476                 } else {
 477                         &log($BULK, "no file $name to read ($!)");
 478                 }
 479                 return $hour < 2;
 480         }
 481         my @list;       # "today" (and maybe "yesterday")
 482         &scan_file($rq_epoch, \@list) and &scan_file($rq_epoch - 24 * 60 * 60, \@list);
 483
 484         my $age = 99999999;
 485         my ($epoch, $metar);
 486         foreach (@list) {
 487                 /^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012$icao\s/s or next;
 488                 $epoch = timegm(0, $5, $4, $3, $2 - 1, $1 - 1900);
 489                 next if $epoch > $rq_epoch;             # lies in the future
 490                 next if $rq_epoch - $epoch > $age;      # older than previous entry
 491                 $metar = $_;
 492                 $age = $rq_epoch - $epoch;
 493         }
 494         return ($metar, $age);
 495 }
 496
 497
 498 # ==================================================================
 499
 500
 501 sub fatal()
 502 {
 503         &log($ERR, "$0: @_");
 504         exit -1;
 505 }
 506
 507
 508 sub log()
 509 {
 510         my $v = shift;
 511         return if $v > $VERBOSITY;
 512         $v = 4 if $v > 4;
 513         print "\033[$COLOR[$v]m" if $USECOLOR;
 514         print "@_";
 515         print "\033[m" if $USECOLOR;
 516         print "\n";
 517 }
 518
 519
 520 main
 521