]> dxcluster.org Git - spider.git/commitdiff
Started on the dx cluster database stuff
authordjk <djk>
Sat, 20 Jun 1998 17:11:50 +0000 (17:11 +0000)
committerdjk <djk>
Sat, 20 Jun 1998 17:11:50 +0000 (17:11 +0000)
added a load of real and dummy commands to be getting on with
Started some DOCUMENTATION (shock horror)

54 files changed:
cmd/Notes.txt [new file with mode: 0644]
cmd/announce.pl [new file with mode: 0644]
cmd/bye [deleted file]
cmd/bye.pl [new file with mode: 0644]
cmd/create/node.pl [new file with mode: 0644]
cmd/create/user.pl [new file with mode: 0644]
cmd/delete/node.pl [new file with mode: 0644]
cmd/delete/user.pl [new file with mode: 0644]
cmd/dx.pl [new file with mode: 0644]
cmd/set/address.pl [new file with mode: 0644]
cmd/set/announce.pl [new file with mode: 0644]
cmd/set/debug.pl [new file with mode: 0644]
cmd/set/dx.pl [new file with mode: 0644]
cmd/set/email.pl [new file with mode: 0644]
cmd/set/here.pl [new file with mode: 0644]
cmd/set/homenode.pl [new file with mode: 0644]
cmd/set/location.pl [new file with mode: 0644]
cmd/set/name.pl [new file with mode: 0644]
cmd/set/qra [deleted file]
cmd/set/qra.pl [new file with mode: 0644]
cmd/set/qth [deleted file]
cmd/set/qth.pl [new file with mode: 0644]
cmd/set/talk.pl [new file with mode: 0644]
cmd/set/wwv.pl [new file with mode: 0644]
cmd/show/ann.pl [new file with mode: 0644]
cmd/show/channel.pl [new file with mode: 0644]
cmd/show/conf.pl [new file with mode: 0644]
cmd/show/debug.pl [new file with mode: 0644]
cmd/show/talk.pl [new file with mode: 0644]
cmd/show/user [deleted file]
cmd/show/user.pl [new file with mode: 0644]
cmd/show/users.pl [new file with mode: 0644]
cmd/show/version.pl [new file with mode: 0644]
cmd/show/wwv.pl [new file with mode: 0644]
cmd/show/wx.pl [new file with mode: 0644]
cmd/shutdown [deleted file]
cmd/shutdown.pl [new file with mode: 0644]
cmd/talk.pl [new file with mode: 0644]
cmd/unset/announce.pl [new file with mode: 0644]
cmd/unset/debug.pl [new file with mode: 0644]
cmd/unset/dx.pl [new file with mode: 0644]
cmd/unset/here.pl [new file with mode: 0644]
cmd/unset/talk.pl [new file with mode: 0644]
cmd/unset/wwv.pl [new file with mode: 0644]
cmd/wwv.pl [new file with mode: 0644]
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXM.pm
perl/DXProt.pm
perl/DXUser.pm
perl/DXVars.pm
perl/client.pl
perl/cluster.pl
perl/create_sysop.pl

