]> scm.dxcluster.org Git - spider.git/blob - perl/DXMsg.pm
done more work on directory now really quite ak1a compatible
[spider.git] / perl / DXMsg.pm
1 #!/usr/bin/perl
2 #
3 # This module impliments the message handling for a dx cluster
4 #
5 # Copyright (c) 1998 Dirk Koopman G1TLH
6 #
7 # $Id$
8 #
9 #
10 # Notes for implementors:-
11 #
12 # PC28 field 11 is the RR required flag
13 # PC28 field 12 is a VIA routing (ie it is a node call) 
14 #
15
16 package DXMsg;
17
18 @ISA = qw(DXProt DXChannel);
19
20 use DXUtil;
21 use DXChannel;
22 use DXUser;
23 use DXM;
24 use DXCluster;
25 use DXProtVars;
26 use DXProtout;
27 use DXDebug;
28 use DXLog;
29 use FileHandle;
30 use Carp;
31
32 use strict;
33 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
34                         @badmsg $badmsgfn $forwardfn @forward);
35
36 %work = ();                                             # outstanding jobs
37 @msg = ();                                              # messages we have
38 %busy = ();                                             # station interlocks
39 $msgdir = "$main::root/msg";    # directory contain the msgs
40 $maxage = 30 * 86400;                   # the maximum age that a message shall live for if not marked 
41 $last_clean = 0;                                # last time we did a clean
42 @forward = ();                  # msg forward table
43
44 $badmsgfn = "$msgdir/badmsg.pl";  # list of TO address we wont store
45 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
46
47 %valid = (
48                   fromnode => '9,From Node',
49                   tonode => '9,To Node',
50                   to => '0,To',
51                   from => '0,From',
52                   t => '0,Msg Time,cldatetime',
53                   private => '9,Private',
54                   subject => '0,Subject',
55                   linesreq => '0,Lines per Gob',
56                   rrreq => '9,Read Confirm',
57                   origin => '0,Origin',
58                   lines => '5,Data',
59                   stream => '9,Stream No',
60                   count => '9,Gob Linecnt',
61                   file => '9,File?,yesno',
62                   gotit => '9,Got it Nodes,parray',
63                   lines => '9,Lines,parray',
64                   'read' => '9,Times read',
65                   size => '0,Size',
66                   msgno => '0,Msgno',
67                   keep => '0,Keep this?,yesno',
68                  );
69
70 # allocate a new object
71 # called fromnode, tonode, from, to, datetime, private?, subject, nolinesper  
72 sub alloc                  
73 {
74         my $pkg = shift;
75         my $self = bless {}, $pkg;
76         $self->{msgno} = shift;
77         my $to = shift;
78         #  $to =~ s/-\d+$//o;
79         $self->{to} = ($to eq $main::mycall) ? $main::myalias : $to;
80         my $from = shift;
81         $from =~ s/-\d+$//o;
82         $self->{from} = uc $from;
83         $self->{t} = shift;
84         $self->{private} = shift;
85         $self->{subject} = shift;
86         $self->{origin} = shift;
87         $self->{'read'} = shift;
88         $self->{rrreq} = shift;
89         $self->{gotit} = [];
90     
91         return $self;
92 }
93
94 sub workclean
95 {
96         my $ref = shift;
97         delete $ref->{lines};
98         delete $ref->{linesreq};
99         delete $ref->{tonode};
100         delete $ref->{fromnode};
101         delete $ref->{stream};
102         delete $ref->{lines};
103         delete $ref->{file};
104         delete $ref->{count};
105 }
106
107 sub process
108 {
109         my ($self, $line) = @_;
110         my @f = split /\^/, $line;
111         my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number
112         
113  SWITCH: {
114                 if ($pcno == 28) {              # incoming message
115                         my $t = cltounix($f[5], $f[6]);
116                         my $stream = next_transno($f[2]);
117                         my $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0', $f[11]);
118                         
119                         # fill in various forwarding state variables
120                         $ref->{fromnode} = $f[2];
121                         $ref->{tonode} = $f[1];
122                         $ref->{rrreq} = $f[11];
123                         $ref->{linesreq} = $f[10];
124                         $ref->{stream} = $stream;
125                         $ref->{count} = 0;      # no of lines between PC31s
126                         dbg('msg', "new message from $f[4] to $f[3] '$f[8]' stream $stream\n");
127                         $work{"$f[2]$stream"} = $ref; # store in work
128                         $busy{$f[2]} = $ref; # set interlock
129                         $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
130                         last SWITCH;
131                 }
132                 
133                 if ($pcno == 29) {              # incoming text
134                         my $ref = $work{"$f[2]$f[3]"};
135                         if ($ref) {
136                                 push @{$ref->{lines}}, $f[4];
137                                 $ref->{count}++;
138                                 if ($ref->{count} >= $ref->{linesreq}) {
139                                         $self->send(DXProt::pc31($f[2], $f[1], $f[3]));
140                                         dbg('msg', "stream $f[3]: $ref->{count} lines received\n");
141                                         $ref->{count} = 0;
142                                 }
143                         }
144                         last SWITCH;
145                 }
146                 
147                 if ($pcno == 30) {              # this is a incoming subject ack
148                         my $ref = $work{$f[2]}; # note no stream at this stage
149                         if ($ref) {
150                                 delete $work{$f[2]};
151                                 $ref->{stream} = $f[3];
152                                 $ref->{count} = 0;
153                                 $ref->{linesreq} = 5;
154                                 $work{"$f[2]$f[3]"} = $ref;     # new ref
155                                 dbg('msg', "incoming subject ack stream $f[3]\n");
156                                 $busy{$f[2]} = $ref; # interlock
157                                 $ref->{lines} = [];
158                                 push @{$ref->{lines}}, ($ref->read_msg_body);
159                                 $ref->send_tranche($self);
160                         } else {
161                                 $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
162                         } 
163                         last SWITCH;
164                 }
165                 
166                 if ($pcno == 31) {              # acknowledge a tranche of lines
167                         my $ref = $work{"$f[2]$f[3]"};
168                         if ($ref) {
169                                 dbg('msg', "tranche ack stream $f[3]\n");
170                                 $ref->send_tranche($self);
171                         } else {
172                                 $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
173                         } 
174                         last SWITCH;
175                 }
176                 
177                 if ($pcno == 32) {              # incoming EOM
178                         dbg('msg', "stream $f[3]: EOM received\n");
179                         my $ref = $work{"$f[2]$f[3]"};
180                         if ($ref) {
181                                 $self->send(DXProt::pc33($f[2], $f[1], $f[3])); # acknowledge it
182                                 
183                                 # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol
184                                 # store the file or message
185                                 # remove extraneous rubbish from the hash
186                                 # remove it from the work in progress vector
187                                 # stuff it on the msg queue
188                                 if ($ref->{lines} && @{$ref->{lines}} > 0) { # ignore messages with 0 lines
189                                         if ($ref->{file}) {
190                                                 $ref->store($ref->{lines});
191                                         } else {
192
193                                                 # does an identical message already exist?
194                                                 my $m;
195                                                 for $m (@msg) {
196                                                         if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from}) {
197                                                                 $ref->stop_msg($self);
198                                                                 my $msgno = $m->{msgno};
199                                                                 dbg('msg', "duplicate message to $msgno\n");
200                                                                 Log('msg', "duplicate message to $msgno");
201                                                                 return;
202                                                         }
203                                                 }
204                                                         
205                                                 # look for 'bad' to addresses 
206                                                 if (grep $ref->{to} eq $_, @badmsg) {
207                                                         $ref->stop_msg($self);
208                                                         dbg('msg', "'Bad' TO address $ref->{to}");
209                                                         Log('msg', "'Bad' TO address $ref->{to}");
210                                                         return;
211                                                 }
212
213                                                 $ref->{msgno} = next_transno("Msgno");
214                                                 push @{$ref->{gotit}}, $f[2]; # mark this up as being received
215                                                 $ref->store($ref->{lines});
216                                                 add_dir($ref);
217                                                 my $dxchan = DXChannel->get($ref->{to});
218                                                 $dxchan->send($dxchan->msg('msgnew')) if $dxchan;
219                                                 Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
220                                         }
221                                 }
222                                 $ref->stop_msg($self);
223                                 queue_msg(0);
224                         } else {
225                                 $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
226                         }
227                         queue_msg(0);
228                         last SWITCH;
229                 }
230                 
231                 if ($pcno == 33) {              # acknowledge the end of message
232                         my $ref = $work{"$f[2]$f[3]"};
233                         if ($ref) {
234                                 if ($ref->{private}) { # remove it if it private and gone off site#
235                                         Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2] and deleted");
236                                         $ref->del_msg;
237                                 } else {
238                                         Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2]");
239                                         push @{$ref->{gotit}}, $f[2]; # mark this up as being received
240                                         $ref->store($ref->{lines});     # re- store the file
241                                 }
242                                 $ref->stop_msg($self);
243                         } else {
244                                 $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
245                         } 
246                         queue_msg(0);
247                         last SWITCH;
248                 }
249                 
250                 if ($pcno == 40) {              # this is a file request
251                         $f[3] =~ s/\\/\//og; # change the slashes
252                         $f[3] =~ s/\.//og;      # remove dots
253                         $f[3] =~ s/^\///o;   # remove the leading /
254                         $f[3] = lc $f[3];       # to lower case;
255                         dbg('msg', "incoming file $f[3]\n");
256                         $f[3] = 'packclus/' . $f[3] unless $f[3] =~ /^packclus\//o;
257                         
258                         # create any directories
259                         my @part = split /\//, $f[3];
260                         my $part;
261                         my $fn = "$main::root";
262                         pop @part;                      # remove last part
263                         foreach $part (@part) {
264                                 $fn .= "/$part";
265                                 next if -e $fn;
266                                 last SWITCH if !mkdir $fn, 0777;
267                                 dbg('msg', "created directory $fn\n");
268                         }
269                         my $stream = next_transno($f[2]);
270                         my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0');
271                         
272                         # forwarding variables
273                         $ref->{fromnode} = $f[1];
274                         $ref->{tonode} = $f[2];
275                         $ref->{linesreq} = $f[5];
276                         $ref->{stream} = $stream;
277                         $ref->{count} = 0;      # no of lines between PC31s
278                         $ref->{file} = 1;
279                         $work{"$f[2]$stream"} = $ref; # store in work
280                         $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack 
281                         
282                         last SWITCH;
283                 }
284                 
285                 if ($pcno == 42) {              # abort transfer
286                         dbg('msg', "stream $f[3]: abort received\n");
287                         my $ref = $work{"$f[2]$f[3]"};
288                         if ($ref) {
289                                 $ref->stop_msg($self);
290                                 $ref = undef;
291                         }
292                         
293                         last SWITCH;
294                 }
295
296                 if ($pcno == 49) {      # global delete on subject
297                         for (@msg) {
298                                 if ($_->{subject} eq $f[2]) {
299                                         $_->del_msg();
300                                         Log('msg', "Message $_->{msgno} fully deleted by $f[1]");
301                                 }
302                         }
303                 }
304         }
305         
306         clean_old() if $main::systime - $last_clean > 3600 ; # clean the message queue
307 }
308
309
310 # store a message away on disc or whatever
311 #
312 # NOTE the second arg is a REFERENCE not a list
313 sub store
314 {
315         my $ref = shift;
316         my $lines = shift;
317         
318         # we only proceed if there are actually any lines in the file
319         if (!$lines || @{$lines} == 0) {
320                 return;
321         }
322         
323         if ($ref->{file}) {                     # a file
324                 dbg('msg', "To be stored in $ref->{to}\n");
325                 
326                 my $fh = new FileHandle "$ref->{to}", "w";
327                 if (defined $fh) {
328                         my $line;
329                         foreach $line (@{$lines}) {
330                                 print $fh "$line\n";
331                         }
332                         $fh->close;
333                         dbg('msg', "file $ref->{to} stored\n");
334                         Log('msg', "file $ref->{to} from $ref->{from} stored" );
335                 } else {
336                         confess "can't open file $ref->{to} $!";  
337                 }
338         } else {                                        # a normal message
339
340                 # attempt to open the message file
341                 my $fn = filename($ref->{msgno});
342                 
343                 dbg('msg', "To be stored in $fn\n");
344                 
345                 # now save the file, overwriting what's there, YES I KNOW OK! (I will change it if it's a problem)
346                 my $fh = new FileHandle "$fn", "w";
347                 if (defined $fh) {
348                         my $rr = $ref->{rrreq} ? '1' : '0';
349                         my $priv = $ref->{private} ? '1': '0';
350                         print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr\n";
351                         print $fh "=== ", join('^', @{$ref->{gotit}}), "\n";
352                         my $line;
353                         $ref->{size} = 0;
354                         foreach $line (@{$lines}) {
355                                 $ref->{size} += (length $line) + 1;
356                                 print $fh "$line\n";
357                         }
358                         $fh->close;
359                         dbg('msg', "msg $ref->{msgno} stored\n");
360                         Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" );
361                 } else {
362                         confess "can't open msg file $fn $!";  
363                 }
364         }
365 }
366
367 # delete a message
368 sub del_msg
369 {
370         my $self = shift;
371         
372         # remove it from the active message list
373         @msg = map { $_ != $self ? $_ : () } @msg;
374         
375         # belt and braces (one day I will ask someone if this is REALLY necessary)
376         delete $self->{gotit};
377         delete $self->{list};
378         
379         # remove the file
380         unlink filename($self->{msgno});
381         dbg('msg', "deleting $self->{msgno}\n");
382 }
383
384 # clean out old messages from the message queue
385 sub clean_old
386 {
387         my $ref;
388         
389         # mark old messages for deletion
390         foreach $ref (@msg) {
391                 if (!$ref->{keep} && $ref->{t} < $main::systime - $maxage) {
392                         $ref->{deleteme} = 1;
393                         delete $ref->{gotit};
394                         delete $ref->{list};
395                         unlink filename($ref->{msgno});
396                         dbg('msg', "deleting old $ref->{msgno}\n");
397                 }
398         }
399         
400         # remove them all from the active message list
401         @msg = map { $_->{deleteme} ? () : $_ } @msg;
402         $last_clean = $main::systime;
403 }
404
405 # read in a message header
406 sub read_msg_header
407
408         my $fn = shift;
409         my $file;
410         my $line;
411         my $ref;
412         my @f;
413         my $size;
414         
415         $file = new FileHandle;
416         if (!open($file, $fn)) {
417                 print "Error reading $fn $!\n";
418                 return undef;
419         }
420         $size = -s $fn;
421         $line = <$file>;                        # first line
422         chomp $line;
423         $size -= length $line;
424         if (! $line =~ /^===/o) {
425                 print "corrupt first line in $fn ($line)\n";
426                 return undef;
427         }
428         $line =~ s/^=== //o;
429         @f = split /\^/, $line;
430         $ref = DXMsg->alloc(@f);
431         
432         $line = <$file>;                        # second line
433         chomp $line;
434         $size -= length $line;
435         if (! $line =~ /^===/o) {
436                 print "corrupt second line in $fn ($line)\n";
437                 return undef;
438         }
439         $line =~ s/^=== //o;
440         $ref->{gotit} = [];
441         @f = split /\^/, $line;
442         push @{$ref->{gotit}}, @f;
443         $ref->{size} = $size;
444         
445         close($file);
446         
447         return $ref;
448 }
449
450 # read in a message header
451 sub read_msg_body
452 {
453         my $self = shift;
454         my $msgno = $self->{msgno};
455         my $file;
456         my $line;
457         my $fn = filename($msgno);
458         my @out;
459         
460         $file = new FileHandle;
461         if (!open($file, $fn)) {
462                 print "Error reading $fn $!\n";
463                 return undef;
464         }
465         chomp (@out = <$file>);
466         close($file);
467         
468         shift @out if $out[0] =~ /^=== /;
469         shift @out if $out[0] =~ /^=== /;
470         return @out;
471 }
472
473 # send a tranche of lines to the other end
474 sub send_tranche
475 {
476         my ($self, $dxchan) = @_;
477         my @out;
478         my $to = $self->{tonode};
479         my $from = $self->{fromnode};
480         my $stream = $self->{stream};
481         my $lines = $self->{lines};
482         my ($c, $i);
483         
484         for ($i = 0, $c = $self->{count}; $i < $self->{linesreq} && $c < @$lines; $i++, $c++) {
485                 push @out, DXProt::pc29($to, $from, $stream, $lines->[$c]);
486     }
487     $self->{count} = $c;
488
489     push @out, DXProt::pc32($to, $from, $stream) if $i < $self->{linesreq};
490         $dxchan->send(@out);
491 }
492
493         
494 # find a message to send out and start the ball rolling
495 sub queue_msg
496 {
497         my $sort = shift;
498         my $call = shift;
499         my $ref;
500         my $clref;
501         my $dxchan;
502         my @nodelist = DXProt::get_all_ak1a();
503         
504         # bat down the message list looking for one that needs to go off site and whose
505         # nearest node is not busy.
506
507         dbg('msg', "queue msg ($sort)\n");
508         foreach $ref (@msg) {
509                 # firstly, is it private and unread? if so can I find the recipient
510                 # in my cluster node list offsite?
511                 if ($ref->{private}) {
512                         if ($ref->{'read'} == 0) {
513                                 $clref = DXCluster->get_exact($ref->{to});
514                                 unless ($clref) {             # otherwise look for a homenode
515                                         my $uref = DXUser->get($ref->{to});
516                                         my $hnode =  $uref->homenode if $uref;
517                                         $clref = DXCluster->get_exact($hnode) if $hnode;
518                                 }
519                                 if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
520                                         $dxchan = $clref->{dxchan};
521                                         $ref->start_msg($dxchan) if $dxchan && $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
522                                 }
523                         }
524                 } elsif (!$sort) {
525                         # otherwise we are dealing with a bulletin, compare the gotit list with
526                         # the nodelist up above, if there are sites that haven't got it yet
527                         # then start sending it - what happens when we get loops is anyone's
528                         # guess, use (to, from, time, subject) tuple?
529                         my $noderef;
530                         foreach $noderef (@nodelist) {
531                                 next if $noderef->call eq $main::mycall;
532                                 next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
533                                 next unless $ref->forward_it($noderef->call);           # check the forwarding file
534                                 # next if $noderef->isolate;               # maybe add code for stuff originated here?
535                                 # next if DXUser->get( ${$ref->{gotit}}[0] )->isolate;  # is the origin isolated?
536                                 
537                                 # if we are here we have a node that doesn't have this message
538                                 $ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
539                                 last;
540                         }
541                 }
542                 
543                 # if all the available nodes are busy then stop
544                 last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
545         }
546 }
547
548 # is there a message for me?
549 sub for_me
550 {
551         my $call = uc shift;
552         my $ref;
553         
554         foreach $ref (@msg) {
555                 # is it for me, private and unread? 
556                 if ($ref->{to} eq $call && $ref->{private}) {
557                         return 1 if !$ref->{'read'};
558                 }
559         }
560         return 0;
561 }
562
563 # start the message off on its travels with a PC28
564 sub start_msg
565 {
566         my ($self, $dxchan) = @_;
567         
568         dbg('msg', "start msg $self->{msgno}\n");
569         $self->{linesreq} = 5;
570         $self->{count} = 0;
571         $self->{tonode} = $dxchan->call;
572         $self->{fromnode} = $main::mycall;
573         $busy{$dxchan->call} = $self;
574         $work{"$self->{tonode}"} = $self;
575         $dxchan->send(DXProt::pc28($self->{tonode}, $self->{fromnode}, $self->{to}, $self->{from}, $self->{t}, $self->{private}, $self->{subject}, $self->{origin}, $self->{rrreq}));
576 }
577
578 # get the ref of a busy node
579 sub get_busy
580 {
581         my $call = shift;
582         return $busy{$call};
583 }
584
585 # get the busy queue
586 sub get_all_busy
587 {
588         return values %busy;
589 }
590
591 # get the forwarding queue
592 sub get_fwq
593 {
594         return values %work;
595 }
596
597 # stop a message from continuing, clean it out, unlock interlocks etc
598 sub stop_msg
599 {
600         my ($self, $dxchan) = @_;
601         my $node = $dxchan->call;
602         
603         dbg('msg', "stop msg $self->{msgno} stream $self->{stream}\n");
604         delete $work{$node};
605         delete $work{"$node$self->{stream}"};
606         $self->workclean;
607         delete $busy{$node};
608 }
609
610 # get a new transaction number from the file specified
611 sub next_transno
612 {
613         my $name = shift;
614         $name =~ s/\W//og;                      # remove non-word characters
615         my $fn = "$msgdir/$name";
616         my $msgno;
617         
618         my $fh = new FileHandle;
619         if (sysopen($fh, $fn, O_RDWR|O_CREAT, 0666)) {
620                 $fh->autoflush(1);
621                 $msgno = $fh->getline;
622                 chomp $msgno;
623                 $msgno++;
624                 seek $fh, 0, 0;
625                 $fh->print("$msgno\n");
626                 dbg('msg', "msgno $msgno allocated for $name\n");
627                 $fh->close;
628         } else {
629                 confess "can't open $fn $!";
630         }
631         return $msgno;
632 }
633
634 # initialise the message 'system', read in all the message headers
635 sub init
636 {
637         my $dir = new FileHandle;
638         my @dir;
639         my $ref;
640
641         # load various control files
642         my @in = load_badmsg();
643         print "@in\n" if @in;
644         @in = load_forward();
645         print "@in\n" if @in;
646
647         # read in the directory
648         opendir($dir, $msgdir) or confess "can't open $msgdir $!";
649         @dir = readdir($dir);
650         closedir($dir);
651
652         @msg = ();
653         for (sort @dir) {
654                 next unless /^m\d+$/o;
655                 
656                 $ref = read_msg_header("$msgdir/$_");
657                 next unless $ref;
658                 
659                 # delete any messages to 'badmsg.pl' places
660                 if (grep $ref->{to} eq $_, @badmsg) {
661                         dbg('msg', "'Bad' TO address $ref->{to}");
662                         Log('msg', "'Bad' TO address $ref->{to}");
663                         $ref->del_msg;
664                         next;
665                 }
666
667                 # add the message to the available queue
668                 add_dir($ref); 
669         }
670 }
671
672 # add the message to the directory listing
673 sub add_dir
674 {
675         my $ref = shift;
676         confess "tried to add a non-ref to the msg directory" if !ref $ref;
677         push @msg, $ref;
678 }
679
680 # return all the current messages
681 sub get_all
682 {
683         return @msg;
684 }
685
686 # get a particular message
687 sub get
688 {
689         my $msgno = shift;
690         for (@msg) {
691                 return $_ if $_->{msgno} == $msgno;
692                 last if $_->{msgno} > $msgno;
693         }
694         return undef;
695 }
696
697 # return the official filename for a message no
698 sub filename
699 {
700         return sprintf "$msgdir/m%06d", shift;
701 }
702
703 #
704 # return a list of valid elements 
705
706
707 sub fields
708 {
709         return keys(%valid);
710 }
711
712 #
713 # return a prompt for a field
714 #
715
716 sub field_prompt
717
718         my ($self, $ele) = @_;
719         return $valid{$ele};
720 }
721
722 #
723 # send a message state machine
724 sub do_send_stuff
725 {
726         my $self = shift;
727         my $line = shift;
728         my @out;
729         
730         if ($self->state eq 'send1') {
731                 #  $DB::single = 1;
732                 confess "local var gone missing" if !ref $self->{loc};
733                 my $loc = $self->{loc};
734                 $loc->{subject} = $line;
735                 $loc->{lines} = [];
736                 $self->state('sendbody');
737                 #push @out, $self->msg('sendbody');
738                 push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
739         } elsif ($self->state eq 'sendbody') {
740                 confess "local var gone missing" if !ref $self->{loc};
741                 my $loc = $self->{loc};
742                 if ($line eq "\032" || uc $line eq "/EX") {
743                         my $to;
744                         
745                         if (@{$loc->{lines}} > 0) {
746                                 foreach $to (@{$loc->{to}}) {
747                                         my $ref;
748                                         my $systime = $main::systime;
749                                         my $mycall = $main::mycall;
750                                         $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
751                                                                                 uc $to,
752                                                                                 $self->call, 
753                                                                                 $systime,
754                                                                                 $loc->{private}, 
755                                                                                 $loc->{subject}, 
756                                                                                 $mycall,
757                                                                                 '0',
758                                                                                 $loc->{rrreq});
759                                         $ref->store($loc->{lines});
760                                         $ref->add_dir();
761                                         #push @out, $self->msg('sendsent', $to);
762                                         push @out, "msgno $ref->{msgno} sent to $to";
763                                         my $dxchan = DXChannel->get(uc $to);
764                                         if ($dxchan) {
765                                                 if ($dxchan->is_user()) {
766                                                         $dxchan->send("New mail has arrived for you");
767                                                 }
768                                         }
769                                 }
770                         }
771                         delete $loc->{lines};
772                         delete $loc->{to};
773                         delete $self->{loc};
774                         $self->func(undef);
775                         DXMsg::queue_msg(0);
776                         $self->state('prompt');
777                 } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
778                         #push @out, $self->msg('sendabort');
779                         push @out, "aborted";
780                         delete $loc->{lines};
781                         delete $loc->{to};
782                         delete $self->{loc};
783                         $self->func(undef);
784                         $self->state('prompt');
785                 } else {
786                         
787                         # i.e. it ain't and end or abort, therefore store the line
788                         push @{$loc->{lines}}, length($line) > 0 ? $line : " ";
789                 }
790         }
791         return (1, @out);
792 }
793
794 # return the standard directory line for this ref 
795 sub dir
796 {
797         my $ref = shift;
798         return sprintf "%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", 
799                 $ref->msgno, $ref->read ? '-' : ' ', $ref->private ? 'p' : ' ', $ref->size,
800                         $ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject;
801 }
802
803 # load the forward table
804 sub load_forward
805 {
806         my @out;
807         do "$forwardfn" if -e "$forwardfn";
808         push @out, $@ if $@;
809         return @out;
810 }
811
812 # load the bad message table
813 sub load_badmsg
814 {
815         my @out;
816         do "$badmsgfn" if -e "$badmsgfn";
817         push @out, $@ if $@;
818         return @out;
819 }
820
821 #
822 # forward that message or not according to the forwarding table
823 # returns 1 for forward, 0 - to ignore
824 #
825
826 sub forward_it
827 {
828         my $ref = shift;
829         my $call = shift;
830         my $i;
831         
832         for ($i = 0; $i < @forward; $i += 5) {
833                 my ($sort, $field, $pattern, $action, $bbs) = @forward[$i..($i+4)]; 
834                 my $tested;
835                 
836                 # are we interested?
837                 last if $ref->{private} && $sort ne 'P';
838                 last if !$ref->{private} && $sort ne 'B';
839                 
840                 # select field
841                 $tested = $ref->{to} if $field eq 'T';
842                 $tested = $ref->{from} if $field eq 'F';
843                 $tested = $ref->{origin} if $field eq 'O';
844                 $tested = $ref->{subject} if $field eq 'S';
845
846                 if (!$pattern || $tested =~ m{$pattern}i) {
847                         return 0 if $action eq 'I';
848                         return 1 if !$bbs || grep $_ eq $call, @{$bbs};
849                 }
850         }
851         return 0;
852 }
853
854 no strict;
855 sub AUTOLOAD
856 {
857         my $self = shift;
858         my $name = $AUTOLOAD;
859         return if $name =~ /::DESTROY$/;
860         $name =~ s/.*:://o;
861         
862         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
863         @_ ? $self->{$name} = shift : $self->{$name} ;
864 }
865
866 1;
867
868 __END__