]> scm.dxcluster.org Git - spider.git/commitdiff
added directory command + dummy read, send and reply
authordjk <djk>
Wed, 30 Sep 1998 22:13:18 +0000 (22:13 +0000)
committerdjk <djk>
Wed, 30 Sep 1998 22:13:18 +0000 (22:13 +0000)
added more functionality to the messaging generally
started the looking at outgoing calls
put some hooks in for Cron and Connects

cmd/directory.pl [new file with mode: 0644]
cmd/read.pl [new file with mode: 0644]
cmd/reply.pl [new file with mode: 0644]
cmd/send.pl [new file with mode: 0644]
perl/DXChannel.pm
perl/DXConnect.pm [new file with mode: 0644]
perl/DXCron.pm [new file with mode: 0644]
perl/DXMsg.pm
perl/call.pl [new file with mode: 0755]
perl/client.pl
perl/cluster.pl

diff --git a/cmd/directory.pl b/cmd/directory.pl
new file mode 100644 (file)
index 0000000..d1b91ff
--- /dev/null
@@ -0,0 +1,22 @@
+#
+# show the contents of the message directory
+#
+# Copyright (c) Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @ref = DXMsg::get_all();
+my $ref;
+my @out;
+
+foreach $ref (@ref) {
+  next if $self->priv < 5 && $ref->private && $ref->to ne $self->call;
+  push @out, sprintf "%6d %s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", 
+    $ref->msgno, $ref->private ? 'p' : ' ', $ref->read ? '-' : ' ', $ref->size,
+       $ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject;
+}
+
+return (1, @out);
diff --git a/cmd/read.pl b/cmd/read.pl
new file mode 100644 (file)
index 0000000..c72be60
--- /dev/null
@@ -0,0 +1,7 @@
+#
+# read a message
+#
+# Copyright (c) Dirk Koopman G1TLH
+#
+# $Id$
+#
diff --git a/cmd/reply.pl b/cmd/reply.pl
new file mode 100644 (file)
index 0000000..a05e3cb
--- /dev/null
@@ -0,0 +1,7 @@
+#
+# reply to a message
+#
+# Copyright (c) Dirk Koopman G1TLH
+#
+# $Id$
+#
diff --git a/cmd/send.pl b/cmd/send.pl
new file mode 100644 (file)
index 0000000..aabf217
--- /dev/null
@@ -0,0 +1,7 @@
+#
+# send a message
+#
+# Copyright (c) Dirk Koopman G1TLH
+#
+# $Id$
+#
index 5a9ca3b2de56c41bfae40ef7f480c28e840a8f4f..d21497bdc4222b870945eff5a6d5d97560321098 100644 (file)
@@ -58,6 +58,7 @@ use vars qw(%channels %valid);
   dx => '0,DX Spots,yesno',
   redirect => '0,Redirect messages to',
   lang => '0,Language',
+  func => '9,Function',
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
@@ -124,6 +125,13 @@ sub is_user
   return $self->{sort} eq 'U';
 }
 
+# is it a connect type
+sub is_connect
+{
+  my $self = shift;
+  return $self->{sort} eq 'C';
+}
+
 # handle out going messages, immediately without waiting for the select to drop
 # this could, in theory, block
 sub send_now
@@ -187,7 +195,7 @@ sub state
   my $self = shift;
   $self->{oldstate} = $self->{state};
   $self->{state} = shift;
-  dbg('state', "$self->{call} channel state $self->{oldstate} -> $self->{state}\n");
+  dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
 }
 
 # disconnect this channel
