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