Perl*Handlers and Embperl Sessions

[alan milligan <al...@hotmail.com>]

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: embperl-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-help@perl.apache.org

Re: Perl*Handlers and Embperl Sessions

[Gerald Richter <ri...@ecos.de>]

Hi,


>   HTML::Embperl::Req::SetupSession($req_rec);
>     my %udat = HTML::Embperl::Req::GetSession;
>
>     if (exists $udat{user}) {
>

GetSession returns a reference to hash, so you have to write:

     my $udat = HTML::Embperl::Req::GetSession;

     if (exists $udat->{user}) {

but you don't need GetSession, SetupSession returns the same reference, so
simply write

    my $udat =  HTML::Embperl::Req::SetupSession($req_rec);

    if (exists $udat -> {user}) {

Gerald


-------------------------------------------------------------
Gerald Richter    ecos electronic communication services gmbh
Internetconnect * Webserver/-design/-datenbanken * Consulting

Post:       Tulpenstrasse 5         D-55276 Dienheim b. Mainz
E-Mail:     richter@ecos.de         Voice:    +49 6133 925131
WWW:        http://www.ecos.de      Fax:      +49 6133 925152
-------------------------------------------------------------




---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-help@perl.apache.org