1#===================================================================== 2# LedgerSMB 3# Small Medium Business Accounting software 4# http://www.ledgersmb.org/ 5# 6# 7# Copyright (C) 2006 8# This work contains copyrighted information from a number of sources all used 9# with permission. 10# 11# This file contains source code included with or based on SQL-Ledger which 12# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed 13# under the GNU General Public License version 2 or, at your option, any later 14# version. For a full list including contact information of contributors, 15# maintainers, and copyright holders, see the CONTRIBUTORS file. 16# 17# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): 18# Copyright (c) 2000 19# 20# Author: DWS Systems Inc. 21# Web: http://www.sql-ledger.org 22# 23# Contributors: 24# 25# 26#====================================================================== 27# 28# This file has undergone whitespace cleanup. 29# 30#====================================================================== 31# 32# setup module 33# add/edit/delete users 34# 35#====================================================================== 36 37$menufile = "menu.ini"; 38 39use LedgerSMB::Form; 40use LedgerSMB::Locale; 41use LedgerSMB::User; 42use LedgerSMB::Session; 43 44$form = new Form; 45 46$locale = LedgerSMB::Locale->get_handle( ${LedgerSMB::Sysconfig::language} ) 47 or 48 $form->error( __FILE__ . ':' . __LINE__ . ': ' . "Locale not loaded: $!\n" ); 49$locale->encoding('UTF-8'); 50$form->{charset} = 'UTF-8'; 51 52eval { require DBI; }; 53$form->error( 54 __FILE__ . ':' . __LINE__ . ': ' . $locale->text('DBI not installed!') ) 55 if ($@); 56 57$form->{stylesheet} = "ledger-smb.css"; 58$form->{favicon} = "favicon.ico"; 59$form->{timeout} = 600; 60 61require "bin/pw.pl"; 62 63# customization 64if ( -f "bin/custom/$form->{script}" ) { 65 eval { require "bin/custom/$form->{script}"; }; 66 $form->error( __FILE__ . ':' . __LINE__ . ': ' . $@ ) if ($@); 67} 68 69if ( $form->{action} ) { 70 &check_password unless $form->{action} eq 'logout'; 71 &{ $form->{action} }; 72 73} 74else { 75 76 # if there are no drivers bail out 77 $form->error( __FILE__ . ':' . __LINE__ . ': ' 78 . $locale->text('No Database Drivers available!') ) 79 unless ( LedgerSMB::User->dbdrivers ); 80 81 $root = LedgerSMB::User->new('admin'); 82 83 &adminlogin; 84} 85 861; 87 88# end 89 90sub adminlogin { 91 92 my ($errorMessage) = @_; 93 94 $form->{title} = 95 qq|LedgerSMB $form->{version} | . $locale->text('Administration'); 96 97 $myheaderadd = qq| 98 <script language="JavaScript" type="text/javascript"> 99 <!-- 100 function sf(){ 101 document.admin.password.focus(); 102 } 103 // End --> 104 </script> 105 |; 106 $form->header( undef, $myheaderadd ); 107 108 print qq| 109 <body class="admin" onload="sf()"> 110 <div align="center"> 111 <a href="http://www.ledgersmb.org/"><img src="ledger-smb.png" width="200" height="100" border="0" alt="LedgerSMB Logo" /></a> 112 <h1 class="login">| 113 . $locale->text('Version') 114 . qq| $form->{version} <br />| 115 . $locale->text('Administration') 116 . qq|</h1> 117 <form method="post" action="admin.pl" name="admin"> 118 <table> 119 <tr> 120 <th>| . $locale->text('Password') . qq|</th> 121 <td><input type="password" name="password" /></td> 122 <td><button type="submit" class="submit" name="action" value="login">| 123 . $locale->text('Login') 124 . qq|</button></td> 125 </tr> 126 </table> 127 <input type="hidden" name="action" value="login" /> 128 <input type="hidden" name="path" value="$form->{path}" /> 129 </form> 130 |; 131 132 if ($errorMessage) { 133 print 134qq|<p><span style="font-weight:bold; color:red;">$errorMessage</span></p><br />|; 135 } 136 137 print qq| 138 <br /><br /> 139 <p><a href="login.pl" 140 >| . $locale->text("Application Login") . qq|</a></p> 141 142 <br /><br /> 143 <a style="font-size: 0.8em;" href="http://www.ledgersmb.org/">| 144 . $locale->text('LedgerSMB website') . qq|</a> 145 </div> 146 </body> 147 </html> 148 |; 149 150} 151 152sub login { 153 154 &list_users; 155} 156 157sub logout { 158 $form->{login} = 'admin'; 159 $form->{callback} = "admin.pl?action=adminlogin"; 160 Session::session_destroy($form); 161 $form->redirect( $locale->text('You are logged out') ); 162 163} 164 165sub add_user { 166 167 $form->{title} = 168 "LedgerSMB " 169 . $locale->text('Accounting') . " " 170 . $locale->text('Administration') . " / " 171 . $locale->text('Add User'); 172 173 if ( -f "css/ledger-smb.css" ) { 174 $myconfig->{stylesheet} = "ledger-smb.css"; 175 } 176 177 $myconfig->{vclimit} = 1000; 178 $myconfig->{menuwidth} = 155; 179 $myconfig->{timeout} = 3600; 180 181 &form_header; 182 &form_footer; 183} 184 185sub edit { 186 187 $form->{title} = 188 "LedgerSMB " 189 . $locale->text('Accounting') . " " 190 . $locale->text('Administration') . " / " 191 . $locale->text('Edit User'); 192 $form->{edit} = 1; 193 194 &form_header; 195 &form_footer; 196} 197 198sub form_footer { 199 200 if ( $form->{edit} ) { 201 $delete = 202 qq|<button type="submit" class="submit" name="action" value="delete">| 203 . $locale->text('Delete') 204 . qq|</button> 205 <input type="hidden" name="edit" value="1" />|; 206 } 207 208 print qq| 209 <input name="callback" type="hidden" value="$form->{script}?action=list_users&path=$form->{path}" /> 210 <input type="hidden" name="path" value="$form->{path}" /> 211 <button type="submit" class="submit" name="action" value="save">| 212 . $locale->text('Save') 213 . qq|</button> 214 $delete 215 </form> 216 </body> 217 </html> 218 |; 219} 220 221sub list_users { 222 223 # use the central database handle 224 my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; 225 226 my $fetchMembers = $dbh->selectall_arrayref( 227 "SELECT uc.name, uc.company, uc.templates, 228 uc.dbuser, uc.dbdriver, uc.dbname, 229 uc.dbhost, u.username 230 FROM users as u, users_conf as uc 231 WHERE u.id = uc.id 232 AND u.id > 1 233 ORDER BY u.username;", { Slice => {} } 234 ); 235 236 my @memberArray = (); 237 my @member = (); 238 239 foreach my $memberArray (@$fetchMembers) { 240 $member{ $memberArray->{username} } = $memberArray; 241 } 242 243 # type=submit $locale->text('Pg Database Administration') 244 # type=submit $locale->text('PgPP Database Administration') 245 246 foreach $item ( LedgerSMB::User->dbdrivers ) { 247 $dbdrivers .= 248 qq|<button name="action" type="submit" class="submit" value="| 249 . ( lc $item ) 250 . '_database_administration">' 251 . $locale->text("$item Database Administration") 252 . qq|</button>|; 253 } 254 255 $column_header{login} = qq|<th>| . $locale->text('Login') . qq|</th>|; 256 $column_header{name} = qq|<th>| . $locale->text('Name') . qq|</th>|; 257 $column_header{company} = qq|<th>| . $locale->text('Company') . qq|</th>|; 258 $column_header{dbdriver} = qq|<th>| . $locale->text('Driver') . qq|</th>|; 259 $column_header{dbhost} = qq|<th>| . $locale->text('Host') . qq|</th>|; 260 $column_header{dataset} = qq|<th>| . $locale->text('Dataset') . qq|</th>|; 261 $column_header{templates} = 262 qq|<th>| . $locale->text('Templates') . qq|</th>|; 263 264 @column_index = qw(login name company dbdriver dbhost dataset templates); 265 266 $form->{title} = 267 "LedgerSMB " 268 . $locale->text('Accounting') . " " 269 . $locale->text('Administration'); 270 271 $form->{login} = "admin"; 272 $form->header; 273 274 print qq| 275 <body class="admin"> 276 <form method="post" action="$form->{script}"> 277 <table width="100%"> 278 <tr class="listheading"> 279 <th>$form->{title}</th> 280 </tr> 281 <tr size="5"></tr> 282 <tr> 283 <td> 284 <table width="100%"> 285 <tr class="listheading">|; 286 287 for (@column_index) { print "$column_header{$_}\n" } 288 289 print qq| </tr>|; 290 291 foreach $key ( sort keys %member ) { 292 293 $href = "$script?action=edit&login=$key&path=$form->{path}"; 294 $href =~ s/ /%20/g; 295 296 $member{$key}{templates} =~ s/^${LedgerSMB::Sysconfig::templates}\///; 297 298 $column_data{login} = qq|<td><a href="$href">$key</a></td>|; 299 $column_data{name} = qq|<td>$member{$key}{name}</td>|; 300 $column_data{company} = qq|<td>$member{$key}{company}</td>|; 301 $column_data{dbdriver} = qq|<td>$member{$key}{dbdriver}</td>|; 302 $column_data{dbhost} = qq|<td>$member{$key}{dbhost}</td>|; 303 $column_data{dataset} = qq|<td>$member{$key}{dbname}</td>|; 304 $column_data{templates} = qq|<td>$member{$key}{templates}</td>|; 305 306 $i++; 307 $i %= 2; 308 print qq| <tr class="listrow$i">|; 309 310 for (@column_index) { print "$column_data{$_}\n"; } 311 312 print qq| </tr>|; 313 } 314 315 print qq| </table> 316 </td> 317 </tr> 318 <tr> 319 <td><hr size="3" noshade /></td> 320 </tr> 321 </table> 322 <input type="hidden" name="path" value="$form->{path}" /> 323 <br /> 324 <button type="submit" class="submit" name="action" value="add_user">| 325 . $locale->text('Add User') 326 . qq|</button> 327 <button type="submit" class="submit" name="action" value="change_admin_password">| 328 . $locale->text('Change Admin Password') 329 . qq|</button> 330 331 $dbdrivers 332 333 <button type="submit" class="submit" name="action" value="logout">| 334 . $locale->text('Logout') 335 . qq|</button> 336 </form> 337 338 | . $locale->text('Click on login name to edit!') . qq| 339 <br /> 340 | 341 . $locale->text( 342'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.' 343 ) 344 . qq| 345 346 </body> 347 </html>|; 348} 349 350sub form_header { 351 352 # if there is a login, get user 353 if ( $form->{login} ) { 354 355 # get user 356 %{$myconfig} = %{ LedgerSMB::User->fetch_config( $form->{login} ) }; 357 358 for (qw(company address signature)) { 359 $myconfig->{$_} = $form->quote( $myconfig->{$_} ); 360 } 361 for (qw(address signature)) { $myconfig->{$_} =~ s/\\n/\n/g } 362 363 # strip basedir from templates directory 364 $myconfig->{templates} =~ s/^${LedgerSMB::Sysconfig::templates}\///; 365 } 366 367 foreach $item (qw(mm-dd-yy mm/dd/yy dd-mm-yy dd/mm/yy dd.mm.yy yyyy-mm-dd)) 368 { 369 $dateformat .= 370 ( $item eq $myconfig->{dateformat} ) 371 ? "<option selected>$item</option>\n" 372 : "<option>$item</option>\n"; 373 } 374 375 my @formats = qw(1,000.00 1000.00 1.000,00 1000,00 1'000.00); 376 push @formats, '1 000.00'; 377 foreach $item (@formats) { 378 $numberformat .= 379 ( $item eq $myconfig->{numberformat} ) 380 ? "<option selected>$item</option>\n" 381 : "<option>$item</option>\n"; 382 } 383 384 %countrycodes = LedgerSMB::User->country_codes; 385 $countrycodes = ""; 386 my $selectedcode = 387 ( $myconfig->{countrycode} ) ? $myconfig->{countrycode} : 'en'; 388 389 foreach $key ( sort { $countrycodes{$a} cmp $countrycodes{$b} } 390 keys %countrycodes ) 391 { 392 $countrycodes .= 393 ( $selectedcode eq $key ) 394 ? qq|<option selected value="$key">$countrycodes{$key}</option>| 395 : qq|<option value="$key">$countrycodes{$key}</option>|; 396 } 397 398 # is there a templates basedir 399 if ( !-d "${LedgerSMB::Sysconfig::templates}" ) { 400 $form->error( 401 __FILE__ . ':' . __LINE__ . ': ' 402 . $locale->text( 403 'Directory [_1] does not exist', 404 ${LedgerSMB::Sysconfig::templates} 405 ) 406 ); 407 } 408 409 opendir TEMPLATEDIR, "${LedgerSMB::Sysconfig::templates}/." 410 or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$templates : $!" ); 411 @all = grep !/(^\.\.?$|^\.svn)/, readdir TEMPLATEDIR; 412 closedir TEMPLATEDIR; 413 414 @allhtml = sort grep /\.html/, @all; 415 416 @alldir = (); 417 for (@all) { 418 419 if ( -d "${LedgerSMB::Sysconfig::templates}/$_" ) { 420 push @alldir, $_; 421 } 422 } 423 424 @allhtml = reverse grep !/Default/, @allhtml; 425 push @allhtml, 'Default'; 426 @allhtml = reverse @allhtml; 427 428 foreach $item ( sort @alldir ) { 429 430 if ( $item eq $myconfig->{templates} ) { 431 $usetemplates .= 432 qq|<option selected value="$item">$item</option>\n|; 433 } 434 else { 435 $usetemplates .= qq|<option value="$item">$item</option>\n|; 436 } 437 } 438 439 $lastitem = $allhtml[0]; 440 $lastitem =~ s/-.*//g; 441 $mastertemplates = qq|<option value="$lastitem">$lastitem</option>\n|; 442 443 foreach $item (@allhtml) { 444 445 $item =~ s/-.*//g; 446 447 if ( $item ne $lastitem ) { 448 $mastertemplates .= qq|<option value="$item">$item</option>\n|; 449 $lastitem = $item; 450 } 451 } 452 453 opendir CSS, "css/."; 454 @all = grep /.*\.css$/, readdir CSS; 455 closedir CSS; 456 457 foreach $item (@all) { 458 459 if ( $item eq $myconfig->{stylesheet} ) { 460 $selectstylesheet .= 461 qq|<option selected value="$item">$item</option>\n|; 462 } 463 else { 464 $selectstylesheet .= qq|<option value="$item">$item</option>\n|; 465 } 466 } 467 468 $selectstylesheet .= "<option></option>\n"; 469 470 if ( %{LedgerSMB::Sysconfig::printer} && ${LedgerSMB::Sysconfig::latex} ) { 471 472 $selectprinter = "<option></option>\n"; 473 474 foreach $item ( sort keys %{LedgerSMB::Sysconfig::printer} ) { 475 476 if ( $myconfig->{printer} eq $item ) { 477 $selectprinter .= 478 qq|<option value="$item" selected>$item</option>\n|; 479 } 480 else { 481 $selectprinter .= qq|<option value="$item">$item</option>\n|; 482 } 483 } 484 485 $printer = qq| 486 <tr> 487 <th align="right">| . $locale->text('Printer') . qq|</th> 488 <td><select name="printer">$selectprinter</select></td> 489 </tr> 490 |; 491 492 } 493 494 $user = $form->{login}; 495 $form->{login} = "admin"; 496 $form->header; 497 $form->{login} = $user; 498 499 print qq| 500 <body class="admin"> 501 <form method="post" action="admin.pl"> 502 <table width="100%"> 503 <tr class="listheading"><th colspan="2">$form->{title}</th></tr> 504 <tr size="5"></tr> 505 <tr valign="top"> 506 <td> 507 <table> 508 <tr> 509 <th align="right">| . $locale->text('Login') . qq|</th> 510 <td><input name="login" value="$myconfig->{login}" /></td> 511 </tr> 512 <tr> 513 <th align="right">| . $locale->text('Password') . qq|</th> 514 <td><input type="password" name="new_password" size="8" value="$myconfig->{password}" /></td> 515 </tr> 516 <tr> 517 <th align="right">| . $locale->text('Name') . qq|</th> 518 <td><input name="name" size="15" value="$myconfig->{name}" /></td> 519 </tr> 520 <tr> 521 <th align="right">| . $locale->text('E-mail') . qq|</th> 522 <td><input name="email" size="30" value="$myconfig->{email}" /></td> 523 </tr> 524 <tr valign="top"> 525 <th align="right">| . $locale->text('Signature') . qq|</th> 526 <td><textarea name="signature" rows="3" cols="35">$myconfig->{signature}</textarea></td> 527 </tr> 528 <tr> 529 <th align="right">| . $locale->text('Phone') . qq|</th> 530 <td><input name="tel" size="14" value="$myconfig->{tel}" /></td> 531 </tr> 532 <tr> 533 <th align="right">| . $locale->text('Fax') . qq|</th> 534 <td><input name="fax" size="14" value="$myconfig->{fax}" /></td> 535 </tr> 536 <tr> 537 <th align="right">| . $locale->text('Company') . qq|</th> 538 <td><input name="company" size="35" value="$myconfig->{company}" /></td> 539 </tr> 540 <tr valign="top"> 541 <th align="right">| . $locale->text('Address') . qq|</th> 542 <td><textarea name="address" rows="4" cols="35">$myconfig->{address}</textarea></td> 543 </tr> 544 </table> 545 </td> 546 <td> 547 <table> 548 <tr> 549 <th align="right">| . $locale->text('Date Format') . qq|</th> 550 <td><select name="dateformat">$dateformat</select></td> 551 </tr> 552 <tr> 553 <th align="right">| . $locale->text('Number Format') . qq|</th> 554 <td><select name="numberformat">$numberformat</select></td> 555 </tr> 556 <tr> 557 <th align="right">| . $locale->text('Dropdown Limit') . qq|</th> 558 <td><input name="vclimit" value="$myconfig->{vclimit}" /></td> 559 </tr> 560 <tr> 561 <th align="right">| . $locale->text('Menu Width') . qq|</th> 562 <td><input name="menuwidth" value="$myconfig->{menuwidth}" /></td> 563 </tr> 564 <tr> 565 <th align="right">| . $locale->text('Language') . qq|</th> 566 <td><select name="countrycode">$countrycodes</select></td> 567 </tr> 568 <tr> 569 <th align="right">| . $locale->text('Session Timeout') . qq|</th> 570 <td><input name="newtimeout" value="$myconfig->{timeout}" /></td> 571 </tr> 572 <tr> 573 <th align="right">| . $locale->text('Stylesheet') . qq|</th> 574 <td><select name="userstylesheet">$selectstylesheet</select></td> 575 </tr> 576 $printer 577 <tr> 578 <th align="right">| . $locale->text('Use Templates') . qq|</th> 579 <td><select name="usetemplates">$usetemplates</select></td> 580 </tr> 581 <tr> 582 <th align="right">| . $locale->text('New Templates') . qq|</th> 583 <td><input name="newtemplates" /></td> 584 </tr> 585 <tr> 586 <th align="right">| . $locale->text('Setup Templates') . qq|</th> 587 <td><select name="mastertemplates">$mastertemplates</select></td> 588 </tr> 589 </table> 590 <input type="hidden" name="templates" value="$myconfig->{templates}" /> 591 </td> 592 </tr> 593 <tr class="listheading"> 594 <th colspan="2">| . $locale->text('Database') . qq|</th> 595 </tr>|; 596 597 # list section for database drivers 598 foreach $item ( LedgerSMB::User->dbdrivers ) { 599 600 print qq| 601 <tr> 602 <td colspan="2"> 603 <table> 604 <tr>|; 605 606 $checked = "checked"; 607 608 if ( $myconfig->{dbdriver} eq $item ) { 609 610 for (qw(dbhost dbport dbuser dbpasswd dbname sid)) { 611 $form->{"${item}_$_"} = $myconfig->{$_}; 612 } 613 $checked = "checked"; 614 } 615 616 print qq| 617 <th align="right">| . $locale->text('Driver') . qq|</th> 618 <td><input name="dbdriver" type="radio" class="radio" value="$item" $checked /> $item</td> 619 <th align="right">| . $locale->text('Host') . qq|</th> 620 <td><input name="${item}_dbhost" size="30" value="$form->{"${item}_dbhost"}" /></td> 621 </tr> 622 <tr>|; 623 624 print qq| 625 <th align="right">| . $locale->text('Dataset') . qq|</th> 626 <td><input name="${item}_dbname" size="15" value="$form->{"${item}_dbname"}" /></td> 627 <th align="right">| . $locale->text('Port') . qq|</th> 628 <td><input name="${item}_dbport" size="4" value="$form->{"${item}_dbport"}" /></td> 629 </tr> 630 <tr> 631 <th align="right">| . $locale->text('User') . qq|</th> 632 <td><input name="${item}_dbuser" size="15" value="$form->{"${item}_dbuser"}" /></td> 633 <th align="right">| . $locale->text('Password') . qq|</th> 634 <td><input name="${item}_dbpasswd" type="password" size="10" value="$form->{"${item}_dbpasswd"}" /></td> 635 </tr>|; 636 637 print qq| 638 </table> 639 <input type="hidden" name="old_dbpasswd" value="$myconfig->{dbpasswd}" /> 640 </td> 641 </tr> 642 <tr> 643 <td colspan="2"><hr size="2" noshade /></td> 644 </tr> 645 |; 646 647 } 648 649 # access control 650 open( FH, '<', $menufile ) 651 or $form->error( __FILE__ . ':' . __LINE__ . ': ' . "$menufile : $!" ); 652 653 # scan for first menu level 654 @a = <FH>; 655 close(FH); 656 657 if ( open( FH, '<', "custom_$menufile" ) ) { 658 push @a, <FH>; 659 } 660 661 close(FH); 662 663 foreach $item (@a) { 664 665 next unless $item =~ /\[\w+/; 666 next if $item =~ /\#/; 667 668 $item =~ s/(\[|\])//g; 669 chop $item; 670 671 if ( $item =~ /--/ ) { 672 673 ( $level, $menuitem ) = split /--/, $item, 2; 674 } 675 else { 676 677 $level = $item; 678 $menuitem = $item; 679 push @acsorder, $item; 680 } 681 682 push @{ $acs{$level} }, $menuitem; 683 684 } 685 686 %role = ( 687 'admin' => $locale->text('Administrator'), 688 'user' => $locale->text('User'), 689 'supervisor' => $locale->text('Supervisor'), 690 'manager' => $locale->text('Manager') 691 ); 692 693 $selectrole = ""; 694 695 foreach $item (qw(user admin supervisor manager)) { 696 $selectrole .= 697 ( $myconfig->{role} eq $item ) 698 ? "<option selected value=\"$item\">$role{$item}</option>\n" 699 : "<option value=\"$item\">$role{$item}</option>\n"; 700 } 701 702 print qq| 703 <tr class="listheading"> 704 <th colspan="2">| . $locale->text('Access Control') . qq|</th> 705 </tr> 706 <tr> 707 <td><select name="role">$selectrole</select></td> 708 </tr> 709 |; 710 711 foreach $item ( split /;/, $myconfig->{acs} ) { 712 ( $key, $value ) = split /--/, $item, 2; 713 $excl{$key}{$value} = 1; 714 } 715 716 foreach $key (@acsorder) { 717 718 $checked = "checked"; 719 720 if ( $form->{login} ) { 721 $checked = ( $excl{$key}{$key} ) ? "" : "checked"; 722 } 723 724 # can't have variable names with & and spaces 725 $item = $form->escape( "${key}--$key", 1 ); 726 727 $acsheading = $key; 728 $acsheading =~ s/ / /g; 729 730 $acsheading = qq| 731 <td align="left" nowrap="nowrap" style="background-color: #C7E9F7" colspan="2"> 732 <input name="$item" class="checkbox" type="checkbox" value="1" $checked /> $acsheading</td><tr><td>\n|; 733 $menuitems .= "$item;"; 734 $acsdata = "<td style=\"background-color: #F0F0F0\">"; 735 736 foreach $item ( @{ $acs{$key} } ) { 737 738 next if ( $key eq $item ); 739 740 $checked = "checked"; 741 742 if ( $form->{login} ) { 743 $checked = ( $excl{$key}{$item} ) ? "" : "checked"; 744 } 745 746 $acsitem = $form->escape( "${key}--$item", 1 ); 747 748 $acsdata .= 749qq|<br /><input name="$acsitem" class="checkbox" type="checkbox" value="1" $checked /> $item|; 750 $menuitems .= "$acsitem;"; 751 } 752 753 $acsdata .= " 754 </td>"; 755 756 print qq| 757 <tr valign="top">$acsheading $acsdata 758 </tr> 759 |; 760 } 761 762 print qq|<input type="hidden" name="acs" value="$menuitems" /> 763 <tr> 764 <td colspan="2"><hr size="3" noshade /></td> 765 </tr> 766 </table> 767 </div> 768 |; 769 770} 771 772sub save { 773 774 $form->{callback} = "admin.pl?action=list_users"; 775 776 # no driver checked 777 $form->error( __FILE__ . ':' . __LINE__ . ': ' 778 . $locale->text('Database Driver not checked!') ) 779 unless $form->{dbdriver}; 780 781 # no spaces allowed in login name 782 $form->{login} =~ s/ //g; 783 784 $form->isblank( "login", $locale->text('Login name missing!') ); 785 786 # check for duplicates 787 if ( !$form->{edit} ) { 788 789 $temp = LedgerSMB::User->new( $form->{login} ); 790 791 if ( $temp->{login} ) { 792 $form->error( __FILE__ . ':' . __LINE__ . ': ' 793 . $locale->text( '[_1] is already a member!', $form->{login} ) 794 ); 795 } 796 } 797 798 # no spaces allowed in directories 799 $form->{newtemplates} =~ s/( |\.\.|\*)//g; 800 801 if ( $form->{newtemplates} ne "" ) { 802 $form->{templates} = $form->{newtemplates}; 803 } 804 else { 805 $form->{templates} = 806 ( $form->{usetemplates} ) ? $form->{usetemplates} : $form->{login}; 807 } 808 809 # is there a basedir 810 if ( !-d "${LedgerSMB::Sysconfig::templates}" ) { 811 $form->error( 812 __FILE__ . ':' . __LINE__ . ': ' 813 . $locale->text( 814 'Directory [_1] does not exist', 815 ${LedgerSMB::Sysconfig::templates} 816 ) 817 ); 818 } 819 820 # add base directory to $form->{templates} 821 $form->{templates} = 822 "${LedgerSMB::Sysconfig::templates}/$form->{templates}"; 823 824 $myconfig = LedgerSMB::User->new("$form->{login}"); 825 826 # redo acs variable and delete all the acs codes 827 @acs = split /;/, $form->{acs}; 828 $form->{acs} = ""; 829 830 foreach $item (@acs) { 831 832 if ($item =~ /\s/){ 833 $item = $form->escape( $item, 1 ); 834 } 835 if ( !$form->{$item} ) { 836 $form->{acs} .= $form->unescape( $form->unescape("$item") ) . ";"; 837 } 838 839 delete $form->{$item}; 840 } 841 842 # check which database was filled in 843 844 $form->{dbhost} = $form->{"$form->{dbdriver}_dbhost"}; 845 $form->{dbport} = $form->{"$form->{dbdriver}_dbport"}; 846 $form->{dbpasswd} = $form->{"$form->{dbdriver}_dbpasswd"}; 847 $form->{dbuser} = $form->{"$form->{dbdriver}_dbuser"}; 848 $form->{dbname} = $form->{"$form->{dbdriver}_dbname"}; 849 $form->isblank( "dbname", $locale->text('Dataset missing!') ); 850 $form->isblank( "dbuser", $locale->text('Database User missing!') ); 851 852 foreach $item ( keys %{$form} ) { 853 $myconfig->{$item} = $form->{$item}; 854 } 855 856 $myconfig->{password} = $form->{new_password}; 857 $myconfig->{timeout} = $form->{newtimeout}; 858 859 delete $myconfig->{stylesheet}; 860 861 if ( $form->{userstylesheet} ) { 862 $myconfig->{stylesheet} = $form->{userstylesheet}; 863 } 864 865 $myconfig->{packpw} = 1; 866 867 $myconfig->save_member($form); 868 869 # create user template directory and copy master files 870 if ( !-d "$form->{templates}" ) { 871 872 umask(002); 873 874 if ( mkdir "$form->{templates}", oct("771") ) { 875 876 umask(007); 877 878 # copy templates to the directory 879 opendir TEMPLATEDIR, "${LedgerSMB::Sysconfig::templates}/." 880 or $form->error( 881 __FILE__ . ':' . __LINE__ . ': ' . "$templates : $!" ); 882 @templates = grep /$form->{mastertemplates}-/, readdir TEMPLATEDIR; 883 closedir TEMPLATEDIR; 884 885 foreach $file (@templates) { 886 887 open( TEMP, '<', "${LedgerSMB::Sysconfig::templates}/$file" ) 888 or $form->error( __FILE__ . ':' . __LINE__ . ': ' 889 . "$templates/$file : $!" ); 890 891 $file =~ s/$form->{mastertemplates}-//; 892 open( NEW, '>', "$form->{templates}/$file" ) 893 or $form->error( __FILE__ . ':' . __LINE__ . ': ' 894 . "$form->{templates}/$file : $!" ); 895 896 while ( $line = <TEMP> ) { 897 print NEW $line; 898 } 899 900 close(TEMP); 901 close(NEW); 902 } 903 904 } 905 else { 906 $form->error( 907 __FILE__ . ':' . __LINE__ . ': ' . "$form->{templates} : $!" ); 908 } 909 } 910 911 $form->redirect( $locale->text('User saved!') ); 912} 913 914sub delete { 915 916 $form->{callback} = "admin.pl?action=list_users"; 917 918 $form->{templates} = 919 ( $form->{templates} ) 920 ? "${LedgerSMB::Sysconfig::templates}/$form->{templates}" 921 : "$templates/$form->{login}"; 922 923 my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; 924 925 my $found = $dbh->selectall_arrayref(qq|SELECT c.templates 926 FROM users_conf c INNER JOIN users u ON (c.id = u.id) 927 WHERE c.templates = ? AND u.username <> ?|, 928 undef, $form->{templates}, $form->{login}); 929 930 # if found keep directory otherwise delete 931 if ( !@$found ) { 932 933 # delete it if there is a template directory 934 $dir = "$form->{templates}"; 935 if ( -d "$dir" ) { 936 unlink <$dir/*>; 937 rmdir "$dir"; 938 } 939 } 940 941 #users_conf 942 943 my $deleteUser = $dbh->prepare("select id FROM users WHERE username = ?;"); 944 945 $deleteUser->execute( $form->{login} ); 946 947 my $id1=$deleteUser->fetchrow(); 948 949 $dbh->do("DELETE FROM users_conf WHERE id=$id1;") or print "error"; 950 $dbh->do("DELETE FROM users WHERE id=$id1;") or print "Error"; 951 952 $form->{login}="admin"; 953 954 955 956 $form->redirect( $locale->text('User deleted!') ); 957} 958 959sub login_name { 960 961 my $login = shift; 962 $login =~ s/\[\]//g; 963 return ($login) ? $login : undef; 964} 965 966sub change_admin_password { 967 968 $form->{title} = 969 qq|LedgerSMB | 970 . $locale->text('Accounting') . " " 971 . $locale->text('Administration') . " / " 972 . $locale->text('Change Admin Password'); 973 974 $form->{login} = "admin"; 975 $form->header; 976 977 print qq| 978 <body class="admin"> 979 <form method="get" action="$form->{script}"> 980 <table> 981 <tr class="listheading"> 982 <th>| . $locale->text('Change Password') . qq|</th> 983 </tr> 984 <tr size="5"></tr> 985 <tr> 986 <td> 987 <table width="100%"> 988 <tr> 989 <th align="right">| . $locale->text('Password') . qq|</th> 990 <td><input type="password" name="new_password" /></td> 991 </tr> 992 <tr> 993 <th align="right">| . $locale->text('Confirm') . qq|</th> 994 <td><input type="password" name="confirm_password" /></td> 995 </tr> 996 </table> 997 </td> 998 </tr> 999 </table> 1000 <br /> 1001 <hr size="3" noshade /> 1002 <input type="hidden" name="path" value="$form->{path}" /> 1003 <p><button type="submit" class="submit" name="action" value="change_password">| 1004 . $locale->text('Change Password') 1005 . qq|</button></p> 1006 </form> 1007 </body> 1008 </html> 1009 |; 1010 1011} 1012 1013sub change_password { 1014 1015 # Do we want to force a login after changing the password? 1016 $form->{callback} = "admin.pl?"; 1017 1018 $form->error( __FILE__ . ':' . __LINE__ . ': ' 1019 . $locale->text('Passwords do not match!') ) 1020 if $form->{new_password} ne $form->{confirm_password}; 1021 1022 # use the central database handle 1023 my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; 1024 1025 my $updateAdminPassword = $dbh->prepare( 1026 "UPDATE users_conf 1027 SET password = md5(?) 1028 WHERE id = 1" 1029 ); 1030 1031 $updateAdminPassword->execute( $form->{new_password} ); 1032 1033 $form->{callback} = 1034 "$form->{script}?action=list_users&path=$form->{path}"; 1035 $form->redirect( $locale->text('Password changed!') ); 1036} 1037 1038sub check_password { 1039 1040 $root = LedgerSMB::User->new('admin'); 1041 1042 if ( $form->{password} ) { 1043 1044 $form->{callback} .= "&password=$form->{password}" 1045 if $form->{callback}; 1046 1047 if ( $root->{password} ne ( Digest::MD5::md5_hex $form->{password} ) ) { 1048 &adminlogin( $locale->text('Access Denied!') ); 1049 exit; 1050 } 1051 else { 1052 $form->{login} = 'admin'; 1053 Session::session_create($form); 1054 } 1055 } 1056 else { 1057 1058 $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; 1059 @cookies = split /;/, $ENV{HTTP_COOKIE}; 1060 foreach (@cookies) { 1061 ( $name, $value ) = split /=/, $_, 2; 1062 $cookie{$name} = $value; 1063 } 1064 1065 if ( !Session::session_check( $cookie{"LedgerSMB"}, $root ) ) { 1066 &adminlogin( $locale->text('Session expired!') ); 1067 exit; 1068 } 1069 } 1070} 1071 1072sub pg_database_administration { 1073 1074 $form->{dbdriver} = 'Pg'; 1075 &dbselect_source; 1076} 1077 1078sub pgpp_database_administration { 1079 1080 $form->{dbdriver} = 'PgPP'; 1081 &dbselect_source; 1082 1083} 1084 1085sub dbdriver_defaults { 1086 1087 # load some defaults for the selected driver 1088 %driverdefaults = ( 1089 'Pg' => { 1090 dbport => '5432', 1091 dbuser => '', 1092 dbdefault => 'template1', 1093 dbhost => 'localhost', 1094 connectstring => $locale->text('Connect to') 1095 } 1096 ); 1097 1098 $driverdefaults{PgPP} = $driverdefaults{Pg}; 1099 1100 for ( keys %{ $driverdefaults{Pg} } ) { 1101 $form->{$_} = $driverdefaults{ $form->{dbdriver} }{$_}; 1102 } 1103 1104} 1105 1106sub dbselect_source { 1107 1108 &dbdriver_defaults; 1109 1110 $form->{title} = 1111 "LedgerSMB " 1112 . $locale->text('Accounting') . " / " 1113 . $locale->text('Database Administration'); 1114 1115 $form->{login} = "admin"; 1116 $form->header; 1117 1118 #an insane amount of table nesting here, this should be cleaned up. 1119 print qq| 1120 <body class="admin"> 1121 <center> 1122 <h2>$form->{title}</h2> 1123 <form method="post" action="$form->{script}" /> 1124 <table> 1125 <tr> 1126 <td> 1127 <table> 1128 <tr class="listheading"> 1129 <th colspan="4">| . $locale->text('Database') . qq|</th> 1130 </tr> 1131 <tr> 1132 <td> 1133 <table> 1134 <tr> 1135 <th align="right">| . $locale->text('Host') . qq|</th> 1136 <td><input name="dbhost" size="25" value="$form->{dbhost}" /></td> 1137 <th align="right">| . $locale->text('Port') . qq|</th> 1138 <td><input name="dbport" size="5" value="$form->{dbport}" /></td> 1139 </tr> 1140 <tr> 1141 <th align="right">| . $locale->text('User') . qq|</th> 1142 <td><input name="dbuser" size="10" value="$form->{dbuser}" /></td> 1143 <th align="right">| . $locale->text('Password') . qq|</th> 1144 <td><input type="password" name="dbpasswd" size="10" /></td> 1145 </tr> 1146 <tr> 1147 <th align="right">$form->{connectstring}</th> 1148 <td colspan="3"><input name="dbdefault" size="10" value="$form->{dbdefault}" /></td> 1149 </tr> 1150 <tr> 1151 <th align="right">| . $locale->text("Superuser") . qq|</th> 1152 <td><input name="dbsuperuser" size="10" value="$form->{dbsuperuser}" /></td> 1153 <th align="right">| . $locale->text('Password') . qq|</th> 1154 <td><input type="password" name="dbsuperpasswd" size="10" /></td> 1155 </tr> 1156 </table> 1157 </td> 1158 </tr> 1159 </table> 1160 </td> 1161 </tr> 1162 </table> 1163 <input type="hidden" name="dbdriver" value="$form->{dbdriver}" /> 1164 <input name="callback" type="hidden" value="$form->{script}?action=list_users&path=$form->{path}" /> 1165 <input type="hidden" name="path" value="$form->{path}" /> 1166 <br /> 1167 <button type="submit" class="submit" name="action" value="create_dataset">| 1168 . $locale->text('Create Dataset') 1169 . qq|</button> 1170 </form> 1171 <p>| 1172 . $locale->text( 1173'This is a preliminary check for existing sources. Nothing will be created or deleted at this stage!' 1174 ) 1175 . qq|</p> 1176 </center> 1177 </body> 1178 </html> 1179 |; 1180} 1181 1182sub continue { 1183 1184 &{ $form->{nextsub} }; 1185} 1186 1187sub dbupdate { 1188 $form->{callback} = "admin.pl?action=list_users"; 1189 1190 LedgerSMB::User->dbupdate( \%$form ); 1191 $form->redirect( $locale->text('Dataset updated!') ); 1192} 1193 1194sub create_dataset { 1195 1196 @dbsources = sort LedgerSMB::User->dbsources( \%$form ); 1197 1198 opendir SQLDIR, "sql/." 1199 or $form->error( __FILE__ . ':' . __LINE__ . ': ' . $! ); 1200 1201 foreach $item ( sort grep /-chart\.sql/, readdir SQLDIR ) { 1202 next if ( $item eq 'Default-chart.sql' ); 1203 $item =~ s/-chart\.sql//; 1204 push @charts, 1205qq|<input name="chart" class="radio" type="radio" value="$item" />$item|; 1206 } 1207 1208 closedir SQLDIR; 1209 1210 # add Default at beginning 1211 unshift @charts, 1212qq|<input name="chart" class="radio" type="radio" value="Default" checked />Default|; 1213 1214 $form->{title} = 1215 "LedgerSMB " 1216 . $locale->text('Accounting') . " " 1217 . $locale->text('Database Administration') . " / " 1218 . $locale->text('Create Dataset'); 1219 $form->{login} = "admin"; 1220 $form->header; 1221 1222 print qq| 1223 <body class="admin"> 1224 <center> 1225 <h2>$form->{title}</h2> 1226 <form method="post" action="$form->{script}" /> 1227 <table width="100%"> 1228 <tr class="listheading"> 1229 <th colspan="2"> </th> 1230 </tr> 1231 <tr> 1232 <th align="right" nowrap="nowrap">| 1233 . $locale->text('Existing Datasets') 1234 . qq|</th> 1235 <td> 1236 |; 1237 1238 for (@dbsources) { print "[ $_ ] " } 1239 1240 print qq| 1241 </td> 1242 </tr> 1243 <tr> 1244 <th align="right" nowrap="nowrap">| 1245 . $locale->text('Create Dataset') 1246 . qq|</th> 1247 <td><input name="db" /></td> 1248 </tr> 1249 <tr> 1250 <th align="right" nowrap="nowrap">| 1251 . $locale->text('Create Chart of Accounts') 1252 . qq|</th> 1253 <td> 1254 <table> 1255 |; 1256 1257 while (@charts) { 1258 print qq| <tr>|; 1259 1260 for ( 0 .. 2 ) { print "<td>$charts[$_]</td>\n" } 1261 1262 print qq| </tr>|; 1263 1264 splice @charts, 0, 3; 1265 } 1266 1267 print qq| </table> 1268 </td> 1269 </tr> 1270 <tr> 1271 <td colspan="2"> 1272 <hr size="3" noshade /> 1273 </td> 1274 </tr> 1275 </table> 1276 |; 1277 1278 $form->hide_form( 1279 qw(dbdriver dbsuperuser dbsuperpasswd dbuser dbhost dbport dbpasswd dbdefault path) 1280 ); 1281 1282 print qq| 1283 <input name="callback" type="hidden" value="$form->{script}?action=list_users&path=$form->{path}" /> 1284 <input type="hidden" name="nextsub" value="dbcreate" /> 1285 <br /> 1286 <button type="submit" class="submit" name="action" value="continue">| 1287 . $locale->text('Continue') 1288 . qq|</button> 1289 </form> 1290 </body> 1291 </html> 1292 |; 1293 1294} 1295 1296sub dbcreate { 1297 1298 $form->isblank( "db", $locale->text('Dataset missing!') ); 1299 1300 LedgerSMB::User->dbcreate( \%$form ); 1301 1302 $form->{title} = 1303 "LedgerSMB " 1304 . $locale->text('Accounting') . " " 1305 . $locale->text('Database Administration') . " / " 1306 . $locale->text('Create Dataset'); 1307 1308 $form->{login} = "admin"; 1309 $form->header; 1310 1311 print qq| 1312 <body class="admin"> 1313 <center> 1314 <h2>$form->{title}</h2> 1315 <form method="post" action="$form->{script}">| 1316 . $locale->text( 'Dataset [_1] successfully created!', $form->{db} ) . qq| 1317 <input type="hidden" name="path" value="$form->{path}" /> 1318 <input type="hidden" name="nextsub" value="list_users" /> 1319 <p><button type="submit" class="submit" name="action" value="continue">| 1320 . $locale->text('Continue') 1321 . qq|</button></p> 1322 </form> 1323 </center> 1324 </body> 1325 </html> 1326 |; 1327} 1328 1329sub unlock_system { 1330 1331 # This needs to be done with a db tool 1332 # unlink "${LedgerSMB::Sysconfig::userspath}/nologin"; 1333 $form->{callback} = 1334 "$form->{script}?action=list_users&path=$form->{path}"; 1335 $form->redirect( $locale->text('Lockfile removed!') ); 1336} 1337 1338sub lock_system { 1339 1340# This needs to be done with a db tool 1341#open(FH, '>', "${LedgerSMB::Sysconfig::userspath}/nologin") or $form->error($locale->text('Cannot create Lock!')); 1342#close(FH); 1343 $form->{callback} = 1344 "$form->{script}?action=list_users&path=$form->{path}"; 1345 $form->redirect( $locale->text('Lockfile created!') ); 1346} 1347