[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[3916] trunk
- Subject: SF.net SVN: ledger-smb:[3916] trunk
- From: ..hidden..
- Date: Mon, 24 Oct 2011 04:58:59 +0000
Revision: 3916
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=3916&view=rev
Author: einhverfr
Date: 2011-10-24 04:58:59 +0000 (Mon, 24 Oct 2011)
Log Message:
-----------
More Framework Enhancements
Modified Paths:
--------------
trunk/LedgerSMB/Auth/DB.pm
trunk/LedgerSMB/SODA.pm
trunk/LedgerSMB.pm
trunk/old-handler.pl
Added Paths:
-----------
trunk/LedgerSMB/App_State.pm
trunk/LedgerSMB/Session.pm
Added: trunk/LedgerSMB/App_State.pm
===================================================================
--- trunk/LedgerSMB/App_State.pm (rev 0)
+++ trunk/LedgerSMB/App_State.pm 2011-10-24 04:58:59 UTC (rev 3916)
@@ -0,0 +1,104 @@
+=head1 NAME
+
+LedgerSMB::App_State
+
+=cut
+package LedgerSMB::App_State;
+use strict;
+use warnings;
+use LedgerSMB::Sysconfig;
+use LedgerSMB::SODA;
+use LedgerSMB::User;
+use LedgerSMB::Locale;
+
+=head1 SYNPOSIS
+
+This is a generic container class for non-web-application related state
+information. It provides a central place to track such things as localization,
+user, and other application state objects.
+
+=head1 OBJECTS FOR STORAGE
+
+The following are objects that are expected to be stored in this namespace:
+
+=over
+
+=cut
+
+our $Locale;
+
+=item Locale
+
+Stores a LedgerSMB::Locale object for the specific user.
+
+=cut
+
+our $User;
+
+=item User
+
+Stores a LedgerSMB::User object for the currently logged in user.
+
+=cut
+
+our $SODA;
+
+=item SODA
+
+Stores the SODA database access handle.
+
+=cut
+
+our $Company_Settings;
+
+=item Company_Settings
+
+Hashref for storing connection-specific settings for the application.
+
+=back
+
+=head1 METHODS
+
+=over
+
+=item init(string $username, string $credential, string $company)
+
+=cut
+
+sub init {
+ my ($username, $credential, $company) = @_;
+ $SODA = LedgerSMB::SODA->new({db => $company,
+ username => $username,
+ cred => $cred});
+ $User = LedgerSMB::User->fetch_config($SODA);
+ $Locale = LedgerSMB::Locale->get_handle($User->{language});
+}
+
+=item cleanup
+
+Deletes all objects attached here.
+
+=cut
+
+sub cleanup {
+
+ $SODA->dbh->disconnect;
+
+ $Locale = LedgerSMB::Locale->get_handle(
+ $LedgerSMB::Sysconfig::language
+ );
+ $User = {};
+ $SODA = {};
+ $Company_Settings = {};
+}
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
Modified: trunk/LedgerSMB/Auth/DB.pm
===================================================================
--- trunk/LedgerSMB/Auth/DB.pm 2011-10-22 05:21:00 UTC (rev 3915)
+++ trunk/LedgerSMB/Auth/DB.pm 2011-10-24 04:58:59 UTC (rev 3916)
@@ -24,250 +24,6 @@
my $logger = Log::Log4perl->get_logger('LedgerSMB');
-=item session_check
-
-Checks to see if a session exists based on current logged in credentials.
-
-Handles failure by creating a new session, since credentials are now separate.
-
-=cut
-
-sub session_check {
- my ( $cookie, $form ) = @_;
-
- my $path = ($ENV{SCRIPT_NAME});
- $path =~ s|[^/]*$||;
- my $secure;
-
- if ($cookie eq 'Login'){
- return session_create($form);
- }
- my $timeout;
-
-
- my $dbh = $form->{dbh};
-
- my $checkQuery = $dbh->prepare(
- "SELECT * FROM session_check(?, ?)");
-
- my ($sessionID, $token, $company) = split(/:/, $cookie);
-
- $form->{company} ||= $company;
- $form->{session_id} = $sessionID;
-
- #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)
- || $form->dberror(
- __FILE__ . ':' . __LINE__ . ': Looking for session: ' );
- my $sessionValid = $checkQuery->rows;
- $dbh->commit;
-
- if ($sessionValid) {
-
- #user has a valid session cookie, now check the user
- my ( $session_ref) = $checkQuery->fetchrow_hashref('NAME_lc');
-
- my $login = $form->{login};
-
- $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
- if (( $session_ref ))
- {
-
-
-
-
- my $newCookieValue =
- $session_ref->{session_id} . ':' . $session_ref->{token} . ':' . $form->{company};
-
- #now update the cookie in the browser
- if ($ENV{SERVER_PORT} == 443){
- $secure = ' Secure;';
- }
- print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=$newCookieValue; path=$path;$secure\n|;
- return 1;
-
- }
- else {
-
- my $sessionDestroy = $dbh->prepare("");
-
- #delete the cookie in the browser
- if ($ENV{SERVER_PORT} == 443){
- $secure = ' Secure;';
- }
- print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
- return 0;
- }
-
- }
- else {
-
- #cookie is not valid
- #delete the cookie in the browser
- if ($ENV{SERVER_PORT} == 443){
- $secure = ' Secure;';
- }
- print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
- return 0;
- }
-}
-
-=item session_create
-
-Creates a new session, sets $lsmb->{session_id} to that session, sets cookies,
-etc.
-
-=cut
-
-sub session_create {
- my ($lsmb) = @_;
- my $path = ($ENV{SCRIPT_NAME});
- my $secure;
- $path =~ s|[^/]*$||;
- my $dbh = $lsmb->{dbh};
- my $login = $lsmb->{login};
-
-
- if ( !$ENV{GATEWAY_INTERFACE} ) {
-
- #don't create cookies or sessions for CLI use
- return 1;
- }
-
- my $fetchUserID = $dbh->prepare(
- "SELECT id
- FROM users
- WHERE username = ?;"
- );
-
- # 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()::text);");
-
- my $createNew = $dbh->prepare(
- "INSERT INTO session (session_id, users_id, token)
- VALUES(?, (SELECT id
- FROM users
- WHERE username = SESSION_USER), ?);"
- );
-
-# Fail early if the user isn't in the users table
- $fetchUserID->execute($login)
- || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Fetch login id: ' );
- my ( $userID ) = $fetchUserID->fetchrow_array;
- unless($userID) {
- $logger->error(__FILE__ . ':' . __LINE__ . ": no such user: $login");
- http_error('401');
- }
-
-# 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, $newToken )
- || http_error('401');
- $lsmb->{session_id} = $newSessionID;
-
- #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};
-
- #now set the cookie in the browser
- #TODO set domain from ENV, also set path to install path
- if ($ENV{SERVER_PORT} == 443){
- $secure = ' Secure;';
- }
- print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=$newCookieValue; path=$path;$secure\n|;
- $lsmb->{LedgerSMB} = $newCookieValue;
- $lsmb->{dbh}->commit;
-}
-
-=item session_destry
-
-Destroys a session and removes it from the db.
-
-=cut
-
-sub session_destroy {
-
- my ($form) = @_;
- my $path = ($ENV{SCRIPT_NAME});
- my $secure;
- $path =~ s|[^/]*$||;
-
- my $login = $form->{login};
- $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
-
- # use the central database handle
- my $dbh = $form->{dbh};
-
- 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
- if ($ENV{SERVER_PORT} == 443){
- $secure = ' Secure;';
- }
- print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
-
-}
-
=item get_credentials
Gets credentials from the 'HTTP_AUTHORIZATION' environment variable which must
Modified: trunk/LedgerSMB/SODA.pm
===================================================================
--- trunk/LedgerSMB/SODA.pm 2011-10-22 05:21:00 UTC (rev 3915)
+++ trunk/LedgerSMB/SODA.pm 2011-10-24 04:58:59 UTC (rev 3916)
@@ -14,9 +14,10 @@
use LedgerSMB::Sysconfig;
use LedgerSMB::Locale;
-our $VERSION = "1.0"
+our $VERSION = "1.0";
=head1 SYNOPSIS
+
This provides better database integration than LedgerSMB::DBObject, which has
been left in place for backwards compatibility. LedgerSMB::SODA provides
services for loosely tying the application to the database through interface
@@ -30,16 +31,15 @@
=cut
-# Broken, fix --CT
# also add inline constraint to ensure autocommit is off
-has dbh => (isa => 'DBI', is => 'rw', required => 1);
+has (dbh => (isa => 'DBI', is => 'rw', required => 1));
=item dbh
This is the database handle through which all access to the database goes.
=cut
-has dbroles => (isa => 'Arrayref[Str]', is=> 'rw', required => 0);
+has (dbroles => (isa => 'Arrayref[Str]', is=> 'rw', required => 0));
=item dbroles
List of database roles for the current logged in user. This can be specified
@@ -47,14 +47,14 @@
=cut
-has db => (isa => 'Str', is=> 'ro', required => 1);
+has (db => (isa => 'Str', is=> 'ro', required => 1));
=item db
Name of the current database
=cut
-has username => (isa => 'Str', is=>'ro', required => 1);
+has (username => (isa => 'Str', is=>'ro', required => 1));
=item username
Name of the current logged in user.
@@ -85,29 +85,35 @@
=cut
-around BUILDARGS => {
+around (BUILDARGS => sub {
my $self = shift @_;
my $orig = shift @_;
my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
if ($args{username}){
# TODO Add DBI Connection
- my $dbh = "...";
- $orig({ db => $args{db}, dbh => $dbh, username => $args{username} });
+ my $dbh = DBI->connect("dbi:Pg:dbname=$args{db}", $args{username},
+ $args{cred},
+ { AutoCommit => 0 }
+ );
+ return $orig({ db => $args{db},
+ dbh => $dbh,
+ username => $args{username} });
} else {
- ($username, $cred) = LedgerSMB::Auth->get_credentials();
- return BUILDARGS({ db => $args{db},
+ my ($username, $cred) = LedgerSMB::Auth->get_credentials();
+ return &BUILDARGS({ db => $args{db},
username => $username,
cred => $cred });
}
-};
+});
-around BUILD => {
+around (BUILD => sub {
my $self = shift @_;
my $orig = shift @_;
- $orig(@_);
+ $self = &$orig($self, @_);
$self->_get_roles();
$self->dbh->pg_learn_custom_types;
-};
+ return $self;
+});
=head1 METHODS
@@ -142,7 +148,8 @@
=cut
sub is_allowed_role {
- my $self = @_;
+ my $self = shift @_;
+ my ($rolename) = (@_);
my $dbh = $self->dbh;
my $prefix = $LedgerSMB::Sysconfig::role_prefix;
@@ -338,30 +345,31 @@
To these are added the following pre-defined windows:
=over
-=cut
-my @pre_defined_windows = (
- { name => "rows_unbounded_pre"
- spec => "ROWS UNBOUNDED PRECEDING" },
=item rows_unbounded_pre
+
ROWS UNBOUNDED PRECEDING
+=item rows_bw_unbounded_pre_and_current
+ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW
+
+=item rows_bw_unbounded_pre_and_following
+ROWS BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING
+
=cut
+
+my @predef_windows = (
+ { name => "rows_unbounded_pre",
+ spec => "ROWS UNBOUNDED PRECEDING" },
+
{ name => "rows_bw_unbounded_pre_and_current",
spec => "ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW" },
-=item rows_bw_unbounded_pre_and_current
-ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW
-
-=cut
{ name => "rows_bw_unbounded_pre_and_following",
spec => "ROWS BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING"},
);
-=item rows_bw_unbounded_pre_and_following
-ROWS BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING
-
=cut
# Private method implements window clauses per above specs above
@@ -436,7 +444,11 @@
sub soda_method {
my ($self) = shift @_;
+ my $dbh = $self->dbh;
my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
+ my $caller = $args{caller};
+ my $method = $args{method};
+
my $schema = $args{schema} || $LedgerSMB::Sysconfig::db_namespace;
if (!keys %$sql_type_cache){
$self->_learn_all_types;
@@ -448,7 +460,7 @@
for my $agg ($args{aggs}){
$col_list .= ", " . $dbh->quote_identifier($agg->{agg});
$col_list .= '(' . $self->_ids_to_string($agg->{cols}) . ')';
- $col_list .= " AS " $dbh->quote_identifier($agg->{alias});
+ $col_list .= " AS " . $dbh->quote_identifier($agg->{alias});
}
my @sproc_arg_list = $self->_get_arg_list({schema => $schema,
@@ -458,12 +470,12 @@
for my $arg (@sproc_arg_list){
if ($arg =~ s/^(in_|arg_)//){
- push @arg_list, $args{$args}->{arg};
+ push @arg_list, $args{args}->{$arg};
} elsif ($arg =~ s/^prop_//){
push @arg_list, $args{$caller}->{arg};
} else {
warn "Bad argument name $arg in soda_method, method $method";
- push @arg_list, $args{$args}->{arg};
+ push @arg_list, $args{args}->{$arg};
}
if ($arg_clause eq ''){
$arg_clause = '?';
@@ -511,7 +523,9 @@
# on name at present, so functions are guaranteed to be unique by name.
sub _get_arg_list {
- my ($self, $args} = @_;
+ my ($self, $args) = @_;
+ my $funcname = $args->{method};
+ my $schema = $args->{schema};
my $dbh = $self->dbh;
my $query = "
SELECT proname, pronargs, proargnames FROM pg_proc
@@ -573,53 +587,52 @@
=over
-=cut
-# Private method, should throw exception but process the out put and log errors
-# before so doing. Replaces LedgerSMB->dberror.
-
-sub _dberror {
- my $state_error = {
-
=item Internal Database Error
SQL State 42883. Undefined function. This is always a bug or an issue with the
database being out of sync with the application.
-=cut
- '42883' => $self->locale->text('Internal Database Error'),
=item Access Denied
Insufficient permissions to perform the operation. Corresponds to SQL States
42501 and 42401.
-=cut
- '42501' => $self->locale->text('Access Denied'),
-# Does 42401 actually exist? --CT
- '42401' => $self->locale->text('Access Denied'),
=item Invalid date/time entered
SQL State 22008. The date or time entered was not in a valid format.
-=cut
- '22008' => $self->locale->text('Invalid date/time entered'),
=item Division by 0 error
-=cut
- '22012' => $self->locale->text('Division by 0 error'),
+
=item Required input not provide
This occurs when a NOT NULL constraint is violated. SQL states 22004 and 23502
-=cut
- '22004' => $self->locale->text('Required input not provided'),
- '23502' => $self->locale->text('Required input not provided'),
=item Conflict with Existing Data
SQL State 23505, indivates that a unique constraint has been violated.
-=cut
- '23505' => $self->locale->text('Conflict with Existing Data'),
=item Error from Function: $errstr
P0001: There was an unhandled exception in a function.
=cut
- 'P0001' => $self->locale->text('Error from Function') . ":\n" .
- $self->{dbh}->errstr,
+# Private method, should throw exception but process the out put and log errors
+# before so doing. Replaces LedgerSMB->dberror.
+
+sub _dberror {
+ my ($self) = shift @_;
+ my $locale = $LedgerSMB::App_State::Locale;
+ my $sqlstate = $self->dbh->sqlstate;
+ #TODO Move these to registered error messages --CT
+ my $state_error = {
+ '42883' => $locale->text('Internal Database Error'),
+ '42501' => $locale->text('Access Denied'),
+# Does 42401 actually exist? --CT
+ '42401' => $locale->text('Access Denied'),
+ '22008' => $locale->text('Invalid date/time entered'),
+ '22012' => $locale->text('Division by 0 error'),
+ '22004' => $locale->text('Required input not provided'),
+ '23502' => $locale->text('Required input not provided'),
+ '23505' => $locale->text('Conflict with Existing Data'),
+ 'P0001' => $locale->text('Error from Function') . ":\n" .
+ $self->dbh->errstr,
};
+ #TODO add logging before raising exception --CT
+ die "LedgerSMB::SODA $sqlstate";
};
Added: trunk/LedgerSMB/Session.pm
===================================================================
--- trunk/LedgerSMB/Session.pm (rev 0)
+++ trunk/LedgerSMB/Session.pm 2011-10-24 04:58:59 UTC (rev 3916)
@@ -0,0 +1,284 @@
+=head1 NAME
+
+LedgerSMB::Session
+
+=head1 SYNOPSIS
+
+Routines for tracking general session actions (create, check, and destroy
+sessions).
+
+=head1 METHODS
+
+=over
+
+=cut
+
+package LedgerSMB::Session;
+
+use LedgerSMB::Sysconfig;
+use LedgerSMB::Log;
+use strict;
+
+my $logger = Log::Log4perl->get_logger('LedgerSMB');
+
+=item check
+
+Checks to see if a session exists based on current logged in credentials.
+
+Handles failure by creating a new session, since credentials are now separate.
+
+=cut
+
+sub check {
+ my ( $cookie, $form ) = @_;
+
+ my $path = ($ENV{SCRIPT_NAME});
+ $path =~ s|[^/]*$||;
+ my $secure;
+
+ if ($cookie eq 'Login'){
+ return session_create($form);
+ }
+ my $timeout;
+
+
+ my $dbh = $form->{dbh};
+
+ my $checkQuery = $dbh->prepare(
+ "SELECT * FROM session_check(?, ?)");
+
+ my ($sessionID, $token, $company) = split(/:/, $cookie);
+
+ $form->{company} ||= $company;
+ $form->{session_id} = $sessionID;
+
+ #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)
+ || $form->dberror(
+ __FILE__ . ':' . __LINE__ . ': Looking for session: ' );
+ my $sessionValid = $checkQuery->rows;
+ $dbh->commit;
+
+ if ($sessionValid) {
+
+ #user has a valid session cookie, now check the user
+ my ( $session_ref) = $checkQuery->fetchrow_hashref('NAME_lc');
+
+ my $login = $form->{login};
+
+ $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
+ if (( $session_ref ))
+ {
+
+
+
+
+ my $newCookieValue =
+ $session_ref->{session_id} . ':' . $session_ref->{token} . ':' . $form->{company};
+
+ #now update the cookie in the browser
+ if ($ENV{SERVER_PORT} == 443){
+ $secure = ' Secure;';
+ }
+ print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=$newCookieValue; path=$path;$secure\n|;
+ return 1;
+
+ }
+ else {
+
+ my $sessionDestroy = $dbh->prepare("");
+
+ #delete the cookie in the browser
+ if ($ENV{SERVER_PORT} == 443){
+ $secure = ' Secure;';
+ }
+ print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
+ return 0;
+ }
+
+ }
+ else {
+
+ #cookie is not valid
+ #delete the cookie in the browser
+ if ($ENV{SERVER_PORT} == 443){
+ $secure = ' Secure;';
+ }
+ print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
+ return 0;
+ }
+}
+
+=item create
+
+Creates a new session, sets $lsmb->{session_id} to that session, sets cookies,
+etc.
+
+=cut
+
+sub create {
+ my ($lsmb) = @_;
+ my $path = ($ENV{SCRIPT_NAME});
+ my $secure;
+ $path =~ s|[^/]*$||;
+ my $dbh = $lsmb->{dbh};
+ my $login = $lsmb->{login};
+
+
+ if ( !$ENV{GATEWAY_INTERFACE} ) {
+
+ #don't create cookies or sessions for CLI use
+ return 1;
+ }
+
+ my $fetchUserID = $dbh->prepare(
+ "SELECT id
+ FROM users
+ WHERE username = ?;"
+ );
+
+ # 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()::text);");
+
+ my $createNew = $dbh->prepare(
+ "INSERT INTO session (session_id, users_id, token)
+ VALUES(?, (SELECT id
+ FROM users
+ WHERE username = SESSION_USER), ?);"
+ );
+
+# Fail early if the user isn't in the users table
+ $fetchUserID->execute($login)
+ || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Fetch login id: ' );
+ my ( $userID ) = $fetchUserID->fetchrow_array;
+ unless($userID) {
+ $logger->error(__FILE__ . ':' . __LINE__ . ": no such user: $login");
+ http_error('401');
+ }
+
+# 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, $newToken )
+ || http_error('401');
+ $lsmb->{session_id} = $newSessionID;
+
+ #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};
+
+ #now set the cookie in the browser
+ #TODO set domain from ENV, also set path to install path
+ if ($ENV{SERVER_PORT} == 443){
+ $secure = ' Secure;';
+ }
+ print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=$newCookieValue; path=$path;$secure\n|;
+ $lsmb->{LedgerSMB} = $newCookieValue;
+ $lsmb->{dbh}->commit;
+}
+
+=item destroy
+
+Destroys a session and removes it from the db.
+
+=cut
+
+sub destroy {
+
+ my ($form) = @_;
+ my $path = ($ENV{SCRIPT_NAME});
+ my $secure;
+ $path =~ s|[^/]*$||;
+
+ my $login = $form->{login};
+ $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
+
+ # use the central database handle
+ my $dbh = $form->{dbh};
+
+ 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
+ if ($ENV{SERVER_PORT} == 443){
+ $secure = ' Secure;';
+ }
+ print qq|Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=; path=$path;$secure\n|;
+
+}
+
+1;
+
+
+=back
+
+=head1 COPYRIGHT
+
+# Small Medium Business Accounting software
+# http://www.ledgersmb.org/
+#
+#
+# Copyright (C) 2006-2011
+# 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.
+
Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm 2011-10-22 05:21:00 UTC (rev 3915)
+++ trunk/LedgerSMB.pm 2011-10-24 04:58:59 UTC (rev 3916)
@@ -208,6 +208,7 @@
use Data::Dumper;
use Error;
use LedgerSMB::Auth;
+use LedgerSMB::Session;
use LedgerSMB::CancelFurtherProcessing;
use LedgerSMB::Template;
use LedgerSMB::Locale;
@@ -330,7 +331,7 @@
if ($self->is_run_mode('cgi', 'mod_perl') and !$ENV{LSMB_NOHEAD}) {
#check for valid session unless this is an inital authentication
#request -- CT
- if (!LedgerSMB::Auth::session_check( $cookie{${LedgerSMB::Sysconfig::cookie_name}}, $self) ) {
+ if (!LedgerSMB::Session::check( $cookie{${LedgerSMB::Sysconfig::cookie_name}}, $self) ) {
$logger->error("Session did not check");
$self->_get_password("Session Expired");
exit;
Modified: trunk/old-handler.pl
===================================================================
--- trunk/old-handler.pl 2011-10-22 05:21:00 UTC (rev 3915)
+++ trunk/old-handler.pl 2011-10-24 04:58:59 UTC (rev 3916)
@@ -56,6 +56,7 @@
use LedgerSMB::Form;
use LedgerSMB::Locale;
use LedgerSMB::Auth;
+use LedgerSMB::Session;
use LedgerSMB::CancelFurtherProcessing;
use Data::Dumper;
require "common.pl";
@@ -186,7 +187,7 @@
}
#check for valid session
- if ( !LedgerSMB::Auth::session_check( $cookie{${LedgerSMB::Sysconfig::cookie_name}}, $form ) ) {
+ if ( !LedgerSMB::Session::check( $cookie{${LedgerSMB::Sysconfig::cookie_name}}, $form ) ) {
&getpassword(1);
exit;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.