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.pm | 23 ++++ LedgerSMB/Auth/DB.pm | 337 ++++++++++++++++++++++++++++++++++++++++++++++++ LedgerSMB/Session.pm | 23 ---- LedgerSMB/Session/DB.pm | 337 ------------------------------------------------ LedgerSMB/User.pm | 2 +- 5 files changed, 361 insertions(+), 361 deletions(-) create mode 100644 LedgerSMB/Auth.pm create mode 100755 LedgerSMB/Auth/DB.pm delete mode 100644 LedgerSMB/Session.pm delete mode 100755 LedgerSMB/Session/DB.pm (limited to 'LedgerSMB') diff --git a/LedgerSMB/Auth.pm b/LedgerSMB/Auth.pm new file mode 100644 index 00000000..fec8209c --- /dev/null +++ b/LedgerSMB/Auth.pm @@ -0,0 +1,23 @@ +#===================================================================== +# 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 is a simple abstraction layer allowing other session handling mechanisms +# (For example Kerberos tickets) as the application progresses. +package LedgerSMB::Auth; + +use LedgerSMB::Sysconfig; + +if ( !${LedgerSMB::Sysconfig::auth} ) { + ${LedgerSMB::Sysconfig::auth} = 'DB'; +} + +require "LedgerSMB/Auth/" . ${LedgerSMB::Sysconfig::auth} . ".pm"; 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; diff --git a/LedgerSMB/Session.pm b/LedgerSMB/Session.pm deleted file mode 100644 index dbc2d1c3..00000000 --- a/LedgerSMB/Session.pm +++ /dev/null @@ -1,23 +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 is a simple abstraction layer allowing other session handling mechanisms -# (For example Kerberos tickets) as the application progresses. -package Session; - -use LedgerSMB::Sysconfig; - -if ( !${LedgerSMB::Sysconfig::session} ) { - ${LedgerSMB::Sysconfig::session} = 'DB'; -} - -require "LedgerSMB/Session/" . ${LedgerSMB::Sysconfig::session} . ".pm"; 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; diff --git a/LedgerSMB/User.pm b/LedgerSMB/User.pm index b5c5c757..e4654d9b 100644 --- a/LedgerSMB/User.pm +++ b/LedgerSMB/User.pm @@ -57,7 +57,7 @@ Deprecated package LedgerSMB::User; use LedgerSMB::Sysconfig; -use LedgerSMB::Session; +use LedgerSMB::Auth; use Data::Dumper; =item LedgerSMB::User->new($login); -- cgit v1.2.3