From b77cd6ef9ebcff9180786c59ec2e40974551447b Mon Sep 17 00:00:00 2001
From: Alex Karle <alex@karle.co>
Date: Fri, 15 May 2020 00:26:51 -0400
Subject: [PATCH] Euchre::Host: Add prune_players to catch stale connections

If a client suspends their device (laptop lid, phone screen), it appears
the connection isn't properly terminated.

I was under the impression we should have detected this when we stopped
sending them ping/pong actions... but I guess not.

So this commit adds a second resource cleanup sub -- prune_players.
Thankfully, it's easy to check if the ws is open, so we just need to go
through and delete all PLAYERS with stale ws connections. This is safe
because if the ws thinks it's closed, it certainly aint gonna reopen
(not with our clients at least).

Also a minor syntax update to the file to use the id accessors over the
{} hash style access. Hard to break that habit.
---
 gloat.pl             |  5 ++++-
 lib/Euchre/Host.pm   | 37 ++++++++++++++++++++++++++++---------
 lib/Euchre/Player.pm |  5 +++++
 3 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/gloat.pl b/gloat.pl
index 6184980..9f98ab7 100755
--- a/gloat.pl
+++ b/gloat.pl
@@ -53,6 +53,9 @@ websocket '/play' => sub {
 };
 
 my $cleanup_time = $ENV{DEBUG} ? 1 : 300;
-Mojo::IOLoop->recurring($cleanup_time => \&prune_tables);
+Mojo::IOLoop->recurring($cleanup_time => sub {
+        prune_tables();
+        prune_players();
+    });
 
 app->start;
diff --git a/lib/Euchre/Host.pm b/lib/Euchre/Host.pm
index 27e7265..e80c4ab 100644
--- a/lib/Euchre/Host.pm
+++ b/lib/Euchre/Host.pm
@@ -18,6 +18,7 @@ our @EXPORT = qw(
     register_player
     gloaters_never_win
     prune_tables
+    prune_players
     list_tables
     stats
 );
@@ -56,7 +57,7 @@ sub gloaters_never_win {
 
     # TODO: cleanup stale tables
     my $p = $PLAYERS{$id};
-    leave_table($p);
+    try_leave_table($p);
 
     $LOG->info("Player " . $p->name . " went inactive");
     delete $PLAYERS{$id};
@@ -88,7 +89,7 @@ sub handle_msg {
         $dispatch{$msg->{action}}->($p, $msg);
     } else {
         require_table($p) or return;
-        my $d = $DEALERS{$PINDEX{$p->{id}}};
+        my $d = $DEALERS{$PINDEX{$p->id}};
         $d->handle_msg($cid, $msg);
     }
 }
@@ -99,7 +100,7 @@ sub handle_msg {
 sub require_table {
     my ($p) = @_;
 
-    my $at_table = exists $PINDEX{$p->{id}};
+    my $at_table = exists $PINDEX{$p->id};
     if (!$at_table) {
         $p->error(NOT_AT_TABLE);
     }
@@ -126,7 +127,7 @@ sub join_table {
     # leave_table in all cases, and we need to prevent one Player from having
     # multiple Tables for a whole lot of reasons (messages from multiple
     # tables, failure to detect and cleanup state, etc)
-    if (exists $PINDEX{$p->{id}}) {
+    if (exists $PINDEX{$p->id}) {
         leave_table($p);
     }
 
@@ -149,7 +150,7 @@ sub join_table {
         $p->error($errno);
     } else {
         $LOG->info("Player " . $p->name . " joined table $tid");
-        $PINDEX{$p->{id}} = $tid;
+        $PINDEX{$p->id} = $tid;
     }
 }
 
@@ -159,7 +160,7 @@ sub leave_table {
     require_table($p) or return;
 
     # Let the dealer do its own cleanup, then cleanup our state
-    my $d = $DEALERS{$PINDEX{$p->{id}}};
+    my $d = $DEALERS{$PINDEX{$p->id}};
     if (my $errno = $d->remove_player($p)) {
         $p->error($errno);
     } else {
@@ -169,9 +170,9 @@ sub leave_table {
         $LOG->info("Player " . $p->name . " left table " . $d->id);
         if (!$d->is_active && $d->game->phase eq 'end') {
             $LOG->info("Deleting Table " . $d->id . " that appears to have finished");
-            delete $DEALERS{$PINDEX{$p->{id}}};
+            delete $DEALERS{$PINDEX{$p->id}};
         }
-        delete $PINDEX{$p->{id}};
+        delete $PINDEX{$p->id};
     }
 }
 
@@ -242,10 +243,28 @@ sub require_keys {
 sub prune_tables {
     for my $k (keys %DEALERS) {
         if (!$DEALERS{$k}->is_active) {
-            $LOG->info("Deleting inactive table " . $DEALERS{$k}->id);
+            $LOG->info("Pruning inactive table " . $DEALERS{$k}->id);
             delete $DEALERS{$k};
         }
     }
 }
 
+# Prune empty players, to be called in a IOLoop
+sub prune_players {
+    for my $p (keys %PLAYERS) {
+        if (!$PLAYERS{$p}->is_active) {
+            $LOG->info("Pruning inactive player " . $PLAYERS{$p}->name);
+            try_leave_table($PLAYERS{$p});
+            delete $PLAYERS{$p};
+        }
+    }
+}
+
+sub try_leave_table {
+    my ($p) = @_;
+    if (exists $PINDEX{$p->id}) {
+        leave_table($p);
+    }
+}
+
 1;
diff --git a/lib/Euchre/Player.pm b/lib/Euchre/Player.pm
index 52a1bc4..2e18fc3 100644
--- a/lib/Euchre/Player.pm
+++ b/lib/Euchre/Player.pm
@@ -49,4 +49,9 @@ sub stand_up {
     return SUCCESS;
 }
 
+sub is_active {
+    my ($self) = @_;
+    return !$self->ws->is_finished;
+}
+
 1;
--
libgit2 1.1.1