#===================================================================== # 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. # # This file contains source code included with or based on SQL-Ledger which # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed # under the GNU General Public License version 2 or, at your option, any later # version. For a full list including contact information of contributors, # maintainers, and copyright holders, see the CONTRIBUTORS file. # # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): # Copyright (c) 2000 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org # # Contributors: # # #====================================================================== # # This file has undergone whitespace cleanup. # #====================================================================== # # setup module # add/edit/delete users # #====================================================================== $menufile = "menu.ini"; use LedgerSMB::Form; use LedgerSMB::Locale; use LedgerSMB::User; use LedgerSMB::Session; $form = new Form; $locale = LedgerSMB::Locale->get_handle( ${LedgerSMB::Sysconfig::language} ) or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "Locale not loaded: $!\n" ); $locale->encoding('UTF-8'); $form->{charset} = 'UTF-8'; eval { require DBI; }; $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text('DBI not installed!') ) if ($@); $form->{stylesheet} = "ledger-smb.css"; $form->{favicon} = "favicon.ico"; $form->{timeout} = 600; require "bin/pw.pl"; # customization if ( -f "bin/custom/$form->{script}" ) { eval { require "bin/custom/$form->{script}"; }; $form->error( __FILE__ . ':' . __LINE__ . ': ' . $@ ) if ($@); } if ( $form->{action} ) { &check_password unless $form->{action} eq 'logout'; &{ $form->{action} }; } else { # if there are no drivers bail out $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text('No Database Drivers available!') ) unless ( LedgerSMB::User->dbdrivers ); $root = LedgerSMB::User->new('admin'); &adminlogin; } 1; # end sub adminlogin { my ($errorMessage) = @_; $form->{title} = qq|LedgerSMB $form->{version} | . $locale->text('Administration'); $myheaderadd = qq| |; $form->header( undef, $myheaderadd ); print qq|
LedgerSMB Logo

| . $locale->text('Version') . qq| $form->{version}
| . $locale->text('Administration') . qq|

| . $locale->text('Password') . qq|
|; if ($errorMessage) { print qq|

$errorMessage


|; } print qq|

| . $locale->text("Application Login") . qq|