diff --git a/perl/DXConnect.pm b/perl/DXConnect.pm
new file mode 100644 (file)
index 0000000..30cd77f
--- /dev/null
@@ -0,0 +1,32 @@
+#
+# module to manage outgoing connections and things
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXConnect;
+
+@ISA = qw(DXChannel);
+
+use DXUtil;
+use DXM;
+use DXDebug;
+use Carp;
+
+use strict;
+
+sub init
+{
+
+}
+
+sub process
+{
+
+}
+
+1;
+__END__
+
diff --git a/perl/DXCron.pm b/perl/DXCron.pm
new file mode 100644 (file)
index 0000000..dd78edd
--- /dev/null
@@ -0,0 +1,31 @@
+#
+# module to timed tasks
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXCron;
+
+use DXUtil;
+use DXM;
+use DXDebug;
+use Carp;
+
+use strict;
+
+# cron initialisation / reading in cronjobs
+sub init
+{
+
+}
+
+# process the cronjobs
+sub process
+{
+
+}
+
+1;
+__END__
index ea4a0791d8ca7ba6c121f59fec7e0fe5554d8305..e949c6827223b4b5f2b8c8079854f6051c0748ce 100644 (file)
@@ -23,11 +23,33 @@ use FileHandle;
 use Carp;
 
 use strict;
-use vars qw($stream %work @msg $msgdir $msgnofn);
+use vars qw(%work @msg $msgdir %valid);
 
 %work = ();                # outstanding jobs
 @msg = ();                 # messages we have
-$msgdir = "$main::data/msg";              # directory contain the msgs
+$msgdir = "$main::root/msg";              # directory contain the msgs
+
+%valid = (
+  fromnode => '9,From Node',
+  tonode => '9,To Node',
+  to => '0,To',
+  from => '0,From',
+  t => '0,Msg Time,cldatetime',
+  private => '9,Private',
+  subject => '0,Subject',
+  linesreq => '0,Lines per Gob',
+  rrreq => '9,Read Confirm',
+  origin => '0,Origin',
+  lines => '5,Data',
+  stream => '9,Stream No',
+  count => '9,Gob Linecnt',
+  file => '9,File?,yesno',
+  gotit => '9,Got it Nodes,parray',
+  lines => '9,Lines,parray',
+  read => '9,Times read',
+  size => '0,Size',
+  msgno => '0,Msgno',
+);
 
 # allocate a new object
 # called fromnode, tonode, from, to, datetime, private?, subject, nolinesper  
@@ -35,19 +57,15 @@ sub alloc
 {
   my $pkg = shift;
   my $self = bless {}, $pkg;
-  $self->{fromnode} = shift;
-  $self->{tonode} = shift;
+  $self->{msgno} = shift;
   $self->{to} = shift;
   $self->{from} = shift;
   $self->{t} = shift;
   $self->{private} = shift;
   $self->{subject} = shift;
-  $self->{linesreq} = shift;    # this the number of lines to send or receive between PC31s
-  $self->{rrreq} = shift;       # a read receipt is required
   $self->{origin} = shift;
-  $self->{stream} = shift;
-  $self->{lines} = [];
-  
+  $self->{read} = shift;
+    
   return $self;
 }
 
@@ -57,7 +75,11 @@ sub workclean
   delete $ref->{lines};
   delete $ref->{linesreq};
   delete $ref->{tonode};
+  delete $ref->{fromnode};
   delete $ref->{stream};
+  delete $ref->{lines};
+  delete $ref->{file};
+  delete $ref->{count};
 }
 
 sub process
@@ -70,11 +92,18 @@ sub process
     if ($pcno == 28) {                        # incoming message
          my $t = cltounix($f[5], $f[6]);
          my $stream = next_transno($f[2]);
-         my $ref = DXMsg->alloc($f[1], $f[2], $f[3], $f[4], $t, $f[7], $f[8], $f[10], $f[11], $f[13], $stream);
+         my $ref = DXMsg->alloc($stream, $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0');
+         
+         # fill in various forwarding state variables
+      $ref->{fromnode} = $f[2];
+      $ref->{tonode} = $f[1];
+         $ref->{rrreq} = $f[11];
+         $ref->{linesreq} = $f[10];
+         $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
-         $self->send(DXProt::pc30($f[2], $f[1], $stream)); 
-         $ref->{count} = 0;                      # no of lines between PC31s
+         $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
          last SWITCH;
        }
        
@@ -105,7 +134,8 @@ sub process
          my $ref = $work{"$f[1]$f[2]$f[3]"};
          if ($ref) {
            $self->send(DXProt::pc33($f[2], $f[1], $f[3]));# acknowledge it
-               $ref->store();                         # store it (whatever that may mean)
+               $ref->store($ref->{lines});                    # store it (whatever that may mean)
+               $ref->workclean;
                delete $work{"$f[1]$f[2]$f[3]"};       # remove the reference from the work vector
          }
          last SWITCH;
@@ -120,7 +150,7 @@ sub process
          $f[3] =~ s/\.//og;                       # remove dots
          $f[3] = lc $f[3];                        # to lower case;
          dbg('msg', "incoming file $f[3]\n");
-         last SWITCH if $f[3] =~ /^\/(perl|cmd|local_cmd|src|lib|include|sys|data\/msg)\//;    # prevent access to executables
+         last SWITCH if $f[3] =~ /^\/(perl|cmd|local_cmd|src|lib|include|sys|msg)\//;    # prevent access to executables
          
          # create any directories
          my @part = split /\//, $f[3];
@@ -134,11 +164,17 @@ sub process
         dbg('msg', "created directory $fn\n");
          }
          my $stream = next_transno($f[2]);
