add various eph timings and variables to control them

fix leading spaces for msgs
fix listeners for 5.7.2

diff --git a/Changes b/Changes
index 5ee56e7da92f4807f953fdbc34ba63ad789e4d8d..cacc841a586602c4d15b35a7addcc7fb92f746f5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+06Jan02=======================================================================
+1. fix leading space removal from messages input from the keyboard
+2. make some mods to allow perl 5.7.2 to run
+3. create $DXProt::eph_restime to allow variable slugging of ephemeral dups
+4. create $DXProt::eph_info_restime to allow a long dupe time for these
+4. create $DXProt::eph_pc34 to allow a short anti dupe slug for rcmd loops
 02Jan02=======================================================================
 1. updated the copyright dates
 2. modernised and extended the Windows instructions a bit.

diff --git a/TODO b/TODO
index afec96bb9bfb17f3c9cd12585a56709f52a185fa..ebcf58a9eda2b8d4513e561e02f552eef79add66 100644 (file)
--- a/TODO
+++ b/TODO
@@ -6,6 +6,10 @@ Maintenance and Enhancements
 ----------------------------
 
 * add a retry count for messages
+* set/notify
+* sh/maxusers (max users in node since last restart)
+* review badwords
+* fix non-english apropos to only show english when there REALLY is nothing else
 
 New Protocol Stuff
 ------------------

diff --git a/cmd/show/dup_eph.pl b/cmd/show/dup_eph.pl
new file mode 100644 (file)
index 0000000..c8abccc
--- /dev/null
+++ b/cmd/show/dup_eph.pl
@@ -0,0 +1,12 @@
+#
+# show a list of all the outstanding announce dups
+# for debugging really
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+my $line = shift;
+return (1, $self->msg('e5')) unless $self->priv >= 9; 
+return (1, DXProt::eph_list $line);

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 8b704ab5333f4f011617bd0ca88ea795dbf8743a..4601ec21df0ca34d01ca99b7beb64f9f9996bdd8 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -186,6 +186,9 @@ sub normal
        my $self = shift;
        my $cmdline = shift;
        my @ans;
+
+       # save this for them's that need it
+       my $rawline = $cmdline;
        
        # remove leading and trailing spaces
        $cmdline =~ s/^\s*(.*)\s*$/$1/;
@@ -274,7 +277,7 @@ sub normal
                                Log('DXCommand', "$self->{call} swore: $cmdline");
                        } else {
                                for (@{$self->{talklist}}) {
-                                       $self->send_talks($_, $cmdline);
+                                       $self->send_talks($_, $rawline);
                                }
                        }
                        $self->send($self->talk_prompt) if $self->{state} eq 'talk';
@@ -286,9 +289,9 @@ sub normal
                no strict 'refs';
                my @ans;
                if (ref $self->{edit}) {
-                       eval { @ans = $self->{edit}->$func($self, $cmdline)};
+                       eval { @ans = $self->{edit}->$func($self, $rawline)};
                } else {
-                       eval {  @ans = &{$self->{func}}($self, $cmdline) };
+                       eval {  @ans = &{$self->{func}}($self, $rawline) };
                }
                if ($@) {
                        $self->send_ans("Syserr: on stored func $self->{func}", $@);

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 7bffd606b25276058b368abf94b28de3cc4bc7ac..4c8a70564f5df1107933fcc7d075f0dc6a8af8b5 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -42,7 +42,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
-use vars qw($pc11_max_age $pc23_max_age $last_pc50
+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
                        %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
@@ -62,6 +62,9 @@ $badnode = new DXHash "badnode";
 $last10 = $last_pc50 = time;
 $ann_to_talk = 1;
 $rspfcheck = 1;
+$eph_restime = 180;
+$eph_info_restime = 10*60;
+$eph_pc34_restime = 30;
 
 @checklist = 
 (
@@ -977,11 +980,16 @@ sub normal
                }
                
                if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
-                       $self->process_rcmd($field[1], $field[2], $field[2], $field[3]);
+                       if (eph_dup($line, $eph_pc34_restime)) {
+                               dbg("PCPROT: dupe") if isdbg('chanerr');
+                       } else {
+                               $self->process_rcmd($field[1], $field[2], $field[2], $field[3]);
+                       }
                        return;
                }
                
                if ($pcno == 35) {              # remote command replies
+                       eph_del_regex("^PC35\^$field[2]\^$field[1]\^");
                        $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]);
                        return;
                }
@@ -1005,6 +1013,11 @@ sub normal
                if ($pcno == 41) {              # user info
                        my $call = $field[1];
 
+                       if (eph_dup($line, $eph_info_restime)) {
+                               dbg("PCPROT: dupe") if isdbg('chanerr');
+                               return;
+                       }
+                       
                        # input filter if required
 #                      my $ref = Route::get($call) || Route->new($call);
 #                      return unless $self->in_filter_route($ref);
@@ -1035,11 +1048,11 @@ sub normal
                        } elsif ($field[2] == 4) {
                                $user->homenode($field[3]);
                        } elsif ($field[2] == 5) {
-                               if (is_qra($field[3])) {
-                                       my ($lat, $long) = DXBearing::qratoll($field[3]);
+                               if (is_qra(uc $field[3])) {
+                                       my ($lat, $long) = DXBearing::qratoll(uc $field[3]);
                                        $user->lat($lat);
                                        $user->long($long);
-                                       $user->qra($field[3]);
+                                       $user->qra(uc $field[3]);
                                } else {
                                        dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
                                        return;
@@ -1048,9 +1061,13 @@ sub normal
                        $user->lastoper($main::systime);   # to cut down on excessive for/opers being generated
                        $user->put;
 
+                       unless ($self->{isolate}) {
+                               DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
+                       }
+
 #  perhaps this IS what we want after all
 #                      $self->route_pc41($ref, $call, $field[2], $field[3], $field[4]);
-#                      return;
+                       return;
                }
 
                if ($pcno == 43) {
@@ -1907,12 +1924,13 @@ sub in_filter_route
 sub eph_dup
 {
        my $s = shift;
+       my $t = shift || $eph_restime;
        my $r;
 
        # chop the end off
        $s =~ s/\^H\d\d?\^?\~?$//;
        $r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
-       $eph{$s} = $main::systime;
+       $eph{$s} = $main::systime + $t;
        return $r;
 }
 
@@ -1932,11 +1950,21 @@ sub eph_clean
        my ($key, $val);
        
        while (($key, $val) = each %eph) {
-               if ($main::systime - $val > 180) {
+               if ($main::systime >= $val) {
                        delete $eph{$key};
                }
        }
 }
 
+sub eph_list
+{
+       my ($key, $val);
+       my @out;
+
+       while (($key, $val) = each %eph) {
+               push @out, $key, $val;
+       }
+       return @out;
+}
 1;
 __END__ 

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 615feb1987e4a102def727f208d093107f63d85b..333693b73a2e65d2ef89d0a620e4b4da9133befa 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -344,11 +344,12 @@ sub new_server {
        my $self = $pkg->new($login_proc);
        
     $self->{sock} = IO::Socket::INET->new (
-                                          LocalAddr => $my_host,
-                                          LocalPort => $my_port,
+                                          LocalAddr => "$my_host:$my_port",
+#                                          LocalPort => $my_port,
                                           Listen    => SOMAXCONN,
                                           Proto     => 'tcp',
-                                          Reuse     => 1);
+                                          ReuseAddr => 1,
+                                                                                 );
     die "Could not create socket: $! \n" unless $self->{sock};
     set_event_handler ($self->{sock}, read => sub { $self->new_client }  );
        return $self;