home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / AuthDBI.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-13  |  45.2 KB  |  1,122 lines
  1. package Apache::AuthDBI;
  2.  
  3. use Apache ();
  4. use Apache::Constants qw( OK AUTH_REQUIRED FORBIDDEN DECLINED SERVER_ERROR );
  5. use DBI ();
  6. use IPC::SysV qw( IPC_CREAT IPC_RMID S_IRUSR S_IWUSR );
  7. use strict;
  8.  
  9. # $Id: AuthDBI.pm,v 1.6 2001/01/12 18:59:00 mergl Exp $
  10.  
  11. require_version DBI 1.00;
  12.  
  13. $Apache::AuthDBI::VERSION = '0.88';
  14.  
  15. # 1: report about cache miss
  16. # 2: full debug output
  17. $Apache::AuthDBI::DEBUG = 0;
  18.  
  19.  
  20. # configuration attributes, defaults will be overwritten with values from .htaccess.
  21.  
  22. my %Config = (
  23.     'Auth_DBI_data_source'      => '',
  24.     'Auth_DBI_username'         => '',
  25.     'Auth_DBI_password'         => '',
  26.     'Auth_DBI_pwd_table'        => '',
  27.     'Auth_DBI_uid_field'        => '',
  28.     'Auth_DBI_pwd_field'        => '',
  29.     'Auth_DBI_pwd_whereclause'  => '',
  30.     'Auth_DBI_grp_table'        => '',
  31.     'Auth_DBI_grp_field'        => '',
  32.     'Auth_DBI_grp_whereclause'  => '',
  33.     'Auth_DBI_log_field'        => '',
  34.     'Auth_DBI_log_string'       => '',
  35.     'Auth_DBI_authoritative'    => 'on',
  36.     'Auth_DBI_nopasswd'         => 'off',
  37.     'Auth_DBI_encrypted'        => 'on',
  38.     'Auth_DBI_encryption_salt'  => 'password',
  39.     'Auth_DBI_uidcasesensitive' => 'on',
  40.     'Auth_DBI_pwdcasesensitive' => 'on',
  41.     'Auth_DBI_placeholder'      => 'off',
  42. );
  43.  
  44. # stores the configuration of current URL.
  45. # initialized  during authentication, eventually re-used for authorization.
  46. my $Attr = { };
  47.  
  48.  
  49. # global cache: all records are put into one string.
  50. # record separator is a newline. Field separator is $;.
  51. # every record is a list of id, time of last access, password, groups (authorization only).
  52. # the id is a comma separated list of user_id, data_source, pwd_table, uid_field.
  53. # the first record is a timestamp, which indicates the last run of the CleanupHandler followed by the child counter.
  54.  
  55. my $Cache = time . "$;0\n";
  56.  
  57. # unique id which serves as key in $Cache.
  58. # the id is generated during authentication and re-used for authorization.
  59. my $ID;
  60.  
  61.  
  62. # minimum lifetimes of cache entries in seconds.
  63. # setting the CacheTime to 0 will not use the cache at all.
  64.  
  65. my $CacheTime = 0;
  66.  
  67. # supposed to be called in a startup script.
  68. # sets CacheTime to a user defined value.
  69.  
  70. sub setCacheTime {
  71.     my $class      = shift;
  72.     my $cache_time = shift;
  73.     # sanity check
  74.     $CacheTime = $cache_time if ($cache_time =~ /\d+/);
  75. }
  76.  
  77.  
  78. # minimum time interval in seconds between two runs of the PerlCleanupHandler.
  79. # setting CleanupTime to 0 will run the PerlCleanupHandler after every request.
  80. # setting CleanupTime to a negative value will disable the PerlCleanupHandler.
  81.  
  82. my $CleanupTime = -1;
  83.  
  84. # supposed to be called in a startup script.
  85. # sets CleanupTime to a user defined value.
  86.  
  87. sub setCleanupTime {
  88.     my $class        = shift;
  89.     my $cleanup_time = shift;
  90.     # sanity check
  91.     $CleanupTime = $cleanup_time if ($cleanup_time =~ /\-*\d+/);
  92. }
  93.  
  94.  
  95. # optionally the string with the global cache can be stored in a shared memory segment.
  96. # the segment will be created from the first child and it will be destroyed if the last child exits.
  97. # the reason for not handling everything in the main server is simply, that there is no way to setup 
  98. # an ExitHandler which runs in the main server and which would remove the shared memory and the semaphore.
  99. # hence we have to keep track about the number of children, so that the last one can do all the cleanup.
  100. # creating the shared memory in the first child also has the advantage, that we don't have to cope
  101. # with changing the ownership.
  102. # if a shm-function fails, the global cache will automatically fall back to one string per process.
  103.  
  104. my $SHMKEY  =     0; # unique key for shared memory segment and semaphore set
  105. my $SEMID   =     0; # id of semaphore set
  106. my $SHMID   =     0; # id of shared memory segment
  107. my $SHMSIZE = 50000; # default size of shared memory segment
  108.  
  109. # shortcuts for semaphores
  110. my $obtain_lock  = pack("sss", 0,  0, 0) . pack("sss", 0, 1, 0);
  111. my $release_lock = pack("sss", 0, -1, 0);
  112.  
  113. # supposed to be called in a startup script.
  114. # sets SHMSIZE to a user defined value and initializes the unique key, used for the shared memory segment and for the semaphore set.
  115. # creates a PerlChildInitHandler which creates the shared memory segment and the semaphore set.
  116. # creates a PerlChildExitHandler which removes the shared memory segment and the semaphore set upon server shutdown.
  117. # keep in mind, that this routine runs only once, when the main server starts up.
  118.  
  119. sub initIPC {
  120.     my $class   = shift;
  121.     my $shmsize = shift;
  122.  
  123.     # make sure, this method is called only once
  124.     return if $SHMKEY;
  125.  
  126.     # ensure minimum size of shared memory segment
  127.     $SHMSIZE = $shmsize if $shmsize >= 500;
  128.  
  129.     # generate unique key based on path of AuthDBI.pm
  130.     foreach my $file (keys %INC) {
  131.         if ($file eq 'Apache/AuthDBI.pm') {
  132.             $SHMKEY = IPC::SysV::ftok($INC{$file}, 1);
  133.             last;
  134.         }
  135.     }
  136.  
  137.     # provide a handler which initializes the shared memory segment (first child)
  138.     # or which increments the child counter. 
  139.     if(Apache->can('push_handlers')) {
  140.         Apache->push_handlers("PerlChildInitHandler" => \&childinit);
  141.     }
  142.  
  143.     # provide a handler which decrements the child count or which destroys the shared memory 
  144.     # segment upon server shutdown, which is defined by the exit of the last child.
  145.     if(Apache->can('push_handlers')) {
  146.         Apache->push_handlers("PerlChildExitHandler" => \&childexit);
  147.     }
  148. }
  149.  
  150.  
  151. # authentication handler
  152.  
  153. sub authen {
  154.  
  155.     my ($r) = @_;
  156.     my ($key, $val, $dbh);
  157.  
  158.     my $prefix = "$$ Apache::AuthDBI::authen";
  159.  
  160.     if ($Apache::AuthDBI::DEBUG > 1) {
  161.         my ($type) = '';
  162.         $type .= 'initial ' if $r->is_initial_req;
  163.         $type .= 'main'     if $r->is_main;
  164.         print STDERR "==========\n$prefix request type = >$type< \n";
  165.     }
  166.  
  167.     return OK unless $r->is_initial_req; # only the first internal request
  168.  
  169.     print STDERR "REQUEST:\n", $r->as_string if $Apache::AuthDBI::DEBUG > 1;
  170.  
  171.     # here the dialog pops up and asks you for username and password
  172.     my($res, $passwd_sent) = $r->get_basic_auth_pw;
  173.     print STDERR "$prefix get_basic_auth_pw: res = >$res<, password sent = >$passwd_sent<\n" if $Apache::AuthDBI::DEBUG > 1;
  174.     return $res if $res; # e.g. HTTP_UNAUTHORIZED
  175.  
  176.     # get username
  177.     my ($user_sent) = $r->connection->user;
  178.     print STDERR "$prefix user sent = >$user_sent<\n" if $Apache::AuthDBI::DEBUG > 1;
  179.  
  180.     # do we use shared memory for the global cache ?
  181.     print STDERR "$prefix cache in shared memory, shmid $SHMID, shmsize $SHMSIZE, semid $SEMID \n" if ($SHMID and $Apache::AuthDBI::DEBUG > 1);
  182.  
  183.     # get configuration
  184.     while(($key, $val) = each %Config) {
  185.         $val = $r->dir_config($key) || $val;
  186.         $key =~ s/^Auth_DBI_//;
  187.         $Attr->{$key} = $val;
  188.         printf STDERR "$prefix Config{ %-16s } = %s\n", $key, $val if $Apache::AuthDBI::DEBUG > 1;
  189.     }
  190.  
  191.     # parse connect attributes, which may be tilde separated lists
  192.     my @data_sources = split(/~/, $Attr->{data_source});
  193.     my @usernames    = split(/~/, $Attr->{username});
  194.     my @passwords    = split(/~/, $Attr->{password});
  195.     $data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
  196.  
  197.     # obtain the id for the cache
  198.     my $data_src = $Attr->{data_source};
  199.     $data_src =~ s/\(.+\)//go; # remove any embedded attributes, because of trouble with regexps
  200.     $ID = join ',', $user_sent, $data_src, $Attr->{pwd_table}, $Attr->{uid_field};
  201.  
  202.     # if not configured decline
  203.     unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{pwd_field}) {
  204.         printf STDERR "$prefix not configured, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
  205.         return DECLINED;
  206.     }
  207.  
  208.     # do we want Windows-like case-insensitivity?
  209.     $user_sent   = lc($user_sent)   if $Attr->{uidcasesensitive} eq "off";
  210.     $passwd_sent = lc($passwd_sent) if $Attr->{pwdcasesensitive} eq "off";
  211.  
  212.     # check whether the user is cached but consider that the password possibly has changed
  213.     my $passwd = '';
  214.     my $salt   = '';
  215.     if ($CacheTime) { # do we use the cache ?
  216.         if ($SHMID) { # do we keep the cache in shared memory ?
  217.             semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  218.             shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  219.             substr($Cache, index($Cache, "\0")) = '';
  220.             semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  221.         }
  222.         # find id in cache
  223.         my ($last_access, $passwd_cached, $groups_cached);
  224.         if ($Cache =~ /$ID$;(\d+)$;(.+)$;(.*)\n/) {
  225.             $last_access   = $1;
  226.             $passwd_cached = $2;
  227.             $groups_cached = $3;
  228.             printf STDERR "$prefix cache: found >$ID< >$last_access< >$passwd_cached< \n" if $Apache::AuthDBI::DEBUG > 1;
  229.             $salt = $Attr->{encryption_salt} eq 'userid' ? $user_sent : $passwd_cached;
  230.             my $passwd_to_check = $Attr->{encrypted} eq 'on' ? crypt($passwd_sent, $salt) : $passwd_sent; 
  231.             # match cached password with password sent 
  232.             $passwd = $passwd_cached if $passwd_to_check eq $passwd_cached;
  233.         }
  234.     }
  235.  
  236.     if ($passwd) { # found in cache
  237.         printf STDERR "$prefix passwd found in cache \n" if $Apache::AuthDBI::DEBUG > 1;
  238.     } else { # password not cached or changed
  239.         printf STDERR "$prefix passwd not found in cache \n" if $Apache::AuthDBI::DEBUG;
  240.  
  241.         # connect to database, use all data_sources until the connect succeeds
  242.         my $j;
  243.         for ($j = 0; $j <= $#data_sources; $j++) {
  244.             last if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j]));
  245.         }
  246.         unless ($dbh) {
  247.             $r->log_reason("$prefix db connect error with data_source >$Attr->{data_source}<", $r->uri);
  248.             return SERVER_ERROR;
  249.         }
  250.  
  251.         # generate statement
  252.         my $user_sent_quoted = $dbh->quote($user_sent);
  253.         my $select    = "SELECT $Attr->{pwd_field}";
  254.         my $from      = "FROM $Attr->{pwd_table}";
  255.         my $where     = ($Attr->{uidcasesensitive} eq "off") ? "WHERE lower($Attr->{uid_field}) =" : "WHERE $Attr->{uid_field} =";
  256.         my $compare   = ($Attr->{placeholder}      eq "on")  ? "?" : "$user_sent_quoted";
  257.         my $statement = "$select $from $where $compare";
  258.         $statement   .= " AND $Attr->{pwd_whereclause}" if $Attr->{pwd_whereclause};
  259.         print STDERR "$prefix statement: $statement\n" if $Apache::AuthDBI::DEBUG > 1;
  260.  
  261.         # prepare statement
  262.         my $sth;
  263.         unless ($sth = $dbh->prepare($statement)) {
  264.             $r->log_reason("$prefix can not prepare statement: $DBI::errstr", $r->uri);
  265.             $dbh->disconnect;
  266.             return SERVER_ERROR;
  267.         }
  268.  
  269.         # execute statement
  270.         my $rv;
  271.         unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) {
  272.             $r->log_reason("$prefix can not execute statement: $DBI::errstr", $r->uri);
  273.             $dbh->disconnect;
  274.             return SERVER_ERROR;
  275.         }
  276.  
  277.         # fetch result
  278.         while ($_ = $sth->fetchrow_array) {
  279.             # strip trailing blanks for fixed-length data-type
  280.             $_ =~ s/ +$// if $_;
  281.             # consider the case with many users sharing the same userid
  282.         $passwd .= "$_$;";
  283.         }
  284.  
  285.         chop  $passwd if $passwd;
  286.         undef $passwd if 0 == $sth->rows; # so we can distinguish later on between no password and empty password
  287.  
  288.         if ($sth->err) {
  289.             $dbh->disconnect;
  290.             return SERVER_ERROR;
  291.         }
  292.         $sth->finish;
  293.  
  294.         # re-use dbh for logging option below
  295.         $dbh->disconnect unless ($Attr->{log_field} && $Attr->{log_string});
  296.     }
  297.  
  298.     $r->subprocess_env(REMOTE_PASSWORDS => $passwd);
  299.     print STDERR "$prefix passwd = >$passwd<\n" if $Apache::AuthDBI::DEBUG > 1;
  300.  
  301.     # check if password is needed
  302.     if (!defined($passwd)) { # not found in database
  303.         # if authoritative insist that user is in database
  304.         if ($Attr->{authoritative} eq 'on') {
  305.             $r->log_reason("$prefix password for user $user_sent not found", $r->uri);
  306.             $r->note_basic_auth_failure;
  307.             return AUTH_REQUIRED;
  308.         } else {
  309.             # else pass control to the next authentication module
  310.             return DECLINED;
  311.         }
  312.     }
  313.  
  314.     # allow any password if nopasswd = on and the retrieved password is empty
  315.     if ($Attr->{nopasswd} eq 'on' && !$passwd) {
  316.         return OK;
  317.     }
  318.  
  319.     # if nopasswd is off, reject user
  320.     unless ($passwd_sent && $passwd) {
  321.         $r->log_reason("$prefix user $user_sent: empty password(s) rejected", $r->uri);
  322.         $r->note_basic_auth_failure;
  323.         return AUTH_REQUIRED;
  324.     }
  325.  
  326.     # compare passwords
  327.     my $found = 0;
  328.     my $password;
  329.     foreach $password (split(/$;/, $passwd)) {
  330.         # compare the two passwords possibly crypting the password if needed
  331.         $salt = $Attr->{encryption_salt} eq 'userid' ? $user_sent : $password;
  332.         my $passwd_to_check = $Attr->{encrypted} eq 'on' ? crypt($passwd_sent, $password) : $passwd_sent; 
  333.         if ($passwd_to_check eq $password) {
  334.             $found = 1;
  335.             $r->subprocess_env(REMOTE_PASSWORD => $password);
  336.             print STDERR "$prefix user $user_sent: password match for >$password< \n" if $Apache::AuthDBI::DEBUG > 1;
  337.             # update timestamp and cache userid/password if CacheTime is configured
  338.             if ($CacheTime) { # do we use the cache ?
  339.                 if ($SHMID) { # do we keep the cache in shared memory ?
  340.                     semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  341.                     shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  342.                     substr($Cache, index($Cache, "\0")) = '';
  343.                 }
  344.                 # update timestamp and password or append new record
  345.                 my $now = time;
  346.                 if (!($Cache =~ s/$ID$;\d+$;.*$;(.*)\n/$ID$;$now$;$password$;$1\n/)) {
  347.             $Cache .= "$ID$;$now$;$password$;\n";
  348.                 } else {
  349.                 }
  350.                 if ($SHMID) { # write cache to shared memory
  351.                     shmwrite($SHMID, $Cache, 0, $SHMSIZE)  or printf STDERR "$prefix shmwrite failed \n";
  352.                     semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  353.                 }
  354.             }
  355.             last;
  356.         }
  357.     }
  358.     unless ($found) {
  359.         $r->log_reason("$prefix user $user_sent: password mismatch", $r->uri);
  360.         $r->note_basic_auth_failure;
  361.         return AUTH_REQUIRED;
  362.     }
  363.  
  364.     # logging option
  365.     if ($Attr->{log_field} && $Attr->{log_string}) {
  366.         if (!$dbh) { # connect to database if not already done
  367.             my ($j, $connect);
  368.             for ($j = 0; $j <= $#data_sources; $j++) {
  369.                 if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j])) {
  370.                     $connect = 1;
  371.                     last;
  372.                 }
  373.             }
  374.             unless ($connect) {
  375.                 $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
  376.                 return SERVER_ERROR;
  377.             }
  378.         }
  379.         my $user_sent_quoted = $dbh->quote($user_sent);
  380.         my $statement = "UPDATE $Attr->{pwd_table} SET $Attr->{log_field} = $Attr->{log_string} WHERE $Attr->{uid_field}=$user_sent_quoted";
  381.         print STDERR "$prefix statement: $statement\n" if $Apache::AuthDBI::DEBUG > 1;
  382.         unless ($dbh->do($statement)) {
  383.             $r->log_reason("$prefix can not do statement: $DBI::errstr", $r->uri);
  384.             $dbh->disconnect;
  385.             return SERVER_ERROR;
  386.         }
  387.         $dbh->disconnect;
  388.     }
  389.  
  390.     # Unless the cache or the CleanupHandler is disabled, the CleanupHandler is initiated 
  391.     # if the last run was more than $CleanupTime seconds before. 
  392.     # Note, that it runs after the request, hence it cleans also the authorization entries 
  393.     if ($CacheTime and $CleanupTime >= 0) {
  394.         my $diff = time - substr($Cache, 0, index($Cache, "$;"));
  395.         print STDERR "$prefix secs since last CleanupHandler: $diff, CleanupTime: $CleanupTime \n" if $Apache::AuthDBI::DEBUG > 1;
  396.         if ($diff > $CleanupTime and Apache->can('push_handlers')) {
  397.             print STDERR "$prefix push PerlCleanupHandler \n" if $Apache::AuthDBI::DEBUG > 1;
  398.             Apache->push_handlers("PerlCleanupHandler", \&cleanup);
  399.         }
  400.     }
  401.  
  402.     printf STDERR "$prefix return OK\n" if $Apache::AuthDBI::DEBUG > 1;
  403.     return OK;
  404. }
  405.  
  406.  
  407. # authorization handler, it is called immediately after the authentication
  408.  
  409. sub authz {
  410.  
  411.     my ($r) = @_;
  412.     my ($key, $val, $dbh);
  413.  
  414.     my ($prefix) = "$$ Apache::AuthDBI::authz ";
  415.  
  416.     if ($Apache::AuthDBI::DEBUG > 1) {
  417.         my ($type) = '';
  418.         $type .= 'initial ' if $r->is_initial_req;
  419.         $type .= 'main'     if $r->is_main;
  420.         print STDERR "==========\n$prefix request type = >$type< \n";
  421.     }
  422.  
  423.     return OK unless $r->is_initial_req; # only the first internal request
  424.  
  425.     my ($user_result)  = DECLINED;
  426.     my ($group_result) = DECLINED;
  427.  
  428.     # get username
  429.     my ($user_sent) = $r->connection->user;
  430.     print STDERR "$prefix user sent = >$user_sent<\n" if $Apache::AuthDBI::DEBUG > 1 ;
  431.  
  432.     # here we could read the configuration, but we re-use the configuration from the authentication
  433.  
  434.     # parse connect attributes, which may be tilde separated lists
  435.     my @data_sources = split(/~/, $Attr->{data_source});
  436.     my @usernames    = split(/~/, $Attr->{username});
  437.     my @passwords    = split(/~/, $Attr->{password});
  438.     $data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
  439.  
  440.     # if not configured decline
  441.     unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) {
  442.         printf STDERR "$prefix not configured, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
  443.         return DECLINED;
  444.     }
  445.  
  446.     # do we want Windows-like case-insensitivity?
  447.     $user_sent = lc($user_sent) if $Attr->{uidcasesensitive} eq "off";
  448.  
  449.     # select code to return if authorization is denied:
  450.     my $authz_denied= $Attr->{expeditive} eq 'on' ? FORBIDDEN : AUTH_REQUIRED;
  451.  
  452.     # check if requirements exists
  453.     my ($ary_ref) = $r->requires;
  454.     unless ($ary_ref) {
  455.         if ($Attr->{authoritative} eq 'on') {
  456.             $r->log_reason("user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri);
  457.             $r->note_basic_auth_failure if $authz_denied == AUTH_REQUIRED;
  458.             return $authz_denied;
  459.         }
  460.         printf STDERR "$prefix no requirements and not authoritative, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
  461.         return DECLINED;
  462.     }
  463.  
  464.     # iterate over all requirement directives and store them according to their type (valid-user, user, group)
  465.     my($hash_ref, $valid_user, $user_requirements, $group_requirements);
  466.     foreach $hash_ref (@$ary_ref) {
  467.         while (($key,$val) = each %$hash_ref) {
  468.             last if $key eq 'requirement';
  469.         }
  470.         $val =~ s/^\s*require\s+//;
  471.         # handle different requirement-types
  472.         if ($val =~ /valid-user/) {
  473.             $valid_user = 1;
  474.         } elsif ($val =~ s/^user\s+//go) {
  475.             $user_requirements .= " $val";
  476.         } elsif ($val =~ s/^group\s+//go) {
  477.             $group_requirements .= " $val";
  478.         }
  479.     }
  480.     $user_requirements  =~ s/^ //go;
  481.     $group_requirements =~ s/^ //go;
  482.     print STDERR "$prefix requirements: valid-user=>$valid_user< user=>$user_requirements< group=>$group_requirements< \n"  if $Apache::AuthDBI::DEBUG > 1;
  483.  
  484.     # check for valid-user
  485.     if ($valid_user) {
  486.         $user_result = OK;
  487.         print STDERR "$prefix user_result = OK: valid-user\n" if $Apache::AuthDBI::DEBUG > 1;
  488.     }
  489.  
  490.     # check for users
  491.     if ($user_result != OK && $user_requirements) {
  492.         $user_result = AUTH_REQUIRED;
  493.         my $user_required;
  494.         foreach $user_required (split /\s+/, $user_requirements) {
  495.             if ($user_required eq $user_sent) {
  496.                 print STDERR "$prefix user_result = OK for $user_required \n" if $Apache::AuthDBI::DEBUG > 1;
  497.                 $user_result = OK;
  498.                 last;
  499.            }
  500.         }
  501.     }
  502.  
  503.     # check for groups
  504.     if ($user_result != OK && $group_requirements) {
  505.         $group_result = AUTH_REQUIRED;
  506.         my ($group, $group_required);
  507.  
  508.         # check whether the user is cached but consider that the group possibly has changed
  509.         my $groups = '';
  510.         if ($CacheTime) { # do we use the cache ?
  511.             # we need to get the cached groups for the current id, which has been read already 
  512.             # during authentication, so we do not read the Cache from shared memory again
  513.             my ($last_access, $passwd_cached, $groups_cached);
  514.             if ($Cache =~ /$ID$;(\d+)$;(.*)$;(.+)\n/) {
  515.                 $last_access   = $1;
  516.                 $passwd_cached = $2;
  517.                 $groups_cached = $3;
  518.                 printf STDERR "$prefix cache: found >$ID< >$last_access< >$groups_cached< \n" if $Apache::AuthDBI::DEBUG > 1;
  519.                 REQUIRE_1: foreach $group_required (split /\s+/, $group_requirements) {
  520.                     foreach $group (split(/,/, $groups_cached)) {
  521.                         if ($group_required eq $group) {
  522.                             $groups = $groups_cached;
  523.                             last REQUIRE_1;
  524.                 }
  525.                     }
  526.                 }
  527.             }
  528.         }
  529.  
  530.         if ($groups) { # found in cache
  531.             printf STDERR "$prefix groups found in cache \n" if $Apache::AuthDBI::DEBUG > 1;
  532.         } else { # groups not cached or changed
  533.             printf STDERR "$prefix groups not found in cache \n" if $Apache::AuthDBI::DEBUG;
  534.  
  535.             # connect to database, use all data_sources until the connect succeeds
  536.             my ($j, $connect);
  537.             for ($j = 0; $j <= $#data_sources; $j++) {
  538.                 if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j])) {
  539.                     $connect = 1;
  540.                     last;
  541.                 }
  542.             }
  543.             unless ($connect) {
  544.                 $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
  545.                 return SERVER_ERROR;
  546.             }
  547.  
  548.             # generate statement
  549.             my $user_sent_quoted = $dbh->quote($user_sent);
  550.             my $select    = "SELECT $Attr->{grp_field}";
  551.             my $from      = ($Attr->{grp_table}) ? "FROM $Attr->{grp_table}" : "FROM $Attr->{pwd_table}";
  552.             my $where     = ($Attr->{uidcasesensitive} eq "off") ? "WHERE lower($Attr->{uid_field}) =" : "WHERE $Attr->{uid_field} =";
  553.             my $compare   = ($Attr->{placeholder}      eq "on")  ? "?" : "$user_sent_quoted";
  554.             my $statement = "$select $from $where $compare";
  555.             $statement   .= " AND $Attr->{grp_whereclause}" if ($Attr->{grp_whereclause});
  556.             print STDERR "$prefix statement: $statement\n" if $Apache::AuthDBI::DEBUG > 1;
  557.  
  558.             # prepare statement
  559.             my $sth;
  560.             unless ($sth = $dbh->prepare($statement)) {
  561.                 $r->log_reason("can not prepare statement: $DBI::errstr", $r->uri);
  562.                 $dbh->disconnect;
  563.                 return SERVER_ERROR;
  564.             }
  565.  
  566.             # execute statement
  567.             my $rv;
  568.             unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) {
  569.                 $r->log_reason("can not execute statement: $DBI::errstr", $r->uri);
  570.                 $dbh->disconnect;
  571.                 return SERVER_ERROR;
  572.             }
  573.  
  574.             # fetch result and build a group-list
  575.             my $group;
  576.             while ( $group = $sth->fetchrow_array ) {
  577.                 # strip trailing blanks for fixed-length data-type
  578.                 $group =~ s/ +$//;
  579.                 $groups .= "$group,";
  580.             }
  581.             chop $groups if $groups;
  582.  
  583.             $sth->finish;
  584.             $dbh->disconnect;
  585.         }
  586.  
  587.         $r->subprocess_env(REMOTE_GROUPS => $groups);
  588.         print STDERR "$prefix groups = >$groups<\n" if $Apache::AuthDBI::DEBUG > 1;
  589.  
  590.         # skip through the required groups until the first matches
  591.         REQUIRE_2: foreach $group_required (split /\s+/, $group_requirements) {
  592.             foreach $group (split(/,/, $groups)) {
  593.                 # check group
  594.                 if ($group_required eq $group) {
  595.                     $group_result = OK;
  596.                     $r->subprocess_env(REMOTE_GROUP => $group);
  597.                     print STDERR "$prefix user $user_sent: group_result = OK for >$group< \n" if $Apache::AuthDBI::DEBUG > 1;
  598.                     # update timestamp and cache userid/groups if CacheTime is configured
  599.                     if ($CacheTime) { # do we use the cache ?
  600.                         if ($SHMID) { # do we keep the cache in shared memory ?
  601.                             semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  602.                             shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  603.                             substr($Cache, index($Cache, "\0")) = '';
  604.                         }
  605.                         # update timestamp and groups
  606.                         my $now = time;
  607.                         # entry must exists from authentication
  608.                 $Cache =~ s/$ID$;\d+$;(.*)$;.*\n/$ID$;$now$;$1$;$groups\n/;
  609.                         if ($SHMID) { # write cache to shared memory
  610.                             shmwrite($SHMID, $Cache, 0, $SHMSIZE)  or printf STDERR "$prefix shmwrite failed \n";
  611.                             semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  612.                         }
  613.                     }
  614.                     last REQUIRE_2;
  615.         }
  616.             }
  617.         }
  618.     }
  619.  
  620.     # check the results of the requirement checks
  621.     if ($Attr->{authoritative} eq 'on' && $user_result != OK && $group_result != OK) {
  622.         my $reason;
  623.         $reason .= " USER"  if $user_result  == AUTH_REQUIRED;
  624.         $reason .= " GROUP" if $group_result == AUTH_REQUIRED;
  625.         $r->log_reason("DBI-Authoritative: Access denied on $reason rule(s)", $r->uri);
  626.         $r->note_basic_auth_failure if $authz_denied == AUTH_REQUIRED;
  627.         return $authz_denied;
  628.     }
  629.  
  630.     # return OK if authorization was successful
  631.     if ($user_result == OK || $group_result == OK) {
  632.         printf STDERR "$prefix return OK\n" if $Apache::AuthDBI::DEBUG > 1;
  633.         return OK;
  634.     }
  635.  
  636.     # otherwise fall through
  637.     printf STDERR "$prefix fall through, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
  638.     return DECLINED;
  639. }
  640.  
  641.  
  642. # The PerlChildInitHandler initializes the shared memory segment (first child)
  643. # or increments the child counter. 
  644. # Note: this handler runs in every child server, but not in the main server.
  645.  
  646. sub childinit {
  647.     my $prefix = "$$ Apache::AuthDBI         PerlChildInitHandler";
  648.     # create (or re-use existing) semaphore set
  649.     $SEMID = semget($SHMKEY, 1, IPC_CREAT|S_IRUSR|S_IWUSR);
  650.     if (!defined($SEMID)) {
  651.       print STDERR "$prefix semget failed \n";
  652.       return;
  653.     }
  654.     # create (or re-use existing) shared memory segment
  655.     $SHMID = shmget($SHMKEY, $SHMSIZE, IPC_CREAT|S_IRUSR|S_IWUSR);
  656.     if (!defined($SHMID)) {
  657.       print STDERR "$prefix shmget failed \n";
  658.       return;
  659.     }
  660.     # make ids accessible to other handlers
  661.     $ENV{AUTH_SEMID} = $SEMID;
  662.     $ENV{AUTH_SHMID} = $SHMID;
  663.     # read shared memory, increment child count and write shared memory segment
  664.     semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  665.     shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  666.     substr($Cache, index($Cache, "\0")) = '';
  667.     my $child_count_new = 1;
  668.     if ($Cache =~ /^(\d+)$;(\d+)\n/) { # segment already exists (eg start of additional server)
  669.         my $time_stamp   = $1;
  670.         my $child_count  = $2;
  671.         $child_count_new = $child_count + 1;
  672.         $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/;
  673.     } else { # first child => initialize segment
  674.         $Cache = time . "$;$child_count_new\n";
  675.     }
  676.     print STDERR "$prefix child count = $child_count_new \n" if $Apache::AuthDBI::DEBUG > 1;
  677.     shmwrite($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmwrite failed \n";
  678.     semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  679.     1;
  680. }
  681.  
  682.  
  683. # The PerlChildExitHandler decrements the child count or destroys the shared memory 
  684. # segment upon server shutdown, which is defined by the exit of the last child.
  685. # Note: this handler runs in every child server, but not in the main server.
  686.  
  687. sub childexit {
  688.     my $prefix = "$$ Apache::AuthDBI         PerlChildExitHandler";
  689.     # read Cache from shared memory, decrement child count and exit or write Cache to shared memory
  690.     semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  691.     shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  692.     substr($Cache, index($Cache, "\0")) = '';
  693.     $Cache =~ /^(\d+)$;(\d+)\n/;
  694.     my $time_stamp  = $1;
  695.     my $child_count = $2;
  696.     my $child_count_new = $child_count - 1;
  697.     if ($child_count_new) {
  698.         print STDERR "$prefix child count = $child_count \n" if $Apache::AuthDBI::DEBUG > 1;
  699.         # write Cache into shared memory
  700.         $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/;
  701.         shmwrite($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmwrite failed \n";
  702.         semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  703.     } else { # last child
  704.         # remove shared memory segment and semaphore set
  705.         print STDERR "$prefix child count = $child_count, remove shared memory $SHMID and semaphore $SEMID \n" if $Apache::AuthDBI::DEBUG > 1;
  706.         shmctl($SHMID,    IPC_RMID, 0) or print STDERR "$prefix shmctl failed \n";
  707.         semctl($SEMID, 0, IPC_RMID, 0) or print STDERR "$prefix semctl failed \n";
  708.     }
  709.     1;
  710. }
  711.  
  712.  
  713. # The PerlCleanupHandler skips through the cache and deletes any outdated entry.
  714. # Note: this handler runs after the response has been sent to the client.
  715.  
  716. sub cleanup {
  717.     my $prefix = "$$ Apache::AuthDBI         PerlCleanupHandler";
  718.     print STDERR "$prefix \n" if $Apache::AuthDBI::DEBUG > 1;
  719.     my $now = time;
  720.     if ($SHMID) { # do we keep the cache in shared memory ?
  721.         semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
  722.         shmread($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmread failed \n";
  723.         substr($Cache, index($Cache, "\0")) = ''; 
  724.     }
  725.     my $newCache = "$now$;"; # initialize timestamp for CleanupHandler
  726.     my ($time_stamp, $child_count);
  727.     foreach my $record (split(/\n/, $Cache)) {
  728.         if (!$time_stamp) { # first record: timestamp of CleanupHandler and child count
  729.             ($time_stamp, $child_count) = split(/$;/, $record);
  730.             $newCache .= "$child_count\n";
  731.             next;
  732.         }
  733.         my ($id, $last_access, $passwd, $groups) = split(/$;/, $record);
  734.         my $diff = $now - $last_access;
  735.         if ($diff >= $CacheTime) {
  736.             print STDERR "$prefix delete >$id<, last access $diff s before \n" if $Apache::AuthDBI::DEBUG > 1;
  737.         } else {
  738.             print STDERR "$prefix keep   >$id<, last access $diff s before \n" if $Apache::AuthDBI::DEBUG > 1;
  739.             $newCache .= "$id$;$now$;$passwd$;$groups\n";
  740.         }
  741.     }
  742.     $Cache = $newCache;
  743.     if ($SHMID) { # write Cache to shared memory
  744.         shmwrite($SHMID, $Cache, 0, $SHMSIZE) or printf STDERR "$prefix shmwrite failed \n";
  745.         semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
  746.     }
  747.     1;
  748. }
  749.  
  750.  
  751. 1;
  752.  
  753. __END__
  754.  
  755.  
  756. =head1 NAME
  757.  
  758. Apache::AuthDBI - Authentication and Authorization via Perl's DBI
  759.  
  760.  
  761. =head1 SYNOPSIS
  762.  
  763.  # Configuration in httpd.conf or startup.pl:
  764.  
  765.  PerlModule Apache::AuthDBI
  766.  
  767.  # Authentication and Authorization in .htaccess:
  768.  
  769.  AuthName DBI
  770.  AuthType Basic
  771.  
  772.  PerlAuthenHandler Apache::AuthDBI::authen
  773.  PerlAuthzHandler  Apache::AuthDBI::authz
  774.  
  775.  PerlSetVar Auth_DBI_data_source   dbi:driver:dsn
  776.  PerlSetVar Auth_DBI_username      db_username
  777.  PerlSetVar Auth_DBI_password      db_password
  778.  #DBI->connect($data_source, $username, $password)
  779.  
  780.  PerlSetVar Auth_DBI_pwd_table     users
  781.  PerlSetVar Auth_DBI_uid_field     username
  782.  PerlSetVar Auth_DBI_pwd_field     password
  783.  # authentication: SELECT pwd_field FROM pwd_table WHERE uid_field=$user
  784.  PerlSetVar Auth_DBI_grp_field     groupname
  785.  # authorization: SELECT grp_field FROM pwd_table WHERE uid_field=$user
  786.  
  787.  require valid-user
  788.  require user   user_1  user_2 ...
  789.  require group group_1 group_2 ...
  790.  
  791. The AuthType is limited to Basic. You may use one or more valid require lines.
  792. For a single require line with the requirement 'valid-user' or with the requirements
  793. 'user user_1 user_2 ...' it is sufficient to use only the authentication handler.
  794.  
  795.  
  796. =head1 DESCRIPTION
  797.  
  798. This module allows authentication and authorization against a database
  799. using Perl's DBI. For supported DBI drivers see:
  800.  
  801.  http://www.symbolstone.org/technology/perl/DBI/
  802.  
  803. Authentication:
  804.  
  805. For the given username the password is looked up in the cache. If the cache
  806. is not configured or if the user is not found in the cache, or if the given
  807. password does not match the cached password, it is requested from the database.
  808.  
  809. If the username does not exist and the authoritative directive is set to 'on',
  810. the request is rejected. If the authoritative directive is set to 'off', the
  811. control is passed on to next module in line.
  812.  
  813. If the password from the database for the given username is empty and the nopasswd
  814. directive is set to 'off', the request is rejected. If the nopasswd directive is set
  815. to 'on', any password is accepted.
  816.  
  817. Finally the passwords (multiple passwords per userid are allowed) are
  818. retrieved from the database. The result is put into the environment variable
  819. REMOTE_PASSWORDS. Then it is compared to the password given. If the encrypted
  820. directive is set to 'on', the given password is encrypted using perl's crypt()
  821. function before comparison. If the encrypted directive is set to 'off' the
  822. plain-text passwords are compared.
  823.  
  824. If this comparison fails the request is rejected, otherwise the request is
  825. accepted and the password is put into the environment variable REMOTE_PASSWORD.
  826.  
  827. The SQL-select used for retrieving the passwords is as follows:
  828.  
  829.  SELECT pwd_field FROM pwd_table WHERE uid_field = user
  830.  
  831. If a pwd_whereclause exists, it is appended to the SQL-select.
  832.  
  833. This module supports in addition a simple kind of logging mechanism. Whenever
  834. the handler is called and a log_string is configured, the log_field will be
  835. updated with the log_string. As log_string - depending upon the database -
  836. macros like TODAY can be used.
  837.  
  838. The SQL-select used for the logging mechanism is as follows:
  839.  
  840.  UPDATE pwd_table SET log_field = log_string WHERE uid_field = user
  841.  
  842. Authorization:
  843.  
  844. When the authorization handler is called, the authentication has already been
  845. done. This means, that the given username/password has been validated.
  846.  
  847. The handler analyzes and processes the requirements line by line. The request
  848. is accepted if the first requirement is fulfilled.
  849.  
  850. In case of 'valid-user' the request is accepted.
  851.  
  852. In case of one or more user-names, they are compared with the given user-name
  853. until the first match.
  854.  
  855. In case of one or more group-names, all groups of the given username are
  856. looked up in the cache. If the cache is not configured or if the user is not
  857. found in the cache, or if the requested group does not match the cached group,
  858. the groups are requested from the database. A comma separated list of all
  859. these groups is put into the environment variable REMOTE_GROUPS. Then these
  860. groups are compared with the required groups until the first match.
  861.  
  862. If there is no match and the authoritative directive is set to 'on' the
  863. request is rejected.
  864.  
  865. In case the authorization succeeds, the environment variable REMOTE_GROUP is
  866. set to the group name, which can be used by user scripts without accessing
  867. the database again.
  868.  
  869. The SQL-select used for retrieving the groups is as follows (depending upon
  870. the existence of a grp_table):
  871.  
  872.  SELECT grp_field FROM pwd_table WHERE uid_field = user
  873.  SELECT grp_field FROM grp_table WHERE uid_field = user
  874.  
  875. This way the group-information can either be held in the main users table, or
  876. in an extra table, if there is an m:n relationship between users and groups.
  877. From all selected groups a comma-separated list is build, which is compared
  878. with the required groups. If you don't like normalized group records you can
  879. put such a comma-separated list of groups (no spaces) into the grp_field
  880. instead of single groups.
  881.  
  882. If a grp_whereclause exists, it is appended to the SQL-select.
  883.  
  884. Cache:
  885.  
  886. The module maintains an optional cash for all passwords/groups. See the
  887. method setCacheTime(n) on how to enable the cache. Every server has it's
  888. own cache. Optionally the cache can be put into a shared memory segment,
  889. so that it can be shared among all servers. See the CONFIGURATION section
  890. on how to enable the usage of shared memory.
  891.  
  892. In order to prevent the cache from growing indefinitely a CleanupHandler can
  893. be initialized, which skips through the cache and deletes all outdated entries.
  894. This can be done once per request after sending the response, hence without
  895. slowing down response time to the client. The minimum time between two successive
  896. runs of the CleanupHandler is configurable (see the CONFIGURATION section). The
  897. default is 0, which runs the CleanupHandler after every request.
  898.  
  899.  
  900.  
  901. =head1 LIST OF TOKENS
  902.  
  903. =item *
  904. Auth_DBI_data_source (Authentication and Authorization)
  905.  
  906. The data_source value has the syntax 'dbi:driver:dsn'. This parameter is
  907. passed to the database driver for processing during connect. The data_source
  908. parameter (as well as the username and the password parameters) may be a
  909. tilde ('~') separated list of several data_sources. All of these triples will
  910. be used until a successful connect is made. This way several backup-servers can
  911. be configured. if you want to use the environment variable DBI_DSN instead of
  912. a data_source, do not specify this parameter at all.
  913.  
  914. =item *
  915. Auth_DBI_username (Authentication and Authorization)
  916.  
  917. The username argument is passed to the database driver for processing during
  918. connect. This parameter may be a tilde ('~') separated list. See the data_source
  919. parameter above for the usage of a list.
  920.  
  921. =item *
  922. Auth_DBI_password (Authentication and Authorization)
  923.  
  924. The password argument is passed to the database driver for processing during
  925. connect. This parameter may be a tilde ('~')  separated list. See the data_source
  926. parameter above for the usage of a list.
  927.  
  928. =item *
  929. Auth_DBI_pwd_table (Authentication and Authorization)
  930.  
  931. Contains at least the fields with the username and the (possibly encrypted)
  932. password. The username should be unique.
  933.  
  934. =item *
  935. Auth_DBI_uid_field (Authentication and Authorization)
  936.  
  937. Field name containing the username in the Auth_DBI_pwd_table.
  938.  
  939. =item *
  940. Auth_DBI_pwd_field (Authentication only)
  941.  
  942. Field name containing the password in the Auth_DBI_pwd_table.
  943.  
  944. =item *
  945. Auth_DBI_pwd_whereclause (Authentication only)
  946.  
  947. Use this option for specifying more constraints to the SQL-select.
  948.  
  949. =item *
  950. Auth_DBI_grp_table (Authorization only)
  951.  
  952. Contains at least the fields with the username and the groupname.
  953.  
  954. =item *
  955. Auth_DBI_grp_field (Authorization only)
  956.  
  957. Field-name containing the groupname in the Auth_DBI_grp_table.
  958.  
  959. =item *
  960. Auth_DBI_grp_whereclause (Authorization only)
  961.  
  962. Use this option for specifying more constraints to the SQL-select.
  963.  
  964. =item *
  965. Auth_DBI_log_field (Authentication only)
  966.  
  967. Field name containing the log string in the Auth_DBI_pwd_table.
  968.  
  969. =item *
  970. Auth_DBI_log_string (Authentication only)
  971.  
  972. String to update the Auth_DBI_log_field in the Auth_DBI_pwd_table. Depending
  973. upon the database this can be a macro like 'TODAY'.
  974.  
  975. =item *
  976. Auth_DBI_authoritative  < on / off> (Authentication and Authorization)
  977.  
  978. Default is 'on'. When set 'on', there is no fall-through to other
  979. authentication methods if the authentication check fails. When this directive
  980. is set to 'off', control is passed on to any other authentication modules. Be
  981. sure you know what you are doing when you decide to switch it off.
  982.  
  983. =item *
  984. Auth_DBI_nopasswd  < on / off > (Authentication only)
  985.  
  986. Default is 'off'. When set 'on' the password comparison is skipped if the
  987. password retrieved from the database is empty, i.e. allow any password. This is
  988. 'off' by default to ensure that an empty Auth_DBI_pwd_field does not allow people
  989. to log in with a random password. Be sure you know what you are doing when you
  990. decide to switch it on.
  991.  
  992. =item *
  993. Auth_DBI_encrypted  < on / off > (Authentication only)
  994.  
  995. Default is 'on'. When set to 'on', the password retrieved from the database
  996. is assumed to be crypted. Hence the incoming password will be crypted before
  997. comparison. When this directive is set to 'off', the comparison is done directly
  998. with the plain-text entered password.
  999.  
  1000. =item *
  1001. Auth_DBI_encryption_salt < password / userid > (Authentication only)
  1002.  
  1003. When crypting the given password AuthDBI uses per default the password selected
  1004. from the database as salt. Setting this parameter to 'userid', the module uses
  1005. the userid as salt.
  1006.  
  1007. =item *
  1008. Auth_DBI_uidcasesensitive  < on / off > (Authentication and Authorization)
  1009.  
  1010. Default is 'on'. When set 'off', the entered userid is converted to lower case.
  1011. Also the userid in the password select-statement is converted to lower case.
  1012.  
  1013. =item *
  1014. Auth_DBI_pwdcasesensitive  < on / off > (Authentication only)
  1015.  
  1016. Default is 'on'. When set 'off', the entered password is converted to lower
  1017. case.
  1018.  
  1019. =item *
  1020. Auth_DBI_placeholder < on / off > (Authentication and Authorization)
  1021.  
  1022. Default is 'off'.  When set 'on', the select statement is prepared using a
  1023. placeholder for the username.  This may result in improved performance for
  1024. databases supporting this method.
  1025.  
  1026.  
  1027. =head1 CONFIGURATION
  1028.  
  1029. The module should be loaded upon startup of the Apache daemon.
  1030. Add the following line to your httpd.conf:
  1031.  
  1032.  PerlModule Apache::AuthDBI
  1033.  
  1034. A common usage is to load the module in a startup file via the PerlRequire
  1035. directive. See eg/startup.pl for an example.
  1036.  
  1037. There are three configurations which are server-specific and which can be done
  1038. in a startup file:
  1039.  
  1040.  Apache::AuthDBI->setCacheTime(0);
  1041.  
  1042. This configures the lifetime in seconds for the entries in the cache.
  1043. Default is 0, which turns off the cache. When set to any value n > 0, the
  1044. passwords/groups of all users will be cached for at least n seconds. After
  1045. finishing the request, a special handler skips through the cache and deletes
  1046. all outdated entries (entries, which are older than the CacheTime).
  1047.  
  1048.  Apache::AuthDBI->setCleanupTime(-1);
  1049.  
  1050. This configures the minimum time in seconds between two successive runs of the
  1051. CleanupHandler, which deletes all outdated entries from the cache. The default
  1052. is -1, which disables the CleanupHandler. Setting the interval to 0 runs the
  1053. CleanupHandler after every request. For a heavily loaded server this should be
  1054. set to a value, which reflects a compromise between scanning a large cache
  1055. possibly containing many outdated entries and between running many times the
  1056. CleanupHandler on a cache containing only few entries.
  1057.  
  1058.  Apache::AuthDBI->initIPC(50000);
  1059.  
  1060. This enables the usage of shared memory for the cache. Instead of every server
  1061. maintaining it's own cache, all servers have access to a common cache. This
  1062. should minimize the database load considerably for sites running many servers.
  1063. The number indicates the size of the shared memory segment in bytes. This size
  1064. is fixed, there is no dynamic allocation of more segments. As a rule of thumb
  1065. multiply the estimated maximum number of simultaneously cached users by 100 to
  1066. get a rough estimate of the needed size. Values below 500 will be overwritten
  1067. with the default 50000.
  1068.  
  1069. To enable debugging the variable $Apache::AuthDBI::DEBUG must be set. This
  1070. can either be done in startup.pl or in the user script. Setting the variable
  1071. to 1, just reports about a cache miss. Setting the variable to 2 enables full
  1072. debug output.
  1073.  
  1074.  
  1075. =head1 PREREQUISITES
  1076.  
  1077. Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher
  1078. and that mod_perl needs to be configured with the appropriate call-back hooks:
  1079.  
  1080.   PERL_AUTHEN=1 PERL_AUTHZ=1 PERL_CLEANUP=1 PERL_STACKED_HANDLERS=1
  1081.  
  1082.  
  1083. =head1 SECURITY
  1084.  
  1085. In some cases it is more secure not to put the username and the password in
  1086. the .htaccess file. The following example shows a solution to this problem:
  1087.  
  1088. httpd.conf:
  1089.  
  1090.  <Perl>
  1091.  my($uid,$pwd) = My::dbi_pwd_fetch();
  1092.  $Location{'/foo/bar'}->{PerlSetVar} = [
  1093.      [ Auth_DBI_username  => $uid ],
  1094.      [ Auth_DBI_password  => $pwd ],
  1095.  ];
  1096.  </Perl>
  1097.  
  1098.  
  1099. =head1 SEE ALSO
  1100.  
  1101. L<Apache>, L<mod_perl>, L<DBI>
  1102.  
  1103.  
  1104. =head1 AUTHORS
  1105.  
  1106. =item *
  1107. mod_perl by Doug MacEachern <modperl@apache.org>
  1108.  
  1109. =item *
  1110. DBI by Tim Bunce <dbi-users@isc.org>
  1111.  
  1112. =item *
  1113. Apache::AuthDBI by Edmund Mergl <E.Mergl@bawue.de>
  1114.  
  1115.  
  1116. =head1 COPYRIGHT
  1117.  
  1118. The Apache::AuthDBI module is free software; you can redistribute it and/or
  1119. modify it under the same terms as Perl itself.
  1120.  
  1121. =cut
  1122.