Expire sessions after about one week, instead of at browser close.

In response to a gripe by Tom Lane.

diff --git a/bin/expire_sessions b/bin/expire_sessions
new file mode 100755 (executable)
index 0000000..3b57a70
--- /dev/null
+++ b/bin/expire_sessions
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+require PgCommitFest::Request;
+
+my $db = PgCommitFest::Request->db();
+$db->do(<<EOM);
+DELETE FROM session WHERE login_time < now() - '10 days'::interval;
+EOM
+$db->commit;

diff --git a/perl-lib/PgCommitFest/DB.pm b/perl-lib/PgCommitFest/DB.pm
index 471900784ecb28e43db4907f1963dfb88296ced2..8eb3f800ffe56b50d4ed04df26df2556a3e008a4 100644 (file)
--- a/perl-lib/PgCommitFest/DB.pm
+++ b/perl-lib/PgCommitFest/DB.pm
@@ -41,6 +41,13 @@ sub delete {
        return $self->{'dbh'}->do($sql, {}, @bind);
 }
 
+sub do {
+       my ($self, $sql, @bind) = @_;
+       warn $sql if $self->{'trace'};
+       $self->{'dirty'} = 1;
+       return $self->{'dbh'}->do($sql, {}, @bind);
+}
+
 sub disconnect {
        my ($self) = @_;
        return $self->{'dbh'}->disconnect();

diff --git a/perl-lib/PgCommitFest/Handler.pm b/perl-lib/PgCommitFest/Handler.pm
index c27ae1064a1c3c04f1afa3bd7ae143b814a442f5..438f7e0f642b36fbbb6f814b18dfe3d9166ee545 100644 (file)
--- a/perl-lib/PgCommitFest/Handler.pm
+++ b/perl-lib/PgCommitFest/Handler.pm
@@ -7,6 +7,7 @@ require PgCommitFest::Request;
 use strict;
 use warnings;
 use FCGI;
+use POSIX;
 use Template;
 
 our %ACTION = (
@@ -112,7 +113,10 @@ EOM
                        $r->db->insert('session', { 'id' => $session_cookie,
                                'userid' => $u->{'userid'} });
                        $r->db->commit;
-                       $r->header('Set-Cookie', "session=$session_cookie; path=/");
+                       my $expires = strftime("%a, %d-%b-%Y %H:%M:%S GMT",
+                               localtime(time + (86400 * 7)));
+                       $r->header('Set-Cookie',
+                               "session=$session_cookie; path=/; expires=$expires");
                        $r->redirect($value{'uri'} ne '' ? $value{'uri'} : '/');
                }
                else {

diff --git a/perl-lib/PgCommitFest/Request.pm b/perl-lib/PgCommitFest/Request.pm
index dc75d92b86fef842b7436ea024bc830a359e653b..9710c5d7c2d3120725dff0bb845023d21b03c966 100644 (file)
--- a/perl-lib/PgCommitFest/Request.pm
+++ b/perl-lib/PgCommitFest/Request.pm
@@ -118,11 +118,10 @@ sub control {
 
 sub db {
        my ($self) = @_;
-       if (!defined $self->{'db'}) {
-               $self->{'db'} =
-                       PgCommitFest::DB->connect($PG, $PGUSERNAME, $PGPASSWORD);
-       }
-       return $self->{'db'};
+       return $self->{'db'} if ref $self && defined $self->{'db'};
+       my $db = PgCommitFest::DB->connect($PG, $PGUSERNAME, $PGPASSWORD);
+       $self->{'db'} = $db if ref $self;
+       return $db;
 }
 
 sub db_is_connected {