[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1717] trunk
- Subject: SF.net SVN: ledger-smb: [1717] trunk
- From: ..hidden..
- Date: Sun, 07 Oct 2007 22:02:22 -0700
Revision: 1717
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=1717&view=rev
Author: einhverfr
Date: 2007-10-07 22:02:21 -0700 (Sun, 07 Oct 2007)
Log Message:
-----------
More authentication fixes.
Modified Paths:
--------------
trunk/LedgerSMB/Session/DB.pm
trunk/LedgerSMB/Sysconfig.pm
trunk/LedgerSMB/Template.pm
trunk/LedgerSMB/User.pm
trunk/LedgerSMB.pm
trunk/README.svn-status
trunk/scripts/menu.pl
Modified: trunk/LedgerSMB/Session/DB.pm
===================================================================
--- trunk/LedgerSMB/Session/DB.pm 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/LedgerSMB/Session/DB.pm 2007-10-08 05:02:21 UTC (rev 1717)
@@ -35,8 +35,11 @@
use Time::HiRes qw(gettimeofday);
+ my $path = ($ENV{SCRIPT_NAME});
+ $path =~ s|[^/]*$||;
+
my ( $cookie, $form ) = @_;
- if ($cookie eq 'Login'){
+ if ($cookie eq 'Login'){
return session_create($form);
}
my $timeout;
@@ -46,20 +49,20 @@
my $checkQuery = $dbh->prepare(
"SELECT u.username, s.transaction_id
- FROM session as s, users as u
- WHERE s.session_id = ?
- AND s.users_id = u.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(),
- transaction_id = ?
+ SET last_used = now()
WHERE session_id = ?;"
);
- my ($sessionID, $transactionID, $company) = split(/:/, $cookie);
+ my ($sessionID, $token, $company) = split(/:/, $cookie);
$form->{company} ||= $company;
@@ -67,8 +70,6 @@
$sessionID =~ s/[^0-9]//g;
$sessionID = int $sessionID;
- $transactionID =~ s/[^0-9]//g;
- $transactionID = int $transactionID;
if ( !$form->{timeout} ) {
$timeout = "1 day";
@@ -77,7 +78,7 @@
$timeout = "$form->{timeout} seconds";
}
- $checkQuery->execute( $sessionID, $timeout )
+ $checkQuery->execute( $sessionID, $token, $timeout )
|| $form->dberror(
__FILE__ . ':' . __LINE__ . ': Looking for session: ' );
my $sessionValid = $checkQuery->rows;
@@ -90,25 +91,20 @@
my $login = $form->{login};
$login =~ s/[^a-zA-Z0-9._+\@'-]//g;
-
- if ( ( $sessionLogin eq $login )
- and ( $sessionTransaction eq $transactionID ) )
+ if (( $sessionLogin eq $login ))
{
- #microseconds are more than random enough for transaction_id
- my ( $ignore, $newTransactionID ) = gettimeofday();
- $newTransactionID = int $newTransactionID;
- $updateAge->execute( $newTransactionID, $sessionID )
+ $updateAge->execute( $sessionID )
|| $form->dberror(
__FILE__ . ':' . __LINE__ . ': Updating session age: ' );
my $newCookieValue =
- $sessionID . ':' . $newTransactionID . ':' . $form->{company};
+ $sessionID . ':' . $token . ':' . $form->{company};
#now update the cookie in the browser
- print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|;
+ print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|;
return 1;
}
@@ -119,7 +115,7 @@
my $sessionDestroy = $dbh->prepare("");
#delete the cookie in the browser
- print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
+ print qq|Set-Cookie: LedgerSMB=; path=$path;\n|;
return 0;
}
@@ -128,14 +124,15 @@
#cookie is not valid
#delete the cookie in the browser
- print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
+ 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};
@@ -155,8 +152,7 @@
my $deleteExisting = $dbh->prepare(
"DELETE
FROM session
- WHERE session.users_id = (select id from users where username = ?)
- AND age(last_used) > ?::interval"
+ WHERE session.users_id = (select id from users where username = ?)"
);
my $seedRandom = $dbh->prepare("SELECT setseed(?);");
@@ -184,7 +180,7 @@
$lsmb->{timeout} = 86400;
}
print STDERR "Breakpoint\n";
- $deleteExisting->execute( $login, "$lsmb->{timeout} seconds" )
+ $deleteExisting->execute( $login)
|| $lsmb->dberror(
__FILE__ . ':' . __LINE__ . ': Delete from session: ' );
@@ -211,13 +207,14 @@
__FILE__ . ':' . __LINE__ . ': Reseed random generator: ' );
- my $newCookieValue = $newSessionID . ':' . $newTransactionID . ':'
+ 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=/;\n|;
+ print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|;
$lsmb->{LedgerSMB} = $newCookieValue;
+ $lsmb->{dbh}->commit;
}
sub session_destroy {
Modified: trunk/LedgerSMB/Sysconfig.pm
===================================================================
--- trunk/LedgerSMB/Sysconfig.pm 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/LedgerSMB/Sysconfig.pm 2007-10-08 05:02:21 UTC (rev 1717)
@@ -131,8 +131,8 @@
# These lines prevent other apps in mod_perl from seeing the global db
# connection info
-my $globalDBConnect = undef;
-my $globalUserName = undef;
-my $globalPassword = undef;
+$ENV{PGHOST} = $config{database}{host};
+$ENV{PGPORT} = $config{database}{port};
+our $defaultdb = $config{database}{default_db};
1;
Modified: trunk/LedgerSMB/Template.pm
===================================================================
--- trunk/LedgerSMB/Template.pm 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/LedgerSMB/Template.pm 2007-10-08 05:02:21 UTC (rev 1717)
@@ -214,7 +214,9 @@
if (UNIVERSAL::isa($self->{locale}, 'LedgerSMB::Locale')){
$cleanvars->{text} = sub { return $self->{locale}->text(@_)};
- }
+ } else {
+ $cleanvars->{text} = sub { return shift @_ };
+ }
$format->can('process')->($self, $cleanvars);
#return $format->can('postprocess')->($self);
Modified: trunk/LedgerSMB/User.pm
===================================================================
--- trunk/LedgerSMB/User.pm 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/LedgerSMB/User.pm 2007-10-08 05:02:21 UTC (rev 1717)
@@ -204,9 +204,7 @@
sub check_recurring {
my ( $self, $form ) = @_;
- my $dbh =
- DBI->connect( $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd} )
- or $form->dberror( __FILE__ . ':' . __LINE__ );
+ my $dbh = $form->{dbh};
$dbh->{pg_encode_utf8} = 1;
my $query = qq|
Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/LedgerSMB.pm 2007-10-08 05:02:21 UTC (rev 1717)
@@ -137,8 +137,10 @@
sub new {
my $type = shift @_;
my $argstr = shift @_;
+ my %cookie;
+ my $self = {};
- my $self = {};
+
$self->{version} = $VERSION;
$self->{dbversion} = "1.2.0";
bless $self, $type;
@@ -148,6 +150,15 @@
$self->merge($params);
+ if ($self->is_run_mode('cgi', 'mod_perl')) {
+ $ENV{HTTP_COOKIE} =~ s/;\s*/;/g;
+ my @cookies = split /;/, $ENV{HTTP_COOKIE};
+ foreach (@cookies) {
+ my ( $name, $value ) = split /=/, $_, 2;
+ $cookie{$name} = $value;
+ }
+ }
+
$self->{action} =~ s/\W/_/g;
$self->{action} = lc $self->{action};
@@ -173,17 +184,15 @@
($self->{action} eq 'authenticate' || !$self->{action})){
return $self;
}
+ if (!$self->{company} && $self->is_run_mode('cgi', 'mod_perl')){
+ my $ccookie = $cookie{LedgerSMB};
+ $ccookie =~ s/.*:([^:]*)$/$1/;
+ $self->{company} = $ccookie;
+ }
$self->_db_init;
+
if ($self->is_run_mode('cgi', 'mod_perl')) {
- my %cookie;
- $ENV{HTTP_COOKIE} =~ s/;\s*/;/g;
- my @cookies = split /;/, $ENV{HTTP_COOKIE};
- foreach (@cookies) {
- my ( $name, $value ) = split /=/, $_, 2;
- $cookie{$name} = $value;
- }
-
#check for valid session unless this is an iniital authentication
#request -- CT
if (!Session::session_check( $cookie{"LedgerSMB"}, $self) ) {
@@ -193,14 +202,14 @@
$self->{_user} = LedgerSMB::User->fetch_config($self);
}
#my $locale = LedgerSMB::Locale->get_handle($self->{_user}->{countrycode})
- #or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
- #self->{_locale} = $locale;
+ $self->{_locale} = LedgerSMB::Locale->get_handle('en') # temporary
+ or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
- $self->{stylesheet} = $self->{_user}->{stylesheet};
+ $self->{stylesheet} = 'ledgersmb.css'; # temporary
+ #$self->{stylesheet} = $self->{_user}->{stylesheet};
+ return $self;
- $self;
-
}
sub _get_password {
@@ -639,15 +648,18 @@
sub _db_init {
my $self = shift @_;
my %args = @_;
- #my $myconfig = $self->{_user};
+ $self->debug({file => '/tmp/dbconnect'});
+
# 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 ($login, $password) = split(/:/, $auth);
$self->{login} = $login;
- $self->{company} ||= 'lsmb13';
+ if (!$self->{company}){
+ $self->{company} = $LedgerSMB::Sysconfig::default_db;
+ }
my $dbname = $self->{company};
# Note that we have to request the login/password again if the db
@@ -655,12 +667,11 @@
# Just in case, however, I think it is a good idea to include the DBI
# error string. CT
$self->{dbh} = DBI->connect(
- "dbi:Pg:dbname=$dbname;host=localhost;port=5432", "$login", "$password", { AutoCommit => 0 }
+ "dbi:Pg:dbname=$dbname", "$login", "$password", { AutoCommit => 0 }
);
my $dbh = $self->{dbh};
-
if (($self->{script} eq 'login.pl') && ($self->{action} eq
'authenticate')){
Modified: trunk/README.svn-status
===================================================================
--- trunk/README.svn-status 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/README.svn-status 2007-10-08 05:02:21 UTC (rev 1717)
@@ -1,3 +1,3 @@
-Dataset creation is now fixed (and mandatory). Only Default and Canadian English (General) COA's currently work.
+SVN /trunk/ currently doesn't work due to rewriting the auth stuff. If you are developing templates, etc. use rev 1691 for now (svn up -r 1691)
Chris T
Modified: trunk/scripts/menu.pl
===================================================================
--- trunk/scripts/menu.pl 2007-10-07 20:04:17 UTC (rev 1716)
+++ trunk/scripts/menu.pl 2007-10-08 05:02:21 UTC (rev 1717)
@@ -105,6 +105,7 @@
sub expanding_menu {
my ($request) = @_;
+ print STDERR 'Breakpoint\n';
if ($request->{'open'} !~ s/:$request->{id}:/:/){
$request->{'open'} .= ":$request->{id}:";
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.