Local extensions

From 5d197c9f7aa2ea796d86aa5473f93956b24cf1b7 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 28 Dec 1998 23:29:13 +0000 Subject: [PATCH] 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 --- Changes | 5 + cmd/connect.pl | 3 + cmd/merge.pl | 7 +- html/cron.html | 13 +-- html/index.html | 3 +- html/local.html | 62 +++++++++++++ html/program.html | 100 +++++++++++++++++++- perl/DXChannel.pm | 16 ++++ perl/DXCron.pm | 12 ++- perl/DXMsg.pm | 5 + perl/DXProt.pm | 25 +++++ perl/Local.pm | 226 ++++++++++++++++++++++++++++++++++++++++++++++ perl/cluster.pl | 25 ++++- 13 files changed, 487 insertions(+), 15 deletions(-) create mode 100644 html/local.html create mode 100644 perl/Local.pm diff --git a/Changes b/Changes index c2ebb14f..d083a17b 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +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. diff --git a/cmd/connect.pl b/cmd/connect.pl index ed6ba9a0..df9a4238 100644 --- a/cmd/connect.pl +++ b/cmd/connect.pl @@ -18,11 +18,14 @@ if (defined $pid) { 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)); } } diff --git a/cmd/merge.pl b/cmd/merge.pl index a17c736e..51620b60 100644 --- a/cmd/merge.pl +++ b/cmd/merge.pl @@ -14,9 +14,10 @@ return (1, $self->msg('e5')) if $self->priv < 5; 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]; diff --git a/html/cron.html b/html/cron.html index adb9320a..596e72e5 100644 --- a/html/cron.html +++ b/html/cron.html @@ -21,7 +21,7 @@

-Last modified: Mon Dec 28 01:06:43 GMT 1998 +Last modified: Mon Dec 28 23:19:21 GMT 1998

Introduction

@@ -133,11 +133,12 @@ Last modified: Mon Dec 28 01:06:43 GMT 1998

Caveats

- 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 - forked 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). + +

I believe this now to be fixed. YMMV, if so tell me about it!

diff --git a/html/index.html b/html/index.html index 97eb4c22..d4218dea 100644 --- a/html/index.html +++ b/html/index.html @@ -18,7 +18,7 @@

-Last modified: Sun Dec 27 20:18:24 GMT 1998 +Last modified: Mon Dec 28 23:13:24 GMT 1998

Introduction

@@ -68,6 +68,7 @@ Last modified: Sun Dec 27 20:18:24 GMT 1998

Periodic jobs, e.g. starting connection to other clusters.

Hop control, network isolation etc.

Programming new commands or altering existing ones. +

Local customisation of the cluster daemon.

Download the software and any patches. diff --git a/html/local.html b/html/local.html new file mode 100644 index 00000000..71858ffe --- /dev/null +++ b/html/local.html @@ -0,0 +1,62 @@ + + + + Local extensions + + + + + + +

Local extensions

+ + + +

Dirk Koopman G1TLH

+ + +Last modified: Mon Dec 28 22:43:23 GMT 1998 + +

Introduction

+ + The DXSpider system is designed to be extensible, to facilitate experimentation and + self-training in both Amateur Radio and Programming. + +

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. + +

What is it?

+ + The mechanism I have chosen to allow people to do their own thing, is a perl .pm file called + Local.pm. 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. + +

Where is it?

+ + The template is /spider/perl/Local.pm. This file should be + copied into /spider/local and then modified to your taste. + +

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! + +

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! + + +

+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+ + $Id$ + + diff --git a/html/program.html b/html/program.html index 6217a198..1be759f0 100644 --- a/html/program.html +++ b/html/program.html @@ -20,7 +20,7 @@

-Last modified: Wed Dec 23 18:27:06 GMT 1998 +Last modified: Mon Dec 28 23:13:21 GMT 1998

Introduction

@@ -88,6 +88,10 @@ Last modified: Wed Dec 23 18:27:06 GMT 1998 your modifications, otherwise it will continue to use the old ones in your local directories! +

If you want to add facilities to the daemon itself or do some + fancy local spot routing, you might like to try looking at Local customisations. +

Hints, Tips and Exhortations

@@ -336,6 +340,100 @@ return (1, @out) +

Editting the source

+ + I suppose this has to be discussed but although I may have confused some of you, I + insist on the following formatting conventions:- + +

All white space to left of a line shall be tabs. +
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. +
You WILLuse the one true (documented) bracing method as + documented in K & R and all the 'official' perl books. +

+ +

I have been experimenting with editors and tabwidths and have settled on + XEmacs. You can get a copy from the + RedHat Contrib ftp site for your version + of Redhat. I use the following parameters in my .emacs file. + +

+  ;; 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)
+  )
+

+ + I also have all the fancy colouring on (don't know what sets that) but this is + what I have in .xemacs-options file:- + +

+  ;; -*- 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)
+

+ + I also use cperl-mode.el.4.19 which I got from + CPAN 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 /usr/lib/xemacs/site-lisp. + +

XEmacs runs perfectly happily on the console as well as under X. +

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index d540004e..5505610e 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -231,6 +231,22 @@ sub disconnect $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 # diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 9e4bde71..3c9c04fb 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -184,9 +184,10 @@ sub start_connect 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 $!"); @@ -195,6 +196,9 @@ sub start_connect } else { dbg('cron', "can't fork for $prog $!"); } + + # coordinate + sleep(1); } sub spawn @@ -206,9 +210,10 @@ 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 $!"); @@ -217,6 +222,9 @@ sub spawn } else { dbg('cron', "can't fork for $line $!"); } + + # coordinate + sleep(1); } 1; __END__ diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 80895a55..0fc327c4 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -497,6 +497,11 @@ sub queue_msg 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'; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 8bd96984..eb3933ea 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -22,6 +22,8 @@ use DXLog; use Spot; use DXProtout; use DXDebug; +use Local; + use Carp; use strict; @@ -128,6 +130,14 @@ sub normal 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 @@ -179,6 +189,14 @@ sub normal 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); @@ -368,6 +386,13 @@ sub normal $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; diff --git a/perl/Local.pm b/perl/Local.pm new file mode 100644 index 00000000..3d296270 --- /dev/null +++ b/perl/Local.pm @@ -0,0 +1,226 @@ +# +# 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__ diff --git a/perl/cluster.pl b/perl/cluster.pl index 5e5d18f3..fa793f22 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -44,6 +44,8 @@ use Prefix; use Bands; use Geomag; use CmdAlias; +use Local; + use Carp; package main; @@ -141,6 +143,12 @@ sub login 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; } @@ -261,14 +269,23 @@ DXProt->init(); 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"; @@ -289,6 +306,10 @@ for (;;) { 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; -- 2.43.0