From 625ce0adf070a7e900fa03714a391652db0c065a Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Thu, 18 Jun 1998 22:29:47 +0000
Subject: [PATCH] fixed a couple of errors and done a bit of tidying
---
perl/DXChannel.pm | 18 ++++++++++++++----
perl/DXCommandmode.pm | 19 +++++++++++++------
perl/DXVars.pm | 3 +++
perl/cluster.pl | 5 +++--
4 files changed, 33 insertions(+), 12 deletions(-)
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 065a78c8..9ba985a6 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -46,6 +46,7 @@ sub new
$self->{user} = $user if defined $user;
$self->{t} = time;
$self->{state} = 0;
+ $self->{oldstate} = 0;
bless $self, $pkg;
return $channels{$call} = $self;
}
@@ -106,8 +107,8 @@ sub send_now
foreach $line (@_) {
my $t = atime;
chomp $line;
- print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG;
- print "> $sort $call $line\n";
+ print main::DEBUG "$t -> $sort $call $line\n" if defined DEBUG;
+ print "-> $sort $call $line\n";
$conn->send_now("$sort$call|$line");
}
}
@@ -135,8 +136,8 @@ sub send # this is always later and always data
foreach $line (@_) {
my $t = atime;
chomp $line;
- print main::DEBUG "$t > D $call $line\n" if defined DEBUG;
- print "> D $call $line\n";
+ print main::DEBUG "$t -> D $call $line\n" if defined DEBUG;
+ print "-> D $call $line\n";
$conn->send_later("D$call|$line");
}
}
@@ -163,5 +164,14 @@ sub msg
$self->send(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;
+ print "Db $self->{call} channel state $self->{oldstate} -> $self->{state}\n" if $main::debug;
+}
+
1;
__END__;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index fb2957da..ae016cc6 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -34,7 +34,7 @@ sub user_start
$self->msg('l2',$name);
$self->send_file($main::motd) if (-e $main::motd);
$self->msg('pr', $call);
- $self->{state} = 10; # a bit of room for further expansion, passwords etc
+ $self->state('prompt'); # a bit of room for further expansion, passwords etc
$self->{priv} = 0; # set the connection priv to 0 - can be upgraded later
}
@@ -52,12 +52,19 @@ sub user_normal
scan_cmd_dirs if (!defined %cmd);
# strip out any nasty characters like $@%&|. and double // etc.
- $cmd =~ s/[\%\@\$\&\|\.\`\~]//og;
+ $cmd =~ s/[%\@\$&\\.`~]//og;
$cmd =~ s|//|/|og;
# split the command up into parts
- my @parts = split |[/\b]+|, $cmd;
-
+ my @part = split /[\/\b]+/, $cmd;
+
+ # the bye command - temporary probably
+ if ($part[0] =~ /^b/io) {
+ $self->user_finish();
+ $self->state('bye');
+ return;
+ }
+
# first expand out the entry to a command, note that I will accept
# anything in any case with any (reasonable) seperator
$self->prompt();
@@ -150,7 +157,7 @@ sub eval_file {
my($self, $path, $cmdname) = @_;
my $package = valid_package_name($cmdname);
my $filename = "$path/$cmdname";
- my $mtime = -m $filename;
+ my $mtime = -M $filename;
my @r;
if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) {
@@ -179,7 +186,7 @@ sub eval_file {
}
#cache it unless we're cleaning out each time
- $Cache{$package}{mtime} = $mtime unless $delete;
+ $Cache{$package}{mtime} = $mtime;
}
@r = eval {$package->handler;};
diff --git a/perl/DXVars.pm b/perl/DXVars.pm
index 11c26012..beab7953 100644
--- a/perl/DXVars.pm
+++ b/perl/DXVars.pm
@@ -82,3 +82,6 @@ $userfn = "$data/users";
# the "message of the day" file
$motd = "$data/motd";
+
+# are we debugging ?
+$debug = 1;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index bdd1f7d9..2f96af88 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -98,8 +98,8 @@ sub process_inqueue
my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/;
# do the really sexy console interface bit! (Who is going to do the TK interface then?)
- print DEBUG atime, " < $sort $call $line\n" if defined DEBUG;
- print "< $sort $call $line\n";
+ print DEBUG atime, " <- $sort $call $line\n" if defined DEBUG;
+ print "<- $sort $call $line\n";
# handle A records
my $user = $dxchan->{user};
@@ -117,6 +117,7 @@ sub process_inqueue
} else {
$dxchan->user_normal($line);
}
+ disconnect($dxchan) if ($dxchan->{state} eq 'bye');
} elsif ($sort eq 'Z') {
disconnect($dxchan);
} else {
--
2.43.0