| . $locale->text('LedgerSMB website') . qq|
|; } sub login { &list_users; } sub logout { $form->{login} = 'admin'; $form->{callback} = "admin.pl?action=adminlogin"; Session::session_destroy($form); $form->redirect( $locale->text('You are logged out') ); } sub add_user { $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " " . $locale->text('Administration') . " / " . $locale->text('Add User'); if ( -f "css/ledger-smb.css" ) { $myconfig->{stylesheet} = "ledger-smb.css"; } $myconfig->{vclimit} = 1000; $myconfig->{menuwidth} = 155; $myconfig->{timeout} = 3600; &form_header; &form_footer; } sub edit { $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " " . $locale->text('Administration') . " / " . $locale->text('Edit User'); $form->{edit} = 1; &form_header; &form_footer; } sub form_footer { if ( $form->{edit} ) { $delete = qq| |; } print qq| $delete |; } sub list_users { # use the central database handle my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; my $fetchMembers = $dbh->selectall_arrayref( "SELECT uc.name, uc.company, uc.templates, uc.dbuser, uc.dbdriver, uc.dbname, uc.dbhost, u.username FROM users as u, users_conf as uc WHERE u.id = uc.id AND u.id > 1 ORDER BY u.username;", { Slice => {} } ); my @memberArray = (); my @member = (); foreach my $memberArray (@$fetchMembers) { $member{ $memberArray->{username} } = $memberArray; } # type=submit $locale->text('Pg Database Administration') # type=submit $locale->text('PgPP Database Administration') foreach $item ( LedgerSMB::User->dbdrivers ) { $dbdrivers .= qq||; } $column_header{login} = qq|| . $locale->text('Login') . qq||; $column_header{name} = qq|| . $locale->text('Name') . qq||; $column_header{company} = qq|| . $locale->text('Company') . qq||; $column_header{dbdriver} = qq|| . $locale->text('Driver') . qq||; $column_header{dbhost} = qq|| . $locale->text('Host') . qq||; $column_header{dataset} = qq|| . $locale->text('Dataset') . qq||; $column_header{templates} = qq|| . $locale->text('Templates') . qq||; @column_index = qw(login name company dbdriver dbhost dataset templates); $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " " . $locale->text('Administration'); $form->{login} = "admin"; $form->header; print qq|
$form->{title}
|; for (@column_index) { print "$column_header{$_}\n" } print qq| |; foreach $key ( sort keys %member ) { $href = "$script?action=edit&login=$key&path=$form->{path}"; $href =~ s/ /%20/g; $member{$key}{templates} =~ s/^${LedgerSMB::Sysconfig::templates}\///; $column_data{login} = qq||; $column_data{name} = qq||; $column_data{company} = qq||; $column_data{dbdriver} = qq||; $column_data{dbhost} = qq||; $column_data{dataset} = qq||; $column_data{templates} = qq||; $i++; $i %= 2; print qq| |; for (@column_index) { print "$column_data{$_}\n"; } print qq| |; } print qq|
$key$member{$key}{name}$member{$key}{company}$member{$key}{dbdriver}$member{$key}{dbhost}$member{$key}{dbname}$member{$key}{templates}

$dbdrivers
| . $locale->text('Click on login name to edit!') . qq|
| . $locale->text( 'To add a user to a group edit a name, change the login name and save. A new user with the same variables will then be saved under the new login name.' ) . qq| |; } sub form_header { # if there is a login, get user if ( $form->{login} ) { # get user %{$myconfig} = %{ LedgerSMB::User->fetch_config( $form->{login} ) }; for (qw(company address signature)) { $myconfig->{$_} = $form->quote( $myconfig->{$_} ); } for (qw(address signature)) { $myconfig->{$_} =~ s/\\n/\n/g } # strip basedir from templates directory $myconfig->{templates} =~ s/^${LedgerSMB::Sysconfig::templates}\///; } foreach $item (qw(mm-dd-yy mm/dd/yy dd-mm-yy dd/mm/yy dd.mm.yy yyyy-mm-dd)) { $dateformat .= ( $item eq $myconfig->{dateformat} ) ? "\n" : "\n"; } my @formats = qw(1,000.00 1000.00 1.000,00 1000,00 1'000.00); push @formats, '1 000.00'; foreach $item (@formats) { $numberformat .= ( $item eq $myconfig->{numberformat} ) ? "\n" : "\n"; } %countrycodes = LedgerSMB::User->country_codes; $countrycodes = ""; my $selectedcode = ( $myconfig->{countrycode} ) ? $myconfig->{countrycode} : 'en'; foreach $key ( sort { $countrycodes{$a} cmp $countrycodes{$b} } keys %countrycodes ) { $countrycodes .= ( $selectedcode eq $key ) ? qq|| : qq||; } # is there a templates basedir if ( !-d "${LedgerSMB::Sysconfig::templates}" ) { $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text( 'Directory [_1] does not exist', ${LedgerSMB::Sysconfig::templates} ) ); } opendir TEMPLATEDIR, "${LedgerSMB::Sysconfig::templates}/." or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$templates : $!" ); @all = grep !/(^\.\.?$|^\.svn)/, readdir TEMPLATEDIR; closedir TEMPLATEDIR; @allhtml = sort grep /\.html/, @all; @alldir = (); for (@all) { if ( -d "${LedgerSMB::Sysconfig::templates}/$_" ) { push @alldir, $_; } } @allhtml = reverse grep !/Default/, @allhtml; push @allhtml, 'Default'; @allhtml = reverse @allhtml; foreach $item ( sort @alldir ) { if ( $item eq $myconfig->{templates} ) { $usetemplates .= qq|\n|; } else { $usetemplates .= qq|\n|; } } $lastitem = $allhtml[0]; $lastitem =~ s/-.*//g; $mastertemplates = qq|\n|; foreach $item (@allhtml) { $item =~ s/-.*//g; if ( $item ne $lastitem ) { $mastertemplates .= qq|\n|; $lastitem = $item; } } opendir CSS, "css/."; @all = grep /.*\.css$/, readdir CSS; closedir CSS; foreach $item (@all) { if ( $item eq $myconfig->{stylesheet} ) { $selectstylesheet .= qq|\n|; } else { $selectstylesheet .= qq|\n|; } } $selectstylesheet .= "\n"; if ( %{LedgerSMB::Sysconfig::printer} && ${LedgerSMB::Sysconfig::latex} ) { $selectprinter = "\n"; foreach $item ( sort keys %{LedgerSMB::Sysconfig::printer} ) { if ( $myconfig->{printer} eq $item ) { $selectprinter .= qq|\n|; } else { $selectprinter .= qq|\n|; } } $printer = qq| | . $locale->text('Printer') . qq| |; } $user = $form->{login}; $form->{login} = "admin"; $form->header; $form->{login} = $user; print qq|
|; # list section for database drivers foreach $item ( LedgerSMB::User->dbdrivers ) { print qq| |; } # access control open( FH, '<', $menufile ) or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$menufile : $!" ); # scan for first menu level @a = ; close(FH); if ( open( FH, '<', "custom_$menufile" ) ) { push @a, ; } close(FH); foreach $item (@a) { next unless $item =~ /\[\w+/; next if $item =~ /\#/; $item =~ s/(\[|\])//g; chop $item; if ( $item =~ /--/ ) { ( $level, $menuitem ) = split /--/, $item, 2; } else { $level = $item; $menuitem = $item; push @acsorder, $item; } push @{ $acs{$level} }, $menuitem; } %role = ( 'admin' => $locale->text('Administrator'), 'user' => $locale->text('User'), 'supervisor' => $locale->text('Supervisor'), 'manager' => $locale->text('Manager') ); $selectrole = ""; foreach $item (qw(user admin supervisor manager)) { $selectrole .= ( $myconfig->{role} eq $item ) ? "\n" : "\n"; } print qq| |; foreach $item ( split /;/, $myconfig->{acs} ) { ( $key, $value ) = split /--/, $item, 2; $excl{$key}{$value} = 1; } foreach $key (@acsorder) { $checked = "checked"; if ( $form->{login} ) { $checked = ( $excl{$key}{$key} ) ? "" : "checked"; } # can't have variable names with & and spaces $item = $form->escape( "${key}--$key", 1 ); $acsheading = $key; $acsheading =~ s/ / /g; $acsheading = qq| "; print qq| $acsheading $acsdata |; } print qq|
$form->{title}
| . $locale->text('Login') . qq|
| . $locale->text('Password') . qq|
| . $locale->text('Name') . qq|
| . $locale->text('E-mail') . qq|
| . $locale->text('Signature') . qq|
| . $locale->text('Phone') . qq|
| . $locale->text('Fax') . qq|
| . $locale->text('Company') . qq|
| . $locale->text('Address') . qq|
$printer
| . $locale->text('Date Format') . qq|
| . $locale->text('Number Format') . qq|
| . $locale->text('Dropdown Limit') . qq|
| . $locale->text('Menu Width') . qq|
| . $locale->text('Language') . qq|
| . $locale->text('Session Timeout') . qq|
| . $locale->text('Stylesheet') . qq|
| . $locale->text('Use Templates') . qq|
| . $locale->text('New Templates') . qq|
| . $locale->text('Setup Templates') . qq|
| . $locale->text('Database') . qq|
|; $checked = "checked"; if ( $myconfig->{dbdriver} eq $item ) { for (qw(dbhost dbport dbuser dbpasswd dbname sid)) { $form->{"${item}_$_"} = $myconfig->{$_}; } $checked = "checked"; } print qq| |; print qq| |; print qq|
| . $locale->text('Driver') . qq|  $item | . $locale->text('Host') . qq|
| . $locale->text('Dataset') . qq| | . $locale->text('Port') . qq|
| . $locale->text('User') . qq| | . $locale->text('Password') . qq|
| . $locale->text('Access Control') . qq|
 $acsheading
\n|; $menuitems .= "$item;"; $acsdata = ""; foreach $item ( @{ $acs{$key} } ) { next if ( $key eq $item ); $checked = "checked"; if ( $form->{login} ) { $checked = ( $excl{$key}{$item} ) ? "" : "checked"; } $acsitem = $form->escape( "${key}--$item", 1 ); $acsdata .= qq|
 $item|; $menuitems .= "$acsitem;"; } $acsdata .= "
|; } sub save { $form->{callback} = "admin.pl?action=list_users"; # no driver checked $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text('Database Driver not checked!') ) unless $form->{dbdriver}; # no spaces allowed in login name $form->{login} =~ s/ //g; $form->isblank( "login", $locale->text('Login name missing!') ); # check for duplicates if ( !$form->{edit} ) { $temp = LedgerSMB::User->new( $form->{login} ); if ( $temp->{login} ) { $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text( '[_1] is already a member!', $form->{login} ) ); } } # no spaces allowed in directories $form->{newtemplates} =~ s/( |\.\.|\*)//g; if ( $form->{newtemplates} ne "" ) { $form->{templates} = $form->{newtemplates}; } else { $form->{templates} = ( $form->{usetemplates} ) ? $form->{usetemplates} : $form->{login}; } # is there a basedir if ( !-d "${LedgerSMB::Sysconfig::templates}" ) { $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text( 'Directory [_1] does not exist', ${LedgerSMB::Sysconfig::templates} ) ); } # add base directory to $form->{templates} $form->{templates} = "${LedgerSMB::Sysconfig::templates}/$form->{templates}"; $myconfig = LedgerSMB::User->new("$form->{login}"); # redo acs variable and delete all the acs codes @acs = split /;/, $form->{acs}; $form->{acs} = ""; foreach $item (@acs) { $item = $form->escape( $item, 1 ); if ( !$form->{$item} ) { $form->{acs} .= $form->unescape( $form->unescape("$item") ) . ";"; } delete $form->{$item}; } # check which database was filled in $form->{dbhost} = $form->{"$form->{dbdriver}_dbhost"}; $form->{dbport} = $form->{"$form->{dbdriver}_dbport"}; $form->{dbpasswd} = $form->{"$form->{dbdriver}_dbpasswd"}; $form->{dbuser} = $form->{"$form->{dbdriver}_dbuser"}; $form->{dbname} = $form->{"$form->{dbdriver}_dbname"}; $form->isblank( "dbname", $locale->text('Dataset missing!') ); $form->isblank( "dbuser", $locale->text('Database User missing!') ); foreach $item ( keys %{$form} ) { $myconfig->{$item} = $form->{$item}; } $myconfig->{password} = $form->{new_password}; $myconfig->{timeout} = $form->{newtimeout}; delete $myconfig->{stylesheet}; if ( $form->{userstylesheet} ) { $myconfig->{stylesheet} = $form->{userstylesheet}; } $myconfig->{packpw} = 1; $myconfig->save_member($form); # create user template directory and copy master files if ( !-d "$form->{templates}" ) { umask(002); if ( mkdir "$form->{templates}", oct("771") ) { umask(007); # copy templates to the directory opendir TEMPLATEDIR, "${LedgerSMB::Sysconfig::templates}/." or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$templates : $!" ); @templates = grep /$form->{mastertemplates}-/, readdir TEMPLATEDIR; closedir TEMPLATEDIR; foreach $file (@templates) { open( TEMP, '<', "${LedgerSMB::Sysconfig::templates}/$file" ) or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$templates/$file : $!" ); $file =~ s/$form->{mastertemplates}-//; open( NEW, '>', "$form->{templates}/$file" ) or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$form->{templates}/$file : $!" ); while ( $line = ) { print NEW $line; } close(TEMP); close(NEW); } } else { $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$form->{templates} : $!" ); } } $form->redirect( $locale->text('User saved!') ); } sub delete { $form->{callback} = "admin.pl?action=list_users"; $form->{templates} = ( $form->{templates} ) ? "${LedgerSMB::Sysconfig::templates}/$form->{templates}" : "$templates/$form->{login}"; my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; my $found = $dbh->selectall_arrayref(qq|SELECT c.templates FROM users_conf c INNER JOIN users u ON (c.id = u.id) WHERE c.templates = ? AND u.username <> ?|, undef, $form->{templates}, $form->{login}); # if found keep directory otherwise delete if ( !@$found ) { # delete it if there is a template directory $dir = "$form->{templates}"; if ( -d "$dir" ) { unlink <$dir/*>; rmdir "$dir"; } } #users_conf my $deleteUser = $dbh->prepare( "DELETE FROM users_conf USING users WHERE users.username = ? and users.id = users_conf.id;" ); $deleteUser->execute( $form->{login} ); #and now users $deleteUser = $dbh->prepare("DELETE FROM users WHERE username = ?;"); $deleteUser->execute( $form->{login} ); $form->redirect( $locale->text('User deleted!') ); } sub login_name { my $login = shift; $login =~ s/\[\]//g; return ($login) ? $login : undef; } sub change_admin_password { $form->{title} = qq|LedgerSMB | . $locale->text('Accounting') . " " . $locale->text('Administration') . " / " . $locale->text('Change Admin Password'); $form->{login} = "admin"; $form->header; print qq|
| . $locale->text('Change Password') . qq|
| . $locale->text('Password') . qq|
| . $locale->text('Confirm') . qq|

|; } sub change_password { # Do we want to force a login after changing the password? $form->{callback} = "admin.pl?"; $form->error( __FILE__ . ':' . __LINE__ . ': ' . $locale->text('Passwords do not match!') ) if $form->{new_password} ne $form->{confirm_password}; # use the central database handle my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; my $updateAdminPassword = $dbh->prepare( "UPDATE users_conf SET password = md5(?) WHERE id = 1" ); $updateAdminPassword->execute( $form->{new_password} ); $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}"; $form->redirect( $locale->text('Password changed!') ); } sub check_password { $root = LedgerSMB::User->new('admin'); if ( $form->{password} ) { $form->{callback} .= "&password=$form->{password}" if $form->{callback}; if ( $root->{password} ne ( Digest::MD5::md5_hex $form->{password} ) ) { &adminlogin( $locale->text('Access Denied!') ); exit; } else { $form->{login} = 'admin'; Session::session_create($form); } } else { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; foreach (@cookies) { ( $name, $value ) = split /=/, $_, 2; $cookie{$name} = $value; } if ( !Session::session_check( $cookie{"LedgerSMB"}, $root ) ) { &adminlogin( $locale->text('Session expired!') ); exit; } } } sub pg_database_administration { $form->{dbdriver} = 'Pg'; &dbselect_source; } sub pgpp_database_administration { $form->{dbdriver} = 'PgPP'; &dbselect_source; } sub dbdriver_defaults { # load some defaults for the selected driver %driverdefaults = ( 'Pg' => { dbport => '5432', dbuser => '', dbdefault => 'template1', dbhost => 'localhost', connectstring => $locale->text('Connect to') } ); $driverdefaults{PgPP} = $driverdefaults{Pg}; for ( keys %{ $driverdefaults{Pg} } ) { $form->{$_} = $driverdefaults{ $form->{dbdriver} }{$_}; } } sub dbselect_source { &dbdriver_defaults; $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " / " . $locale->text('Database Administration'); $form->{login} = "admin"; $form->header; #an insane amount of table nesting here, this should be cleaned up. print qq|

$form->{title}

| . $locale->text('Database') . qq|
| . $locale->text('Host') . qq| | . $locale->text('Port') . qq|
| . $locale->text('User') . qq| | . $locale->text('Password') . qq|
$form->{connectstring}
| . $locale->text("Superuser") . qq| | . $locale->text('Password') . qq|

| . $locale->text( 'This is a preliminary check for existing sources. Nothing will be created or deleted at this stage!' ) . qq|

|; } sub continue { &{ $form->{nextsub} }; } sub dbupdate { $form->{callback} = "admin.pl?action=list_users"; LedgerSMB::User->dbupdate( \%$form ); $form->redirect( $locale->text('Dataset updated!') ); } sub create_dataset { @dbsources = sort LedgerSMB::User->dbsources( \%$form ); opendir SQLDIR, "sql/." or $form->error( __FILE__ . ':' . __LINE__ . ': ' . $! ); foreach $item ( sort grep /-chart\.sql/, readdir SQLDIR ) { next if ( $item eq 'Default-chart.sql' ); $item =~ s/-chart\.sql//; push @charts, qq|$item|; } closedir SQLDIR; # add Default at beginning unshift @charts, qq|Default|; $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " " . $locale->text('Database Administration') . " / " . $locale->text('Create Dataset'); $form->{login} = "admin"; $form->header; print qq|

$form->{title}

 
| . $locale->text('Existing Datasets') . qq| |; for (@dbsources) { print "[ $_ ] " } print qq|
| . $locale->text('Create Dataset') . qq|
| . $locale->text('Create Chart of Accounts') . qq| |; while (@charts) { print qq| |; for ( 0 .. 2 ) { print "\n" } print qq| |; splice @charts, 0, 3; } print qq|
$charts[$_]
|; $form->hide_form( qw(dbdriver dbsuperuser dbsuperpasswd dbuser dbhost dbport dbpasswd dbdefault path) ); print qq|
|; } sub dbcreate { $form->isblank( "db", $locale->text('Dataset missing!') ); LedgerSMB::User->dbcreate( \%$form ); $form->{title} = "LedgerSMB " . $locale->text('Accounting') . " " . $locale->text('Database Administration') . " / " . $locale->text('Create Dataset'); $form->{login} = "admin"; $form->header; print qq|

$form->{title}

| . $locale->text( 'Dataset [_1] successfully created!', $form->{db} ) . qq|

|; } sub unlock_system { # This needs to be done with a db tool # unlink "${LedgerSMB::Sysconfig::userspath}/nologin"; $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}"; $form->redirect( $locale->text('Lockfile removed!') ); } sub lock_system { # This needs to be done with a db tool #open(FH, '>', "${LedgerSMB::Sysconfig::userspath}/nologin") or $form->error($locale->text('Cannot create Lock!')); #close(FH); $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}"; $form->redirect( $locale->text('Lockfile created!') ); }