X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=69a72abe9e1d4438118f991b5e3b86f515206099;hb=8b21846900b9f840da86fef72e6ee86ac56cfb53;hp=99ae22a90960dec138e9339f3f9c60bae7310d0d;hpb=ad7e69f78ee4c0593e1d7576a7c1fd3b13931f84;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 99ae22a9..69a72abe 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -21,7 +21,7 @@ # # Copyright (c) 1998-2000 - Dirk Koopman G1TLH # -# $Id$ +# # package DXChannel; @@ -35,7 +35,7 @@ use Prefix; use Route; use strict; -use vars qw(%channels %valid @ISA $count); +use vars qw(%channels %valid @ISA $count $maxerrors); %channels = (); $count = 0; @@ -119,14 +119,13 @@ $count = 0; lastmsgpoll => '0,Last Msg Poll,atime', inscript => '9,In a script,yesno', handle_xml => '9,Handles XML,yesno', - do_pc92 => '9,Handles PC92,yesno', - send_pc92 => '9,Send PC92,atime', + do_pc9x => '9,Handles PC9x,yesno', inqueue => '9,Input Queue,parray', + next_pc92_update => '9,Next PC92 Update,atime', + next_pc92_keepalive => '9,Next PC92 KeepAlive,atime', ); - -use vars qw($VERSION $BRANCH); -($VERSION, $BRANCH) = dxver(q$Revision$); +$maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection # object destruction sub DESTROY @@ -180,6 +179,22 @@ sub alloc return $channels{$call} = $self; } +# count errors and disconnect if too many +# this has to be here because it can come from rcmd (DXProt) as +# well as DXCommandmode. +sub _error_out +{ + my $self = shift; + my $e = shift; + if (++$self->{errors} > $maxerrors) { + $self->send($self->msg('e26')); + $self->disconnect; + return (); + } else { + return ($self->msg($e)); + } +} + # rebless this channel as something else sub rebless { @@ -224,6 +239,17 @@ sub get_all_nodes return @out; } +# return a list of node calls +sub get_all_node_calls +{ + my $ref; + my @out; + foreach $ref (values %channels) { + push @out, $ref->{call} if $ref->is_node; + } + return @out; +} + # return a list of all users sub get_all_users { @@ -472,7 +498,7 @@ sub disconnect my $user = $self->{user}; $user->close() if defined $user; - $self->{conn}->disconnect; + $self->{conn}->disconnect if $self->{conn}; $self->del(); } @@ -577,28 +603,6 @@ sub decode_input return ($sort, $call, $line); } -sub rspfcheck -{ - my ($self, $flag, $node, $user) = @_; - my $nref = Route::Node::get($node); - my $dxchan = $nref->dxchan if $nref; - if ($nref && $dxchan) { - if ($dxchan == $self) { - return 1 unless $user; - return 1 if $user eq $node; - my @users = $nref->users; - return 1 if @users == 0 || grep $user eq $_, @users; - dbg("RSPF: $user not on $node") if isdbg('chanerr'); - } else { - dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr'); - } - } else { - return 1 if $flag; - dbg("RSPF: required $node not found" ) if isdbg('chanerr'); - } - return 0; -} - # broadcast a message to all clusters taking into account isolation # [except those mentioned after buffer] sub broadcast_nodes