summaryrefslogtreecommitdiff
path: root/scripts/login.pl
blob: ea0cf652033fdf384c87546ccb5bfcf3d862d60d (plain)
  1. package LedgerSMB::Scripts::login;
  2. our $VERSION = 1.0;
  3. use LedgerSMB::Locale;
  4. use LedgerSMB::Form; # Required for now to integrate with menu module.
  5. use LedgerSMB::User;
  6. use LedgerSMB::Auth;
  7. use strict;
  8. # this is kind of silly, as it doesn't check if someone IS trying to log in.
  9. # If one looks at the login template (get_password.html), it does not post
  10. # to any action, so this code will always get called, thereby preventing
  11. # anyone from actually logging in.
  12. sub __default {
  13. my ($request) = @_;
  14. my $locale;
  15. $locale = LedgerSMB::Locale->get_handle(${LedgerSMB::Sysconfig::language})
  16. or $request->error( __FILE__ . ':' . __LINE__ .
  17. ": Locale not loaded: $!\n" );
  18. $request->{stylesheet} = "ledgersmb.css";
  19. $request->{titlebar} = "LedgerSMB $request->{VERSION}";
  20. my $template = LedgerSMB::Template->new(
  21. user =>$request->{_user},
  22. locale => $locale,
  23. path => 'UI',
  24. template => 'login',
  25. format => 'HTML'
  26. );
  27. $template->render($request);
  28. }
  29. # Directly printing like this is made of fail.
  30. sub authenticate {
  31. my ($request) = @_;
  32. if (!$request->{dbh}){
  33. if (!$request->{company}){
  34. $request->{company} = $LedgerSMB::Sysconfig::default_db;
  35. }
  36. $request->_db_init;
  37. }
  38. my $path = $ENV{SCRIPT_NAME};
  39. $path =~ s|[^/]*$||;
  40. if ($request->{dbh} && $request->{next}) {
  41. print "Content-Type: text/html\n";
  42. print "Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=Login; path=$path\n";
  43. print "Status: 302 Found\n";
  44. print "Location: ".$path.$request->{next}."\n";
  45. print "\n";
  46. exit;
  47. }
  48. elsif ($request->{dbh} || $request->{log_out}){
  49. print "Content-Type: text/html\n";
  50. print "Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=Login; path=$path\n";
  51. print "Status: 200 Success\n\n";
  52. if ($request->{log_out}){
  53. exit;
  54. }
  55. }
  56. else {
  57. print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n";
  58. print "Status: 401 Unauthorized\n\n";
  59. print "Please enter your credentials.\n";
  60. exit;
  61. }
  62. }
  63. sub login {
  64. my ($request) = @_;
  65. if (!$request->{_user}){
  66. __default($request);
  67. }
  68. require "scripts/menu.pl";
  69. LedgerSMB::Scripts::menu::root_doc($request);
  70. }
  71. sub logout {
  72. my ($request) = @_;
  73. $request->{callback} = "";
  74. $request->{endsession} = 1;
  75. LedgerSMB::Auth::session_destroy($request);
  76. print "Location: login.pl\n";
  77. print "Content-type: text/html\n\n";
  78. exit;
  79. }
  80. sub continue {
  81. my ($request) = @_;
  82. if ($request->{next} && $request->{password}) {
  83. $request->{user} = "admin";
  84. if (&authenticate($request)) {
  85. # LedgerSMB::Handler::call_script();
  86. }
  87. }
  88. else {
  89. # well, wtf? This is kind of useless.
  90. $request->error("Cannot continue to a Nonexistent page.");
  91. }
  92. }
  93. eval { do "scripts/custom/login.pl"};
  94. 1;