Merge branch 'users.v3j' into mojo
authorDirk Koopman <djk@tobit.co.uk>
Thu, 9 Jul 2020 20:10:07 +0000 (21:10 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Thu, 9 Jul 2020 20:10:07 +0000 (21:10 +0100)
23 files changed:
Changes
RBN.mojo [new file with mode: 0644]
UPGRADE.mojo
cmd/Aliases
cmd/Commands_en.hlp
cmd/export_users.pl
cmd/load/dxqsl.pl
cmd/set/wantrbn.pl
cmd/show/node.pl
perl/DXCommandmode.pm
perl/DXDebug.pm
perl/DXUser.pm
perl/DXUtil.pm
perl/ExtMsg.pm
perl/Messages
perl/Msg.pm
perl/QSL.pm
perl/RBN.pm
perl/cluster.pl
perl/convert-users-v3-to-v3j.pl [new file with mode: 0755]
perl/convert-users-v3-to-v4.pl [deleted file]
perl/create_dxqsl.pl [new file with mode: 0755]
perl/create_qsl.pl [deleted file]

diff --git a/Changes b/Changes
index d8e3fcc14b9cf409447c4a9a0d7081e85cb09f02..74bc922b108ae9e09c0cf7a73d2270ec74ae4926 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,10 +1,39 @@
+08Jul20=======================================================================
+1. "Finish" the RBN system :-)
+2. This includes enabling the coarse selection of spot modes using set/wantrbn
+   with arguments like 'set/wantrbn cw beacon'. This limits your output to
+   just CW, BCN and DXF modes.  
+3. The RBN spot is now cached. With a following wind, this means that even a
+   node restart, done in a timely fashion (within a few minutes) will not
+   cause a "cache warmup" delay for users on a restart.
+4. Added the "full fat" set/wantrbn command and aliased it to 'set/skimmer'. 
+   I use both terms (whenever I remembered) in the help text.
+5. Help text has been written.
+6. The UPGRADE.mojo file has been tweeked to point out the users file format
+   change.
+7. Merge in users.v3j to the mojo branch.
 07Jul20=======================================================================
-1. Fix show/cluster command to take into account the presence of skimmer nodes
+1. Fix show/node command.
+2. Fix show/cluster command to take into account the presence of skimmer nodes
    which are a new category of thing which is neither a node nor a user.
 06Jul20=======================================================================
-1. Update console.pl (dx) to improve scrolling as keyboard speed. 
+1. Add RBN.mojo with information of the RBN capabilities of DXSpider.
 05Jul20=======================================================================
 1. Fix show/dxcc.
+2. Add HAPROXY "real ip" type 1 handling for incoming connections.
+04Jul20=======================================================================
+1. Give console.pl (or dx) a good going over with a bog brush to *finally*
+   (cough) make it work correctly with a full 80 column window (and not just
+   to a width of 79 really). Also fix scrolling.
+28Jun20=======================================================================
+1. Merge mojo with users.v3j to remove all vestages of Storable from DXSpider
+   in an effort to make the whole storage thing more reliable (and also a
+   bit faster). The user file will be auto-upgraded on restart. This may take
+   up to 20 seconds on slower hardware (and maybe a bit longer on huge user
+   files). On my 180,000 odd users, on my hardware, it takes 4 seconds.
+2. The DXQSL system storage is also upgraded, Please run 
+   /spider/perl/create_dxqsl.pl in a spare shell. This will recreate the 
+   dxqsl.v1j file. Run 'load/dxqsl' in the console to activate it. 
 17Jun20=======================================================================
 1. Change the Spot file reading mechanism back to the default of using 'tac'.
 08Jun20=======================================================================
diff --git a/RBN.mojo b/RBN.mojo
new file mode 100644 (file)
index 0000000..488abb3
--- /dev/null
+++ b/RBN.mojo
@@ -0,0 +1,267 @@
+6th July 2020
+
+The latest release of the Mojo branch of DXSpider contains a client
+for the Reverse Beacon Network (RBN). This is not a simple client, it
+attempts to make some sense of the 10s of 1000s of "spots" that the
+RBN can send PER HOUR. At busy times, actually nearly all the time, the
+spots from the RBN come in too quickly for anybody to get anything more
+than a fleeting impression of what's coming in.
+
+Something has to try to make this manageable - which is what I have
+tried to do with DXSpider's RBN client.
+
+The RBN has a number of problems (apart from the overwhelming quantity
+of data that it sends):
+
+* Spotted callsigns, especially on CW, are not reliably
+  decoded. Estimates vary as to how bad it is but, as far as I can
+  tell, even these estimates are unreliable!
+
+* The frequency given is unreliable. I have seen differences as great
+  as 600hz on CW spots.
+
+* There is far too much (in my view) useless information in each spot
+  - even if one had time to read, decode and understand it before the
+  spot has scrolled off the top of the screen.
+
+* The format of the comment is not regular. If one has both FTx and
+  "all the other" spots (CW, PSK et al) enabled at the same time,
+  one's eye is constantly having to re-adjust. Again, very difficult
+  to deal with on contest days. Especially if it mixed in with
+  "normal" spots.
+
+So what have I done about this? Look at the sample of input traffic
+below:
+
+05Jul2020@22:59:31 (chan) <- I SK0MMR DX de KM3T-2-#:  14100.0  CS3B           CW    24 dB  22 WPM  NCDXF B 2259Z
+05Jul2020@22:59:31 (chan) <- I SK0MMR DX de KM3T-2-#:  28263.9  AB8Z/B         CW    15 dB  18 WPM  BEACON  2259Z
+05Jul2020@22:59:31 (chan) <- I SK0MMR DX de LZ3CB-#:   7018.20  RW1M           CW    10 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:31 (chan) <- I SK0MMR DX de W9XG-#:    14057.6  K7GT           CW     7 dB  21 WPM  CQ      2259Z
+05Jul2020@22:59:31 (chan) <- I SK0MMR DX de G0LUJ-#:   14100.1  CS3B           CW    18 dB  20 WPM  NCDXF B 2259Z
+05Jul2020@22:59:32 (chan) <- I SK0MMR DX de LZ4UX-#:    7018.3  RW1M           CW    13 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:32 (chan) <- I SK0MMR DX de LZ4AE-#:    7018.3  RW1M           CW    28 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:32 (chan) <- I SK0MMR DX de W1NT-6-#:  28222.9  N1NSP/B        CW     5 dB  15 WPM  BEACON  2259Z
+05Jul2020@22:59:32 (chan) <- I SK0MMR DX de W1NT-6-#:  28297.0  NS9RC          CW     4 dB  13 WPM  BEACON  2259Z
+05Jul2020@22:59:32 (chan) <- I SK0MMR DX de F8DGY-#:    7018.2  RW1M           CW    23 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:33 (chan) <- I SK0MMR DX de 9A1CIG-#:  7018.30  RW1M           CW    20 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:33 (chan) <- I SK0MMR DX de LZ7AA-#:    7018.3  RW1M           CW    16 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:33 (chan) <- I SK0MMR DX de DK9IP-#:    7018.2  RW1M           CW    21 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:33 (chan) <- I SK0MMR DX de WE9V-#:    10118.0  N5JCB          CW    15 dB  10 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de DJ9IE-#:    7028.0  PT7KM          CW    15 dB  10 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de DJ9IE-#:    7018.3  RW1M           CW    31 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de DD5XX-#:    7018.3  RW1M           CW    21 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de DE1LON-#:  14025.5  EI5JF          CW    13 dB  19 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de DE1LON-#:   7018.3  RW1M           CW    24 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de ON6ZQ-#:    7018.3  RW1M           CW    22 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:34 (chan) <- I SK0MMR DX de OH6BG-#:    3516.9  RA1AFT         CW    15 dB  25 WPM  CQ      2259Z
+05Jul2020@22:59:35 (chan) <- I SK0MMR DX de HA1VHF-#:   7018.3  RW1M           CW    30 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:35 (chan) <- I SK0MMR DX de F6IIT-#:    7018.4  RW1M           CW    32 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:36 (chan) <- I SK0MMR DX de HB9BXE-#:   7018.3  RW1M           CW    23 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:37 (chan) <- I SK0MMR DX de SM0IHR-#:   7018.3  RW1M           CW    21 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:37 (chan) <- I SK0MMR DX de DK0TE-#:    7018.3  RW1M           CW    26 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:37 (chan) <- I SK0MMR DX de OE9GHV-#:   7018.3  RW1M           CW    40 dB  19 WPM  CQ      2259Z
+05Jul2020@22:59:37 (chan) <- I SK0MMR DX de CX6VM-#:   10118.0  N5JCB          CW    20 dB  10 WPM  CQ      2259Z
+05Jul2020@22:59:37 (chan) -> D G1TST DX de F8DGY-#:     7018.3 RW1M         CW  23dB Q:9* Z:20           16 2259Z 14
+05Jul2020@22:59:38 (chan) <- I SK0MMR DX de HB9JCB-#:   7018.3  RW1M           CW    16 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de HB9JCB-#:   3516.9  RA1AFT         CW     9 dB  26 WPM  CQ      2259Z
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de KO7SS-7-#:  14057.6  K7GT           CW     6 dB  21 WPM  CQ      2259Z
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de K9LC-#:    28169.9  VA3XCD/B       CW     9 dB  10 WPM  BEACON  2259Z
+05Jul2020@22:59:40 (chan) <- I SK0MMR DX de HB9DCO-#:   7018.2  RW1M           CW    25 dB  18 WPM  CQ      2259Z
+05Jul2020@22:59:40 (chan) <- I SK0MMR DX de EA5WU-#:    7018.3  RW1M           CW    19 dB  18 WPM  CQ      2259Z
+
+* As you can see, there are frequently more than one spotter for a
+  callsign:
+
+* I normalise the frequency and cache up to 9 copies from different
+  spots. In order to do this I have to wait a few (configurable) seconds
+  for the client to collect a reasonable number of copies. More copies 
+  may come in after 9 copies have been received. Once I have enough 
+  copies to be sure that the callsign is at least agreeed upon by more
+  than one skimmer, or the wait timer goes off, I emit a spot.  By this
+  means I can reduce the number of spots sent to a node user by up to a
+  factor of 10 for CW etc spots and about 8 for FTx spots.
+
+  For example, from the trace above, all the RW1M RBN spots become just
+  one line:
+
+DX de F8DGY-#:     7018.3 RW1M         CW  23dB Q:9* Z:20           16 2259Z 14
+
+* No RBN spots can leak out of the node to the general cluster. Each
+  node that wants to use the RBN *must* establish their own
+  connections to the RBN.
+
+* Currently no RBN spots are stored. This may well change but how and
+  where these spots are stored is not yet decided. Only "DXSpider
+  curated" spots (like the example above) will be stored (if/when they
+  are). Sh/dx will be suitably modified if storage happens. 
+
+* There are some things that need to be explained:
+
+a) The input format from the RBN is not the same as format emitted by
+the cluster node. This is part of the unhelpfulness to mixing a raw
+RBN feed with normal spots.
+
+b) Each spot sent out to a node user has a "Qwalitee" marker, In this
+case Q:9*. The '9' means that I have received 9 copies of this spot
+from different skimmers and, in this case, they did not agree on the
+frequency (7018.2 - 7018.4) which is indicated by a '*'. The frequency
+shown is the majority decision. If this station has been active for
+some time and he is still calling CQ after some time (configurable,
+but currently 60 minutes) and gaps for QSOs or tea breaks are ignored,
+then a '+' character will be added.
+
+If the "Qualitee" Q:1 is seen on a CW spot, then only one skimmer has
+seen that spot and the callsign *could* be wrong, but frequently, if
+it is wrong, it is more obvious than the example below. But if Q is
+Q:2 and above, then the callsign is much more likely to be correct.
+
+DX de DJ9IE-#:    14034.9 UN7BBD       CW   4dB Q:5*+              17 1444Z 14
+DX de OL7M-#:     14037.9 UA6LQ        CW  13dB Q:7                16 1448Z 15
+DX de LZ3CB-#:    28050.2 DL4HRM       CW   7dB Q:1                14 1448Z 20
+
+c) I ditch the WPM and the 'CQ' as not being hugely relevant. 
+
+d) If there is a Z:nn[,mm...], then this spot was also heard by
+skimmers in other zones. In this example, it means that this call was
+also heard in CQ Zone 20. This list does NOT include the cq zone of
+the skimmer nor the spot. If you would like to see these then do
+'set/dxcq'. This setting is active for all the examples in this
+document. This is completely optional.
+
+There can be a ',' separated list of as many zones where this spot was
+also heard by another skimmers, up to the space available in the
+comment area.
+
+DX de LZ4UX-#:    14015.5 ON7TQ        CW   6dB Q:9 Z:5,14,15,40   14 0646Z 20
+DX de VE7CC-#:     3573.0 N8ADO        FT8 -14dB Q:4 Z:4,5          4 0647Z  3
+DX de DM7EE-#:    14027.5 R1AC         CW   9dB Q:9* Z:5,15,17,20  16 0643Z 14
+DX de WE9V-#:      7074.0 EA7ALL       FT8 -9dB Q:2+ Z:5           14 0641Z  4
+
+e) I shorten the skimmer callsign to 6 characters - having first
+chopped off any SSIDs, spurious /xxx strings from the end, leaving
+just the base callsign, before (re-)adding '-#' on the end. This is
+done to minimise the misalignment of the spot rightwards, as in the
+incoming skimmer spot from KO7SS-7-# below. There are some very
+strange skimmer callsigns with all sorts of spurious endings, all of
+which I attempt to reduce to the base callsign. Some skimmer base
+callsigns still might be shortened for display purposes. Things like
+'3V/K5WEM' won't fit in six characters but the whole base callsign is
+used for zone info, internally, but only the first 6 characters are
+displayed in any spot.
+
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de HB9JCB-#:   3516.9  RA1AFT         CW     9 dB  26 WPM  CQ      2259Z
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de KO7SS-7-#:  14057.6  K7GT           CW     6 dB  21 WPM  CQ      2259Z
+05Jul2020@22:59:39 (chan) <- I SK0MMR DX de K9LC-#:    28169.9  VA3XCD/B       CW     9 dB  10 WPM  BEACON  2259Z
+
+f) I have a filter set (accept/spot by_zone 14 and not zone 14 or zone
+14 and not by_zone 14) which will give me the first spot that either
+spot or skimmer is in zone 14 but the other isn't. For those of us
+that are bad at zones (like me) sh/dxcq is your friend. You can have
+separate filters just for RBN spots if you want something different to
+your spot filters. Use acc/rbn or rej/rbn. NB: these will completely
+override your spot filters for RBN spots. Obviously "real" spots will
+will continue to use the spot filter(s).
+
+g) If there is NO filter in operation, then the skimmer spot with the
+LOWEST signal strength will be shown. This implies that if any extra
+zones are shown, then the signal will be higher.
+
+h) A filter can further drastically reduce the output sent to the
+user. As this STATS line shows:
+
+23:22:45 (*) RBN:STATS hour SK0MMR raw: 5826 sent: 555 delivered: 70 users: 1
+
+For this hour, I received 5826 raw spots from the CW etc RBN, which
+produced 555 possible spots, which my filter reduced to 70 that were
+actually delivered to G1TST. For the FTx RBN, I don't have a filter
+active and so I got all the possibles:
+
+23:22:45 (*) RBN:STATS hour SK1MMR raw: 13354 sent: 1745 delivered: 1745 users: 1
+
+---------------------------------------------------------------------
+
+So how do you go about using this:
+
+First you need to create an RBN user. Now you can use any call you
+like and it won't be visible outside of the node. I call mine SK0MMR
+and SK1MMR. One of these connects to the "standard" RBN port that
+outputs CW, BEACON, DXF, PSK and RTTY spots, and the other connects to
+the RBN port that just outputs FT4 and FT8 spots.
+
+set/rbn sk0mmr sk1mmr
+
+Now create connect scripts in /spider/connect/sk0mmr (and similarly
+sk1mmr). They look like this:
+
+/spider/connect/sk0mmr:
+
+connect telnet telnet.reversebeacon.net 7000
+'call:' '<node callsign here'
+
+/spider/connect/sk1mmr:
+
+connect telnet telnet.reversebeacon.net 7001
+'call:' '<node callsign here'
+
+Now put them in your local crontab in /spider/local_cmd/crontab:
+
+* * * * * start_connect('sk0mmr') unless connected('sk0mmr')
+* * * * * start_connect('sk1mmr') unless connected('sk1mmr')
+
+This will check once every minute to see if each RBN connection is
+active, you can check what is connected with the 'links' command:
+
+                                                 Ave  Obs  Ping  Next      Filters
+  Callsign Type Started                 Uptime    RTT Count Int.  Ping Iso? In  Out PC92? Address
+    GB7DJK DXSP  5-Jul-2020 1722Z     7h 6m 8s   0.02   2    300    89               Y    163.172.11.79
+    SK0MMR RBN   5-Jul-2020 1722Z     7h 6m 8s                 0     0                    198.137.202.75
+    SK1MMR RBN   5-Jul-2020 1722Z     7h 6m 8s                 0     0                    198.137.202.75
+
+The connections are sometimes dropped or become stuck, I have a
+mechanism to detect this and it will disconnect that RBN connection
+and the reconnection will be reconnected by the crontab, just like any
+other (normal) node.
+
+I use the crontab, rather than restarting immediately after
+disconnection, to prevent race conditions (or just slow them down to
+one disconnection a minute).
+
+The first time a connection is made, after node startup, there is a 5
+minute pause before RBN spots come out for users. This is done to fill
+up (or "train") the cache. Otherwise the users will be overwhelmed by
+spots - it slows down reasonably quickly - but experiment shows that 5
+minutes is a reasonable compromise. The delay is configurable,
+globally, for all RBN connections, but in future is likely to be
+configurable per connection. Basically, because the FTx RBN data is
+much more bursty and there is more of it (except on CW contests), it
+could do with a somewhat longer training period than the CW etc RBN
+connection.
+
+If a connection drops and reconnects. There is no delay or extra
+training time.
+
+For users. At the moment. There is a single command that sets or
+unsets ALL RBN spot sorts:
+
+set/wantrbn
+unset/wantrbn
+
+Very soon this will be replaced with a '(un)set/skimmer' command that
+allow the user to choose which categories they want. Filtering can be
+used in conjunction with this proposed command to further refine
+output.
+
+This still very much "work in progress" and will be subject to
+change. But I am grateful to the feedback I have received, so far,
+from:
+
+Kin EA3CV
+Andy G4PIQ
+Mike G8TIC
+Lee VE7CC
+
+But if you have comments, suggestions and brickbats please email me or
+the support list.
+
+Dirk G1TLH
+
index 502bb0e78ffe0aa28fb7b21052629a4b779ac394..baecd479d2664195a22cf379ec3d788fc6f51ead 100644 (file)
@@ -1,4 +1,8 @@
-There are the notes for upgrading to the mojo branch.
+8th July 2020
+-------------
+
+There are the notes for upgrading to the mojo branch. PLEASE NOTE THERE HAVE BEEN CHANGES 
+FOR all MOJO BRANCH USERS. See APPENDIX(i) at the end of this document.
 
 There is NO POINT in doing this at the moment unless you are running a node with many (>50)
 users. It is the future, but at the moment I am testing larger and larger installations to
