at vast speed (reduced it significantly anyway).
2. Personals will now move if homenode is known.
3. Added Local.pm for doing local specials
+28Dec98========================================================================
+1. Crossed fingers, got rid of the instabilities caused by execing programs
+at vast speed (reduced it significantly anyway).
+2. Personals will now move if homenode is known.
+3. Added Local.pm for doing local specials
27Dec98========================================================================
1. Various detail changes to remove some more warning with -w on
2. Added DXCron handling - you can do crontabs now.
if (!$pid) {
# in child, unset warnings, disable debugging and general clean up from us
$^W = 0;
+ $SIG{HUP} = 'IGNORE';
eval "{ package DB; sub DB {} }";
alarm(0);
+ DXChannel::closeall();
$SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
exec $prog, $call, 'connect';
} else {
+ sleep(1); # do a coordination
return(1, $self->msg('constart', $call));
}
}
return (1, $self->msg('e12')) if !$f[0];
my $call = uc $f[0];
-my $dxchan = DXChannel->get($call);
-return (1, $self->msg('e10', $call)) unless $dxchan;
-return (1, $self->msg('e13', $call)) unless $dxchan->is_ak1a();
+my $ref = DXCluster->get_exact($call);
+my $dxchan = $ref->dxchan if $ref;
+return (1, $self->msg('e10', $call)) unless $ref;
+return (1, $self->msg('e13', $call)) unless $ref->isa('DXNode');
my ($spots, $wwv) = $f[1] =~ m{(\d+/\d+)} if $f[1];
<p>
<!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Mon Dec 28 01:06:43 GMT 1998
+Last modified: Mon Dec 28 23:19:21 GMT 1998
<!-- hhmts end -->
<h4>Introduction</h4>
<h4>Caveats</h4>
- There seems to be an intermittent problem when running
- (especially?) with the debugger on. Essentially you will
- experience random crashes with nonsensical error messages. I
- believe that this is caused by stack tracing trying to work inside
- <tt>forked</tt> processes.
+ There was an intermittent problem when running
+ (especially?) with the debugger on. Essentially you would
+ experience random crashes with nonsensical error messages returning from funny places on the stack (if
+ the debugger was on) or just core dumping (if it wasn't).
+
+ <p>I believe this now to be fixed. YMMV, if so tell me about it!
<!-- Standard Footer!! -->
<p> </p>
<p>
<!-- Created: Wed Dec 2 18:22:33 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Sun Dec 27 20:18:24 GMT 1998
+Last modified: Mon Dec 28 23:13:24 GMT 1998
<!-- hhmts end -->
<h4>Introduction</h4>
<li> <a href="cron.html">Periodic</a> jobs, e.g. starting connection to other clusters.
<li> <a href="hops.html">Hop</a> control, network <a href="hops.html#isolate">isolation</a> etc.
<li> <a href="program.html">Programming</a> new commands or altering existing ones.
+ <li> <a href="local.html">Local</a> customisation of the cluster daemon.
<li> <a href="../download/">Download</a> the software and any patches.
</ol>
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>Local extensions</title>
+ <meta name="Keywords" content="DX Cluster, DXSpider, Spider, Packet Cluster, DXCluster, Pavillion Software, AK1A, AX25, AX.25, WWV, Packet Radio, Amateur Radio, Propagation, DX, DXing, G1TLH, GB7TLH, Dirk Koopman, Mailing list, Linux, RedHat, PERL">
+ <meta name="Description" content="Software and systems for realtime digital communications between amateur radio stations for the provision of information on propagation conditions and stations operating">
+ <meta name="Author" content="Dirk Koopman G1TLH">
+ </head>
+ <body TEXT="#000000" LINK="#0000ff" VLINK="#800080" BGCOLOR="#FFFFFF">
+ <FONT COLOR="#606060">
+ <hr>
+ <h2>Local extensions</h2>
+ <hr>
+ </font>
+
+
+ <address><a href="mailto:djk@tobit.co.uk">Dirk Koopman G1TLH</a></address>
+ <p>
+ <!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
+ <!-- hhmts start -->
+Last modified: Mon Dec 28 22:43:23 GMT 1998
+<!-- hhmts end -->
+ <h4>Introduction</h4>
+
+ The DXSpider system is designed to be extensible, to facilitate experimentation and
+ self-training in both Amateur Radio and Programming.
+
+ <p>Having said all of that it is also designed so that it should be relatively easy to solve
+ some real world problems that we have in the DX Cluster network as well as allow the implementation
+ and testing of new protocols relatively safely.
+
+ <h4>What is it?</h4>
+
+ The mechanism I have chosen to allow people to do their own thing, is a perl <tt>.pm</tt> file called
+ <b>Local.pm</b>. It is simply a perl package with its own address space, which has a number of defined
+ subroutines called from certain places in the daemon code. I have provided a "blank" version for you
+ to modify.
+
+ <h4>Where is it?</h4>
+
+ The template is <b>/spider/perl/Local.pm</b>. This file should be
+ copied into <b>/spider/local</b> and then modified to your taste.
+
+ <p>At the moment, the template's format and standard functions are
+ not really finalised, but I won't take away the functions that are
+ currently there and I won't rename them. I reserve the right to
+ add to them!
+
+ <p>As and when I get a clearer idea of what people might wish to do with
+ it and how, I will add to the documentation on this page. So for now:
+ this is it!
+
+<!-- Standard Footer!! -->
+ <p> </p>
+ <p>
+ <FONT COLOR="#606060"><hr></font>
+ <font color="#FF0000" size=-2>
+ Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved<br>
+ </font>
+ <font color="#000000" size=-2>$Id$</font>
+ </body>
+</html>
<p>
<!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Wed Dec 23 18:27:06 GMT 1998
+Last modified: Mon Dec 28 23:13:21 GMT 1998
<!-- hhmts end -->
<h4>Introduction</h4>
your modifications, otherwise <EM>it will continue to use the old ones in your local
directories!</em>
+ <p>If you want to add facilities to the daemon itself or do some
+ fancy local spot routing, you might like to try looking at <a
+ href="local.html">Local</a> customisations.
+
<h4>Hints, Tips and Exhortations</h4>
<ol>
</ol>
+ <h4>Editting the source</h4>
+
+ I suppose this has to be discussed but although I may have confused some of you, I
+ insist on the following formatting conventions:-
+
+ <ol>
+ <p><li>All white space to left of a line shall be tabs.
+ <p><li>A tab shall be 4 characters (unless it is 8) (I use 4). Anything you see
+ with multiples of 2 spaces will be reformatted next time I edit it.
+ <p><li>You <b><u><i>WILL</i></u></b>use the one true (documented) bracing method as
+ documented in K & R and all the 'official' perl books.
+ </ol>
+
+ <p>I have been experimenting with editors and tabwidths and have settled on
+ <a href="http://www.xemacs.org">XEmacs</a>. You can get a copy from the
+ <a href="ftp://contrib.redhat.com">RedHat Contrib</a> ftp site for your version
+ of Redhat. I use the following parameters in my .emacs file.
+
+ <pre>
+ ;; End of Options Menu Settings
+ (custom-set-variables
+ '(cperl-electric-parens t)
+ '(cperl-auto-newline t)
+ '(cperl-electric-linefeed t)
+ '(cperl-hairy t)
+ '(tab-width 4)
+ '(cperl-indent-level 4)
+ '(cperl-brace-offset 0)
+ '(cperl-continued-brace-offset -4)
+ '(cperl-label-offset -4)
+ '(cperl-merge-trailing-else nil)
+ '(cperl-continued-statement-offset 4)
+ )
+ </pre>
+
+ I also have all the fancy colouring on (don't know what sets that) but this is
+ what I have in .xemacs-options file:-
+
+ <pre>
+ ;; -*- Mode: Emacs-Lisp -*-
+
+ (setq options-file-xemacs-version '(20 4))
+ (setq-default case-fold-search t)
+ (setq-default overwrite-mode nil)
+ (setq-default case-fold-search t)
+ (setq-default case-replace t)
+ (setq-default zmacs-regions t)
+ (setq-default mouse-yank-at-point t)
+ (setq-default require-final-newline t)
+ (setq-default next-line-add-newlines nil)
+ (setq-default teach-extended-commands-p t)
+ (setq-default teach-extended-commands-timeout 4)
+ (setq-default debug-on-error nil)
+ (setq-default debug-on-quit nil)
+ (setq-default lpr-switches nil)
+ (setq-default ps-print-color-p t)
+ (setq-default ps-paper-type 'letter)
+ (setq-default get-frame-for-buffer-default-instance-limit nil)
+ (setq-default temp-buffer-show-function 'show-temp-buffer-in-current-frame)
+ (setq-default font-lock-auto-fontify t)
+ (setq-default font-lock-use-fonts nil)
+ (setq-default font-lock-use-colors '(color))
+ (setq-default font-lock-maximum-decoration t)
+ (setq-default font-lock-maximum-size 256000)
+ (setq-default font-lock-mode-enable-list nil)
+ (setq-default font-lock-mode-disable-list nil)
+ (require 'font-lock)
+ (remove-hook 'font-lock-mode-hook 'turn-on-fast-lock)
+ (remove-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
+ (require 'paren)
+ (paren-set-mode 'blink-paren)
+ (if (featurep 'scrollbar) (progn (add-spec-list-to-specifier scrollbar-width 'nil) (add-spe$
+ (add-spec-list-to-specifier modeline-shadow-thickness '((global (nil . 2))))
+ (setq-default truncate-lines nil)
+ (setq-default bar-cursor nil)
+ (setq-default buffers-menu-max-size 25)
+ (setq-default complex-buffers-menu-p nil)
+ (setq-default buffers-menu-sort-function 'sort-buffers-menu-by-mode-then-alphabetically)
+ (setq-default buffers-menu-grouping-function 'group-buffers-menu-by-mode-then-alphabeticall$
+ (setq-default buffers-menu-submenus-for-groups-p nil)
+ (setq-default font-menu-ignore-scaled-fonts t)
+ (setq-default font-menu-this-frame-only-p nil)
+ (if (featurep 'toolbar) (progn (set-default-toolbar-position 'top) (add-spec-list-to-specif$
+ (setq-default mouse-avoidance-mode nil)
+ (setq-default browse-url-browser-function 'browse-url-w3)
+ </pre>
+
+ I also use <a href="../download/cperl-mode.el.4.19.gz">cperl-mode.el.4.19</a> which I got from
+ <a href="http://www.cpan.org">CPAN</a> for the auto formatting of the perl as I write it. Some
+ of its habits are rather peculiar, but you can either switch them off or learn to live with them
+ as I did. I installed my copy in <b>/usr/lib/xemacs/site-lisp</b>.
+
+ <p>XEmacs runs perfectly happily on the console as well as under X.
+
<!-- Standard Footer!! -->
<p> </p>
<p>
$self->del();
}
+#
+# just close all the socket connections down without any fiddling about, cleaning, being
+# nice to other processes and otherwise telling them what is going on.
+#
+# This is for the benefit of forked processes to prepare for starting new programs, they
+# don't want or need all this baggage.
+#
+
+sub closeall
+{
+ my $ref;
+ foreach $ref (values %channels) {
+ $ref->{conn}->disconnect() if $ref->{conn};
+ }
+}
+
# various access routines
#
if (!$pid) {
# in child, unset warnings, disable debugging and general clean up from us
$^W = 0;
-# do "$main::root/perl/Disable_debug.pl";
eval "{ package DB; sub DB {} }";
+ $SIG{HUP} = 'IGNORE';
alarm(0);
+ DXChannel::closeall();
$SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
exec $prog, $call, 'connect';
dbg('cron', "exec '$prog' failed $!");
} else {
dbg('cron', "can't fork for $prog $!");
}
+
+ # coordinate
+ sleep(1);
}
sub spawn
if (!$pid) {
# in child, unset warnings, disable debugging and general clean up from us
$^W = 0;
-# do "$main::root/perl/Disable_debug.pl";
eval "{ package DB; sub DB {} }";
+ $SIG{HUP} = 'IGNORE';
alarm(0);
+ DXChannel::closeall();
$SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
exec "$line";
dbg('cron', "exec '$line' failed $!");
} else {
dbg('cron', "can't fork for $line $!");
}
+
+ # coordinate
+ sleep(1);
}
1;
__END__
if ($ref->{private}) {
if ($ref->{'read'} == 0) {
$clref = DXCluster->get_exact($ref->{to});
+ unless ($clref) { # otherwise look for a homenode
+ my $uref = DXUser->get($ref->{to});
+ my $hnode = $uref->homenode if $uref;
+ $clref = DXCluster->get_exact($hnode) if $hnode;
+ }
if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
$dxchan = $clref->{dxchan};
$ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
use Spot;
use DXProtout;
use DXDebug;
+use Local;
+
use Carp;
use strict;
return unless $pcno;
return if $pcno < 10 || $pcno > 51;
+ # local processing 1
+ my $pcr;
+ eval {
+ $pcr = Local::pcprot($self, $pcno, @field);
+ };
+ dbg('local', "Local::pcprot error $@") if $@;
+ return if $pcr;
+
SWITCH: {
if ($pcno == 10) { # incoming talk
my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
+ # local processing
+ my $r;
+ eval {
+ $r = Local::spot1($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
+ };
+ dbg('local', "Local::spot1 error $@") if $@;
+ return if $r;
+
# send orf to the users
if ($spot && $pcno == 11) {
my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
$wwvdup{$dupkey} = $d;
Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+ my $r;
+ eval {
+ $r = Local::wwv2($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+ };
+ dbg('local', "Local::wwv2 error $@") if $@;
+ return if $r;
+
# DON'T be silly and send on PC27s!
return if $pcno == 27;
--- /dev/null
+#
+# This is a template Local module
+#
+# DON'T CHANGE THIS, copy it to ../local/ and change it
+# there
+#
+# You can add whatever code you like in here, you can also declare
+# new subroutines in addition to the ones here, include other packages
+# or do whatever you like. This is your spring board.
+#
+
+package Local;
+
+use DXVars;
+use DXDebug;
+use DXUtil;
+
+# DON'T REMOVE THIS LINE
+use strict;
+
+
+# declare any global variables you use in here
+use vars qw{ };
+
+# called at initialisation time
+sub init
+{
+
+}
+
+# called once every second
+sub process
+{
+
+}
+
+# called just before the ending of the program
+sub finish
+{
+
+}
+
+# called after an incoming PC line has been split up, return 0 if you want to
+# continue and 1 if you wish the PC Protocol line to be ignored completely
+#
+# Parameters:-
+# $self - the DXChannel object
+# $pcno - the no of the PC field
+# @field - the spot exactly as is, split up into fields
+# $field[0] will be PC11 or PC26
+sub pcprot
+{
+ return 0; # remove this line if you want the switch
+
+ my ($self, $pcno, @field) = @_;
+
+ # take out any switches that aren't interesting to you.
+ SWITCH: {
+ if ($pcno == 10) { # incoming talk
+ last SWITCH;
+ }
+
+ if ($pcno == 11 || $pcno == 26) { # dx spot
+ last SWITCH;
+ }
+
+ if ($pcno == 12) { # announces
+ last SWITCH;
+ }
+
+ if ($pcno == 13) {
+ last SWITCH;
+ }
+ if ($pcno == 14) {
+ last SWITCH;
+ }
+ if ($pcno == 15) {
+ last SWITCH;
+ }
+
+ if ($pcno == 16) { # add a user
+ last SWITCH;
+ }
+
+ if ($pcno == 17) { # remove a user
+ last SWITCH;
+ }
+
+ if ($pcno == 18) { # link request
+ last SWITCH;
+ }
+
+ if ($pcno == 19) { # incoming cluster list
+ last SWITCH;
+ }
+
+ if ($pcno == 20) { # send local configuration
+ last SWITCH;
+ }
+
+ if ($pcno == 21) { # delete a cluster from the list
+ last SWITCH;
+ }
+
+ if ($pcno == 22) {
+ last SWITCH;
+ }
+
+ if ($pcno == 23 || $pcno == 27) { # WWV info
+ last SWITCH;
+ }
+
+ if ($pcno == 24) { # set here status
+ last SWITCH;
+ }
+
+ if ($pcno == 25) { # merge request
+ last SWITCH;
+ }
+
+ if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
+ last SWITCH;
+ }
+
+ if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
+ last SWITCH;
+ }
+
+ if ($pcno == 35) { # remote command replies
+ last SWITCH;
+ }
+
+ if ($pcno == 37) {
+ last SWITCH;
+ }
+
+ if ($pcno == 38) { # node connected list from neighbour
+ last SWITCH;
+ }
+
+ if ($pcno == 39) { # incoming disconnect
+ last SWITCH;
+ }
+
+ if ($pcno == 41) { # user info
+ last SWITCH;
+ }
+ if ($pcno == 43) {
+ last SWITCH;
+ }
+ if ($pcno == 44) {
+ last SWITCH;
+ }
+ if ($pcno == 45) {
+ last SWITCH;
+ }
+ if ($pcno == 46) {
+ last SWITCH;
+ }
+ if ($pcno == 47) {
+ last SWITCH;
+ }
+ if ($pcno == 48) {
+ last SWITCH;
+ }
+
+ if ($pcno == 50) { # keep alive/user list
+ last SWITCH;
+ }
+
+ if ($pcno == 51) { # incoming ping requests/answers
+ last SWITCH;
+ }
+ }
+ return 0;
+}
+
+# called after the spot has been stored but before it is broadcast,
+# you can do funky routing here that is non-standard. 0 carries on
+# after this, 1 stops dead and no routing is done (this could mean
+# that YOU have done some routing or other instead
+#
+# Parameters:-
+# $self - the DXChannel object
+# $freq - frequency
+# $spotted - the spotted callsign
+# $d - the date in unix time format
+# $text - the text of the spot
+# $spotter - who spotted it
+# $orignode - the originating node
+#
+sub spot
+{
+ return 0;
+}
+
+# called after the wwv has been stored but before it is broadcast,
+# you can do funky routing here that is non-standard. 0 carries on
+# after this, 1 stops dead and no routing is done (this could mean
+# that YOU have done some routing or other instead
+#
+# Parameters:-
+# $self - the DXChannel object
+# The rest the same as for Geomag::update
+sub wwv
+{
+ return 0;
+}
+
+# no idea what or when these are called yet
+sub userstart
+{
+ return 0;
+}
+
+sub userline
+{
+ return 0;
+}
+
+sub userfinish
+{
+ return 0;
+}
+1;
+__END__
use Bands;
use Geomag;
use CmdAlias;
+use Local;
+
use Carp;
package main;
sub cease
{
my $dxchan;
+
+ eval {
+ Local::finish(); # end local processing
+ };
+ dbg('local', "Local::finish error $@") if $@;
+
foreach $dxchan (DXChannel->get_all()) {
disconnect($dxchan) unless $dxchan == $DXProt::me;
}
DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version);
# read in any existing message headers and clean out old crap
-print "reading existing message headers\n";
+print "reading existing message headers ...\n";
DXMsg->init();
DXMsg::clean_old();
# read in any cron jobs
-print "reading cron jobs\n";
+print "reading cron jobs ...\n";
DXCron->init();
+# starting local stuff
+print "doing local initialisation ...\n"
+eval {
+ Local::init();
+};
+dbg('local', "Local::init error $@") if $@;
+
+
+
# print various flags
#print "useful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P\n";
DXCommandmode::process(); # process ongoing command mode stuff
DXProt::process(); # process ongoing ak1a pcxx stuff
DXConnect::process();
+ eval {
+ Local::process(); # do any localised processing
+ };
+ dbg('local', "Local::process error $@") if $@;
}
if ($decease) {
last if --$decease <= 0;
projects / spider.git / commitdiff