diff --git a/cmd/Notes.txt b/cmd/Notes.txt
new file mode 100644 (file)
index 0000000..3768d2c
--- /dev/null
@@ -0,0 +1,89 @@
+Programming Notes ($Id$)
+
+* Every command that can used on the command line lives in either this
+  directory ('cmd') or in a local version ('local_cmd'). You are cajoled or
+  ordered not to and generally discouraged from altering the commands in
+  the 'cmd' directory. You can put local copies in the 'local_cmd' directory
+  and they will override the standard ones.
+
+* If you want to play, do it in the 'local_cmd' directory. It's very easy and
+  reasonably safe. You can override a command whilst the cluster is running. 
+  Compilation errors will simply give you error messages, it won't stop the
+  cluster running - this only happens if you mess with the internals to the
+  extent that it gets confused...
+
+* A command is a piece of perl, it is simply a small snippet of program
+  that is dynamically loaded into the cluster on invocation from the 
+  command line. The last modification time is used to determine whether to
+  reload it.
+
+* New (or altered) commands are available for test the moment you save them.
+
+* A command is placed into the appropriate directory with a '.pl' appended
+  to the end. So the 'show/qra' command lives in 'cmd/show/qra.pl' (or a
+  local version would be in 'local_cmd/show/qra.pl'.
+
+* For the security conscious, potentially dubious characters (i.e. not 
+  [A-Za-z0-9_/]) are converted to their hex equivalents. This will almost
+  certainly mean that the user will get an error message (unless you have
+  your secret squirrel hat on and have deliberately put such commands up 
+  [in 'local_cmd' of course]).
+
+* The snippets of program you put here are wrapped in an eval { } and
+  are subroutines derived from the DXChannel class. They effectively
+  the following declaration :-
+
+  sub Emb_<cmdname>($self, $args)
+  {
+     ...
+     your code here
+     ...
+  }
+
+* slash characters are replaced by '_' so the equivalent name for 'show/qth'
+  is 'Emb_show_qth'.
+
+* you would normally do a 'my $self = shift;' as the first thing. There
+  are a complete set of accessors for DXUser, DXCommandmode and DXChannel
+  classes and these are the recommended way of getting at these classes.
+  A fairly standard start might be:-
+
+  $self = shift;
+  $call = $self->call;
+  $user = $self->user;
+
+* $args is the rest of the line after the command (as a string).
+
+* You are responsible for maintaining user security. If you have a command
+  that does something a normal system shouldn't be allowed to do or see, 
+  there is $self->priv (using the above example) which gives you the running
+  privilege level of the channel. USE IT!
+
+* The normal privilege levels are:-
+    0 - user privilege.
+    5 - sysop privilege.
+    9 - console privilege.
+
+  The sysop privilege is for things that you are prepared for remote
+  sysops and clusters to do or see.
+
+  A console privilege can only be executed locally (at least if you have
+  correctly installed the client program in inetd or ax25d).
+
+  The set/priv command can only be executed by a console privileged 
+  session.
+
+* You must return a list with a 0 or 1 as the first element. 1 means
+  success and 0 means fail. Each element of the list which follows is 
+  assumed to be one line for output. Don't put \n characters at the end
+  of an element (the client will put the correct one in if required 
+  [but see below]).
+
+* Anything you output with a > as the last character is taken to mean
+  that this is a prompt and will not have a \r or \n appended to it.
+
+* help files can also be placed in the appropriate place. These files 
+  have exactly the same naming conventions as commands except that they
+  have a '.hlp' appended to the command name rather than a '.pl'. All 
+  in the help file are sent to the user except those starting with a '#'
+  character.
diff --git a/cmd/announce.pl b/cmd/announce.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/bye b/cmd/bye
deleted file mode 100644 (file)
index 1fc73f6..0000000
--- a/cmd/bye
+++ /dev/null
@@ -1,9 +0,0 @@
-#
-# the bye command
-#
-# $Id$
-#
-
-my $self = shift;
-$self->state('bye');
-return (1);
diff --git a/cmd/bye.pl b/cmd/bye.pl
new file mode 100644 (file)
index 0000000..1fc73f6
--- /dev/null
@@ -0,0 +1,9 @@
+#
+# the bye command
+#
+# $Id$
+#
+
+my $self = shift;
+$self->state('bye');
+return (1);
diff --git a/cmd/create/node.pl b/cmd/create/node.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/create/user.pl b/cmd/create/user.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/delete/node.pl b/cmd/delete/node.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/delete/user.pl b/cmd/delete/user.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/dx.pl b/cmd/dx.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/address.pl b/cmd/set/address.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/announce.pl b/cmd/set/announce.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/debug.pl b/cmd/set/debug.pl
new file mode 100644 (file)
index 0000000..e5c4658
--- /dev/null
@@ -0,0 +1,15 @@
+#
+# add a debug level
+#
+# $Id$
+#
+
+use DXDebug;
+
+$self = shift;
+return (0) if $self->priv < 9;
+
+dbgadd(split);
+my $set = join ' ', dbglist();
+
+return (1, "Debug Levels now: $set"); 
diff --git a/cmd/set/dx.pl b/cmd/set/dx.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/email.pl b/cmd/set/email.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/here.pl b/cmd/set/here.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/location.pl b/cmd/set/location.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/name.pl b/cmd/set/name.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/qra b/cmd/set/qra
deleted file mode 100644 (file)
index 0b13524..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-#
-# set the qra locator field
-#
-# $Id$
-#
-my ($self, $args)  = @_;
-my $user = $self->user;
-return (1, "qra locator is now ", $user->qra($args));
diff --git a/cmd/set/qra.pl b/cmd/set/qra.pl
new file mode 100644 (file)
index 0000000..0b13524
--- /dev/null
@@ -0,0 +1,8 @@
+#
+# set the qra locator field
+#
+# $Id$
+#
+my ($self, $args)  = @_;
+my $user = $self->user;
+return (1, "qra locator is now ", $user->qra($args));
diff --git a/cmd/set/qth b/cmd/set/qth
deleted file mode 100644 (file)
index 93407a2..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-#
-# set the qth field
-#
-# $Id$
-#
-my ($self, $args)  = @_;
-my $user = $self->user;
-return (1, "qth is now ", $user->qth($args));
diff --git a/cmd/set/qth.pl b/cmd/set/qth.pl
new file mode 100644 (file)
index 0000000..93407a2
--- /dev/null
@@ -0,0 +1,8 @@
+#
+# set the qth field
+#
+# $Id$
+#
+my ($self, $args)  = @_;
+my $user = $self->user;
+return (1, "qth is now ", $user->qth($args));
diff --git a/cmd/set/talk.pl b/cmd/set/talk.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/set/wwv.pl b/cmd/set/wwv.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/ann.pl b/cmd/show/ann.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/channel.pl b/cmd/show/channel.pl
new file mode 100644 (file)
index 0000000..4b4a792
--- /dev/null
@@ -0,0 +1,30 @@
+#
+# show the channel status
+#
+# $Id$
+#
+
+my $self = shift;
+#return (0) if ($self->priv < 9); # only console users allowed
+my @list = split;                # generate a list of callsigns
+@list = ($self->call) if !@list;  # my channel if no callsigns
+
+my $call;
+my @out;
+foreach $call (@list) {
+  my $ref = DXChannel->get($call);
+  return (0, "Channel: $call not found") if !$ref;
+
+  my @fields = $ref->fields;
+  my $field;
+  push @out, "User Information $call";
+  foreach $field (@fields) {
+    my $prompt = $ref->field_prompt($field);
+    my $val = $ref->{$field};
+    push @out, "$prompt: $val";
+  } 
+}
+
+return (1, @out);
+
+
diff --git a/cmd/show/conf.pl b/cmd/show/conf.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/debug.pl b/cmd/show/debug.pl
new file mode 100644 (file)
index 0000000..0d560a4
--- /dev/null
@@ -0,0 +1,16 @@
+#
+# show the debug status
+#
+# $Id$
+#
+
+use DXDebug;
+
+my $self = shift;
+#return (0) if ($self->priv < 9); # only console users allowed
+
+my $set = join ' ', dbglist();   # generate space delimited list
+
+return (1, "debug levels: $set");
+
+
diff --git a/cmd/show/talk.pl b/cmd/show/talk.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/user b/cmd/show/user
deleted file mode 100644 (file)
index eab5895..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-#
-# show either the current user or a nominated set
-#
-# $Id$
-#
-
-my $self = shift;
-my @set = split;      # the list of users you want listings (may be null)
-
-@set = ($self->call) if !@set;   # my call if no args
-
-my ($call, $field);
-my @fields = DXUser->fields();
-foreach $call (@set) {
-  my $user = DXUser->get($call);
-}
-
-
diff --git a/cmd/show/user.pl b/cmd/show/user.pl
new file mode 100644 (file)
index 0000000..919fda6
--- /dev/null
@@ -0,0 +1,32 @@
+#
+# show either the current user or a nominated set
+#
+# $Id$
+#
+
+my $self = shift;
+#return (0) if ($self->priv < 9); # only console users allowed
+my @list = split;                # generate a list of callsigns
+@list = ($self->call) if !@list;  # my channel if no callsigns
+
+my $call;
+my @out;
+foreach $call (@list) {
+  my $ref = DXUser->get($call);
+  return (0, "User: $call not found") if !$ref;
+
+  my @fields = $ref->fields;
+  my $field;
+  push @out, "User Information $call";
+  foreach $field (@fields) {
+    my $prompt = $ref->field_prompt($field);
+    my $val = $ref->{$field};
+    push @out, "$prompt: $val";
+  } 
+}
+
+return (1, @out);
+
+
+
+
diff --git a/cmd/show/users.pl b/cmd/show/users.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/version.pl b/cmd/show/version.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/wwv.pl b/cmd/show/wwv.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/show/wx.pl b/cmd/show/wx.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/shutdown b/cmd/shutdown
deleted file mode 100644 (file)
index dea787a..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-#
-# the shutdown command
-# 
-# $Id$
-#
-&main::cease();
diff --git a/cmd/shutdown.pl b/cmd/shutdown.pl
new file mode 100644 (file)
index 0000000..43b6fb7
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# the shutdown command
+# 
+# $Id$
+#
+my $self = shift;
+if ($self->priv >= 5) {
+  &main::cease();
+}
+return (0);
diff --git a/cmd/talk.pl b/cmd/talk.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/unset/announce.pl b/cmd/unset/announce.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/unset/debug.pl b/cmd/unset/debug.pl
new file mode 100644 (file)
index 0000000..78a8252
--- /dev/null
@@ -0,0 +1,15 @@
+#
+# add a debug level
+#
+# $Id$
+#
+
+use DXDebug;
+
+$self = shift;
+return (0) if $self->priv < 9;
+
+dbgsub(split);
+my $set = join ' ', dbglist();
+
+return (1, "Debug Levels now: $set"); 
diff --git a/cmd/unset/dx.pl b/cmd/unset/dx.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/unset/talk.pl b/cmd/unset/talk.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/unset/wwv.pl b/cmd/unset/wwv.pl
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/cmd/wwv.pl b/cmd/wwv.pl
new file mode 100644 (file)
index 0000000..e69de29
index 093bfb003ca2ae6e9b824f0e097d8e8f4eb48d6a..cfa3d150fe1b3f3ff6220135e81dd6264480fbcd 100644 (file)
@@ -28,6 +28,7 @@ package DXChannel;
 use Msg;
 use DXUtil;
 use DXM;
+use DXDebug;
 
 %channels = undef;
 
@@ -41,10 +42,11 @@ use DXM;
   oldstate => 'Last State',
   list => 'Dependant DXChannels list',
   name => 'User Name',
+  connsort => 'Connection Type'
 );
 
 
