[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1835] trunk
- Subject: SF.net SVN: ledger-smb: [1835] trunk
- From: ..hidden..
- Date: Thu, 01 Nov 2007 16:42:24 -0700
Revision: 1835
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=1835&view=rev
Author: einhverfr
Date: 2007-11-01 16:42:23 -0700 (Thu, 01 Nov 2007)
Log Message:
-----------
Renaming the Session namespace to LedgerSMB::Auth
Modified Paths:
--------------
trunk/LedgerSMB/User.pm
trunk/LedgerSMB.pm
trunk/lsmb-request.pl
trunk/old-handler.pl
trunk/scripts/login.pl
trunk/sql/modules/Voucher.sql
Added Paths:
-----------
trunk/LedgerSMB/Auth/
trunk/LedgerSMB/Auth/DB.pm
trunk/LedgerSMB/Auth.pm
Removed Paths:
-------------
trunk/LedgerSMB/Auth/DB.pm
trunk/LedgerSMB/Session/
trunk/LedgerSMB/Session.pm
Copied: trunk/LedgerSMB/Auth (from rev 1832, trunk/LedgerSMB/Session)
Deleted: trunk/LedgerSMB/Auth/DB.pm
===================================================================
--- trunk/LedgerSMB/Session/DB.pm 2007-10-31 22:52:03 UTC (rev 1832)
+++ trunk/LedgerSMB/Auth/DB.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -1,318 +0,0 @@
-#=====================================================================
-# LedgerSMB
-# Small Medium Business Accounting software
-# http://www.ledgersmb.org/
-#
-#
-# Copyright (C) 2006
-# 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.
-#
-#
-#======================================================================
-#
-# This file has undergone whitespace cleanup.
-#
-#======================================================================
-# This package contains session related functions:
-#
-# check - checks validity of session based on the user's cookie and login
-#
-# create - creates a new session, writes cookie upon success
-#
-# destroy - destroys session
-#
-# password_check - compares the password with the stored cryted password
-# (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 ) = @_;
- print STFERR "Checking Session\n";
-
- my $path = ($ENV{SCRIPT_NAME});
- $path =~ s|[^/]*$||;
-
- if ($cookie eq 'Login'){
- print STDERR "creating session\n";
- return session_create($form);
- }
- my $timeout;
-
-
- my $dbh = $form->{dbh};
-
- my $checkQuery = $dbh->prepare(
- "SELECT u.username, s.transaction_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()
- WHERE session_id = ?;"
- );
-
- my ($sessionID, $token, $company) = split(/:/, $cookie);
-
- $form->{company} ||= $company;
-
- #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, $timeout )
- || $form->dberror(
- __FILE__ . ':' . __LINE__ . ': Looking for session: ' );
- my $sessionValid = $checkQuery->rows;
-
- if ($sessionValid) {
-
- #user has a valid session cookie, now check the user
- my ( $sessionLogin, $sessionTransaction ) = $checkQuery->fetchrow_array;
-
- my $login = $form->{login};
-
- $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
- if (( $sessionLogin eq $login ))
- {
-
-
-
- $updateAge->execute( $sessionID )
- || $form->dberror(
- __FILE__ . ':' . __LINE__ . ': Updating session age: ' );
-
- my $newCookieValue =
- $sessionID . ':' . $token . ':' . $form->{company};
-
- #now update the cookie in the browser
- print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|;
- return 1;
-
- }
- else {
-
-#something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt?
-#destroy the session
- my $sessionDestroy = $dbh->prepare("");
-
- #delete the cookie in the browser
- print qq|Set-Cookie: LedgerSMB=; path=$path;\n|;
- return 0;
- }
-
- }
- else {
-
- #cookie is not valid
- #delete the cookie in the browser
- 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};
-
- #microseconds are more than random enough for transaction_id
- my ( $ignore, $newTransactionID ) = gettimeofday();
- $newTransactionID = int $newTransactionID;
-
-
- if ( !$ENV{GATEWAY_INTERFACE} ) {
-
- #don't create cookies or sessions for CLI use
- return 1;
- }
-
- # 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());");
-
- my $createNew = $dbh->prepare(
- "INSERT INTO session (session_id, users_id, token, transaction_id)
- VALUES(?, (SELECT id
- FROM users
- WHERE username = ?), ?, ?);"
- );
-
-# 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, $login, $newToken, $newTransactionID )
- || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
-
- #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};
- 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=$path;\n|;
- $lsmb->{LedgerSMB} = $newCookieValue;
- $lsmb->{dbh}->commit;
-}
-
-sub session_destroy {
-
- my ($form) = @_;
-
- my $login = $form->{login};
- $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
-
- # use the central database handle
- my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
-
- 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
- print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
-
-}
-
-sub password_check {
-
- use Digest::MD5;
-
- my ( $form, $username, $password ) = @_;
-
- $username =~ s/[^a-zA-Z0-9._+\@'-]//g;
-
- # use the central database handle
- my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
-
- my $fetchPassword = $dbh->prepare(
- "SELECT u.username, uc.password, uc.crypted_password
- FROM users as u, users_conf as uc
- WHERE u.username = ?
- AND u.id = uc.id;"
- );
-
- $fetchPassword->execute($username)
- || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' );
-
- my ( $dbusername, $md5Password, $cryptPassword ) =
- $fetchPassword->fetchrow_array;
-
- if ( $dbusername ne $username ) {
- # User data retrieved from db not for the requested user
- return 0;
- }
- elsif ($cryptPassword) {
-
- #First time login from old system, check crypted password
-
- if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword )
- {
-
- #password was good, convert to md5 password and null crypted
- my $updatePassword = $dbh->prepare(
- "UPDATE users_conf
- SET password = md5(?),
- crypted_password = null
- FROM users
- WHERE users_conf.id = users.id
- AND users.username = ?;"
- );
-
- $updatePassword->execute( $password, $username )
- || $form->dberror(
- __FILE__ . ':' . __LINE__ . ': Converting password : ' );
-
- return 1;
-
- }
- else {
- return 0; #password failed
- }
-
- }
- elsif ($md5Password) {
-
- if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) {
- return 0;
- }
- else {
- return 1;
- }
-
- }
- else {
-
- #both the md5Password and cryptPasswords were blank
- return 0;
- }
-}
-
-1;
Copied: trunk/LedgerSMB/Auth/DB.pm (from rev 1834, trunk/LedgerSMB/Session/DB.pm)
===================================================================
--- trunk/LedgerSMB/Auth/DB.pm (rev 0)
+++ trunk/LedgerSMB/Auth/DB.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -0,0 +1,337 @@
+#=====================================================================
+# LedgerSMB
+# Small Medium Business Accounting software
+# http://www.ledgersmb.org/
+#
+#
+# Copyright (C) 2006
+# 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.
+#
+#
+#======================================================================
+#
+# This file has undergone whitespace cleanup.
+#
+#======================================================================
+# This package contains session related functions:
+#
+# check - checks validity of session based on the user's cookie and login
+#
+# create - creates a new session, writes cookie upon success
+#
+# destroy - destroys session
+#
+# password_check - compares the password with the stored cryted password
+# (ver. < 1.2) and the md5 one (ver. >= 1.2)
+#====================================================================
+package LedgerSMB::Auth;
+use MIME::Base64;
+use strict;
+
+sub session_check {
+ use Time::HiRes qw(gettimeofday);
+ my ( $cookie, $form ) = @_;
+ print STFERR "Checking Session\n";
+
+ my $path = ($ENV{SCRIPT_NAME});
+ $path =~ s|[^/]*$||;
+
+ if ($cookie eq 'Login'){
+ print STDERR "creating session\n";
+ return session_create($form);
+ }
+ my $timeout;
+
+
+ my $dbh = $form->{dbh};
+
+ my $checkQuery = $dbh->prepare(
+ "SELECT u.username, s.transaction_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()
+ WHERE session_id = ?;"
+ );
+
+ my ($sessionID, $token, $company) = split(/:/, $cookie);
+
+ $form->{company} ||= $company;
+
+ #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, $timeout )
+ || $form->dberror(
+ __FILE__ . ':' . __LINE__ . ': Looking for session: ' );
+ my $sessionValid = $checkQuery->rows;
+
+ if ($sessionValid) {
+
+ #user has a valid session cookie, now check the user
+ my ( $sessionLogin, $sessionTransaction ) = $checkQuery->fetchrow_array;
+
+ my $login = $form->{login};
+
+ $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
+ if (( $sessionLogin eq $login ))
+ {
+
+
+
+ $updateAge->execute( $sessionID )
+ || $form->dberror(
+ __FILE__ . ':' . __LINE__ . ': Updating session age: ' );
+
+ my $newCookieValue =
+ $sessionID . ':' . $token . ':' . $form->{company};
+
+ #now update the cookie in the browser
+ print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|;
+ return 1;
+
+ }
+ else {
+
+#something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt?
+#destroy the session
+ my $sessionDestroy = $dbh->prepare("");
+
+ #delete the cookie in the browser
+ print qq|Set-Cookie: LedgerSMB=; path=$path;\n|;
+ return 0;
+ }
+
+ }
+ else {
+
+ #cookie is not valid
+ #delete the cookie in the browser
+ 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};
+
+ #microseconds are more than random enough for transaction_id
+ my ( $ignore, $newTransactionID ) = gettimeofday();
+ $newTransactionID = int $newTransactionID;
+
+
+ if ( !$ENV{GATEWAY_INTERFACE} ) {
+
+ #don't create cookies or sessions for CLI use
+ return 1;
+ }
+
+ # 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());");
+
+ my $createNew = $dbh->prepare(
+ "INSERT INTO session (session_id, users_id, token, transaction_id)
+ VALUES(?, (SELECT id
+ FROM users
+ WHERE username = ?), ?, ?);"
+ );
+
+# 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, $login, $newToken, $newTransactionID )
+ || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
+
+ #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};
+ 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=$path;\n|;
+ $lsmb->{LedgerSMB} = $newCookieValue;
+ $lsmb->{dbh}->commit;
+}
+
+sub session_destroy {
+
+ my ($form) = @_;
+
+ my $login = $form->{login};
+ $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
+
+ # use the central database handle
+ my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
+
+ 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
+ print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
+
+}
+
+sub get_credentials {
+ # 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 $return_value = {};
+ ($return_value->{login}, $return_value->{password}) = split(/:/, $auth);
+
+ return $return_value;
+
+}
+
+sub credential_prompt{
+ print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n";
+ print "Status: 401 Unauthorized\n\n";
+ print "Please enter your credentials.\n";
+ exit;
+}
+
+sub password_check {
+
+ use Digest::MD5;
+
+ my ( $form, $username, $password ) = @_;
+
+ $username =~ s/[^a-zA-Z0-9._+\@'-]//g;
+
+ # use the central database handle
+ my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
+
+ my $fetchPassword = $dbh->prepare(
+ "SELECT u.username, uc.password, uc.crypted_password
+ FROM users as u, users_conf as uc
+ WHERE u.username = ?
+ AND u.id = uc.id;"
+ );
+
+ $fetchPassword->execute($username)
+ || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' );
+
+ my ( $dbusername, $md5Password, $cryptPassword ) =
+ $fetchPassword->fetchrow_array;
+
+ if ( $dbusername ne $username ) {
+ # User data retrieved from db not for the requested user
+ return 0;
+ }
+ elsif ($cryptPassword) {
+
+ #First time login from old system, check crypted password
+
+ if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword )
+ {
+
+ #password was good, convert to md5 password and null crypted
+ my $updatePassword = $dbh->prepare(
+ "UPDATE users_conf
+ SET password = md5(?),
+ crypted_password = null
+ FROM users
+ WHERE users_conf.id = users.id
+ AND users.username = ?;"
+ );
+
+ $updatePassword->execute( $password, $username )
+ || $form->dberror(
+ __FILE__ . ':' . __LINE__ . ': Converting password : ' );
+
+ return 1;
+
+ }
+ else {
+ return 0; #password failed
+ }
+
+ }
+ elsif ($md5Password) {
+
+ if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+
+ }
+ else {
+
+ #both the md5Password and cryptPasswords were blank
+ return 0;
+ }
+}
+
+1;
Copied: trunk/LedgerSMB/Auth.pm (from rev 1832, trunk/LedgerSMB/Session.pm)
===================================================================
--- trunk/LedgerSMB/Auth.pm (rev 0)
+++ trunk/LedgerSMB/Auth.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -0,0 +1,23 @@
+#=====================================================================
+# LedgerSMB
+# Small Medium Business Accounting software
+# http://www.ledgersmb.org/
+#
+#
+# Copyright (C) 2006
+# 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.
+
+# This is a simple abstraction layer allowing other session handling mechanisms
+# (For example Kerberos tickets) as the application progresses.
+package LedgerSMB::Auth;
+
+use LedgerSMB::Sysconfig;
+
+if ( !${LedgerSMB::Sysconfig::auth} ) {
+ ${LedgerSMB::Sysconfig::auth} = 'DB';
+}
+
+require "LedgerSMB/Auth/" . ${LedgerSMB::Sysconfig::auth} . ".pm";
Deleted: trunk/LedgerSMB/Session.pm
===================================================================
--- trunk/LedgerSMB/Session.pm 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/LedgerSMB/Session.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -1,23 +0,0 @@
-#=====================================================================
-# LedgerSMB
-# Small Medium Business Accounting software
-# http://www.ledgersmb.org/
-#
-#
-# Copyright (C) 2006
-# 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.
-
-# This is a simple abstraction layer allowing other session handling mechanisms
-# (For example Kerberos tickets) as the application progresses.
-package Session;
-
-use LedgerSMB::Sysconfig;
-
-if ( !${LedgerSMB::Sysconfig::session} ) {
- ${LedgerSMB::Sysconfig::session} = 'DB';
-}
-
-require "LedgerSMB/Session/" . ${LedgerSMB::Sysconfig::session} . ".pm";
Modified: trunk/LedgerSMB/User.pm
===================================================================
--- trunk/LedgerSMB/User.pm 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/LedgerSMB/User.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -57,7 +57,7 @@
package LedgerSMB::User;
use LedgerSMB::Sysconfig;
-use LedgerSMB::Session;
+use LedgerSMB::Auth;
use Data::Dumper;
=item LedgerSMB::User->new($login);
Modified: trunk/LedgerSMB.pm
===================================================================
--- trunk/LedgerSMB.pm 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/LedgerSMB.pm 2007-11-01 23:42:23 UTC (rev 1835)
@@ -125,7 +125,7 @@
use Math::BigFloat;
use LedgerSMB::Sysconfig;
use Data::Dumper;
-use LedgerSMB::Session;
+use LedgerSMB::Auth;
use LedgerSMB::Template;
use LedgerSMB::Locale;
use LedgerSMB::User;
@@ -195,7 +195,7 @@
if ($self->is_run_mode('cgi', 'mod_perl')) {
#check for valid session unless this is an inital authentication
#request -- CT
- if (!Session::session_check( $cookie{"LedgerSMB"}, $self) ) {
+ if (!LedgerSMB::Auth::session_check( $cookie{"LedgerSMB"}, $self) ) {
$self->_get_password("Session Expired");
exit;
}
@@ -215,7 +215,7 @@
sub _get_password {
my ($self) = shift @_;
$self->{sessionexpired} = shift @_;
- Session::credential_prompt();
+ LedgerSMB::Auth::credential_prompt();
exit;
}
@@ -634,7 +634,7 @@
my $self = shift @_;
my %args = @_;
- my $creds = Session::get_credentials();
+ my $creds = LedgerSMB::Auth::get_credentials();
$self->{login} = $creds->{login};
if (!$self->{company}){
Modified: trunk/lsmb-request.pl
===================================================================
--- trunk/lsmb-request.pl 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/lsmb-request.pl 2007-11-01 23:42:23 UTC (rev 1835)
@@ -29,7 +29,6 @@
use LedgerSMB::User;
use LedgerSMB;
use LedgerSMB::Locale;
-use LedgerSMB::Session;
use Data::Dumper;
# for custom preprocessing logic
Modified: trunk/old-handler.pl
===================================================================
--- trunk/old-handler.pl 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/old-handler.pl 2007-11-01 23:42:23 UTC (rev 1835)
@@ -55,7 +55,7 @@
use LedgerSMB::User;
use LedgerSMB::Form;
use LedgerSMB::Locale;
-use LedgerSMB::Session;
+use LedgerSMB::Auth;
use Data::Dumper;
require "common.pl";
@@ -170,7 +170,7 @@
}
#check for valid session
- if ( !Session::session_check( $cookie{"LedgerSMB"}, $form ) ) {
+ if ( !LedgerSMB::Auth::session_check( $cookie{"LedgerSMB"}, $form ) ) {
&getpassword(1);
exit;
}
Modified: trunk/scripts/login.pl
===================================================================
--- trunk/scripts/login.pl 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/scripts/login.pl 2007-11-01 23:42:23 UTC (rev 1835)
@@ -4,6 +4,7 @@
use LedgerSMB::Locale;
use LedgerSMB::Form; # Required for now to integrate with menu module.
use LedgerSMB::User;
+use LedgerSMB::Auth;
use strict;
sub __default {
@@ -63,7 +64,7 @@
my ($request) = @_;
$request->{callback} = "";
$request->{endsession} = 1;
- Session::session_destroy($request);
+ LedgerSMB::Auth::session_destroy($request);
print "Location: login.pl\n";
print "Content-type: text/html\n\n";
exit;
Modified: trunk/sql/modules/Voucher.sql
===================================================================
--- trunk/sql/modules/Voucher.sql 2007-11-01 22:06:34 UTC (rev 1834)
+++ trunk/sql/modules/Voucher.sql 2007-11-01 23:42:23 UTC (rev 1835)
@@ -81,193 +81,79 @@
transaction_id integer,
amount numeric,
transaction_date date,
- voucher_number text
+ batch_class text
);
-CREATE OR REPLACE FUNCTION voucher_list_ap (in_batch_id integer)
-RETURNS SETOF voucher_list AS
+CREATE OR REPLACE FUNCTION voucher_list (in_batch_id integer)
+RETURNS SETOF voucher_list AS
$$
-DECLARE
- voucher_out voucher_list%ROWTYPE;
+declare voucher_item record;
BEGIN
- FOR voucher_out IN SELECT v.id, a.invnumber AS reference,
- c.name ||' -- ' || c.vendornumber AS description,
- v.batch_id, a.id AS transaction_id,
- a.amount, v.voucher_number
- FROM vouchers v
- JOIN ap a ON (a.id = v.trans_id)
- JOIN vendor c ON (c.id = a.vendor_id)
- WHERE v.br_id = in_batch_id
-
+ FOR voucher_item IN
+ SELECT v.id, a.invnumber, e.name, v.batch_id, v.trans_id,
+ a.amount - a.paid, a.transdate, 'Payable'
+ FROM voucher v
+ JOIN ap a ON (v.trans_id = a.id)
+ JOIN entity e ON (a.entity_id = e.id)
+ WHERE v.batch_id = in_batch_id
+ AND v.batch_class = (select id from batch_class
+ WHERE class = 'payable')
+ UNION
+ SELECT v.id, a.invnumber, e.name, v.batch_id, v.trans_id,
+ a.amount - a.paid, a.transdate, 'Receivable'
+ FROM voucher v
+ JOIN ar a ON (v.trans_id = a.id)
+ JOIN entity e ON (a.entity_id = e.id)
+ WHERE v.batch_id = in_batch_id
+ AND v.batch_class = (select id from batch_class
+ WHERE class = 'receivable')
+ UNION
+ SELECT v.id, a.source, a.memo, v.batch_id, v.trans_id,
+ a.amount, a.transdate, bc.class
+ FROM voucher v
+ JOIN acc_trans a ON (v.trans_id = a.trans_id)
+ JOIN batch_class bc ON (bc.id = v.batch_class)
+ WHERE v.batch_id = in_batch_id
+ AND a.voucher_id = v.id
+ AND bc.class like 'payment%'
+ OR bc.class like 'receipt%'
+ UNION
+ SELECT v.id, g.reference, g.description, v.batch_id, v.trans_id,
+ sum(a.amount), g.transdate, 'gl'
+ FROM voucher v
+ JOIN gl g ON (g.id = v.trans_id)
+ JOIN acc_trans a ON (v.trans_id = a.trans_id)
+ WHERE a.amount > 0
+ AND v.batch_id = in_batch_id
+ AND v.batch_class IN (select id from batch_class
+ where class = 'gl')
+ GROUP BY v.id, g.reference, g.description, v.batch_id,
+ v.trans_id, g.transdate
+ ORDER BY 7, 1
LOOP
- RETURN NEXT voucher_out;
+ RETURN NEXT voucher_item;
END LOOP;
-
END;
-$$ LANGUAGE PLPGSQL;
+$$ language plpgsql;
-CREATE OR REPLACE FUNCTION voucher_list_payment (in_batch_id integer)
-RETURNS SETOF voucher_list AS
-$$
-DECLARE
- voucher_out voucher_list%ROWTYPE;
-BEGIN
- FOR voucher_out IN SELECT v.id, c.vendornumber AS reference,
- c.name AS description, in_batch_id AS batch_id,
- v.transaction_id AS transaction_id, sum(ac.amount) AS amount,
- v.voucher_number
- FROM acc_trans ac
- JOIN vouchers v ON (v.id = ac.vr_id AND v.transaction_id = ac.trans_id)
- JOIN chart ch ON (ch.id = ac.chart_id)
- JOIN ap a ON (a.id = ac.trans_id)
- JOIN vendor c ON (c.id = a.vendor_id)
- WHERE v.br_id = in_batch_id
- AND ch.link LIKE '%AP_paid%'
- GROUP BY v.id, c.name, c.vendornumber, v.voucher_number,
- a.vendor_id, v.transaction_id
+CREATE TYPE batch_list_item AS (
+ id integer,
+ batch_class text,
+ description text,
+ created_by text,
+ created_on date,
+ total numeric
+);
-
- LOOP
- RETURN NEXT voucher_out;
- END LOOP;
-
-END;
-$$ LANGUAGE PLPGSQL;
-
-CREATE OR REPLACE FUNCTION voucher_list_payment_reversal (in_batch_id integer)
-RETURNS SETOF voucher_list AS
+CREATE FUNCTION batch_list RETURNS SETOF batch_list_item AS
$$
-DECLARE
- voucher_out voucher_list%ROWTYPE;
-BEGIN
- FOR voucher_out IN
- SELECT v.id, ac.source AS reference,
- c.vendornumber || ' -- ' || c.name AS description,
- sum(ac.amount) * -1 AS amount, in_batch_id AS batch_id,
- v.transaction_id AS transaction_id, v.voucher_number
- FROM acc_trans ac
- JOIN vr v ON (v.id = ac.vr_id AND v.trans_id = ac.trans_id)
- JOIN chart ch ON (ch.id = ac.chart_id)
- JOIN ap a ON (a.id = ac.trans_id)
- JOIN vendor c ON (c.id = a.vendor_id)
- WHERE vr.br_id = in_batch_id
- AND c.link LIKE '%AP_paid%'
- GROUP BY v.id, c.name, c.vendornumber, v.voucher_number,
- a.vendor_id, ac.source
-
- LOOP
- RETURN NEXT voucher_out;
- END LOOP;
-
-END;
$$ LANGUAGE PLPGSQL;
-CREATE OR REPLACE FUNCTION voucher_list_ap (in_batch_id integer)
-RETURNS SETOF voucher_list AS
-$$
-DECLARE
- voucher_out voucher_list%ROWTYPE;
-BEGIN
- FOR voucher_out IN
- SELECT v.id, g.reference, g.description, in_batch_id AS batch_id,
- SUM(ac.amount) AS amount, g.id AS transaction_id,
- v.vouchernumber
- FROM acc_trans ac
- JOIN gl g ON (g.id = ac.trans_id)
- JOIN vouchers v ON (v.trans_id = g.id)
- WHERE v.batch_id = in_batch_id
- AND ac.amount >= 0
- GROUP BY g.id, g.reference, g.description, v.id,
- v.voucher_number
+CREATE OR REPLACE FUNCTION batch_post in_batch_id INTEGER)
+returns int AS
+$$;
- LOOP
- RETURN NEXT voucher_out;
- END LOOP;
-
-END;
$$ LANGUAGE PLPGSQL;
-
-CREATE OR REPLACE FUNCTION batch_post (in_batch_id integer[], in_batch text,
- in_control_amount NUMERIC)
-RETURNS BOOL AS
-$$
-DECLARE
- control_amount NUMERIC;
- voucher voucher%ROWTYPE;
- incriment NUMERIC;
-BEGIN
--- CHECK CONTROL NUMBERS
- IF in_batch = 'gl' THEN
- SELECT sum(amount) INTO control_amount
- FROM acc_trans
- WHERE trans_id IN (
- SELECT id FROM gl
- WHERE coalesce(approved, false) != true)
- AND trans_id IN (
- SELECT transaction_id FROM voucher
- WHERE batch_id = ANY (in_batch_id))
- AND coalesce(approved, false) != true
- AND amount > 0
- FOR UPDATE;
-
- ELSE IF in_batch like '%payment%' THEN
-
- SELECT sum(ac.amount) INTO control_amount
- FROM acc_trans ac
- JOIN voucher v ON (v.transaction_id = ac.trans_id)
- WHERE v.batch_id = ANY (in_batch_id)
- AND ac.vr_id = v.id
- AND coalesce(approved, false) = false
- FOR UPDATE;
-
- ELSE
- SELECT sum(amount) INTO control_amount
- FROM acc_trans
- WHERE trans_id IN
- (SELECT transaction_id FROM voucher
- WHERE batch_id = ANY (in_batch_id))
- AND trans_id IN
- (SELECT trans_id FROM ap
- WHERE coalesce(approved, false) = false)
- AND amount > 0
- FOR UPDATE;
-
- END IF;
-
- IF control_amount != in_control_amount THEN
- RETURN FALSE;
- END IF;
-
--- TODO: POST TRANSACTIONALLY
-
- IF in_batch like '%payment%' THEN
- ELSE
- UPDATE acc_trans
- SET approved = true
- WHERE trans_id IN
- (SELECT transaction_id FROM voucher
- WHERE batch_id = ANY (in_batch_id));
-
- IF in_batch = 'gl' THEN
-
- UPDATE gl SET approved = true
- WHERE trans_id IN
- (SELECT transaction_id FROM voucher
- WHERE batch_id = ANY (in_batch_id));
-
- ELSE
- UPDATE ap SET approved = true
- WHERE trans_id IN
- (SELECT transaction_id FROM voucher
- WHERE batch_id = ANY (in_batch_id));
- END IF;
- END IF;
-
- RETURN TRUE;
-END;
-$$ LANGUAGE PLPGSQL;
-
-
CREATE OR REPLACE FUNCTION batch_create(
in_batch_number text, in_description text, in_batch_class text) RETURNS int AS
$$
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.