]> dxcluster.org Git - spider.git/commitdiff
add get/keps command to load AMSAT keps
authorDirk Koopman <djk@tobit.co.uk>
Wed, 11 Sep 2013 15:17:30 +0000 (16:17 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Wed, 11 Sep 2013 15:17:30 +0000 (16:17 +0100)
Fix AsyncMsg to handle basic 302 redirects.

Changes
cmd/Commands_en.hlp
cmd/get/keps.pl
cmd/show/satellite.pl
perl/AsyncMsg.pm
perl/Version.pm

diff --git a/Changes b/Changes
index 94df286a175fa230e8284e2d5cab06d59bbca6de..5353c615fd4ea8b5c8739ca1c5a1dae089c8119b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,7 @@
 10Sep13=======================================================================
+1. Add the get/keps command, which allows a sysop to get the latest AMSAT
+   keplarian elements either on demand or periodically in the crontab.
+10Sep13=======================================================================
 1. Fix sh/time such that no arguments print details for the caller.
 09Sep13=======================================================================
 1. Make all the Net::Telnet based commands (sh/425, sh/contest, sh/db0sdx,
index 85143b493e3ce64a516f89b1f0a550b5528808d4..840ee0e21bb49d25a6fc30209e028beaef5d80a5 100644 (file)
@@ -877,6 +877,21 @@ This command sends out any information held in the user file which can
 be broadcast in PC41 protocol packets. This information is Name, QTH, Location
 and Homenode. PC41s are only sent for the information that is available.
  
+=== 8^GET/KEPS^Obtain the latest AMSAT Keplarian Elements from the web
+There are various ways that one can obtain the AMSAT keps. Traditionally the
+regular method was to get on the mailing list and then arrange for the email
+to be piped into convkeps.pl and arrange from the crontab to run LOAD/KEPS. 
+For various reasons, it was quite easy for one to be silently dropped 
+from this mailing list. 
+
+With the advent of asynchronous (web) connections in DXSpider it is now 
+possible to use this command to get the latest keps direct from the
+AMSAT web site. One can do this from the command line or one can add a line 
+in the local DXSpider crontab file to do periodically (say once a week).
+
+This command will clear out the existing keps and then run LOAD/KEPS 
+for you (but only) after a successful download from the AMSAT website.
 === 0^HELP^The HELP Command
 HELP is available for a number of commands. The syntax is:-
 
index 54e386090534670d588fe06ea20e649525182706..36e075685af70dd06334317c18f324decd703a4d 100644 (file)
 #
-# Query the DB0SDX QSL server for a callsign
+# Obtain the latest keps from the Amsat site and
+# load them. 
 #
-# Copyright (c) 2003 Dirk Koopman G1TLH
-# Modified Dec 9, 2004 for new website and xml schema by David Spoelstra N9KT
-# and tidied up by me (Dirk)
+# This will clear out the old keps and rewrite the $root/local/Keps.pm 
+# file to retain the data.
 #
+# The main state machine code comes more or less straight out of convkeps.pl
+# This command is really to avoid the (even more) messy business of parsing emails
 #
+# Copyright (c) 2013 Dirk Koopman, G1TLH
 #
 
+# convert (+/-)00000-0 to (+/-).00000e-0
+sub genenum
+{
+       my ($sign, $frac, $esign, $exp) = unpack "aa5aa", shift;
+       $esign = '+' if $esign eq ' ';
+       my $n = $sign . "." . $frac . 'e' . $esign . $exp;
+       return $n - 0;
+}
+
 sub on_disc
 {
        my $conn = shift;
        my $dxchan = shift;
-       my @out;
        
-       dbg("keps in: $conn->{kepsin}") if isdbg('keps');
+       if ($conn->{kepsin}) {
+               my $fn = "$main::root/local/Keps.pm";
+               my %keps;
+               
+               my @lines = split /[\r\n]+/, $conn->{kepsin};
+               my $state = 1;
+               my $line = 0;
+               my $ref;
+               my $count = 0;
+               my $name;
+               my %lookup = (
+                                         'AO-5' => 'AO-05',
+                                         'AO-6' => 'AO-06',
+                                         'AO-7' => 'AO-07',
+                                         'AO-8' => 'AO-08',
+                                         'AO-9' => 'AO-09',
+                                        );
+               for (@lines) {
+                       
+                       last if m{^-};
 
-       $dxchan->send("get/keps: new keps loaded");
+                       s/^\s+//;
+                       s/[\s\r]+$//;
+                       next unless $_;
+                       last if m{^/EX}i;
+                       
+                       dbg("keps: $state $_") if isdbg('keps');
+                       
+                       if ($state == 0 && /^Decode/i) {
+                               $state = 1;
+                       } elsif ($state == 1) {
+                               last if m{^-};
+                               next if m{^To\s+all}i;
+                               
+                               if (/^([- \w]+)(?:\s+\[[-+\w]\])?$/) {
+                                       my $n = uc $1;
+                                       dbg("keps: $state processing $n") if isdbg('keps');
+                                       $n =~ s/\s/-/g;
+                                       $name = $lookup{$n};
+                                       $name ||= $n;
+                                       $ref = $keps{$name} = {}; 
+                                       $state = 2;
+                               }
+                       } elsif ($state == 2) {
+                               if (/^1 /) {
+                                       my ($id, $number, $epoch, $decay, $mm2, $bstar, $elset) = unpack "xxa5xxa5xxxa15xa10xa8xa8xxxa4x", $_;
+                                       dbg("keps: $state processing line 1 for $name") if isdbg('keps');
+                                       $ref->{id} = $id - 0;
+                                       $ref->{number} = $number - 0;
+                                       $ref->{epoch} = $epoch - 0;
+                                       $ref->{mm1} = $decay - 0;
+                                       $ref->{mm2} = genenum($mm2);
+                                       $ref->{bstar} = genenum($bstar);
+                                       $ref->{elset} = $elset - 0;
+                                       #print "$id $number $epoch $decay $mm2 $bstar $elset\n"; 
+                                       #print "mm2: $ref->{mm2} bstar: $ref->{bstar}\n";
+                                       
+                                       $state = 3;
+                               } else {
+                                       #print "out of order on line $line\n";
+                                       dbg("keps: $state invalid or out of order line 1 for $name") if isdbg('keps');
+                                       undef $ref;
+                                       delete $keps{$name} if defined $name;
+                                       $state = 1;
+                               }
+                       } elsif ($state == 3) {
+                               if (/^2 /) {
+                                       my ($id, $incl, $raan, $ecc, $peri, $man, $mmo, $orbit) = unpack "xxa5xa8xa8xa7xa8xa8xa11a5x", $_;
+                                       dbg("keps: $state processing line 2 for $name") if isdbg('keps');
+                                       $ref->{meananomaly} = $man - 0;
+                                       $ref->{meanmotion} = $mmo - 0;
+                                       $ref->{inclination} = $incl - 0;
+                                       $ref->{eccentricity} = ".$ecc" - 0;
+                                       $ref->{argperigee} = $peri - 0;
+                                       $ref->{raan} = $raan - 0;
+                                       $ref->{orbit} = $orbit - 0;
+                                       $count++;
+                               } else {
+                                       #print "out of order on line $line\n";
+                                       dbg("keps: $state invalid or out of order line 2 for $name") if isdbg('keps');
+                                       delete $keps{$name};
+                               }
+                               undef $ref;
+                               $state = 1;
+                       }
+               }
+               if ($count) {
+                       dbg("keps: $count recs, creating $fn") if isdbg('keps');
+                       my $dd = new Data::Dumper([\%keps], [qw(*keps)]);
+                       $dd->Indent(1);
+                       $dd->Quotekeys(0);
+                       open(OUT, ">$fn") or die "$fn $!";
+                       print OUT "#\n# this file is automatically produced by the get/keps command\n#\n";
+                       print OUT "# Last update: ", scalar gmtime, "\n#\n";
+                       print OUT "\npackage Sun;\n\n";
+                       print OUT $dd->Dumpxs;
+                       print OUT "1;\n";
+                       close(OUT);
+                       dbg("keps: running load/keps") if isdbg('keps');
+                       dbg("keps: clearing out old keps") if isdbg('keps');
+                       %Sun::keps = ();
+                       $dxchan->send($dxchan->run_cmd("load/keps"));
+               }
+       }
 }
 
 sub process
@@ -26,7 +138,7 @@ sub process
 
        $conn->{kepsin} .= "$msg\n";
        
-       dbg("keps in: $conn->{kepsin}") if isdbg('keps');
+#      dbg("keps in: $msg") if isdbg('keps');
 }
 
 sub handle
@@ -37,6 +149,7 @@ sub handle
 
        $line = uc $line;
        return (1, $self->msg('e24')) unless $Internet::allow;
+       return (1, $self->msg('e5')) if $self->priv < 8;
        my $target = $Internet::keps_url || 'www.amsat.org';
        my $path = $Internet::keps_path || '/amsat/ftp/keps/current/nasa.all';
        my $port = 80;
index 35bc7b88ba4a80f0eff0f1ae95dd181185680307..bede7a89dfd75859adfdf386f385332251f49e32 100644 (file)
@@ -16,9 +16,9 @@ my ($self, $line) = @_;
 my @out;
 
 my @f = split /\s+/, $line;
-my $satname = uc shift @f;
-my $numhours = shift @f;       # the number of hours ahead to print
-my $step = shift @f;           # tracking table resolution in minutes
+my $satname = uc shift @f if @f;
+my $numhours = shift @f if @f; # the number of hours ahead to print
+my $step = shift @f if @f;             # tracking table resolution in minutes
 
 # default hours and step size
 $numhours = 3 unless $numhours && $numhours =~ /^\d+$/;
index 0456efc98906d2184ff2063d2bcee276075e6d06..f7b2bc0ddf1102520da25559887bd38456cda20a 100644 (file)
@@ -52,15 +52,35 @@ sub handle_get
                if ($code == 200) {
                        # success
                        $conn->{state} = 'waitblank';
+               } elsif ($code == 302) {
+                       # redirect
+                       $conn->{state} = 'waitlocation';
                } else {
                        $dxchan->send("$code $ascii");
                        $conn->disconnect;
                } 
+       } elsif ($state  eq 'waitlocation') {
+               my ($path) = $msg =~ m|Location:\s*(.*)|;
+               if ($path) {
+                       my @uri = split m|/+|, $path;
+                       if ($uri[0] eq 'http:') {
+                               shift @uri;
+                               my $host = shift @uri;
+                               my $newpath = '/' . join('/', @uri);
+                               $newpath .= '/' if $path =~ m|/$|;
+                               _getpost(ref $conn, $conn->{asyncsort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{asyncargs}});
+                       } elsif ($path =~ m|^/|) {
+                               _getpost(ref $conn, $conn->{asyncsort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path,
+                                                @{$conn->{asyncargs}});
+                       }
+                       delete $conn->{on_disconnect};
+                       $conn->disconnect;
+               }
        } elsif ($state eq 'waitblank') {
                unless ($msg) {
                        $conn->{state} = 'indata';
                }
-       } else {
+       } elsif ($conn->{state} eq 'indata') {
                if (my $filter = $conn->{filter}) {
                        no strict 'refs';
                        # this will crash if the command has been redefined and the filter is a
@@ -142,14 +162,15 @@ sub _getpost
        my $path = shift;
        my %args = @_;
        
-       my $filter = shift;
-       
+
        my $conn = $pkg->new($call, \&handle_get);
+       $conn->{asyncargs} = [@_];
        $conn->{state} = 'waitreply';
        $conn->{filter} = delete $args{filter} if exists $args{filter};
        $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
        $conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect};
        $conn->{path} = $path;
+       $conn->{asyncsort} = $sort;
        
        $r = $conn->connect($host, $port);
        if ($r) {
@@ -219,9 +240,9 @@ sub connect
        # start a connection
        my $r = $conn->SUPER::connect($host, $port);
        if ($r) {
-               dbg("HTTPMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
+               dbg("AsyncMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
        } else {
-               dbg("HTTPMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
+               dbg("AsyncMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
        }
        
        return $r;
index 5740ddeb62fea0331e97c4a4dcecfe81bf15fb25..6efa783437555470c8758c29de918fa6a649d93e 100644 (file)
@@ -11,7 +11,7 @@ use vars qw($version $subversion $build $gitversion);
 
 $version = '1.55';
 $subversion = '0';
-$build = '133';
-$gitversion = 'e941823';
+$build = '134';
+$gitversion = 'b099b4a';
 
 1;