[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1712] trunk
- Subject: SF.net SVN: ledger-smb: [1712] trunk
- From: ..hidden..
- Date: Sat, 06 Oct 2007 23:07:18 -0700
Revision: 1712
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=1712&view=rev
Author: einhverfr
Date: 2007-10-06 23:07:18 -0700 (Sat, 06 Oct 2007)
Log Message:
-----------
Login is still broken. However, a lot of progress has been made. THis also includes the COGS changes made since 1.2.8
Modified Paths:
--------------
trunk/LedgerSMB/Form.pm
trunk/LedgerSMB/IS.pm
trunk/LedgerSMB/Session/DB.pm
trunk/LedgerSMB/Sysconfig.pm
trunk/LedgerSMB/User.pm
trunk/LedgerSMB.pm
trunk/UI/login.css
trunk/UI/login.html
trunk/scripts/login.pl
trunk/sql/Pg-database.sql
Modified: trunk/LedgerSMB/Form.pm
===================================================================
--- trunk/LedgerSMB/Form.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB/Form.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -1113,9 +1113,17 @@
sub db_init {
my ( $self, $myconfig ) = @_;
+
+ # 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->{dbh} = $self->dbconnect_noauto($myconfig) || $self->dberror();
my %date_query = (
'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
+
'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
Modified: trunk/LedgerSMB/IS.pm
===================================================================
--- trunk/LedgerSMB/IS.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB/IS.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -1527,6 +1527,12 @@
}
sub cogs {
+ # This is nearly entirely rewritten since 1.2.8 based in part on the works
+ # of Victor Sterpu and Dieter Simader (see CONTRIBUTORS for more
+ # information). However, there are a number of areas where I have
+ # substantially rewritten the logic. This function is heavily annotated
+ # largely because COGS/invoices are still scheduled to be re-engineered in
+ # 1.4 so it is a good idea to have records of opinions in the code.-- CT
my ( $dbh2, $form, $id, $totalqty, $project_id, $sellprice) = @_;
my $dbh = $form->{dbh};
my $query;
@@ -1606,13 +1612,13 @@
# will throw an error until we have an understanding of other workflows
# that need to be supported. -- CT
$query = qq|
- SELECT i.id, i.qty, i.allocated, a.transdate
- i.qty - i.allocated AS available,
+ SELECT i.id, i.qty, i.allocated, a.transdate,
+ -1 * (i.allocated + i.qty) AS available,
p.expense_accno_id, p.inventory_accno_id
FROM invoice i
JOIN parts p ON (p.id = i.parts_id)
JOIN ar a ON (a.id = i.trans_id)
- WHERE i.parts_id = ? AND (i.qty + i.allocated) > 0
+ WHERE i.parts_id = ? AND (i.qty + i.allocated) > 0
AND i.sellprice = ?
ORDER BY transdate
|;
@@ -1621,7 +1627,7 @@
my $qty;
while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
$form->db_parse_numeric(sth=>$sth, hashref => $ref);
- if ($totalqty > $ref->{available}){
+ if ($totalqty < $ref->{available}){
$qty = $ref->{available};
} else {
$qty = $totalqty;
@@ -1629,44 +1635,86 @@
# update allocated for sold item
$form->update_balance(
$dbh, "invoice", "allocated",
- qq|id = $ref->{id}|, $qty * -1
+ qq|id = $ref->{id}|, $qty
);
- $allocated += $qty;
- my $linetotal = $qty*$ref->{sellprice};
- $query = qq|
- INSERT INTO acc_trans
- (trans_id, chart_id, amount,
- transdate, project_id, invoice_id)
- VALUES (?, ?, ?, ?, ?, ?)|;
- my $sth1 = $dbh->prepare($query);
- $sth1->execute(
- $form->{id}, $ref->{"expense_accno_id"},
- $linetotal, $form->{transdate},
- $project_id, $ref->{id}
- ) || $form->dberror($query);
+ # Note: No COGS calculations on reversed short sale invoices.
+ # This merely prevents COGS calculations in the future agaisnt
+ # such short invoices. -- CT
+ $totalqty -= $qty;
+ $allocated -= $qty;
+ last if $totalqty == 0;
+ }
+ # If the total quantity is still less than zero, we must assume that
+ # this is just an invoice which has been voided or products returns
+ # but is not merely representing a voided short sale, and therefore
+ # we need to unallocate the items from AP. There has been some debate
+ # as to how to approach this, and I think it is safest to unallocate
+ # the most recently allocated AP items of the same type regardless of
+ # the relevant dates of the invoices. I can see cases where this
+ # might require adjustments, however. -- CT
+
+ if ($totalqty < 0){
$query = qq|
- INSERT INTO acc_trans
- (trans_id, chart_id, amount, transdate,
- project_id, invoice_id)
- VALUES (?, ?, ?, ?, ?, ?)|;
+ SELECT i.allocated, i.sellprice, p.inventory_accno_id,
+ p.expense_accno_id, i.id
+ FROM invoice i
+ JOIN parts p ON (i.parts_id = p.id)
+ JOIN ap a ON (i.trans_id = a.id)
+ WHERE (i.allocated + i.qty) < 0
+ AND i.parts_id = ?
+ ORDER BY a.transdate DESC, a.id DESC
+ |;
- $sth1 = $dbh->prepare($query);
- $sth1->execute(
- $form->{id}, $ref->{"inventory_accno_id"},
- -$linetotal, $form->{transdate},
- $project_id, $ref->{id}
- ) || $form->dberror($query);
+ my $sth = $dbh->prepare($query);
+ $sth->execute($id);
- $totalqty -= $qty;
- last if $totalqty == 0;
+ while (my $ref = $sth->fetchrow_hashref(NAME_lc)){
+ my $qty = $ref->{allocated} * -1;
+
+ $qty = ($qty < $totalqty) ? $totalqty : $qty;
+
+ my $linetotal = $qty*$ref->{sellprice};
+ push @{ $form->{acc_trans}{lineitems} },
+ {
+ chart_id => $ref->{expense_accno_id},
+ amount => $linetotal,
+ project_id => $project_id,
+ invoice_id => $ref->{id}
+ };
+
+ push @{ $form->{acc_trans}{lineitems} },
+ {
+ chart_id => $ref->{inventory_accno_id},
+ amount => -$linetotal,
+ project_id => $project_id,
+ invoice_id => $ref->{id}
+ };
+ $form->update_balance(
+ $dbh, "invoice", "allocated",
+ qq|id = $ref->{id}|, $qty
+ );
+
+ $totalqty -= $qty;
+ $allocated -= $qty;
+
+ last if $totalqty == 0;
+ }
}
+
+ # If we still have less than 0 total quantity, this is not a return
+ # or a void. Throw an error. If there are valid workflows that throw
+ # this error, they will require more work to address and will not work
+ # safely with the current system. -- CT
if ($totalqty < 0){
$form->error("Too many reversed items on an invoice");
}
+ elsif ($totalqty > 0){
+ $form->error("Unexpected and invalid quantity allocated.".
+ " Aborting.");
+ }
}
-
return $allocated;
}
Modified: trunk/LedgerSMB/Session/DB.pm
===================================================================
--- trunk/LedgerSMB/Session/DB.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB/Session/DB.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -28,16 +28,21 @@
# (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 ) = @_;
- my ( $sessionID, $transactionID, $token ) = split /:/, $cookie;
+ if ($cookie eq 'Login'){
+ return session_create($form);
+ }
+ my $timeout;
- # use the central database handle
- my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
+
+ my $dbh = $form->{dbh};
my $checkQuery = $dbh->prepare(
"SELECT u.username, s.transaction_id
@@ -54,6 +59,10 @@
WHERE session_id = ?;"
);
+ my ($sessionID, $transactionID, $company) = split(/:/, $cookie);
+
+ $form->{company} ||= $company;
+
#must be an integer
$sessionID =~ s/[^0-9]//g;
$sessionID = int $sessionID;
@@ -61,15 +70,11 @@
$transactionID =~ s/[^0-9]//g;
$transactionID = int $transactionID;
- #must be 32 chars long and contain hex chars
- $token =~ s/[^0-9a-f]//g;
- $token = substr( $token, 0, 32 );
-
- if ( !$myconfig{timeout} ) {
+ if ( !$form->{timeout} ) {
$timeout = "1 day";
}
else {
- $timeout = "$myconfig{timeout} seconds";
+ $timeout = "$form->{timeout} seconds";
}
$checkQuery->execute( $sessionID, $timeout )
@@ -99,8 +104,8 @@
|| $form->dberror(
__FILE__ . ':' . __LINE__ . ': Updating session age: ' );
- $newCookieValue =
- $sessionID . ':' . $newTransactionID . ':' . $token;
+ my $newCookieValue =
+ $sessionID . ':' . $newTransactionID . ':' . $form->{company};
#now update the cookie in the browser
print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|;
@@ -129,6 +134,8 @@
}
sub session_create {
+ my ($lsmb) = @_;
+ my $lsmb;
use Time::HiRes qw(gettimeofday);
@@ -136,7 +143,6 @@
my ( $ignore, $newTransactionID ) = gettimeofday();
$newTransactionID = int $newTransactionID;
- my ($form) = @_;
if ( !$ENV{HTTP_HOST} ) {
@@ -145,7 +151,7 @@
}
# use the central database handle
- my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
+ my $dbh = $lsmb->{dbh};
# TODO Change this to use %myconfig
my $deleteExisting = $dbh->prepare(
@@ -167,43 +173,56 @@
WHERE username = ?), ?, ?);"
);
-# this is assuming that $form->{login} is safe, which might be a bad assumption
-# so, I'm going to remove some chars, which might make previously valid logins invalid
- my $login = $form->{login};
+# 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;
+ my ($login, undef) = split(/:/, MIME::Base64::decode($auth));
$login =~ s/[^a-zA-Z0-9._+\@'-]//g;
#delete any existing stale sessions with this login if they exist
- if ( !$myconfig{timeout} ) {
- $myconfig{timeout} = 86400;
+ if ( $lsmb->{timeout} ) {
+ $lsmb->{timeout} = 86400;
}
- $deleteExisting->execute( $login, "$myconfig{timeout} seconds" )
- || $form->dberror(
+ $deleteExisting->execute( $login, "$lsmb->{timeout} seconds" )
+ || $lsmb->dberror(
__FILE__ . ':' . __LINE__ . ': Delete from session: ' );
#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
+#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()
- || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' );
+ || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' );
my ( $newSessionID, $newToken ) = $fetchSequence->fetchrow_array;
#create a new session
$createNew->execute( $newSessionID, $login, $newToken, $newTransactionID )
- || $form->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
+ || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
#reseed the random number generator
my $randomSeed = 1.0 * ( '0.' . ( time() ^ ( $$ + ( $$ << 15 ) ) ) );
$seedRandom->execute($randomSeed)
- || $form->dberror(
+ || $lsmb->dberror(
__FILE__ . ':' . __LINE__ . ': Reseed random generator: ' );
- $newCookieValue = $newSessionID . ':' . $newTransactionID . ':' . $newToken;
+ my $newCookieValue = $newSessionID . ':' . $newTransactionID . ':'
+ . $lsmb->{company};
+
#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|;
- $form->{LedgerSMB} = $newCookieValue;
+ $lsmb->{LedgerSMB} = $newCookieValue;
}
sub session_destroy {
Modified: trunk/LedgerSMB/Sysconfig.pm
===================================================================
--- trunk/LedgerSMB/Sysconfig.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB/Sysconfig.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -116,17 +116,17 @@
}
#putting this in an if clause for now so not to break other devel users
-if ( $config{globaldb}{DBname} ) {
- my $dbconnect = "dbi:Pg:dbname=$globalDBname host=$globalDBhost
- port=$globalDBport user=$globalDBUserName
- password=$globalDBPassword"; # for easier debugging
- $GLOBALDBH = DBI->connect($dbconnect);
- if ( !$GLOBALDBH ) {
- $form = new Form;
- $form->error("No GlobalDBH Configured or Could not Connect");
- }
- $GLOBALDBH->{pg_enable_utf8} = 1;
-}
+#if ( $config{globaldb}{DBname} ) {
+# my $dbconnect = "dbi:Pg:dbname=$globalDBname host=$globalDBhost
+# port=$globalDBport user=$globalDBUserName
+# password=$globalDBPassword"; # for easier debugging
+# $GLOBALDBH = DBI->connect($dbconnect);
+# if ( !$GLOBALDBH ) {
+# $form = new Form;
+# $form->error("No GlobalDBH Configured or Could not Connect");
+# }
+# $GLOBALDBH->{pg_enable_utf8} = 1;
+#}
# These lines prevent other apps in mod_perl from seeing the global db
# connection info
Modified: trunk/LedgerSMB/User.pm
===================================================================
--- trunk/LedgerSMB/User.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB/User.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -165,14 +165,15 @@
#I'm hoping that this function will go and is a temporary bridge
#until we get rid of %myconfig elsewhere in the code
- my ( $self, $login ) = @_;
+ my ( $self, $lsmb ) = @_;
+ my $login = $lsmb->{login};
+ my $dbh = $lsmb->{dbh};
+
if ( !$login ) {
&error( $self, "Access Denied" );
}
- # use central db
- my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
# for now, this is querying the table directly... ugly
# my $fetchUserPrefs = $dbh->prepare(
@@ -230,100 +231,7 @@
return \%myconfig;
}
-=item $user->login($form);
-Disused auth function.
-
-=cut
-
-sub login {
-
- my ( $self, $form ) = @_;
-
- my $rc = -1;
-
- if ( $self->{login} ne "" ) {
- if (
- !Session::password_check(
- $form, $form->{login}, $form->{password}
- )
- )
- {
- return -1;
- }
-
- #this is really dumb, but %myconfig will have to stay until 1.3
- while ( my ( $key, $value ) = each( %{$self} ) ) {
- $myconfig{$key} = $value;
- }
-
- # check if database is down
- my $dbh =
- DBI->connect( $myconfig{dbconnect}, $myconfig{dbuser},
- $myconfig{dbpasswd} )
- or $self->error( __FILE__ . ':' . __LINE__ . ': ' . $DBI::errstr );
- $dbh->{pg_enable_utf8} = 1;
-
- # we got a connection, check the version
- my $query = qq|
- SELECT value FROM defaults
- WHERE setting_key = 'version'|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
-
- my ($dbversion) = $sth->fetchrow_array;
- $sth->finish;
-
- # add login to employee table if it does not exist
- # no error check for employee table, ignore if it does not exist
- my $login = $self->{login};
- $login =~ s/@.*//;
- $query = qq|SELECT entity_id FROM employee WHERE login = ?|;
- $sth = $dbh->prepare($query);
- $sth->execute($login);
-
- my ($id) = $sth->fetchrow_array;
- $sth->finish;
-
- if ( !$id ) {
- my ($employeenumber) =
- $form->update_defaults( \%myconfig, "employeenumber", $dbh );
-
- $query = qq|
- INSERT INTO employee
- (login, employeenumber, name,
- workphone, role)
- VALUES (?, ?, ?, ?, ?)|;
- $sth = $dbh->prepare($query);
- $sth->execute(
- $login, $employeenumber, $myconfig{name},
- $myconfig{tel}, $myconfig{role}
- );
- }
- $dbh->disconnect;
-
- $rc = 0;
-
- if ( $form->{dbversion} ne $dbversion ) {
- $rc = -3;
- $dbupdate =
- ( calc_version($dbversion) < calc_version( $form->{dbversion} ) );
- }
-
- if ($dbupdate) {
- $rc = -4;
-
- # if DB2 bale out
- if ( $myconfig{dbdriver} eq 'DB2' ) {
- $rc = -2;
- }
- }
- }
-
- $rc;
-
-}
-
=item LedgerSMB::User->check_recurring($form);
Disused function to return the number of current recurring events.
Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/LedgerSMB.pm 2007-10-07 06:07:18 UTC (rev 1712)
@@ -154,7 +154,7 @@
if ( $self->{path} eq "bin/lynx" ) {
$self->{menubar} = 1;
- #menubar will be deprecated, replaced with below
+ # Applying the path is deprecated. Use menubar instead. CT.
$self->{lynx} = 1;
$self->{path} = "bin/lynx";
}
@@ -166,64 +166,41 @@
if ( ( $self->{script} =~ m#(\.\.|\\|/)# ) ) {
$self->error("Access Denied");
}
- if (!$self->{login}){
- #this is an ugly hack we need to rethink.
+ if (!$self->{script}) {
+ $self->{script} = 'login.pl';
+ }
+ if (($self->{script} eq 'login.pl') &&
+ ($self->{action} eq 'authenticate' || !$self->{action})){
return $self;
}
- $self->{_user} = LedgerSMB::User->fetch_config($self->{login});
my $locale = LedgerSMB::Locale->get_handle($self->{_user}->{countrycode})
- or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
- if ( !${LedgerSMB::Sysconfig::GLOBALDBH} ) {
- $locale->text("No GlobalDBH Configured or Could not Connect");
- }
+ or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
$self->{_locale} = $locale;
-# if ( $self->{password} ) {
-# if (
-# !Session::password_check(
-# $self, $self->{ login }, $self->{ password }
-# )
-# )
-# {
-# if ($self->is_run_mode('cgi', 'mod_perl')) {
-# $self->_get_password();
-# }
-# else {
-# $self->error( __FILE__ . ':' . __LINE__ . ': '
-# . $locale->text('Access Denied!') );
-# }
-# exit;
-# }
-# else {
-# Session::session_create($self);
-# }
+ $self->_db_init;
+ $self->{_user} = LedgerSMB::User->fetch_config($self);
+ 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;
+ }
-# }
-# else {
-# 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 (!($self->{action} eq 'authenticate'
+ || $self->{script} eq 'login.pl')
+ || !Session::session_check( $cookie{"LedgerSMB"}, $self) ) {
+ $self->_get_password("Session Expired");
+ exit;
+ }
+ }
- #check for valid session
-# if ( !Session::session_check( $cookie{"LedgerSMB"}, $self) ) {
-# $self->_get_password(1);
-# exit;
-# }
-# }
-# else {
-# exit;
-# }
-# }
+ $self->{stylesheet} = $self->{_user}->{stylesheet};
-# $self->{stylesheet} = $self->{_user}->{stylesheet};
- $self->_db_init;
-
$self;
}
@@ -233,7 +210,7 @@
$self->{sessionexpired} = shift @_;
$self->{hidden} = [];
for (keys %$self){
- next if $_ =~ /(^script$|^endsession$|^password$)/;
+ next if $_ =~ /(^script$|^endsession$|^password$|^hidden$)/;
my $attr = {};
$attr->{name} = $_;
$attr->{value} = $self->{$_};
@@ -664,20 +641,57 @@
sub _db_init {
my $self = shift @_;
my %args = @_;
- my $myconfig = $self->{_user};
+ #my $myconfig = $self->{_user};
+ # 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';
+ my $dbname = $self->{company};
+
+ # Note that we have to request the login/password again if the db
+ # connection fails since this probably means bad credentials are entered.
+ # Just in case, however, I think it is a good idea to include the DBI
+ # error string. CT
my $dbh = DBI->connect(
- $myconfig->{ dbconnect }, $myconfig->{ username },
- $self->{ password }, { AutoCommit => 0 }
- ) or $self->dberror;
+ "dbi:Pg:dbname=$dbname;host=localhost;port=5432", "$login", "$password", { AutoCommit => 0 }
+ );
+ $self->{dbh} = $dbh;
+ # This is the general version check
+ my $sth = $dbh->prepare("
+ SELECT value FROM defaults
+ WHERE setting_key = 'version'");
+ $sth->execute;
+
+ my ($dbversion) = $sth->fetchrow_array;
+ if ($dbversion ne $self->{dbversion}){
+ $self->error("Database is not the expected version.");
+ }
+
+
+ if ($self->{script} eq 'login.pl' && $self->{action} eq
+ 'authenticate'){
+
+ return;
+ }
+ elsif (!$dbh){
+ $self->_get_password;
+ }
+
$dbh->{pg_server_prepare} = 0;
$dbh->{pg_enable_utf8} = 1;
- if ( $myconfig->{dboptions} ) {
- $dbh->do( $myconfig->{dboptions} );
+
+ # TODO: Add date handling settings and the like.
+
+ $self->{dbh} = $dbh;
+ if ($self->{script} eq 'autheticate' && $self->script eq 'login.pl'){
+ return;
}
- $self->{dbh} = $dbh;
my $query = "SELECT t.extends,
coalesce (t.table_name, 'custom_' || extends)
|| ':' || f.field_name as field_def
Modified: trunk/UI/login.css
===================================================================
--- trunk/UI/login.css 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/UI/login.css 2007-10-07 06:07:18 UTC (rev 1712)
@@ -10,7 +10,7 @@
div.login div.login {
width: 21em;
- height: 20em;
+ height: 23em;
border-width: 1px;
border-style: solid;
padding-bottom: 2em;
Modified: trunk/UI/login.html
===================================================================
--- trunk/UI/login.html 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/UI/login.html 2007-10-07 06:07:18 UTC (rev 1712)
@@ -13,35 +13,60 @@
<meta name="robots" content="noindex,nofollow" />
- <script language="JavaScript" type="text/javascript">
- <!--
- var agt = navigator.userAgent.toLowerCase();
- var is_major = parseInt(navigator.appVersion);
- var is_nav = ((agt.indexOf('mozilla') != -1) && (agt.indexOf('spoofer') == -1)
- && (agt.indexOf('compatible') == -1) && (agt.indexOf('opera') == -1)
- && (agt.indexOf('webtv') == -1));
- var is_nav4lo = (is_nav && (is_major <= 4));
+ <script language="JavaScript" type="text/javascript"
+ src="UI/login.js">
+ </script>
+ <script language="JavaScript" type="text/javascript" >
+function setup_page() {
+ var credential_html;
- function jsp() {
- if (is_nav4lo){
- document.login.js.value = "0";
- } else {
- document.login.js.value = "1";
- }
- }
-
- function sf() { document.login.login.focus(); }
- // End -->
+ var cred_div = document.getElementById("credentials");
+ credential_html =
+ '<div class="labelledinput">' +
+ '<div class="label">' +
+ '<label for="login">' +
+ "<?lsmb text('Name') ?>"+
+ "</label>" +
+ '</div>' +
+ '<div class="input">' +
+ '<input class="login" ' +
+ 'name="login" size="30" ' +
+ 'value="" id="login" '+
+ 'accesskey="n" />' +
+ '</div>' +
+ '</div>' +
+ '<div class="labelledinput">' +
+ '<div class="label">' +
+ '<label for="password">' +
+ "<?lsmb text('Password') ?>" +
+ '</label>' +
+ '</div>' +
+ '<div class="input">' +
+ '<input class="login" ' +
+ 'type="password" ' +
+ 'name="password" ' +
+ 'size="30" ' +
+ 'id="password" ' +
+ 'accesskey="p" />' +
+ '</div>' +
+ '</div>';
+ if (<?lsmb IF blacklisted ?>false<?lsmb ELSE ?>true<?lsmb END ?>
+ && get_http_request_object()){
+ cred_div.innerHTML = credential_html;
+ }
+ document.login.login.focus();
+}
</script>
</head>
-<body class="login" onload="jsp(); sf();">
+<body class="login" onload="setup_page();">
<br /><br />
<center>
- <form method="post" action="login.pl" name="login">
+ <form method="post" action="login.pl" name="login"
+ onsubmit="return submit_form()">
<input type="hidden" name="menubar"
value="<?lsmb menubar ?>">
<div class="login">
@@ -49,35 +74,22 @@
<a href="http://www.ledgersmb.org/"; target="_top"><img src="images/ledgersmb.png" class="logo" alt="LedgerSMB Logo" /></a>
<h1 class="login" align="center">Version SVN Trunk</h1>
<div align="center">
- <div class="labelledinput">
+ <div id="credentials"></div>
+ <div id="company">
+ <div class="labelledinput">
<div class="label">
- <label for="login">
- <?lsmb text('Name') ?>
- </label>
- </div>
- <div class="input">
- <input class="login"
- name="login" size="30"
- value=""
- id="login"
- accesskey="n" />
- </div>
- </div>
- <div class="labelledinput">
- <div class="label">
- <label for="password">
- <?lsmb text('Password')
+ <label for="company">
+ <?lsmb text('Company')
?>
</label>
</div>
<div class="input">
<input class="login"
- type="password"
- name="password"
+ type="text"
+ name="company"
size="30"
- id="password"
- accesskey="p" />
- </div>
+ id="company"
+ accesskey="c" />
</div>
</div>
<button type="submit" name="action" value="login" accesskey="l"><?lsmb text('Login') ?></button>
Modified: trunk/scripts/login.pl
===================================================================
--- trunk/scripts/login.pl 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/scripts/login.pl 2007-10-07 06:07:18 UTC (rev 1712)
@@ -22,6 +22,28 @@
$template->render($request);
}
+sub authenticate {
+ my ($request) = @_;
+ if (!$request->{dbh}){
+ $request->{company} = 'lsmb13';
+ $request->_db_init;
+ }
+ $request->debug({file => '/tmp/request'});
+ if ($request->{dbh} || $request->{log_out}){
+ print "Content-Type: text/html\n";
+ print "Set-Cookie: LedgerSMB=Login;\n";
+ print "Status: 200 Success\n\n";
+ if ($request->{log_out}){
+ exit;
+ }
+ }
+ else {
+ print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n";
+ print "Status: 401 Unauthorized\n\n";
+ print "Please enter your credentials.\n";
+ exit;
+ }
+}
sub login {
my ($request) = @_;
Modified: trunk/sql/Pg-database.sql
===================================================================
--- trunk/sql/Pg-database.sql 2007-10-06 22:46:17 UTC (rev 1711)
+++ trunk/sql/Pg-database.sql 2007-10-07 06:07:18 UTC (rev 1712)
@@ -149,8 +149,7 @@
last_used TIMESTAMP default now(),
ttl int default 3600 not null,
users_id INTEGER NOT NULL references users(id),
-transaction_id INTEGER NOT NULL,
-javascript_auth BOOL DEFAULT FALSE
+transaction_id INTEGER NOT NULL
);
--
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.