File Coverage

lib/CallBackery/User.pm
Criterion Covered Total %
statement 29 68 42.6
branch 1 14 7.1
condition 0 25 0.0
subroutine 10 14 71.4
pod 4 5 80.0
total 44 126 34.9


line stmt bran cond sub pod time code
1             package CallBackery::User;
2              
3             # $Id: User.pm 539 2013-12-09 22:28:11Z oetiker $
4              
5             # sorted hashes
6 1     1   8 use Mojo::Base -base;
  1         2  
  1         7  
7 1     1   164 use Carp qw(croak confess);
  1         3  
  1         51  
8 1     1   6 use Scalar::Util qw(weaken);
  1         2  
  1         41  
9 1     1   5 use Mojo::Util qw(b64_decode b64_encode secure_compare);
  1         2  
  1         68  
10 1     1   8 use Mojo::JSON qw(encode_json decode_json);
  1         2  
  1         60  
11 1     1   6 use CallBackery::Exception qw(mkerror);
  1         2  
  1         60  
12 1     1   7 use Time::HiRes qw(gettimeofday);
  1         2  
  1         10  
13 1     1   153 use Mojo::Util qw(hmac_sha1_sum);
  1         2  
  1         1967  
14              
15             =head1 NAME
16              
17             CallBackery::User - tell me about the current user
18              
19             =head1 SYNOPSIS
20              
21             use CallBackery::User;
22             my $user = CallBackery::User->new($self->controller);
23              
24             $user->werk;
25             $user->may('right'); # does the user have the given right
26             $user->id;
27              
28             =head1 DESCRIPTION
29              
30             All the methods if L as well as the following
31              
32             =head2 $self->controller
33              
34             the controller
35              
36             =cut
37              
38             has 'controller';
39              
40             =head2 $self->userId
41              
42             By default the userId is numeric and represents a user account. For system tasks, it gets set to alphabetic identifiers.
43             The following alphabetic identifiers do exist:
44              
45             __CONSOLE when running in the config console mode
46             __CONFIG for backup and restore tasks
47              
48             =cut
49              
50              
51              
52              
53             =head2 userId
54              
55             return the user id if the session user is valid.
56              
57             =cut
58              
59             has userId => sub {
60             my $self = shift;
61             my $cookieUserId = $self->cookieConf->{u};
62             my $db = $self->mojoSqlDb;
63             my $userInfo = $self->db->fetchRow('cbuser',{id=>$cookieUserId});
64             if (my $userId = $userInfo->{cbuser_id}){
65             $self->userInfo($userInfo);
66             $self->db->userName($userInfo->{cbuser_login});
67             return $userId;
68             }
69             my $userCount = [$db->dbh->selectrow_array('SELECT count(cbuser_id) FROM '
70             . $db->dbh->quote_identifier("cbuser"))]->[0];
71             return ($userCount == 0 ? '__ROOT' : undef );
72             };
73              
74             =head2 $self->db
75              
76             a handle to a L object.
77              
78             =cut
79              
80             has app => sub {
81             my $app = shift->controller->app;
82             return $app;
83             };
84              
85             has log => sub {
86             shift->app->log;
87             };
88              
89             has db => sub {
90             shift->app->database;
91             };
92              
93             =head2 $self->mojoSqlDb
94              
95             returns a pointer to one of the Database object of a Mojo::Pg instance.
96             =cut
97              
98             sub mojoSqlDb {
99 2     2 1 8 shift->db->mojoSqlDb;
100             };
101              
102             =head2 $self->userInfo
103              
104             returns a hash of information about the current user.
105              
106             =cut
107              
108             has userInfo => sub {
109             my $self = shift;
110             my $userId = $self->userId // return {};
111             if ($userId eq '__ROOT'){
112             return {cbuser_id => '__ROOT'};
113             }
114             if ($userId eq '__SHELL'){
115             return {cbuser_id => '__SHELL'};
116             }
117             $self->db->fetchRow('cbuser',{id=>$self->userId}) // {};
118             };
119              
120              
121             =head2 $self->loginName
122              
123             returns a human readable login name for the current user
124              
125             =cut
126              
127             has loginName => sub {
128             shift->userInfo->{cbuser_login} // '*UNKNOWN*';
129             };
130              
131              
132             =head2 $self->sessionConf
133              
134             Extracts the session config from the cookie from the X-Session-Cookie header or the xsc parameter.
135             If the xsc parameter is set, its timestamp must be no older than 2 seconds.
136              
137             =cut
138              
139             has headerSessionCookie => sub {
140             my $self = shift;
141             my $c = $self->controller;
142             return $c->req->headers->header('X-Session-Cookie');
143             };
144              
145             has paramSessionCookie => sub {
146             my $self = shift;
147             my $c = $self->controller;
148             return $c->param('xsc');
149             };
150              
151             has firstSecret => sub {
152             shift->controller->app->secrets()->[0];
153             };
154              
155             sub isUserAuthenticated {
156 0     0 0 0 my $self = shift;
157 0 0       0 $self->userInfo->{cbuser_id} ? 1 : 0;
158             };
159              
160             has cookieConf => sub {
161             my $self = shift;
162             my $headerCookie = $self->headerSessionCookie;
163             my $paramCookie = $self->paramSessionCookie;
164              
165             my ($data,$check) = split /:/,($headerCookie || $paramCookie || ''),2;
166              
167             return {} if not ($data and $check);
168              
169             my $secret = $self->firstSecret;
170              
171             my $checkTest = Mojo::Util::hmac_sha1_sum($data, $secret);
172             if (not secure_compare($check,$checkTest)){
173             $self->log->debug(qq{Bad signed cookie possible hacking attempt.});
174             return {};
175             }
176              
177             my $conf = eval {
178             local $SIG{__DIE__};
179             decode_json(b64_decode($data))
180             };
181             if ($@){
182             $self->log->debug("Invalid cookie structure in '$data': $@");
183             return {};
184             }
185              
186             if (ref $conf ne 'HASH'){
187             $self->log->debug("Cookie structure not a hash");
188             return {};
189             }
190              
191             if (not $conf->{t}){
192             $self->log->debug("Cookie timestamp is invalid");
193             return {};
194             }
195              
196             if ($paramCookie and gettimeofday() - $conf->{t} > 2.0){
197             $self->log->debug(qq{Cookie is expired});
198             die mkerror(38445,"cookie has expired");
199             }
200              
201             return $conf;
202             };
203              
204             =head2 $user->login($login,$password)
205              
206             login the user object. If login return 1 you can then makeSessionCookie.
207              
208             =cut
209              
210             sub login {
211 0     0 1 0 my $self = shift;
212 0         0 my $login = shift;
213 0         0 my $password = shift;
214 0         0 my $cfg = $self->app->config->cfgHash;
215 0   0     0 my $remoteAddress = eval { $self->controller->tx->remote_address } // 'UNKNOWN_IP';
  0         0  
216 0 0 0     0 if ($cfg->{sesame_pass} and $cfg->{sesame_user}
      0        
      0        
      0        
      0        
217             and $login and $password
218             and $login eq $cfg->{sesame_user}
219             and hmac_sha1_sum($password) eq $cfg->{sesame_pass}){
220 0         0 $self->log->info("SESAME Login for $login from $remoteAddress successful");
221 0         0 $self->session(userId=>'__ROOT');
222 0         0 return 1;
223             }
224              
225 0         0 my $db = $self->app->database;
226 0         0 my $userData = $db->fetchRow('cbuser',{login=>$login});
227 0 0       0 if (not $userData) {
228 0         0 $self->log->info("Login attempt with unknown user $login from $remoteAddress failed");
229 0         0 return undef;
230             }
231              
232 0 0 0     0 if ($userData->{cbuser_password} and $password
      0        
233             and hmac_sha1_sum($password) eq $userData->{cbuser_password} ){
234 0         0 $self->userId($userData->{cbuser_id});
235 0         0 $self->log->info("Login for $login from $remoteAddress successful");
236 0         0 return 1;
237             }
238 0         0 $self->log->info("Login attempt with wrong password for $login from $remoteAddress failed");
239 0         0 return undef;
240             }
241              
242             =head2 $bool = $self->C(right);
243              
244             Check if the user has the right indicated.
245              
246             =cut
247              
248             sub may {
249 0     0 1 0 my $self = shift;
250 0         0 my $right = shift;
251             # root has all the rights
252 0 0 0     0 if (($self->userId // '') eq '__ROOT'){
253 0         0 return 1;
254             }
255 0         0 my $db = $self->db;
256 0         0 my $rightId = $db->lookUp('cbright','key',$right);
257 0         0 my $userId = $self->userId;
258 0 0       0 return ($db->matchData('cbuserright',{cbuser=>$userId,cbright=>$rightId}) ? 1 : 0);
259             }
260              
261             =head2 makeSessionCookie()
262              
263             Returns a timestamped, signed session cookie containing the current userId.
264              
265             =cut
266              
267             sub makeSessionCookie {
268 0     0 1 0 my $self = shift;
269 0         0 my $timeout = shift;
270 0         0 my $now = gettimeofday;
271 0         0 my $conf = b64_encode(encode_json({
272             u => $self->userId,
273             t => $now,
274             }));
275 0         0 $conf =~ s/\s+//g;
276 0         0 my $secret = $self->firstSecret;
277 0         0 my $check = Mojo::Util::hmac_sha1_sum($conf, $secret);
278 0         0 return $conf.':'.$check;
279             }
280              
281             sub DESTROY {
282 1     1   230 local($., $@, $!, $^E, $?);
283 1 50       5 return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
284 1         4 my $self = shift;
285 1         4 $self->log->debug("Destroying ".__PACKAGE__);
286             }
287              
288             1;
289             __END__