-# create a new connection object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
+# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
 sub new
 {
   my ($pkg, $call, $conn, $user) = @_;
@@ -61,21 +63,21 @@ sub new
   return $channels{$call} = $self;
 }
 
-# obtain a connection object by callsign [$obj = DXChannel->get($call)]
+# obtain a channel object by callsign [$obj = DXChannel->get($call)]
 sub get
 {
   my ($pkg, $call) = @_;
-  return $connect{$call};
+  return $channels{$call};
 }
 
-# obtain all the connection objects
+# obtain all the channel objects
 sub get_all
 {
   my ($pkg) = @_;
   return values(%channels);
 }
 
-# obtain a connection object by searching for its connection reference
+# obtain a channel object by searching for its connection reference
 sub get_by_cnum
 {
   my ($pkg, $conn) = @_;
@@ -87,7 +89,7 @@ sub get_by_cnum
   return undef;
 }
 
-# get rid of a connection object [$obj->del()]
+# get rid of a channel object [$obj->del()]
 sub del
 {
   my $self = shift;
@@ -115,10 +117,8 @@ sub send_now
     my $line;
        
     foreach $line (@_) {
-      my $t = atime;
          chomp $line;
-      print main::DEBUG "$t -> $sort $call $line\n" if defined DEBUG;
-         print "-> $sort $call $line\n";
+      dbg('chan', "-> $sort $call $line\n");
       $conn->send_now("$sort$call|$line");
        }
   }
