From: Dirk Koopman Date: Thu, 9 Jul 2020 20:10:07 +0000 (+0100) Subject: Merge branch 'users.v3j' into mojo X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=3b73a2dde8b378db6b56438699c5a1f233194dbf;hp=8fa1ac1083c4a4d1b2916933ca49d00d2fad2d8b;p=spider.git Merge branch 'users.v3j' into mojo --- diff --git a/Changes b/Changes index d8e3fcc1..74bc922b 100644 --- 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 index 00000000..488abb33 --- /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:' '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 command). When this is finished, run 'load/dxqsl' in +a console (or restart the node, but it isn't necessary). diff --git a/cmd/Aliases b/cmd/Aliases index e9029f18..59c1255e 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -22,151 +22,159 @@ 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' => [ + ], + ); + diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 244688d9..65153473 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -107,6 +107,7 @@ You can use the tag 'all' to accept everything eg: === 0^ACCEPT/SPOTS [0-9] ^Set an 'accept' filter line for spots +=== 0^ACCEPT/RBN [0-9] ^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 ^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] ^Set a 'reject' filter line for spots +=== 0^REJECT/RBN [0-9] ^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 ...^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 ...^Mark a user as registered === 9^UNSET/REGISTER ...^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^ [category ..]^Allow (some) RBN/Skimmer spots +=== 9^SET/SKIMMER^ [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 diff --git a/cmd/export_users.pl b/cmd/export_users.pl index 774d8384..45b03d75 100644 --- a/cmd/export_users.pl +++ b/cmd/export_users.pl @@ -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"; } diff --git a/cmd/load/dxqsl.pl b/cmd/load/dxqsl.pl index b1738229..679864c0 100644 --- a/cmd/load/dxqsl.pl +++ b/cmd/load/dxqsl.pl @@ -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); diff --git a/cmd/set/wantrbn.pl b/cmd/set/wantrbn.pl index f4aa86e2..e4528c33 100644 --- a/cmd/set/wantrbn.pl +++ b/cmd/set/wantrbn.pl @@ -7,21 +7,111 @@ # 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); diff --git a/cmd/show/node.pl b/cmd/show/node.pl index b41cd93f..f8e71177 100644 --- a/cmd/show/node.pl +++ b/cmd/show/node.pl @@ -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; + } } } } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 729675be..bef5626d 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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 diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 28ae8fe5..fcc60b86 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -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 diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 0b72a680..267c68ed 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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 () { 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 diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index d23cb92e..f7e52c9a 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -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; diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 44846c53..6b3a30b1 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -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 diff --git a/perl/Messages b/perl/Messages index 08a79251..d79eec73 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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]', diff --git a/perl/Msg.pm b/perl/Msg.pm index 81c2e40a..3e30372f 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -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); diff --git a/perl/QSL.pm b/perl/QSL.pm index 0df7570b..d10345ed 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -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; diff --git a/perl/RBN.pm b/perl/RBN.pm index 6773118f..418c1cb3 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -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; diff --git a/perl/cluster.pl b/perl/cluster.pl index 8f41a1b8..2f1baf46 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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 index 00000000..06fda097 --- /dev/null +++ b/perl/convert-users-v3-to-v3j.pl @@ -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 index 48ef0c00..00000000 --- a/perl/convert-users-v3-to-v4.pl +++ /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 index 00000000..38fccc5a --- /dev/null +++ b/perl/create_dxqsl.pl @@ -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 index f4083f55..00000000 --- a/perl/create_qsl.pl +++ /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); - -