users with useradd -m <callsign>. Alter the default .bashrc so that it
contains just one line (assuming you use the default bash shell).
- exec /spider/perl/client.pl <callsign>
+ exec /spider/perl/client.pl <callsign> telnet
Don't forget to give them a real password. This is really for network
- cluster logins
+ cluster logins. The telnet argument does two things, it sets the EOL
+ convention to \n rather than AX25's \r and it automatically reduces
+ the privilege of the <callsign> to a 'safe[r]' level.
7) for incoming AX25 connections you are expected to have got the AX25
utilities setup, tested and working. See the AX25-HOWTO for more info
--- /dev/null
+#
+# go INSTANTLY into debug mode (if you are in the debugger!)
+#
+# remember perl -d cluster.pl to use this
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my $self = shift;
+return if $self->priv < 9;
+
+$DB::single = 1;
+
foreach $call (@calls) {
$call = uc $call;
+ next if $call eq $main::mycall;
my $dxchan = DXChannel->get($call);
if ($dxchan) {
if ($dxchan->is_ak1a) {
- $dxchan->send_now("D", $self->pc39('Disconnected'));
- } else {
+ $dxchan->send_now("D", DXProt::pc39($dxchan->call, 'Disconnected'));
+ } else {
$dxchan->disconnect;
- }
+ }
push @out, "disconnected $call";
} else {
push @out, "$call not connected locally";
my @body;
my $ref;
+# $DB::single = 1;
+
for $msgno (@f) {
$ref = DXMsg::get($msgno);
if (!$ref) {
--- /dev/null
+#
+# synonym for send or SP send private
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my $ref = DXCommandmode::find_cmd_ref('send');
+return ( &{$ref}(@_) ) if $ref;
+return (0,());
#
# send a message
#
+# this should handle
+#
+# send <call> [<call> .. ]
+# send private <call> [<call> .. ]
+# send private rr <call> [<call> .. ]
+# send rr <call> [<call> .. ]
+# send noprivate <call> [<call> .. ]
+# send b <call> [<call> .. ]
+# send copy <call> [<call> .. ]
+# send copy rr <call> [<call> .. ]
+#
# Copyright (c) Dirk Koopman G1TLH
#
# $Id$
#
+my ($self, $line) = @_;
+my @out;
+my $loc;
+
+#$DB::single = 1;
+
+if ($self->state eq "prompt") {
+
+ my @f = split /\s+/, $line;
+
+ $f[0] = uc $f[0];
+
+ # first deal with copies
+ if ($f[0] eq 'C' || $f[0] eq 'CC' || $f[0] eq 'COPY') {
+ my $i = 1;
+ my $rr = '0';
+ if (uc $f[$i] eq 'RR') {
+ $rr = '1';
+ $i++;
+ }
+ my $oref = DXMsg::get($f[$i]);
+ #return (0, $self->msg('esend1', $f[$i])) if !$oref;
+ #return (0, $self->msg('esend2')) if $i+1 > @f;
+ return (0, "msgno $f[$i] not found") if !$oref;
+ return (0, "need a callsign") if $i+1 > @f;
+
+ # separate copy to everyone listed
+ for ($i++ ; $i < @f; $i++) {
+ my $msgno = DXMsg::next_transno('Msgno');
+ my $newsubj = "CC: " . $oref->subject;
+ my $nref = DXMsg->alloc($msgno,
+ uc $f[$i],
+ $self->call,
+ $main::systime,
+ '1',
+ $newsubj,
+ $main::mycall, $rr);
+ my @list;
+ my $from = $oref->from;
+ my $to = $oref->to;
+ my $date = cldate($oref->t);
+ my $time = ztime($oref->t);
+ my $buf = "Original from: $from To: $to Date: $date $time";
+ push @list, $buf;
+ push @list, $oref->read_msg_body();
+ $nref->store(\@list);
+ $nref->add_dir();
+ #push @out, $self->msg('sendcc', $oref->msgno, $f[$i]);
+ push @out, "copy of msg $oref->{msgno} sent to $to";
+ }
+ DXMsg::queue_msg();
+ return (1, @out);
+ }
+
+ # now deal with real message inputs
+ # parse out send line for various possibilities
+ $loc = $self->{loc} = {};
+
+ my $i = 0;
+ $f[0] = uc $f[0];
+ $loc->{private} = '1';
+ if ($f[0] eq 'B' || $f[0] =~ /^NOP/oi) {
+ $loc->{private} = '0';
+ $i += 1;
+ } elsif ($f[0] eq 'P' || $f[0] =~ /^PRI/oi) {
+ $i += 1;
+ }
+
+ $loc->{rrreq} = '0';
+ if (uc $f[$i] eq 'RR') {
+ $loc->{rrreq} = '1';
+ $i++;
+ }
+
+ # check we have some callsigns
+ if ($i > @f) {
+ delete $self->{loc};
+ #return (0, $self->msg('esend2'));
+ return (0, "need a callsign");
+ }
+
+ # now save all the 'to' callsigns for later
+ my @to = @f[ $i..$#f ];
+ $loc->{to} = \@to;
+
+ # find me and set the state and the function on my state variable to
+ # keep calling me for every line until I relinquish control
+ $self->func("DXMsg::do_send_stuff");
+ $self->state('send1');
+ #push @out, $self->msg('sendsubj');
+ push @out, "Enter Subject (30 characters) >";
+}
+
+return (1, @out);
--- /dev/null
+#
+# set the privilege of the user
+#
+# call as set/priv n <call> ...
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my $priv = shift @args;
+my @out;
+my $user;
+
+$DB::single = 1;
+
+return (0) if $self->priv < 9;
+
+if ($priv < 0 || $priv > 9) {
+ return (0, $self->msg('e5'));
+}
+
+foreach $call (@args) {
+ $call = uc $call;
+ my $user = DXUser->get_current($call);
+ if ($user) {
+ $user->priv($priv);
+ $user->put();
+ push @out, $self->msg('priv', $call);
+ } else {
+ push @out, $self->msg('e3', "Set Privilege", $call);
+ }
+}
+return (1, @out);
my @dx;
foreach $ref (@res) {
@dx = @$ref;
- my $t = ztime($dx[2]);
- my $d = cldate($dx[2]);
- push @out, sprintf "%9s %-12s %s %s %-28s <%s>", $dx[0], $dx[1], $d, $t, $dx[3], $dx[4];
+ push @out, Spot::formatl(@dx);
}
return (1, @out);
--- /dev/null
+#
+# synonym for send or SP send private
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my $ref = DXCommandmode::find_cmd_ref('send');
+return ( &{$ref}(@_) ) if $ref;
+return (0,());
package DXChannel;
use Msg;
-use DXUtil;
use DXM;
+use DXUtil;
use DXDebug;
use Carp;
redirect => '0,Redirect messages to',
lang => '0,Language',
func => '9,Function',
+ loc => '9,Local Vars', # used by func to store local variables in
);
# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
$self->send(@buf);
}
-# just a shortcut for $dxchan->send(msg(...));
+# this will implement language independence (in time)
sub msg
{
my $self = shift;
- $self->send(DXM::msg(@_));
+ return DXM::msg(@_);
}
# change the state of the channel - lots of scope for debugging here :-)
sub state
{
my $self = shift;
- $self->{oldstate} = $self->{state};
- $self->{state} = shift;
- dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
+ if (@_) {
+ $self->{oldstate} = $self->{state};
+ $self->{state} = shift;
+ dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
+ }
+ return $self->{state};
}
# disconnect this channel
use Exporter;
@ISA = qw(Exporter);
-use Carp;
use DXDebug;
+use Carp;
use strict;
use vars qw(%cluster %valid);
use DXVars;
use DXDebug;
use DXM;
+use FileHandle;
use Carp;
use strict;
-use vars qw(%Cache %cmd_cache);
+use vars qw(%Cache %cmd_cache $errstr);
%Cache = (); # cache of dynamically loaded routine's mod times
%cmd_cache = (); # cache of short names
-
+$errstr = (); # error string from eval
#
# obtain a new connection this is derived from dxchannel
#
my $name = $user->{name};
$self->{name} = $name ? $name : $call;
- $self->msg('l2',$self->{name});
+ $self->send($self->msg('l2',$self->{name}));
$self->send_file($main::motd) if (-e $main::motd);
- $self->msg('pr', $call);
+ $self->send($self->msg('pr', $call));
$self->state('prompt'); # a bit of room for further expansion, passwords etc
$self->{priv} = $user->priv;
$self->{lang} = $user->lang;
# set some necessary flags on the user if they are connecting
$self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
- $self->prompt() if $self->{state} =~ /^prompt/o;
+# $self->prompt() if $self->{state} =~ /^prompt/o;
# add yourself to the database
my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database";
my $user = $self->{user};
my $call = $self->{call};
my $cmdline = shift;
+ my @ans;
+
+ # are we in stored state?
+ if ($self->{func}) {
+ my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) };
+ dbg('eval', "stored func cmd = $c\n");
+ eval $c;
+ if ($@) {
+ return (1, "Syserr: Eval err $errstr on stored func $self->{func}");
+ }
+ } else {
- # strip out //
- $cmdline =~ s|//|/|og;
+ # special case only \n input => " "
+ if ($cmdline eq " ") {
+ $self->prompt();
+ return;
+ }
+
+ # strip out //
+ $cmdline =~ s|//|/|og;
- # split the command line up into parts, the first part is the command
- my ($cmd, $args) = $cmdline =~ /^([\w\/]+)\s*(.*)/o;
+ # split the command line up into parts, the first part is the command
+ my ($cmd, $args) = $cmdline =~ /^([\w\/]+)\s*(.*)/o;
- if ($cmd) {
+ if ($cmd) {
- my ($path, $fcmd);
+ my ($path, $fcmd);
- # first expand out the entry to a command
- ($path, $fcmd) = search($main::localcmd, $cmd, "pl");
- ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
-
- my @ans = $self->eval_file($path, $fcmd, $args) if $path && $fcmd;
-# @ans = $self->eval_file($main::cmd, $cmd, $args) if !$ans[0];
- if ($ans[0]) {
- shift @ans;
- $self->send(@ans) if @ans > 0;
- } else {
- shift @ans;
- if (@ans > 0) {
- $self->msg('e2', @ans);
- } else {
- $self->msg('e1');
+ # first expand out the entry to a command
+ ($path, $fcmd) = search($main::localcmd, $cmd, "pl");
+ ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
+
+ my $package = find_cmd_name($path, $fcmd);
+ @ans = (0, "Syserr: compile err on $package\n$@$errstr") if !$package ;
+
+ if ($package) {
+ my $c = qq{ \@ans = $package(\$self, \$args) };
+ dbg('eval', "cluster cmd = $c\n");
+ eval $c;
+ if ($@) {
+ @ans = (0, "Syserr: Eval err cached $package\n$@");
+ }
}
}
+ }
+
+# my @ans = $self->eval_file($path, $fcmd, $args) if $path && $fcmd;
+# @ans = $self->eval_file($main::cmd, $cmd, $args) if !$ans[0];
+ if ($ans[0]) {
+ shift @ans;
+ $self->send(@ans) if @ans > 0;
} else {
- $self->msg('e1');
+ shift @ans;
+ if (@ans > 0) {
+ $self->send($self->msg('e2', @ans));
+ } else {
+ $self->send($self->msg('e1'));
+ }
}
# send a prompt only if we are in a prompt state
{
my $self = shift;
my $call = $self->{call};
- DXChannel::msg($self, 'pr', $call);
+ $self->send($self->msg('pr', $call));
+ #DXChannel::msg($self, 'pr', $call);
}
# broadcast a message to all users [except those mentioned after buffer]
$string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
#Dress it up as a real package name
- $string =~ s|/|_|g;
+ $string =~ s/\//_/og;
return "Emb_" . $string;
}
my ($stem, $leaf);
no strict 'refs';
- $pkg = "DXChannel::$pkg\::"; # expand to full symbol table name
+ $pkg = "DXCommandmode::$pkg\::"; # expand to full symbol table name
($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
-
- my $stem_symtab = *{$stem}{HASH};
-
- delete $stem_symtab->{$leaf};
+
+ if ($stem && $leaf) {
+ my $stem_symtab = *{$stem}{HASH};
+ delete $stem_symtab->{$leaf};
+ }
}
-sub eval_file {
- my $self = shift;
+# find a cmd reference
+# this is really for use in user written stubs
+#
+# use the result as a symbolic reference:-
+#
+# no strict 'refs';
+# @out = &$r($self, $line);
+#
+sub find_cmd_ref
+{
+ my $cmd = shift;
+ my $r;
+
+ if ($cmd) {
+
+ # first expand out the entry to a command
+ my ($path, $fcmd) = search($main::localcmd, $cmd, "pl");
+ ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
+
+ # make sure it is loaded
+ $r = find_cmd_name($path, $fcmd);
+ }
+ return $r;
+}
+
+#
+# this bit of magic finds a command in the offered directory
+sub find_cmd_name {
my $path = shift;
my $cmdname = shift;
my $package = valid_package_name($cmdname);
my $mtime = -M $filename;
# return if we can't find it
- return (0, DXM::msg('e1')) if !defined $mtime;
+ $errstr = undef;
+ if (undef $mtime) {
+ $errstr = DXM::msg('e1');
+ return undef;
+ }
if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) {
#we have compiled this subroutine already,
#print STDERR "already compiled $package->handler\n";
;
} else {
- local *FH;
- if (!open FH, $filename) {
- return (0, "Syserr: can't open '$filename' $!");
+ my $fh = new FileHandle;
+ if (!open $fh, $filename) {
+ $errstr = "Syserr: can't open '$filename' $!";
};
- local($/) = undef;
- my $sub = <FH>;
- close FH;
+ my $old = $fh->input_record_separator(undef);
+ my $sub = <$fh>;
+ $fh->input_record_separator($old);
+ close $fh;
#wrap the code into a subroutine inside our unique package
- my $eval = qq{package DXChannel; sub $package { $sub; }};
+ my $eval = qq{
+ sub $package
+ {
+ $sub
+ } };
+
if (isdbg('eval')) {
my @list = split /\n/, $eval;
my $line;
- foreach (@list) {
+ for (@list) {
dbg('eval', $_, "\n");
}
}
- #print "eval $eval\n";
+
{
#hide our variables within this block
my($filename,$mtime,$package,$sub);
eval $eval;
}
+
if ($@) {
+ print "\$\@ = $@";
+ $errstr = $@;
delete_package($package);
- return (1, "Syserr: Eval err $@ on $package");
+ $package = undef;
+ } else {
+ #cache it unless we're cleaning out each time
+ $Cache{$package}{mtime} = $mtime;
}
-
- #cache it unless we're cleaning out each time
- $Cache{$package}{mtime} = $mtime;
}
- my @r;
- my $c = qq{ \@r = \$self->$package(\@_); };
- dbg('eval', "cluster cmd = $c\n");
- eval $c;
- if ($@) {
- delete_package($package);
- return (1, "Syserr: Eval err $@ on cached $package");
- }
-
- #take a look if you want
#print Devel::Symdump->rnew($package)->as_string, $/;
- return @r;
+ $package = "DXCommandmode::$package" if $package;
+ return $package;
}
1;
use FileHandle;
use DXUtil;
+use Carp;
%dbglevel = ();
$dbgfh = "";
package DXM;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(msg);
+use DXVars;
%msgs = (
addr => 'Address set to: $_[0]',
e2 => 'Error: $_[0]',
e3 => '$_[0]: $_[1] not found',
e4 => 'Need at least a prefix or callsign',
+ e5 => 'Not Allowed',
email => 'E-mail address set to: $_[0]',
heres => 'Here set on $_[0]',
hereu => 'Here unset on $_[0]',
node => '$_[0] set as AK1A style Node',
nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
+ priv => 'Privilege level changed on $_[0]',
prx => '$main::$mycall >',
talks => 'Talk flag set on $_[0]',
talku => 'Talk flag unset on $_[0]',
my $self = shift;
my $s = $msgs{$self};
return "unknown message '$self'" if !defined $s;
- return eval qq("$s");
+ my $ans = eval qq{ "$s" };
+ confess $@ if $@;
+ return $ans;
}
use Carp;
use strict;
-use vars qw(%work @msg $msgdir %valid);
+use vars qw(%work @msg $msgdir %valid %busy);
%work = (); # outstanding jobs
@msg = (); # messages we have
+%busy = (); # station interlocks
$msgdir = "$main::root/msg"; # directory contain the msgs
%valid = (
$self->{subject} = shift;
$self->{origin} = shift;
$self->{read} = shift;
+ $self->{gotit} = [];
return $self;
}
if ($pcno == 28) { # incoming message
my $t = cltounix($f[5], $f[6]);
my $stream = next_transno($f[2]);
- my $ref = DXMsg->alloc($stream, $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0');
+ my $ref = DXMsg->alloc($stream, $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0', $f[11]);
# fill in various forwarding state variables
$ref->{fromnode} = $f[2];
$ref->{stream} = $stream;
$ref->{count} = 0; # no of lines between PC31s
dbg('msg', "new message from $f[4] to $f[3] '$f[8]' stream $stream\n");
- $work{"$f[1]$f[2]$stream"} = $ref; # store in work
+ $work{"$f[2]$stream"} = $ref; # store in work
+ $busy{$f[2]} = $ref; # set interlock
$self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
last SWITCH;
}
if ($pcno == 29) { # incoming text
- my $ref = $work{"$f[1]$f[2]$f[3]"};
+ my $ref = $work{"$f[2]$f[3]"};
if ($ref) {
push @{$ref->{lines}}, $f[4];
$ref->{count}++;
last SWITCH;
}
- if ($pcno == 30) {
+ if ($pcno == 30) { # this is a incoming subject ack
+ my $ref = $work{$f[2]}; # note no stream at this stage
+ delete $work{$f[2]};
+ $ref->{stream} = $f[3];
+ $ref->{count} = 0;
+ $ref->{linesreq} = 5;
+ $work{"$f[2]$f[3]"} = $ref; # new ref
+ dbg('msg', "incoming subject ack stream $[3]\n");
+ $busy{$f[2]} = $ref; # interlock
+ $ref->{lines} = [];
+ push @{$ref->{lines}}, ($ref->read_msg_body);
+ $ref->send_tranche($self);
last SWITCH;
}
- if ($pcno == 31) {
+ if ($pcno == 31) { # acknowledge a tranche of lines
+ my $ref = $work{"$f[2]$f[3]"};
+ if ($ref) {
+ dbg('msg', "tranche ack stream $f[3]\n");
+ $ref->send_tranche($self);
+ } else {
+ $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
+ }
last SWITCH;
}
if ($pcno == 32) { # incoming EOM
dbg('msg', "stream $f[3]: EOM received\n");
- my $ref = $work{"$f[1]$f[2]$f[3]"};
+ my $ref = $work{"$f[2]$f[3]"};
if ($ref) {
$self->send(DXProt::pc33($f[2], $f[1], $f[3]));# acknowledge it
# get the next msg no - note that this has NOTHING to do with the stream number in PC protocol
- # store the file or message
- # remove extraneous rubbish from the hash
- # remove it from the work in progress vector
- # stuff it on the msg queue
- $ref->{msgno} = next_transno("Msgno") if !$ref->{file};
- $ref->store($ref->{lines});
- $ref->workclean;
- delete $work{"$f[1]$f[2]$f[3]"};
- push @msg, $ref;
+ # store the file or message
+ # remove extraneous rubbish from the hash
+ # remove it from the work in progress vector
+ # stuff it on the msg queue
+ if ($ref->{lines} && @{$ref->{lines}} > 0) { # ignore messages with 0 lines
+ $ref->{msgno} = next_transno("Msgno") if !$ref->{file};
+ push @{$ref->{gotit}}, $f[2]; # mark this up as being received
+ $ref->store($ref->{lines});
+ add_dir($ref);
+ }
+ $ref->stop_msg($self);
+ queue_msg();
+ } else {
+ $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
}
+ queue_msg();
last SWITCH;
}
- if ($pcno == 33) {
+ if ($pcno == 33) { # acknowledge the end of message
+ my $ref = $work{"$f[2]$f[3]"};
+ if ($ref) {
+ if ($ref->{private}) { # remove it if it private and gone off site#
+ $ref->del_msg;
+ } else {
+ push @{$ref->{gotit}}, $f[2]; # mark this up as being received
+ $ref->store($ref->{lines}); # re- store the file
+ }
+ $ref->stop_msg($self);
+ } else {
+ $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
+ }
+ queue_msg();
last SWITCH;
}
dbg('msg', "created directory $fn\n");
}
my $stream = next_transno($f[2]);
- my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0');
+ my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0');
# forwarding variables
$ref->{fromnode} = $f[1];
$ref->{stream} = $stream;
$ref->{count} = 0; # no of lines between PC31s
$ref->{file} = 1;
- $work{"$f[1]$f[2]$stream"} = $ref; # store in work
+ $work{"$f[2]$stream"} = $ref; # store in work
$self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
last SWITCH;
}
+
+ if ($pcno == 42) { # abort transfer
+ dbg('msg', "stream $f[3]: abort received\n");
+ my $ref = $work{"$f[2]$f[3]"};
+ if ($ref) {
+ $ref->stop_msg($self);
+ $ref = undef;
+ }
+
+ last SWITCH;
+ }
}
}
# store a message away on disc or whatever
+#
+# NOTE the second arg is a REFERENCE not a list
sub store
{
my $ref = shift;
my $lines = shift;
# we only proceed if there are actually any lines in the file
- if (@{$lines} == 0) {
+ if (!$lines || @{$lines} == 0) {
return;
}
my $fn = filename($ref->{msgno});
dbg('msg', "To be stored in $fn\n");
-
+
+ # now save the file, overwriting what's there, YES I KNOW OK! (I will change it if it's a problem)
my $fh = new FileHandle "$fn", "w";
if (defined $fh) {
- print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$ref->{private}^$ref->{subject}^$ref->{origin}^$ref->{read}\n";
- print $fh "=== $ref->{fromnode}\n";
+ my $rr = $ref->{rrreq} ? '1' : '0';
+ my $priv = $ref->{private} ? '1': '0';
+ print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{read}^$rr\n";
+ print $fh "=== ", join('^', @{$ref->{gotit}}), "\n";
my $line;
$ref->{size} = 0;
foreach $line (@{$lines}) {
$ref->{size} += (length $line) + 1;
print $fh "$line\n";
}
- $ref->{gotit} = [];
- push @{$ref->{gotit}}, $ref->{fromnode} if $ref->{fromnode};
$fh->close;
dbg('msg', "msg $ref->{msgno} stored\n");
} else {
# remove it from the active message list
@msg = map { $_ != $self ? $_ : () } @msg;
+ # belt and braces (one day I will ask someone if this is REALLY necessary)
+ delete $self->{gotit};
+ delete $self->{list};
+
# remove the file
unlink filename($self->{msgno});
+ dbg('msg', "deleting $self->{msgno}\n");
}
# read in a message header
$line =~ s/^=== //o;
$ref->{gotit} = [];
@f = split /\^/, $line;
- push @{$ref->{goit}}, @f;
+ push @{$ref->{gotit}}, @f;
$ref->{size} = $size;
close($file);
return @out;
}
+# send a tranche of lines to the other end
+sub send_tranche
+{
+ my ($self, $dxchan) = @_;
+ my @out;
+ my $to = $self->{tonode};
+ my $from = $self->{fromnode};
+ my $stream = $self->{stream};
+ my $i;
+
+ for ($i = 0; $i < $self->{linesreq} && $self->{count} < @{$self->{lines}}; $i++, $self->{count}++) {
+ push @out, DXProt::pc29($to, $from, $stream, ${$self->{lines}}[$self->{count}]);
+ }
+ push @out, DXProt::pc32($to, $from, $stream) if $i < $self->{linesreq};
+ $dxchan->send(@out);
+}
+
+
+# find a message to send out and start the ball rolling
+sub queue_msg
+{
+ my $sort = shift;
+ my @nodelist = DXProt::get_all_ak1a();
+ my $ref;
+ my $clref;
+ my $dxchan;
+
+ # bat down the message list looking for one that needs to go off site and whose
+ # nearest node is not busy.
+
+ dbg('msg', "queue msg ($sort)\n");
+ foreach $ref (@msg) {
+ # firstly, is it private and unread? if so can I find the recipient
+ # in my cluster node list offsite?
+ if ($ref->{private}) {
+ if ($ref->{read} == 0) {
+ $clref = DXCluster->get($ref->{to});
+ if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
+ $dxchan = $clref->{dxchan};
+ $ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call);
+ }
+ }
+ } elsif ($sort == undef) {
+ # otherwise we are dealing with a bulletin, compare the gotit list with
+ # the nodelist up above, if there are sites that haven't got it yet
+ # then start sending it - what happens when we get loops is anyone's
+ # guess, use (to, from, time, subject) tuple?
+ my $noderef;
+ foreach $noderef (@nodelist) {
+ next if $noderef->call eq $main::mycall;
+ next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
+
+ # if we are here we have a node that doesn't have this message
+ $ref->start_msg($noderef) if !get_busy($noderef->call);
+ last;
+ }
+ }
+
+ # if all the available nodes are busy then stop
+ last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
+ }
+}
+
+# start the message off on its travels with a PC28
+sub start_msg
+{
+ my ($self, $dxchan) = @_;
+
+ dbg('msg', "start msg $self->{msgno}\n");
+ $self->{linesreq} = 5;
+ $self->{count} = 0;
+ $self->{tonode} = $dxchan->call;
+ $self->{fromnode} = $main::mycall;
+ $busy{$dxchan->call} = $self;
+ $work{"$self->{tonode}"} = $self;
+ $dxchan->send(DXProt::pc28($self->{tonode}, $self->{fromnode}, $self->{to}, $self->{from}, $self->{t}, $self->{private}, $self->{subject}, $self->{origin}, $self->{rrreq}));
+}
+
+# get the ref of a busy node
+sub get_busy
+{
+ my $call = shift;
+ return $busy{$call};
+}
+
+# get the busy queue
+sub get_all_busy
+{
+ return values %busy;
+}
+
+# get the forwarding queue
+sub get_fwq
+{
+ return values %work;
+}
+
+# stop a message from continuing, clean it out, unlock interlocks etc
+sub stop_msg
+{
+ my ($self, $dxchan) = @_;
+ my $node = $dxchan->call;
+
+ dbg('msg', "stop msg $self->{msgno} stream $self->{stream}\n");
+ delete $work{$node};
+ delete $work{"$node$self->{stream}"};
+ $self->workclean;
+ delete $busy{$node};
+}
+
# get a new transaction number from the file specified
sub next_transno
{
$ref = read_msg_header("$msgdir/$_");
next if !$ref;
- # add the clusters that have this
- push @msg, $ref;
+ # add the message to the available queue
+ add_dir($ref);
}
}
+# add the message to the directory listing
+sub add_dir
+{
+ my $ref = shift;
+ confess "tried to add a non-ref to the msg directory" if !ref $ref;
+ push @msg, $ref;
+}
+
# return all the current messages
sub get_all
{
@_ ? $self->{$name} = shift : $self->{$name} ;
}
+sub do_send_stuff
+{
+ my $self = shift;
+ my $line = shift;
+ my @out;
+
+ if ($self->state eq 'send1') {
+# $DB::single = 1;
+ confess "local var gone missing" if !ref $self->{loc};
+ my $loc = $self->{loc};
+ $loc->{subject} = $line;
+ $loc->{lines} = [];
+ $self->state('sendbody');
+ #push @out, $self->msg('sendbody');
+ push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
+ } elsif ($self->state eq 'sendbody') {
+ confess "local var gone missing" if !ref $self->{loc};
+ my $loc = $self->{loc};
+ if ($line eq "\032" || uc $line eq "/EX") {
+ my $to;
+
+ if (@{$loc->{lines}} > 0) {
+ foreach $to (@{$loc->{to}}) {
+ my $ref;
+ my $systime = $main::systime;
+ my $mycall = $main::mycall;
+ $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
+ uc $to,
+ $self->call,
+ $systime,
+ $loc->{private},
+ $loc->{subject},
+ $mycall,
+ $loc->{rrreq});
+ $ref->store($loc->{lines});
+ $ref->add_dir();
+ #push @out, $self->msg('sendsent', $to);
+ push @out, "msgno $ref->{msgno} sent to $to";
+ }
+ }
+ delete $loc->{lines};
+ delete $loc->{to};
+ delete $self->{loc};
+ $self->state('prompt');
+ $self->func(undef);
+ DXMsg::queue_msg();
+ } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
+ #push @out, $self->msg('sendabort');
+ push @out, "aborted";
+ delete $loc->{lines};
+ delete $loc->{to};
+ delete $self->{loc};
+ $self->func(undef);
+ $self->state('prompt');
+ } else {
+
+ # i.e. it ain't and end or abort, therefore store the line
+ push @{$loc->{lines}}, $line;
+ }
+ }
+ return (1, @out);
+}
1;
use DXCommandmode;
use Spot;
use DXProtout;
+use Carp;
use strict;
-use vars qw($me);
+use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour);
-$me = undef; # the channel id for this cluster
+$me = undef; # the channel id for this cluster
+$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
+$pc11_dup_age = 24*3600; # the maximum time to keep the dup list for
+%dup = (); # the pc11 and 26 dup hash
+$last_hour = time; # last time I did an hourly periodic update
sub init
{
# send initialisation string
$self->send(pc38()) if DXNode->get_all();
$self->send(pc18());
- $self->state('normal');
+ $self->state('init');
$self->pc50_t(time);
}
return;
}
- if ($pcno == 11) { # dx spot
+ if ($pcno == 11 || $pcno == 26) { # dx spot
# if this is a 'nodx' node then ignore it
last SWITCH if grep $field[7] =~ /^$_/, @DXProt::nodx_node;
# convert the date to a unix date
my $d = cltounix($field[3], $field[4]);
-# my $date = $field[3];
-# my $time = $field[4];
-# $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/;
-# $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/;
-# my $d = str2time("$date $time");
- return if !$d; # bang out (and don't pass on) if date is invalid
+ return if !$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age); # bang out (and don't pass on) if date is invalid or the spot is too old
# strip off the leading & trailing spaces from the comment
my $text = unpad($field[5]);
# store it away
- Spot::add($field[1], $field[2], $d, $text, $field[6]);
-
- # format and broadcast it to users
my $spotter = $field[6];
$spotter =~ s/-\d+$//o; # strip off the ssid from the spotter
- $spotter .= ':'; # add a colon
+
+ # do some de-duping
+ my $dupkey = "$field[1]$field[2]$d$text$field[6]";
+ return if $dup{$dupkey};
+ $dup{$dupkey} = $d;
+
+ my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter);
# send orf to the users
- my $buf = sprintf "DX de %-7.7s %13.13s %-12.12s %-30.30s %5.5s\a\a", $spotter, $field[1], $field[2], $text, $field[4];
- broadcast_users($buf);
+ if ($spot && $pcno == 11) {
+ my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
+ broadcast_users("$buf\a\a");
+ }
last SWITCH;
}
$user->node($node->call) if !$user->node;
$user->put;
}
+
+ # queue up any messages (look for privates only)
+ DXMsg::queue_msg(1) if $self->state eq 'normal';
last SWITCH;
}
}
if ($pcno == 18) { # link request
-
$self->send_local_config();
$self->send(pc20());
+ $self->state('init');
last SWITCH;
}
next if $ver < 5000; # only works with version 5 software
next if length $call < 3; # min 3 letter callsigns
DXNode->new($self, $call, $confmode, $here, $ver);
+
+ # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
+ my $mref = DXMsg::get_busy($call);
+ $mref->stop_msg($self) if $mref;
}
+
+ # queue up any messages
+ DXMsg::queue_msg() if $self->state eq 'normal';
last SWITCH;
}
if ($pcno == 20) { # send local configuration
$self->send_local_config();
$self->send(pc22());
+ $self->state('normal');
+
+ # queue mail
+ DXMsg::queue_msg();
return;
}
}
if ($pcno == 22) {last SWITCH;}
- if ($pcno == 23) {last SWITCH;}
+
+ if ($pcno == 23 || $pcno == 27) { # WWV info
+ last SWITCH;
+ }
if ($pcno == 24) { # set here status
my $call = uc $field[1];
}
if ($pcno == 25) {last SWITCH;}
- if ($pcno == 26) {last SWITCH;}
- if ($pcno == 27) {last SWITCH;}
if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42) { # mail/file handling
DXMsg::process($self, $line);
$chan->pc50_t($t);
}
}
+
+ my $key;
+ my $val;
+ my $cutoff;
+ if ($main::systime - 3600 > $last_hour) {
+ $cutoff = $main::systime - $pc11_dup_age;
+ while (($key, $val) = each %dup) {
+ delete $dup{$key} if $val < $cutoff;
+ }
+ $last_hour = $main::systime;
+ }
}
#
{
my $self = shift;
my $ref = DXCluster->get($self->call);
+
+ # unbusy and stop and outgoing mail
+ my $mref = DXMsg::get_busy($self->call);
+ $mref->stop_msg($self) if $mref;
# broadcast to all other nodes that all the nodes connected to via me are gone
my @gonenodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all();
use DXUtil;
use DXM;
+use Carp;
use strict;
{
my ($self, $ref) = @_;
my $hops = get_hops(17);
- return "PC17^$self->{call}^$ref->{call}^$hops^";
+ return "PC17^$ref->{call}^$self->{call}^$hops^";
}
# Request init string
# message start (fromnode, tonode, to, from, t, private, subject, origin)
sub pc28
{
- my ($fromnode, $tonode, $to, $from, $t, $private, $subject, $origin) = @_;
+ my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_;
my $date = cldate($t);
my $time = ztime($t);
$private = $private ? '1' : '0';
- return "PC28^$fromnode^$tonode^$to^from^$date^$time^$private^$subject^ ^5^0^ ^$origin^~";
+ $rr = $rr ? '1' : '0';
+ return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~";
}
# message text (from and to node same way round as pc29)
{
my ($fromnode, $tonode, $stream, $text) = @_;
$text =~ s/\^//og; # remove ^
- return "PC29^$fromnode^$tonode^$stream^text^~";
+ return "PC29^$fromnode^$tonode^$stream^$text^~";
}
# subject acknowledge (will have to and from node reversed to pc28)
return "PC33^$fromnode^$tonode^$stream^";
}
-
# send all the DX clusters I reckon are connected
sub pc38
{
# tell the local node to discconnect
sub pc39
{
- my ($ref, $reason) = @_;
- my $call = $ref->call;
+ my ($call, $reason) = @_;
my $hops = get_hops(21);
$reason = "Gone." if !$reason;
return "PC39^$call^$reason^";
}
+# cue up bulletin or file for transfer
+sub pc40
+{
+ my ($to, $from, $fn, $bull) = @_;
+ $bull = $bull ? '1' : '0';
+ return "PC40^$to^$from^$fn^$bull^5^";
+}
+
+# user info
+sub pc41
+{
+ my ($call, $sort, $info) = @_;
+ my $hops = get_hops(41);
+ $sort = $sort ? "$sort" : '0';
+ return "PC41^$call^$sort^$info^$hops^~";
+}
+
+# abort message
+sub pc42
+{
+ my ($fromnode, $tonode, $stream) = @_;
+ return "PC42^$fromnode^$tonode^$stream^";
+}
+
+# bull delete
+sub pc49
+{
+ my ($from, $subject) = @_;
+ my $hops = get_hops(49);
+ return "PC49^$from^$subject^$hops^~";
+}
+
# periodic update of users, plus keep link alive device (always H99)
sub pc50
{
package DXUtil;
use Date::Parse;
+use Carp;
require Exporter;
@ISA = qw(Exporter);
$motd = "$data/motd";
# are we debugging ?
-@debug = ('chan');
+@debug = ('chan', 'state', 'msg');
use FileHandle;
use DXDebug;
+use Carp;
use strict;
use DXVars;
use DB_File;
use Data::Dumper;
+use Carp;
use strict;
use vars qw($db %prefix_loc %pre);
use FileHandle;
use DXVars;
use DXDebug;
+use DXUtil;
use Julian;
use Prefix;
use Carp;
my @dxcc = Prefix::extract($spot[1]);
push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
- $fh->print(join("\^", @spot), "\n");
+ my $buf = join("\^", @spot);
+ $fh->print($buf, "\n");
+
+ return $buf;
}
# search the spot database for records based on the field no and an expression
}
$expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
+# $expr =~ s/\$f(\d)/\$spots[$1]/g; # swap the letter n for the correct field name
dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
# build up eval to execute
- $eval = qq(my \$c;
+ $eval = qq(
+# while (<\$fh>) {
+# chomp;
+# my \@spots = split /\\^/o;
+# if ($expr) { # note NO \$expr
+# \$count++;
+# next if \$count < \$from; # wait until from
+# push(\@out, \\\@spots);
+# last LOOP if \$count >= \$to; # stop after to
+# }
+# }
+ my \$c;
+ my \$ref;
for (\$c = \$#spots; \$c >= 0; \$c--) {
\$ref = \$spots[\$c];
if ($expr) {
push(\@out, \$ref);
last LOOP if \$count >= \$to; # stop after to
}
- });
+ }
+ );
LOOP:
- for ($i = 0; $i < 60; ++$i) {
- my @now = Julian::sub(@fromdate, $i);
+ for ($i = 0; $i < $maxdays; ++$i) { # look thru $maxdays worth of files only
+ my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
last if Julian::cmp(@now, @todate) <= 0;
my @spots = ();
my $in;
foreach $in (<$fh>) {
chomp $in;
- push @spots, [ split('\^', $in) ];
+ push @spots, [ split('\^', $in) ];
}
- my $ref;
eval $eval; # do the search on this file
- return ("error", $@) if $@;
+ return ("Spot search error", $@) if $@;
}
}
# do nothing, unreferencing or overwriting the $self will close it
}
+# format a spot for user output in 'broadcast' mode
+sub formatb
+{
+ my @dx = @_;
+ my $t = ztime($dx[2]);
+ return sprintf "DX de %-9.9s: %9.1f %-12s %-30s<%s>", $dx[4], $dx[0], $dx[1], $dx[3], $t ;
+}
+
+# format a spot for user output in list mode
+sub formatl
+{
+ my @dx = @_;
+ my $t = ztime($dx[2]);
+ my $d = cldate($dx[2]);
+ return sprintf "%9.1f %-12s %s %s %-30s<%s>", $dx[0], $dx[1], $d, $t, $dx[3], $dx[4] ;
+}
+
1;
use Msg;
use DXVars;
+use Carp;
$mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
$call = ""; # the callsign being used
if ($mode) {
$buf =~ s/\r/\n/og if $mode == 1;
$dangle = !($buf =~ /\n$/);
- @lines = split /\n/, $buf;
+ if ($buf eq "\n") {
+ @lines = (" ");
+ } else {
+ @lines = split /\n/, $buf;
+ }
if ($dangle) { # pull off any dangly bits
$buf = pop @lines;
} else {
use DXConnect;
use Prefix;
use Bands;
+use Carp;
package main;
$dxchan->start($line);
} elsif ($sort eq 'D') {
die "\$user not defined for $call" if !defined $user;
- if ($dxchan->{func}) {
- # call an ongoing routine if there is a function specified
- &{$dxchan->{func}} ($dxchan, $line);
- } else {
- # normal input
- $dxchan->normal($line);
- }
+
+ # normal input
+ $dxchan->normal($line);
+
disconnect($dxchan) if ($dxchan->{state} eq 'bye');
} elsif ($sort eq 'Z') {
disconnect($dxchan);
projects / spider.git / commitdiff