File Coverage

blib/lib/Yote/Server/App.pm
Criterion Covered Total %
statement 15 39 38.4
branch 0 8 0.0
condition 0 6 0.0
subroutine 5 10 50.0
pod 0 3 0.0
total 20 66 30.3


line stmt bran cond sub pod time code
1             package Yote::Server::App;
2              
3 12     12   5052 use strict;
  12         12  
  12         288  
4 12     12   36 use warnings;
  12         12  
  12         300  
5              
6 12     12   48 use Yote::Server;
  12         12  
  12         192  
7              
8 12     12   24 use Digest::MD5;
  12         12  
  12         348  
9              
10 12     12   24 use base 'Yote::ServerObj';
  12         12  
  12         4704  
11              
12 0     0     sub _acct_class { "Yote::Server::Acct" }
13              
14             #
15             # Override and call _create_account
16             #
17             sub create_account {
18 0     0 0   die "May not create account via website";
19             }
20              
21             sub _create_account {
22 0     0     my( $self, $un, $pw, $class_override ) = @_;
23 0           my $accts = $self->get__accts({});
24              
25 0 0         if( $accts->{lc($un)} ) {
26 0           $self->_err( "Unable to create account" );
27             }
28              
29 0   0       my $acct = $self->{STORE}->newobj( { user => $un }, $class_override || $self->_acct_class );
30 0           $acct->set__password_hash( crypt( $pw, length( $pw ) . Digest::MD5::md5_hex($acct->{ID} ) ) );
31              
32             # TODO - create an email infrastructure for account validation
33 0           $acct->set_app( $self );
34            
35 0           $accts->{lc($un)} = $acct;
36 0           $acct;
37             } #_create_account
38              
39             sub logout {
40 0     0 0   my $self = shift;
41 0           my $root = $self->{SESSION}{SERVER_ROOT};
42 0 0         $root->_destroy_session( $self->{SESSION}->get__token ) if $root;
43 0           delete $self->{SESSION};
44 0           1;
45             } #logout
46              
47             sub login {
48 0     0 0   my( $self, $un, $pw ) = @_;
49              
50             # returns account, cookie. only way to get account object
51 0           my $acct = $self->get__accts({})->{lc($un)};
52              
53             # doing it like this so a failed attempt has about the same amount of time
54             # as an attempt against a nonexistant account. maybe random microsleep?
55 0 0         my $pwh = crypt( $pw, length( $pw ) . Digest::MD5::md5_hex($acct ? $acct->{ID} : $self->{ID} ) );
56 0 0 0       if( $acct && $pwh eq $acct->get__password_hash ) {
57             # this and Yote::ServerRoot::fetch_app are the only ways to expose the account obj
58             # to the UI. If the UI calls for an acct object it wasn't exposed to, Yote::Server
59             # won't allow it. fetch_app only calls it if the correct cookie token is passed in
60 0           $self->{SESSION}->set_acct( $acct );
61 0           $acct->_onLogin;
62 0           return $acct;
63             }
64 0           $self->_err( "Incorrect login" );
65             } #login
66              
67             1;