package Apache::AuthExpire; #file Apache/AuthExpire.pm # # Author: J. J. Horner # Revisions: Shannon Eric Peevey # Version: 0.38 (07/15/2003) # Usage: see documentation # Description: # Small mod_perl handler to provide Authentication phase time outs for # sensitive areas, per realm. Still has a few issues, but nothing too # serious. use strict; use Carp; use mod_perl; # setting the constants to help identify which version of mod_perl # is installed use constant MP2 => ($mod_perl::VERSION >= 1.99); # test for the version of mod_perl, and use the appropriate libraries BEGIN { if (MP2) { require Apache::Const; require Apache::Access; require Apache::Connection; require Apache::Log; require Apache::RequestRec; require Apache::RequestUtil; require Apache::ServerUtil; Apache::Const->import(-compile => 'HTTP_UNAUTHORIZED','OK','DECLINED'); } else { require Apache::Constants; require Apache::Log; Apache::Constants->import('HTTP_UNAUTHORIZED','OK','DECLINED'); } } our $VERSION = '0.38'; sub handler { my $current_time = time(); # Time will be used here :) my $r = shift; my $log = $r->log; return MP2 ? Apache::DECLINED : Apache::Constants::DECLINED unless $r->is_initial_req; #grab debug value from config files. #Sends 'debug' level messages to error_log when set. my $DEBUG; if (defined ($r->dir_config('TIMEOUT_DEBUG'))) { $DEBUG = $r->dir_config('TIMEOUT_DEBUG'); $log->notice("Debug value set to $DEBUG."); } my ($res, $sent_pw) = $r->get_basic_auth_pw; return $res if $res != (MP2 ? Apache::OK : OK); # return not OK status if not OK my ($limit, $default, $time_to_die); my $request_line = $r->the_request; # Grab TimeLimit from .htaccess file (if available) # or use DefaultLimit if TimeLimit not set or if # TimeLimit greater than default. Can't have longer # time limits than max set by policy. $limit = $r->dir_config('TimeLimit') if (defined($r->dir_config('TimeLimit')) && $r->dir_config('TimeLimit') > 1); $default = $r->dir_config('DefaultLimit'); $log->notice("Default Limit set to $default.") if ($DEBUG); if (defined($limit)) { $time_to_die = ($limit < $default) ? $limit : $default; $log->notice("Time Limit for $request_line set to $limit") if ($DEBUG); } else { $time_to_die = $default; } # Do nothing if MODE set to 'Off'. return MP2 ? Apache::DECLINED : Apache::Constants::DECLINED if ($r->dir_config('MODE') eq 'Off'); my $user = MP2 ? $r->user : $r->connection->user; my $realm = $r->auth_name(); $realm =~ s/\s+/_/g; $realm =~ s/\//_/g; my $host = MP2 ? $r->connection->get_remote_host() : $r->get_remote_host(); my $time_file = MP2 ? Apache::server_root_relative($r->pool, "conf/times/$realm-$host.$user") :$r->server_root_relative("conf/times/$realm-$host.$user"); $log->notice("Time file set to $time_file") if ($DEBUG); if (-e $time_file) { # if timestamp file exists, check time difference my $last_time = (stat($time_file))[9] || $log->warn("Unable to get last modtime from file: $!"); my $time_delta = ($current_time - $last_time); # Determine time since last access if ($time_to_die > $time_delta) { # time delta = specified time limit open (TIME, ">$time_file") || $log->warn("Can't update timestamp on $time_file: $!"); close TIME; return MP2 ? Apache::OK : OK; } else { # time delta greater than TimeLimit $log->notice("Time since last access: $time_delta") if ($DEBUG); $r->note_basic_auth_failure; unlink($time_file) or $log->warn("Can't unlink file: $!"); return MP2 ? Apache::HTTP_UNAUTHORIZED : HTTP_UNAUTHORIZED; } } else { # previous time delta greater than TimeLimit so file was unlinked # or first time checking into server. open (TIME, ">$time_file") || $log->crit("Unable to create $time_file: $!\n"); close TIME; return MP2 ? Apache::OK : OK; } } 1; __END__ =head1 NAME Apache::AuthExpire - mod_perl handler to provide Authentication time limits on .htaccess protected pages. =head1 SYNOPSIS In httpd.conf file: PerlAuthenHandler Apache::AuthExpire PerlSetVar DefaultLimit Optional httpd.conf file entry: PerlSetVar TIMEOUT_DEBUG <0 || 1> Turns debugging on to print messages to server error_log Optional .htaccess entries: PerlSetVar TimeLimit