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 / /, $ENV{'METARPROXY'} if defined $ENV{'METARPROXY'};
 113         while (1) {
 114                 $_ = $ARGV[0];
 115                 defined $_ or last;
 116                 # dissolve glued together short options (e.g. -cvv)
 117                 if (/^-([^-]{2,})$/) {
 118                         shift @ARGV;
 119                         map { unshift @ARGV, "-$_" } split //, $1;
 120                         next;
 121                 }
 122                 if (!/^-/) {
 123                         push @ITEMS, $_;
 124                 } elsif (/^(-d|--download)$/) {
 125                         $mode = 1;
 126                 } elsif (/^(-i|--install)$/) {
 127                         $mode = 2;
 128                 } elsif (/^(-r|--record)$/) {
 129                         $mode = 3;
 130                 } elsif (/^(-s|--server?)$/) {
 131                         $mode = 4;
 132                 } elsif (/^(-b(.*)|--base(=(.*))?)/) {
 133                         my $path = &argument($2, $4);
 134                         defined $path or &fatal("-b|--base option lacks <path> argument");
 135                         $path =~ s/^~/$HOME/;
 136                         $BASE = $path;
 137                         &log($BULK, "set option --base: '$BASE'");
 138                 } elsif (/^(-f(.*)|--file(=(.*))?)$/) {
 139                         my $file = &argument($2, $4);
 140                         defined $file or &fatal("-f|--file option lacks <path> argument");
 141                         &log($BULK, "set option --file: '$file'");
 142                         &read_icao_file($file);
 143                 } elsif (/^(-p(.*)|--port(=(.*))?)$/) {
 144                         $PORT = &argument($2, $4);
 145                         defined $PORT or &fatal("--port option lacks <port number> argument");
 146                         &log($BULK, "set option --port: '$PORT'");
 147                 } elsif (/^(-y(.*)|--proxy(=(.*))?)$/) {
 148                         $PROXY = &argument($2, $4);
 149                         defined $PROXY or &fatal("--proxy option lacks <host> definition");
 150                         &log($BULK, "set option --proxy: '$PROXY'");
 151                 } elsif (/^(-v|--verbose)$/) {
 152                         $VERBOSITY++;
 153                 } elsif (/^(-q|--quiet)$/) {
 154                         $VERBOSITY = 0;
 155                 } elsif (/^(-h|--help)$/) {
 156                         print $help;
 157                         return 0;
 158                 } elsif (/^(-V|--version)$/) {
 159                         ($_ = '$Revision$') =~ s/.*(\d+\.\d+).*/print "$1\n"/e;
 160                         return 0;
 161                 } elsif (/^(-c|--color)$/) {
 162                         $USECOLOR = !$USECOLOR;
 163                 } else {
 164                         &fatal("unknown option $_");
 165                 }
 166                 shift @ARGV;
 167         }
 168         return $mode;
 169 }
 170
 171
 172 sub main()
 173 {
 174         undef $PROXY if $PROXY eq "";
 175         my $mode = &parse_options();
 176         exit if $mode == 0;
 177
 178         -d $FG_HOME or mkdir $FG_HOME or &fatal("cannot create directory $FG_HOME ($!)");
 179         -d $BASE or mkdir $BASE or &fatal("cannot create directory $BASE ($!)");
 180
 181         if (defined $PROXY) {
 182                 $PROXY =~ m|^(http://)?([a-zA-Z][a-zA-Z0-9-.]*):(\d+)/?| or &fatal("invalid proxy address: '$PROXY'");
 183                 ($PROXYHOST, $PROXYPORT) = ($2, $3);
 184         }
 185
 186         my $ret = 0;
 187         if ($mode == 1) {
 188                 $ret = &download;
 189         } elsif ($mode == 2) {
 190                 $ret = &install();
 191         } elsif ($mode == 3) {
 192                 $ret = &record();
 193         } elsif ($mode == 4) {
 194                 &log($ERR, "ignoring command line args: " . (join ", ", @ITEMS)) if @ITEMS;
 195                 $ret = &serve();
 196         }
 197         exit $ret;
 198 }
 199
 200
 201 sub read_icao_file($)
 202 {
 203         my $path = shift;
 204         $path =~ s/^\~/$HOME/;
 205
 206         if (!open(F, "<$path")) {
 207                 &log($ERR, "cannot open station list $path ($!)");
 208                 return;
 209         }
 210         while (<F>) {
 211                 s/\s+$//;
 212                 foreach (split) {
 213                         if (/^[A-Z][A-Z0-9]{3}$/) {
 214                                 push @ITEMS, $_;
 215                         } else {
 216                                 &log($ERR, "discarding suspicious station from $path: $_");
 217                         }
 218                 }
 219         }
 220         close F or &log($ERR, "cannot close station list $path ($!)");
 221 }
 222
 223
 224 # download ===================================================================
 225
 226
 227 sub download()
 228 {
 229         my %h;
 230         sub norm {
 231                 my $i = shift;
 232                 $i = 0 if $i < 0;
 233                 $i = 23 if $i > 23;
 234                 return $i;
 235         }
 236         foreach (@ITEMS) {
 237                 if (/^all$/) {
 238                         map { $h{$_} = 1 } (0 .. 23);
 239                 } elsif (/^(\d+)-(\d+)$/) {
 240                         map { $h{$_} = 1 } (&norm($1) .. &norm($2));
 241                 } elsif (/^(\d+)h$/) {
 242                         my $to = (gmtime(time))[2];
 243                         my $from = $to - &norm($1) + 1;
 244                         if ($from < 0) {
 245                                 map { $h{$_} = 1 } ((24 + $from) .. 23);
 246                                 $from = 0;
 247                         }
 248                         map { $h{$_} = 1 } ($from .. $to);
 249                 } elsif (/^(\d+)$/) {
 250                         $h{&norm($1)} = 1;
 251                 } else {
 252                         &log($ERR, "illegal download argument '$_' ignored");
 253                 }
 254         }
 255         @ITEMS = sort { $a <=> $b } keys %h;
 256         @ITEMS or &fatal("nothing to download");
 257         &log($INFO, "downloading: " . (join ", ", @ITEMS));
 258         foreach (@ITEMS) {
 259                 my $file = sprintf "/pub/data/observations/metar/cycles/%02dZ.TXT", $_;
 260                 &install_metar_http($SERVER, "80", $file);
 261         }
 262         return 0;
 263 }
 264
 265
 266 # install ====================================================================
 267
 268
 269 sub install()
 270 {
 271         foreach my $file (@ITEMS) {
 272                 &log($INFO, "installing $file");
 273                 if (! -f $file) {
 274                         &log($ERR, "file $file doesn't exist");
 275                         next;
 276                 }
 277                 if (!open (IN, "<$file")) {
 278                         &log($ERR, "cannot open $file ($!)");
 279                         next;
 280                 }
 281                 local $/ = "";
 282                 &install_metar($_) foreach <IN>;
 283                 close IN or &log($ERR, "cannot close $file ($!)");
 284         }
 285         return 0;
 286 }
 287
 288
 289 # install a METAR string KSFO under $FG_HOME/metar/2005-01-12/K/KS/KSFO
 290 sub install_metar($)
 291 {
 292         my $metar = shift;
 293         return unless $metar =~ /^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012([A-Z])([A-Z0-9])([A-Z0-9]{2})\s/s;
 294
 295         my $name = sprintf "$BASE/%04d-%02d-%02d", $1, $2, $3;
 296         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 297         $name .= "/$6";
 298         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 299         $name .= "/$6$7";
 300         -d $name or mkdir $name or &fatal("cannot create directory $name ($!)");
 301         $name .= "/$6$7$8";
 302
 303         my $found;
 304         if (open(F, "<$name")) {
 305                 local $/ = "";
 306                 while (<F>) {
 307                         if (m|^$1/$2/$3 $4:$5\s|s) {
 308                                 $found = 1;
 309                                 last;
 310                         }
 311                 }
 312                 close F or &log($ERR, "cannot close file $name ($!)");
 313                 return if defined $found;
 314         }
 315         &log($INFO, "writing to $name");
 316
 317         open(F, ">>$name") or &fatal("cannot append to file $name ($!)");
 318         print F $metar;
 319         close F or &log($ERR, "cannot close file $name ($!)");
 320 }
 321
 322
 323
 324 sub install_metar_http($$$)
 325 {
 326         my ($server, $port, $addr) = @_;
 327         &log($INFO, "installing data from http://$server:$port$addr");
 328         if (defined $PROXYHOST) {
 329                 &log($INFO, "via proxy http://$PROXYHOST:$PROXYPORT");
 330                 $addr = "http://$server" . $addr;
 331                 ($server, $port) = ($PROXYHOST, $PROXYPORT);
 332         }
 333
 334         my $socket = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $server, PeerPort => $port);
 335         $socket or &fatal("cannot connect to http://$server:$port$addr/ ($!)");
 336         $socket->autoflush(1);
 337         my $get = "GET $addr HTTP/1.0";
 338         print $socket "$get\015\012\015\012";
 339         &log($DEBUG, ":$get:");
 340
 341         # skip header
 342         while (<$socket>) {
 343                 s/\s*$//;
 344                 last if /^$/;
 345                 &log($DEBUG, "[$_]");
 346         }
 347         local $/ = "";
 348         foreach (<$socket>) {
 349                 &install_metar("$_\n");
 350         }
 351         close($socket) or &log($ERR, "cannot close INET socket ($!)");
 352         return 0;
 353 }
 354
 355
 356 # record =====================================================================
 357
 358
 359 sub record()
 360 {
 361         @ITEMS or &fatal("no stations given");
 362
 363         my %h;
 364         # check for validity and remove duplicates
 365         foreach (@ITEMS) {
 366                 if (/^[A-Z][A-Z0-9]{3}$/) {
 367                         $h{$_} = 1;
 368                 } else {
 369                         &log($ERR, "discarding invalid station '$_'");
 370                 }
 371         }
 372         @ITEMS = sort keys %h;
 373
 374         &log($INFO, "recording stations @ITEMS");
 375         while (1) {
 376                 foreach (@ITEMS) {
 377                         &install_metar_http($SERVER, "80", "/pub/data/observations/metar/stations/$_.TXT");
 378                 }
 379                 &log($INFO, "sleeping ...");
 380                 sleep 15 * 60
 381         }
 382 }
 383
 384
 385 # serve ======================================================================
 386
 387
 388 sub serve()
 389 {
 390         my $server = IO::Socket::INET->new(Proto => 'tcp', LocalPort => $PORT, Listen => SOMAXCONN, Reuse => 1);
 391         $server or &fatal("cannot setup server ($!)");
 392         &log($BULK, "server $0 accepting clients on port $PORT");
 393
 394         while (my $client = $server->accept()) {
 395                 $client->autoflush(1);
 396                 my $hostinfo = gethostbyaddr($client->peeraddr);
 397                 my $clientname = $hostinfo->name || $client->peerhost;
 398                 my $addr = inet_ntoa(inet_aton($clientname));
 399
 400                 my ($icao, $epoch);
 401                 while (<$client>) {
 402                         s/\s+$//;
 403                         &log($DEBUG, $_);
 404
 405                         if (m|^GET\s+http://weather.noaa.gov/.*/([A-Z][A-Z0-9]{3}).TXT\s+HTTP/|) {
 406                                 $icao = $1;
 407                         } elsif (/X-Time: (\d+)/) {
 408                                 $epoch = $1;
 409                         } elsif (/^$/) {
 410                                 last;
 411                         } else {
 412                                 &log($INFO, "$_") if $VERBOSITY < $DEBUG;
 413                         }
 414                 }
 415
 416                 if (defined $icao and defined $epoch) {
 417                         my ($min, $hour, $day, $mon, $year) = (gmtime($epoch))[1 .. 5];
 418                         $year += 1900;
 419                         $mon++;
 420                         &log($BULK, sprintf "client '$clientname' [$addr] requests data for station $icao "
 421                                         . "at %04d/%02d/%02d %02d:%02d", $year, $mon, $day, $hour, $min);
 422
 423                         my ($metar, $age) = &get_metar($icao, $epoch);
 424                         if (defined $metar) {
 425                                 if ($age <= $METAR_MAX_AGE) {
 426                                         &log($BULK, "found (" . int($age / 60) . " min old)");
 427                                         $metar =~ s/\s*$//s;
 428                                         $METAR_DEFAULT = $metar;
 429                                         $METAR_DEFAULT =~ s/.*\015?\012[A-Z0-9]{4}\s+[0-9]{6}Z\s+//s;
 430                                         &log($DEBUG, "setting default to '$METAR_DEFAULT'");
 431                                         $metar =~ s/\015?\012/\015\012/g;
 432                                 } else {
 433                                         &log($INFO, "found, but too old (" . int($age / 60) . " min)");
 434                                         undef $metar;
 435                                 }
 436                         } else {
 437                                 &log($WARN, "not found!");
 438                         }
 439
 440                         if (!defined $metar) {
 441                                 &log($INFO, "sending last successful data again");
 442                                 $metar = sprintf "%04d/%02d/%02d %02d:%02d\015\012",
 443                                                 $year, $mon, $day, $hour, $min;
 444                                 $metar .= sprintf "$icao %02d%02d%02dZ $METAR_DEFAULT",
 445                                                 $day, $hour, $min;
 446                         }
 447                         print $client "Content-Type: text/plain\015\012"
 448                                         . "X-MetarProxy: nasse Maus\015\012"
 449                                         . "\015\012"
 450                                         . "$metar\015\012";
 451                         &log($INFO, $metar);
 452                 } else {
 453                         &log($WARN, "incomplete request");
 454                 }
 455                 &log($BULK, "closing connection");
 456                 close $client;
 457         }
 458 }
 459
 460
 461 sub get_metar($$)
 462 {
 463         my $icao = shift;
 464         my $rq_epoch = shift;
 465         $icao =~ /^([A-Z])([A-Z0-9])([A-Z0-9]{2})$/;
 466
 467         sub scan_file($$) {
 468                 my $time = shift;
 469                 my $list = shift;
 470                 my ($hour, $day, $mon, $year) = (gmtime($time))[2 .. 5];
 471                 my $name = sprintf "$BASE/%04d-%02d-%02d/$1/$1$2/$1$2$3", $year + 1900, $mon + 1, $day;
 472                 if (open (F, "<$name")) {
 473                         &log($BULK, "reading $name");
 474                         local $/ = "";
 475                         push @$list, <F>;
 476                         close F or &log($ERR, "cannot close file $name ($!)");
 477                 } else {
 478                         &log($BULK, "no file $name to read ($!)");
 479                 }
 480                 return $hour < 2;
 481         }
 482         my @list;       # "today" (and maybe "yesterday")
 483         &scan_file($rq_epoch, \@list) and &scan_file($rq_epoch - 24 * 60 * 60, \@list);
 484
 485         my $age = 99999999;
 486         my ($epoch, $metar);
 487         foreach (@list) {
 488                 /^(\d{4})\/(\d+)\/(\d+)\s(\d+):(\d+).*\015?\012$icao\s/s or next;
 489                 $epoch = timegm(0, $5, $4, $3, $2 - 1, $1 - 1900);
 490                 next if $epoch > $rq_epoch;             # lies in the future
 491                 next if $rq_epoch - $epoch > $age;      # older than previous entry
 492                 $metar = $_;
 493                 $age = $rq_epoch - $epoch;
 494         }
 495         return ($metar, $age);
 496 }
 497
 498
 499 # ==================================================================
 500
 501
 502 sub fatal()
 503 {
 504         &log($ERR, "$0: @_");
 505         exit -1;
 506 }
 507
 508
 509 sub log()
 510 {
 511         my $v = shift;
 512         return if $v > $VERBOSITY;
 513         $v = 4 if $v > 4;
 514         print "\033[$COLOR[$v]m" if $USECOLOR;
 515         print "@_";
 516         print "\033[m" if $USECOLOR;
 517         print "\n";
 518 }
 519
 520
 521 main
 522