@@ -59,7 +63,7 @@ You will need the following CPAN packages:
        sudo apt-get install libev-perl libmojolicious-perl libjson-perl libjson-xs-perl libdata-structure-util-perl libmath-round-perl
 
     or on Redhat based systems you can install the very similarly (but not the same) named
-       packages. I don't the exact names but using anything less than Centos 7 is likely to cause
+       packages. I don't know the exact names but using anything less than Centos 7 is likely to cause
        a world of pain. Also I doubt that EV and Mojolicious are packaged for Centos at all.
 
        If in doubt or it is taking too long to find the packages you should build from CPAN. Note: you may
@@ -70,8 +74,8 @@ You will need the following CPAN packages:
 
        sudo cpanm EV Mojolicious JSON JSON::XS Data::Structure::Util Math::Round
        
-       # just in case it's missing
-       sudo apt-get install top
+       # just in case it's missing (top, that is)
+       sudo apt-get install procps
 
 Please make sure that, if you insist on using operating system packages, that your Mojolicious is
 at least version 7.26. Mojo::IOLoop::ForkCall is NOT LONGER IN USE! The current version at time
@@ -184,6 +188,25 @@ I try very hard not to leave it in a broken state...
 
 Dirk G1TLH
 
+APPENDIX(i)
+
+With this revrsion of the code, the users.v3 file will be replaced with users.v3j. This is a reversable 
+change. Simply revert to the previous revision, and email me, should anything go wrong. On restarting 
+the node, the users.v3j file will be generated from the users.v3 file. The users.v3 file is not changed. 
+The process of generation will take up to 30 seconds depending on the number of users in your file,
+the speed of your disk(s) and the CPU speed (probably in that order. On my machine, it takes about 5
+seconds, on an RPi??? 
+
+Part of this process may clear out some old records or suggest that there might errors. DO NOT BE 
+ALARM. This is completely normal. 
+
+This change not only should make the rebuilding of the users file (much) less likely, but tests suggest
+that access to the users file is about 2.5 times quicker. How much difference this makes in practise 
+remains to be seen. 
+
+When you done this, in another shell, run /spider/perl/create_dxsql.pl. This will convert the DXQSL 
+system to dxqsl.v1j (for the sh/dxqsl <call> command). When this is finished, run 'load/dxqsl' in 
+a console (or restart the node, but it isn't necessary).
 
 
 
index e9029f1872fe267a0d134ad7e97de77612d297c1..59c1255e67dbd429610002c819b96182dbcff84a 100644 (file)
 package CmdAlias;
 
 %alias = (
-    '?' => [
-         '^\?', 'apropos', 'apropos',
-       ],
-    'a' => [
-         '^a$', 'announce', 'announce',
-       '^acc?e?p?t?$', 'apropos accept', 'apropos',
-         '^ann?o?u?n?c?e?/full', 'announce full', 'announce', 
-         '^ann?o?u?n?c?e?/sysop', 'announce sysop', 'announce',
-         '^ann?o?u?n?c?e?/(.*)$', 'announce $1', 'announce',
-       ],
-       'b' => [
-         '^b$', 'bye', 'bye',
-       ],
-       'c' => [
-       '^cle?a?r?$', 'apropos clear', 'apropos',
-       '^cre?a?t?e?$', 'apropos create', 'apropos',
-       ],
-       'd' => [
-         '^dele?t?e?/fu', 'kill full', 'kill',
-         '^dele?t?e?$', 'kill', 'kill',
-         '^dir?e?c?t?o?r?y?/a\w*', 'directory all', 'directory',
-         '^dir?e?c?t?o?r?y?/b\w*', 'directory bulletins', 'directory',
-         '^dir?e?c?t?o?r?y?/n\w*', 'directory new', 'directory',
-         '^dir?e?c?t?o?r?y?/o\w*', 'directory own', 'directory',
-         '^dir?e?c?t?o?r?y?/s\w*', 'directory subject', 'directory',
-         '^dir?e?c?t?o?r?y?/t\w*', 'directory to', 'directory',
-         '^dir?e?c?t?o?r?y?/f\w*', 'directory from', 'directory',
-         '^dir?e?c?t?o?r?y?/(\d+)-(\d+)', 'directory $1-$2', 'directory',
-         '^dir?e?c?t?o?r?y?/(\d+)', 'directory $1', 'directory',
-       ],
-       'e' => [
-         '^exi?t?$', 'bye', 'bye',
-         '^export_u', 'export_users', 'export_users',
-         '^expor?', 'export', 'export',
-         '^expun?g?e?$', 'kill expunge', 'kill expunge',
-       ],
-       'f' => [
-       '^for?w?a?r?d?$', 'apropos forward', 'apropos',
-       ],
-       'g' => [
-       ],
-       'h' => [
-       ],
-       'i' => [
-       ],
-       'j' => [
-       ],
-       'k' => [
-                       '^ki?l?l?/ex', 'kill expunge', 'kill',
-       ],
-       'l' => [
-       '^loa?d?$', 'apropos load', 'apropos',
-         '^l$', 'directory', 'directory',
-         '^ll$', 'directory', 'directory',
-         '^ll/(\d+)', 'directory $1', 'directory',
-         '^lm$', 'directory own', 'directory',
-      '^l>$', 'directory to', 'directory',
-      '^l<$', 'directory from', 'directory',
-       ],
-       'm' => [
-       ],
-       'n' => [
-       ],
-       'o' => [
-       ],
-       'p' => [
-       ],
-       'q' => [
-         '^qu?i?t?$', 'bye', 'bye',
-       ],
-       'r' => [        
-         '^r$', 'read', 'read',
-       '^reje?c?t?$', 'apropos reject', 'apropos',
-         '^rcmd/(\S+)', 'rcmd $1', 'rcmd',
-       ],
-       's' => [
-         '^s$', 'send', 'send',
-         '^s/p$', 'send', 'send',
-         '^sb$', 'send noprivate', 'send',
-         '^set/home$', 'set/homenode', 'set/homenode',
-         '^set/nobe', 'unset/beep', 'unset/beep',
-         '^set/nohe', 'unset/here', 'unset/here',
-         '^set/noan', 'unset/announce', 'unset/announce',
-         '^set/nodxg', 'unset/dxgrid', 'unset/dxgrid',
-         '^set/nodx', 'unset/dx', 'unset/dx',
-         '^set/noe', 'unset/echo', 'unset/echo',
-         '^set/nota', 'unset/talk', 'unset/talk',
-         '^set/noww', 'unset/wwv', 'unset/wwv',
-         '^set/nowx', 'unset/wx', 'unset/wx',
-       '^set$', 'apropos set', 'apropos',
-         '^sho?w?/u$', 'show/user', 'show/user',
-         '^sho?w?/bul', 'show/files bulletins', 'show/files',
-         '^sho?w?/co?n?\w*/a', 'show/configuration all', 'show/configuration',
-         '^sho?w?/co?n?\w*/n', 'show/configuration nodes', 'show/configuration',
-         '^sho?w?/c$', 'show/configuration', 'show/configuration',
-         '^sho?w?/com', 'dbavail', 'dbavail',
-         '^sho?w?/dxcc', 'show/dx dxcc', 'show/dx',
-         '^sho?w?/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx',
-         '^sho?w?/dx/(\d+)', 'show/dx $1', 'show/dx',
-         '^sho?w?/dx/d(\d+)', 'show/dx from $1', 'show/dx',
-         '^sho?w?/fdx/(\d+)-(\d+)', 'show/dx real $1-$2', 'show/fdx',
-         '^sho?w?/fdx/(\d+)', 'show/dx real $1', 'show/fdx',
-         '^sho?w?/fdx/d(\d+)', 'show/dx real from $1', 'show/fdx',
-         '^sho?w?/fdx', 'show/dx real', 'show/fdx',
-         '^sho?w?/grou?p?s?', 'show/groups', 'show/groups',
-         '^sho?w?/gr[ae]?y?l?i?n?e?', 'show/grayline', 'show/grayline',
-         '^sho?w?/myfd?x?/(\d+)-(\d+)', 'show/dx filter real $1-$2', 'show/mydx',
-         '^sho?w?/myfd?x?/(\d+)', 'show/dx filter real $1', 'show/mydx',
-         '^sho?w?/myfd?x?/d(\d+)', 'show/dx filter real from $1', 'show/mydx',
-         '^sho?w?/myfd?x?', 'show/dx filter real', 'show/mydx',
-         '^sho?w?/myd?x?/(\d+)-(\d+)', 'show/dx filter $1-$2', 'show/mydx',
-         '^sho?w?/myd?x?/(\d+)', 'show/dx filter $1', 'show/mydx',
-         '^sho?w?/myd?x?/d(\d+)', 'show/dx filter from $1', 'show/mydx',
-         '^sho?w?/myd?x?', 'show/dx filter', 'show/mydx',
-         '^sho?w?/newco?n?\w*/n', 'show/newconfiguration node', 'show/newconfiguration',
-         '^sho?w?/sta?$', 'show/station', 'show/station',
-         '^sho?w?/tnc', 'who', 'who',
-      '^sho?w?/up', 'show/cluster', 'show/cluster',
-         '^sho?w?/ww?v?/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv',
-         '^sho?w?/ww?v?/(\d+)', 'show/wwv $1', 'show/wwv',
-       '^sho?w?$', 'apropos show', 'apropos',
-       '^shutd?\w*$', 'shutdown', 'shutdown',
-         '^sp$', 'send', 'send',
-       '^sta?t?$', 'apropos stat', 'apropos',
+                 '?' => [
+                                 '^\?', 'apropos', 'apropos',
+                                ],
+                 'a' => [
+                                 '^a$', 'announce', 'announce',
+                                 '^acc?e?p?t?$', 'apropos accept', 'apropos',
+                                 '^ann?o?u?n?c?e?/full', 'announce full', 'announce', 
+                                 '^ann?o?u?n?c?e?/sysop', 'announce sysop', 'announce',
+                                 '^ann?o?u?n?c?e?/(.*)$', 'announce $1', 'announce',
+                                ],
+                 'b' => [
+                                 '^b$', 'bye', 'bye',
+                                ],
+                 'c' => [
+                                 '^cle?a?r?$', 'apropos clear', 'apropos',
+                                 '^cre?a?t?e?$', 'apropos create', 'apropos',
+                                ],
+                 'd' => [
+                                 '^dele?t?e?/fu', 'kill full', 'kill',
+                                 '^dele?t?e?$', 'kill', 'kill',
+                                 '^dir?e?c?t?o?r?y?/a\w*', 'directory all', 'directory',
+                                 '^dir?e?c?t?o?r?y?/b\w*', 'directory bulletins', 'directory',
+                                 '^dir?e?c?t?o?r?y?/n\w*', 'directory new', 'directory',
+                                 '^dir?e?c?t?o?r?y?/o\w*', 'directory own', 'directory',
+                                 '^dir?e?c?t?o?r?y?/s\w*', 'directory subject', 'directory',
+                                 '^dir?e?c?t?o?r?y?/t\w*', 'directory to', 'directory',
+                                 '^dir?e?c?t?o?r?y?/f\w*', 'directory from', 'directory',
+                                 '^dir?e?c?t?o?r?y?/(\d+)-(\d+)', 'directory $1-$2', 'directory',
+                                 '^dir?e?c?t?o?r?y?/(\d+)', 'directory $1', 'directory',
+                                ],
+                 'e' => [
+                                 '^exi?t?$', 'bye', 'bye',
+                                 '^export_u', 'export_users', 'export_users',
+                                 '^expor?', 'export', 'export',
+                                 '^expun?g?e?$', 'kill expunge', 'kill expunge',
+                                ],
+                 'f' => [
+                                 '^for?w?a?r?d?$', 'apropos forward', 'apropos',
+                                ],
+                 'g' => [
+                                ],
+                 'h' => [
+                                ],
+                 'i' => [
+                                ],
+                 'j' => [
+                                ],
+                 'k' => [
+                                 '^ki?l?l?/ex', 'kill expunge', 'kill',
+                                ],
+                 'l' => [
+                                 '^loa?d?$', 'apropos load', 'apropos',
+                                 '^l$', 'directory', 'directory',
+                                 '^ll$', 'directory', 'directory',
+                                 '^ll/(\d+)', 'directory $1', 'directory',
+                                 '^lm$', 'directory own', 'directory',
+                                 '^l>$', 'directory to', 'directory',
+                                 '^l<$', 'directory from', 'directory',
+                                ],
+                 'm' => [
+                                ],
+                 'n' => [
+                                ],
+                 'o' => [
+                                ],
+                 'p' => [
+                                ],
+                 'q' => [
+                                 '^qu?i?t?$', 'bye', 'bye',
+                                ],
+                 'r' => [      
+                                 '^r$', 'read', 'read',
+                                 '^reje?c?t?$', 'apropos reject', 'apropos',
+                                 '^rcmd/(\S+)', 'rcmd $1', 'rcmd',
+                                ],
+                 's' => [
+                                 '^s$', 'send', 'send',
+                                 '^s/p$', 'send', 'send',
+                                 '^sb$', 'send noprivate', 'send',
+                                 '^set/dbg$', 'set/debug', 'set/debug',
+                                 '^set/home$', 'set/homenode', 'set/homenode',
+                                 '^set/nobe', 'unset/beep', 'unset/beep',
+                                 '^set/nohe', 'unset/here', 'unset/here',
+                                 '^set/noan', 'unset/announce', 'unset/announce',
+                                 '^set/nodxg', 'unset/dxgrid', 'unset/dxgrid',
+                                 '^set/nodx', 'unset/dx', 'unset/dx',
+                                 '^set/noe', 'unset/echo', 'unset/echo',
+                                 '^set/nota', 'unset/talk', 'unset/talk',
+                                 '^set/noww', 'unset/wwv', 'unset/wwv',
+                                 '^set/nowx', 'unset/wx', 'unset/wx',
+                                 '^set/nosk', 'set/wantrbn none', 'set/wantrbn',
+                                 '^set/sk', 'set/wantrbn', 'set/wantrbn',
+                                 '^set$', 'apropos set', 'apropos',
+                                 '^sho?w?/u$', 'show/user', 'show/user',
+                                 '^sho?w?/bul', 'show/files bulletins', 'show/files',
+                                 '^sho?w?/co?n?\w*/a', 'show/configuration all', 'show/configuration',
+                                 '^sho?w?/co?n?\w*/n', 'show/configuration nodes', 'show/configuration',
+                                 '^sho?w?/c$', 'show/configuration', 'show/configuration',
+                                 '^sho?w?/com', 'dbavail', 'dbavail',
+                                 '^sho?w?/dbg', 'show/debug', 'show/debug',
+                                 '^sho?w?/dxcc', 'show/dx dxcc', 'show/dx',
+                                 '^sho?w?/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx',
+                                 '^sho?w?/dx/(\d+)', 'show/dx $1', 'show/dx',
+                                 '^sho?w?/dx/d(\d+)', 'show/dx from $1', 'show/dx',
+                                 '^sho?w?/fdx/(\d+)-(\d+)', 'show/dx real $1-$2', 'show/fdx',
+                                 '^sho?w?/fdx/(\d+)', 'show/dx real $1', 'show/fdx',
+                                 '^sho?w?/fdx/d(\d+)', 'show/dx real from $1', 'show/fdx',
+                                 '^sho?w?/fdx', 'show/dx real', 'show/fdx',
+                                 '^sho?w?/grou?p?s?', 'show/groups', 'show/groups',
+                                 '^sho?w?/gr[ae]?y?l?i?n?e?', 'show/grayline', 'show/grayline',
+                                 '^sho?w?/myfd?x?/(\d+)-(\d+)', 'show/dx filter real $1-$2', 'show/mydx',
+                                 '^sho?w?/myfd?x?/(\d+)', 'show/dx filter real $1', 'show/mydx',
+                                 '^sho?w?/myfd?x?/d(\d+)', 'show/dx filter real from $1', 'show/mydx',
+                                 '^sho?w?/myfd?x?', 'show/dx filter real', 'show/mydx',
+                                 '^sho?w?/myd?x?/(\d+)-(\d+)', 'show/dx filter $1-$2', 'show/mydx',
+                                 '^sho?w?/myd?x?/(\d+)', 'show/dx filter $1', 'show/mydx',
+                                 '^sho?w?/myd?x?/d(\d+)', 'show/dx filter from $1', 'show/mydx',
+                                 '^sho?w?/myd?x?', 'show/dx filter', 'show/mydx',
+                                 '^sho?w?/newco?n?\w*/n', 'show/newconfiguration node', 'show/newconfiguration',
+                                 '^sho?w?/sta?$', 'show/station', 'show/station',
+                                 '^sho?w?/tnc', 'who', 'who',
+                                 '^sho?w?/u$', 'show/user', 'show/user',
+                                 '^sho?w?/up', 'show/cluster', 'show/cluster',
+                                 '^sho?w?/ww?v?/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv',
+                                 '^sho?w?/ww?v?/(\d+)', 'show/wwv $1', 'show/wwv',
+                                 '^sho?w?$', 'apropos show', 'apropos',
+                                 '^shutd?\w*$', 'shutdown', 'shutdown',
+                                 '^sp$', 'send', 'send',
+                                 '^sta?t?$', 'apropos stat', 'apropos',
        
-    ],
-       't' => [
-         '^ta$', 'talk', 'talk',
-         '^t$', 'talk', 'talk',
-       ],
-       'u' => [
-       '^uns?e?t?$', 'apropos unset', 'apropos',
-       '^uns?e?t?/node$', 'set/user', 'set/user',
-       ],
-       'v' => [
-       ],
-       'w' => [
-         '^w$', 'who', 'who',
-         '^wx/full', 'wx full', 'wx',
-         '^wx/sysop', 'wx sysop', 'wx',
-       ],
-       'x' => [
-       ],
-       'y' => [
-       ],
-       'z' => [
-       ],
-)
+                                ],
+                 't' => [
+                                 '^ta$', 'talk', 'talk',
+                                 '^t$', 'talk', 'talk',
+                                ],
+                 'u' => [
+                                 '^uns?e?t?$', 'apropos unset', 'apropos',
+                                 '^uns?e?t?/dbg$', 'unset/debug', 'unset/debug',
+                                 '^uns?e?t?/node$', 'set/user', 'set/user',
+                                 '^uns?e?t?/sk', 'set/wantrbn none', 'set/wantrbn',
+                                ],
+                 'v' => [
+                                ],
+                 'w' => [
+                                 '^w$', 'who', 'who',
+                                 '^wx/full', 'wx full', 'wx',
+                                 '^wx/sysop', 'wx sysop', 'wx',
+                                ],
+                 'x' => [
+                                ],
+                 'y' => [
+                                ],
+                 'z' => [
+                                ],
+                );
+
index 244688d99efea04bbac4ee37b8ad654d5f96c872..65153473da6a48eba9379697e09d96988f488019 100644 (file)
@@ -107,6 +107,7 @@ You can use the tag 'all' to accept everything eg:
 
 
 === 0^ACCEPT/SPOTS [0-9] <pattern>^Set an 'accept' filter line for spots
+=== 0^ACCEPT/RBN [0-9] <pattern>^Set an 'accept' filter line for RBN spots
 Create an 'accept this spot' line for a filter. 
 
 An accept filter line means that if the spot matches this filter it is
@@ -1119,6 +1120,98 @@ is a good indication of the quality of the link.  The actual time
 it takes is output to the console in seconds.
 Any visible cluster node can be PINGed.
 
+=== 0^RBN^The Reverse Beacon or Skimmer System
+DXSpider now has the ability to show spots from the Reverse Beacon Network
+or "Skimmers", if your sysop has enabled the feed(s) (and has the bandwidth
+to both receive the feeds and also to pass them on to you.
+
+Currently there are two RBN/Skimmer feeds available which, at busy
+times can send up to 50,000 spots/hour EACH. Somewhere in the low
+1000s is more normal. Clearly this is not much use to the average user
+and so DXSpider "curates" them by removing duplicates and checking for
+invalid callsigns or prefixes, as well as using some algorithms to fix
+the rather variable frequencies that some skimmers produce
+(particularly for CW spots).
+
+This means that the format of the spot that you see is completely
+different to the spots that the RBN feeds supply and, as a result of
+the "curation" reduces the volume of spots to you by between 8 and 11
+times.
+
+See SET/SKIMMER (or SET/WANTRBN) for more information on enabling
+RBN/Skimmer spots and also on selecting particular categories (e.g CW
+or FT8/FT4) - which has the side benefit of reducing the volume of
+spots that you receive even more!
+
+Here are some examples of the output:
+
+DX de LZ4UX-#:    14015.5 ON7TQ        CW   6dB Q:9 Z:5,14,15,40   14 0646Z 20
+DX de VE7CC-#:     3573.0 N8ADO        FT8 -14dB Q:4 Z:4,5          4 0647Z  3
+DX de DM7EE-#:    14027.5 R1AC         CW   9dB Q:9* Z:5,15,17,20  16 0643Z 14
+DX de WE9V-#:      7074.0 EA7ALL       FT8 -9dB Q:2+ Z:5           14 0641Z  4
+
+Note that UNSET/DXGRID, UNSET/DXITU and SET/DXCQ are in operation in
+these examples. This is completely optional.
+
+The comment field has been completely changed in order provide as much
+information, in as smaller space, as possible. All the irrelevant
+information has been removed.
+
+You can use the Category (CW and FT8 in these examples) to with
+SET/SKIMMER (or SET/WANTRBN) to, rather coarsely, select which spots
+you require. You can refine this further by the use of Filtering. See
+SET/SKIMMER or SET/WANTRBN for more information. But the short answer
+is that these are spots and are filtered like any other spot, unless
+you want to filter these spots differently, in which case you can use
+REJECT/RBN and ACCEPT/RBN in exactly the same way as ACCEPT/SPOT and
+REJECT/SPOT. If you don't use RBN filters then these spots will be
+filter by any spot filters that you may have.
+
+The next field (6dB, -14dB etc) is the LOWEST reported signal that was
+heard.
+
+The Q: field is the number of skimmers that heard this spot (up to 9
+shown, but it could easily be many more). If Q: is > 1 (especially on
+CW) then you can be reasonably certain that the callsign is accurate,
+especially on CW. 'Q' stands for "Qualitee" :-)
+
+If there is a '*', it means that there was a disagreement about
+frequency. In fact, particularly for CW spots, I have see
+disagreements of 600Hz. Which is a worry. The frequency that is shown
+is the majority view of all the skimmers spotting this call. You may
+have to fossick about the airwaves to find the actual frequency :-)
+
+There are stations that are permanently on, like Beacons, and also
+others that have long sessions on the same frequency and do a lot of
+CQing. If they have been on for a certain length of time and they
+reappear before their cache entry expires (about 2 hours), then they
+are respotted. This is indicated by the '+'. NOTE - if they change
+frequency, this will generate new spots. Each callsign/frequency pair
+could respotted separately for as long as any individual
+callsign/frequency pair remain in the cache.
+
+The Z: field is present then that indicates the other CQ zones that
+heard this spot - not including the skimmer that is shown. I show as
+many as there are in whatever space is left in the comment
+field. Note: if you have any of the optional flags around the time
+then they may overwrite part of this field.
+
+If there is NO filter in operation, then the skimmer spot with the
+LOWEST signal strength will be shown. This implies that if any extra
+Z: zones are shown, then the signal will be higher in those zones.
+
+If you have a filter (for instance: ACCEPT/SPOT by_zone 14 and not
+zone 14 or zone 14 and not by_zone 14) where '14' is your QTH CQ
+zone. You will, instead be served with the lowest signal strength spot
+that satisfies that filter. Incidentally, this particular style of
+filter is quite useful for RBN spots, as it reduces the volume and is
+likely to be more relevant for casual use. If this filter is too broad
+(or narrow) for your normal spotting requirements, then you can use
+ACCEPT/RBN with the same filter specification and it will only apply
+to RBN spots. You can also replace '14' with a list like '14,15' if
+you want to broaden it out. You will still get the same Z: list (if
+any) whether you filter or not.
+
 === 1^RCMD <node call> <cmd>^Send a command to another DX Cluster
 This command allows you to send nearly any command to another DX Cluster
 node that is connected to the system. 
