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