Login is still broken. However, a lot of progress has been made. THis also includes the COGS changes made since 1.2.8

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1712 4979c152-3d1c-0410-bac9-87ea11338e46

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
 );
 
 --