1#===================================================================== 2# SQL-Ledger 3# Copyright (c) DWS Systems Inc. 4# 5# Author: DWS Systems Inc. 6# Web: http://www.sql-ledger.com 7# 8#===================================================================== 9# 10# login frontend 11# 12#===================================================================== 13 14 15use DBI; 16use SL::User; 17use SL::Form; 18 19 20$form = new Form; 21 22 23$locale = new Locale $language, "login"; 24 25$form->{charset} = $charset; 26 27# customization 28if (-f "$form->{path}/custom/$form->{script}") { 29 eval { require "$form->{path}/custom/$form->{script}"; }; 30 $form->error($@) if ($@); 31} 32 33# per login customization 34if (-f "$form->{path}/custom/$form->{login}/$form->{script}") { 35 eval { require "$form->{path}/custom/$form->{login}/$form->{script}"; }; 36 $form->error($@) if ($@); 37} 38 39if ($form->{action}) { 40 &{ $locale->findsub($form->{action}) }; 41} else { 42 &login_screen; 43} 44 45 461; 47 48 49sub login_screen { 50 51 $form->{stylesheet} = "sql-ledger.css"; 52 $form->{favicon} = "sql-ledger.ico"; 53 54 $form->header; 55 56 $focus = ($form->{login}) ? "password" : "login"; 57 58 print qq| 59<script language="javascript" type="text/javascript"> 60<!-- 61var agt = navigator.userAgent.toLowerCase(); 62var is_major = parseInt(navigator.appVersion); 63var is_nav = ((agt.indexOf('mozilla') != -1) && (agt.indexOf('spoofer') == -1) 64 && (agt.indexOf('compatible') == -1) && (agt.indexOf('opera') == -1) 65 && (agt.indexOf('webtv') == -1)); 66var is_nav4lo = (is_nav && (is_major <= 4)); 67 68function jsp() { 69 if (is_nav4lo) 70 document.forms[0].js.value = "" 71 else 72 document.forms[0].js.value = "1" 73} 74// End --> 75</script> 76 77<body class=login onload="jsp(); document.forms[0].${focus}.focus()"> 78 79<pre> 80 81 82 83 84 85 86</pre> 87 88<center> 89<table class=login border=3 cellpadding=20> 90 <tr> 91 <td class=login align=center><a href="http://www.sql-ledger.com" target=_blank><img src=$images/sql-ledger.png border=0></a> 92<h1 class=login align=center>|.$locale->text('Version').qq| $form->{version}</h1> 93 94<p> 95 96 <form method=post name=main action=$form->{script}> 97 98 <table width=100%> 99 <tr> 100 <td align=center> 101 <table> 102 <tr> 103 <th align=right>|.$locale->text('Name').qq|</th> 104 <td><input class=login name=login size=30></td> 105 </tr> 106 <tr> 107 <th align=right>|.$locale->text('Password').qq|</th> 108 <td><input class=login type=password name=password size=30></td> 109 </tr> 110 </table> 111 112 <br> 113 <input type=submit name=action value="|.$locale->text('Login').qq|"> 114 </td> 115 </tr> 116 </table> 117|; 118 119 $form->hide_form(qw(js path)); 120 121 print qq| 122 </form> 123 124 </td> 125 </tr> 126</table> 127 128</body> 129</html> 130|; 131 132} 133 134 135sub selectdataset { 136 my ($login) = @_; 137 138 if (-f "css/sql-ledger.css") { 139 $form->{stylesheet} = "sql-ledger.css"; 140 } 141 if (-f sql-ledger.ico) { 142 $form->{favicon} = "sql-ledger.ico"; 143 } 144 145 delete $self->{sessioncookie}; 146 $form->header(1); 147 148 print qq| 149<body class=login onload="document.forms[0].password.focus()" /> 150 151<pre> 152 153</pre> 154 155<center> 156<table class=login border=3 cellpadding=20> 157 <tr> 158 <td class=login align=center><a href="http://www.sql-ledger.com" target=_blank><img src=$images/sql-ledger.png border=0></a> 159<h1 class=login align=center>|.$locale->text('Version').qq| $form->{version}</h1> 160 161<p> 162 163<form method=post action=$form->{script}> 164 165<input type=hidden name=beenthere value=1> 166 167 <table width=100%> 168 <tr> 169 <td align=center> 170 <table> 171 <tr> 172 <th align=right>|.$locale->text('Name').qq|</th> 173 <td>$form->{login}</td> 174 </tr> 175 <tr> 176 <th align=right>|.$locale->text('Password').qq|</th> 177 <td><input class=login type=password name=password size=30 value=$form->{password}></td> 178 </tr> 179 <tr> 180 <th align=right>|.$locale->text('Company').qq|</th> 181 <td>|; 182 183 $form->hide_form(qw(js path)); 184 185 $checked = "checked"; 186 for (sort { lc $login{$a} cmp lc $login{$b} } keys %{ $login }) { 187 print qq| 188 <br><input class=login type=radio name=login value=$_ $checked>$login->{$_} 189 |; 190 $checked = ""; 191 } 192 193 print qq| 194 </td> 195 </tr> 196 </table> 197 <br> 198 <input type=submit name=action value="|.$locale->text('Login').qq|"> 199 </td> 200 </tr> 201 </table> 202 203</form> 204 205 </td> 206 </tr> 207</table> 208 209</body> 210</html> 211|; 212 213 214} 215 216 217sub login { 218 219 $form->{stylesheet} = "sql-ledger.css"; 220 $form->{favicon} = "sql-ledger.ico"; 221 222 $form->error($locale->text('You did not enter a name!')) unless ($form->{login}); 223 224 if (! $form->{beenthere}) { 225 open(FH, "$memberfile") or $form->error("$memberfile : $!"); 226 @members = <FH>; 227 close(FH); 228 229 while (@members) { 230 $_ = shift @members; 231 if (/^\[(.*\@.*)\]/) { 232 $login = $1; 233 if ($login =~ /^\Q$form->{login}\E(\@|$)/) { 234 ($name, $dbname) = split /\@/, $login, 2; 235 $login{$login} = $dbname; 236 237 do { 238 if (/^company=/) { 239 (undef, $company) = split /=/, $_, 2; 240 chop $company; 241 $login{$login} = $company if $company; 242 } 243 $_ = shift @members; 244 } until /^\s+$/; 245 } 246 } 247 } 248 249 if (keys %login > 1) { 250 &selectdataset(\%login); 251 exit; 252 } else { 253 if ($form->{login} !~ /\@/) { 254 $form->{login} .= "\@$dbname"; 255 } 256 } 257 } 258 259 $user = new User $memberfile, $form->{login}; 260 261 # if we get an error back, bale out 262 if (($errno = $user->login(\%$form, $userspath)) <= -1) { 263 264 $errno *= -1; 265 $err[1] = $locale->text('Incorrect Username!'); 266 $err[2] = $locale->text('Incorrect Password!'); 267 $err[3] = $locale->text('Incorrect Dataset version!'); 268 $err[4] = $locale->text('Dataset is newer than version!'); 269 270 271 if ($errno == 1 && $form->{admin}) { 272 $err[1] = $locale->text('admin does not exist!'); 273 } 274 275 if ($errno == 4 && $form->{admin}) { 276 277 $form->info($err[4]); 278 279 $form->info("<p><a href=menu.pl?login=$form->{login}&path=$form->{path}&action=display&main=company_logo&js=$form->{js}&password=$form->{password}>".$locale->text('Continue')."</a>"); 280 281 exit; 282 283 } 284 285 if ($errno == 5) { 286 if (-f "$userspath/$user->{dbname}.LCK") { 287 if (-s "$userspath/$user->{dbname}.LCK") { 288 open(FH, "$userspath/$user->{dbname}.LCK"); 289 $msg = <FH>; 290 close(FH); 291 if ($form->{admin}) { 292 $form->info($msg); 293 } else { 294 $form->error($msg); 295 } 296 } else { 297 $msg = $locale->text('Dataset locked!'); 298 if ($form->{admin}) { 299 $form->info($msg); 300 } else { 301 $form->error($msg); 302 } 303 } 304 305 } else { 306 307 # upgrade dataset and log in again 308 open FH, ">$userspath/$user->{dbname}.LCK" or $form->error($!); 309 310 for (qw(dbname dbhost dbport dbdriver dbconnect dbuser dbpasswd)) { $form->{$_} = $user->{$_} } 311 312 $form->info($locale->text('Upgrading to Version')." $form->{version} ... "); 313 314 # required for Oracle 315 $form->{dbdefault} = $sid; 316 317 $user->dbupdate(\%$form); 318 319 # remove lock file 320 unlink "$userspath/$user->{dbname}.LCK"; 321 322 } 323 324 $form->info("<p><a href=menu.pl?login=$form->{login}&path=$form->{path}&action=display&main=company_logo&js=$form->{js}&password=$form->{password}>".$locale->text('Continue')."</a>"); 325 326 exit; 327 328 } 329 330 $form->error($err[$errno]); 331 332 } 333 334 for (qw(dbconnect dbhost dbport dbname dbuser dbpasswd)) { $myconfig{$_} = $user->{$_} } 335 336 # create image directory 337 if (! -d "$images/$myconfig{dbname}") { 338 mkdir "$images/$myconfig{dbname}", oct("771") or $form->error("$images/$myconfig{dbname} : $!"); 339 } 340 341 if ($user->{tan} && $sendmail) { 342 &email_tan; 343 exit; 344 } 345 346 # remove stale locks 347 $form->remove_locks(\%myconfig); 348 349 $form->{timeout} = $user->{timeout}; 350 $form->{sessioncookie} = $user->{sessioncookie}; 351 352 # made it this far, setup callback for the menu 353 $form->{callback} = "menu.pl?action=display"; 354 for (qw(login path password js sessioncookie)) { $form->{callback} .= "&$_=$form->{$_}" } 355 356 # check for recurring transactions 357 if ($user->{acs} !~ /Recurring Transactions/) { 358 if ($user->check_recurring(\%$form)) { 359 $form->{callback} .= "&main=recurring_transactions"; 360 } else { 361 $form->{callback} .= "&main=company_logo"; 362 } 363 } else { 364 $form->{callback} .= "&main=company_logo"; 365 } 366 367 $form->redirect; 368 369} 370 371 372sub logout { 373 374 $form->{callback} = "$form->{script}?path=$form->{path}&endsession=1"; 375 376 if (-f "$userspath/$form->{login}.conf") { 377 require "$userspath/$form->{login}.conf"; 378 $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; 379 380 User->logout(\%myconfig, \%$form); 381 } 382 383 $form->redirect; 384 385} 386 387 388sub email_tan { 389 390 $form->error($locale->text('No email address for')." $user->{name}") unless ($user->{email}); 391 392 use SL::Mailer; 393 $mail = new Mailer; 394 395 srand( time() ^ ($$ + ($$ << 15)) ); 396 $digits = "0123456789"; 397 $tan = ""; 398 while (length($tan) < 4) { 399 $tan .= substr($digits, (int(rand(length($digits)))), 1); 400 } 401 402 $mail->{message} = $locale->text('TAN').": $tan"; 403 $mail->{from} = $mail->{to} = qq|"$user->{name}" <$user->{email}>|; 404 $mail->{subject} = "SQL-Ledger $form->{version} $user->{company} $mail->{message}"; 405 406 407 $form->error($err) if ($err = $mail->send($sendmail)); 408 409 $form->{stylesheet} = $user->{stylesheet}; 410 $form->{favicon} = "sql-ledger.ico"; 411 $form->{nextsub} = "tan_login"; 412 413 $user->{password} = $tan; 414 415 $user->create_config("$userspath/$form->{login}.conf"); 416 417 418 $form->header; 419 420 print qq| 421 422<body class=login> 423 424<pre> 425 426</pre> 427 428<center> 429<table class=login border=3 cellpadding=20> 430 <tr> 431 <td class=login align=center><a href="http://www.sql-ledger.com" target=_blank><img src=$images/sql-ledger.png border=0></a> 432<h1 class=login align=center>|.$locale->text('Version').qq| $form->{version}</h1> 433<h1 class=login align=center>$user->{company}</h1> 434 435<p> 436 437 <form method=post action=$form->{script}> 438 439 <table width=100%> 440 <tr> 441 <td align=center> 442 <table> 443 <tr> 444 <th align=right>|.$locale->text('TAN').qq|</th> 445 <td><input class=login type=password name=password size=30></td> 446 </tr> 447 </table> 448 <br> 449 <input type=submit name=action value="|.$locale->text('Continue').qq|"> 450 </td> 451 </tr> 452 </table> 453|; 454 455 456 $form->hide_form(qw(nextsub js login path)); 457 458 print qq| 459 </form> 460 461 </td> 462 </tr> 463</table> 464 465</body> 466</html> 467|; 468 469} 470 471 472sub tan_login { 473 474 $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; 475 476 # check for user config file, could be missing or ??? 477 eval { require("$userspath/$form->{login}.conf"); }; 478 479 if ($@) { 480 $form->error($locale->text('Configuration file missing!')); 481 exit; 482 } 483 484 if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { 485 if (-f "$userspath/$form->{login}.tan") { 486 open(FH, "+<$userspath/$form->{login}.tan") or $form->error("$userspath/$form->{login}.tan : $!"); 487 488 $tries = <FH>; 489 $tries++; 490 491 seek(FH, 0, 0); 492 truncate(FH, 0); 493 print FH $tries; 494 close(FH); 495 496 if ($tries > 3) { 497 unlink "$userspath/$form->{login}.conf"; 498 unlink "$userspath/$form->{login}.tan"; 499 $form->error($locale->text('Maximum tries exceeded!')); 500 } 501 } else { 502 open(FH, ">$userspath/$form->{login}.tan") or $form->error("$userspath/$form->{login}.tan : $!"); 503 print FH "1"; 504 close(FH); 505 } 506 507 $form->error($locale->text('Invalid TAN')); 508 } else { 509 510 # remove stale locks 511 $form->remove_locks(\%myconfig); 512 513 unlink "$userspath/$form->{login}.tan"; 514 515 $form->{callback} = "menu.pl?action=display"; 516 for (qw(login path js password)) { $form->{callback} .= "&$_=$form->{$_}" } 517 $form->{callback} .= "&main=company_logo"; 518 519 $form->redirect; 520 521 } 522 523} 524 525 526sub continue { &{ $form->{nextsub} } }; 527 528