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