@@ -1185,6 +1278,7 @@ default for nodes and users eg:-
   reject/ann user_default by G,M,2
 
 === 0^REJECT/SPOTS [0-9] <pattern>^Set a 'reject' filter line for spots
+=== 0^REJECT/RBN [0-9] <pattern>^Set a 'reject' filter line for RBN spots
 Create a 'reject this spot' line for a filter. 
 
 A reject filter line means that if the spot matches this filter it is
@@ -1890,6 +1984,16 @@ correctly (assuming your locator is correct ;-). For example:-
 Tell the system where you are. For example:-
   SET/QTH East Dereham, Norfolk
 
+=== 9^SET/RBN <call> ...^Mark this call as an RBN node
+This will mark this callsign as a Reverse Beacon
+Network client. It's not a node in the normal sense of that word
+in DXSpider. But it will generate spots from the RBN/Skimmers and
+will act like a specialised node just for RBN spots.
+
+You will need to use this command to create your skimmer node
+connections. Normally one per RBN port (7000, 7001) but, in principle
+you could connect to any skimmer that uses the same spot format.
+
 === 9^SET/REGISTER <call> ...^Mark a user as registered
 === 9^UNSET/REGISTER <call> ...^Mark a user as not registered
 Registration is a concept that you can switch on by executing the
