fix 5.8 ism that does not work on 5.6 (incrementing a subroutine).
[spider.git] / perl / DXProt.pm
index 69085f358a146eee342562bf5cfc5b2ae8d9ba4f..352a4f6a4aae9bd715467aab117ad842bd295dd9 100644 (file)
@@ -47,10 +47,11 @@ $main::branch += $BRANCH;
 
 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
                        $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
-                       $pingint $obscount %pc19list $chatdupeage
-                       $investigation_int $pc19_version
+                       $pingint $obscount %pc19list $chatdupeage $chatimportfn
+                       $investigation_int $pc19_version $myprot_version
                        %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
-                       $allowzero $decode_dk0wcy $send_opernam @checklist);
+                       $allowzero $decode_dk0wcy $send_opernam @checklist
+                       $handle_xml);
 
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc23
@@ -75,13 +76,15 @@ $eph_pc34_restime = 30;
 $pingint = 5*60;
 $obscount = 2;
 $chatdupeage = 20 * 60 * 60;
+$chatimportfn = "$main::root/chat_import";
 $investigation_int = 12*60*60; # time between checks to see if we can see this node
 $pc19_version = 5466;                  # the visible version no for outgoing PC19s generated from pc59
+$handle_xml = 0;                               # handle XML sentences
 
 @checklist = 
 (
  [ qw(i c c m bp bc c) ],                      # pc10
- [ qw(i f m d t m c c h) ],            # pc11
+ [ qw(i f bm d t m c c h) ],           # pc11
  [ qw(i c bm m bm bm p h) ],           # pc12
  [ qw(i c h) ],                                        # 
  [ qw(i c h) ],                                        # 
@@ -205,6 +208,21 @@ sub init
 {
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
+
+       my $user = DXUser->get($main::mycall);
+       die "User $main::mycall not setup or disappeared RTFM" unless $user;
+       
+       $myprot_version += $main::version*100;
+       $main::me = DXProt->new($main::mycall, 0, $user); 
+       $main::me->{here} = 1;
+       $main::me->{state} = "indifferent";
+       $main::me->{sort} = 'S';    # S for spider
+       $main::me->{priv} = 9;
+       $main::me->{metric} = 0;
+       $main::me->{pingave} = 0;
+       $main::me->{registered} = 1;
+       $main::me->{version} = $main::version;
+       $main::me->{build} = $main::build;
 }
 
 #
@@ -233,7 +251,10 @@ sub start
        my $user = $self->{user};
 
        # log it
-       my $host = $self->{conn}->{peerhost} || "unknown";
+       my $host = $self->{conn}->{peerhost};
+       $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
+       $host ||= "unknown";
+
        Log('DXProt', "$call connected from $host");
        
        # remember type of connection
@@ -307,21 +328,6 @@ sub sendinit
        $self->send(pc18());
 }
 
-sub removepc90
-{
-       $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
-       $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
-}
-
-#sub send
-#{
-#      my $self = shift;
-#      while (@_) {
-#              my $line = shift;
-#              $self->SUPER::send($line);
-#      }
-#}
-
 #
 # This is the normal pcxx despatcher
 #
@@ -329,9 +335,6 @@ sub normal
 {
        my ($self, $line) = @_;
 
-       # remove any incoming PC90 frames
-       removepc90($line);
-
        my @field = split /\^/, $line;
        return unless @field;
        
@@ -422,8 +425,8 @@ sub handle_10
 #      RouteDB::update($to, $_[6]);
 
        # it is here and logged on
-       $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
-       $dxchan = DXChannel->get($to) unless $dxchan;
+       $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall;
+       $dxchan = DXChannel::get($to) unless $dxchan;
        if ($dxchan && $dxchan->is_user) {
                $_[3] =~ s/\%5E/^/g;
                $dxchan->talk($from, $to, $via, $_[3]);
@@ -519,7 +522,7 @@ sub handle_11
 #      RouteDB::update($_[7], $self->{call});
 #      RouteDB::update($_[6], $_[7]);
        
-       my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]);
+       my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]);
        # global spot filtering on INPUT
        if ($self->{inspotsfilter}) {
                my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
@@ -532,7 +535,7 @@ sub handle_11
        # this goes after the input filtering, but before the add
        # so that if it is input filtered, it isn't added to the dup
        # list. This allows it to come in from a "legitimate" source
-       if (Spot::dup($_[1], $_[2], $d, $_[5], $_[6])) {
+       if (Spot::dup(@spot[0..4,5])) {
                dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
                return;
        }
@@ -647,7 +650,7 @@ sub handle_12
 
        my $dxchan;
        
-       if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
+       if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
                $self->send_chat($line, @_[1..6]);
        } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
@@ -763,7 +766,7 @@ sub handle_16
                                                }
                                        }
                                        $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route 
