From 27c5a57fac903382eac1216fe06f259f858245c8 Mon Sep 17 00:00:00 2001 From: einhverfr Date: Thu, 1 Nov 2007 23:42:23 +0000 Subject: Renaming the Session namespace to LedgerSMB::Auth git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1835 4979c152-3d1c-0410-bac9-87ea11338e46 --- LedgerSMB/Auth/DB.pm | 337 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 337 insertions(+) create mode 100755 LedgerSMB/Auth/DB.pm (limited to 'LedgerSMB/Auth') diff --git a/LedgerSMB/Auth/DB.pm b/LedgerSMB/Auth/DB.pm new file mode 100755 index 00000000..da89711f --- /dev/null +++ b/LedgerSMB/Auth/DB.pm @@ -0,0 +1,337 @@ +#===================================================================== +# 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 LedgerSMB::Auth; +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; -- cgit v1.2.3