@@ -1958,6 +2062,70 @@ Conflicts with: SET/DXCQ, SET/DXITU
 
 Do a STAT/USER to see which flags you have set if you are confused.  
 
+=== 0^SET/WANTRBN^[category ..]^Allow (some) RBN/Skimmer spots
+=== 0^SET/SKIMMER^[category ..]^Allow (some) RBN/Skimmer spotsT
+=== 0^UNSET/WANTRBN^Stop all RBN/Skimmer spots
+=== 0^UNSET/SKIMMER^Stop all RBN/Skimmer spots
+=== 9^SET/WANTRBN^<call> [category ..]^Allow (some) RBN/Skimmer spots
+=== 9^SET/SKIMMER^<call> [category ..]^Allow (some) RBN/Skimmer spots
+This command allows curated Reverse Beacon Spots to come out on your
+terminal (or not).
+
+If you want everything just type:
+
+   set/wantrbn
+or     
+   set/skimmer
+
+Either command will do.
+
+If you want it all to just stop type:
+
+   unset/skimmer        (or unset/wantrbn)
+or
+   set/skimmer none
+
+There five categories (or modes) of RBN/Skimmer spot available and one
+can limit the spots to one or more of these categories/modes:
+
+   CW BEACON PSK RTTY FT
+
+together with a load of synonyms
+
+   BEACON BCN DXF
+   PSK FSK MSK
+   FT FT8 FT4
+
+if you use
+
+   set/skimmer psk ft8
+
+you will get psk, fsk, msk, ft4 and ft8 spots. if you want to break
+that down, then you will need to set filters accordingly - but your
+filter will only be offered spots from the categories that you have
+selected.
+
+If you get into a muddle with this you can simply reset 'all on'
+with SET/SKIMMER or 'all off' with UNSET/SKIMMER.
+
+By default any filters that you have for "manual" spots will be
+automatically applied to your RBN/Skimmer feed. However it is possible
+to filter RBN/Skimmer spots differently by use ACCEPT/RBN and/or
+REJECT/RBN filters.
+
+The RBN filters completely override any spot filters for these
+spots. But the spot filters will continue to filter "manual" spots as
+before.
+
+NOTE: Filters and this command CAN interact with each other. If you
+don't get the results that you expect, check your filters with
+SHOW/FILTER.
+
+Please see HELP RBN for an explanation of the spot format. It is NOT
+the same as one would get directly from the RBN/Skimmers. But it is
+recommended that you SET/DXCQ and UNSET/DXITU and UNSET/DXGRID (unless
+latter in more important to you with, for example, FT4/8 spots).
+
 === 0^SET/WCY^Allow WCY messages to come out on your terminal
 === 0^UNSET/WCY^Stop WCY messages coming out on your terminal
 
index 774d83848a3dbebaab2b83f59b2fba7a74cb6450..45b03d75e2f51bb886753f987556b4cdc0a652e8 100644 (file)
@@ -7,9 +7,9 @@ my $self = shift;
 my $line = shift;;
 return (1, $self->msg('e5')) unless $self->priv >= 9;
 
+my $line ||= 'user_json';
 my ($fn, $flag) = split /\s+/, $line;
