Script to remove expired sessions.

This also can set up users so that the admin
"Log user out" function works correctly.

3 files changed, 81 insertions, 0 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 96f0fd35c..624dbc041 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -27,6 +27,7 @@
         - Admin can log a user out. #1975
         - Admin can remove a user's account details. #1944
         - Superusers can have optional two-factor authentication. #1973
+        - Add script to remove expired sessions. #1987
     - UK:
         - Lazy load images in the footer.
 
diff --git a/bin/expire-sessions b/bin/expire-sessions
new file mode 100755
index 000000000..8cfdd57e3
--- /dev/null
+++ b/bin/expire-sessions
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+
+# expire-sessions: Run regularly to remove old sessions (plus
+# can set up data for 'log user out' admin functionality).
+
+use strict;
+use warnings;
+require 5.8.0;
+
+BEGIN {
+    use File::Basename qw(dirname);
+    use File::Spec;
+    my $d = dirname(File::Spec->rel2abs($0));
+    require "$d/../setenv.pl";
+}
+
+use FixMyStreet::DB;
+use Getopt::Long;
+use List::Util qw(uniq);
+use MIME::Base64;
+use Storable;
+
+GetOptions(
+    'init' => \my $init,
+);
+
+my $rs = FixMyStreet::DB->resultset("Session");
+
+# Delete expired sessions (including from in User object)
+while (my $session = $rs->search({ expires => { '<', time() } })->next) {
+    if (my $user = get_user($session)) {
+        my $id = get_id($session);
+        my $sessions = $user->get_extra_metadata('sessions');
+        my @new_sessions = grep { $_ ne $id } @$sessions;
+        update_user_sessions($user, \@new_sessions) if @new_sessions != @$sessions;
+    }
+    $session->delete;
+}
+
+if ($init) {
+    # Update sessions to make sure all present in User objects
+    print "Setting up sessions in user objects\n";
+    while (my $session = $rs->next) {
+        my $user = get_user($session) or next;
+        my $id = get_id($session);
+        my $sessions = $user->get_extra_metadata('sessions');
+        my @new_sessions = uniq @$sessions, $id;
+        update_user_sessions($user, \@new_sessions) if @new_sessions != @$sessions;
+    }
+}
+
+# ---
+
+sub get_user {
+    my $session = shift;
+    return unless $session->session_data;
+    my $data = Storable::thaw(MIME::Base64::decode($session->session_data));
+    return unless $data->{__user};
+    my $user = FixMyStreet::DB->resultset("User")->find($data->{__user}{id});
+    return $user;
+}
+
+sub get_id {
+    my $session = shift;
+    my $id = $session->id;
+    $id =~ s/^session://;
+    $id =~ s/\s+$//;
+    return $id;
+}
+
+sub update_user_sessions {
+    my ($user, $sessions) = @_;
+    if (@$sessions) {
+        $user->set_extra_metadata('sessions', $sessions);
+    } else {
+        $user->unset_extra_metadata('sessions');
+    }
+    $user->update;
+}
diff --git a/conf/crontab-example b/conf/crontab-example
index 037dd147e..f06144699 100644
--- a/conf/crontab-example
+++ b/conf/crontab-example
@@ -31,6 +31,7 @@ PATH=/usr/local/bin:/usr/bin:/bin
 13 * * * * "$FMS/bin/update-all-reports"
 
 # Once a day on all servers
+0  0 * * * "$FMS/bin/expire-sessions"
 39 2 * * * "$FMS/bin/problems-filed-graph"
 43 2 * * * "$FMS/bin/problem-creation-graph"
 00 8 * * * "$FMS/bin/check-for-zombies" $UNIX_USER