+08Nov99=======================================================================
+1. added spoofing (mk1 version) for sysops, useful for those little jobs like
+reseting a user's qra locator and such like "spoof g7brn set/qra jo02lq".
07Nov99=======================================================================
1. reduced the amount of stuff compared against for dup announces.
2. Check the regex for DK0WCY announces produces results before storing it as
+++ /dev/null
-#!/usr/bin/perl
-#
-# Database update routine
-#
-# Copyright (c) 1999 Dirk Koopman G1TLH
-#
-my ($self, $line) = @_;
-my @f = split /\s+/, $line;
-my @out;
-
-my $name = shift @f if @f;
-my $db = DXDb::getdesc($name);
-return (1, $self->msg('db3', $name)) unless $db;
-
-if ($db->remote) {
- for (@f) {
- my $n = DXDb::newstream($self->call);
- DXProt::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call));
- }
-} else {
- for (@f) {
- my $value = $db->getkey($_);
- if ($value) {
- push @out, split /\n/, $value;
- } else {
- push @out, $self->msg('db2', $_, $db->{name});
- }
- }
-}
-
-return (1, @out);
}
$key = uc $_;
$value = undef;
- ++$state;
+ ++$state if $key;
} elsif ($state == 1) {
if (/^\&\&/) {
if ($key =~ /^#/) {
+ } elsif ($key && $value) {
+ $db->putkey($key, $value);
+ $count++;
}
- $db->putkey($key, $value);
$state = 0;
- $count++;
+ next;
+ } elsif (/^\%\%/) {
+ $state = 0;
next;
}
$value .= $_ . "\n";
--- /dev/null
+#!/usr/bin/perl
+#
+# Database update routine
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @out;
+
+my $name = shift @f if @f;
+my $db = DXDb::getdesc($name);
+return (1, $self->msg('db3', $name)) unless $db;
+
+if ($db->remote) {
+ for (@f) {
+ my $n = DXDb::newstream($self->call);
+ DXProt::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call));
+ }
+} else {
+ for (@f) {
+ my $value = $db->getkey($_);
+ if ($value) {
+ push @out, split /\n/, $value;
+ } else {
+ push @out, $self->msg('db2', $_, $db->{name});
+ }
+ }
+}
+
+return (1, @out);
--- /dev/null
+#!/usr/bin/perl
+#
+# Database update routine
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @out;
+
+
+return (1, @out);
--- /dev/null
+#!/usr/bin/perl
+#
+# pretend that you are another user, useful for reseting
+# those silly things that people insist on getting wrong
+# like set/homenode et al
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+my ($self, $line) = @_;
+
+my $mycall = $self->call;
+my $myuser = $self->user;
+
+my ($call, $newline) = split /\s+/, $line, 2;
+return (1, $self->msg('nodee1', $call)) if DXChannel->get($call);
+
+if ($self->remotecmd) {
+ Log('DXCommand', "$mycall is trying to spoof $call remotely");
+ return (1, $self->msg('e5'));
+}
+if ($self->priv < 9) {
+ Log('DXCommand', "$mycall is trying to spoof $call locally");
+ return (1, $self->msg('e5'));
+}
+
+my @out;
+$call = uc $call;
+my $user = DXUser->get($call);
+unless ($user) {
+ $user = DXUser->new($call);
+ push @out, $self->msg('spf1', $call);
+}
+
+# set up basic environment
+$self->call($call);
+$self->user($user);
+Log('DXCommand', "spoof '$newline' as $call by $mycall");
+my @in = $self->run_cmd($newline);
+push @out, map {"spoof $call: $_"} @in;
+$self->call($mycall);
+$self->user($myuser);
+
+return (1, @out);
$cmdline =~ s|//|/|og;
# split the command line up into parts, the first part is the command
- my ($cmd, $args) = $cmdline =~ /^([\S\/]+)\s*(.*)/o;
+ my ($cmd, $args) = split /\s+/, $cmdline, 2;
+ $args = "" unless $args;
if ($cmd) {
# alias it if possible
my $acmd = CmdAlias::get_cmd($cmd);
if ($acmd) {
- ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o;
+ ($cmd, $args) = split /\s+/, "$acmd $args", 2;
+ $args = "" unless $args;
dbg('command', "aliased cmd: $cmd $args");
}
my $n = getstream($f[3]);
if ($n) {
my $mchan = DXChannel->get($n->{call});
- $mchan->send($f[2] . ":$f[4]");
+ $mchan->send($f[2] . ":$f[4]") if $mchan;
}
last SWITCH;
}
sloc => 'Cluster lat $_[0] long $_[1], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
sqra => 'Cluster QRA Locator$_[0], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
sorry => 'Sorry',
+ spf1 => 'spoof: creating new user $_[0]',
suser1 => 'usage: callsign user_field_name value',
suser2 => 'User $_[0] not found',
suser3 => 'User field \'$_[0]\' was \'$_[1]\' now set to \'$_[2]\'',