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