-
Notifications
You must be signed in to change notification settings - Fork 9
/
User.pm
143 lines (118 loc) · 3.27 KB
/
User.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
use strictures 2;
package Catalyst::Authentication::Store::Neo4p::User;
use Moose;
use Carp qw( croak );
use Digest;
use URI::Escape;
use namespace::clean;
has user_id => (is => 'ro');
has user_data => (is => 'ro');
has [qw(auth_realm store)] => (is => 'rw',);
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args;
if (@_ == 1) {
$args = shift;
} else {
$args = {@_};
}
my $udata = $args->{user_data};
if (exists $udata->{sub}) {
# It's a Google login. Extract id and email from the passed info.
$args->{user_id} = $udata->{sub};
$args->{user_data} = {
email => $udata->{email},
role => 'user'
};
} elsif (exists $udata->{url}) {
# It's an OpenID login. Extract id; there is no email.
$args->{user_id} = uri_escape($udata->{url});
$args->{user_data} = { role => 'user' };
if (exists $udata->{display}) {
$args->{user_data}->{email} = $udata->{display};
}
} elsif (exists $udata->{username} && !exists $args->{user_id}) {
# It's a username (and maybe password) from the registration form. Shift
# them around appropriately and encrypt the password.
my $email = delete $udata->{username};
$args->{user_id} = $email;
$udata->{email} = $email;
if (exists $udata->{password}) {
my $ctx = Digest->new('SHA-256');
$ctx->add(delete $udata->{password});
$udata->{passphrase} = $ctx->b64digest();
}
}
# The user data will look somewhat different if it comes from Google or OpenID.
$class->$orig($args);
};
# auth user object and backend user object are the same
sub get_object { shift }
sub email {
my ($self) = @_;
return $self->user_data->{email};
}
sub id {
my ($self) = @_;
return $self->user_id;
}
sub roles {
my ($self) = @_;
return $self->user_data->{role};
}
sub is_admin {
my $self = shift;
return $self->user_data->{role} eq 'admin';
}
sub get {
my ($self, $arg) = @_;
if ($self->can($arg)) {
return $self->$arg;
} elsif ($arg eq 'password') {
return $self->user_data->{passphrase};
}
return undef;
}
sub to_hash {
my $self = shift;
my $ret = {
id => $self->id,
email => $self->email,
role => $self->roles || 'user',
};
$ret->{active} = JSON::false
if exists $self->user_data->{'active'} && !$self->user_data->{'active'};
$ret->{passphrase} = $self->user_data->{passphrase}
if exists $self->user_data->{passphrase};
return $ret;
}
my %supports = (
password => 'hashed',
roles => ["roles"],
session => 1,
);
sub supports {
my ($self, @spec) = @_;
my $cursor = \%supports;
return 1 if @spec == 1 and $self->can($spec[0]);
# XXX is this correct?
for (@spec) {
return if ref($cursor) ne "HASH";
$cursor = $cursor->{$_};
}
if (ref $cursor) {
die "Bad feature spec: '@spec'" unless ref $cursor eq "ARRAY";
foreach my $key (@$cursor) {
return undef unless $self->can($key);
}
return 1;
} else {
return $cursor;
}
}
sub for_session {
my ($self) = @_;
return $self->user_id;
}
1;