Hi,
I am attempting to write a mod_perl handler to get invoked before the
PerlHandler which is HTML::Embperl.
One of my Embperl scripts sets up a 'user' object in %udat which needs to be
retrieved and authenticated in the PerlAuthzHandler of each request.
However, I am having a lot of problems retrieving this session in my
handler!
I was under the expectation that since my handler does a 'use
HTML::Embperl;' it's BEGIN block would be called to initialise all the state
info for subsequent HTML::Embperl::Req::SetupSession /
HTML::Embperl::Req::GetSession calls (where a GetSession should suffice?).
This does not appear to be so.
I have included my handler below and would appreciate if someone can help
me. The existance check on %udat fails in my handler, although there is a
perfectly good session object which is verified in my HTML::Embperl scripts.
Cheers, Alan
package Balclutha::mod_auth;
use Apache;
use Apache::Constants qw(OK DECLINED);
#
# call HTML::Embperl BEGIN block to setup session handling (bind to %udat)
#
use HTML::Embperl;
use Data::Dumper;
use DBIx::Recordset;
use Balclutha::User;
$DBIx::Recordset::Debug = 2;
%OK_URLS = ( '/' => 1, # for just with domain in
url !!
'/index.html' => 1,
'/public/stylesheet.css' => 1,
'/public/header.html' => 1,
'/public/index.html' => 1,
'/system/navigationbar.epl' => 1,
'/system/authenticate.epl' => 1,
'/system/footer.epl' => 1);
sub handler {
my $req_rec = shift;
$req_rec->warn("Balclutha::mod_auth doing: " . $req_rec->uri);
#print STDERR "HTML::Embperl is: ", Dumper(%HTML::Embperl::), "\n";
#
# DECLINED is passthru ...
#
return DECLINED if defined $OK_URLS{$req_rec->uri};
my %rec;
#
# setup %ENV
#
HTML::Embperl::ScanEnvironment(\%rec, $req_rec);
HTML::Embperl::Req::SetupSession($req_rec);
my %udat = HTML::Embperl::Req::GetSession;
if (exists $udat{user}) {
*set = DBIx::Recordset->Search({'!Table' => 'groupname_file',
'$where' => 'file = ?',
'$values' => [ $req_rec->uri ] }) ;
my $rec = $set->Next;
return DECLINED unless $rec; # we don't know about this file we will
suppose it must be OK ...
while ($rec) {
return DECLINED if $udat{user}->hasgroup($rec->{groupname});
$rec = $set->Next;
}
$req_rec->log_error("Balclutha::mod_auth failed auth, user doesn't have
perms: " . $req_rec->uri);
return 403; # we know about this file, but user doesn't have perms !!
}
#
# maybe it's one of the 'defaults' available to all users ...
#
my $server_protocol = 'http';
$server_protocol = 'https' if exists $ENV{HTTPS};
*set = DBIx::Recordset->Search({'!Table' => 'groupname_file',
'$where' => 'groupname = ? and file = ?',
'$values' => [ $server_protocol, $req_rec->uri ]
}) ;
my $rec = $set->Next;
return DECLINED if $rec; # found it ...
#
# don't know this user, no record of the file either -> sod off
#
$req_rec->log_error("Balclutha::mod_auth failed auth, no user and no
entry in groupname_file: " . $req_rec->uri);
return 403;
}
1;
__END__
_________________________________________________________________
Get your FREE download of MSN Explorer at http://explorer.msn.com/intl.asp
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
