mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
add get/keps command to load AMSAT keps
Fix AsyncMsg to handle basic 302 redirects.
This commit is contained in:
Dirk Koopman
parent
b099b4a232
commit
564b5b3a0c
3
Changes
3
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,
|
||||
|
||||
@ -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:-
|
||||
|
||||
|
||||
129
cmd/get/keps.pl
129
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;
|
||||
|
||||
@ -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+$/;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user