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