X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=8097f6cd96c24621d6112b93e6594105bb8d269a;hb=f77b59f4fcceb428142461972e94345419cbda28;hp=c324930fad4b8ac9d9190b2fcd1bac07c6a31342;hpb=2e16209416d1d189707935868a708b525c93097b;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index c324930f..8097f6cd 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -9,61 +9,55 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # +# $Id$ # use Msg; use DXVars; use DXUtil; -use DXConnect; +use DXChannel; use DXUser; +use DXM; package main; -@inqueue = undef; # the main input queue, an array of hashes - -# handle out going messages -sub send_now -{ - my ($conn, $sort, $call, $line) = @_; - - print DEBUG "$t > $sort $call $line\n" if defined DEBUG; - print "> $sort $call $line\n"; - $conn->send_now("$sort$call|$line"); -} - -sub send_later -{ - my ($conn, $sort, $call, $line) = @_; - - print DEBUG "$t > $sort $call $line\n" if defined DEBUG; - print "> $sort $call $line\n"; - $conn->send_later("$sort$call|$line"); -} +@inqueue = (); # the main input queue, an array of hashes # handle disconnections sub disconnect { - my $dxconn = shift; - my ($user) = $dxconn->{user}; - my ($conn) = $dxconn->{conn}; + my $dxchan = shift; + return if !defined $dxchan; + my $user = $dxchan->{user}; + my $conn = $dxchan->{conn}; $user->close() if defined $user; - $conn->disconnect(); - $dxconn->del(); + $conn->disconnect() if defined $conn; + $dxchan->del(); } # handle incoming messages sub rec { my ($conn, $msg, $err) = @_; - my $dxconn = DXConnect->get_by_cnum($conn); # get the dxconnnect object for this message + my $dxchan = DXChannel->get_by_cnum($conn); # get the dxconnnect object for this message if (defined $err && $err) { - disconnect($dxconn); + disconnect($dxchan) if defined $dxchan; return; - } + } + + # set up the basic channel info - this needs a bit more thought - there is duplication here + if (!defined $dxchan) { + my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + my $user = DXUser->get($call); + $user = DXUser->new($call) if !defined $user; + $dxchan = DXChannel->new($call, $conn, $user); + } + + # queue the message and the channel object for later processing if (defined $msg) { my $self = bless {}, "inqueue"; - $self->{dxconn} = $dxconn; + $self->{dxchan} = $dxchan; $self->{data} = $msg; push @inqueue, $self; } @@ -77,10 +71,11 @@ sub login # cease running this program, close down all the connections nicely sub cease { - my $dxconn; - foreach $dxconn (DXConnect->get_all()) { - disconnect($dxconn); + my $dxchan; + foreach $dxchan (DXChannel->get_all()) { + disconnect($dxchan); } + exit(0); } # this is where the input queue is dealt with and things are dispatched off to other parts of @@ -91,8 +86,8 @@ sub process_inqueue return if !$self; my $data = $self->{data}; - my $dxconn = $self->{dxconn}; - my ($sort, $call, $line) = $data =~ /^(\w)(\S+)|(.*)$/; + my $dxchan = $self->{dxchan}; + my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/; # do the really sexy console interface bit! (Who is going to do the TK interface then?) print DEBUG atime, " < $sort $call $line\n" if defined DEBUG; @@ -100,12 +95,17 @@ sub process_inqueue # handle A records if ($sort eq 'A') { - if ($dxconn) { # there should not be one of these, disconnect - + my $user = $dxchan->{user}; + $user->{sort} = 'U' if !defined $user->{sort}; + if ($user->{sort} eq 'U') { + $dxchan->send_now('D', msg('l2', $call, $mycall, $myqth)); + $dxchan->send_file($motd) if (-e $motd); } - my $user = DXUser->get($call); # see if we have one of these + } elsif (sort eq 'D') { + ; + } elsif ($sort eq 'Z') { + disconnect($dxchan); } - } ############################################################# @@ -115,7 +115,7 @@ sub process_inqueue ############################################################# # open the debug file, set various FHs to be unbuffered -open(DEBUG, ">>$debugfn") or die "can't open $debugfn($!)\n"; +open(DEBUG, ">>$debugfn") or die "can't open $debugfn($!)"; select DEBUG; $| = 1; select STDOUT; $| = 1;