| 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; |