-$fn ||= 'user_asc';
-unless ($fn && $fn eq 'user_asc') {
+unless ($fn && $fn eq 'user_json') {
        $fn =~ s|[/\.]||g;
        $fn = "/tmp/$fn";
 }
index b17382294f6e17cb4f20833a088a3688533e79ff..679864c0077576eb82f43ec7e212500c45c93398 100644 (file)
@@ -5,4 +5,6 @@ my $self = shift;
 return (1, $self->msg('e5')) if $self->priv < 9;
 QSL::finish();
 my $r = QSL::init(1);
-return (1, $r ? $self->msg('ok') : $self->msg('e2', "$!"));
+my @out;
+push @out, $self->msg($r ? 'ok':'e2', "$!");
+return (1, @out);
index f4aa86e225a78eb089ce50d819d7548963e74061..e4528c339ccafbc1abf70f461e8e5e0ec2359ac3 100644 (file)
 #
 
 my ($self, $line) = @_;
-my @args = split /\s+/, $line;
+my @args = split /\s+/, uc $line;
 my $call;
 my @out;
 
-@args = $self->call if (!@args || $self->priv < 9);
+my @calls;
+my @want;
 
-foreach $call (@args) {
+dbg('set/skimmer @args = "' . join(', ', @args) . '"') if isdbg('set/skim');
+
+while (@args) {
+       my $a = shift @args;
+       dbg("set/skimmer \$a = $a") if isdbg('set/skim');;
+       if ($a !~ /^(?:FT|BCN|BEA|DXF|CW|PSK|MSK|FSK|RTT|NO)/ && is_callsign($a)) {
+               return (1, $self->msg('e5')) if $a ne $self->call       && $self->priv < 9;
+               push @calls, $a;
+               next;
+       }
+       last unless $a;
+
+       dbg("set/skimmer \$a = $a") if isdbg('set/skim');;
+
+       my ($want) = $a =~ /^(FT|BCN|BEA|DXF|CW|PSK|MSK|FSK|RTT|NO)/;
+       return (1, $self->msg('e39', $a)) unless $want;
+       push @want, $want;
+}
+
+dbg('set/skimmer @calls = "' . join(', ', @calls) . '"') if isdbg('set/skim');
+dbg('set/skimmer @want = "' . join(', ', @want) . '"') if isdbg('set/skim');
+
+my $s = '';
+
+push @calls, $self->call unless @calls;
+
+foreach $call (@calls) {
        $call = uc $call;
        my $user = DXUser::get_current($call);
        if ($user) {
+
+               dbg(sprintf("set/skimmer before rbn:%d ft:%d bcn:%d cw:%d psk:%d rtty:%d",
+                                       $user->wantrbn,
+                                       $user->wantft,
+                                       $user->wantbeacon,
+                                       $user->wantcw,
+                                       $user->wantpsk,
+                                       $user->wantrtty,
+                                  )) if isdbg('set/skim');
+               
                $user->wantrbn(1);
+               if (@want) {
+                       $user->wantft(0);
+                       $user->wantbeacon(0);
+                       $user->wantcw(0);
+                       $user->wantpsk(0);
+                       $user->wantrtty(0);
+                       for (@want) {
+                               $user->wantrbn(0) if /^NO/;
+                               $user->wantft(1) if /^FT/;
+                               $user->wantbeacon(1) if /^BCN|BEA|DXF/;
+                               $user->wantcw(1) if /^CW/;
+                               $user->wantpsk(1) if /^PSK|MSK|FSK/;
+                               $user->wantrtty(1) if /^RT/;
+                       }
+               } elsif ($user->wantrbn) {
+                       $user->wantft(1);
+                       $user->wantbeacon(1);
+                       $user->wantcw(1);
+                       $user->wantpsk(1);
+                       $user->wantrtty(1);
+               } else {
+                       $user->wantft(0);
+                       $user->wantbeacon(0);
+                       $user->wantcw(0);
+                       $user->wantpsk(0);
+                       $user->wantrtty(0);
+               }
+
+               dbg(sprintf("set/skimmer after rbn:%d ft:%d bcn:%d cw:%d psk:%d rtty:%d",
+                                       $user->wantrbn,
+                                       $user->wantft,
+                                       $user->wantbeacon,
+                                       $user->wantcw,
+                                       $user->wantpsk,
+                                       $user->wantrtty,
+                                  )) if isdbg('set/skim');
+               
+               my $s = '';
+               if (@want) {
+                       @want = ();                     # variable reuse!!
+                       push @want, 'CW' if $user->wantcw;
+                       push @want, 'BEACONS' if $user->wantbeacon;
+                       push @want, 'PSK, FSK' if $user->wantpsk;
+                       push @want, 'RTTY' if $user->wantrtty;
+                       push @want, 'FT8 & FT4' if $user->wantft;
+                   $s = join(', ', @want) if @want && $user->wantrbn;
+               } 
+               
+               dbg("set/skimmer \$s = $s") if isdbg('set/skim');;
+               dbg('set/skimmer @want NOW = "' . join(', ', @want) . '"') if isdbg('set/skim');
+               
+               $s ||= $user->wantrbn ? 'ALL MODES' : 'NONE';
                $user->put;
-               push @out, $self->msg('wante', 'RBN', $call);
-       } else {
-               push @out, $self->msg('e3', "Set wantrbn", $call);
+               push @out, $self->msg('skims', $call, $s);
+       }
+       else {
+               push @out, $self->msg('e3', "Set Skimmer", $call);
        }
 }
 return (1, @out);
index b41cd93f0bcd0575128556c775c64cd261b048d0..f8e711776d9c3ef4afdb017231593d8113641979 100644 (file)
@@ -16,7 +16,6 @@
 
 my ($self, $line) = @_;
 return (1, $self->msg('e5')) unless $self->priv >= 1;
-return (1, $self->msg('storable')) unless $DXUser::v3;
 
 my @call = map {uc $_} split /\s+/, $line; 
 my @out;
@@ -29,9 +28,10 @@ if (@call == 0) {
        shift @call;
        my ($action, $key, $data) = (0,0,0);
        for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
-               if ($data =~ m{\01[ACRSX]\0\0\0\04sort}) {
-                   push @call, $key;
-                       ++$count;
+               if (iscallsign($key)) {
+                       if ($data =~ /"sort":"[ACRSX]"/) {
+                               push @call, $key;
+                       }
                }
        }
 }
index 729675be0685da73848d16f6c648c291daa7e111..bef5626d9e30a998aabbb6ccf70115a77362bdc2 100644 (file)
@@ -516,7 +516,7 @@ sub run_cmd
 
                # check cmd
                if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) {
-                       LogDbg('DXCommand', "cmd: invalid characters in '$cmd'");
+                       LogDbg('DXCommand', "cmd: $self->{call} - invalid characters in '$cmd'");
                        return $self->_error_out('e1');
                }
 
@@ -996,38 +996,37 @@ sub format_dx_spot
 
        my $t = ztime($_[2]);
        my $loc = '';
-       my $clth = $self->{consort} eq 'local' ? 29 : 30;
+       my $clth = 30;
+       #       --$clth if $self->{consort} eq 'local';
+       
        my $comment = substr (($_[3] || ''), 0, $clth);
        $comment .= ' ' x ($clth - (length($comment)));
-       if ($self->{user}->wantgrid) {
+       
+    if ($self->{user}->wantgrid) {
                my $ref = DXUser::get_current($_[1]);
                if ($ref && $ref->qra) {
-                       $loc = ' ' . substr($ref->qra, 0, 4);
-                       $comment = substr $comment, 0,  ($clth - (length($comment)+length($loc)));
-                       $comment .= $loc;
-                       $loc = '';
+                       my $cloc = ' ' . substr($ref->qra, 0, 4);
+                       $comment = substr $comment, 0,  ($clth - (length($comment)+length($cloc)));
+                       $comment .= $cloc;
                }
-       }
-       
-       if ($self->{user}->wantgrid) {
-               my $ref = DXUser::get_current($_[4]);
+               my $origin = $_[4];
+               $origin =~ s/-#$//;                     # sigh......
+               $ref = DXUser::get_current($origin);
                if ($ref && $ref->qra) {
                        $loc = ' ' . substr($ref->qra, 0, 4);
                }
-       }
-
-       if ($self->{user}->wantdxitu) {
+       } elsif ($self->{user}->wantdxitu) {
                $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; 
+               $comment = substr($comment, 0,  $clth-3) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; 
        } elsif ($self->{user}->wantdxcq) {
                $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; 
+               $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; 
        } elsif ($self->{user}->wantusstate) {
                $loc = ' ' . $_[13] if $_[13];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . $_[12] if $_[12]; 
+               $comment = substr($comment, 0,  $clth-3) . ' ' . $_[12] if $_[12]; 
        }
 
-       return sprintf "DX de %-7.7s%11.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
+       return sprintf "DX de %-9.9s%10.1f %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
 }
 
 # send a dx spot
index 28ae8fe56281137a056bac41954fa6013c1f8481..fcc60b86ded201972dbe8b9d7c7dd74a03f8b4ad 100644 (file)
@@ -119,8 +119,8 @@ sub dbg
                my @l = split /\n/, $r;
                foreach my $l (@l) {
                        $l =~ s/([\x00-\x08\x0B-\x1f\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
-                       print "$l\n" if defined \*STDOUT && !$no_stdout;
                        my $tag = $_isdbg ? "($_isdbg) " : '(*) ';
+                       print "$tag$l\n" if defined \*STDOUT && !$no_stdout;
                        my $str = "$t^$tag$l";
                        &$callback($str) if $callback;
                        if ($dbgringlth) {
@@ -130,6 +130,7 @@ sub dbg
                        $fp->writeunix($t, $str) unless !$fp || $dbglevel{"nolog$_isdbg"} ; 
                }
        }
+       $_isdbg = '';
 }
 
 sub dbginit
@@ -182,6 +183,7 @@ sub dbgdump
        my $l = shift;
        my $m = shift;
        if ($dbglevel{$l} || $l eq 'err') {
+               my @out;
                foreach my $l (@_) {
                        for (my $o = 0; $o < length $l; $o += 16) {
                                my $c = substr $l, $o, 16;
@@ -189,11 +191,12 @@ sub dbgdump
                                $c =~ s/[\x00-\x1f\x7f-\xff]/./g;
                                my $left = 16 - length $c;
                                $h .= ' ' x (2 * $left) if $left > 0;
-                               dbg($m . sprintf("%4d:", $o) . "$h $c");
+                               push @out, $m . sprintf("%4d:", $o) . "$h $c";
                                $m = ' ' x (length $m);
                        }
                }
-       }
+               dbg(@out) if isdbg($l); # yes, I know, I have my reasons;
+       } 
 }
 
 sub dbgadd
index 0b72a680f363a4bbcf45f6912217c110ccec5f6b..267c68ed9d3c6d86e70efb37761ac9f8de8d22cb 100644 (file)
@@ -17,6 +17,10 @@ use DXDebug;
 use DXUtil;
 use LRU;
 use File::Copy;
+use Data::Structure::Util qw(unbless);
+use Time::HiRes qw(gettimeofday tv_interval);
+use IO::File;
+use JSON;
 
 use strict;
 
@@ -32,6 +36,8 @@ $tooold = 86400 * 365;                # this marks an old user who hasn't given enough info to
 $v3 = 0;
 our $maxconnlist = 3;                  # remember this many connection time (duration) [start, end] pairs
 
+my $json;
+
 # hash of valid elements and a simple prompt
 %valid = (
                  call => '0,Callsign',
@@ -89,7 +95,7 @@ our $maxconnlist = 3;                 # remember this many connection time (duration) [start,
                  wantcw => '0,Want RBN CW,yesno',
                  wantrtty => '0,Want RBN RTTY,yesno',
                  wantpsk => '0,Want RBN PSK,yesno',
-                 wantbeacon => '0,Want (RBN) Beacon,yesno',
+                 wantbeacon => '0,Want RBN Beacon,yesno',
                  lastoper => '9,Last for/oper,cldatetime',
                  nothere => '0,Not Here Text',
                  registered => '9,Registered?,yesno',
@@ -101,7 +107,7 @@ our $maxconnlist = 3;                       # remember this many connection time (duration) [start,
                  maxconnect => '1,Max Connections',
                  startt => '0,Start Time,cldatetime',
                  connlist => '1,Connections,parraydifft',
-                 width => '0,Preferred Width'
+                 width => '0,Preferred Width',
                 );
 
 #no strict;
@@ -129,73 +135,34 @@ sub init
 {
        my $mode = shift;
   
-       my $ufn;
-       my $convert;
-       
-       eval {
-               require Storable;
-       };
-
+   $json = JSON->new->canonical(1);
        my $fn = "users";
-       
-       if ($@) {
-               $ufn = localdata("users.v2");
-               $v3 = $convert = 0;
-               dbg("the module Storable appears to be missing!!");
-               dbg("trying to continue in compatibility mode (this may fail)");
-               dbg("please install Storable from CPAN as soon as possible");
-       } else {
-               import Storable qw(nfreeze thaw);
-
-               $ufn = localdata("users.v3");
-               $v3 = 1;
-               $convert++ if -e localdata("users.v2") && !-e $ufn;
-       }
-       
-       if ($mode) {
-               $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
-       } else {
-               $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
+       $filename = localdata("$fn.v3j");
+       unless (-e $filename || $mode == 2) {
+               LogDbg('DXUser', "New User File version $filename does not exist, running conversion from users.v3 or v2, please wait");
+               system('/spider/perl/convert-users-v3-to-v3j.pl');
+               init(1);
+               export();
+               return;
        }
-
-       die "Cannot open $ufn ($!)\n" unless $dbm;
-
-       $lru = LRU->newbase("DXUser", $lrusize);
-       
-       # do a conversion if required
-       if ($dbm && $convert) {
-               my ($key, $val, $action, $count, $err) = ('','',0,0,0);
-               
-               my %oldu;
-               dbg("Converting the User File to V3 ");
-               dbg("This will take a while, I suggest you go and have cup of strong tea");
-               my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]";
-        for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
-                       my $ref;
-                       eval { $ref = asc_decode($val) };
-                       unless ($@) {
-                               if ($ref) {
-                                       $ref->put;
-                                       $count++;
-                               } else {
-                                       $err++
-                               }
-                       } else {
-                               Log('err', "DXUser: error decoding $@");
-                       }
-               } 
-               undef $odbm;
-               untie %oldu;
-               dbg("Conversion completed $count records $err errors");
+       if (-e $filename || $mode == 2) {
+               $lru = LRU->newbase("DXUser", $lrusize);
+               if ($mode) {
+                       $dbm = tie (%u, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
+               } else {
+                       $dbm = tie (%u, 'DB_File', $filename, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
+               }
        }
-       $filename = $ufn;
+       die "Cannot open $filename ($!)\n" unless $dbm || $mode == 2;
+       return;
 }
 
+# delete files with extreme prejudice
 sub del_file
 {
        # with extreme prejudice
-       unlink "$main::data/users.v3";
-       unlink "$main::local_data/users.v3";
+       unlink "$main::data/users.v3j";
+       unlink "$main::local_data/users.v3j";
 }
 
 #
@@ -338,60 +305,37 @@ sub put
        $dbm->put($call, $ref);
 }
 
-# freeze the user
-sub encode
-{
-       goto &asc_encode unless $v3;
-       my $self = shift;
-       return nfreeze($self);
-}
 
 # thaw the user
 sub decode
 {
-       goto &asc_decode unless $v3;
-       my $ref;
-       $ref = thaw(shift);
-       return $ref;
+    my $s = shift;
+    my $ref;
+    eval { $ref = $json->decode($s) };
+    if ($ref && !$@) {
+        return bless $ref, 'DXUser';
+    } else {
+        LogDbg('DXUser', "DXUser::json_decode: on '$s' $@");
+    }
+    return undef;
 }
 
-# 
-# create a string from a user reference (in_ascii)
-#
-sub asc_encode
+# freeze the user
+sub encode
 {
-       my $self = shift;
-       my $strip = shift;
-       my $p;
-
-       if ($strip) {
-               my $ref = bless {}, ref $self;
-               foreach my $k (qw(qth lat long qra sort call homenode node lastoper lastin)) {
-                       $ref->{$k} = $self->{$k} if exists $self->{$k};
-               }
-               $ref->{name} = $self->{name} if exists $self->{name} && $self->{name} !~ /selfspot/i;
-               $p = dd($ref);
+    my $ref = shift;
+    unbless($ref);
+    my $s;
+       
+       eval {$s = $json->encode($ref) };
+       if ($s && !$@) {
+               bless $ref, 'DXUser';
+               return $s;
        } else {
-               $p = dd($self);
+               LogDbg('DXUser', "DXUser::json_encode $ref->{call}, $@");
        }
-       return $p;
 }
 
-#
-# create a hash from a string (in ascii)
-#
-sub asc_decode
-{
-       my $s = shift;
-       my $ref;
-       $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
-       eval '$ref = ' . $s;
-       if ($@) {
-               LogDbg('err', "DXUser::asc_decode: on '$s' $@");
-               $ref = undef;
-       }
-       return $ref;
-}
 
 #
 # del - delete a user
@@ -448,10 +392,10 @@ sub fields
 
 sub export
 {
-       my $name = shift || 'user_asc';
+       my $name = shift || 'user_json';
        my $basic_info_only = shift;
 
-       my $fn = $name ne 'user_asc' ? $name : "$main::local_data/$name";                       # force use of local
+       my $fn = $name ne 'user_json' ? $name : "$main::local_data/$name";                       # force use of local
        
        # save old ones
        move "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
@@ -460,6 +404,7 @@ sub export
        move "$fn.o", "$fn.oo" if -e "$fn.o";
        move "$fn", "$fn.o" if -e "$fn";
 
+       my $ta = [gettimeofday];
        my $count = 0;
        my $err = 0;
        my $del = 0;
@@ -503,35 +448,39 @@ BEGIN {
 }
 
 use SysVar;
+use DXUtil;
 use DXUser;
+use JSON;
+use Time::HiRes qw(gettimeofday tv_interval);
+package DXUser;
 
-if (@ARGV) {
-       $main::userfn = shift @ARGV;
-       print "user filename now $userfn\n";
-}
+our $json = JSON->new->canonical(1);
 
-package DXUser;
+my $ta = [gettimeofday];
+our $filename = "$main::local_data/users.v3j";
+my $exists = -e $filename ? "OVERWRITING" : "CREATING"; 
+print "perl user_json $exists $filename\n";
 
 del_file();
-init(1);
+init(2);
 %u = ();
 my $count = 0;
 my $err = 0;
 while (<DATA>) {
        chomp;
        my @f = split /\t/;
-       my $ref = asc_decode($f[1]);
+       my $ref = decode($f[1]);
        if ($ref) {
                $ref->put();
                $count++;
-        DXUser::sync() unless $count % 10000;
        } else {
                print "# Error: $f[0]\t$f[1]\n";
                $err++
        }
 }
 DXUser::sync(); DXUser::finish();
-print "There are $count user records and $err errors\n";
+my $diff = _diffms($ta);
+print "There are $count user records and $err errors in $diff mS\n";
 };
                print $fh "__DATA__\n";
 
@@ -561,7 +510,7 @@ print "There are $count user records and $err errors\n";
                                        }
                                }
                                # only store users that are reasonably active or have useful information
