X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FDS.pm;h=3cddfd188588e0fc8f13163b0150478e01304514;hb=c882fd47f0f83f0be9b8c524604e003295e2b1ba;hp=15ece4df5bbee68158f0bdfcbb2ad75418bd4064;hpb=97caa1fe259cd6904573f36e0ac078a269b6ec5f;p=public-inbox.git

diff --git a/lib/PublicInbox/DS.pm b/lib/PublicInbox/DS.pm
index 15ece4df..3cddfd18 100644
--- a/lib/PublicInbox/DS.pm
+++ b/lib/PublicInbox/DS.pm
@@ -35,9 +35,10 @@ use Errno qw(EAGAIN EINVAL);
 use Carp qw(carp croak);
 our @EXPORT_OK = qw(now msg_more dwaitpid add_timer);
 
+my %Stack;
 my $nextq; # queue for next_tick
 my $wait_pids; # list of [ pid, callback, callback_arg ]
-my $later_queue; # list of callbacks to run at some later interval
+my $later_q; # list of callbacks to run at some later interval
 my $EXPMAP; # fd -> idle_time
 our $EXPTIME = 180; # 3 minutes
 my ($later_timer, $reap_armed, $exp_timer);
@@ -66,18 +67,25 @@ Reset all state
 
 =cut
 sub Reset {
-    $in_loop = undef; # first in case DESTROY callbacks use this
-    %DescriptorMap = ();
-    $wait_pids = $later_queue = $reap_armed = undef;
-    $EXPMAP = {};
-    $nextq = $ToClose = $later_timer = $exp_timer = undef;
-    $LoopTimeout = -1;  # no timeout by default
-    @Timers = ();
-
-    $PostLoopCallback = undef;
-
-    $_io = undef; # closes real $Epoll FD
-    $Epoll = undef; # may call DSKQXS::DESTROY
+	do {
+		$in_loop = undef; # first in case DESTROY callbacks use this
+		%DescriptorMap = ();
+		@Timers = ();
+		$PostLoopCallback = undef;
+
+		# we may be iterating inside one of these on our stack
+		my @q = delete @Stack{keys %Stack};
+		for my $q (@q) { @$q = () }
+		$EXPMAP = {};
+		$wait_pids = $later_q = $nextq = $ToClose = undef;
+		$_io = undef; # closes real $Epoll FD
+		$Epoll = undef; # may call DSKQXS::DESTROY
+	} while (@Timers || keys(%Stack) || $nextq || $wait_pids ||
+		$later_q || $ToClose || keys(%DescriptorMap) ||
+		$PostLoopCallback);
+
+	$reap_armed = $later_timer = $exp_timer = undef;
+	$LoopTimeout = -1;  # no timeout by default
 }
 
 =head2 C<< CLASS->SetLoopTimeout( $timeout ) >>
@@ -160,17 +168,19 @@ C<PostLoopCallback> below for how to exit the loop.
 sub now () { clock_gettime(CLOCK_MONOTONIC) }
 
 sub next_tick () {
-    my $q = $nextq or return;
-    $nextq = undef;
-    for my $obj (@$q) {
-        # we avoid "ref" on blessed refs to workaround a Perl 5.16.3 leak:
-        # https://rt.perl.org/Public/Bug/Display.html?id=114340
-        if (blessed($obj)) {
-            $obj->event_step;
-        } else {
-            $obj->();
-        }
-    }
+	my $q = $nextq or return;
+	$nextq = undef;
+	$Stack{cur_runq} = $q;
+	for my $obj (@$q) {
+		# avoid "ref" on blessed refs to workaround a Perl 5.16.3 leak:
+		# https://rt.perl.org/Public/Bug/Display.html?id=114340
+		if (blessed($obj)) {
+			$obj->event_step;
+		} else {
+			$obj->();
+		}
+	}
+	delete $Stack{cur_runq};
 }
 
 # runs timers and returns milliseconds for next one, or next event loop
@@ -221,6 +231,7 @@ sub reap_pids {
 	$reap_armed = undef;
 	my $tmp = $wait_pids or return;
 	$wait_pids = undef;
+	$Stack{reap_runq} = $tmp;
 	my $oldset = block_signals();
 	foreach my $ary (@$tmp) {
 		my ($pid, $cb, $arg) = @$ary;
@@ -237,6 +248,7 @@ sub reap_pids {
 		}
 	}
 	sig_setmask($oldset);
+	delete $Stack{reap_runq};
 }
 
 # reentrant SIGCHLD handler (since reap_pids is not reentrant)
@@ -271,7 +283,6 @@ sub EventLoop {
     $Epoll //= _InitPoller();
     local $in_loop = 1;
     my @events;
-    my $obj; # guard stack-not-refcounted w/ Carp + @DB::args
     do {
         my $timeout = RunTimers();
 
@@ -282,7 +293,9 @@ sub EventLoop {
             # that ones in the front triggered unregister-interest actions.  if we
             # can't find the %sock entry, it's because we're no longer interested
             # in that event.
-            $obj = $DescriptorMap{$fd};
+
+	    # guard stack-not-refcounted w/ Carp + @DB::args
+            my $obj = $DescriptorMap{$fd};
             $obj->event_step;
         }
     } while (PostEventLoop());
@@ -646,13 +659,15 @@ sub dwaitpid ($;$$) {
 }
 
 sub _run_later () {
-	my $run = $later_queue or return;
-	$later_timer = $later_queue = undef;
-	$_->() for @$run;
+	my $q = $later_q or return;
+	$later_timer = $later_q = undef;
+	$Stack{later_q} = $q;
+	$_->() for @$q;
+	delete $Stack{later_q};
 }
 
 sub later ($) {
-	push @$later_queue, $_[0]; # autovivifies @$later_queue
+	push @$later_q, $_[0]; # autovivifies @$later_q
 	$later_timer //= add_timer(60, \&_run_later);
 }