#===================================================================== # 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'; #$form->{charset} = $locale->encoding; 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->{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 { #currently, this is disabled, but will set a value in the central db #$nologin = qq||; # #if (-e "${LedgerSMB::Sysconfig::userspath}/nologin") { # $nologin = qq||; #} # 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}\///; $member{$key}{dbhost} = $locale->text('localhost') unless $member{$key}{dbhost}; $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 $nologin
|.$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 !/^\.\.?$/, 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("${LedgerSMB::Sysconfig::memberfile}", "$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}"; # scan %user for $templatedir foreach $login (keys %user) { last if ($found = ($form->{templates} eq $user{$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"; } } my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; #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{ Session::session_create($root); } } 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)){ &getpassword(1); 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 => '', dbuser => 'ledger-smb', dbdefault => 'template1', dbhost => '', 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|; $selectencoding = qq| |; $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('Multibyte Encoding').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 delete_dataset { if (@dbsources = LedgerSMB::User->dbsources_unused(\%$form)) { foreach $item (sort @dbsources) { $dbsources .= qq| $item |; } } else { $form->error(__FILE__.':'.__LINE__.': '.$locale->text('Nothing to delete!')); } $form->{title} = "LedgerSMB ".$locale->text('Accounting') ." ".$locale->text('Database Administration') ." / ".$locale->text('Delete Dataset'); $form->{login} = "admin"; $form->header; print qq|

$form->{title}

|.$locale->text('The following Datasets are not in use and can be deleted').qq|
$dbsources

|; } sub dbdelete { if (!$form->{db}) { $form->error(__FILE__.':'.__LINE__.': '.$locale->text('No Dataset selected!')); } LedgerSMB::User->dbdelete(\%$form); $form->{title} = "LedgerSMB ".$locale->text('Accounting') ." ".$locale->text('Database Administration') ." / ".$locale->text('Delete Dataset'); $form->{login} = "admin"; $form->header; print qq|

$form->{title}

$form->{db} |.$locale->text('successfully deleted!') .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!')); }