-                               print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n";
+                               print $fh "$key\t" . encode($ref) . "\n";
                                ++$count;
                        } else {
                                LogDbg('DXCommand', "Export Error3: '$key'\t" . carp($val) ."\n$@");
@@ -572,7 +521,8 @@ print "There are $count user records and $err errors\n";
                } 
         $fh->close;
     }
-       my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors ('sh/log Export' for details)};
+       my $diff = _diffms($ta);
+       my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors in $diff mS ('sh/log Export' for details)};
        LogDbg('command', $s);
        return $s;
 }
@@ -728,7 +678,7 @@ sub wanttalk
 
 sub wantgrid
 {
-       return _want('grid', @_);
+       return _wantnot('grid', @_);
 }
 
 sub wantemail
@@ -763,12 +713,12 @@ sub wantusstate
 
 sub wantdxcq
 {
-       return _want('dxcq', @_);
+       return _wantnot('dxcq', @_);
 }
 
 sub wantdxitu
 {
-       return _want('dxitu', @_);
+       return _wantnot('dxitu', @_);
 }
 
 sub wantgtk
index d23cb92ea7daa952d57c1deacaa843aa6b329f19..f7e52c9a92cb727e8c5431c4f9cd4d2d63e3d5e7 100644 (file)
@@ -385,7 +385,7 @@ sub is_callsign
        return $_[0] =~ m!^
                                          (?:\d?[A-Z]{1,2}\d{0,2}/)?    # out of area prefix /  
                                          (?:\d?[A-Z]{1,2}\d{1,5})      # main prefix one (required) - lengthened for special calls 
-                                         [A-Z]{1,5}                # callsign letters (required)
+                                         [A-Z]{1,8}                # callsign letters (required)
                                          (?:-(?:\d{1,2}))?         # - nn possibly (eg G8BPQ-8)
                                          (?:/[0-9A-Z]{1,7})?       # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly
                                          $!x;
index 44846c53312f12a370b2babd6cd5acd888605c4d..6b3a30b1c0f00624fa573fc79c35cba28eb314a4 100644 (file)
@@ -64,6 +64,24 @@ sub echo
        $conn->{echo} = shift;
 }
 
+sub _rcv
+{
+    my $conn = shift; # $rcv_now complement of $flush
+       my $msg = shift;
+    my $sock = $conn->{sock};
+    return unless defined($sock);
+       return if $conn->{disconnecting};
+
+       if ($conn->{state} eq 'WL' && $conn->{sort} =~ /^I/ && $msg =~ /^PROXY/) {
+               my $echo = $conn->{echo};
+               $conn->{echo} = 0;
+               $conn->SUPER::_rcv($msg);
+               $conn->{echo} = $echo;
+       } else {
+               $conn->SUPER::_rcv($msg);
+       }
+}
+
 sub dequeue
 {
        my $conn = shift;
@@ -99,7 +117,19 @@ sub dequeue
                                &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
                        } elsif ($conn->{state} eq 'WL' ) {
                                $msg = uc $msg;
-                               if (is_callsign($msg)) {
+                               if ($conn->{sort} =~ /^I/ && (my ($ip, $from) = $msg =~ /^PROXY TCP[46] ([\da-fA-F:\.]+) ([\da-fA-F:\.]+)/) ) {
+                                       # SOMEONE appears to have affixed an HA Proxy to my connection
+                                       $ip =~ s|^::ffff:||; # chop off leading pseudo IPV6 stuff on dual stack listeners
+                                       $from =~ s|^::ffff:||;
+                                       if ($from eq $conn->{peerhost}) {
+                                               dbg("ExtMsg: connect - PROXY IP change from '$conn->{peerhost}' -> '$ip'");
+                                               $conn->{peerhost} = $ip;
+                                       } else {
+                                               dbg("ExtMsg: connect - PROXY someone ($from) is trying to spoof '$ip'");
+                                               $conn->send_now("Sorry $msg is an invalid callsign");
+                                               $conn->disconnect;
+                                       }
+                               } elsif (is_callsign($msg)) {
                                        if ($main::allowslashcall || $msg !~ m|/|) {
                                                my $sort = $conn->{csort};
                                                $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1';
@@ -170,7 +200,7 @@ sub new_client {
        $conn->_send_file(localdata("issue"));
        $conn->send_raw("login: ");
        $conn->_dotimeout(60);
-       $conn->{echo} = 1;
+#      $conn->{echo} = 1;
 }
 
 sub start_connect
index 08a79251f230c24d839e5e8c201b4474b1bbc93e..d79eec7332065a2936ee2de47427eb9c9d7ab07a 100644 (file)
@@ -112,6 +112,7 @@ package DXM;
                                e36 => 'You can only do this in normal user prompt state',
                                e37 => 'Need at least a callsign',
                                e38 => 'This is not a valid regex',
+                               e39 => 'Sorry $_[0] is not a valid argument',
 
                                echoon => 'Echoing enabled',
                                echooff => 'Echoing disabled',
@@ -302,6 +303,7 @@ package DXM;
                                showconf => 'Node         Callsigns',
                                shu => '\"SHU\" is not enough! you need to type at least \"SHUT\" to shutdown the node',
                                shutting => '$main::mycall shutting down...',
+                               skims => 'RBN/Skimming set to $_[1] for $_[0]',
                                sloc => 'Cluster lat $_[0] long $_[1], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
                                snode1 => 'Node Call   Sort    Version',
                                snode2 => '$_[0] $_[1]  $_[2]',
index 81c2e40a0090aa09ecdeba30e94dd01ae6cd70a6..3e30372ff1111bbac4923b6837c5a01618d8d620 100644 (file)
@@ -345,9 +345,7 @@ sub _send_stuff
                my $lth = length $data;
                my $call = $conn->{call} || 'none';
                if (isdbg('raw')) {
-                       if (isdbg('raw')) {
-                               dbgdump('raw', "$call send $lth: ", $lth);
-                       }
+                       dbgdump('raw', "$call send $lth:", $data);
                }
                if (defined $sock) {
                        $sock->write($data);
index 0df7570ba24f615ac1fccce38cde2d59955588ca..d10345eda2ebbf70166ca9c42d91beae4e1e9acc 100644 (file)
@@ -8,39 +8,35 @@
 package QSL;
 
 use strict;
-use DXVars;
+use SysVar;
 use DXUtil;
 use DB_File;
 use DXDebug;
 use Prefix;
+use JSON;
+use Data::Structure::Util qw(unbless);
 
 use vars qw($qslfn $dbm $maxentries);
-$qslfn = 'qsl';
+$qslfn = 'dxqsl';
 $dbm = undef;
 $maxentries = 50;
 
-localdata_mv("$qslfn.v1");
+my %u;
+my $json;
+
+localdata_mv("$qslfn.v1j");
 
 sub init
 {
        my $mode = shift;
-       my $ufn = localdata("$qslfn.v1");
+       my $ufn = localdata("$qslfn.v1j");
 
-       Prefix::load() unless Prefix::loaded();
+       $json = JSON->new->canonical(1);
        
-       eval {
-               require Storable;
-       };
+       Prefix::load() unless Prefix::loaded();
+
+       finish() if $dbm;
        
-       if ($@) {
-               dbg("Storable appears to be missing");
-               dbg("In order to use the QSL feature you must");
-               dbg("load Storable from CPAN");
-               return undef;
-       }
-       import Storable qw(nfreeze freeze thaw);
-       my %u;
-       undef $dbm;
        if ($mode) {
                $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)";
        } else {
@@ -51,7 +47,9 @@ sub init
 
 sub finish
 {
+       $dbm->sync;
        undef $dbm;
+       untie %u;
 }
 
 sub new
@@ -119,7 +117,7 @@ sub get
        
        my $r = $dbm->get($key, $value);
        return undef if $r;
-       return thaw($value);
+       return decode($value);
 }
 
 sub put
@@ -127,8 +125,40 @@ sub put
        return unless $dbm;
        my $self = shift;
        my $key = $self->[0];
-       my $value = nfreeze($self);
+       my $value = encode($self);
        $dbm->put($key, $value);
 }
 
+sub remove_files
+{
+       unlink "$main::data/$qslfn.v1j";
+       unlink "$main::local_data/$qslfn.v1j";
+}
+
+# thaw the user
+sub decode
+{
+    my $s = shift;
+    my $ref;
+    eval { $ref = $json->decode($s) };
+    if ($ref && !$@) {
+        return bless $ref, 'QSL';
+    } 
+    return undef;
+}
+
+# freeze the user
+sub encode
+{
+    my $ref = shift;
+    unbless($ref);
+    my $s;
+       
+       eval {$s = $json->encode($ref) };
+       if ($s && !$@) {
+               bless $ref, 'QSL';
+               return $s;
+       } 
+}
+
 1;
index 6773118f0315ea621c4b658d1e9318141b76a03f..418c1cb357e45947baa9779f441cd5651fc72234 100644 (file)
@@ -11,8 +11,8 @@ package RBN;
 
 use 5.10.1;
 
-use DXUtil;
 use DXDebug;
+use DXUtil;
 use DXLog;
 use DXUser;
 use DXChannel;
@@ -20,6 +20,8 @@ use Math::Round qw(nearest);
 use Date::Parse;
 use Time::HiRes qw(clock_gettime CLOCK_REALTIME);
 use Spot;
+use JSON;
+use IO::File;
 
 our @ISA = qw(DXChannel);
 
@@ -34,11 +36,34 @@ our $minspottime = 60*60;           # the time between respots of a callsign - if a call
 
 our $beacontime = 5*60;                        # same as minspottime, but for beacons (and shorter)
 
-our $dwelltime = 6;                    # the amount of time to wait for duplicates before issuing
+our $dwelltime = 10;                   # the amount of time to wait for duplicates before issuing
                                 # a spot to the user (no doubt waiting with bated breath).
 
 our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
 
+my $spots;                                             # the GLOBAL spot cache
+
+my %runtime;                                   # how long each channel has been running
+
+our $cachefn = localdata('rbn_cache');
+our $cache_valid = 4*60;               # The cache file is considered valid if it is not more than this old
+
+my $json;
+my $noinrush = 0;                              # override the inrushpreventor if set
+
+sub init
+{
+       $json = JSON->new;
+       $spots = {};
+       if (check_cache()) {
+               $noinrush = 1;
+       }
+       if (defined $DB::VERSION) {
+               $noinrush = 1;
+               $json->indent(1);
+       }
+}
+
 sub new 
 {
        my $self = DXChannel::alloc(@_);
@@ -47,12 +72,19 @@ sub new
        my $pkg = shift;
        my $call = shift;
 
-#      DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], );
-       $self->{spot} = {};
        $self->{last} = 0;
        $self->{noraw} = 0;
        $self->{nospot} = 0;
+       $self->{nouser} = {};
        $self->{norbn} = 0;
+       $self->{noraw10} = 0;
+       $self->{nospot10} = 0;
+       $self->{nouser10} = {};
+       $self->{norbn10} = 0;
+       $self->{nospothour} = 0;
+       $self->{nouserhour} = {};
+       $self->{norbnhour} = 0;
+       $self->{norawhour} = 0;
        $self->{sort} = 'N';
        $self->{lasttime} = $main::systime;
        $self->{minspottime} = $minspottime;
@@ -117,8 +149,10 @@ sub start
                $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);  
        }
 
-       # start inrush timer
-       $self->{inrushpreventor} = $main::systime + $startup_delay;
+       # if we have been running and stopped for a while 
+       # if the cache is warm enough don't operate the inrush preventor
+       $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ?  0 : $main::systime + $startup_delay;
+       dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
 }
 
 my @queue;                                             # the queue of spots ready to send
@@ -128,7 +162,7 @@ sub normal
        my $self = shift;
        my $line = shift;
        my @ans;
-       my $spots = $self->{spot};
+#      my $spots = $self->{spot};
        
        # save this for them's that need it
        my $rawline = $line;
@@ -154,14 +188,23 @@ sub normal
        my $qra = $spd, $spd = '' if is_qra($spd);
        $u = $qra if $qra;
 
+       # is this anything like a callsign?
+       unless (is_callsign($call)) {
+               dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
+               return;
+       }
+
        $origin =~ s/\-(?:\d{1,2}\-)?\#$//; # get rid of all the crap we aren't interested in
 
 
        $sort ||= '';
        $tx ||= '';
        $qra ||= '';
-    dbg qq{or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if isdbg('rbn');
+    dbg qq{RBN:input decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if isdbg('rbn');
 
+       ++$self->{noraw};
+       ++$self->{noraw10};
+       ++$self->{norawhour};
        
        my $b;
        
@@ -217,8 +260,8 @@ sub normal
 
                # do we have it?
                my $spot = $spots->{$sp};
-               $spot = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if !$spot && exists $spots->{$spp};
-               $spot = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if !$spot && exists $spots->{$spm};
+               $spot = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if isdbg('rbn') && !$spot && exists $spots->{$spp};
+               $spot = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if isdbg('rbn') && !$spot && exists $spots->{$spm};
                
 
                # if we have one and there is only one slot and that slot's time isn't expired for respot then return
@@ -244,12 +287,11 @@ sub normal
                # here we either have an existing spot record buildup on the go, or we need to create the first one
                unless ($spot) {
                        $spots->{$sp} = $spot = [clock_gettime(CLOCK_REALTIME)];;
-                       dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . $respot ? ' RESPOT' : '') if isdbg('rbn');
+                       dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if isdbg('rbn');
                }
 
                # add me to the display queue unless we are waiting for initial in rush to finish
-               return unless $self->{inrushpreventor} < $main::systime;
-               push @{$self->{queue}}, $sp if @$spot == 1; # queue the KEY (not the record)
+               return unless $noinrush || $self->{inrushpreventor} < $main::systime;
 
                # build up a new record and store it in the buildup
                # deal with the unix time
@@ -259,14 +301,22 @@ sub normal
 
                # create record and add into the buildup
                my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
-               dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn');
                my @s =  Spot::prepare($r->[1], $r->[2], $r->[6], '', $r->[0]);
+               if ($s[5] == 666) {
+                       dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
+                       return;
+               }
+               
                if ($self->{inrbnfilter}) {
                        my ($want, undef) = $self->{inrbnfilter}->it($s);
-                       next unless $want;      
+                       return unless $want;    
                }
                $r->[9] = \@s;
 
+               push @{$self->{queue}}, $sp if @$spot == 1; # queue the KEY (not the record)
+
+               dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn');
+
                push @$spot, $r;
 
                # At this point we run the queue to see if anything can be sent onwards to the punter
@@ -292,7 +342,7 @@ sub normal
                                $quality = 9 if $quality > 9;
                                $quality = "Q:$quality";
                                if (isdbg('progress')) {
-                                       my $s = "RBN: SPOT key: '$sp' = $r->[2] on $r->[1] \@ $r->[5] $quality";
+                                       my $s = "RBN: SPOT key: '$sp' = $r->[2] on $r->[1] by $r->[0] \@ $r->[5] $quality";
                                        $s .=  " route: $self->{call}";
                                        dbg($s);
                                }
@@ -308,36 +358,57 @@ sub normal
                                dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $spot->[0] + $dwelltime - $now) if isdbg 'rbnqueue'; 
                        }
                }
