From 50f6466ca2dff82ca470a4abe327d741cffef61a Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 20 Sep 2001 14:13:11 +0000 Subject: [PATCH] 1. fix set/lockout so that it is possible to lock out all SSIDs except those specifically unlocked and so that you don't need to lock the non-SSID call in order to lock an SSID call. So set/lock g1tlh will lock out all instances of g1tlh, g1tlh-1, g1tlh-15 etc except (for instance) unset/lock g1tlh-9. 2. show/lock allows partial callsign matching so sh/lock gb7 will only show GB7* calls that are locked. 3. Had a grand shift around for the start of NP. --- Changes | 8 +++ cmd/announce.pl | 4 +- cmd/forward/opername.pl | 12 ++-- cmd/kill.pl | 2 +- cmd/links.pl | 2 +- cmd/set/here.pl | 2 +- cmd/set/homenode.pl | 2 +- cmd/set/location.pl | 4 +- cmd/set/name.pl | 2 +- cmd/set/qra.pl | 4 +- cmd/set/qth.pl | 2 +- cmd/set/sys_location.pl | 2 +- cmd/show/lockout.pl | 15 +++-- cmd/unset/here.pl | 2 +- cmd/who.pl | 2 +- cmd/wx.pl | 4 +- html/newprot.html | 76 +++++++++++++++++------- perl/DXChannel.pm | 93 +++++++++++++++++++++++++++++ perl/DXCommandmode.pm | 6 +- perl/DXCron.pm | 4 +- perl/DXMsg.pm | 4 +- perl/DXProt.pm | 127 +++++++--------------------------------- perl/QXProt.pm | 116 ++++++++++++++++++++++++++++++++++++ perl/cluster.pl | 33 +++++++---- 24 files changed, 355 insertions(+), 173 deletions(-) create mode 100644 perl/QXProt.pm diff --git a/Changes b/Changes index 4ad8dd8a..8363ca58 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +21Sep01======================================================================= +1. fix set/lockout so that it is possible to lock out all SSIDs except those +specifically unlocked and so that you don't need to lock the non-SSID call in +order to lock an SSID call. So set/lock g1tlh will lock out all instances of +g1tlh, g1tlh-1, g1tlh-15 etc except (for instance) unset/lock g1tlh-9. +2. show/lock allows partial callsign matching so sh/lock gb7 will only show +GB7* calls that are locked. +3. Had a grand shift around for the start of NP. 19Sep01======================================================================= 1. put in some rudimentory rsfp checking for various things 2. tried to do some fixes on console.pl - YOU WILL REQUIRE Curses 1.06 from diff --git a/cmd/announce.pl b/cmd/announce.pl index df7b91d0..0ea2e12f 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -54,10 +54,10 @@ if (@bad = BadWords::check($line)) { return (1, $self->msg('dup')) if AnnTalk::dup($from, $toflag, $line); Log('ann', $to, $from, $line); -DXProt::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals); +DXChannel::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals); if ($to ne "LOCAL") { my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0); - DXProt::broadcast_ak1a($pc); + DXChannel::broadcast_nodes($pc); } return (1, ()); diff --git a/cmd/forward/opername.pl b/cmd/forward/opername.pl index 1daaa1c3..91acc8b4 100644 --- a/cmd/forward/opername.pl +++ b/cmd/forward/opername.pl @@ -32,29 +32,29 @@ foreach $call (@f) { my $qra = $ref->qra; my $latlong = DXBearing::lltos($lat, $long) if $lat && $long; if ($name) { - my $l = DXProt::pc41($DXProt::me, $call, 1, $name); + my $l = DXProt::pc41($main::me, $call, 1, $name); DXProt::eph_dup($l); - DXProt::broadcast_all_ak1a($l, $DXProt::me) ; + DXChannel::broadcast_all_nodes($l, $main::me) ; } if ($qth) { my $l = DXProt::pc41($call, 2, $qth); DXProt::eph_dup($l); - DXProt::broadcast_all_ak1a($l, $DXProt::me) ; + DXChannel::broadcast_all_nodes($l, $main::me) ; } if ($latlong) { my $l = DXProt::pc41($call, 3, $latlong); DXProt::eph_dup($l); - DXProt::broadcast_all_ak1a($l, $DXProt::me) ; + DXChannel::broadcast_all_nodes($l, $main::me) ; } if ($node) { my $l = DXProt::pc41($call, 4, $node); DXProt::eph_dup($l); - DXProt::broadcast_all_ak1a($l, $DXProt::me) ; + DXChannel::broadcast_all_nodes($l, $main::me) ; } if ($qra) { my $l = DXProt::pc41($call, 5, $qra); DXProt::eph_dup($l); - DXProt::broadcast_all_ak1a($l, $DXProt::me) ; + DXChannel::broadcast_all_nodes($l, $main::me) ; } } } diff --git a/cmd/kill.pl b/cmd/kill.pl index ab7bb511..de533bdc 100644 --- a/cmd/kill.pl +++ b/cmd/kill.pl @@ -64,7 +64,7 @@ while (@f) { foreach $ref ( @refs) { Log('msg', "Message $ref->{msgno} from $ref->{from} to $ref->{to} deleted by $call"); if ($full) { - DXProt::broadcast_ak1a(DXProt::pc49($ref->{from}, $ref->{subject}), $DXProt::me); + DXChannel::broadcast_nodes(DXProt::pc49($ref->{from}, $ref->{subject}), $main::me); } my $tonode = $ref->tonode; $ref->stop_msg($tonode) if $tonode; diff --git a/cmd/links.pl b/cmd/links.pl index 648ebba4..463a4e4f 100644 --- a/cmd/links.pl +++ b/cmd/links.pl @@ -20,7 +20,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) { my $t = cldatetime($dxchan->startt); my $sort; my $name = $dxchan->user->name || " "; - my $ping = $dxchan->is_node && $dxchan != $DXProt::me ? sprintf("%8.2f", + my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%8.2f", $dxchan->pingave) : ""; $sort = "DXSP" if $dxchan->is_spider; $sort = "CLX " if $dxchan->is_clx; diff --git a/cmd/set/here.pl b/cmd/set/here.pl index 44fc4d4b..1c4b167c 100644 --- a/cmd/set/here.pl +++ b/cmd/set/here.pl @@ -25,7 +25,7 @@ foreach $call (@args) { $ref->here(1); my $s = DXProt::pc24($ref); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; } } else { push @out, $self->msg('e3', "Set Here", $call); diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl index cf8d9715..b2d7d342 100644 --- a/cmd/set/homenode.pl +++ b/cmd/set/homenode.pl @@ -24,7 +24,7 @@ if ($user) { $user->put(); my $s = DXProt::pc41($call, 4, $line); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; return (1, $self->msg('hnode', $line)); } else { return (1, $self->msg('namee2', $call)); diff --git a/cmd/set/location.pl b/cmd/set/location.pl index f4ee0358..9d31dcf5 100644 --- a/cmd/set/location.pl +++ b/cmd/set/location.pl @@ -30,7 +30,7 @@ if ($user) { my $l = DXBearing::lltos($lat, $long); my $s = DXProt::pc41($call, 3, $l); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; } my $qra = DXBearing::lltoqra($lat, $long); my $oldqra = $user->qra || ""; @@ -38,7 +38,7 @@ if ($user) { $user->qra($qra); my $s = DXProt::pc41($call, 5, $qra); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me); + DXChannel::broadcast_all_nodes($s, $main::me); } $user->put(); diff --git a/cmd/set/name.pl b/cmd/set/name.pl index 32917574..4bffef41 100644 --- a/cmd/set/name.pl +++ b/cmd/set/name.pl @@ -23,7 +23,7 @@ if ($user) { $user->put(); my $s = DXProt::pc41($call, 1, $line); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; return (1, $self->msg('name', $line)); } else { return (1, $self->msg('namee2', $call)); diff --git a/cmd/set/qra.pl b/cmd/set/qra.pl index 60c6dc16..4bae21c3 100644 --- a/cmd/set/qra.pl +++ b/cmd/set/qra.pl @@ -25,7 +25,7 @@ if ($user) { $user->qra($qra); my $s = DXProt::pc41($call, 5, $qra); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me); + DXChannel::broadcast_all_nodes($s, $main::me); } my ($lat, $long) = DXBearing::qratoll($qra); my $oldlat = $user->lat || 0; @@ -36,7 +36,7 @@ if ($user) { my $l = DXBearing::lltos($lat, $long); my $s = DXProt::pc41($call, 3, $l); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; } $user->put(); diff --git a/cmd/set/qth.pl b/cmd/set/qth.pl index 2b696f94..4a5a881f 100644 --- a/cmd/set/qth.pl +++ b/cmd/set/qth.pl @@ -23,7 +23,7 @@ if ($user) { $user->put(); my $s = DXProt::pc41($call, 2, $line); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; return (1, $self->msg('qth', $line)); } else { return (1, $self->msg('namee2', $call)); diff --git a/cmd/set/sys_location.pl b/cmd/set/sys_location.pl index 903a5796..aac91823 100644 --- a/cmd/set/sys_location.pl +++ b/cmd/set/sys_location.pl @@ -25,7 +25,7 @@ if ($user) { my ($lat, $long) = DXBearing::stoll($line); $user->lat($lat); $user->long($long); - DXProt::broadcast_all_ak1a(DXProt::pc41($call, 3, $line), $DXProt::me); + DXChannel::broadcast_all_nodes(DXProt::pc41($call, 3, $line), $main::me); if (!$user->qra) { my $qra = DXBearing::lltos($lat, $long); $user->qra($qra); diff --git a/cmd/show/lockout.pl b/cmd/show/lockout.pl index 04d1ef12..f4c87a87 100644 --- a/cmd/show/lockout.pl +++ b/cmd/show/lockout.pl @@ -15,13 +15,20 @@ my @out; use DB_File; +if ($line) { + $line =~ s/[^\w-\/]+//g; + $line = "^\U\Q$line"; +} + my ($action, $count, $key, $data) = (0,0,0,0); for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { if ($data =~ m{lockout =>}) { - my $u = DXUser->get_current($key); - if ($u && $u->lockout) { - push @out, $key; - ++$count; + if ($line && $key =~ /$line/) { + my $u = DXUser->get_current($key); + if ($u && $u->lockout) { + push @out, $key; + ++$count; + } } } } diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl index 4da517c1..19db8dbd 100644 --- a/cmd/unset/here.pl +++ b/cmd/unset/here.pl @@ -25,7 +25,7 @@ foreach $call (@args) { $ref->here(0); my $s = DXProt::pc24($ref); DXProt::eph_dup($s); - DXProt::broadcast_all_ak1a($s, $DXProt::me) ; + DXChannel::broadcast_all_nodes($s, $main::me) ; } } else { push @out, $self->msg('e3', "Unset Here", $call); diff --git a/cmd/who.pl b/cmd/who.pl index ecb45d70..6ec7dba3 100644 --- a/cmd/who.pl +++ b/cmd/who.pl @@ -26,7 +26,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) { $sort = "AK1A" if $dxchan->is_ak1a; } my $name = $dxchan->user->name || " "; - my $ping = $dxchan->is_node && $dxchan != $DXProt::me ? sprintf("%5.2f", $dxchan->pingave) : " "; + my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : " "; my $conn = $dxchan->conn; my $ip = ''; $ip = $conn->{peerhost} if $conn && $conn->{peerhost}; diff --git a/cmd/wx.pl b/cmd/wx.pl index cec70f4e..af7cd0ab 100644 --- a/cmd/wx.pl +++ b/cmd/wx.pl @@ -36,11 +36,11 @@ if ($sort eq "FULL") { $to = "LOCAL"; } -DXProt::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals); +DXChannel::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals); if ($to ne "LOCAL") { $line =~ s/\^//og; # remove ^ characters! my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1); - DXProt::broadcast_ak1a($pc, $DXProt::me); + DXChannel::broadcast_nodes($pc, $main::me); } return (1, ()); diff --git a/html/newprot.html b/html/newprot.html index c34a5354..1bb84fe2 100644 --- a/html/newprot.html +++ b/html/newprot.html @@ -32,7 +32,8 @@ become stretched to beyond breaking point. Some attempts have been made to extend it, but none have done what is actually required: which is to throw it away completely and start from scratch.

-

This is an attempt at starting again.

+

This is an attempt at starting again. In fit of originality I am calling +it "New Protocol" or "NP" for short

Design Criteria