From b953903f1c33ae35ce24bad344e46ab17b0b5d95 Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 7 Jan 2007 23:57:24 +0000 Subject: [PATCH] added perl socket blocking where available change timestamp in PC9x to seconds in day. --- perl/DXLog.pm | 2 +- perl/DXProtHandle.pm | 9 ++++++++- perl/Msg.pm | 22 ++++++++-------------- perl/cluster.pl | 12 ++++++++++-- 4 files changed, 27 insertions(+), 18 deletions(-) diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 78548353..07038433 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -206,7 +206,7 @@ sub Log sub LogDbg { - DXDebug::dbg($_[$#_]); + DXDebug::dbg($_) for @_; Log(@_); } diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 26781885..fc05280a 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -1339,7 +1339,7 @@ sub gen_pc9x_t if (!$_last_time || $_last_time != $main::systime) { $_last_time = $main::systime; $_last_occurs = 0; - return $_last_time; + return $_last_time - $main::systime_daystart; } else { $_last_occurs++; return sprintf "$_last_time.%02d", $_last_occurs; @@ -1356,10 +1356,12 @@ sub check_pc9x_t my $parent = ref $call ? $call : Route::Node::get($call); if ($parent) { my $lastid = $parent->lastid->{$pc} || 0; + $t += 86400 if $t < $lastid - 43200; if ($lastid >= $t) { dbg("PCPROT: dup / old id on $call <= $lastid, ignored") if isdbg('chanerr'); return; } + $t -= 86400 if $t >= 86400; } elsif ($create) { $parent = Route::Node->new($call); } @@ -1394,6 +1396,7 @@ sub handle_92 } my $parent = check_pc9x_t($pcall, $t, 92, 1); + return unless $parent; $parent->lastid->{92} = $t; $parent->do_pc92(1); @@ -1404,6 +1407,10 @@ sub handle_92 # and update any information that needs to be done. my ($call, $is_node, $is_extnode, $here, $version, $build) = _decode_pc92_call($ent[0]); if ($call && $is_node) { + if ($call eq $main::mycall) { + dbg("PCPROT: looped back on node entry, ignored") if isdbg('chanerr'); + return; + } if ($is_extnode) { # reparent to external node (note that we must have received a 'C' or 'A' record # from the true parent node for this external before we get one for the this node diff --git a/perl/Msg.pm b/perl/Msg.pm index 00569928..e13be8f3 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -42,11 +42,9 @@ BEGIN { require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL)) }; if ($@ || $main::is_win) { -# print STDERR "POSIX Blocking *** NOT *** supported $@\n"; - $blocking_supported = 0; + $blocking_supported = IO::Socket->can('blocking') ? 2 : 0; } else { - $blocking_supported = 1; -# print STDERR "POSIX Blocking enabled\n"; + $blocking_supported = IO::Socket->can('blocking') ? 2 : 1; } @@ -139,12 +137,8 @@ sub blocking return unless $blocking_supported; # Make the handle stop blocking, the Windows way. - if ($main::is_win) { - # 126 is FIONBIO (some docs say 0x7F << 16) - ioctl( $_[0], - 0x80000000 | (4 << 16) | (ord('f') << 8) | 126, - "$_[1]" - ); + if ($blocking_supported) { + $_[0]->blocking($_[1]); } else { my $flags = fcntl ($_[0], F_GETFL, 0); if ($_[1]) { @@ -346,10 +340,10 @@ sub _send { # return to the event loop only after every message, or if it # is likely to block in the middle of a message. - if ($conn->{blocking} != $flush) { - blocking($sock, $flush); - $conn->{blocking} = $flush; - } +# if ($conn->{blocking} != $flush) { +# blocking($sock, $flush); +# $conn->{blocking} = $flush; +# } my $offset = (exists $conn->{send_offset}) ? $conn->{send_offset} : 0; while (@$rq) { diff --git a/perl/cluster.pl b/perl/cluster.pl index 0fc478ea..79bca264 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -116,7 +116,7 @@ use strict; use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr $clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting - $allowdxby $dbh $dsn $dbuser $dbpass $do_xml + $allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart ); @inqueue = (); # the main input queue, an array of hashes @@ -332,6 +332,8 @@ sub AGWrestart ############################################################# $starttime = $systime = time; +$systime_days = int ($systime / 86400); +$systime_daystart = $systime_days * 86400; $lang = 'en' unless $lang; unless ($DB::VERSION) { @@ -511,7 +513,13 @@ for (;;) { # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { reap() if $zombies; - IsoTime::update($systime = $timenow); + $systime = $timenow; + my $days = int ($systime / 86400); + if ($systime_days != $days) { + $systime_days = $days; + $systime_daystart = $days * 86400; + } + IsoTime::update($systime); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXXml::process(); -- 2.43.0