From 78ed3f6025103ec1c47c90725e37b417647d83c8 Mon Sep 17 00:00:00 2001 From: djk Date: Wed, 30 Sep 1998 22:13:18 +0000 Subject: [PATCH] added directory command + dummy read, send and reply added more functionality to the messaging generally started the looking at outgoing calls put some hooks in for Cron and Connects --- cmd/directory.pl | 22 +++++ cmd/read.pl | 7 ++ cmd/reply.pl | 7 ++ cmd/send.pl | 7 ++ perl/DXChannel.pm | 10 +- perl/DXConnect.pm | 32 +++++++ perl/DXCron.pm | 31 ++++++ perl/DXMsg.pm | 236 ++++++++++++++++++++++++++++++++++++++++------ perl/call.pl | 20 ++++ perl/client.pl | 41 +++++++- perl/cluster.pl | 20 +++- 11 files changed, 401 insertions(+), 32 deletions(-) create mode 100644 cmd/directory.pl create mode 100644 cmd/read.pl create mode 100644 cmd/reply.pl create mode 100644 cmd/send.pl create mode 100644 perl/DXConnect.pm create mode 100644 perl/DXCron.pm create mode 100755 perl/call.pl diff --git a/cmd/directory.pl b/cmd/directory.pl new file mode 100644 index 00000000..d1b91ffa --- /dev/null +++ b/cmd/directory.pl @@ -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 index 00000000..c72be605 --- /dev/null +++ b/cmd/read.pl @@ -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 index 00000000..a05e3cbe --- /dev/null +++ b/cmd/reply.pl @@ -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 index 00000000..aabf2172 --- /dev/null +++ b/cmd/send.pl @@ -0,0 +1,7 @@ +# +# send a message +# +# Copyright (c) Dirk Koopman G1TLH +# +# $Id$ +# diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 5a9ca3b2..d21497bd 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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 index 00000000..30cd77f3 --- /dev/null +++ b/perl/DXConnect.pm @@ -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 index 00000000..dd78edd4 --- /dev/null +++ b/perl/DXCron.pm @@ -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__ diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index ea4a0791..e949c682 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -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 index 00000000..89cdb2f0 --- /dev/null +++ b/perl/call.pl @@ -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) { + +} diff --git a/perl/client.pl b/perl/client.pl index 84541433..2a41c221 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -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"); diff --git a/perl/cluster.pl b/perl/cluster.pl index f46ef82d..f1759ef5 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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(); } } -- 2.43.0