X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=blobdiff_plain;f=perl%2FDXChannel.pm;h=674f835599bf972738bd06993bbb5b71606a413f;hp=40efdd245c5445be1e4c4c1fd06f81dac31267a0;hb=f63d598af3f797b56b8d5e23ec4ff5254192eee9;hpb=ec2bc54f842a3b684ce9375511f4ab2098717fe1 diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 40efdd24..674f8355 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -19,7 +19,7 @@ # firstly and OO about ninthly (if you don't like the design and you can't # improve it with better OO and thus make it smaller and more efficient, then tough). # -# Copyright (c) 1998-2000 - Dirk Koopman G1TLH +# Copyright (c) 1998-2016 - Dirk Koopman G1TLH # # # @@ -41,90 +41,96 @@ use vars qw(%channels %valid @ISA $count $maxerrors); $count = 0; %valid = ( - call => '0,Callsign', - conn => '9,Msg Conn ref', - user => '9,DXUser ref', - startt => '0,Start Time,atime', - t => '9,Time,atime', - pc50_t => '5,Last PC50 Time,atime', - priv => '9,Privilege', - state => '0,Current State', - oldstate => '5,Last State', - list => '9,Dep Chan List', - name => '0,User Name', - consort => '5,Connection Type', 'sort' => '5,Type of Channel', - wwv => '0,Want WWV,yesno', - wcy => '0,Want WCY,yesno', - wx => '0,Want WX,yesno', - talk => '0,Want Talk,yesno', ann => '0,Want Announce,yesno', - here => '0,Here?,yesno', + ann_talk => '0,Suppress Talk Anns,yesno', + annfilter => '5,Ann Filt-out', + badcount => '1,Bad Word Count', + badip => '9,BAD IP address', + beep => '0,Want Beeps,yesno', + build => '1,Node Build', + call => '0,Callsign', + cluster => '5,Cluster data', conf => '0,In Conference?,yesno', + conn => '9,Msg Conn ref', + consort => '5,Connection Type', + cq => '0,CQ Zone', + delayed => '5,Delayed messages,parray', + disconnecting => '9,Disconnecting,yesno', + do_pc9x => '9,Handles PC9x,yesno', dx => '0,DX Spots,yesno', - redirect => '0,Redirect messages to', - lang => '0,Language', + dxcc => '0,Country Code', + edit => '7,Edit Function', + enhanced => '5,Enhanced Client,yesno', + errors => '9,Errors', func => '5,Function', - loc => '9,Local Vars', # used by func to store local variables in - beep => '0,Want Beeps,yesno', - lastread => '5,Last Msg Read', - outbound => '5,outbound?,yesno', - remotecmd => '9,doing rcmd,yesno', - pagelth => '0,Page Length', - pagedata => '9,Page Data Store', group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other - isolate => '5,Isolate network,yesno', - delayed => '5,Delayed messages,parray', - annfilter => '5,Ann Filt-out', - wwvfilter => '5,WWV Filt-out', - wcyfilter => '5,WCY Filt-out', - spotsfilter => '5,Spot Filt-out', - routefilter => '5,Route Filt-out', - pc92filter => '5,PC92 Route Filt-out', + gtk => '5,Using GTK,yesno', + handle_xml => '9,Handles XML,yesno', + here => '0,Here?,yesno', + hostname => '0,Hostname', inannfilter => '5,Ann Filt-inp', - inwwvfilter => '5,WWV Filt-inp', - inwcyfilter => '5,WCY Filt-inp', - inspotsfilter => '5,Spot Filt-inp', - inroutefilter => '5,Route Filt-inp', inpc92filter => '5,PC92 Route Filt-inp', + inqueue => '9,Input Queue,parray', + inrbnfilter => '5,RBN Filt-inp', + inroutefilter => '5,Route Filt-inp', + inscript => '9,In a script,yesno', + inspotsfilter => '5,Spot Filt-inp', + inwcyfilter => '5,WCY Filt-inp', + inwwvfilter => '5,WWV Filt-inp', + isbasic => '9,Internal Connection', + isolate => '5,Isolate network,yesno', + isslugged => '9,Still Slugged,yesno', + itu => '0,ITU Zone', + lang => '0,Language', + lastmsgpoll => '0,Last Msg Poll,atime', + lastping => '5,Ping last sent,atime', + lastread => '5,Last Msg Read', + list => '9,Dep Chan List', + loc => '9,Local Vars', # used by func to store local variables in + logininfo => '9,Login info req,yesno', + metric => '1,Route metric', + name => '0,User Name', + newroute => '1,New Style Routing,yesno', + next_pc92_keepalive => '9,Next PC92 KeepAlive,atime', + next_pc92_update => '9,Next PC92 Update,atime', + nopings => '5,Ping Obs Count', + oldstate => '5,Last State', + outbound => '5,outbound?,yesno', + pagedata => '9,Page Data Store', + pagelth => '0,Page Length', passwd => '9,Passwd List,yesno', + pc50_t => '5,Last PC50 Time,atime', + pc92filter => '5,PC92 Route Filt-out', + pingave => '0,Ping ave time', pingint => '5,Ping Interval ', - nopings => '5,Ping Obs Count', - lastping => '5,Ping last sent,atime', pingtime => '5,Ping totaltime,parray', - pingave => '0,Ping ave time', - logininfo => '9,Login info req,yesno', - talklist => '0,Talk List,parray', - cluster => '5,Cluster data', - isbasic => '9,Internal Connection', - errors => '9,Errors', + priv => '9,Privilege', + prompt => '0,Required Prompt', + rbnfilter => '5,RBN Filt-out', + redirect => '0,Redirect messages to', + registered => '9,Registered?,yesno', + remotecmd => '9,doing rcmd,yesno', route => '9,Route Data', - dxcc => '0,Country Code', - itu => '0,ITU Zone', - cq => '0,CQ Zone', - enhanced => '5,Enhanced Client,yesno', - gtk => '5,Using GTK,yesno', + routefilter => '5,Route Filt-out', senddbg => '8,Sending Debug,yesno', - width => '0,Column Width', - disconnecting => '9,Disconnecting,yesno', - ann_talk => '0,Suppress Talk Anns,yesno', - metric => '1,Route metric', - badcount => '1,Bad Word Count', - edit => '7,Edit Function', - registered => '9,Registered?,yesno', - prompt => '0,Required Prompt', - version => '1,Node Version', - build => '1,Node Build', - verified => '9,Verified?,yesno', - newroute => '1,New Style Routing,yesno', + sluggedpcs => '9,Slugged PCxx Queue,parray', + spotsfilter => '5,Spot Filt-out', + startt => '0,Start Time,atime', + state => '0,Current State', + t => '9,Time,atime', + talk => '0,Want Talk,yesno', + talklist => '0,Talk List,parray', + user => '9,DXUser ref', ve7cc => '0,VE7CC program special,yesno', - lastmsgpoll => '0,Last Msg Poll,atime', - inscript => '9,In a script,yesno', - handle_xml => '9,Handles XML,yesno', - 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', + verified => '9,Verified?,yesno', + version => '1,Node Version', + wcy => '0,Want WCY,yesno', + wcyfilter => '5,WCY Filt-out', + width => '0,Column Width', + wwv => '0,Want WWV,yesno', + wwvfilter => '5,WWV Filt-out', + wx => '0,Want WX,yesno', ); $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection @@ -161,20 +167,19 @@ sub alloc $self->{sort} = $user->sort; $self->{width} = $user->width; } - $self->{startt} = $self->{t} = time; + $self->{startt} = $self->{t} = $main::systime; $self->{state} = 0; $self->{oldstate} = 0; $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; $self->{width} ||= 80; - # add in all the dxcc, itu, zone info my @dxcc = Prefix::extract($call); if (@dxcc > 0) { $self->{dxcc} = $dxcc[1]->dxcc; $self->{itu} = $dxcc[1]->itu; - $self->{cq} = $dxcc[1]->cq; + $self->{cq} = $dxcc[1]->cq; } $self->{inqueue} = []; @@ -216,6 +221,7 @@ sub rec if (defined $msg) { push @{$self->{inqueue}}, $msg; } + $self->process_one; } # obtain a channel object by callsign [$obj = DXChannel::get($call)] @@ -301,69 +307,70 @@ sub del # is it a bbs sub is_bbs { - my $self = shift; - return $self->{'sort'} eq 'B'; + return $_[0]->{sort} eq 'B'; } sub is_node { - my $self = shift; - return $self->{'sort'} =~ /[ACRSXW]/; + return $_[0]->{sort} =~ /^[ACRSX]$/; } # is it an ak1a node ? sub is_ak1a { - my $self = shift; - return $self->{'sort'} eq 'A'; + return $_[0]->{sort} eq 'A'; } # is it a user? sub is_user { - my $self = shift; - return $self->{'sort'} eq 'U'; + return $_[0]->{sort} =~ /^[UW]$/; } # is it a clx node sub is_clx { - my $self = shift; - return $self->{'sort'} eq 'C'; + return $_[0]->{sort} eq 'C'; } -# it is Aranea -sub is_aranea +# it is a Web connected user +sub is_web { - my $self = shift; - return $self->{'sort'} eq 'W'; + return $_[0]->{sort} eq 'W'; } # is it a spider node sub is_spider { - my $self = shift; - return $self->{'sort'} eq 'S'; + return $_[0]->{sort} eq 'S'; } # is it a DXNet node sub is_dxnet { - my $self = shift; - return $self->{'sort'} eq 'X'; + return $_[0]->{sort} eq 'X'; } # is it a ar-cluster node sub is_arcluster { - my $self = shift; - return $self->{'sort'} eq 'R'; + return $_[0]->{sort} eq 'R'; +} + +sub is_rbn +{ + return $_[0]->{sort} eq 'N'; +} + +sub is_dslink +{ + return $_[0]->{sort} eq 'L'; } # for perl 5.004's benefit sub sort { my $self = shift; - return @_ ? $self->{'sort'} = shift : $self->{'sort'} ; + return @_ ? $self->{sort} = shift : $self->{sort} ; } # find out whether we are prepared to believe this callsign on this interface @@ -502,7 +509,7 @@ sub disconnect my $self = shift; my $user = $self->{user}; - $user->close() if defined $user; + $user->close($self->{startt}, $self->{hostname}) if defined $user; $self->{conn}->disconnect if $self->{conn}; $self->del(); } @@ -589,7 +596,7 @@ sub decode_input { my $dxchan = shift; my $data = shift; - my ($sort, $call, $line) = $data =~ /^([A-Z])([A-Z0-9\-]{3,9})\|(.*)$/; + my ($sort, $call, $line) = $data =~ /^([A-Z])(#?[A-Z0-9\/\-]{3,25})\|(.*)$/; my $chcall = (ref $dxchan) ? $dxchan->call : "UN.KNOWN"; @@ -681,7 +688,7 @@ sub broadcast_list if ($sort eq 'dx') { next unless $dxchan->{dx}; - ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; + ($filter) = $dxchan->{spotsfilter}->it($fref) if $dxchan->{spotsfilter} && ref $fref; next unless $filter; } next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; @@ -699,40 +706,48 @@ sub broadcast_list } } -sub process +sub process_one { - foreach my $dxchan (get_all()) { - next if $dxchan->{disconnecting}; + my $self = shift; + + while (my $data = shift @{$self->{inqueue}}) { + my ($sort, $call, $line) = $self->decode_input($data); + next unless defined $sort; + + # do the really sexy console interface bit! (Who is going to do the TK interface then?) + dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan'); - while (my $data = shift @{$dxchan->{inqueue}}) { - my ($sort, $call, $line) = $dxchan->decode_input($data); - next unless defined $sort; - - # do the really sexy console interface bit! (Who is going to do the TK interface then?) - dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan'); - - # handle A records - my $user = $dxchan->user; - if ($sort eq 'A' || $sort eq 'O') { - $dxchan->start($line, $sort); - } elsif ($sort eq 'I') { - die "\$user not defined for $call" if !defined $user; + # handle A records + my $user = $self->user; + if ($sort eq 'I') { + die "\$user not defined for $call" unless defined $user; - # normal input - $dxchan->normal($line); - } elsif ($sort eq 'Z') { - $dxchan->disconnect; - } elsif ($sort eq 'D') { - ; # ignored (an echo) - } elsif ($sort eq 'G') { - $dxchan->enhanced($line); - } else { - print STDERR atime, " Unknown command letter ($sort) received from $call\n"; - } + # normal input + $self->normal($line); + } elsif ($sort eq 'G') { + $self->enhanced($line); + } elsif ($sort eq 'A' || $sort eq 'O' || $sort eq 'W') { + $self->start($line, $sort); + } elsif ($sort eq 'C') { + $self->width($line); # change number of columns + } elsif ($sort eq 'Z') { + $self->disconnect; + } elsif ($sort eq 'D') { + ; # ignored (an echo) + } else { + dbg atime . " DXChannel::process_one: Unknown command letter ($sort) received from $call\n"; } } } +sub process +{ + foreach my $dxchan (values %channels) { + next if $dxchan->{disconnecting}; + $dxchan->process_one; + } +} + sub handle_xml { my $self = shift; @@ -746,12 +761,22 @@ sub handle_xml return $r; } -sub registered +sub error_handler +{ + my $self = shift; + my $error = shift || ''; + dbg("$self->{call} ERROR '$error', closing") if isdbg('chan'); + $self->{conn}->set_error(undef) if exists $self->{conn}; + $self->disconnect(1); +} + + +sub isregistered { my $self = shift; # the sysop is registered! - return 1 if $self->call eq $main::myalias || $self->call eq $main::mycall; + return 1 if $self->{call} eq $main::myalias || $self->{call} eq $main::mycall; if ($main::reqreg) { return $self->{registered};