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:-
#
-# 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
$conn->{kepsin} .= "$msg\n";
- dbg("keps in: $conn->{kepsin}") if isdbg('keps');
+# dbg("keps in: $msg") if isdbg('keps');
}
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;
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
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) {
# 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;
projects / spider.git / commitdiff