]> dxcluster.net Git - spider.git/blob - perl/DXMsg.pm
677888f850948c490c9be43ebbc34abd7e30e49c
[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 use DXUtil;
19 use DXChannel;
20 use DXUser;
21 use DXM;
22 use DXProtVars;
23 use DXProtout;
24 use DXDebug;
25 use DXLog;
26 use IO::File;
27 use Fcntl;
28
29 use strict;
30
31 use vars qw($VERSION $BRANCH);
32 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
33 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
34 $main::build += $VERSION;
35 $main::branch += $BRANCH;
36
37 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean $residencetime
38                         @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime
39                     $queueinterval $lastq $importfn $minchunk $maxchunk $bulltopriv);
40
41 %work = ();                                             # outstanding jobs
42 @msg = ();                                              # messages we have
43 %busy = ();                                             # station interlocks
44 $msgdir = "$main::root/msg";    # directory contain the msgs
45 $maxage = 30 * 86400;                   # the maximum age that a message shall live for if not marked 
46 $last_clean = 0;                                # last time we did a clean
47 @forward = ();                  # msg forward table
48 @badmsg = ();                                   # bad message table
49 @swop = ();                                             # swop table
50 $timeout = 30*60;               # forwarding timeout
51 $waittime = 30*60;              # time an aborted outgoing message waits before trying again
52 $queueinterval = 1*60;          # run the queue every 1 minute
53 $lastq = 0;
54
55 $minchunk = 4800;               # minimum chunk size for a split message
56 $maxchunk = 6000;               # maximum chunk size
57 $bulltopriv = 1;                                # convert msgs with callsigns to private if they are bulls
58 $residencetime = 2*86400;       # keep deleted messages for this amount of time
59
60
61 $badmsgfn = "$msgdir/badmsg.pl";    # list of TO address we wont store
62 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
63 $swopfn = "$msgdir/swop.pl";        # the swopping table
64 $importfn = "$msgdir/import";       # import directory
65
66
67 %valid = (
68                   fromnode => '5,From Node',
69                   tonode => '5,To Node',
70                   to => '0,To',
71                   from => '0,From',
72                   t => '0,Msg Time,cldatetime',
73                   private => '5,Private,yesno',
74                   subject => '0,Subject',
75                   linesreq => '0,Lines per Gob',
76                   rrreq => '5,Read Confirm,yesno',
77                   origin => '0,Origin',
78                   lines => '5,Data',
79                   stream => '9,Stream No',
80                   count => '5,Gob Linecnt',
81                   file => '5,File?,yesno',
82                   gotit => '5,Got it Nodes,parray',
83                   lines => '5,Lines,parray',
84                   'read' => '5,Times read',
85                   size => '0,Size',
86                   msgno => '0,Msgno',
87                   keep => '0,Keep this?,yesno',
88                   lastt => '5,Last processed,cldatetime',
89                   waitt => '5,Wait until,cldatetime',
90                   delete => '5,Awaiting Delete,yesno',
91                   deletetime => '5,Deletion Time,cldatetime',
92                  );
93
94 # allocate a new object
95 # called fromnode, tonode, from, to, datetime, private?, subject, nolinesper  
96 sub alloc                  
97 {
98         my $pkg = shift;
99         my $self = bless {}, $pkg;
100         $self->{msgno} = shift;
101         my $to = shift;
102         #  $to =~ s/-\d+$//o;
103         $self->{to} = ($to eq $main::mycall) ? $main::myalias : $to;
104         my $from = shift;
105         $from =~ s/-\d+$//o;
106         $self->{from} = uc $from;
107         $self->{t} = shift;
108         $self->{private} = shift;
109         $self->{subject} = shift;
110         $self->{origin} = shift;
111         $self->{'read'} = shift;
112         $self->{rrreq} = shift;
113         $self->{delete} = shift;
114         $self->{deletetime} = shift;
115         $self->{gotit} = [];
116 #       $self->{lastt} = $main::systime;
117         $self->{lines} = [];
118         $self->{private} = 1 if $bulltopriv && DXUser->get_current($self->{to});
119     
120         return $self;
121 }
122
123
124 sub process
125 {
126         my ($self, $line) = @_;
127
128         # this is periodic processing
129         if (!$self || !$line) {
130
131                 if ($main::systime >= $lastq + $queueinterval) {
132
133                         # queue some message if the interval timer has gone off
134                         queue_msg(0);
135
136                         # import any messages in the import directory
137                         import_msgs();
138                         
139                         $lastq = $main::systime;
140                 }
141
142                 # clean the message queue
143                 clean_old() if $main::systime - $last_clean > 3600 ;
144                 $last_clean = $main::systime;
145                 return;
146         }
147
148         my @f = split /\^/, $line;
149         my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number
150         my ($tonode, $fromnode) = @f[1, 2];
151         my $stream = $f[3] if ($pcno >= 29 && $pcno <= 33) || $pcno == 42;
152
153  SWITCH: {
154                 if ($pcno == 28) {              # incoming message
155
156                         # sort out various extant protocol errors that occur
157                         my $origin = $f[13];
158                         $origin = $self->call unless $origin && $origin gt ' ';
159
160                         # first look for any messages in the busy queue 
161                         # and cancel them this should both resolve timed out incoming messages
162                         # and crossing of message between nodes, incoming messages have priority
163
164                         my $ref = get_busy($fromnode);
165                         if ($ref) {
166                                 my $otonode = $ref->{tonode} || "unknown";
167                                 dbg("Busy, stopping msgno: $ref->{msgno} $fromnode->$otonode") if isdbg('msg');
168                                 $ref->stop_msg($fromnode);
169                         }
170
171                         my $t = cltounix($f[5], $f[6]);
172                         $stream = next_transno($fromnode);
173                         $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $origin, '0', $f[11]);
174                         
175                         # fill in various forwarding state variables
176                         $ref->{fromnode} = $fromnode;
177                         $ref->{tonode} = $tonode;
178                         $ref->{rrreq} = $f[11];
179                         $ref->{linesreq} = $f[10];
180                         $ref->{stream} = $stream;
181                         $ref->{count} = 0;      # no of lines between PC31s
182                         dbg("new message from $f[4] to $f[3] '$f[8]' stream $fromnode/$stream\n") if isdbg('msg');
183                         Log('msg', "Incoming message $f[4] to $f[3] '$f[8]' origin: $origin" );
184                         set_fwq($fromnode, $stream, $ref); # store in work
185                         set_busy($fromnode, $ref); # set interlock
186                         $self->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack
187                         $ref->{lastt} = $main::systime;
188
189                         # look to see whether this is a non private message sent to a known callsign
190                         my $uref = DXUser->get_current($ref->{to});
191                         if (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) {
192                                 $ref->{private} = 1;
193                                 dbg("set bull to $ref->{to} to private") if isdbg('msg');
194                                 Log('msg', "set bull to $ref->{to} to private");
195                         }
196                         last SWITCH;
197                 }
198                 
199                 if ($pcno == 29) {              # incoming text
200                         my $ref = get_fwq($fromnode, $stream);
201                         if ($ref) {
202                                 $f[4] =~ s/\%5E/^/g;
203                                 if (@{$ref->{lines}}) {
204                                         push @{$ref->{lines}}, $f[4];
205                                 } else {
206                                         # temporarily store any R: lines so that we end up with 
207                                         # only the first and last ones stored.
208                                         if ($f[4] =~ m|^R:\d{6}/\d{4}|) {
209                                                 push @{$ref->{tempr}}, $f[4];
210                                         } else {
211                                                 if (exists $ref->{tempr}) {
212                                                         push @{$ref->{lines}}, shift @{$ref->{tempr}};
213                                                         push @{$ref->{lines}}, pop @{$ref->{tempr}} if @{$ref->{tempr}};
214                                                         delete $ref->{tempr};
215                                                 }
216                                                 push @{$ref->{lines}}, $f[4];
217                                         } 
218                                 }
219                                 $ref->{count}++;
220                                 if ($ref->{count} >= $ref->{linesreq}) {
221                                         $self->send(DXProt::pc31($fromnode, $tonode, $stream));
222                                         dbg("stream $stream: $ref->{count} lines received\n") if isdbg('msg');
223                                         $ref->{count} = 0;
224                                 }
225                                 $ref->{lastt} = $main::systime;
226                         } else {
227                                 dbg("PC29 from unknown stream $stream from $fromnode") if isdbg('msg');
228                                 $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream
229                         }
230                         last SWITCH;
231                 }
232                 
233                 if ($pcno == 30) {              # this is a incoming subject ack
234                         my $ref = get_fwq($fromnode);   # note no stream at this stage
235                         if ($ref) {
236                                 del_fwq($fromnode);
237                                 $ref->{stream} = $stream;
238                                 $ref->{count} = 0;
239                                 $ref->{linesreq} = 5;
240                                 set_fwq($fromnode, $stream, $ref);      # new ref
241                                 set_busy($fromnode, $ref); # interlock
242                                 dbg("incoming subject ack stream $stream\n") if isdbg('msg');
243                                 $ref->{lines} = [ $ref->read_msg_body ];
244                                 $ref->send_tranche($self);
245                                 $ref->{lastt} = $main::systime;
246                         } else {
247                                 dbg("PC30 from unknown stream $stream from $fromnode") if isdbg('msg');
248                                 $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream
249                         } 
250                         last SWITCH;
251                 }
252                 
253                 if ($pcno == 31) {              # acknowledge a tranche of lines
254                         my $ref = get_fwq($fromnode, $stream);
255                         if ($ref) {
256                                 dbg("tranche ack stream $stream\n") if isdbg('msg');
257                                 $ref->send_tranche($self);
258                                 $ref->{lastt} = $main::systime;
259                         } else {
260                                 dbg("PC31 from unknown stream $stream from $fromnode") if isdbg('msg');
261                                 $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream
262                         } 
263                         last SWITCH;
264                 }
265                 
266                 if ($pcno == 32) {              # incoming EOM
267                         dbg("stream $stream: EOM received\n") if isdbg('msg');
268                         my $ref = get_fwq($fromnode, $stream);
269                         if ($ref) {
270                                 $self->send(DXProt::pc33($fromnode, $tonode, $stream)); # acknowledge it
271                                 
272                                 # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol
273                                 # store the file or message
274                                 # remove extraneous rubbish from the hash
275                                 # remove it from the work in progress vector
276                                 # stuff it on the msg queue
277                                 if ($ref->{lines}) {
278                                         if ($ref->{file}) {
279                                                 $ref->store($ref->{lines});
280                                         } else {
281
282                                                 # does an identical message already exist?
283                                                 my $m;
284                                                 for $m (@msg) {
285                                                         if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) {
286                                                                 $ref->stop_msg($fromnode);
287                                                                 my $msgno = $m->{msgno};
288                                                                 dbg("duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno") if isdbg('msg');
289                                                                 Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno");
290                                                                 return;
291                                                         }
292                                                 }
293
294                                                 # swop addresses
295                                                 $ref->swop_it($self->call);
296                                                 
297                                                 # look for 'bad' to addresses 
298                                                 if ($ref->dump_it($self->call)) {
299                                                         $ref->stop_msg($fromnode);
300                                                         dbg("'Bad' message $ref->{to}") if isdbg('msg');
301                                                         Log('msg', "'Bad' message $ref->{to}");
302                                                         return;
303                                                 }
304
305                                                 # check the message for bad words 
306                                                 my @words;
307                                                 for (@{$ref->{lines}}) {
308                                                         push @words, BadWords::check($_);
309                                                 }
310                                                 push @words, BadWords::check($ref->{subject});
311                                                 if (@words) {
312                                                         dbg("$ref->{from} swore: '@words' -> $ref->{to} '$ref->{subject}' origin: $ref->{origin} via " . $self->call) if isdbg('msg');
313                                                         Log('msg',"$ref->{from} swore: '@words' -> $ref->{to} origin: $ref->{origin} via " . $self->call);
314                                                         Log('msg',"subject: $ref->{subject}");
315                                                         for (@{$ref->{lines}}) {
316                                                                 Log('msg', "line: $_");
317                                                         }
318                                                         $ref->stop_msg($fromnode);
319                                                         return;
320                                                 }
321                                                         
322                                                 $ref->{msgno} = next_transno("Msgno");
323                                                 push @{$ref->{gotit}}, $fromnode; # mark this up as being received
324                                                 $ref->store($ref->{lines});
325                                                 add_dir($ref);
326                                                 my $dxchan = DXChannel->get($ref->{to});
327                                                 $dxchan->send($dxchan->msg('m9')) if $dxchan && $dxchan->is_user;
328                                                 Log('msg', "Message $ref->{msgno} from $ref->{from} received from $fromnode for $ref->{to}");
329                                         }
330                                 }
331                                 $ref->stop_msg($fromnode);
332                         } else {
333                                 dbg("PC32 from unknown stream $stream from $fromnode") if isdbg('msg');
334                                 $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream
335                         }
336                         # queue_msg(0);
337                         last SWITCH;
338                 }
339                 
340                 if ($pcno == 33) {              # acknowledge the end of message
341                         my $ref = get_fwq($fromnode, $stream);
342                         if ($ref) {
343                                 if ($ref->{private}) { # remove it if it private and gone off site#
344                                         Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode and deleted");
345                                         $ref->mark_delete;
346                                 } else {
347                                         Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode");
348                                         push @{$ref->{gotit}}, $fromnode; # mark this up as being received
349                                         $ref->store($ref->{lines});     # re- store the file
350                                 }
351                                 $ref->stop_msg($fromnode);
352                         } else {
353                                 dbg("PC33 from unknown stream $stream from $fromnode") if isdbg('msg');
354                                 $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream
355                         } 
356
357                         # send next one if present
358                         queue_msg(0);
359                         last SWITCH;
360                 }
361                 
362                 if ($pcno == 40) {              # this is a file request
363                         $f[3] =~ s/\\/\//og; # change the slashes
364                         $f[3] =~ s/\.//og;      # remove dots
365                         $f[3] =~ s/^\///o;   # remove the leading /
366                         $f[3] = lc $f[3];       # to lower case;
367                         dbg("incoming file $f[3]\n") if isdbg('msg');
368                         $f[3] = 'packclus/' . $f[3] unless $f[3] =~ /^packclus\//o;
369                         
370                         # create any directories
371                         my @part = split /\//, $f[3];
372                         my $part;
373                         my $fn = "$main::root";
374                         pop @part;                      # remove last part
375                         foreach $part (@part) {
376                                 $fn .= "/$part";
377                                 next if -e $fn;
378                                 last SWITCH if !mkdir $fn, 0777;
379                                 dbg("created directory $fn\n") if isdbg('msg');
380                         }
381                         my $stream = next_transno($fromnode);
382                         my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0');
383                         
384                         # forwarding variables
385                         $ref->{fromnode} = $tonode;
386                         $ref->{tonode} = $fromnode;
387                         $ref->{linesreq} = $f[5];
388                         $ref->{stream} = $stream;
389                         $ref->{count} = 0;      # no of lines between PC31s
390                         $ref->{file} = 1;
391                         $ref->{lastt} = $main::systime;
392                         set_fwq($fromnode, $stream, $ref); # store in work
393                         $self->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack 
394                         
395                         last SWITCH;
396                 }
397                 
398                 if ($pcno == 42) {              # abort transfer
399                         dbg("stream $stream: abort received\n") if isdbg('msg');
400                         my $ref = get_fwq($fromnode, $stream);
401                         if ($ref) {
402                                 $ref->stop_msg($fromnode);
403                                 $ref = undef;
404                         }
405                         last SWITCH;
406                 }
407
408                 if ($pcno == 49) {      # global delete on subject
409                         for (@msg) {
410                                 if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) {
411                                         $_->mark_delete;
412                                         Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted");
413                                         DXChannel::broadcast_nodes($line, $self);
414                                 }
415                         }
416                 }
417         }
418 }
419
420
421 # store a message away on disc or whatever
422 #
423 # NOTE the second arg is a REFERENCE not a list
424 sub store
425 {
426         my $ref = shift;
427         my $lines = shift;
428
429         if ($ref->{file}) {                     # a file
430                 dbg("To be stored in $ref->{to}\n") if isdbg('msg');
431                 
432                 my $fh = new IO::File "$ref->{to}", "w";
433                 if (defined $fh) {
434                         my $line;
435                         foreach $line (@{$lines}) {
436                                 print $fh "$line\n";
437                         }
438                         $fh->close;
439                         dbg("file $ref->{to} stored\n") if isdbg('msg');
440                         Log('msg', "file $ref->{to} from $ref->{from} stored" );
441                 } else {
442                         confess "can't open file $ref->{to} $!";  
443                 }
444         } else {                                        # a normal message
445
446                 # attempt to open the message file
447                 my $fn = filename($ref->{msgno});
448                 
449                 dbg("To be stored in $fn\n") if isdbg('msg');
450                 
451                 # now save the file, overwriting what's there, YES I KNOW OK! (I will change it if it's a problem)
452                 my $fh = new IO::File "$fn", "w";
453                 if (defined $fh) {
454                         my $rr = $ref->{rrreq} ? '1' : '0';
455                         my $priv = $ref->{private} ? '1': '0';
456                         my $del = $ref->{delete} ? '1' : '0';
457                         my $delt = $ref->{deletetime} || '0';
458                         print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt\n";
459                         print $fh "=== ", join('^', @{$ref->{gotit}}), "\n";
460                         my $line;
461                         $ref->{size} = 0;
462                         foreach $line (@{$lines}) {
463                                 $ref->{size} += (length $line) + 1;
464                                 print $fh "$line\n";
465                         }
466                         $fh->close;
467                         dbg("msg $ref->{msgno} stored\n") if isdbg('msg');
468                         Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" );
469                 } else {
470                         confess "can't open msg file $fn $!";  
471                 }
472         }
473 }
474
475 # delete a message
476 sub del_msg
477 {
478         my $self = shift;
479         my $dxchan = shift;
480         
481         if ($self->{tonode}) {
482                 $self->{delete}++;
483                 $self->{deletetime} = 0;
484         } else {
485                 # remove it from the active message list
486                 @msg = grep { $_ != $self } @msg;
487
488                 my $call = '';
489                 $call = ' by ' . $dxchan->call if $dxchan;
490                 Log('msg', "Msgno $self->{msgno} expunged$call");
491                 
492                 # remove the file
493                 unlink filename($self->{msgno});
494         }
495 }
496
497 sub mark_delete
498 {
499         my $ref = shift;
500         my $t = shift;
501         $t = $main::systime + $residencetime unless defined $t;
502         
503         $ref->{delete}++;
504         $ref->{deletetime} = $t;
505         $ref->store( [$ref->read_msg_body] );
506 }
507
508 # clean out old messages from the message queue
509 sub clean_old
510 {
511         my $ref;
512         
513         # mark old messages for deletion
514         foreach $ref (@msg) {
515                 if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) {
516
517                         # this is for IMMEDIATE destruction
518                         $ref->{delete}++;
519                         $ref->{deletetime} = 0;
520                 }
521         }
522 }
523
524 # read in a message header
525 sub read_msg_header
526
527         my $fn = shift;
528         my $file;
529         my $line;
530         my $ref;
531         my @f;
532         my $size;
533         
534         $file = new IO::File "$fn";
535         if (!$file) {
536             dbg("Error reading $fn $!");
537             Log('err', "Error reading $fn $!");
538                 return undef;
539         }
540         $size = -s $fn;
541         $line = <$file>;                        # first line
542         if ($size == 0 || !$line) {
543             dbg("Empty $fn $!");
544             Log('err', "Empty $fn $!");
545                 return undef;
546         }
547         chomp $line;
548         $size -= length $line;
549         if (! $line =~ /^===/o) {
550                 dbg("corrupt first line in $fn ($line)");
551                 Log('err', "corrupt first line in $fn ($line)");
552                 return undef;
553         }
554         $line =~ s/^=== //o;
555         @f = split /\^/, $line;
556         $ref = DXMsg->alloc(@f);
557         
558         $line = <$file>;                        # second line
559         chomp $line;
560         $size -= length $line;
561         if (! $line =~ /^===/o) {
562             dbg("corrupt second line in $fn ($line)");
563             Log('err', "corrupt second line in $fn ($line)");
564                 return undef;
565         }
566         $line =~ s/^=== //o;
567         $ref->{gotit} = [];
568         @f = split /\^/, $line;
569         push @{$ref->{gotit}}, @f;
570         $ref->{size} = $size;
571         
572         close($file);
573         
574         return $ref;
575 }
576
577 # read in a message header
578 sub read_msg_body
579 {
580         my $self = shift;
581         my $msgno = $self->{msgno};
582         my $file;
583         my $line;
584         my $fn = filename($msgno);
585         my @out;
586         
587         $file = new IO::File;
588         if (!open($file, $fn)) {
589                 dbg("Error reading $fn $!");
590                 Log('err' ,"Error reading $fn $!");
591                 return ();
592         }
593         @out = map {chomp; $_} <$file>;
594         close($file);
595         
596         shift @out if $out[0] =~ /^=== /;
597         shift @out if $out[0] =~ /^=== /;
598         return @out;
599 }
600
601 # send a tranche of lines to the other end
602 sub send_tranche
603 {
604         my ($self, $dxchan) = @_;
605         my @out;
606         my $to = $self->{tonode};
607         my $from = $self->{fromnode};
608         my $stream = $self->{stream};
609         my $lines = $self->{lines};
610         my ($c, $i);
611         
612         for ($i = 0, $c = $self->{count}; $i < $self->{linesreq} && $c < @$lines; $i++, $c++) {
613                 push @out, DXProt::pc29($to, $from, $stream, $lines->[$c]);
614     }
615     $self->{count} = $c;
616
617     push @out, DXProt::pc32($to, $from, $stream) if $i < $self->{linesreq};
618         $dxchan->send(@out);
619 }
620
621         
622 # find a message to send out and start the ball rolling
623 sub queue_msg
624 {
625         my $sort = shift;
626         my $ref;
627         my $clref;
628         
629         # bat down the message list looking for one that needs to go off site and whose
630         # nearest node is not busy.
631
632         dbg("queue msg ($sort)\n") if isdbg('msg');
633         my @nodelist = DXChannel::get_all_nodes;
634         foreach $ref (@msg) {
635
636                 # ignore 'delayed' messages until their waiting time has expired
637                 if (exists $ref->{waitt}) {
638                         next if $ref->{waitt} > $main::systime;
639                         delete $ref->{waitt};
640                 } 
641
642                 # any time outs?
643                 if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) {
644                         my $node = $ref->{tonode};
645                         dbg("Timeout, stopping msgno: $ref->{msgno} -> $node") if isdbg('msg');
646                         Log('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
647                         $ref->stop_msg($node);
648                         
649                         # delay any outgoing messages that fail
650                         $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
651                         delete $ref->{lastt};
652                         next;
653                 }
654
655                 # is it being sent anywhere currently?
656                 next if $ref->{tonode};           # ignore it if it already being processed
657                 
658                 # is it awaiting deletion?
659                 if ($ref->{delete} && $main::systime >= $ref->{deletetime}) {
660                         $ref->del_msg;
661                         next;
662                 }
663                 next if $ref->{delete};
664                 
665                 # firstly, is it private and unread? if so can I find the recipient
666                 # in my cluster node list offsite?
667
668                 # deal with routed private messages
669                 my $dxchan;
670                 if ($ref->{private}) {
671                         next if $ref->{'read'};           # if it is read, it is stuck here
672                         $clref = Route::get($ref->{to});
673                         if ($clref) {
674                                 $dxchan = $clref->dxchan;
675                                 if ($dxchan) {
676                                         if ($dxchan->is_node) {
677                                                 next if $clref->call eq $main::mycall;  # i.e. it lives here
678                                                 $ref->start_msg($dxchan) if !get_busy($dxchan->call)  && $dxchan->state eq 'normal';
679                                         }
680                                 } else {
681                                         dbg("Route: No dxchan for $ref->{to} " . ref($clref) ) if isdbg('msg');
682                                 }
683                         }
684                 } else {
685                         
686                         # otherwise we are dealing with a bulletin or forwarded private message
687                         # compare the gotit list with
688                         # the nodelist up above, if there are sites that haven't got it yet
689                         # then start sending it - what happens when we get loops is anyone's
690                         # guess, use (to, from, time, subject) tuple?
691                         foreach $dxchan (@nodelist) {
692                                 my $call = $dxchan->call;
693                                 next unless $call;
694                                 next if $call eq $main::mycall;
695                                 next if ref $ref->{gotit} && grep $_ eq $call, @{$ref->{gotit}};
696                                 next unless $ref->forward_it($call);           # check the forwarding file
697                                 next if $ref->{tonode};           # ignore it if it already being processed
698                                 
699                                 # if we are here we have a node that doesn't have this message
700                                 if (!get_busy($call)  && $dxchan->state eq 'normal') {
701                                         $ref->start_msg($dxchan);
702                                         last;
703                                 }
704                         }
705                 }
706
707                 # if all the available nodes are busy then stop
708                 last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
709         }
710 }
711
712 # is there a message for me?
713 sub for_me
714 {
715         my $call = uc shift;
716         my $ref;
717         
718         foreach $ref (@msg) {
719                 # is it for me, private and unread? 
720                 if ($ref->{to} eq $call && $ref->{private}) {
721                         return 1 if !$ref->{'read'};
722                 }
723         }
724         return 0;
725 }
726
727 # start the message off on its travels with a PC28
728 sub start_msg
729 {
730         my ($self, $dxchan) = @_;
731         
732         confess("trying to start started msg $self->{msgno} nodes: $self->{fromnode} -> $self->{tonode}") if $self->{tonode};
733         dbg("start msg $self->{msgno}\n") if isdbg('msg');
734         $self->{linesreq} = 10;
735         $self->{count} = 0;
736         $self->{tonode} = $dxchan->call;
737         $self->{fromnode} = $main::mycall;
738         set_busy($self->{tonode}, $self);
739         set_fwq($self->{tonode}, undef, $self);
740         $self->{lastt} = $main::systime;
741         my ($fromnode, $origin);
742         $fromnode = $self->{fromnode};
743         $origin = $self->{origin};
744         $dxchan->send(DXProt::pc28($self->{tonode}, $fromnode, $self->{to}, $self->{from}, $self->{t}, $self->{private}, $self->{subject}, $origin, $self->{rrreq}));
745 }
746
747 # get the ref of a busy node
748 sub get_busy
749 {
750         my $call = shift;
751         return $busy{$call};
752 }
753
754 sub set_busy
755 {
756         my $call = shift;
757         return $busy{$call} = shift;
758 }
759
760 sub del_busy
761 {
762         my $call = shift;
763         return delete $busy{$call};
764 }
765
766 # get the whole busy queue
767 sub get_all_busy
768 {
769         return keys %busy;
770 }
771
772 # get a forwarding queue entry
773 sub get_fwq
774 {
775         my $call = shift;
776         my $stream = shift || '0';
777         return $work{"$call,$stream"};
778 }
779
780 # delete a forwarding queue entry
781 sub del_fwq
782 {
783         my $call = shift;
784         my $stream = shift || '0';
785         return delete $work{"$call,$stream"};
786 }
787
788 # set a fwq entry
789 sub set_fwq
790 {
791         my $call = shift;
792         my $stream = shift || '0';
793         return $work{"$call,$stream"} = shift;
794 }
795
796 # get the whole forwarding queue
797 sub get_all_fwq
798 {
799         return keys %work;
800 }
801
802 # stop a message from continuing, clean it out, unlock interlocks etc
803 sub stop_msg
804 {
805         my $self = shift;
806         my $node = shift;
807         my $stream = $self->{stream};
808         
809         
810         dbg("stop msg $self->{msgno} -> node $node\n") if isdbg('msg');
811         del_fwq($node, $stream);
812         $self->workclean;
813         del_busy($node);
814 }
815
816 sub workclean
817 {
818         my $ref = shift;
819         delete $ref->{lines};
820         delete $ref->{linesreq};
821         delete $ref->{tonode};
822         delete $ref->{fromnode};
823         delete $ref->{stream};
824         delete $ref->{file};
825         delete $ref->{count};
826         delete $ref->{tempr};
827         delete $ref->{lastt};
828         delete $ref->{waitt};
829 }
830
831 # get a new transaction number from the file specified
832 sub next_transno
833 {
834         my $name = shift;
835         $name =~ s/\W//og;                      # remove non-word characters
836         my $fn = "$msgdir/$name";
837         my $msgno;
838         
839         my $fh = new IO::File;
840         if (sysopen($fh, $fn, O_RDWR|O_CREAT, 0666)) {
841                 $fh->autoflush(1);
842                 $msgno = $fh->getline || '0';
843                 chomp $msgno;
844                 $msgno++;
845                 seek $fh, 0, 0;
846                 $fh->print("$msgno\n");
847                 dbg("msgno $msgno allocated for $name\n") if isdbg('msg');
848                 $fh->close;
849         } else {
850                 confess "can't open $fn $!";
851         }
852         return $msgno;
853 }
854
855 # initialise the message 'system', read in all the message headers
856 sub init
857 {
858         my $dir = new IO::File;
859         my @dir;
860         my $ref;
861                 
862         # load various control files
863         dbg("load badmsg: " . (load_badmsg() or "Ok"));
864         dbg("load forward: " . (load_forward() or "Ok"));
865         dbg("load swop: " . (load_swop() or "Ok"));
866
867         # read in the directory
868         opendir($dir, $msgdir) or confess "can't open $msgdir $!";
869         @dir = readdir($dir);
870         closedir($dir);
871
872         @msg = ();
873         for (sort @dir) {
874                 next unless /^m\d\d\d\d\d\d$/;
875                 
876                 $ref = read_msg_header("$msgdir/$_");
877                 unless ($ref) {
878                         dbg("Deleting $_");
879                         Log('err', "Deleting $_");
880                         unlink "$msgdir/$_";
881                         next;
882                 }
883                 
884                 # delete any messages to 'badmsg.pl' places
885                 if ($ref->dump_it('')) {
886                         dbg("'Bad' TO address $ref->{to}") if isdbg('msg');
887                         Log('msg', "'Bad' TO address $ref->{to}");
888                         $ref->del_msg;
889                         next;
890                 }
891
892                 # add the message to the available queue
893                 add_dir($ref); 
894         }
895 }
896
897 # add the message to the directory listing
898 sub add_dir
899 {
900         my $ref = shift;
901         confess "tried to add a non-ref to the msg directory" if !ref $ref;
902         push @msg, $ref;
903 }
904
905 # return all the current messages
906 sub get_all
907 {
908         return @msg;
909 }
910
911 # get a particular message
912 sub get
913 {
914         my $msgno = shift;
915         for (@msg) {
916                 return $_ if $_->{msgno} == $msgno;
917                 last if $_->{msgno} > $msgno;
918         }
919         return undef;
920 }
921
922 # return the official filename for a message no
923 sub filename
924 {
925         return sprintf "$msgdir/m%06d", shift;
926 }
927
928 #
929 # return a list of valid elements 
930
931
932 sub fields
933 {
934         return keys(%valid);
935 }
936
937 #
938 # return a prompt for a field
939 #
940
941 sub field_prompt
942
943         my ($self, $ele) = @_;
944         return $valid{$ele};
945 }
946
947 #
948 # send a message state machine
949 sub do_send_stuff
950 {
951         my $self = shift;
952         my $line = shift;
953         my @out;
954         
955         if ($self->state eq 'send1') {
956                 #  $DB::single = 1;
957                 confess "local var gone missing" if !ref $self->{loc};
958                 my $loc = $self->{loc};
959                 if (my @ans = BadWords::check($line)) {
960                         $self->{badcount} += @ans;
961                         Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} in msg");
962                         $loc->{reject}++;
963                 }
964                 $loc->{subject} = $line;
965                 $loc->{lines} = [];
966                 $self->state('sendbody');
967                 #push @out, $self->msg('sendbody');
968                 push @out, $self->msg('m8');
969         } elsif ($self->state eq 'sendbody') {
970                 confess "local var gone missing" if !ref $self->{loc};
971                 my $loc = $self->{loc};
972                 if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") {
973                         my $to;
974                         unless ($loc->{reject}) {
975                                 foreach $to (@{$loc->{to}}) {
976                                         my $ref;
977                                         my $systime = $main::systime;
978                                         my $mycall = $main::mycall;
979                                         $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
980                                                                                 uc $to,
981                                                                                 exists $loc->{from} ? $loc->{from} : $self->call, 
982                                                                                 $systime,
983                                                                                 $loc->{private}, 
984                                                                                 $loc->{subject}, 
985                                                                                 exists $loc->{origin} ? $loc->{origin} : $mycall,
986                                                                                 '0',
987                                                                                 $loc->{rrreq});
988                                         $ref->swop_it($self->call);
989                                         $ref->store($loc->{lines});
990                                         $ref->add_dir();
991                                         push @out, $self->msg('m11', $ref->{msgno}, $to);
992                                         #push @out, "msgno $ref->{msgno} sent to $to";
993                                         my $dxchan = DXChannel->get(uc $to);
994                                         if ($dxchan) {
995                                                 if ($dxchan->is_user()) {
996                                                         $dxchan->send($dxchan->msg('m9'));
997                                                 }
998                                         }
999                                 }
1000                         } else {
1001                                 Log('msg', $self->call . " swore to @{$loc->{to}} subject: '$loc->{subject}' in msg, REJECTED");
1002                         }
1003                         
1004                         delete $loc->{lines};
1005                         delete $loc->{to};
1006                         delete $self->{loc};
1007                         $self->func(undef);
1008                         
1009                         $self->state('prompt');
1010                 } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
1011                         #push @out, $self->msg('sendabort');
1012                         push @out, $self->msg('m10');
1013                         delete $loc->{lines};
1014                         delete $loc->{to};
1015                         delete $self->{loc};
1016                         $self->func(undef);
1017                         $self->state('prompt');
1018                 } else {
1019                         if (my @ans = BadWords::check($line)) {
1020                                 $self->{badcount} += @ans;
1021                                 Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} subject: '$loc->{subject}' in msg") unless $loc->{reject};
1022                                 Log('msg', "line: $line");
1023                                 $loc->{reject}++;
1024                         }
1025                         
1026                         # i.e. it ain't and end or abort, therefore store the line
1027                         push @{$loc->{lines}}, length($line) > 0 ? $line : " ";
1028                 }
1029         }
1030         return @out;
1031 }
1032
1033 # return the standard directory line for this ref 
1034 sub dir
1035 {
1036         my $ref = shift;
1037         my $flag = $ref->read ? '-' : ' ';
1038         $flag = 'D' if $ref->delete;
1039         return sprintf "%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", 
1040                 $ref->msgno, $flag, $ref->private ? 'p' : ' ', $ref->size,
1041                         $ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject;
1042 }
1043
1044 # load the forward table
1045 sub load_forward
1046 {
1047         my @out;
1048         my $s = readfilestr($forwardfn);
1049         if ($s) {
1050                 eval $s;
1051                 push @out, $@ if $@;
1052         }
1053         return @out;
1054 }
1055
1056 # load the bad message table
1057 sub load_badmsg
1058 {
1059         my @out;
1060         my $s = readfilestr($badmsgfn);
1061         if ($s) {
1062                 eval $s;
1063                 push @out, $@ if $@;
1064         }
1065         return @out;
1066 }
1067
1068 # load the swop message table
1069 sub load_swop
1070 {
1071         my @out;
1072         my $s = readfilestr($swopfn);
1073         if ($s) {
1074                 eval $s;
1075                 push @out, $@ if $@;
1076         }
1077         return @out;
1078 }
1079
1080 #
1081 # forward that message or not according to the forwarding table
1082 # returns 1 for forward, 0 - to ignore
1083 #
1084
1085 sub forward_it
1086 {
1087         my $ref = shift;
1088         my $call = shift;
1089         my $i;
1090         
1091         for ($i = 0; $i < @forward; $i += 5) {
1092                 my ($sort, $field, $pattern, $action, $bbs) = @forward[$i..($i+4)]; 
1093                 my $tested;
1094                 
1095                 # are we interested?
1096                 next if $ref->{private} && $sort ne 'P';
1097                 next if !$ref->{private} && $sort ne 'B';
1098                 
1099                 # select field
1100                 $tested = $ref->{to} if $field eq 'T';
1101                 $tested = $ref->{from} if $field eq 'F';
1102                 $tested = $ref->{origin} if $field eq 'O';
1103                 $tested = $ref->{subject} if $field eq 'S';
1104
1105                 if (!$pattern || $tested =~ m{$pattern}i) {
1106                         return 0 if $action eq 'I';
1107                         return 1 if !$bbs || grep $_ eq $call, @{$bbs};
1108                 }
1109         }
1110         return 0;
1111 }
1112
1113 sub dump_it
1114 {
1115         my $ref = shift;
1116         my $call = shift;
1117         my $i;
1118         
1119         for ($i = 0; $i < @badmsg; $i += 3) {
1120                 my ($sort, $field, $pattern) = @badmsg[$i..($i+2)]; 
1121                 my $tested;
1122                 
1123                 # are we interested?
1124                 next if $ref->{private} && $sort ne 'P';
1125                 next if !$ref->{private} && $sort ne 'B';
1126                 
1127                 # select field
1128                 $tested = $ref->{to} if $field eq 'T';
1129                 $tested = $ref->{from} if $field eq 'F';
1130                 $tested = $ref->{origin} if $field eq 'O';
1131                 $tested = $ref->{subject} if $field eq 'S';
1132                 $tested = $call if $field eq 'I';
1133
1134                 if (!$pattern || $tested =~ m{$pattern}i) {
1135                         return 1;
1136                 }
1137         }
1138         return 0;
1139 }
1140
1141 sub swop_it
1142 {
1143         my $ref = shift;
1144         my $call = shift;
1145         my $i;
1146         my $count = 0;
1147         
1148         for ($i = 0; $i < @swop; $i += 5) {
1149                 my ($sort, $field, $pattern, $tfield, $topattern) = @swop[$i..($i+4)]; 
1150                 my $tested;
1151                 my $swop;
1152                 my $old;
1153                 
1154                 # are we interested?
1155                 next if $ref->{private} && $sort ne 'P';
1156                 next if !$ref->{private} && $sort ne 'B';
1157                 
1158                 # select field
1159                 $tested = $ref->{to} if $field eq 'T';
1160                 $tested = $ref->{from} if $field eq 'F';
1161                 $tested = $ref->{origin} if $field eq 'O';
1162                 $tested = $ref->{subject} if $field eq 'S';
1163
1164                 # select swop field
1165                 $old = $swop = $ref->{to} if $tfield eq 'T';
1166                 $old = $swop = $ref->{from} if $tfield eq 'F';
1167                 $old = $swop = $ref->{origin} if $tfield eq 'O';
1168                 $old = $swop = $ref->{subject} if $tfield eq 'S';
1169
1170                 if ($tested =~ m{$pattern}i) {
1171                         if ($tested eq $swop) {
1172                                 $swop =~ s{$pattern}{$topattern}i;
1173                         } else {
1174                                 $swop = $topattern;
1175                         }
1176                         Log('msg', "Msg $ref->{msgno}: $tfield $old -> $swop");
1177                         Log('dbg', "Msg $ref->{msgno}: $tfield $old -> $swop");
1178                         $ref->{to} = $swop if $tfield eq 'T';
1179                         $ref->{from} = $swop if $tfield eq 'F';
1180                         $ref->{origin} = $swop if $tfield eq 'O';
1181                         $ref->{subject} = $swop if $tfield eq 'S';
1182                         ++$count;
1183                 }
1184         }
1185         return $count;
1186 }
1187
1188 # import any msgs in the import directory
1189 # the messages are in BBS format (but may have cluster extentions
1190 # so SB UK < GB7TLH is legal
1191 sub import_msgs
1192 {
1193         # are there any to do in this directory?
1194         return unless -d $importfn;
1195         unless (opendir(DIR, $importfn)) {
1196                 dbg("can\'t open $importfn $!") if isdbg('msg');
1197                 Log('msg', "can\'t open $importfn $!");
1198                 return;
1199         } 
1200
1201         my @names = readdir(DIR);
1202         closedir(DIR);
1203         my $name;
1204         foreach $name (@names) {
1205                 next if $name =~ /^\./;
1206                 my $splitit = $name =~ /^split/;
1207                 my $fn = "$importfn/$name";
1208                 next unless -f $fn;
1209                 unless (open(MSG, $fn)) {
1210                         dbg("can\'t open import file $fn $!") if isdbg('msg');
1211                         Log('msg', "can\'t open import file $fn $!");
1212                         unlink($fn);
1213                         next;
1214                 }
1215                 my @msg = map { chomp; $_ } <MSG>;
1216                 close(MSG);
1217                 unlink($fn);
1218                 my @out = import_one($main::me, \@msg, $splitit);
1219                 Log('msg', @out);
1220         }
1221 }
1222
1223 # import one message as a list in bbs (as extended) mode
1224 # takes a reference to an array containing the whole message
1225 sub import_one
1226 {
1227         my $dxchan = shift;
1228         my $ref = shift;
1229         my $splitit = shift;
1230         my $private = '1';
1231         my $rr = '0';
1232         my $notincalls = 1;
1233         my $from = $dxchan->call;
1234         my $origin = $main::mycall;
1235         my @to;
1236         my @out;
1237                                 
1238         # first line;
1239         my $line = shift @$ref;
1240         my @f = split /([\s\@\$])/, $line;
1241         @f = map {s/\s+//g; length $_ ? $_ : ()} @f;
1242
1243         unless (@f && $f[0] =~ /^(:?S|SP|SB|SEND)$/ ) {
1244                 my $m = "invalid first line in import '$line'";
1245                 dbg($m) if isdbg('msg');
1246                 return (1, $m);
1247         }
1248         while (@f) {
1249                 my $f = uc shift @f;
1250                 next if $f eq 'SEND';
1251
1252                 # private / noprivate / rr
1253                 if ($notincalls && ($f eq 'B' || $f eq 'SB' || $f =~ /^NOP/oi)) {
1254                         $private = '0';
1255                 } elsif ($notincalls && ($f eq 'P' || $f eq 'SP' || $f =~ /^PRI/oi)) {
1256                         ;
1257                 } elsif ($notincalls && ($f eq 'RR')) {
1258                         $rr = '1';
1259                 } elsif (($f =~ /^[\@\.\#\$]$/ || $f eq '.#') && @f) {       # this is bbs syntax, for AT
1260                         shift @f;
1261                 } elsif ($f eq '<' && @f) {     # this is bbs syntax  for from call
1262                         $from = uc shift @f;
1263                 } elsif ($f =~ /^\$/) {     # this is bbs syntax  for a bid
1264                         next;
1265                 } elsif ($f =~ /^<(\S+)/) {     # this is bbs syntax  for from call
1266                         $from = $1;
1267                 } elsif ($f =~ /^\$\S+/) {     # this is bbs syntax for bid
1268                         ;
1269                 } else {
1270
1271                         # callsign ?
1272                         $notincalls = 0;
1273
1274                         # is this callsign a distro?
1275                         my $fn = "$msgdir/distro/$f.pl";
1276                         if (-e $fn) {
1277                                 my $fh = new IO::File $fn;
1278                                 if ($fh) {
1279                                         local $/ = undef;
1280                                         my $s = <$fh>;
1281                                         $fh->close;
1282                                         my @call;
1283                                         @call = eval $s;
1284                                         return (1, "Error in Distro $f.pl:", $@) if $@;
1285                                         if (@call > 0) {
1286                                                 push @f, @call;
1287                                                 next;
1288                                         }
1289                                 }
1290                         }
1291                         
1292                         if (grep $_ eq $f, @DXMsg::badmsg) {
1293                                 push @out, $dxchan->msg('m3', $f);
1294                         } else {
1295                                 push @to, $f;
1296                         }
1297                 }
1298         }
1299         
1300         # subject is the next line
1301         my $subject = shift @$ref;
1302         
1303         # strip off trailing lines 
1304         pop @$ref while (@$ref && $$ref[-1] =~ /^\s*$/);
1305         
1306         # strip off /EX or /ABORT
1307         return ("aborted") if @$ref && $$ref[-1] =~ m{^/ABORT$}i; 
1308         pop @$ref if (@$ref && $$ref[-1] =~ m{^/EX$}i);                                                                  
1309
1310         # sort out any splitting that needs to be done
1311         my @chunk;
1312         if ($splitit) {
1313                 my $lth = 0;
1314                 my $lines = [];
1315                 for (@$ref) {
1316                         if ($lth >= $maxchunk || ($lth > $minchunk && /^\s*$/)) {
1317                                 push @chunk, $lines;
1318                                 $lines = [];
1319                                 $lth = 0;
1320                         } 
1321                         push @$lines, $_;
1322                         $lth += length; 
1323                 }
1324                 push @chunk, $lines if @$lines;
1325         } else {
1326                 push @chunk, $ref;
1327         }
1328                                   
1329     # write all the messages away
1330         my $i;
1331         for ( $i = 0;  $i < @chunk; $i++) {
1332                 my $chunk = $chunk[$i];
1333                 my $ch_subject;
1334                 if (@chunk > 1) {
1335                         my $num = " [" . ($i+1) . "/" . scalar @chunk . "]";
1336                         $ch_subject = substr($subject, 0, 27 - length $num) .  $num;
1337                 } else {
1338                         $ch_subject = $subject;
1339                 }
1340                 my $to;
1341                 foreach $to (@to) {
1342                         my $systime = $main::systime;
1343                         my $mycall = $main::mycall;
1344                         my $mref = DXMsg->alloc(DXMsg::next_transno('Msgno'),
1345                                                                         $to,
1346                                                                         $from, 
1347                                                                         $systime,
1348                                                                         $private, 
1349                                                                         $ch_subject, 
1350                                                                         $origin,
1351                                                                         '0',
1352                                                                         $rr);
1353                         $mref->swop_it($main::mycall);
1354                         $mref->store($chunk);
1355                         $mref->add_dir();
1356                         push @out, $dxchan->msg('m11', $mref->{msgno}, $to);
1357                         #push @out, "msgno $ref->{msgno} sent to $to";
1358                         my $todxchan = DXChannel->get(uc $to);
1359                         if ($todxchan) {
1360                                 if ($todxchan->is_user()) {
1361                                         $todxchan->send($todxchan->msg('m9'));
1362                                 }
1363                         }
1364                 }
1365         }
1366         return @out;
1367 }
1368
1369 no strict;
1370 sub AUTOLOAD
1371 {
1372         my $self = shift;
1373         my $name = $AUTOLOAD;
1374         return if $name =~ /::DESTROY$/;
1375         $name =~ s/.*:://o;
1376         
1377         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
1378         # this clever line of code creates a subroutine which takes over from autoload
1379         # from OO Perl - Conway
1380         *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
1381         @_ ? $self->{$name} = shift : $self->{$name} ;
1382 }
1383
1384 1;
1385
1386 __END__