#===================================================================== # 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; $form = new Form; $locale = LedgerSMB::Locale->get_handle($language); $locale->encoding('UTF-8'); $form->{charset} = 'UTF-8'; #$form->{charset} = $locale->encoding; eval { require DBI; }; $form->error($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($@) if ($@); } if ($form->{action}) { &check_password unless $form->{action} eq 'logout'; &{ $form->{action} }; } else { # if there are no drivers bail out $form->error($locale->text('No Database Drivers available!')) unless (User->dbdrivers); # create memberfile if (! -f $memberfile) { open(FH, ">$memberfile") or $form->error("$memberfile : $!"); print FH qq|# LedgerSMB Accounting members [root login] password= |; close FH; } $root = new User "$memberfile", "root login"; unless($root && $root->{password}) { &setup_initial_password(); exit; } &adminlogin; } 1; # end sub setup_initial_password { $form->header(); print qq|
LedgerSMB Logo

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

Change password

This is your first time logging into LedgerSMB. Please set your administrative password

|.$locale->text('Password').qq|
|.$locale->text('Confirm').qq|

LedgerSMB |.$locale->text('website').qq|
|; } sub adminlogin { $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|

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

LedgerSMB |.$locale->text('website').qq|
|; } sub login { &list_users; } sub logout { $form->{callback} = "$form->{script}?path=$form->{path}&endsession=1"; unlink "$userspath/adminhash"; print qq|Set-Cookie: LedgerSMB=; path=/;\n|; $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 { open(FH, "$memberfile") or $form->error("$memberfile : $!"); $nologin = qq||; if (-e "$userspath/nologin") { $nologin = qq||; } while () { chop; if (/^\[.*\]/) { $login = $_; $login =~ s/(\[|\])//g; } if (/^(name=|company=|templates=|dbuser=|dbdriver=|dbname=|dbhost=)/) { chop ($var = $&); ($null, $member{$login}{$var}) = split /=/, $_, 2; } } close(FH); # type=submit $locale->text('Pg Database Administration') # type=submit $locale->text('PgPP Database Administration') foreach $item (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} = "root login"; $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}&sessionid=$form->{sessionid}"; $href =~ s/ /%20/g; $member{$key}{templates} =~ s/^$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 = new User "$memberfile", "$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/^$templates\///; $myconfig->{dbpasswd} = unpack 'u', $myconfig->{dbpasswd}; } 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 = User->country_codes; $countrycodes = ""; foreach $key (sort { $countrycodes{$a} cmp $countrycodes{$b} } keys %countrycodes) { $countrycodes .= ($myconfig->{countrycode} eq $key) ? qq|| : qq||; } $countrycodes = qq|\n$countrycodes|; # is there a templates basedir if (! -d "$templates") { $form->error($locale->text('Directory').": $templates ".$locale->text('does not exist')); } opendir TEMPLATEDIR, "$templates/." or $form->error("$templates : $!"); @all = grep !/^\.\.?$/, readdir TEMPLATEDIR; closedir TEMPLATEDIR; @allhtml = sort grep /\.html/, @all; @alldir = (); for (@all) { if (-d "$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 (%printer && $latex) { $selectprinter = "\n"; foreach $item (sort keys %printer) { if ($myconfig->{printer} eq $item) { $selectprinter .= qq|\n|; } else { $selectprinter .= qq|\n|; } } $printer = qq| |.$locale->text('Printer').qq| |; } $user = $form->{login}; $form->{login} = "root login"; $form->header; $form->{login} = $user; print qq|
|; # list section for database drivers foreach $item (User->dbdrivers) { print qq| |; } # access control open(FH, $menufile) or $form->error("$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 { # no driver checked $form->error($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 = new User "$memberfile", "$form->{login}"; if ($temp->{login}) { $form->error("$form->{login} ".$locale->text('is already a member!')); } } # 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 "$templates") { $form->error($locale->text('Directory').": $templates ".$locale->text('does not exist')); } # add base directory to $form->{templates} $form->{templates} = "$templates/$form->{templates}"; $myconfig = new User "$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->{old_password}; $myconfig->{password} = $form->{new_password} if $form->{new_password} ne $form->{old_password}; $myconfig->{timeout} = $form->{newtimeout}; delete $myconfig->{stylesheet}; if ($form->{userstylesheet}) { $myconfig->{stylesheet} = $form->{userstylesheet}; } $myconfig->{packpw} = 1; $myconfig->save_member($memberfile, $userspath); # 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, "$templates/." or $form->error("$templates : $!"); @templates = grep /$form->{mastertemplates}-/, readdir TEMPLATEDIR; closedir TEMPLATEDIR; foreach $file (@templates) { open(TEMP, "$templates/$file") or $form->error("$templates/$file : $!"); $file =~ s/$form->{mastertemplates}-//; open(NEW, ">$form->{templates}/$file") or $form->error("$form->{templates}/$file : $!"); while ($line = ) { print NEW $line; } close(TEMP); close(NEW); } } else { $form->error("$form->{templates} : $!"); } } $form->redirect($locale->text('User saved!')); } sub delete { $form->{templates} = ($form->{templates}) ? "$templates/$form->{templates}" : "$templates/$form->{login}"; $form->error("$memberfile ".$locale->text('locked!')) if (-f ${memberfile}.LCK); open(FH, ">${memberfile}.LCK") or $form->error("${memberfile}.LCK : $!"); close(FH); if (! open(CONF, "+<$memberfile")) { unlink "${memberfile}.LCK"; $form->error("$memberfile : $!"); } @config = ; seek(CONF, 0, 0); truncate(CONF, 0); while ($line = shift @config) { chop $line; if ($line =~ /^\[/) { last if ($line eq "[$form->{login}]"); $login = &login_name($line); } if ($line =~ /^templates=/) { ($null, $user{$login}) = split /=/, $line, 2; } print CONF "$line\n"; } # remove everything up to next login or EOF # and save template variable while ($line = shift @config) { chop $line; ($key, $value) = split /=/, $line, 2; $myconfig{$key} = $value; last if ($line =~ /^\[/); } # this one is either the next login or EOF print CONF "$line\n"; $login = &login_name($line); while ($line = shift @config) { chop $line; if ($line =~ /^\[/) { $login = &login_name($line); } if ($line =~ /^templates=/) { ($null, $user{$login}) = split /=/, $line, 2; } print CONF "$line\n"; } close(CONF); unlink "${memberfile}.LCK"; # 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"; } } if ($myconfig{dbconnect}) { $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; for (keys %myconfig) { $form->{$_} = $myconfig{$_} } User->delete_login(\%$form); # delete config file for user unlink "$userspath/$form->{login}.conf"; } $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} = "root login"; $form->header; print qq|
|.$locale->text('Change Password').qq|
|.$locale->text('Password').qq|
|.$locale->text('Confirm').qq|

|; } sub change_password { $form->error($locale->text('Passwords do not match!')) if $form->{new_password} ne $form->{confirm_password}; $root->{password} = $form->{new_password}; $root->{'root login'} = 1; $root->save_member($memberfile); $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}&sessionid=$form->{sessionid}"; $form->redirect($locale->text('Password changed!')); } sub get_hash { use Digest::MD5; $form->{hash} = Digest::MD5::md5_hex rand(); } sub check_password { $root = new User "$memberfile", "root login"; if ($root->{password}) { if ($form->{password}) { $form->{callback} .= "&password=$form->{password}" if $form->{callback}; $form->{sessionid} = time; if ($root->{password} ne crypt $form->{password}, 'ro') { &getpassword; exit; } &get_hash; open(HASHFILE, "> $userspath/adminhash") || $form->error("Can't Open Hashfile: $!"); print HASHFILE $form->{hash}; print qq|Set-Cookie: LedgerSMB=$form->{hash}; path=/;\n|; } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; %cookie = split /[=;]/, $ENV{HTTP_COOKIE}; # Changeme to %cookies $cookie = ($form->{path} eq 'bin/lynx') ? $cookie{login} : $cookie{"LedgerSMB-root login"}; #fixes problem with first login and such if (!(-f "$userspath/adminhash")) { &get_hash; open(HASHFILE, "> $userspath/adminhash") || $form->error("Can't Open Hashfile: $!"); print HASHFILE $form->{hash}; close(HASHFILE); } open (HASHFILE, "< $userspath/adminhash") || $form->error("Can't Open Hashfile: $!"); chomp($form->{hash} = ); %cookies = split /[=;]/, $ENV{HTTP_COOKIE}; if (! $cookie || $cookie ne $form->{sessionid} || $form->{hash} ne $cookies{LedgerSMB}) { &getpassword; 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} = "root login"; $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 { User->dbupdate(\%$form); $form->redirect($locale->text('Dataset updated!')); } sub create_dataset { @dbsources = sort User->dbsources(\%$form); opendir SQLDIR, "sql/." or $form->error($!); 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} = "root login"; $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 sessionid)); print qq|
|; } sub dbcreate { $form->isblank("db", $locale->text('Dataset missing!')); User->dbcreate(\%$form); $form->{title} = "LedgerSMB ".$locale->text('Accounting') ." ".$locale->text('Database Administration') ." / ".$locale->text('Create Dataset'); $form->{login} = "root login"; $form->header; print qq|

$form->{title}

| .$locale->text('Dataset')." $form->{db} ".$locale->text('successfully created!') .qq|

|; } sub delete_dataset { if (@dbsources = User->dbsources_unused(\%$form, $memberfile)) { foreach $item (sort @dbsources) { $dbsources .= qq| $item |; } } else { $form->error($locale->text('Nothing to delete!')); } $form->{title} = "LedgerSMB ".$locale->text('Accounting') ." ".$locale->text('Database Administration') ." / ".$locale->text('Delete Dataset'); $form->{login} = "root login"; $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($locale->text('No Dataset selected!')); } User->dbdelete(\%$form); $form->{title} = "LedgerSMB ".$locale->text('Accounting') ." ".$locale->text('Database Administration') ." / ".$locale->text('Delete Dataset'); $form->{login} = "root login"; $form->header; print qq|

$form->{title}

$form->{db} |.$locale->text('successfully deleted!') .qq|

|; } sub unlock_system { unlink "$userspath/nologin"; $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}&sessionid=$form->{sessionid}"; $form->redirect($locale->text('Lockfile removed!')); } sub lock_system { open(FH, ">$userspath/nologin") or $form->error($locale->text('Cannot create Lock!')); close(FH); $form->{callback} = "$form->{script}?action=list_users&path=$form->{path}&sessionid=$form->{sessionid}"; $form->redirect($locale->text('Lockfile created!')); }