summaryrefslogtreecommitdiff
path: root/LedgerSMB/Session/DB.pm
blob: e488401531b19260bd6f93b776cf6e36d588520e (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. # password_check - compares the password with the stored cryted password
  28. # (ver. < 1.2) and the md5 one (ver. >= 1.2)
  29. #====================================================================
  30. package Session;
  31. sub session_check {
  32. use Time::HiRes qw(gettimeofday);
  33. my ( $cookie, $form ) = @_;
  34. my ( $sessionID, $transactionID, $token ) = split /:/, $cookie;
  35. # use the central database handle
  36. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  37. my $checkQuery = $dbh->prepare(
  38. "SELECT u.username, s.transaction_id
  39. FROM session as s, users as u
  40. WHERE s.session_id = ?
  41. AND s.users_id = u.id
  42. AND s.last_used > now() - ?::interval"
  43. );
  44. my $updateAge = $dbh->prepare(
  45. "UPDATE session
  46. SET last_used = now(),
  47. transaction_id = ?
  48. WHERE session_id = ?;"
  49. );
  50. #must be an integer
  51. $sessionID =~ s/[^0-9]//g;
  52. $sessionID = int $sessionID;
  53. $transactionID =~ s/[^0-9]//g;
  54. $transactionID = int $transactionID;
  55. #must be 32 chars long and contain hex chars
  56. $token =~ s/[^0-9a-f]//g;
  57. $token = substr( $token, 0, 32 );
  58. if ( !$myconfig{timeout} ) {
  59. $timeout = "1 day";
  60. }
  61. else {
  62. $timeout = "$myconfig{timeout} seconds";
  63. }
  64. $checkQuery->execute( $sessionID, $timeout )
  65. || $form->dberror(
  66. __FILE__ . ':' . __LINE__ . ': Looking for session: ' );
  67. my $sessionValid = $checkQuery->rows;
  68. if ($sessionValid) {
  69. #user has a valid session cookie, now check the user
  70. my ( $sessionLogin, $sessionTransaction ) = $checkQuery->fetchrow_array;
  71. my $login = $form->{login};
  72. $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
  73. if ( ( $sessionLogin eq $login )
  74. and ( $sessionTransaction eq $transactionID ) )
  75. {
  76. #microseconds are more than random enough for transaction_id
  77. my ( $ignore, $newTransactionID ) = gettimeofday();
  78. $newTransactionID = int $newTransactionID;
  79. $updateAge->execute( $newTransactionID, $sessionID )
  80. || $form->dberror(
  81. __FILE__ . ':' . __LINE__ . ': Updating session age: ' );
  82. $newCookieValue =
  83. $sessionID . ':' . $newTransactionID . ':' . $token;
  84. #now update the cookie in the browser
  85. print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|;
  86. return 1;
  87. }
  88. else {
  89. #something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt?
  90. #destroy the session
  91. my $sessionDestroy = $dbh->prepare("");
  92. #delete the cookie in the browser
  93. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  94. return 0;
  95. }
  96. }
  97. else {
  98. #cookie is not valid
  99. #delete the cookie in the browser
  100. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  101. return 0;
  102. }
  103. }
  104. sub session_create {
  105. use Time::HiRes qw(gettimeofday);
  106. #microseconds are more than random enough for transaction_id
  107. my ( $ignore, $newTransactionID ) = gettimeofday();
  108. $newTransactionID = int $newTransactionID;
  109. my ($form) = @_;
  110. if ( !$ENV{HTTP_HOST} ) {
  111. #don't create cookies or sessions for CLI use
  112. return 1;
  113. }
  114. # use the central database handle
  115. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  116. # TODO Change this to use %myconfig
  117. my $deleteExisting = $dbh->prepare(
  118. "DELETE
  119. FROM session
  120. WHERE session.users_id = (select id from users where username = ?)
  121. AND age(last_used) > ?::interval"
  122. );
  123. my $seedRandom = $dbh->prepare("SELECT setseed(?);");
  124. my $fetchSequence =
  125. $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());");
  126. my $createNew = $dbh->prepare(
  127. "INSERT INTO session (session_id, users_id, token, transaction_id)
  128. VALUES(?, (SELECT id
  129. FROM users
  130. WHERE username = ?), ?, ?);"
  131. );
  132. # this is assuming that $form->{login} is safe, which might be a bad assumption
  133. # so, I'm going to remove some chars, which might make previously valid logins invalid
  134. my $login = $form->{login};
  135. $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
  136. #delete any existing stale sessions with this login if they exist
  137. if ( !$myconfig{timeout} ) {
  138. $myconfig{timeout} = 86400;
  139. }
  140. $deleteExisting->execute( $login, "$myconfig{timeout} seconds" )
  141. || $form->dberror(
  142. __FILE__ . ':' . __LINE__ . ': Delete from session: ' );
  143. #doing the random stuff in the db so that LedgerSMB won't
  144. #require a good random generator - maybe this should be reviewed, pgsql's isn't great either
  145. $fetchSequence->execute()
  146. || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' );
  147. my ( $newSessionID, $newToken ) = $fetchSequence->fetchrow_array;
  148. #create a new session
  149. $createNew->execute( $newSessionID, $login, $newToken, $newTransactionID )
  150. || $form->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
  151. #reseed the random number generator
  152. my $randomSeed = 1.0 * ( '0.' . ( time() ^ ( $$ + ( $$ << 15 ) ) ) );
  153. $seedRandom->execute($randomSeed)
  154. || $form->dberror(
  155. __FILE__ . ':' . __LINE__ . ': Reseed random generator: ' );
  156. $newCookieValue = $newSessionID . ':' . $newTransactionID . ':' . $newToken;
  157. #now set the cookie in the browser
  158. #TODO set domain from ENV, also set path to install path
  159. print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|;
  160. $form->{LedgerSMB} = $newCookieValue;
  161. }
  162. sub session_destroy {
  163. my ($form) = @_;
  164. my $login = $form->{login};
  165. $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
  166. # use the central database handle
  167. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  168. my $deleteExisting = $dbh->prepare( "
  169. DELETE FROM session
  170. WHERE users_id = (select id from users where username = ?)
  171. " );
  172. $deleteExisting->execute($login)
  173. || $form->dberror(
  174. __FILE__ . ':' . __LINE__ . ': Delete from session: ' );
  175. #delete the cookie in the browser
  176. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  177. }
  178. sub password_check {
  179. use Digest::MD5;
  180. my ( $form, $username, $password ) = @_;
  181. $username =~ s/[^a-zA-Z0-9._+\@'-]//g;
  182. # use the central database handle
  183. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  184. my $fetchPassword = $dbh->prepare(
  185. "SELECT u.username, uc.password, uc.crypted_password
  186. FROM users as u, users_conf as uc
  187. WHERE u.username = ?
  188. AND u.id = uc.id;"
  189. );
  190. $fetchPassword->execute($username)
  191. || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' );
  192. my ( $dbusername, $md5Password, $cryptPassword ) =
  193. $fetchPassword->fetchrow_array;
  194. if ( $dbusername ne $username ) {
  195. # User data retrieved from db not for the requested user
  196. return 0;
  197. }
  198. elsif ($cryptPassword) {
  199. #First time login from old system, check crypted password
  200. if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword )
  201. {
  202. #password was good, convert to md5 password and null crypted
  203. my $updatePassword = $dbh->prepare(
  204. "UPDATE users_conf
  205. SET password = md5(?),
  206. crypted_password = null
  207. FROM users
  208. WHERE users_conf.id = users.id
  209. AND users.username = ?;"
  210. );
  211. $updatePassword->execute( $password, $username )
  212. || $form->dberror(
  213. __FILE__ . ':' . __LINE__ . ': Converting password : ' );
  214. return 1;
  215. }
  216. else {
  217. return 0; #password failed
  218. }
  219. }
  220. elsif ($md5Password) {
  221. if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) {
  222. return 0;
  223. }
  224. else {
  225. return 1;
  226. }
  227. }
  228. else {
  229. #both the md5Password and cryptPasswords were blank
  230. return 0;
  231. }
  232. }
  233. 1;