1# $Id: AuthDBI.pm 1140245 2011-06-27 17:25:53Z phred $ 2package Apache::AuthDBI; 3 4$Apache::AuthDBI::VERSION = '1.11'; 5 6# 1: report about cache miss 7# 2: full debug output 8$Apache::AuthDBI::DEBUG = 0; 9 10use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION} 11 && $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0; 12 13BEGIN { 14 my @constants = qw( OK AUTH_REQUIRED FORBIDDEN DECLINED SERVER_ERROR ); 15 if (MP2) { 16 require Apache2::Access; 17 require Apache2::Const; 18 require Apache2::RequestRec; 19 require Apache2::RequestUtil; 20 require Apache2::Log; 21 import Apache2::Const @constants; 22 } 23 else { 24 require Apache::Constants; 25 import Apache::Constants @constants; 26 } 27} 28 29use strict; 30use DBI (); 31use Digest::SHA1 (); 32use Digest::MD5 (); 33 34sub debug { 35 print STDERR "$_[1]\n" if $_[0] <= $Apache::AuthDBI::DEBUG; 36} 37 38sub push_handlers { 39 if (MP2) { 40 require Apache2::ServerUtil; 41 my $s = Apache2::ServerUtil->server; 42 $s->push_handlers(@_); 43 } 44 else { 45 Apache->push_handlers(@_); 46 } 47} 48 49# configuration attributes, defaults will be overwritten with values 50# from .htaccess. 51my %Config = ( 52 'Auth_DBI_data_source' => '', 53 'Auth_DBI_username' => '', 54 'Auth_DBI_password' => '', 55 'Auth_DBI_pwd_table' => '', 56 'Auth_DBI_uid_field' => '', 57 'Auth_DBI_pwd_field' => '', 58 'Auth_DBI_pwd_whereclause' => '', 59 'Auth_DBI_grp_table' => '', 60 'Auth_DBI_grp_field' => '', 61 'Auth_DBI_grp_whereclause' => '', 62 'Auth_DBI_log_field' => '', 63 'Auth_DBI_log_string' => '', 64 'Auth_DBI_authoritative' => 'on', 65 'Auth_DBI_nopasswd' => 'off', 66 'Auth_DBI_encrypted' => 'on', 67 'Auth_DBI_encryption_salt' => 'password', 68 #Using Two (or more) Methods Will Allow for Fallback to older Methods 69 'Auth_DBI_encryption_method'=> 'sha1hex/md5/crypt', 70 'Auth_DBI_uidcasesensitive' => 'on', 71 'Auth_DBI_pwdcasesensitive' => 'on', 72 'Auth_DBI_placeholder' => 'off', 73 'Auth_DBI_expeditive' => 'on', 74 ); 75 76# stores the configuration of current URL. 77# initialized during authentication, eventually re-used for authorization. 78my $Attr = {}; 79 80# global cache: all records are put into one string. 81# record separator is a newline. Field separator is $;. 82# every record is a list of id, time of last access, password, groups 83#(authorization only). 84# the id is a comma separated list of user_id, data_source, pwd_table, 85# uid_field. 86# the first record is a timestamp, which indicates the last run of the 87# CleanupHandler followed by the child counter. 88my $Cache = time . "$;0\n"; 89 90# unique id which serves as key in $Cache. 91# the id is generated during authentication and re-used for authorization. 92my $ID; 93 94# minimum lifetimes of cache entries in seconds. 95# setting the CacheTime to 0 will not use the cache at all. 96my $CacheTime = 0; 97 98# supposed to be called in a startup script. 99# sets CacheTime to a user defined value. 100sub setCacheTime { 101 my $class = shift; 102 my $cache_time = shift; 103 104 # sanity check 105 $CacheTime = $cache_time if $cache_time =~ /\d+/; 106} 107 108# minimum time interval in seconds between two runs of the PerlCleanupHandler. 109# setting CleanupTime to 0 will run the PerlCleanupHandler after every request. 110# setting CleanupTime to a negative value will disable the PerlCleanupHandler. 111my $CleanupTime = -1; 112 113# supposed to be called in a startup script. 114# sets CleanupTime to a user defined value. 115sub setCleanupTime { 116 my $class = shift; 117 my $cleanup_time = shift; 118 119 # sanity check 120 $CleanupTime = $cleanup_time if $cleanup_time =~ /\-*\d+/; 121} 122 123# optionally the string with the global cache can be stored in a shared memory 124# segment. the segment will be created from the first child and it will be 125# destroyed if the last child exits. the reason for not handling everything 126# in the main server is simply, that there is no way to setup 127# an ExitHandler which runs in the main server and which would remove the 128# shared memory and the semaphore.hence we have to keep track about the 129# number of children, so that the last one can do all the cleanup. 130# creating the shared memory in the first child also has the advantage, 131# that we don't have to cope with changing the ownership. if a shm-function 132# fails, the global cache will automatically fall back to one string 133# per process. 134my $SHMKEY = 0; # unique key for shared memory segment and semaphore set 135my $SEMID = 0; # id of semaphore set 136my $SHMID = 0; # id of shared memory segment 137my $SHMSIZE = 50000; # default size of shared memory segment 138my $SHMPROJID = 1; # default project id for shared memory segment 139 140# Supposed to be called in a startup script. 141# Sets SHMPROJID to a user defined value 142sub setProjID { 143 my $class = shift; 144 my $shmprojid = shift; 145 146 #Set ProjID prior to calling initIPC! 147 return if $SHMKEY; 148 149 # sanity check - Must be numeric and less than or equal to 255 150 $SHMPROJID = int($shmprojid) 151 if $shmprojid =~ /\d{1,3}/ && $shmprojid <= 255 && $shmprojid > 0; 152} 153 154# shortcuts for semaphores 155my $obtain_lock = pack("sss", 0, 0, 0) . pack("sss", 0, 1, 0); 156my $release_lock = pack("sss", 0, -1, 0); 157 158# supposed to be called in a startup script. 159# sets SHMSIZE to a user defined value and initializes the unique key, 160# used for the shared memory segment and for the semaphore set. 161# creates a PerlChildInitHandler which creates the shared memory segment 162# and the semaphore set. creates a PerlChildExitHandler which removes 163# the shared memory segment and the semaphore set upon server shutdown. 164# keep in mind, that this routine runs only once, when the main server 165#starts up. 166sub initIPC { 167 my $class = shift; 168 my $shmsize = shift; 169 170 require IPC::SysV; 171 172 # make sure, this method is called only once 173 return if $SHMKEY; 174 175 # ensure minimum size of shared memory segment 176 $SHMSIZE = $shmsize if $shmsize >= 500; 177 178 # generate unique key based on path of AuthDBI.pm + SHMPROJID 179 foreach my $file (keys %INC) { 180 if ($file eq 'Apache/AuthDBI.pm') { 181 $SHMKEY = IPC::SysV::ftok($INC{$file}, $SHMPROJID); 182 last; 183 } 184 } 185 186 # provide a handler which initializes the shared memory segment 187 #(first child) or which increments the child counter. 188 push_handlers(PerlChildInitHandler => \&childinit); 189 190 # provide a handler which decrements the child count or which 191 # destroys the shared memory 192 # segment upon server shutdown, which is defined by the exit of the 193 # last child. 194 push_handlers(PerlChildExitHandler => \&childexit); 195} 196 197# authentication handler 198sub authen { 199 my ($r) = @_; 200 201 my ($key, $val, $dbh); 202 my $prefix = "$$ Apache::AuthDBI::authen"; 203 204 if ($Apache::AuthDBI::DEBUG > 1) { 205 my $type = ''; 206 if (MP2) { 207 $type .= 'initial ' if $r->is_initial_req(); 208 $type .= 'main' if $r->main(); 209 } 210 else { 211 $type .= 'initial ' if $r->is_initial_req; 212 $type .= 'main' if $r->is_main; 213 } 214 debug (1, "==========\n$prefix request type = >$type<"); 215 } 216 217 return MP2 ? Apache2::Const::OK() : Apache::Constants::OK() 218 unless $r->is_initial_req; # only the first internal request 219 220 debug (2, "REQUEST:" . $r->as_string); 221 222 # here the dialog pops up and asks you for username and password 223 my ($res, $passwd_sent) = $r->get_basic_auth_pw; 224 { 225 no warnings qw(uninitialized); 226 debug (2, "$prefix get_basic_auth_pw: res = >$res<, password sent = >$passwd_sent<"); 227 } 228 return $res if $res; # e.g. HTTP_UNAUTHORIZED 229 230 # get username 231 my $user_sent = $r->user; 232 debug(2, "$prefix user sent = >$user_sent<"); 233 234 # do we use shared memory for the global cache ? 235 debug (2, "$prefix cache in shared memory, shmid $SHMID, shmsize $SHMSIZE, semid $SEMID"); 236 237 # get configuration 238 while(($key, $val) = each %Config) { 239 $val = $r->dir_config($key) || $val; 240 $key =~ s/^Auth_DBI_//; 241 $Attr->{$key} = $val; 242 debug(2, sprintf("$prefix Config{ %-16s } = %s", $key, $val)); 243 } 244 245 # parse connect attributes, which may be tilde separated lists 246 my @data_sources = split /~/, $Attr->{data_source}; 247 my @usernames = split /~/, $Attr->{username}; 248 my @passwords = split /~/, $Attr->{password}; 249 # use ENV{DBI_DSN} if not defined 250 $data_sources[0] = '' unless $data_sources[0]; 251 252 # obtain the id for the cache 253 # remove any embedded attributes, because of trouble with regexps 254 my $data_src = $Attr->{data_source}; 255 $data_src =~ s/\(.+\)//g; 256 257 $ID = join ',', 258 $user_sent, $data_src, $Attr->{pwd_table}, $Attr->{uid_field}; 259 260 # if not configured decline 261 unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{pwd_field}) { 262 debug (2, "$prefix not configured, return DECLINED"); 263 return MP2 ? Apache2::Const::DECLINED() : 264 Apache::Constants::DECLINED(); 265 } 266 267 # do we want Windows-like case-insensitivity? 268 $user_sent = lc $user_sent if $Attr->{uidcasesensitive} eq "off"; 269 $passwd_sent = lc $passwd_sent if $Attr->{pwdcasesensitive} eq "off"; 270 271 # check whether the user is cached but consider that the password 272 # possibly has changed 273 my $passwd = ''; 274 if ($CacheTime) { # do we use the cache ? 275 if ($SHMID) { # do we keep the cache in shared memory ? 276 semop($SEMID, $obtain_lock) 277 or warn "$prefix semop failed \n"; 278 shmread($SHMID, $Cache, 0, $SHMSIZE) 279 or warn "$prefix shmread failed \n"; 280 substr($Cache, index($Cache, "\0")) = ''; 281 semop($SEMID, $release_lock) 282 or warn "$prefix semop failed \n"; 283 } 284 # find id in cache 285 my ($last_access, $passwd_cached, $groups_cached); 286 if ($Cache =~ /$ID$;(\d+)$;(.+)$;(.*)\n/) { 287 $last_access = $1; 288 $passwd_cached = $2; 289 $groups_cached = $3; 290 debug(2, "$prefix cache: found >$ID< >$last_access< >$passwd_cached<"); 291 292 my @passwds_to_check = 293 &get_passwds_to_check( 294 $Attr, 295 user_sent => $user_sent, 296 passwd_sent => $passwd_sent, 297 password => $passwd_cached 298 ); 299 300 debug(2, "$prefix " . scalar(@passwds_to_check) . " passwords to check"); 301 foreach my $passwd_to_check (@passwds_to_check) { 302 # match cached password with password sent 303 $passwd = $passwd_cached if $passwd_to_check eq $passwd_cached; 304 last if $passwd; 305 } 306 } 307 } 308 309 # found in cache 310 if ($passwd) { 311 debug(2, "$prefix passwd found in cache"); 312 } 313 else { 314 # password not cached or changed 315 debug (2, "$prefix passwd not found in cache"); 316 317 # connect to database, use all data_sources until the connect succeeds 318 for (my $j = 0; $j <= $#data_sources; $j++) { 319 last if ( 320 $dbh = DBI->connect( 321 $data_sources[$j], 322 $usernames[$j], 323 $passwords[$j] 324 ) 325 ); 326 } 327 unless ($dbh) { 328 $r->log_reason( 329 "$prefix db connect error with data_source " . 330 ">$Attr->{data_source}<: $DBI::errstr", 331 $r->uri 332 ); 333 return MP2 ? Apache2::Const::SERVER_ERROR() : 334 Apache::Constants::SERVER_ERROR(); 335 } 336 337 # generate statement 338 my $user_sent_quoted = $dbh->quote($user_sent); 339 my $select = "SELECT $Attr->{pwd_field}"; 340 my $from = "FROM $Attr->{pwd_table}"; 341 my $where = ($Attr->{uidcasesensitive} eq "off") ? 342 "WHERE lower($Attr->{uid_field}) =" : 343 "WHERE $Attr->{uid_field} ="; 344 my $compare = ($Attr->{placeholder} eq "on") ? 345 "?" : "$user_sent_quoted"; 346 my $statement = "$select $from $where $compare"; 347 $statement .= " AND $Attr->{pwd_whereclause}" 348 if $Attr->{pwd_whereclause}; 349 350 debug(2, "$prefix statement: $statement"); 351 352 # prepare statement 353 my $sth; 354 unless ($sth = $dbh->prepare($statement)) { 355 $r->log_reason("$prefix can not prepare statement: $DBI::errstr", $r->uri); 356 $dbh->disconnect; 357 return MP2 ? Apache2::Const::SERVER_ERROR() : 358 Apache::Constants::SERVER_ERROR(); 359 } 360 361 # execute statement 362 my $rv; 363 unless ($rv = ($Attr->{placeholder} eq "on") ? 364 $sth->execute($user_sent) : $sth->execute) { 365 $r->log_reason("$prefix can not execute statement: $DBI::errstr", $r->uri); 366 $dbh->disconnect; 367 return MP2 ? Apache2::Const::SERVER_ERROR() : 368 Apache::Constants::SERVER_ERROR(); 369 } 370 371 my $password; 372 $sth->execute(); 373 $sth->bind_columns(\$password); 374 my $cnt = 0; 375 while ($sth->fetch()) { 376 $password =~ s/ +$// if $password; 377 $passwd .= "$password$;"; 378 $cnt++; 379 } 380 381 chop $passwd if $passwd; 382 # so we can distinguish later on between no password and empty password 383 undef $passwd if 0 == $cnt; 384 385 if ($sth->err) { 386 $dbh->disconnect; 387 return MP2 ? Apache2::Const::SERVER_ERROR() : 388 Apache::Constants::SERVER_ERROR(); 389 } 390 $sth->finish; 391 392 # re-use dbh for logging option below 393 $dbh->disconnect unless $Attr->{log_field} && $Attr->{log_string}; 394 } 395 396 $r->subprocess_env(REMOTE_PASSWORDS => $passwd); 397 debug(2, "$prefix passwd = >$passwd<"); 398 399 # check if password is needed 400 unless ($passwd) { # not found in database 401 # if authoritative insist that user is in database 402 if ($Attr->{authoritative} eq 'on') { 403 $r->log_reason("$prefix password for user $user_sent not found", $r->uri); 404 $r->note_basic_auth_failure; 405 return MP2 ? Apache2::Const::AUTH_REQUIRED() : 406 Apache::Constants::AUTH_REQUIRED(); 407 } 408 else { 409 # else pass control to the next authentication module 410 return MP2 ? Apache2::Const::DECLINED() : 411 Apache::Constants::DECLINED(); 412 } 413 } 414 415 # allow any password if nopasswd = on and the retrieved password is empty 416 if ($Attr->{nopasswd} eq 'on' && !$passwd) { 417 return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); 418 } 419 420 # if nopasswd is off, reject user 421 unless ($passwd_sent && $passwd) { 422 $r->log_reason("$prefix user $user_sent: empty password(s) rejected", $r->uri); 423 $r->note_basic_auth_failure; 424 return MP2 ? Apache2::Const::AUTH_REQUIRED() : 425 Apache::Constants::AUTH_REQUIRED(); 426 } 427 428 # compare passwords 429 my $found = 0; 430 foreach my $password (split /$;/, $passwd) { 431 # compare all the passwords using as many encryption methods 432 # in fallback as needed 433 my @passwds_to_check = 434 &get_passwds_to_check( 435 $Attr, 436 user_sent => $user_sent, 437 passwd_sent => $passwd_sent, 438 password => $password 439 ); 440 441 debug (2, "$prefix " . scalar(@passwds_to_check) . " passwords to check"); 442 443 foreach my $passwd_to_check (@passwds_to_check) { 444 debug( 445 2, 446 "$prefix user $user_sent: Password after Preparation " . 447 ">$passwd_to_check< - trying for a match with >$password<" 448 ); 449 450 if ($passwd_to_check eq $password) { 451 $found = 1; 452 $r->subprocess_env(REMOTE_PASSWORD => $password); 453 debug ( 454 2, 455 "$prefix user $user_sent: Password from Web Server " . 456 ">$passwd_sent< - Password after Preparation >$passwd_to_check< - " . 457 "password match for >$password<" 458 ); 459 460 # update timestamp and cache userid/password if CacheTime 461 # is configured 462 if ($CacheTime) { # do we use the cache ? 463 if ($SHMID) { # do we keep the cache in shared memory ? 464 semop($SEMID, $obtain_lock) 465 or warn "$prefix semop failed \n"; 466 shmread($SHMID, $Cache, 0, $SHMSIZE) 467 or warn "$prefix shmread failed \n"; 468 substr($Cache, index($Cache, "\0")) = ''; 469 } 470 471 # update timestamp and password or append new record 472 my $now = time; 473 if (!($Cache =~ s/$ID$;\d+$;.*$;(.*)\n/$ID$;$now$;$password$;$1\n/)) { 474 $Cache .= "$ID$;$now$;$password$;\n"; 475 } 476 477 if ($SHMID) { # write cache to shared memory 478 shmwrite($SHMID, $Cache, 0, $SHMSIZE) 479 or warn "$prefix shmwrite failed \n"; 480 semop($SEMID, $release_lock) 481 or warn "$prefix semop failed \n"; 482 } 483 } 484 last; 485 } 486 } 487 488 #if the passwd matched (encrypted or otherwise), don't check the 489 # myriad other passwords that may or may not exist 490 last if $found > 0 ; 491 } 492 493 unless ($found) { 494 $r->log_reason("$prefix user $user_sent: password mismatch", $r->uri); 495 $r->note_basic_auth_failure; 496 return MP2 ? Apache2::Const::AUTH_REQUIRED() : 497 Apache::Constants::AUTH_REQUIRED(); 498 } 499 500 # logging option 501 if ($Attr->{log_field} && $Attr->{log_string}) { 502 if (!$dbh) { # connect to database if not already done 503 my $connect; 504 for (my $j = 0; $j <= $#data_sources; $j++) { 505 if ($dbh = DBI->connect( 506 $data_sources[$j], 507 $usernames[$j], 508 $passwords[$j] 509 )) { 510 $connect = 1; 511 last; 512 } 513 } 514 unless ($connect) { 515 $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri); 516 return MP2 ? Apache2::Const::SERVER_ERROR() : 517 Apache::Constants::SERVER_ERROR(); 518 } 519 } 520 my $user_sent_quoted = $dbh->quote($user_sent); 521 my $statement = "UPDATE $Attr->{pwd_table} SET $Attr->{log_field} = " . 522 "$Attr->{log_string} WHERE $Attr->{uid_field}=$user_sent_quoted"; 523 524 debug(2, "$prefix statement: $statement"); 525 526 unless ($dbh->do($statement)) { 527 $r->log_reason("$prefix can not do statement: $DBI::errstr", $r->uri); 528 $dbh->disconnect; 529 return MP2 ? Apache2::Const::SERVER_ERROR() : 530 Apache::Constants::SERVER_ERROR(); 531 } 532 $dbh->disconnect; 533 } 534 535 # Unless the cache or the CleanupHandler is disabled, the 536 # CleanupHandler is initiated if the last run was more than 537 # $CleanupTime seconds before. 538 # Note, that it runs after the request, hence it cleans also the 539 # authorization entries 540 if ($CacheTime and $CleanupTime >= 0) { 541 my $diff = time - substr $Cache, 0, index($Cache, "$;"); 542 debug( 543 2, 544 "$prefix secs since last CleanupHandler: $diff, CleanupTime: " . 545 "$CleanupTime" 546 ); 547 548 if ($diff > $CleanupTime) { 549 debug (2, "$prefix push PerlCleanupHandler"); 550 push_handlers(PerlCleanupHandler => \&cleanup); 551 } 552 } 553 554 debug (2, "$prefix return OK\n"); 555 return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); 556} 557 558#Encrypts a password in all supported/requested methods and passes back 559#array for comparison 560sub get_passwds_to_check { 561 my $Attr = shift; 562 my %params = @_; 563 564 565 my ($prefix) = "$$ Apache::AuthDBI::get_passwds_to_check "; 566 567 my ($salt, @passwds_to_check); 568 569 if ($Attr->{encrypted} eq 'on') { 570 #SHA1 571 if ($Attr->{encryption_method} =~ /(^|\/)sha1hex($|\/)/i) { 572 push @passwds_to_check, SHA1_digest( 573 text => $params{'passwd_sent'}, 574 format => 'hex' 575 ); 576 } 577 578 #MD5 579 if ($Attr->{encryption_method} =~ /(^|\/)md5hex($|\/)/i) { 580 push @passwds_to_check, MD5_digest( 581 text => $params{'passwd_sent'}, 582 format => 'hex' 583 ); 584 } 585 586 #CRYPT 587 if ($Attr->{encryption_method} =~ /(^|\/)crypt($|\/)/i) { 588 $salt = $Attr->{encryption_salt} eq 'userid' ? 589 $params{'user_sent'} : $params{'password'}; 590 #Bug Fix in v0.94 (marked as 0.93 in file. salt was NOT being sent 591 # to crypt) - KAM - 06-16-2005 592 push @passwds_to_check, crypt($params{'passwd_sent'}, $salt); 593 } 594 595 #WE DIDN'T GET ANY PASSWORDS TO CHECK. MUST BE A PROBLEM 596 if (scalar(@passwds_to_check) < 1) { 597 debug (2, "$prefix Error: No Valid Encryption Method Specified"); 598 } 599 } 600 else { 601 #IF NO ENCRYPTION, JUST PUSH THE CLEARTEXT PASS 602 push @passwds_to_check, $params{'passwd_sent'}; 603 } 604 605 return (@passwds_to_check); 606} 607 608# authorization handler, it is called immediately after the authentication 609sub authz { 610 my $r = shift; 611 612 my ($key, $val, $dbh); 613 my $prefix = "$$ Apache::AuthDBI::authz "; 614 615 if ($Apache::AuthDBI::DEBUG > 1) { 616 my $type = ''; 617 if (MP2) { 618 $type .= 'initial ' if $r->is_initial_req(); 619 $type .= 'main' if $r->main(); 620 } 621 else { 622 $type .= 'initial ' if $r->is_initial_req; 623 $type .= 'main' if $r->is_main; 624 } 625 debug(1, "==========\n$prefix request type = >$type<"); 626 } 627 628 # only the first internal request 629 unless ($r->is_initial_req) { 630 return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); 631 } 632 633 my $user_result = MP2 ? Apache2::Const::DECLINED() : 634 Apache::Constants::DECLINED(); 635 my $group_result = MP2 ? Apache2::Const::DECLINED() : 636 Apache::Constants::DECLINED(); 637 638 # get username 639 my $user_sent = $r->user; 640 debug(2, "$prefix user sent = >$user_sent<"); 641 642 # here we could read the configuration, but we re-use the configuration 643 # from the authentication 644 645 # parse connect attributes, which may be tilde separated lists 646 my @data_sources = split /~/, $Attr->{data_source}; 647 my @usernames = split /~/, $Attr->{username}; 648 my @passwords = split /~/, $Attr->{password}; 649 # use ENV{DBI_DSN} if not defined 650 $data_sources[0] = '' unless $data_sources[0]; 651 652 # if not configured decline 653 unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) { 654 debug(2, "$prefix not configured, return DECLINED"); 655 return MP2 ? Apache2::Const::DECLINED() : 656 Apache::Constants::DECLINED(); 657 } 658 659 # do we want Windows-like case-insensitivity? 660 $user_sent = lc $user_sent if $Attr->{uidcasesensitive} eq "off"; 661 662 # select code to return if authorization is denied: 663 my $authz_denied; 664 if (MP2) { 665 $authz_denied = $Attr->{expeditive} eq 'on' ? 666 Apache2::Const::FORBIDDEN() : Apache2::Const::AUTH_REQUIRED(); 667 } 668 else { 669 $authz_denied = $Attr->{expeditive} eq 'on' ? 670 Apache::Constants::FORBIDDEN() : Apache::Constants::AUTH_REQUIRED(); 671 } 672 673 # check if requirements exists 674 my $ary_ref = $r->requires; 675 unless ($ary_ref) { 676 if ($Attr->{authoritative} eq 'on') { 677 $r->log_reason("user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri); 678 if ($authz_denied == (MP2 ? Apache2::Const::AUTH_REQUIRED() : 679 Apache::Constants::AUTH_REQUIRED())) { 680 $r->note_basic_auth_failure; 681 } 682 return $authz_denied; 683 } 684 debug (2, "$prefix no requirements and not authoritative, return DECLINED"); 685 return MP2 ? Apache2::Const::DECLINED() : 686 Apache::Constants::DECLINED(); 687 } 688 689 # iterate over all requirement directives and store them according to 690 # their type (valid-user, user, group) 691 my($valid_user, $user_requirements, $group_requirements); 692 foreach my $hash_ref (@$ary_ref) { 693 while (($key,$val) = each %$hash_ref) { 694 last if $key eq 'requirement'; 695 } 696 $val =~ s/^\s*require\s+//; 697 698 # handle different requirement-types 699 if ($val =~ /valid-user/) { 700 $valid_user = 1; 701 } 702 elsif ($val =~ s/^user\s+//g) { 703 $user_requirements .= " $val"; 704 } 705 elsif ($val =~ s/^group\s+//g) { 706 $group_requirements .= " $val"; 707 } 708 } 709 $user_requirements =~ s/^ //g if $user_requirements; 710 $group_requirements =~ s/^ //g if $group_requirements; 711 712 { 713 no warnings qw(uninitialized); 714 715 debug( 716 2, 717 "$prefix requirements: [valid-user=>$valid_user<] [user=>" . 718 "$user_requirements<] [group=>$group_requirements<]" 719 ); 720 } 721 722 # check for valid-user 723 if ($valid_user) { 724 $user_result = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); 725 debug(2, "$prefix user_result = OK: valid-user"); 726 } 727 728 # check for users 729 if (($user_result != (MP2 ? Apache2::Const::OK() : 730 Apache::Constants::OK())) && $user_requirements) { 731 732 $user_result = MP2 ? Apache2::Const::AUTH_REQUIRED() : 733 Apache::Constants::AUTH_REQUIRED(); 734 735 foreach my $user_required (split /\s+/, $user_requirements) { 736 if ($user_required eq $user_sent) { 737 debug (2, "$prefix user_result = OK for $user_required"); 738 $user_result = MP2 ? Apache2::Const::OK() : 739 Apache::Constants::OK(); 740 last; 741 } 742 } 743 } 744 745 my $user_result_valid = MP2 ? Apache2::Const::OK() : 746 Apache::Constants::OK(); 747 748 # check for groups 749 if ($user_result != $user_result_valid && $group_requirements) { 750 debug(2, "$prefix: checking for groups >$group_requirements<"); 751 $group_result = MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); 752 my $group; 753 754 # check whether the user is cached but consider that the group 755 # possibly has changed 756 my $groups = ''; 757 if ($CacheTime) { # do we use the cache ? 758 # we need to get the cached groups for the current id, 759 # which has been read already 760 # during authentication, so we do not read the Cache from 761 # shared memory again 762 my ($last_access, $passwd_cached, $groups_cached); 763 if ($Cache =~ /$ID$;(\d+)$;(.*)$;(.+)\n/) { 764 $last_access = $1; 765 $passwd_cached = $2; 766 $groups_cached = $3; 767 debug(2, "$prefix cache: found >$ID< >$last_access< >$groups_cached"); 768 769 REQUIRE_1: 770 foreach my $group_required (split /\s+/, $group_requirements) { 771 foreach $group (split(/,/, $groups_cached)) { 772 if ($group_required eq $group) { 773 $groups = $groups_cached; 774 last REQUIRE_1; 775 } 776 } 777 } 778 } 779 } 780 781 # found in cache 782 if ($groups) { 783 debug(2, "$prefix groups found in cache"); 784 } 785 else { 786 # groups not cached or changed 787 debug(2, "$prefix groups not found in cache"); 788 789 # connect to database, use all data_sources until the connect 790 # succeeds 791 my $connect; 792 for (my $j = 0; $j <= $#data_sources; $j++) { 793 if ($dbh = DBI->connect( 794 $data_sources[$j], 795 $usernames[$j], 796 $passwords[$j] 797 )) { 798 $connect = 1; 799 last; 800 } 801 } 802 unless ($connect) { 803 $r->log_reason( 804 "$prefix db connect error with " . 805 "$Attr->{data_source}", 806 $r->uri 807 ); 808 return MP2 ? Apache2::Const::SERVER_ERROR() : 809 Apache::Constants::SERVER_ERROR(); 810 } 811 812 # generate statement 813 my $user_sent_quoted = $dbh->quote($user_sent); 814 my $select = "SELECT $Attr->{grp_field}"; 815 my $from = ($Attr->{grp_table}) ? 816 "FROM $Attr->{grp_table}" : "FROM $Attr->{pwd_table}"; 817 my $where = ($Attr->{uidcasesensitive} eq "off") ? 818 "WHERE lower($Attr->{uid_field}) =" : 819 "WHERE $Attr->{uid_field} ="; 820 my $compare = ($Attr->{placeholder} eq "on") ? 821 "?" : "$user_sent_quoted"; 822 my $statement = "$select $from $where $compare"; 823 $statement .= " AND $Attr->{grp_whereclause}" 824 if ($Attr->{grp_whereclause}); 825 826 debug(2, "$prefix statement: $statement"); 827 828 # prepare statement 829 my $sth; 830 unless ($sth = $dbh->prepare($statement)) { 831 $r->log_reason( 832 "can not prepare statement: $DBI::errstr", 833 $r->uri 834 ); 835 $dbh->disconnect; 836 return MP2 ? Apache2::Const::SERVER_ERROR() : 837 Apache::Constants::SERVER_ERROR(); 838 } 839 840 # execute statement 841 my $rv; 842 unless ($rv = ($Attr->{placeholder} eq "on") ? 843 $sth->execute($user_sent) : $sth->execute) { 844 $r->log_reason( 845 "can not execute statement: $DBI::errstr", 846 $r->uri 847 ); 848 $dbh->disconnect; 849 return MP2 ? Apache2::Const::SERVER_ERROR() : 850 Apache::Constants::SERVER_ERROR(); 851 } 852 853 # fetch result and build a group-list 854 # strip trailing blanks for fixed-length data-type 855 while (my $group = $sth->fetchrow_array) { 856 $group =~ s/ +$//; 857 $groups .= "$group,"; 858 } 859 chop $groups if $groups; 860 861 $sth->finish; 862 $dbh->disconnect; 863 } 864 865 $r->subprocess_env(REMOTE_GROUPS => $groups); 866 debug(2, "$prefix groups = >$groups<\n"); 867 868 # skip through the required groups until the first matches 869 REQUIRE_2: 870 foreach my $group_required (split /\s+/, $group_requirements) { 871 foreach my $group (split(/,/, $groups)) { 872 # check group 873 if ($group_required eq $group) { 874 $group_result = MP2 ? Apache2::Const::OK() : 875 Apache::Constants::OK(); 876 $r->subprocess_env(REMOTE_GROUP => $group); 877 878 debug( 879 2, 880 "$prefix user $user_sent: group_result = OK " . 881 "for >$group<" 882 ); 883 884 # update timestamp and cache userid/groups if 885 # CacheTime is configured 886 if ($CacheTime) { # do we use the cache ? 887 if ($SHMID) { # do we keep the cache in shared memory ? 888 semop($SEMID, $obtain_lock) 889 or warn "$prefix semop failed \n"; 890 shmread($SHMID, $Cache, 0, $SHMSIZE) 891 or warn "$prefix shmread failed \n"; 892 substr($Cache, index($Cache, "\0")) = ''; 893 } 894 895 # update timestamp and groups 896 my $now = time; 897 # entry must exists from authentication 898 $Cache =~ s/$ID$;\d+$;(.*)$;.*\n/$ID$;$now$;$1$;$groups\n/; 899 if ($SHMID) { # write cache to shared memory 900 shmwrite($SHMID, $Cache, 0, $SHMSIZE) 901 or warn "$prefix shmwrite failed \n"; 902 semop($SEMID, $release_lock) 903 or warn "$prefix semop failed \n"; 904 } 905 } 906 last REQUIRE_2; 907 } 908 } 909 } 910 } 911 912 # check the results of the requirement checks 913 if ($Attr->{authoritative} eq 'on' && 914 ( 915 $user_result != (MP2 ? 916 Apache2::Const::OK() : 917 Apache::Constants::OK()) 918 ) 919 && ( 920 $group_result != (MP2 ? Apache2::Const::OK() : 921 Apache::Constants::OK()) 922 ) 923 ) { 924 my $reason; 925 if ($user_result == (MP2 ? Apache2::Const::AUTH_REQUIRED() : 926 Apache::Constants::AUTH_REQUIRED())) { 927 $reason .= " USER"; 928 } 929 if ($group_result == (MP2 ? Apache2::Const::AUTH_REQUIRED() : 930 Apache::Constants::AUTH_REQUIRED())) { 931 $reason .= " GROUP"; 932 } 933 $r->log_reason( 934 "DBI-Authoritative: Access denied on $reason rule(s)", 935 $r->uri 936 ); 937 938 if ($authz_denied == (MP2 ? Apache2::Const::AUTH_REQUIRED() : 939 Apache::Constants::AUTH_REQUIRED())) { 940 $r->note_basic_auth_failure; 941 } 942 943 return $authz_denied; 944 } 945 946 # return OK if authorization was successful 947 my $success = MP2 ? Apache2::Const::OK() : 948 Apache::Constants::OK(); 949 my $declined = MP2 ? Apache2::Const::DECLINED() : 950 Apache::Constants::DECLINED(); 951 952 if ( 953 ($user_result != $declined && $user_result == $success) 954 || 955 ($group_result != $declined && $group_result == $success) 956 ) { 957 debug(2, "$prefix return OK"); 958 return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); 959 } 960 961 # otherwise fall through 962 debug(2, "$prefix fall through, return DECLINED"); 963 return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); 964} 965 966sub dec2hex { 967 my $dec = shift; 968 969 return sprintf("%lx", $dec); 970} 971 972# The PerlChildInitHandler initializes the shared memory segment (first child) 973# or increments the child counter. 974# Note: this handler runs in every child server, but not in the main server. 975# create (or re-use existing) semaphore set 976sub childinit { 977 978 my $prefix = "$$ Apache::AuthDBI PerlChildInitHandler"; 979 980 my $SHMKEY_hex = dec2hex($SHMKEY); 981 982 debug( 983 2, 984 "$prefix SHMProjID = >$SHMPROJID< Shared Memory Key >$SHMKEY " . 985 "Decimal - $SHMKEY_hex Hex<" 986 ); 987 988 $SEMID = semget( 989 $SHMKEY, 990 1, 991 IPC::SysV::IPC_CREAT() | 992 IPC::SysV::S_IRUSR() | 993 IPC::SysV::S_IWUSR() 994 ); 995 unless (defined $SEMID) { 996 warn "$prefix semget failed - SHMKEY $SHMKEY - Error $!\n"; 997 if (uc chomp $! eq 'PERMISSION DENIED') { 998 warn " $prefix Read/Write Permission Denied to Shared Memory Array.\n"; 999 warn " $prefix Use ipcs -s to list semaphores and look for " . 1000 "$SHMKEY_hex. If found, shutdown Apache and use ipcrm sem " . 1001 "$SHMKEY_hex to remove the colliding (and hopefully " . 1002 "unused) semaphore. See documentation for setProjID " . 1003 "for more information. \n"; 1004 } 1005 1006 return; 1007 } 1008 1009 # create (or re-use existing) shared memory segment 1010 $SHMID = shmget( 1011 $SHMKEY, 1012 $SHMSIZE, 1013 IPC::SysV::IPC_CREAT() | 1014 IPC::SysV::S_IRUSR() | 1015 IPC::SysV::S_IWUSR() 1016 ); 1017 unless (defined $SHMID) { 1018 warn "$prefix shmget failed - Error $!\n"; 1019 return; 1020 } 1021 1022 # make ids accessible to other handlers 1023 $ENV{AUTH_SEMID} = $SEMID; 1024 $ENV{AUTH_SHMID} = $SHMID; 1025 1026 # read shared memory, increment child count and write shared memory 1027 # segment 1028 semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; 1029 shmread($SHMID, $Cache, 0, $SHMSIZE) 1030 or warn "$prefix shmread failed \n"; 1031 substr($Cache, index($Cache, "\0")) = ''; 1032 1033 # segment already exists (eg start of additional server) 1034 my $child_count_new = 1; 1035 if ($Cache =~ /^(\d+)$;(\d+)\n/) { 1036 my $time_stamp = $1; 1037 my $child_count = $2; 1038 $child_count_new = $child_count + 1; 1039 $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/; 1040 } 1041 else { 1042 # first child => initialize segment 1043 $Cache = time . "$;$child_count_new\n"; 1044 } 1045 debug(2, "$prefix child count = $child_count_new"); 1046 1047 shmwrite($SHMID, $Cache, 0, $SHMSIZE) 1048 or warn "$prefix shmwrite failed \n"; 1049 semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; 1050 1051 1; 1052} 1053 1054# The PerlChildExitHandler decrements the child count or destroys the shared 1055# memory segment upon server shutdown, which is defined by the exit of the 1056# last child. 1057# Note: this handler runs in every child server, but not in the main server. 1058sub childexit { 1059 1060 my $prefix = "$$ Apache::AuthDBI PerlChildExitHandler"; 1061 1062 # read Cache from shared memory, decrement child count and exit or write 1063 #Cache to shared memory 1064 semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; 1065 shmread($SHMID, $Cache, 0, $SHMSIZE) 1066 or warn "$prefix shmread failed \n"; 1067 substr($Cache, index($Cache, "\0")) = ''; 1068 $Cache =~ /^(\d+)$;(\d+)\n/; 1069 1070 my $time_stamp = $1; 1071 my $child_count = $2; 1072 my $child_count_new = $child_count - 1; 1073 if ($child_count_new) { 1074 debug(2, "$prefix child count = $child_count"); 1075 1076 # write Cache into shared memory 1077 $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/; 1078 shmwrite($SHMID, $Cache, 0, $SHMSIZE) 1079 or warn "$prefix shmwrite failed \n"; 1080 semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; 1081 } 1082 else { 1083 # last child 1084 # remove shared memory segment and semaphore set 1085 debug( 1086 2, 1087 "$prefix child count = $child_count, remove shared memory " . 1088 "$SHMID and semaphore $SEMID" 1089 ); 1090 shmctl($SHMID, IPC::SysV::IPC_RMID(), 0) 1091 or warn "$prefix shmctl failed \n"; 1092 semctl($SEMID, 0, IPC::SysV::IPC_RMID(), 0) 1093 or warn "$prefix semctl failed \n"; 1094 } 1095 1096 1; 1097} 1098 1099# The PerlCleanupHandler skips through the cache and deletes any outdated 1100# entry. 1101# Note: this handler runs after the response has been sent to the client. 1102sub cleanup { 1103 1104 my $prefix = "$$ Apache::AuthDBI PerlCleanupHandler"; 1105 debug(2, "$prefix"); 1106 1107 # do we keep the cache in shared memory ? 1108 my $now = time; 1109 if ($SHMID) { 1110 semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; 1111 shmread($SHMID, $Cache, 0, $SHMSIZE) 1112 or warn "$prefix shmread failed \n"; 1113 substr($Cache, index($Cache, "\0")) = ''; 1114 } 1115 1116 # initialize timestamp for CleanupHandler 1117 my $newCache = "$now$;"; 1118 my ($time_stamp, $child_count); 1119 foreach my $record (split(/\n/, $Cache)) { 1120 # first record: timestamp of CleanupHandler and child count 1121 if (!$time_stamp) { 1122 ($time_stamp, $child_count) = split /$;/, $record; 1123 $newCache .= "$child_count\n"; 1124 next; 1125 } 1126 my ($id, $last_access, $passwd, $groups) = split /$;/, $record; 1127 my $diff = $now - $last_access; 1128 if ($diff >= $CacheTime) { 1129 debug(2, "$prefix delete >$id<, last access $diff s before"); 1130 } 1131 else { 1132 debug(2, "$prefix keep >$id<, last access $diff s before"); 1133 $newCache .= "$id$;$now$;$passwd$;$groups\n"; 1134 } 1135 } 1136 1137 # write Cache to shared memory 1138 $Cache = $newCache; 1139 if ($SHMID) { 1140 shmwrite($SHMID, $Cache, 0, $SHMSIZE) 1141 or warn "$prefix shmwrite failed \n"; 1142 semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; 1143 } 1144 1145 1; 1146} 1147 1148# Added 06-14-2005 - KAM - Returns SHA1 digest - Modified from PerlCMS' more 1149# generic routine to remove IO::File requirement 1150sub SHA1_digest { 1151 my %params = @_; 1152 1153 my $prefix = "$$ Apache::AuthDBI SHA1_digest"; 1154 debug(2, $prefix); 1155 1156 $params{'format'} ||= "base64"; 1157 1158 my $sha1 = Digest::SHA1->new(); 1159 1160 if ($params{'text'} ne '') { 1161 $sha1->add($params{'text'}); 1162 } 1163 else { 1164 return -1; 1165 } 1166 1167 if ($params{'format'} =~ /base64/i) { 1168 return $sha1->b64digest; 1169 } 1170 elsif ($params{'format'} =~ /hex/i) { 1171 return $sha1->hexdigest; 1172 } 1173 elsif ($params{'format'} =~ /binary/i) { 1174 return $sha1->binary; 1175 } 1176 1177 -1; 1178} 1179 1180# Added 06-20-2005 - KAM - Returns MD5 digest - Modified from PerlCMS' more 1181# generic routine to remove IO::File requirement 1182sub MD5_digest { 1183 my %params = @_; 1184 1185 my $prefix = "$$ Apache::AuthDBI MD5_digest"; 1186 debug(2, $prefix); 1187 1188 $params{'format'} ||= "hex"; 1189 1190 my $md5 = Digest::MD5->new(); 1191 1192 if ($params{'text'} ne '') { 1193 $md5->add($params{'text'}); 1194 } 1195 else { 1196 return -1; 1197 } 1198 1199 if ($params{'format'} =~ /base64/i) { 1200 return $md5->b64digest; 1201 } 1202 elsif ($params{'format'} =~ /hex/i) { 1203 return $md5->hexdigest; 1204 } 1205 elsif ($params{'format'} =~ /binary/i) { 1206 return $md5->digest; 1207 } 1208 1209 -1; 1210} 1211 12121; 1213 1214__END__ 1215 1216=head1 NAME 1217 1218Apache::AuthDBI - Authentication and Authorization via Perl's DBI 1219 1220=head1 SYNOPSIS 1221 1222 # Configuration in httpd.conf or startup.pl: 1223 1224 PerlModule Apache::AuthDBI 1225 1226 # Authentication and Authorization in .htaccess: 1227 1228 AuthName DBI 1229 AuthType Basic 1230 1231 PerlAuthenHandler Apache::AuthDBI::authen 1232 PerlAuthzHandler Apache::AuthDBI::authz 1233 1234 PerlSetVar Auth_DBI_data_source dbi:driver:dsn 1235 PerlSetVar Auth_DBI_username db_username 1236 PerlSetVar Auth_DBI_password db_password 1237 #DBI->connect($data_source, $username, $password) 1238 1239 PerlSetVar Auth_DBI_pwd_table users 1240 PerlSetVar Auth_DBI_uid_field username 1241 PerlSetVar Auth_DBI_pwd_field password 1242 # authentication: SELECT pwd_field FROM pwd_table WHERE uid_field=$user 1243 PerlSetVar Auth_DBI_grp_field groupname 1244 # authorization: SELECT grp_field FROM pwd_table WHERE uid_field=$user 1245 1246 require valid-user 1247 require user user_1 user_2 ... 1248 require group group_1 group_2 ... 1249 1250The AuthType is limited to Basic. You may use one or more valid require lines. 1251For a single require line with the requirement 'valid-user' or with the 1252requirements 'user user_1 user_2 ...' it is sufficient to use only the 1253authentication handler. 1254 1255=head1 DESCRIPTION 1256 1257This module allows authentication and authorization against a database 1258using Perl's DBI. For supported DBI drivers see: 1259 1260 http://dbi.perl.org/ 1261 1262Authentication: 1263 1264For the given username the password is looked up in the cache. If the cache 1265is not configured or if the user is not found in the cache, or if the given 1266password does not match the cached password, it is requested from the database. 1267 1268If the username does not exist and the authoritative directive is set to 'on', 1269the request is rejected. If the authoritative directive is set to 'off', the 1270control is passed on to next module in line. 1271 1272If the password from the database for the given username is empty and the 1273nopasswd directive is set to 'off', the request is rejected. If the nopasswd 1274directive is set to 'on', any password is accepted. 1275 1276Finally the passwords (multiple passwords per userid are allowed) are 1277retrieved from the database. The result is put into the environment variable 1278REMOTE_PASSWORDS. Then it is compared to the password given. If the encrypted 1279directive is set to 'on', the given password is encrypted using perl's crypt() 1280function before comparison. If the encrypted directive is set to 'off' the 1281plain-text passwords are compared. 1282 1283If this comparison fails the request is rejected, otherwise the request is 1284accepted and the password is put into the environment variable REMOTE_PASSWORD. 1285 1286The SQL-select used for retrieving the passwords is as follows: 1287 1288 SELECT pwd_field FROM pwd_table WHERE uid_field = user 1289 1290If a pwd_whereclause exists, it is appended to the SQL-select. 1291 1292This module supports in addition a simple kind of logging mechanism. Whenever 1293the handler is called and a log_string is configured, the log_field will be 1294updated with the log_string. As log_string - depending upon the database - 1295macros like TODAY can be used. 1296 1297The SQL-select used for the logging mechanism is as follows: 1298 1299 UPDATE pwd_table SET log_field = log_string WHERE uid_field = user 1300 1301Authorization: 1302 1303When the authorization handler is called, the authentication has already been 1304done. This means, that the given username/password has been validated. 1305 1306The handler analyzes and processes the requirements line by line. The request 1307is accepted if the first requirement is fulfilled. 1308 1309In case of 'valid-user' the request is accepted. 1310 1311In case of one or more user-names, they are compared with the given user-name 1312until the first match. 1313 1314In case of one or more group-names, all groups of the given username are 1315looked up in the cache. If the cache is not configured or if the user is not 1316found in the cache, or if the requested group does not match the cached group, 1317the groups are requested from the database. A comma separated list of all 1318these groups is put into the environment variable REMOTE_GROUPS. Then these 1319groups are compared with the required groups until the first match. 1320 1321If there is no match and the authoritative directive is set to 'on' the 1322request is rejected. 1323 1324In case the authorization succeeds, the environment variable REMOTE_GROUP is 1325set to the group name, which can be used by user scripts without accessing 1326the database again. 1327 1328The SQL-select used for retrieving the groups is as follows (depending upon 1329the existence of a grp_table): 1330 1331 SELECT grp_field FROM pwd_table WHERE uid_field = user 1332 SELECT grp_field FROM grp_table WHERE uid_field = user 1333 1334This way the group-information can either be held in the main users table, or 1335in an extra table, if there is an m:n relationship between users and groups. 1336From all selected groups a comma-separated list is build, which is compared 1337with the required groups. If you don't like normalized group records you can 1338put such a comma-separated list of groups (no spaces) into the grp_field 1339instead of single groups. 1340 1341If a grp_whereclause exists, it is appended to the SQL-select. 1342 1343Cache: 1344 1345The module maintains an optional cash for all passwords/groups. See the 1346method setCacheTime(n) on how to enable the cache. Every server has it's 1347own cache. Optionally the cache can be put into a shared memory segment, 1348so that it can be shared among all servers. See the CONFIGURATION section 1349on how to enable the usage of shared memory. 1350 1351In order to prevent the cache from growing indefinitely a CleanupHandler can 1352be initialized, which skips through the cache and deletes all outdated entries. 1353This can be done once per request after sending the response, hence without 1354slowing down response time to the client. The minimum time between two 1355successive runs of the CleanupHandler is configurable (see the CONFIGURATION 1356section). The default is 0, which runs the CleanupHandler after every request. 1357 1358=head1 LIST OF TOKENS 1359 1360=over 1361 1362=item * Auth_DBI_data_source (Authentication and Authorization) 1363 1364The data_source value has the syntax 'dbi:driver:dsn'. This parameter is 1365passed to the database driver for processing during connect. The data_source 1366parameter (as well as the username and the password parameters) may be a 1367tilde ('~') separated list of several data_sources. All of these triples will 1368be used until a successful connect is made. This way several backup-servers 1369can be configured. if you want to use the environment variable DBI_DSN 1370instead of a data_source, do not specify this parameter at all. 1371 1372=item * Auth_DBI_username (Authentication and Authorization) 1373 1374The username argument is passed to the database driver for processing during 1375connect. This parameter may be a tilde ('~') separated list. 1376See the data_source parameter above for the usage of a list. 1377 1378=item * Auth_DBI_password (Authentication and Authorization) 1379 1380The password argument is passed to the database driver for processing during 1381connect. This parameter may be a tilde ('~') separated list. 1382See the data_source parameter above for the usage of a list. 1383 1384=item * Auth_DBI_pwd_table (Authentication and Authorization) 1385 1386Contains at least the fields with the username and the (possibly encrypted) 1387password. The username should be unique. 1388 1389=item * Auth_DBI_uid_field (Authentication and Authorization) 1390 1391Field name containing the username in the Auth_DBI_pwd_table. 1392 1393=item * Auth_DBI_pwd_field (Authentication only) 1394 1395Field name containing the password in the Auth_DBI_pwd_table. 1396 1397=item * Auth_DBI_pwd_whereclause (Authentication only) 1398 1399Use this option for specifying more constraints to the SQL-select. 1400 1401=item * Auth_DBI_grp_table (Authorization only) 1402 1403Contains at least the fields with the username and the groupname. 1404 1405=item * Auth_DBI_grp_field (Authorization only) 1406 1407Field-name containing the groupname in the Auth_DBI_grp_table. 1408 1409=item * Auth_DBI_grp_whereclause (Authorization only) 1410 1411Use this option for specifying more constraints to the SQL-select. 1412 1413=item * Auth_DBI_log_field (Authentication only) 1414 1415Field name containing the log string in the Auth_DBI_pwd_table. 1416 1417=item * Auth_DBI_log_string (Authentication only) 1418 1419String to update the Auth_DBI_log_field in the Auth_DBI_pwd_table. Depending 1420upon the database this can be a macro like 'TODAY'. 1421 1422=item * Auth_DBI_authoritative < on / off> (Authentication and Authorization) 1423 1424Default is 'on'. When set 'on', there is no fall-through to other 1425authentication methods if the authentication check fails. When this directive 1426is set to 'off', control is passed on to any other authentication modules. Be 1427sure you know what you are doing when you decide to switch it off. 1428 1429=item * Auth_DBI_nopasswd < on / off > (Authentication only) 1430 1431Default is 'off'. When set 'on' the password comparison is skipped if the 1432password retrieved from the database is empty, i.e. allow any password. 1433This is 'off' by default to ensure that an empty Auth_DBI_pwd_field does not 1434allow people to log in with a random password. Be sure you know what you are 1435doing when you decide to switch it on. 1436 1437=item * Auth_DBI_encrypted < on / off > (Authentication only) 1438 1439Default is 'on'. When set to 'on', the password retrieved from the database 1440is assumed to be crypted. Hence the incoming password will be crypted before 1441comparison. When this directive is set to 'off', the comparison is done 1442directly with the plain-text entered password. 1443 1444=item * 1445Auth_DBI_encryption_method < sha1hex/md5hex/crypt > (Authentication only) 1446 1447Default is blank. When set to one or more encryption method, the password 1448retrieved from the database is assumed to be crypted. Hence the incoming 1449password will be crypted before comparison. The method supports falling 1450back so specifying 'sha1hex/md5hex' would allow for a site that is upgrading 1451to sha1 to support both methods. sha1 is the recommended method. 1452 1453=item * Auth_DBI_encryption_salt < password / userid > (Authentication only) 1454 1455When crypting the given password AuthDBI uses per default the password 1456selected from the database as salt. Setting this parameter to 'userid', 1457the module uses the userid as salt. 1458 1459=item * 1460Auth_DBI_uidcasesensitive < on / off > (Authentication and Authorization) 1461 1462Default is 'on'. When set 'off', the entered userid is converted to lower case. 1463Also the userid in the password select-statement is converted to lower case. 1464 1465=item * Auth_DBI_pwdcasesensitive < on / off > (Authentication only) 1466 1467Default is 'on'. When set 'off', the entered password is converted to lower 1468case. 1469 1470=item * Auth_DBI_placeholder < on / off > (Authentication and Authorization) 1471 1472Default is 'off'. When set 'on', the select statement is prepared using a 1473placeholder for the username. This may result in improved performance for 1474databases supporting this method. 1475 1476=back 1477 1478=head1 CONFIGURATION 1479 1480The module should be loaded upon startup of the Apache daemon. 1481Add the following line to your httpd.conf: 1482 1483 PerlModule Apache::AuthDBI 1484 1485A common usage is to load the module in a startup file via the PerlRequire 1486directive. See eg/startup.pl for an example. 1487 1488There are three configurations which are server-specific and which can be done 1489in a startup file: 1490 1491 Apache::AuthDBI->setCacheTime(0); 1492 1493This configures the lifetime in seconds for the entries in the cache. 1494Default is 0, which turns off the cache. When set to any value n > 0, the 1495passwords/groups of all users will be cached for at least n seconds. After 1496finishing the request, a special handler skips through the cache and deletes 1497all outdated entries (entries, which are older than the CacheTime). 1498 1499 Apache::AuthDBI->setCleanupTime(-1); 1500 1501This configures the minimum time in seconds between two successive runs of the 1502CleanupHandler, which deletes all outdated entries from the cache. The default 1503is -1, which disables the CleanupHandler. Setting the interval to 0 runs the 1504CleanupHandler after every request. For a heavily loaded server this should be 1505set to a value, which reflects a compromise between scanning a large cache 1506possibly containing many outdated entries and between running many times the 1507CleanupHandler on a cache containing only few entries. 1508 1509 Apache::AuthDBI->setProjID(1); 1510 1511This configures the project ID used to create a semaphore ID for shared memory. 1512It can be set to any integer 1 to 255 or it will default to a value of 1. 1513 1514NOTE: This must be set prior to calling initIPC. 1515 1516If you are running multiple instances of Apache on the same server\ 1517(for example, Apache1 and Apache2), you may not want (or be able) to use 1518shared memory between them. In this case, use a different project ID on 1519each server. 1520 1521If you are reading this because you suspect you have a permission issue or a 1522collision with a semaphore, use 'ipcs -s' to list semaphores and look for the 1523Semaphore ID from the apache error log. If found, shutdown Apache (all of 1524them) and use 'ipcrm sem <semaphore key>' to remove the colliding 1525(and hopefully unused) semaphore. 1526 1527You may also want to remove any orphaned shared memory segments by using 1528'ipcs -m' and removing the orphans with ipcrm shm <shared memory id>. 1529 1530 Apache::AuthDBI->initIPC(50000); 1531 1532This enables the usage of shared memory for the cache. Instead of every server 1533maintaining it's own cache, all servers have access to a common cache. This 1534should minimize the database load considerably for sites running many servers. 1535The number indicates the size of the shared memory segment in bytes. This size 1536is fixed, there is no dynamic allocation of more segments. As a rule of thumb 1537multiply the estimated maximum number of simultaneously cached users by 100 to 1538get a rough estimate of the needed size. Values below 500 will be overwritten 1539with the default 50000. 1540 1541To enable debugging the variable $Apache::AuthDBI::DEBUG must be set. This 1542can either be done in startup.pl or in the user script. Setting the variable 1543to 1, just reports about a cache miss. Setting the variable to 2 enables full 1544debug output. 1545 1546=head1 PREREQUISITES 1547 1548=head2 MOD_PERL 2.0 1549 1550Apache::DBI version 0.96 and should work under mod_perl 2.0 RC5 and later 1551with httpd 2.0.49 and later. 1552 1553Apache::DBI versions less than 1.00 are NO longer supported. Additionally, 1554mod_perl versions less then 2.0.0 are NO longer supported. 1555 1556=head2 MOD_PERL 1.0 1557 1558Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher 1559and that mod_perl needs to be configured with the appropriate call-back hooks: 1560 1561 PERL_AUTHEN=1 PERL_AUTHZ=1 PERL_CLEANUP=1 PERL_STACKED_HANDLERS=1 1562 1563Apache::DBI v0.94 was the last version before dual mod_perl 2.x support was begun. 1564It still recommened that you use the latest version of Apache::DBI because Apache::DBI 1565versions less than 1.00 are NO longer supported. 1566 1567=head1 SECURITY 1568 1569In some cases it is more secure not to put the username and the password in 1570the .htaccess file. The following example shows a solution to this problem: 1571 1572httpd.conf: 1573 1574 <Perl> 1575 my($uid,$pwd) = My::dbi_pwd_fetch(); 1576 $Location{'/foo/bar'}->{PerlSetVar} = [ 1577 [ Auth_DBI_username => $uid ], 1578 [ Auth_DBI_password => $pwd ], 1579 ]; 1580 </Perl> 1581 1582 1583=head1 SEE ALSO 1584 1585L<Apache>, L<mod_perl>, L<DBI> 1586 1587=head1 AUTHORS 1588 1589=over 1590 1591=item * 1592Apache::AuthDBI by Edmund Mergl; now maintained and supported by the 1593modperl mailinglist, subscribe by sending mail to 1594modperl-subscribe@perl.apache.org. 1595 1596=item * 1597mod_perl by Doug MacEachern. 1598 1599=item * 1600DBI by Tim Bunce <dbi-users-subscribe@perl.org> 1601 1602=back 1603 1604=head1 COPYRIGHT 1605 1606The Apache::AuthDBI module is free software; you can redistribute it and/or 1607modify it under the same terms as Perl itself. 1608 1609=cut 1610