@@ -144,10 +144,8 @@ sub send              # this is always later and always data
     my $line;
 
     foreach $line (@_) {
-      my $t = atime;
          chomp $line;
-         print main::DEBUG "$t -> D $call $line\n" if defined DEBUG;
-         print "-> D $call $line\n";
+         dbg('chan', "-> D $call $line\n");
          $conn->send_later("D$call|$line");
        }
   }
@@ -180,10 +178,30 @@ 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;
+  dbg('state', "$self->{call} channel state $self->{oldstate} -> $self->{state}\n");
 }
 
 # various access routines
+
+#
+# return a list of valid elements 
+# 
+
+sub fields
+{
+  return keys(%valid);
+}
+
+#
+# return a prompt for a field
+#
+
+sub field_prompt
+{ 
+  my ($self, $ele) = @_;
+  return $valid{$ele};
+}
+
 sub AUTOLOAD
 {
   my $self = shift;
index d8e1ac1048c1d4bb226280e9f8adc8803b820851..6a3603abd306f75b1260d243ae80340732026143 100644 (file)
@@ -15,6 +15,7 @@ use DXUtil;
 use DXChannel;
 use DXUser;
 use DXVars;
+use DXDebug;
 
 use strict;
 use vars qw( %Cache $last_dir_mtime @cmd);
@@ -28,16 +29,19 @@ $last_dir_mtime = 0;          # the last time one of the cmd dirs was modified
 
 sub start
 { 
-  my $self = shift;
+  my ($self, $line) = @_;
   my $user = $self->{user};
   my $call = $self->{call};
   my $name = $self->{name};
   $name = $call if !defined $name;
+
   $self->msg('l2',$name);
   $self->send_file($main::motd) if (-e $main::motd);
   $self->msg('pr', $call);
   $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
+  $self->{priv} = $user->priv;
+  $self->{priv} = 0 if $line =~ /^(ax|te)/;     # set the connection priv to 0 - can be upgraded later
+  $self->{consort} = $line;                # save the connection type
 }
 
 #
@@ -162,7 +166,7 @@ sub eval_file {
   my $path = shift;
   my $cmdname = shift;
   my $package = valid_package_name($cmdname);
-  my $filename = "$path/$cmdname";
+  my $filename = "$path/$cmdname.pl";
   my $mtime = -M $filename;
   
   # return if we can't find it
@@ -184,7 +188,14 @@ sub eval_file {
                
     #wrap the code into a subroutine inside our unique package
        my $eval = qq{package DXChannel; sub $package { $sub; }};
-       print "eval $eval\n";
+       if (isdbg('eval')) {
+         my @list = split /\n/, $eval;
+         my $line;
+         foreach (@list) {
+           dbg('eval', $_, "\n");
+         }
+       }
+       #print "eval $eval\n";
        {
          #hide our variables within this block
          my($filename,$mtime,$package,$sub);
@@ -201,7 +212,7 @@ sub eval_file {
   
   my @r;
   my $c = qq{ \@r = \$self->$package(\@_); };
-  print "c = $c\n";
+  dbg('eval', "cluster cmd = $c\n");
   eval  $c; ;
   if ($@) {
     delete_package($package);
index 435e32f94ba4fdd50b59b2ada81576f079046bcd..9be309894b8e7402c4cffa5cdf43f1f9eb2ff22f 100644 (file)
@@ -26,6 +26,8 @@ require Exporter;
   pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
   e1 => 'Invalid command',
   e2 => 'Error: $_[0]',
+  conother => 'Sorry $_[0] you are connected on another port',
+  concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster',
 );
 
 sub msg
index f0a0a3b27d07f1f8885dc5ef54bf537f595d39e0..92e3b0d0e1d24e27944f250a228e629e4d268ba0 100644 (file)
@@ -15,6 +15,7 @@ use DXUtil;
 use DXChannel;
 use DXUser;
 use DXM;
+use DXCluster;
 
 # this is how a pc connection starts (for an incoming connection)
 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
@@ -22,6 +23,13 @@ use DXM;
 sub start
 {
   my $self = shift;
+  my $call = $self->call;
+  
+  # do we have him connected on the cluster somewhere else?
+  if (DXCluster->get
+  $self->pc38();
+  $self->pc18();
+  $self->{state} = 'incoming';
 }
 
 #
@@ -48,6 +56,10 @@ sub finish
 {
 
 }
+#
+# All the various PC routines
+#
 
 1;
 __END__ 
index 101340c8e16be12ceac1c627f09a2359fb7b5d06..f5f7e0491f561351c0a146c5c98cdbcf3b1993b6 100644 (file)
@@ -131,7 +131,7 @@ sub close
 # return a list of valid elements 
 # 
 
-sub elements
+sub fields
 {
   return keys(%valid);
 }
@@ -140,7 +140,7 @@ sub elements
 # return a prompt for a field
 #
 
-sub prompt
+sub field_prompt
 { 
   my ($self, $ele) = @_;
   return $valid{$ele};
index beab79530728bea1cfe716b9e5c871dcaa6b8eb5..39549e64db576dfcc699df6aa858d806de5a881e 100644 (file)
@@ -84,4 +84,4 @@ $userfn = "$data/users";
 $motd = "$data/motd";
 
 # are we debugging ?
-$debug = 1;
+@debug = ('chan');
index b2dcfa3a7223d4cebba279b334de3e66a7525d64..c3efad349185290ce4161c976d8bffef90ce27fc 100755 (executable)
@@ -20,11 +20,12 @@ BEGIN {
 use Msg;
 use DXVars;
 
-$mode = 1;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
+$mode = 2;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
 $call = "";                     # the callsign being used
 @stdoutq = ();                  # the queue of stuff to send out to the user
 $conn = 0;                      # the connection object for the cluster
 $lastbit = "";                  # the last bit of an incomplete input line
+$mynl = "\n";                   # standard terminator
 
 # cease communications
 sub cease
@@ -45,16 +46,11 @@ sub sig_term
 sub setmode
 {
   if ($mode == 1) {
-    $nl = "\r";
+    $mynl = "\r";
   } else {
-       $nl = "\n";
-  }
-  $/ = $nl;
-  if ($mode == 0) {
-    $\ = undef;
-  } else {
-    $\ = $nl;
+       $mynl = "\n";
   }
+  $/ = $mynl;
 }
 
 # handle incoming messages
@@ -68,9 +64,12 @@ sub rec_socket
     my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
        
        if ($sort eq 'D') {
-          $nl = "" if $mode == 0;
+          my $snl = $mynl;
+          $snl = "" if $mode == 0;
+          $snl = ' ' if ($mode && $line =~ />$/);
           $line =~ s/\n/\r/og if $mode == 1;
-          print $line;
+          #my $p = qq($line$snl);
+          print $line, $snl;
        } elsif ($sort eq 'M') {
          $mode = $line;               # set new mode from cluster
       setmode();
@@ -115,12 +114,13 @@ sub rec_stdin
   }
 }
 
-$call = uc $ARGV[0];
-die "client.pl <call> [<mode>]\r\n" if (!$call);
-$mode = $ARGV[1] if (@ARGV > 1);
+$call = uc shift @ARGV;
+$call = uc $mycall if !$call; 
+$connsort = lc shift @ARGV;
+$connsort = 'local' if !$connsort;
+$mode = ($connsort =~ /^ax/) ? 1 : 2;
 setmode();
 
-
 #select STDOUT; $| = 1;
 STDOUT->autoflush(1);
 
@@ -129,7 +129,7 @@ $SIG{'TERM'} = \&sig_term;
 $SIG{'HUP'} = \&sig_term;
 
 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
-$conn->send_now("A$call|start");
+$conn->send_now("A$call|$connsort");
 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 Msg->event_loop();
 
index 8da9fe00ec069578b9e52f102400ad23932a4971..435d00873768fce04a968f74434151a40aa09c15 100755 (executable)
@@ -20,6 +20,8 @@ use DXUser;
 use DXM;
 use DXCommandmode;
 use DXProt;
+use DXCluster;
+use DXDebug;
 
 package main;
 
@@ -57,6 +59,28 @@ sub rec
         $user = DXUser->new($call) if !defined $user;
         $user->sort('U') if (!$user->sort());
         my $sort = $user->sort();
+        
+        # is there one already connected?
+        if (DXChannel->get($call)) {
+          my $mess = DXM::msg('conother', $call);
+          dbg('chan', "-> D $call $mess\n"); 
+       $conn->send_now("D$call|$mess");
+          dbg('chan', "-> Z $call bye\n");
+       $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
+          return;
+     }
+
+        # is there one already connected elsewhere in the cluster?
+        if (DXCluster->get($call)) {
+          my $mess = DXM::msg('concluster', $call);
+          dbg('chan', "-> D $call $mess\n"); 
+       $conn->send_now("D$call|$mess");
+          dbg('chan', "-> Z $call bye\n");
+       $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
+          return;
+     }
+
+        # create the channel
      $dxchan = DXCommandmode->new($call, $conn, $user) if ($sort eq 'U');
      $dxchan = DXProt->new($call, $conn, $user) if ($sort eq 'A');
         die "Invalid sort of user on $call = $sort" if !$dxchan;
@@ -98,8 +122,7 @@ 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";
+  dbg('chan', "<- $sort $call $line\n");
   
   # handle A records
   my $user = $dxchan->user;
@@ -123,9 +146,11 @@ sub process_inqueue
 #############################################################
 
 # open the debug file, set various FHs to be unbuffered
-open(DEBUG, ">>$debugfn") or die "can't open $debugfn($!)";
-select DEBUG; $| = 1;
-select STDOUT; $| = 1;
+dbginit($debugfn);
+foreach(@debug) {
+  dbgadd($_);
+}
+STDOUT->autoflush(1);
 
 # initialise User file system
 DXUser->init($userfn);
index 43d59785899e31ee1754a5584f43f1544b555fc8..a08bb9fffc441bcebdacf7d438ceb805b9de5daa 100755 (executable)
@@ -25,7 +25,7 @@ sub create_it
   $self->{long} = $mylongtitude;
   $self->{email} = $myemail;
   $self->{bbsaddr} = $mybbsaddr;
-  $self->{sort} = 'C';           # C - Console user, S - Spider cluster, A - AK1A, U - User, B - BBS
+  $self->{sort} = 'U';           # C - Console user, S - Spider cluster, A - AK1A, U - User, B - BBS
   $self->{priv} = 9;             # 0 - 9 - with 9 being the highest
   $self->{lastin} = 0;