-               
-
        } else {
                dbg "RBN:DATA,$line" if isdbg('rbn');
        }
+}
 
-       #       # periodic clearing out of the two caches
-       if (($tim % 60 == 0 && $tim > $self->{last}) || ($self->{last} && $tim >= $self->{last} + 60)) {
-               my $count = 0;
-               my $removed = 0;
-               while (my ($k,$v) = each %{$spots}) {
-                       if ($tim - $v->[0] > $self->{minspottime}*2) {
-                               delete $spots->{$k};
-                               ++$removed;
-                       }
-                       else {
-                               ++$count;
-                       }
+sub per_minute
+{
+       foreach my $dxchan (DXChannel::get_all()) {
+               next unless $dxchan->is_rbn;
+               dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} sent: $dxchan->{norbn} delivered: $dxchan->{nospot} users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats');
+               if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
+                       LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
+                       $dxchan->disconnect;
                }
-               dbg "RBN:ADMIN,$self->{call},spot cache remain: $count removed: $removed"; # if isdbg('rbn');
-               dbg "RBN:" . join(',', "STAT", $self->{noraw}, $self->{norbn}, $self->{nospot}) if $self->{showstats};
-               $self->{noraw} = $self->{norbn} = $self->{nospot} = 0;
-               $self->{last} = int($tim / 60) * 60;
+               $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
+               $runtime{$dxchan->{call}} += 60;
        }
-}
 
+       # save the spot cache
+       write_cache() unless $main::systime + $startup_delay < $main::systime;;
+}
 
+sub per_10_minute
+{
+       my $count = 0;
+       my $removed = 0;
+       while (my ($k,$v) = each %{$spots}) {
+               if ($main::systime - $v->[0] > $minspottime*2) {
+                       delete $spots->{$k};
+                       ++$removed;
+               }
+               else {
+                       ++$count;
+               }
+       }
+       dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
+       foreach my $dxchan (DXChannel::get_all()) {
+               next unless $dxchan->is_rbn;
+               dbg "RBN:STATS 10-minute $dxchan->{call} raw: $dxchan->{noraw10} sent: $dxchan->{norbn10} delivered: $dxchan->{nospot10} users: " . scalar keys %{$dxchan->{nousers10}};
+               $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
+       }
+}
 
-#      }
-# }
+sub per_hour
+{
+       foreach my $dxchan (DXChannel::get_all()) {
+               next unless $dxchan->is_rbn;
+               dbg "RBN:STATS hour $dxchan->{call} raw: $dxchan->{norawhour} sent: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} users: " . scalar keys %{$dxchan->{nousershour}};
+               $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
+       }
+}
 
 # we should get the spot record minus the time, so just an array of record (arrays)
 sub send_dx_spot
@@ -346,6 +417,10 @@ sub send_dx_spot
        my $quality = shift;
        my $spot = shift;
 
+       ++$self->{norbn};
+       ++$self->{norbn10};
+       ++$self->{norbnhour};
+       
        # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
 
        my $mode = $spot->[0]->[3]; # as all the modes will be the same;
@@ -362,12 +437,17 @@ sub send_dx_spot
                ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
                ++$want if $user->wantcw && $mode =~ /^CW/;
                ++$want if $user->wantrtty && $mode =~ /^RTT/;
-               ++$want if $user->wantpsk && $mode =~ /^PSK/;
-               ++$want if $user->wantcw && $mode =~ /^CW/;
+               ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
                ++$want if $user->wantft && $mode =~ /^FT/;
-               ++$want unless $want;   # send everything if nothing is selected.
 
-               next unless $want;
+               dbg(sprintf("RBN: spot selection for $dxchan->{call} mode: '$mode' want: $want flags rbn:%d ft:%d bcn:%d cw:%d psk:%d rtty:%d",
+                                       $user->wantrbn,
+                                       $user->wantft,
+                                       $user->wantbeacon,
+                                       $user->wantcw,
+                                       $user->wantpsk,
+                                       $user->wantrtty,
+                                  )) if isdbg('rbnll');
 
                # send one spot to one user out of the ones that we have
                $self->dx_spot($dxchan, $quality, $spot) if $want;
@@ -380,6 +460,8 @@ sub dx_spot
        my $dxchan = shift;
        my $quality = shift;
        my $spot = shift;
+       my $call = $dxchan->{call};
+       
 
        my $strength = 100;             # because it could if we talk about FTx
        my $saver;
@@ -388,7 +470,11 @@ sub dx_spot
        my %qrg;
        my $respot;
        my $qra;
-               
+
+       ++$self->{nousers}->{$call};
+       ++$self->{nousers10}->{$call};
+       ++$self->{nousershour}->{$call};
+       
        foreach my $r (@$spot) {
                # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
                # Spot::prepare($qrg, $call, $utz, $comment, $origin);
@@ -449,11 +535,19 @@ sub dx_spot
                        $buf = VE7CC::dx_spot($dxchan, @$saver);
                        $saver->[4] = $call;
                } else {
+                       my $call = $saver->[4];
+                       $saver->[4] = substr($call, 0, 6);
+                       $saver->[4] .= '-#';
                        $buf = $dxchan->format_dx_spot(@$saver);
+                       $saver->[4] = $call;
                }
-               $buf =~ s/^DX/RB/;
+#              $buf =~ s/^DX/RB/;
                $dxchan->local_send('N', $buf);
 
+               ++$self->{nospot};
+               ++$self->{nospot10};
+               ++$self->{nospothour};
+               
                if ($qra) {
                        my $user = DXUser::get_current($saver->[1]) || DXUser->new($saver->[1]);
                        unless ($user->qra && is_qra($user->qra)) {
@@ -465,4 +559,55 @@ sub dx_spot
        }
 }
 
+sub finish
+{
+       write_cache();
+}
+
+sub write_cache
+{
+       my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
+       my $s = $json->encode($spots);
+       $fh->print($s);
+       $fh->close;
+}
+
+sub check_cache
+{
+       if (-e $cachefn) {
+               my $mt = (stat($cachefn))[9];
+               my $t = $main::systime - $mt || 1;
+               my $p = difft($mt);
+               if ($t < $cache_valid) {
+                       dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
+                       my $fh = IO::File->new($cachefn);
+                       my $s;
+                       if ($fh) {
+                               local $/ = undef;
+                               $s = <$fh>;
+                               dbg("RBN:check_cache cache read size " . length $s);
+                               $fh->close;
+                       } else {
+                               dbg("RBN:check_cache file read error $!");
+                               return undef;
+                       }
+                       if ($s) {
+                               eval {$spots = $json->decode($s)};
+                               if ($spots && ref $spots) {
+                                       dbg("RBN:check_cache spot cache restored");
+                                       return 1;
+                               }
+                       }
+                       dbg("RBN::checkcache error decoding $@");
+               } else {
+                       my $d = difft($main::systime-$cache_valid);
+                       dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
+               }
+       } else {
+               dbg("RBN:check_cache '$cachefn' spot cache not present");
+       }
+       
+       return undef;
+}
+
 1;
index 8f41a1b8b619ed8f68079e81dff90615b3ba17d2..2f1baf46f2f5f2a4aa22c6c0fbcaa503a4e87bfd 100755 (executable)
@@ -235,7 +235,7 @@ sub new_channel
                        $user->long($main::mylongitude);
                        $user->qra($main::mylocator);
                }
-               $user->startt($main::systime);
+               $user->startt($main::systime);  
                $conn->conns($call);
                $dxchan = Web->new($call, $conn, $user);
                $dxchan->enhanced(1);
@@ -251,6 +251,7 @@ sub new_channel
 
                # is he locked out ?
                $user = DXUser::get_current($call);
+               $conn->conns($call);
                my $basecall = $call;
                $basecall =~ s/-\d+$//; # remember this for later multiple user processing
                my $lock;
@@ -411,6 +412,7 @@ sub cease
        UDPMsg::finish();
 
        # end everything else
+       RBN::finish();
        DXUser::finish();
        DXDupe::finish();
 
@@ -682,6 +684,9 @@ sub setup_start
        dbg("reading database descriptors ...");
        DXDb::load();
 
+       dbg("starting RBN ...");
+       RBN::init();
+
        # starting local stuff
        dbg("doing local initialisation ...");
        QSL::init(1);
@@ -754,18 +759,17 @@ sub per_sec
        IsoTime::update($systime);
        DXCommandmode::process(); # process ongoing command mode stuff
        DXProt::process();              # process ongoing ak1a pcxx stuff
-       DXCron::process();      # do cron jobs
        DXXml::process();
        DXConnect::process();
        DXMsg::process();
        DXDb::process();
        DXUser::process();
        DXDupe::process();
-       DXCron::process();                      # do cron jobs
        IsoTime::update($systime);
        DXConnect::process();
        DXUser::process();
        AGWMsg::process();
+       DXCron::process();                      # do cron jobs
        
        Timer::handler();
        DXLog::flushall();