-         my $ref = DXMsg->alloc($f[1], $f[2], "$main::root/$f[3]", undef, time, !$f[4], undef, $f[5], 0, ' ', $stream);
+         my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0');
+         
+         # forwarding variables
+      $ref->{fromnode} = $f[1];
+      $ref->{tonode} = $f[2];
+         $ref->{linesreq} = $f[5];
+         $ref->{stream} = $stream;
+         $ref->{count} = 0;                      # no of lines between PC31s
          $ref->{file} = 1;
       $work{"$f[1]$f[2]$stream"} = $ref;         # store in work
-         $self->send(DXProt::pc30($f[2], $f[1], $stream)); 
-         $ref->{count} = 0;                      # no of lines between PC31s
+         $self->send(DXProt::pc30($f[2], $f[1], $stream));  # send ack 
          
          last SWITCH;
        }
@@ -150,10 +186,10 @@ sub process
 sub store
 {
   my $ref = shift;
+  my $lines = shift;
   
   # we only proceed if there are actually any lines in the file
-  if (@{$ref->{lines}} == 0) {
-    delete $ref->{lines};
+  if (@{$lines} == 0) {
        return;
   }
   
@@ -163,7 +199,7 @@ sub store
     my $fh = new FileHandle "$ref->{to}", "w";
        if (defined $fh) {
          my $line;
-         foreach $line (@{$ref->{lines}}) {
+         foreach $line (@{$lines}) {
                print $fh "$line\n";
          }
          $fh->close;
@@ -171,26 +207,29 @@ sub store
     } else {
       confess "can't open file $ref->{to} $!";  
     }
+#      push @{$ref->{gotit}}, $ref->{fromnode} if $ref->{fromnode};
   } else {              # a normal message
 
     # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol
-       my $msgno = next_transno("msgno");
+       my $msgno = next_transno("Msgno");
 
     # attempt to open the message file
-       my $fn = sprintf "$msgdir/m%06d", $msgno;
+       my $fn = filename($msgno);
 
     dbg('msg', "To be stored in $fn\n");
   
     my $fh = new FileHandle "$fn", "w";
        if (defined $fh) {
-      print $fh "=== $ref->{to}^$ref->{from}^$ref->{private}^$ref->{subject}^$ref->{origin}\n";
+      print $fh "=== $msgno^$ref->{to}^$ref->{from}^$ref->{t}^$ref->{private}^$ref->{subject}^$ref->{origin}^$ref->{read}\n";
          print $fh "=== $ref->{fromnode}\n";
          my $line;
-         foreach $line (@{$ref->{lines}}) {
-        $ref->{size} += length $line + 1;
+         foreach $line (@{$lines}) {
+        $ref->{size} += (length $line) + 1;
                print $fh "$line\n";
          }
-         $ref->workclean();
+         $ref->{gotit} = [];
+         $ref->{msgno} = $msgno;
+         push @{$ref->{gotit}}, $ref->{fromnode} if $ref->{fromnode};
          push @msg, $ref;           # add this message to the incore message list
          $fh->close;
          dbg('msg', "msg $msgno stored\n");
@@ -200,6 +239,86 @@ sub store
   }
 }
 
+# delete a message
+sub del_msg
+{
+  my $self = shift;
+
+  # remove it from the active message list
+  @msg = map { $_ != $self ? $_ : () } @msg;
+  
+  # remove the file
+  unlink filename($self->{msgno});
+}
+
+# read in a message header
+sub read_msg_header
+{ 
+  my $fn = shift;
+  my $file;
+  my $line;
+  my $ref;
+  my @f;
+  my $size;
+
+  $file = new FileHandle;
+  if (!open($file, $fn)) {
+    print "Error reading $fn $!\n";
+    return undef;
+  }
+  $size = -s $fn;
+  $line = <$file>;       # first line
+  chomp $line;
+  $size -= length $line;
+  if (! $line =~ /^===/o) {
+    print "corrupt first line in $fn ($line)\n";
+    return undef;
+  }
+  $line =~ s/^=== //o;
+  @f = split /\^/, $line;
+  $ref = DXMsg->alloc(@f);
+  
+  $line = <$file>;       # second line
+  chomp $line;
+  $size -= length $line;
+  if (! $line =~ /^===/o) {
+    print "corrupt second line in $fn ($line)\n";
+    return undef;
+  }
+  $line =~ s/^=== //o;
+  $ref->{gotit} = [];
+  @f = split /\^/, $line;
+  push @{$ref->{goit}}, @f;
+  $ref->{size} = $size;
+  close($file);
+  
+  return $ref;
+}
+
+# read in a message header
+sub read_msg_body
+{
+  my $self = shift;
+  my $msgno = $self->{msgno};
+  my $file;
+  my $line;
+  my $fn = filename($msgno);
+  my @out;
+
+  $file = new FileHandle;
+  if (!open($file, $fn)) {
+    print "Error reading $fn $!\n";
+    return undef;
+  }
+  chomp (@out = <$file>);
+  close($file);
+  
+  shift @out if $out[0] =~ /^=== \d+\^/;
+  shift @out if $out[0] =~ /^=== \d+\^/;
+  return @out;
+}
+
 # get a new transaction number from the file specified
 sub next_transno
 {
@@ -224,12 +343,75 @@ sub next_transno
   return $msgno;
 }
 
-# initialise the message 'system'
+# initialise the message 'system', read in all the message headers
 sub init
 {
+  my $dir = new FileHandle;
+  my @dir;
+  my $ref;
 
+  # read in the directory
+  opendir($dir, $msgdir) or confess "can't open $msgdir $!";
+  @dir = readdir($dir);
+  closedir($dir);
+  
+  for (sort @dir) {
+    next if /^\./o;
+       next if ! /^m\d+/o;
+
+    $ref = read_msg_header("$msgdir/$_");
+       next if !$ref;
+       
+       # add the clusters that have this
+       push @msg, $ref; 
+       
+  }
+}
+
+# return all the current messages
+sub get_all
+{
+  return @msg;
+}
+
+# return the official filename for a message no
+sub filename
+{
+  return sprintf "$msgdir/m%06d", shift;
 }
 
+#
+# 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};
+}
+
+no strict;
+sub AUTOLOAD
+{
+  my $self = shift;
+  my $name = $AUTOLOAD;
+  return if $name =~ /::DESTROY$/;
+  $name =~ s/.*:://o;
+  
+  confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+  @_ ? $self->{$name} = shift : $self->{$name} ;
+}
+
+
 1;
 
 __END__
diff --git a/perl/call.pl b/perl/call.pl
new file mode 100755 (executable)
index 0000000..89cdb2f
--- /dev/null
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+#
+# a little program to see if I can use ax25_call in a perl script
+#
+
+use FileHandle;
+use IPC::Open2;
+
+$pid = Open2( \*IN, \*OUT, "ax25_call ether GB7DJK-1 G1TLH");
+
+IN->input_record_separator("\r");
+OUT->output_record_separator("\r");
+OUT->autoflush(1);
+
+vec($rin, fileno(STDIN), 1) = 1;
+vec($rin, fileno(IN), 1) = 1;
+
+while (($nfound = select($rout=$rin, undef, undef, 0.001)) >= 0) {
+  
+}
index 845414339c7bf3e2cae040cc43c4993ee9ca5acb..2a41c221320fbef8120d2af0598a69f6da5be6be 100755 (executable)
@@ -5,17 +5,36 @@
 # This is a perl module/program that sits on the end of a dxcluster
 # 'protocol' connection and deals with anything that might come along.
 #
-# this program is called by ax25d and gets raw ax25 text on its input
+# this program is called by ax25d or inetd and gets raw ax25 text on its input
+# It can also be launched into the ether by the cluster program itself for outgoing
+# connections
+#
+# Calling syntax is:-
+#
+# client.pl [callsign] [telnet|ax25|local] [[connect] [program name and args ...]]
+#
+# if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
+#
+# if there is no connection type then 'local' is assumed
+#
+# if there is a 'connect' keyword then it will try to launch the following program
+# and any arguments and connect the stdin & stdout of both the program and the 
+# client together.
 #
 # Copyright (c) 1998 Dirk Koopman G1TLH
 #
 # $Id$
 # 
 
+
 # search local then perl directories
 BEGIN {
-  unshift @INC, "/spider/perl";   # this IS the right way round!
-  unshift @INC, "/spider/local";
+  # root of directory tree for this system
+  $root = "/spider"; 
+  $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+
+  unshift @INC, "$root/perl";   # this IS the right way round!
+  unshift @INC, "$root/local";
 }
 
 use Msg;
@@ -48,6 +67,14 @@ sub sig_term
   cease(1);
 }
 
+# terminate a child
+sub sig_chld
+{
+  $SIG{CHLD} = \&sig_chld;
+  $waitedpid = wait;
+}
+
+
 sub setmode
 {
   if ($mode == 1) {
@@ -147,6 +174,13 @@ $call = uc $myalias if !$call;
 $connsort = lc shift @ARGV;
 $connsort = 'local' if !$connsort;
 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
+
+# is this an out going connection?
+if ($ARGV[0] eq "connect") {
+  shift @ARGV;          # lose the keyword
+  
+}
+
 setmode();
 if ($call eq $mycall) {
   print "You cannot connect as your cluster callsign ($mycall)", $nl;
@@ -159,6 +193,7 @@ STDOUT->autoflush(1);
 $SIG{'INT'} = \&sig_term;
 $SIG{'TERM'} = \&sig_term;
 $SIG{'HUP'} = \&sig_term;
+$SIG{'CHLD'} = \&sig_chld;
 
 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 $conn->send_now("A$call|$connsort");
index f46ef82d80f20f7ad4f7ef3d19d2685f1ce101ae..f1759ef5a01e80a178d2210206081afa50ca5409 100755 (executable)
@@ -31,6 +31,8 @@ use DXProt;
 use DXMsg;
 use DXCluster;
 use DXDebug;
+use DXCron;
+use DXConnect;
 use Prefix;
 use Bands;
 
@@ -140,7 +142,13 @@ sub process_inqueue
     $dxchan->start($line);  
   } elsif ($sort eq 'D') {
     die "\$user not defined for $call" if !defined $user;
-       $dxchan->normal($line);  
+       if ($dxchan->{func}) {   
+         # call an ongoing routine if there is a function specified
+         &{$dxchan->{func}} ($dxchan, $line);
+       } else {
+         # normal input
+         $dxchan->normal($line);
+       }
     disconnect($dxchan) if ($dxchan->{state} eq 'bye');
   } elsif ($sort eq 'Z') {
     disconnect($dxchan);
@@ -189,6 +197,14 @@ DXProt->init();
 # put in a DXCluster node for us here so we can add users and take them away
 DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); 
 
+# read in any existing message headers
+print "reading existing message headers\n";
+DXMsg->init();
+
+# read in any cron jobs
+print "reading cron jobs\n";
+DXCron->init();
+
 # this, such as it is, is the main loop!
 print "orft we jolly well go ...\n";
 for (;;) {
@@ -204,6 +220,8 @@ for (;;) {
        $ztime = &ztime();
     DXCommandmode::process();     # process ongoing command mode stuff
     DXProt::process();              # process ongoing ak1a pcxx stuff
+       DXCron::process();
+       DXConnect::process();
   }
 }