summaryrefslogtreecommitdiff
path: root/LedgerSMB/Session.pm
blob: d287d1996f80f79f66a765e22076c81d39204d9b (plain)
  1. #=====================================================================
  2. # LedgerSMB
  3. # Small Medium Business Accounting software
  4. #
  5. # See COPYRIGHT file for copyright information
  6. #======================================================================
  7. #
  8. # This file has undergone whitespace cleanup.
  9. #
  10. #======================================================================
  11. # This package contains session related functions:
  12. #
  13. # check - checks validity of session based on the user's cookie and login
  14. #
  15. # create - creates a new session, writes cookie upon success
  16. #
  17. # destroy - destroys session
  18. #====================================================================
  19. package Session;
  20. sub session_check {
  21. my ($cookie, $form, %myconfig) = @_;
  22. my ($sessionid, $token) = split /:/, $cookie;
  23. # connect to database
  24. my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd});
  25. my $checkQuery = $dbh->prepare("SELECT sl_login FROM session WHERE session_id = ? AND token = ? AND last_used > now() - ?::interval");
  26. my $updateAge = $dbh->prepare("UPDATE session SET last_used = now() WHERE session_id = ?;");
  27. #must be an integer
  28. $sessionid =~ s/[^0-9]//g;
  29. $sessionid = int $sessionid;
  30. #must be 32 chars long and contain hex chars
  31. $token =~ s/[^0-9a-f]//g;
  32. $token = substr($token, 0, 32);
  33. if (!$myconfig{timeout}){
  34. $timeout = "1 day";
  35. } else {
  36. $timeout = "$myconfig{timeout} seconds";
  37. }
  38. $checkQuery->execute($sessionid, $token, $timeout) || $form->dberror('Looking for session: ');
  39. my $sessionValid = $checkQuery->rows;
  40. if($sessionValid){
  41. #user has a valid session cookie, now check the user
  42. my ($sessionLogin) = $checkQuery->fetchrow_array;
  43. my $login = $form->{login};
  44. $login =~ s/[^a-zA-Z0-9@.-]//g;
  45. if($sessionLogin eq $login){
  46. $updateAge->execute($sessionid) || $form->dberror('Updating session age: ');
  47. return 1;
  48. } else {
  49. #something's wrong, they have the cookie, but wrong user. Hijack attempt?
  50. #delete the cookie in the browser
  51. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  52. return 0;
  53. }
  54. } else {
  55. #cookie is not valid
  56. #delete the cookie in the browser
  57. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  58. print qq|Set-Cookie: DiedHere=true; path=/;\n|;
  59. return 0;
  60. }
  61. }
  62. sub session_create {
  63. my ($form, %myconfig) = @_;
  64. # connect to database
  65. my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd});
  66. # TODO Change this to use %myconfig
  67. my $deleteExisting = $dbh->prepare("DELETE FROM session WHERE sl_login = ? AND age(last_used) > ?::interval");
  68. my $seedRandom = $dbh->prepare("SELECT setseed(?);");
  69. my $fetchSequence = $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());");
  70. my $createNew = $dbh->prepare("INSERT INTO session (session_id, sl_login, token) VALUES(?, ?, ?);");
  71. # this is assuming that $form->{login} is safe, which might be a bad assumption
  72. # so, I'm going to remove some chars, which might make previously valid logins invalid
  73. my $login = $form->{login};
  74. $login =~ s/[^a-zA-Z0-9@.-]//g;
  75. #delete any existing stale sessions with this login if they exist
  76. if (!$myconfig{timeout}){
  77. $myconfig{timeout} = 86400;
  78. }
  79. $deleteExisting->execute($login, "$myconfig{timeout} seconds") || $form->dberror('Delete from session: ');
  80. #doing the md5 and random stuff in the db so that LedgerSMB won't
  81. #require new perl modules (Digest::MD5 and a good random generator)
  82. $fetchSequence->execute() || $form->dberror('Fetch sequence id: ');
  83. my ($newSessionID, $newToken) = $fetchSequence->fetchrow_array;
  84. #create a new session
  85. $createNew->execute($newSessionID, $login, $newToken) || $form->dberror('Create new session: ');
  86. #reseed the random number generator
  87. my $randomSeed = 1.0 * ('0.'. (time() ^ ($$ + ($$ <<15))));
  88. $seedRandom->execute($randomSeed)|| $form->dberror('Reseed random generator: ');;
  89. $newCookieValue = $newSessionID . ':' . $newToken;
  90. #now set the cookie in the browser
  91. #TODO set domain from ENV, also set path to install path
  92. print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|;
  93. $form->{LedgerSMB} = $newCookieValue;
  94. }
  95. sub session_destroy {
  96. # Under the current architecture, this function is a bit problematic
  97. # %myconfig is often not defined when this function needs to be called.
  98. # which means that the db connection parameters are not available.
  99. # moving user prefs and the session table into a central db will solve this issue
  100. my ($form, %myconfig) = @_;
  101. my $login = $form->{login};
  102. $login =~ s/[^a-zA-Z0-9@.-]//g;
  103. # connect to database
  104. my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd});
  105. my $deleteExisting = $dbh->prepare("DELETE FROM session WHERE sl_login = ?;");
  106. $deleteExisting->execute($login) || $form->dberror('Delete from session: ');
  107. #delete the cookie in the browser
  108. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  109. }
  110. 1;