summaryrefslogtreecommitdiff
path: root/LedgerSMB/Auth/DB.pm
blob: ca5f01fa4799c326026bc6285c7b910715de04cb (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. 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. print STDERR "Creating Session\n";
  108. my $path = ($ENV{SCRIPT_NAME});
  109. $path =~ s|[^/]*$||;
  110. use Time::HiRes qw(gettimeofday);
  111. my $dbh = $lsmb->{dbh};
  112. my $login = $lsmb->{login};
  113. #microseconds are more than random enough for transaction_id
  114. my ( $ignore, $newTransactionID ) = gettimeofday();
  115. $newTransactionID = int $newTransactionID;
  116. if ( !$ENV{GATEWAY_INTERFACE} ) {
  117. #don't create cookies or sessions for CLI use
  118. return 1;
  119. }
  120. # TODO Change this to use %myconfig
  121. my $deleteExisting = $dbh->prepare(
  122. "DELETE
  123. FROM session
  124. WHERE session.users_id = (select id from users where username = ?)"
  125. );
  126. my $seedRandom = $dbh->prepare("SELECT setseed(?);");
  127. my $fetchSequence =
  128. $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());");
  129. my $createNew = $dbh->prepare(
  130. "INSERT INTO session (session_id, users_id, token, transaction_id)
  131. VALUES(?, (SELECT id
  132. FROM users
  133. WHERE username = ?), ?, ?);"
  134. );
  135. # this is assuming that the login is safe, which might be a bad assumption
  136. # so, I'm going to remove some chars, which might make previously valid
  137. # logins invalid --CM
  138. # I am changing this to use HTTP Basic Auth credentials for now. -- CT
  139. my $auth = $ENV{HTTP_AUTHORIZATION};
  140. $auth =~ s/^Basic //i;
  141. #delete any existing stale sessions with this login if they exist
  142. if ( !$lsmb->{timeout} ) {
  143. $lsmb->{timeout} = 86400;
  144. }
  145. $deleteExisting->execute( $login)
  146. || $lsmb->dberror(
  147. __FILE__ . ':' . __LINE__ . ': Delete from session: ' . $DBI::errstr);
  148. #doing the random stuff in the db so that LedgerSMB won't
  149. #require a good random generator - maybe this should be reviewed,
  150. #pgsql's isn't great either -CM
  151. #
  152. #I think we should be OK. The random number generator is only a small part
  153. #of the credentials in 1.3.x, and for people that need greater security, there
  154. #is always Kerberos.... -- CT
  155. $fetchSequence->execute()
  156. || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' );
  157. my ( $newSessionID, $newToken ) = $fetchSequence->fetchrow_array;
  158. #create a new session
  159. $createNew->execute( $newSessionID, $login, $newToken, $newTransactionID )
  160. || $lsmb->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' );
  161. #reseed the random number generator
  162. my $randomSeed = 1.0 * ( '0.' . ( time() ^ ( $$ + ( $$ << 15 ) ) ) );
  163. $seedRandom->execute($randomSeed)
  164. || $lsmb->dberror(
  165. __FILE__ . ':' . __LINE__ . ': Reseed random generator: ' );
  166. my $newCookieValue = $newSessionID . ':' . $newToken . ':'
  167. . $lsmb->{company};
  168. print STDERR "Breakpoint\n";
  169. #now set the cookie in the browser
  170. #TODO set domain from ENV, also set path to install path
  171. print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=$path;\n|;
  172. $lsmb->{LedgerSMB} = $newCookieValue;
  173. $lsmb->{dbh}->commit;
  174. }
  175. sub session_destroy {
  176. my ($form) = @_;
  177. my $login = $form->{login};
  178. $login =~ s/[^a-zA-Z0-9._+\@'-]//g;
  179. # use the central database handle
  180. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  181. my $deleteExisting = $dbh->prepare( "
  182. DELETE FROM session
  183. WHERE users_id = (select id from users where username = ?)
  184. " );
  185. $deleteExisting->execute($login)
  186. || $form->dberror(
  187. __FILE__ . ':' . __LINE__ . ': Delete from session: ' );
  188. #delete the cookie in the browser
  189. print qq|Set-Cookie: LedgerSMB=; path=/;\n|;
  190. }
  191. sub get_credentials {
  192. # Handling of HTTP Basic Auth headers
  193. my $auth = $ENV{'HTTP_AUTHORIZATION'};
  194. $auth =~ s/Basic //i; # strip out basic authentication preface
  195. $auth = MIME::Base64::decode($auth);
  196. my $return_value = {};
  197. ($return_value->{login}, $return_value->{password}) = split(/:/, $auth);
  198. return $return_value;
  199. }
  200. sub credential_prompt{
  201. print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n";
  202. print "Status: 401 Unauthorized\n\n";
  203. print "Please enter your credentials.\n";
  204. exit;
  205. }
  206. sub password_check {
  207. use Digest::MD5;
  208. my ( $form, $username, $password ) = @_;
  209. $username =~ s/[^a-zA-Z0-9._+\@'-]//g;
  210. # use the central database handle
  211. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  212. my $fetchPassword = $dbh->prepare(
  213. "SELECT u.username, uc.password, uc.crypted_password
  214. FROM users as u, users_conf as uc
  215. WHERE u.username = ?
  216. AND u.id = uc.id;"
  217. );
  218. $fetchPassword->execute($username)
  219. || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' );
  220. my ( $dbusername, $md5Password, $cryptPassword ) =
  221. $fetchPassword->fetchrow_array;
  222. if ( $dbusername ne $username ) {
  223. # User data retrieved from db not for the requested user
  224. return 0;
  225. }
  226. elsif ($cryptPassword) {
  227. #First time login from old system, check crypted password
  228. if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword )
  229. {
  230. #password was good, convert to md5 password and null crypted
  231. my $updatePassword = $dbh->prepare(
  232. "UPDATE users_conf
  233. SET password = md5(?),
  234. crypted_password = null
  235. FROM users
  236. WHERE users_conf.id = users.id
  237. AND users.username = ?;"
  238. );
  239. $updatePassword->execute( $password, $username )
  240. || $form->dberror(
  241. __FILE__ . ':' . __LINE__ . ': Converting password : ' );
  242. return 1;
  243. }
  244. else {
  245. return 0; #password failed
  246. }
  247. }
  248. elsif ($md5Password) {
  249. if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) {
  250. return 0;
  251. }
  252. else {
  253. return 1;
  254. }
  255. }
  256. else {
  257. #both the md5Password and cryptPasswords were blank
  258. return 0;
  259. }
  260. }
  261. 1;