-                                       $user->lastin($main::systime) unless DXChannel->get($ncall);
+                                       $user->lastin($main::systime) unless DXChannel::get($ncall);
                                        $user->put;
                                                
                                        # route the pc19 - this will cause 'stuttering PC19s' for a while
@@ -834,7 +837,7 @@ sub handle_16
                $user = DXUser->new($call) if !$user;
                $user->homenode($parent->call) if !$user->homenode;
                $user->node($parent->call);
-               $user->lastin($main::systime) unless DXChannel->get($call);
+               $user->lastin($main::systime) unless DXChannel::get($call);
                $user->put;
        }
        $self->route_pc16($origin, $line, $parent, @rout) if @rout;
@@ -927,6 +930,7 @@ sub handle_18
                        $self->user->put;
                        $self->sort('S');
                }
+               $self->{handle_xml}++ if $_[1] =~ /\bxml\b/;
        } else {
                $self->version(50.0);
                $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
@@ -1000,7 +1004,7 @@ sub handle_19
                next if $call eq $main::mycall;
 
                # check that this PC19 isn't trying to alter the wrong dxchan
-               my $dxchan = DXChannel->get($call);
+               my $dxchan = DXChannel::get($call);
                if ($dxchan && $dxchan != $self) {
                        dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
                        next;
@@ -1082,7 +1086,7 @@ sub handle_19
                my $mref = DXMsg::get_busy($call);
                $mref->stop_msg($call) if $mref;
                                
-               $user->lastin($main::systime) unless DXChannel->get($call);
+               $user->lastin($main::systime) unless DXChannel::get($call);
                $user->put;
        }
 
@@ -1151,7 +1155,7 @@ sub handle_21
                        my $node = Route::Node::get($call);
                        if ($node) {
                                                
-                               my $dxchan = DXChannel->get($call);
+                               my $dxchan = DXChannel::get($call);
                                if ($dxchan && $dxchan != $self) {
                                        dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
                                        return;
@@ -1215,13 +1219,24 @@ sub handle_23
                dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr');
                return;
        }
-       if (Geomag::dup($d,$sfi,$k,$i,$_[6])) {
+
+       # global wwv filtering on INPUT
+       my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]);
+       if ($self->{inwwvfilter}) {
+               my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc);
+               unless ($filter) {
+                       dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
+                       return;
+               }
+       }
+       $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
+       if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) {
                dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
                return;
        }
-       $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
                
-       my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
+       # note this only takes the first one it gets
+       Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
 
        my $rep;
        eval {
@@ -1533,10 +1548,10 @@ sub handle_51
                        # it's a reply, look in the ping list for this one
                        my $ref = $pings{$from};
                        if ($ref) {
-                               my $tochan =  DXChannel->get($from);
+                               my $tochan =  DXChannel::get($from);
                                while (@$ref) {
                                        my $r = shift @$ref;
-                                       my $dxchan = DXChannel->get($r->{call});
+                                       my $dxchan = DXChannel::get($r->{call});
                                        next unless $dxchan;
                                        my $t = tv_interval($r->{t}, [ gettimeofday ]);
                                        if ($dxchan->is_user) {
@@ -1684,7 +1699,7 @@ sub handle_default
 sub process
 {
        my $t = time;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $pc50s;
        
@@ -1721,6 +1736,8 @@ sub process
                # clean out ephemera 
 
                eph_clean();
+               import_chat();
+               
 
                $last10 = $t;
        }
@@ -1743,7 +1760,7 @@ sub send_dx_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -1794,7 +1811,7 @@ sub send_wwv_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]);
 
@@ -1818,7 +1835,7 @@ sub wwv
        my ($filter, $hops);
        
        if ($self->{wwvfilter}) {
-               ($filter, $hops) = $self->{wwvfilter}->it(@_);
+               ($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_]);
                return unless $filter;
        }
        send_prot_line($self, $filter, $hops, $isolate, $line)
@@ -1828,7 +1845,7 @@ sub send_wcy_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]);
        