@@ -776,20 +780,19 @@ sub per_10_sec
 
 }
 
-
 sub per_minute
 {
-
+       RBN::per_minute();
 }
 
 sub per_10_minute
 {
-
+       RBN::per_10_minute();
 }
 
 sub per_hour
 {
-
+       RBN::per_hour();
 }
 
 sub per_day
diff --git a/perl/convert-users-v3-to-v3j.pl b/perl/convert-users-v3-to-v3j.pl
new file mode 100755 (executable)
index 0000000..06fda09
--- /dev/null
@@ -0,0 +1,148 @@
+#!/usr/bin/env perl
+#
+# Convert users.v2 or .v3 to JSON .v3j format
+#
+# It is believed that this can be run at any time...
+#
+# Copyright (c) 2020 Dirk Koopman G1TLH
+#
+#
+# 
+
+# make sure that modules are searched in the order local then perl
+
+BEGIN {
+       # root of directory tree for this system
+       $root = "/spider"; 
+       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+    unshift @INC, "$root/perl";     # this IS the right way round!
+       unshift @INC, "$root/local";
+}
+
+use strict;
+
+use SysVar;
+use DXUser;
+use DXUtil;
+use JSON;
+use Data::Structure::Util qw(unbless);
+use Time::HiRes qw(gettimeofday tv_interval);
+use IO::File;
+use File::Copy;
+use Carp;
+use DB_File;
+
+use 5.10.1;
+
+my $ufn;
+my $fn = "users";
+
+my $json = JSON->new()->canonical(1);
+my $ofn = localdata("$fn.v3j");
+my $convert;
+
+eval {
+       require Storable;
+};
+
+if ($@) {
+       if ( ! -e localdata("$fn.v3") && -e localdata("$fn.v2") ) {
+               $convert = 2;
+       }
+       LogDbg('',"the module Storable appears to be missing!!");
+       LogDbg('',"trying to continue in compatibility mode (this may fail)");
+       LogDbg('',"please install Storable from CPAN as soon as possible");
+}
+else {
+       import Storable qw(nfreeze thaw);
+       $convert = 3 if -e localdata("users.v3") && !-e $ufn;
+}
+
+die "need to have a $fn.v2 or (preferably) a $fn.v3 file in /spider/data or /spider/local_data\n" unless $convert;
+
+if (-e $ofn) {
+       my $nfn = localdata("$fn.v3j.new");
+       say "You appear to have (or are using) $ofn, creating $nfn instead";
+       $ofn = $nfn;
+} else {
+       $ofn = $ofn;
+       say "using $ofn for output";
+}
+
+
+# do a conversion if required
+if ($convert) {
+       my ($key, $val, $action, $count, $err) = ('','',0,0,0);
+       my $ta = [gettimeofday];
+       my $ofh = IO::File->new(">$ofn") or die "cannot open $ofn ($!)\n";
+               
+       my %oldu;
+       my %newu;
+       
+       LogDbg('',"Converting the User from V$convert format to $fn.v3j ");
+       LogDbg('',"This will take a while, maybe as much as 10 secs");
+       my $idbm = tie (%oldu, 'DB_File', localdata("users.v$convert"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v$convert ($!) [rebuild it from user_asc?]";
+       my $odbm = tie (%newu, 'DB_File', $ofn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $ofn ($!)";
+       for ($action = R_FIRST; !$idbm->seq($key, $val, $action); $action = R_NEXT) {
+               my $ref;
+               if ($convert == 3) {
+                       eval { $ref = storable_decode($val) };
+               }
+               else {
+                       eval { $ref = asc_decode($val) };
+               }
+               unless ($@) {
+                       if ($ref) {
+                               unbless $ref;
+                               $newu{$ref->{call}} = $json->encode($ref);
+                               $count++;
+                       }
+                       else {
+                               $err++
+                       }
+               }
+               else {
+                       Log('err', "DXUser: error decoding $@");
+               }
+       } 
+       untie %oldu;
+       undef $idbm;
+       untie %newu;
+       undef $odbm;
+       my $t = _diffms($ta);
+       LogDbg('',"Conversion from users.v$convert to $ofn completed $count records $err errors $t mS");
+       $ofh->close;
+}
+
+exit 0;
+
+sub asc_decode
+{
+       my $s = shift;
+       my $ref;
+       $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
+       eval '$ref = ' . $s;
+       if ($@) {
+               LogDbg('err', "asc_decode: on '$s' $@");
+               $ref = undef;
+       }
+       return $ref;
+}
+
+sub storable_decode
+{
+       my $ref;
+       $ref = thaw(shift);
+       return $ref;
+}
+
+sub LogDbg
+{
+       my (undef, $s) = @_;
+       say $s;
+}
+
+sub Log
+{
+       say shift;
+}
diff --git a/perl/convert-users-v3-to-v4.pl b/perl/convert-users-v3-to-v4.pl
deleted file mode 100755 (executable)
index 48ef0c0..0000000
+++ /dev/null
@@ -1,143 +0,0 @@
-#!/usr/bin/env perl
-#
-# Convert users.v2 or .v3 to JSON .v4 format
-#
-# It is believed that this can be run at any time...
-#
-# Copyright (c) 2020 Dirk Koopman G1TLH
-#
-#
-# 
-
-# make sure that modules are searched in the order local then perl
-
-BEGIN {
-       # root of directory tree for this system
-       $root = "/spider"; 
-       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-    unshift @INC, "$root/perl";     # this IS the right way round!
-       unshift @INC, "$root/local";
-}
-
-use strict;
-
-use SysVar;
-use DXUser;
-use DXUtil;
-use JSON;
-use Data::Structure::Util qw(unbless);
-use Time::HiRes qw(gettimeofday tv_interval);
-use IO::File;
-use File::Copy;
-use Carp;
-use DB_File;
-
-use 5.10.1;
-
-my $ufn;
-my $fn = "users";
-
-my $json = JSON->new()->canonical(1);
-my $ofn = localdata("$fn.v4");
-my $convert;
-
-eval {
-       require Storable;
-};
-
-if ($@) {
-       if ( ! -e localdata("$fn.v3") && -e localdata("$fn.v2") ) {
-               $convert = 2;
-       }
-       LogDbg('',"the module Storable appears to be missing!!");
-       LogDbg('',"trying to continue in compatibility mode (this may fail)");
-       LogDbg('',"please install Storable from CPAN as soon as possible");
-}
-else {
-       import Storable qw(nfreeze thaw);
-       $convert = 3 if -e localdata("users.v3") && !-e $ufn;
-}
-
-die "need to have a $fn.v2 or (preferably) a $fn.v3 file in /spider/data or /spider/local_data\n" unless $convert;
-
-if (-e $ofn || -e "$ofn.n") {
-       my $nfn = localdata("$fn.v4.json");
-       say "You appear to have (or are using) $ofn, creating $nfn instead";
-       $ofn = $nfn;
-} else {
-       $ofn = "$ofn.n";
-       say "using $ofn.n for output";
-}
-
-
-# do a conversion if required
-if ($convert) {
-       my ($key, $val, $action, $count, $err) = ('','',0,0,0);
-       my $ta = [gettimeofday];
-       my $ofh = IO::File->new(">$ofn") or die "cannot open $ofn ($!)\n";
-               
-       my %oldu;
-       LogDbg('',"Converting the User File from V$convert to $fn.v4 ");
-       LogDbg('',"This will take a while, maybe as much as 10 secs");
-       my $odbm = tie (%oldu, 'DB_File', localdata("users.v$convert"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v$convert ($!) [rebuild it from user_asc?]";
-       for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
-               my $ref;
-               if ($convert == 3) {
-                       eval { $ref = storable_decode($val) };
-               }
-               else {
-                       eval { $ref = asc_decode($val) };
-               }
-               unless ($@) {
-                       if ($ref) {
-                               unbless $ref;
-                               $ofh->print("$ref->{call}\t" . $json->encode($ref) . "\n");
-                               $count++;
-                       }
-                       else {
-                               $err++
-                       }
-               }
-               else {
-                       Log('err', "DXUser: error decoding $@");
-               }
-       } 
-       undef $odbm;
-       untie %oldu;
-       my $t = _diffms($ta);
-       LogDbg('',"Conversion from users.v$convert to $ofn completed $count records $err errors $t mS");
-       $ofh->close;
-}
-
-exit 0;
-
-sub asc_decode
-{
-       my $s = shift;
-       my $ref;
-       $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
-       eval '$ref = ' . $s;
-       if ($@) {
-               LogDbg('err', "DXUser::asc_decode: on '$s' $@");
-               $ref = undef;
-       }
-       return $ref;
-}
-
-sub storable_decode
-{
-       my $ref;
-       $ref = thaw(shift);
-       return $ref;
-}
-
-sub LogDbg
-{
-       my (undef, $s) = @_;
-       say $s;
-}
-
-sub Log
-{
-       say shift;
-}
diff --git a/perl/create_dxqsl.pl b/perl/create_dxqsl.pl
new file mode 100755 (executable)
index 0000000..38fccc5
--- /dev/null
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+#
+# Implement a 'GO' database list
+#
+# Copyright (c) 2003 Dirk Koopman G1TLH
+#
+#
+#
+
+# search local then perl directories
+BEGIN {
+       use vars qw($root);
+       
+       # root of directory tree for this system
+       $root = "/spider"; 
+       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+       
+       unshift @INC, "$root/perl";     # this IS the right way round!
+       unshift @INC, "$root/local";
+}
+
+use strict;
+
+use IO::File;
+use SysVar;
+use DXUtil;
+use Spot;
+use QSL;
+
+use vars qw($end $lastyear $lastday $lasttime);
+
+$end = 0;
+$SIG{TERM} = $SIG{INT} = sub { $end++ };
+
+my $qslfn = "dxqsl";
+
+$main::systime = time;
+
+QSL::remove_files();
+QSL::init(1) or die "cannot open QSL file";
+
+my $base = localdata("spots");
+
+opendir YEAR, $base or die "$base $!";
+foreach my $year (sort readdir YEAR) {
+       next if $year =~ /^\./;
+       
+       my $baseyear = "$base/$year";
+       opendir DAY,  $baseyear or die "$baseyear $!";
+       foreach my $day (sort readdir DAY) {
+               next unless $day =~ /(\d+)\.dat$/;
+               my $dayno = $1 + 0;
+               
+               my $fn = "$baseyear/$day";
+               my $f = new IO::File $fn  or die "$fn ($!)"; 
+               print "doing: $fn\n";
+               while (<$f>) {
+                       last if $end;
+                       if (/(QSL|VIA)/i) {
+                               my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
+                               my $q = QSL::get($call) || new QSL $call;
+                               $q->update($comment, $t, $by);
+                               $lasttime = $t;
+                       }
+               }
+               $f->close;
+               last if $end;
+       }
+       last if $end;
+}
+
+QSL::finish();
+
+exit(0);
+
+
diff --git a/perl/create_qsl.pl b/perl/create_qsl.pl
deleted file mode 100755 (executable)
index f4083f5..0000000
+++ /dev/null
@@ -1,78 +0,0 @@
-#!/usr/bin/env perl
-#
-# Implement a 'GO' database list
-#
-# Copyright (c) 2003 Dirk Koopman G1TLH
-#
-#
-#
-
-# search local then perl directories
-BEGIN {
-       use vars qw($root);
-       
-       # root of directory tree for this system
-       $root = "/spider"; 
-       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-       
-       unshift @INC, "$root/perl";     # this IS the right way round!
-       unshift @INC, "$root/local";
-}
-
-use strict;
-
-use IO::File;
-use SysVar;
-use DXUtil;
-use Spot;
-use QSL;
-
-use vars qw($end $lastyear $lastday $lasttime);
-
-$end = 0;
-$SIG{TERM} = $SIG{INT} = sub { $end++ };
-
-my $qslfn = "qsl";
-
-$main::systime = time;
-
-unlink "$data/qsl.v1";
-unlink "$local_data/qsl.v1";
-
-QSL::init(1) or die "cannot open QSL file";
-
-my $base = localdata("spots");
-
-opendir YEAR, $base or die "$base $!";
-foreach my $year (sort readdir YEAR) {
-       next if $year =~ /^\./;
-       
-       my $baseyear = "$base/$year";
-       opendir DAY,  $baseyear or die "$baseyear $!";
-       foreach my $day (sort readdir DAY) {
-               next unless $day =~ /(\d+)\.dat$/;
-               my $dayno = $1 + 0;
-               
-               my $fn = "$baseyear/$day";
-               my $f = new IO::File $fn  or die "$fn ($!)"; 
-               print "doing: $fn\n";
-               while (<$f>) {
-                       last if $end;
-                       if (/(QSL|VIA)/i) {
-                               my ($freq, $call, $t, $comment, $by, @rest) = split /\^/;
-                               my $q = QSL::get($call) || new QSL $call;
-                               $q->update($comment, $t, $by);
-                               $lasttime = $t;
-                       }
-               }
-               $f->close;
-               last if $end;
-       }
-       last if $end;
-}
-
-QSL::finish();
-
-exit(0);
-
-