spider/perl/DXMsg.pm

#!/usr/bin/perl
#
# This module impliments the message handling for a dx cluster
#
# Copyright (c) 1998 Dirk Koopman G1TLH
#
# $Id$
# 

package DXMsg;

@ISA = qw(DXProt DXChannel);

use DXUtil;
use DXChannel;
use DXUser;
use DXM;
use DXCluster;
use DXProtVars;
use DXProtout;
use DXDebug;
use FileHandle;
use Carp;

use strict;
use vars qw($stream %work @msg $msgdir $msgnofn);

%work = ();                # outstanding jobs
@msg = ();                 # messages we have
$msgdir = "$main::data/msg";              # directory contain the msgs

# allocate a new object
# called fromnode, tonode, from, to, datetime, private?, subject, nolinesper  
sub alloc                  
{
  my $pkg = shift;
  my $self = bless {}, $pkg;
  $self->{fromnode} = shift;
  $self->{tonode} = 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} = [];
  
  return $self;
}

sub workclean
{
  my $ref = shift;
  delete $ref->{lines};
  delete $ref->{linesreq};
  delete $ref->{tonode};
  delete $ref->{stream};
}

sub process
{
  my ($self, $line) = @_;
  my @f = split /[\^\~]/, $line;
  my ($pcno) = $f[0] =~ /^PC(\d\d)/;          # just get the number
  
  SWITCH: {
    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);
	  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
	  last SWITCH;
	}
	
    if ($pcno == 29) {                        # incoming text
	  my $ref = $work{"$f[1]$f[2]$f[3]"};
	  if ($ref) {
	    push @{$ref->{lines}}, $f[4];
		$ref->{count}++;
		if ($ref->{count} >= $ref->{linesreq}) {
		  $self->send(DXProt::pc31($f[2], $f[1], $f[3]));
		  dbg('msg', "stream $f[3]: $ref->{linereq} lines received\n");
		  $ref->{count} = 0;
		}
	  }
	  last SWITCH;
	}
	
    if ($pcno == 30) {
	  last SWITCH;
	}
	
    if ($pcno == 31) {
	  last SWITCH;
	}
	
    if ($pcno == 32) {                         # incoming EOM
	  dbg('msg', "stream $f[3]: EOM received\n");
	  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)
		delete $work{"$f[1]$f[2]$f[3]"};       # remove the reference from the work vector
	  }
	  last SWITCH;
	}
	
    if ($pcno == 33) {
	  last SWITCH;
	}
	
	if ($pcno == 40) {                         # this is a file request
	  $f[3] =~ s/\\/\//og;                     # change the slashes
	  $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
	  
	  # create any directories
	  my @part = split /\//, $f[3];
	  my $part;
	  my $fn = "$main::root";
	  pop @part;         # remove last part
	  foreach $part (@part) {
	    $fn .= "/$part";
		next if -e $fn;
	    last SWITCH if !mkdir $fn, 0777;
        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);
	  $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
	  
	  last SWITCH;
	}
  }
}


# store a message away on disc or whatever
sub store
{
  my $ref = shift;
  
  # we only proceed if there are actually any lines in the file
  if (@{$ref->{lines}} == 0) {
    delete $ref->{lines};
	return;
  }
  
  if ($ref->{file}) {   # a file
    dbg('msg', "To be stored in $ref->{to}\n");
  
    my $fh = new FileHandle "$ref->{to}", "w";
	if (defined $fh) {
	  my $line;
	  foreach $line (@{$ref->{lines}}) {
		print $fh "$line\n";
	  }
	  $fh->close;
	  dbg('msg', "file $ref->{to} stored\n");
    } else {
      confess "can't open file $ref->{to} $!";  
    }
  } 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");

    # attempt to open the message file
	my $fn = sprintf "$msgdir/m%06d", $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 "=== $ref->{fromnode}\n";
	  my $line;
	  foreach $line (@{$ref->{lines}}) {
        $ref->{size} += length $line + 1;
		print $fh "$line\n";
	  }
	  $ref->workclean();
	  push @msg, $ref;           # add this message to the incore message list
	  $fh->close;
	  dbg('msg', "msg $msgno stored\n");
    } else {
      confess "can't open msg file $fn $!";  
    }
  }
}

# get a new transaction number from the file specified
sub next_transno
{
  my $name = shift;
  $name =~ s/\W//og;      # remove non-word characters
  my $fn = "$msgdir/$name";
  my $msgno;
  
  my $fh = new FileHandle;
  if (sysopen($fh, $fn, O_RDWR|O_CREAT, 0666)) {
    $fh->autoflush(1);
	$msgno = $fh->getline;
	chomp $msgno;
	$msgno++;
	seek $fh, 0, 0;
	$fh->print("$msgno\n");
	dbg('msg', "msgno $msgno allocated for $name\n");
	$fh->close;
  } else {
    confess "can't open $fn $!";
  }
  return $msgno;
}

# initialise the message 'system'
sub init
{

}

1;

__END__