From 564b5b3a0c2fa40f00e015f8b05f3a87ea4e7e26 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 11 Sep 2013 16:17:30 +0100 Subject: [PATCH] add get/keps command to load AMSAT keps Fix AsyncMsg to handle basic 302 redirects. --- Changes | 3 + cmd/Commands_en.hlp | 15 +++++ cmd/get/keps.pl | 129 +++++++++++++++++++++++++++++++++++++++--- cmd/show/satellite.pl | 6 +- perl/AsyncMsg.pm | 31 ++++++++-- perl/Version.pm | 4 +- 6 files changed, 170 insertions(+), 18 deletions(-) diff --git a/Changes b/Changes index 94df286a..5353c615 100644 --- 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, diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 85143b49..840ee0e2 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -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:- diff --git a/cmd/get/keps.pl b/cmd/get/keps.pl index 54e38609..36e07568 100644 --- a/cmd/get/keps.pl +++ b/cmd/get/keps.pl @@ -1,22 +1,134 @@ # -# 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; diff --git a/cmd/show/satellite.pl b/cmd/show/satellite.pl index 35bc7b88..bede7a89 100644 --- a/cmd/show/satellite.pl +++ b/cmd/show/satellite.pl @@ -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+$/; diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm index 0456efc9..f7b2bc0d 100644 --- a/perl/AsyncMsg.pm +++ b/perl/AsyncMsg.pm @@ -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; diff --git a/perl/Version.pm b/perl/Version.pm index 5740ddeb..6efa7834 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -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; -- 2.43.0