diff options
| -rwxr-xr-x | LedgerSMB.pm | 136 | ||||
| -rw-r--r-- | LedgerSMB/Form.pm | 8 | ||||
| -rw-r--r-- | LedgerSMB/IS.pm | 112 | ||||
| -rwxr-xr-x | LedgerSMB/Session/DB.pm | 71 | ||||
| -rw-r--r-- | LedgerSMB/Sysconfig.pm | 22 | ||||
| -rw-r--r-- | LedgerSMB/User.pm | 100 | ||||
| -rw-r--r-- | UI/login.css | 2 | ||||
| -rw-r--r-- | UI/login.html | 96 | ||||
| -rw-r--r-- | scripts/login.pl | 22 | ||||
| -rw-r--r-- | sql/Pg-database.sql | 3 |
10 files changed, 301 insertions, 271 deletions
diff --git a/LedgerSMB.pm b/LedgerSMB.pm index 6c08715d..b975071c 100755 --- a/LedgerSMB.pm +++ b/LedgerSMB.pm @@ -154,7 +154,7 @@ sub new { 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,63 +166,40 @@ sub new { 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); -# } - -# } -# 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 -# if ( !Session::session_check( $cookie{"LedgerSMB"}, $self) ) { -# $self->_get_password(1); -# exit; -# } -# } -# else { -# exit; -# } -# } - -# $self->{stylesheet} = $self->{_user}->{stylesheet}; - $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; + } + + #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; + } + } + + $self->{stylesheet} = $self->{_user}->{stylesheet}; + $self; @@ -233,7 +210,7 @@ sub _get_password { $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 error { 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; + } my $query = "SELECT t.extends, coalesce (t.table_name, 'custom_' || extends) || ':' || f.field_name as field_def diff --git a/LedgerSMB/Form.pm b/LedgerSMB/Form.pm index a98eb0d0..4d055497 100644 --- a/LedgerSMB/Form.pm +++ b/LedgerSMB/Form.pm @@ -1113,9 +1113,17 @@ autocommit disabled. 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\'', diff --git a/LedgerSMB/IS.pm b/LedgerSMB/IS.pm index 264fbd29..d494eb48 100644 --- a/LedgerSMB/IS.pm +++ b/LedgerSMB/IS.pm @@ -1527,6 +1527,12 @@ sub process_assembly { } 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 @@ sub cogs { # 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 @@ sub cogs { 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 @@ sub cogs { # 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); - $query = qq| - INSERT INTO acc_trans - (trans_id, chart_id, amount, transdate, - project_id, invoice_id) - VALUES (?, ?, ?, ?, ?, ?)|; - - $sth1 = $dbh->prepare($query); - $sth1->execute( - $form->{id}, $ref->{"inventory_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| + 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 + |; + + my $sth = $dbh->prepare($query); + $sth->execute($id); + + 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; } diff --git a/LedgerSMB/Session/DB.pm b/LedgerSMB/Session/DB.pm index 872dd419..145e1476 100755 --- a/LedgerSMB/Session/DB.pm +++ b/LedgerSMB/Session/DB.pm @@ -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 @@ sub session_check { 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 @@ sub session_check { $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 @@ sub session_check { || $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_check { } sub session_create { + my ($lsmb) = @_; + my $lsmb; use Time::HiRes qw(gettimeofday); @@ -136,7 +143,6 @@ sub session_create { my ( $ignore, $newTransactionID ) = gettimeofday(); $newTransactionID = int $newTransactionID; - my ($form) = @_; if ( !$ENV{HTTP_HOST} ) { @@ -145,7 +151,7 @@ sub session_create { } # 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 @@ sub session_create { 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 { diff --git a/LedgerSMB/Sysconfig.pm b/LedgerSMB/Sysconfig.pm index e01618cc..b62651a6 100644 --- a/LedgerSMB/Sysconfig.pm +++ b/LedgerSMB/Sysconfig.pm @@ -116,17 +116,17 @@ for $var (qw(DBhost DBport DBname DBUserName DBPassword)) { } #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 diff --git a/LedgerSMB/User.pm b/LedgerSMB/User.pm index 89033ed1..41aa0dcd 100644 --- a/LedgerSMB/User.pm +++ b/LedgerSMB/User.pm @@ -165,14 +165,15 @@ sub fetch_config { #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,99 +231,6 @@ sub fetch_config { 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); diff --git a/UI/login.css b/UI/login.css index 2809fe74..3b38893c 100644 --- a/UI/login.css +++ b/UI/login.css @@ -10,7 +10,7 @@ div.login { div.login div.login { width: 21em; - height: 20em; + height: 23em; border-width: 1px; border-style: solid; padding-bottom: 2em; diff --git a/UI/login.html b/UI/login.html index fb9ff629..6dcf560f 100644 --- a/UI/login.html +++ b/UI/login.html @@ -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)); - - function jsp() { - if (is_nav4lo){ - document.login.js.value = "0"; - } else { - document.login.js.value = "1"; - } - } + <script language="JavaScript" type="text/javascript" + src="UI/login.js"> + </script> + <script language="JavaScript" type="text/javascript" > +function setup_page() { + var credential_html; - 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 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 id="credentials"></div> + <div id="company"> + <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> diff --git a/scripts/login.pl b/scripts/login.pl index 39482b65..a117f80d 100644 --- a/scripts/login.pl +++ b/scripts/login.pl @@ -22,6 +22,28 @@ sub __default { $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) = @_; diff --git a/sql/Pg-database.sql b/sql/Pg-database.sql index c4f4b630..76b22079 100644 --- a/sql/Pg-database.sql +++ b/sql/Pg-database.sql @@ -149,8 +149,7 @@ token VARCHAR(32) CHECK(length(token) = 32), 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 ); -- |