From 51eae76dd663d23c1f4bb1e809e9c258e800cb73 Mon Sep 17 00:00:00 2001
From: Matthew Somerville <matthew@mysociety.org>
Date: Wed, 10 Jun 2020 14:29:35 +0100
Subject: Only show access tokens once, and store hashed.

---
 .../Authentication/Credential/AccessToken.pm       | 34 ++++++++++------------
 1 file changed, 15 insertions(+), 19 deletions(-)

(limited to 'perllib/Catalyst/Authentication/Credential/AccessToken.pm')

diff --git a/perllib/Catalyst/Authentication/Credential/AccessToken.pm b/perllib/Catalyst/Authentication/Credential/AccessToken.pm
index 7827c936d..24398823d 100644
--- a/perllib/Catalyst/Authentication/Credential/AccessToken.pm
+++ b/perllib/Catalyst/Authentication/Credential/AccessToken.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use base 'Class::Accessor::Fast';
 
-__PACKAGE__->mk_accessors(qw(token_field token_lookup));
+__PACKAGE__->mk_accessors(qw(token_field));
 
 our $VERSION = "0.01";
 
@@ -23,21 +23,23 @@ sub authenticate {
     $token ||= $c->get_param('access_token');
     return unless $token;
 
-    my $field = $self->token_field || 'access_token';
+    my $id;
+    ($id, $token) = split /-/, $token, 2;
+    return unless $id =~ /^[1-9]\d*$/;
 
-    my $value = $token;
-    if (my $lookup = $self->token_lookup) {
-        $value = {};
-        foreach (keys %$lookup) {
-            my $v = $lookup->{$_};
-            $v =~ s/TOKEN/$token/;
-            $value->{$_} = $v;
-        }
-    }
-    my $user_obj = $realm->find_user({ $field => $value }, $c);
-    if (ref $user_obj) {
+    my $user_obj = $realm->find_user({ id => $id }, $c);
+    if (ref($user_obj) && $self->check_token($user_obj, $token)) {
         return $user_obj;
     }
+    return;
+}
+
+sub check_token {
+    my ($self, $user, $token) = @_;
+
+    my $field = $self->token_field || 'access_token';
+    my $value = $user->$field;
+    return $user->_column_encoders->{password}->($token, $value) eq $value;
 }
 
 __PACKAGE__;
@@ -102,12 +104,6 @@ depending on the storage class used, but is most likely something like
 'access_token'. In fact, this is so common that if this is left out of the
 config, it defaults to 'access_token'.
 
-=item token_lookup
-
-If the token isn't a field on its own, but contained within another field, you
-can provide a custom lookup here, where the string TOKEN in a value will be
-replaced by the access token.
-
 =back
 
 =head1 USAGE
-- 
cgit v1.2.3


From e461de75b26e74c0d8c154a1a17d6019c2be30dd Mon Sep 17 00:00:00 2001
From: M Somerville <matthew-github@dracos.co.uk>
Date: Fri, 7 Aug 2020 20:02:17 +0100
Subject: Offline process for CSV generation.

Include a status page, the option for access token requests to use this
system, and a script for manual generation.
---
 perllib/Catalyst/Authentication/Credential/AccessToken.pm | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

(limited to 'perllib/Catalyst/Authentication/Credential/AccessToken.pm')

diff --git a/perllib/Catalyst/Authentication/Credential/AccessToken.pm b/perllib/Catalyst/Authentication/Credential/AccessToken.pm
index 24398823d..39364ad99 100644
--- a/perllib/Catalyst/Authentication/Credential/AccessToken.pm
+++ b/perllib/Catalyst/Authentication/Credential/AccessToken.pm
@@ -15,12 +15,18 @@ sub new {
     return $self;
 }
 
-sub authenticate {
-    my ( $self, $c, $realm, $authinfo_ignored ) = @_;
-
+sub get_token {
+    my ($self, $c) = @_;
     my $auth_header = $c->req->header('Authorization') || '';
     my ($token) = $auth_header =~ /^Bearer (.*)/i;
     $token ||= $c->get_param('access_token');
+    return $token;
+}
+
+sub authenticate {
+    my ( $self, $c, $realm, $authinfo_ignored ) = @_;
+
+    my $token = $self->get_token($c);
     return unless $token;
 
     my $id;
-- 
cgit v1.2.3