@@ -1861,7 +1878,7 @@ sub send_announce
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $target;
        my $to = 'To ';
@@ -1926,7 +1943,7 @@ sub send_chat
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $target = $_[3];
        my $text = unpad($_[2]);
@@ -2067,7 +2084,7 @@ sub route
        }
 
        # always send it down the local interface if available
-       my $dxchan = DXChannel->get($call);
+       my $dxchan = DXChannel::get($call);
        if ($dxchan) {
                dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route');
        } else {
@@ -2090,7 +2107,7 @@ sub route
                                dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
                                return;
                        }
-                       $dxchan = DXChannel->get($rcall);
+                       $dxchan = DXChannel::get($rcall);
                        dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
                }
        }
@@ -2171,7 +2188,7 @@ sub addping
        my $r = {};
        $r->{call} = $from;
        $r->{t} = [ gettimeofday ];
-       if ($via && (my $dxchan = DXChannel->get($via))) {
+       if ($via && (my $dxchan = DXChannel::get($via))) {
                $dxchan->send(pc51($to, $main::mycall, 1));
        } else {
                route(undef, $to, pc51($to, $main::mycall, 1));
@@ -2223,13 +2240,13 @@ sub process_rcmd_reply
        if ($tonode eq $main::mycall) {
                my $s = $rcmds{$fromnode};
                if ($s) {
-                       my $dxchan = DXChannel->get($s->{call});
-                       my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
+                       my $dxchan = DXChannel::get($s->{call});
+                       my $ref = $user eq $tonode ? $dxchan : (DXChannel::get($user) || $dxchan);
                        $ref->send($line) if $ref;
                        delete $rcmds{$fromnode} if !$dxchan;
                } else {
                        # send unsolicited ones to the sysop
-                       my $dxchan = DXChannel->get($main::myalias);
+                       my $dxchan = DXChannel::get($main::myalias);
                        $dxchan->send($line) if $dxchan;
                }
        } else {
@@ -2307,6 +2324,8 @@ sub disconnect
                        eph_del_regex("^PC1[679].*$c");
                }
        }
+
+       RouteDB::delete_interface($call);
        
        # remove them from the pc19list as well
        while (my ($k,$v) = each %pc19list) {
@@ -2547,5 +2566,69 @@ sub run_cmd
 {
        goto &DXCommandmode::run_cmd;
 }
+
+
+# import any msgs in the chat directory
+# the messages are sent to the chat group which forms the
+# the first part of the name (eg: solar.1243.txt would be
+# sent to chat group SOLAR)
+# 
+# Each message found is sent: one non-blank line to one chat
+# message. So 4 lines = 4 chat messages.
+# 
+# The special name LOCAL is for local users ANN
+# The special name ALL is for ANN/FULL
+# The special name SYSOP is for ANN/SYSOP
+#
+sub import_chat
+{
+       # are there any to do in this directory?
+       return unless -d $chatimportfn;
+       unless (opendir(DIR, $chatimportfn)) {
+               dbg("can\'t open $chatimportfn $!") if isdbg('msg');
+               Log('msg', "can\'t open $chatimportfn $!");
+               return;
+       } 
+
+       my @names = readdir(DIR);
+       closedir(DIR);
+       my $name;
+       foreach $name (@names) {
+               next if $name =~ /^\./;
+               my $splitit = $name =~ /^split/;
+               my $fn = "$chatimportfn/$name";
+               next unless -f $fn;
+               unless (open(MSG, $fn)) {
+                       dbg("can\'t open import file $fn $!") if isdbg('msg');
+                       Log('msg', "can\'t open import file $fn $!");
+                       unlink($fn);
+                       next;
+               }
+               my @msg = map { s/\r?\n$//; $_ } <MSG>;
+               close(MSG);
+               unlink($fn);
+
+               my @cat = split /\./, $name;
+               my $target = uc $cat[0];
+
+               foreach my $text (@msg) {
+                       next unless $text && $text !~ /^\s*#/;
+                       if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP') {
+                               my $sysopflag = $target eq 'SYSOP' ? '*' : ' ';
+                               if ($target ne 'LOCAL') {
+                                       send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0');
+                               } else {
+                                       Log('ann', 'LOCAL', $main::mycall, $text);
+                                       DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all());
+                               }
+                       } else {
+                               my $msgid = nextchatmsgid();
+                               $text = "#$msgid $text";
+                               send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0');
+                       }
+               }
+       }
+}
+
 1;
 __END__