diff options
Diffstat (limited to 'LedgerSMB/Session')
| -rwxr-xr-x | LedgerSMB/Session/DB.pm | 337 |
1 files changed, 0 insertions, 337 deletions
diff --git a/LedgerSMB/Session/DB.pm b/LedgerSMB/Session/DB.pm deleted file mode 100755 index 419ca5d3..00000000 --- a/LedgerSMB/Session/DB.pm +++ /dev/null @@ -1,337 +0,0 @@ -#===================================================================== -# LedgerSMB -# Small Medium Business Accounting software -# http://www.ledgersmb.org/ -# -# -# Copyright (C) 2006 -# This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for -# details. -# -# -#====================================================================== -# -# This file has undergone whitespace cleanup. -# -#====================================================================== -# This package contains session related functions: -# -# check - checks validity of session based on the user's cookie and login -# -# create - creates a new session, writes cookie upon success -# -# destroy - destroys session -# -# password_check - compares the password with the stored cryted password -# (ver. < 1.2) and the md5 one (ver. >= 1.2) -#==================================================================== -package Session; -use MIME::Base64; -use strict; - -sub session_check { - use Time::HiRes qw(gettimeofday); - my ( $cookie, $form ) = @_; - print STFERR "Checking Session\n"; - - my $path = ($ENV{SCRIPT_NAME}); - $path =~ s|[^/]*$||; - - if ($cookie eq 'Login'){ - print STDERR "creating session\n"; - return session_create($form); - } - my $timeout; - - - my $dbh = $form->{dbh}; - - my $checkQuery = $dbh->prepare( - "SELECT u.username, s.transaction_id - FROM session as s - JOIN users as u ON (s.users_id = u.id) - WHERE s.session_id = ? - AND token = ? - AND s.last_used > now() - ?::interval" - ); - - my $updateAge = $dbh->prepare( - "UPDATE session - SET last_used = now() - WHERE session_id = ?;" - ); - - my ($sessionID, $token, $company) = split(/:/, $cookie); - - $form->{company} ||= $company; - - #must be an integer - $sessionID =~ s/[^0-9]//g; - $sessionID = int $sessionID; - - - if ( !$form->{timeout} ) { - $timeout = "1 day"; - } - else { - $timeout = "$form->{timeout} seconds"; - } - - $checkQuery->execute( $sessionID, $token, $timeout ) - || $form->dberror( - __FILE__ . ':' . __LINE__ . ': Looking for session: ' ); - my $sessionValid = $checkQuery->rows; - - if ($sessionValid) { - - #user has a valid session cookie, now check the user - my ( $sessionLogin, $sessionTransaction ) = $checkQuery->fetchrow_array; - - my $login = $form->{login}; - - $login =~ s/[^a-zA-Z0-9._+\@'-]//g; - if (( $sessionLogin eq $login )) - { - - - - $updateAge->execute( $sessionID ) - || $form->dberror( - __FILE__ . ':' . __LINE__ . ': Updating session age: ' ); - - my $newCookieValue = - $sessionID . ':' . $token . ':' . $form->{company}; - - #now update the cookie in the browser - print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|; - return 1; - - } - else { - -#something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt? -#destroy the session - my $sessionDestroy = $dbh->prepare(""); - - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=$path;\n|; - return 0; - } - - } - else { - - #cookie is not valid - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=$path;\n|; - return 0; - } -} - -sub session_create { - my ($lsmb) = @_; - my $path = ($ENV{SCRIPT_NAME}); - $path =~ s|[^/]*$||; - use Time::HiRes qw(gettimeofday); - my $dbh = $lsmb->{dbh}; - my $login = $lsmb->{login}; - - #microseconds are more than random enough for transaction_id - my ( $ignore, $newTransactionID ) = gettimeofday(); - $newTransactionID = int $newTransactionID; - - - if ( !$ENV{GATEWAY_INTERFACE} ) { - - #don't create cookies or sessions for CLI use - return 1; - } - - # TODO Change this to use %myconfig - my $deleteExisting = $dbh->prepare( - "DELETE - FROM session - WHERE session.users_id = (select id from users where username = ?)" - ); - my $seedRandom = $dbh->prepare("SELECT setseed(?);"); - - my $fetchSequence = - $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());"); - - my $createNew = $dbh->prepare( - "INSERT INTO session (session_id, users_id, token, transaction_id) - VALUES(?, (SELECT id - FROM users - WHERE username = ?), ?, ?);" - ); - -# this is assuming that the login is safe, which might be a bad assumption -# so, I'm going to remove some chars, which might make previously valid -# logins invalid --CM - -# I am changing this to use HTTP Basic Auth credentials for now. -- CT - - my $auth = $ENV{HTTP_AUTHORIZATION}; - $auth =~ s/^Basic //i; - - #delete any existing stale sessions with this login if they exist - if ( !$lsmb->{timeout} ) { - $lsmb->{timeout} = 86400; - } - $deleteExisting->execute( $login) - || $lsmb->dberror( - __FILE__ . ':' . __LINE__ . ': Delete from session: ' . $DBI::errstr); - -#doing the random stuff in the db so that LedgerSMB won't -#require a good random generator - maybe this should be reviewed, -#pgsql's isn't great either -CM -# -#I think we should be OK. The random number generator is only a small part -#of the credentials in 1.3.x, and for people that need greater security, there -#is always Kerberos.... -- CT - $fetchSequence->execute() - || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' ); - my ( $newSessionID, $newToken ) = $fetchSequence->fetchrow_array; - - #create a new session - $createNew->execute( $newSessionID, $login, $newToken, $newTransactionID ) - || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' ); - - #reseed the random number generator - my $randomSeed = 1.0 * ( '0.' . ( time() ^ ( $$ + ( $$ << 15 ) ) ) ); - - $seedRandom->execute($randomSeed) - || $lsmb->dberror( - __FILE__ . ':' . __LINE__ . ': Reseed random generator: ' ); - - - my $newCookieValue = $newSessionID . ':' . $newToken . ':' - . $lsmb->{company}; - print STDERR "Breakpoint\n"; - #now set the cookie in the browser - #TODO set domain from ENV, also set path to install path - print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|; - $lsmb->{LedgerSMB} = $newCookieValue; - $lsmb->{dbh}->commit; -} - -sub session_destroy { - - my ($form) = @_; - - my $login = $form->{login}; - $login =~ s/[^a-zA-Z0-9._+\@'-]//g; - - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - - my $deleteExisting = $dbh->prepare( " - DELETE FROM session - WHERE users_id = (select id from users where username = ?) - " ); - - $deleteExisting->execute($login) - || $form->dberror( - __FILE__ . ':' . __LINE__ . ': Delete from session: ' ); - - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=/;\n|; - -} - -sub get_credentials { - # Handling of HTTP Basic Auth headers - my $auth = $ENV{'HTTP_AUTHORIZATION'}; - $auth =~ s/Basic //i; # strip out basic authentication preface - $auth = MIME::Base64::decode($auth); - my $return_value = {}; - ($return_value->{login}, $return_value->{password}) = split(/:/, $auth); - - return $return_value; - -} - -sub credential_prompt{ - print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n"; - print "Status: 401 Unauthorized\n\n"; - print "Please enter your credentials.\n"; - exit; -} - -sub password_check { - - use Digest::MD5; - - my ( $form, $username, $password ) = @_; - - $username =~ s/[^a-zA-Z0-9._+\@'-]//g; - - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - - my $fetchPassword = $dbh->prepare( - "SELECT u.username, uc.password, uc.crypted_password - FROM users as u, users_conf as uc - WHERE u.username = ? - AND u.id = uc.id;" - ); - - $fetchPassword->execute($username) - || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' ); - - my ( $dbusername, $md5Password, $cryptPassword ) = - $fetchPassword->fetchrow_array; - - if ( $dbusername ne $username ) { - # User data retrieved from db not for the requested user - return 0; - } - elsif ($cryptPassword) { - - #First time login from old system, check crypted password - - if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword ) - { - - #password was good, convert to md5 password and null crypted - my $updatePassword = $dbh->prepare( - "UPDATE users_conf - SET password = md5(?), - crypted_password = null - FROM users - WHERE users_conf.id = users.id - AND users.username = ?;" - ); - - $updatePassword->execute( $password, $username ) - || $form->dberror( - __FILE__ . ':' . __LINE__ . ': Converting password : ' ); - - return 1; - - } - else { - return 0; #password failed - } - - } - elsif ($md5Password) { - - if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) { - return 0; - } - else { - return 1; - } - - } - else { - - #both the md5Password and cryptPasswords were blank - return 0; - } -} - -1; |