Re: ENV

[Dodger <se...@aquest.com>]

Jonathan Vanasco wrote:
> Is there a way to get additional shell variables exported into ENV on 
> startup ?
>
> // Jonathan Vanasco

Yup.

I do this:

package Local::PrepSession;

use DBI;

my $sql = DBI->connect('DBI:mysql:apache','******','******');

use Apache2::RequestRec();
use Apache2::RequestIO();
use Apache2::ServerRec();
use strict;

sub clearEnv();
sub killCookie($$);

use CGI::Cookie;

use Apache2::Const(':common');

sub handler {
my $r = shift;
my $s = $r->server;
my $sql = DBI->connect('DBI:mysql:apache','******','******');

my %cookies = fetch CGI::Cookie;
my $sessionid;
$sessionid = $cookies{'session'}->value if defined $cookies{'session'};
clearEnv;
$ENV{SESSION_ID} = $sessionid;
$ENV{SESSION_HANDLER} = 'PrepSession';

unless ($sessionid) {
# Session ID is undefined. No such cookie.
delete $ENV{SESSION_ID};
$ENV{NO_SESSION_REASON} = "No session cookie found";

$sql->disconnect;
return DECLINED;
}

my $sessionTables = {
'xfx3d.net' => 'xfx_session',
'gothic-classifieds.com' => 'gc_session',
'art-geeks.com' => 'ag_session',
'cryptbabes.com' => 'cb_session',
'moopleapproved.com' => 'mp_session',
'whatever3d.com' => 'whatever',
'mistressjadeor.com' => 'mj_session',
'club-nemesis.com' => 'nemesis_session',
};
my $dom = $s->server_hostname();

# debug
for my $envar (grep !/^ORIGINAL_/, keys %ENV) {
$ENV{"ORIGINAL_$envar"} = $ENV{$envar};
}

$ENV{DB_DOMAIN_ORIG} = $dom;

unless ($dom =~ /^[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-]+$/) {
$ENV{DEBUG} = "Domain had to be stripped down";
if ($dom =~ s/.*\.([a-zA-Z0-9\-]+\.[a-zA-Z0-9\-]+)/$1/) {
$ENV{DOMAIN_CATCH} = "Did some stripping??";
}
else {
$ENV{DOMAIN_CATCH} = "Didn't match???";
}
}

$ENV{DB_DOMAIN} = $dom;

my $session_table = $sessionTables->{$dom};
$ENV{SQL_SESSION_TABLE} = $sessionTables->{$dom};

unless ($session_table) {
# request came in for a domain name without a session table
$ENV{SESSION_ID} = 0;
$ENV{NO_SESSION_REASON} = "No session table found for server $dom";
clearEnv;
killCookie($r, $dom);
$sql->disconnect;
return DECLINED;
}

$ENV{SQL_FULL_TABLE} = 'apache.'.$session_table;

my $get_session_st = <<"EOF";
SELECT *
FROM apache.$session_table
WHERE id = ?
EOF

my $get_session = $sql->prepare($get_session_st);
$ENV{GET_SESSION_PREPARED} = ref $get_session;
if ($sql->errstr) {
# we had an error preparing the session query
# don't kill the cookie -- it may be a temporary DB issue
$ENV{SESSION_ID} = '0E0';
$ENV{SQL_PREPARE_GET_SESSION_ERR} = $sql->errstr;
$sql->disconnect;
return DECLINED;
}

my $rows = $get_session->execute($sessionid);

if ($get_session->errstr) {
# We had an error executing the query
# don't kill the cookie -- it may be a temporary DB issue
clearEnv;
$ENV{SQL_EXECUTE_GET_SESSION_ERR} = $get_session->errstr;
$ENV{SQL_FAILED_STATEMENT} = $get_session_st;
open ERRLOG, ">>/usr/local/apache2/logs/session_errlog";
print ERRLOG "Get_session error: ", $get_session->errstr, "\n";
close ERRLOG;
$get_session->finish;
$sql->disconnect;
return DECLINED;
}

unless ($rows + 0) {
# the submitted Session ID cookie is invalid. No match.
killCookie($r, $dom);
clearEnv;
open ERRLOG, ">>/usr/local/apache2/logs/session_errlog";
print ERRLOG "Invalid session $sessionid\n";
close ERRLOG;
$ENV{NO_SESSION_REASON} = "Invalid session $sessionid\n";
$get_session->finish;
$sql->disconnect;
return DECLINED;
}

my $session = $get_session->fetchrow_hashref;
$get_session->finish;

if ($session) {
my $expiry = $session->{remember} eq 'Yes' ? '+1y' : '+1d';
my $pcookie = CGI::Cookie->new($r,
-name => 'session',
-value => $sessionid,
-expires => $expiry,
-path => '/',
-domain => ".$dom");
$r->headers_out->set('Set-Cookie' => $pcookie);

for my $svar (keys %{$session}) {
$ENV{uc("SESSION_$svar")} = $session->{$svar};
}

if ($session->{access}) {
my @access = split /;/, $session->{access};

for my $a (@access) {
my ($ap, $t) = split /:/, $a;
$ENV{uc("ACCESS_$ap")} = $t;
}
}

my $update_session_st = <<"EOF";
UPDATE apache.$session_table
SET last_action = NOW()
WHERE id = ?
EOF
my $update_session = $sql->prepare($update_session_st);
$update_session->execute($sessionid);
}

else {
clearEnv;
killCookie($r, $dom);
$ENV{NO_SESSION_REASON} = "Session id not found in $session_table";
}
$sql->disconnect;
return DECLINED;
}

sub killCookie($$) {
my $r = shift;
my $dom = shift;
my $mcookie = CGI::Cookie->new($r,
-name => 'session',
-value => '',
-expires => '-1d',
-path => '/',
-domain => ".$dom");
$r->headers_out->set('Set-Cookie' => $mcookie);
}

sub clearEnv() {
for my $envar (grep /^(SESSION|ACCESS)/, keys %ENV) {
delete $ENV{$envar};
}
}

1;

and in the httd.conf:

<Directory "/usr/local/www">
Options Indexes FollowSymLinks MultiViews Includes ExecCGI
AllowOverride All
Order allow,deny
Allow from all

PerlOptions +ParseHeaders +GlobalRequest +SetupEnv
<Files ~ "\.(mp|php|php3|shtml)">
PerlFixupHandler Local::PrepSession
</Files>
</Directory>

This sets up certain things based on the session cookie, including 
getting any parametre stored in the session table (which is a faster 
lookup than, say my members table) and also their access levels (which 
is way faster, as I store the whole thing in a single column in session, 
whilst in the 'real' tables it's stored in a proper relational fashion).

It also sets up a bit of debugging info that I can use if I need to, and 
could of course add more.

The nice thing about it is that it will run this for plain old SHTML 
files and even PHP or whatever else (ColdFusion, JSP, ASP, etc) and 
populate the environment with the session information for these as well.

The tables look basically like this:

mysql> desc whatever
-> ;
+-------------+------------------+------+-----+---------------------+-------+
| Field | Type | Null | Key | Default | Extra |
+-------------+------------------+------+-----+---------------------+-------+
| id | varchar(32) | NO | | | |
| member | varchar(32) | NO | | | |
| handle | varchar(64) | NO | | 0 | |
| last_action | timestamp | YES | | 0000-00-00 00:00:00 | |
| login_dt | timestamp | YES | | 0000-00-00 00:00:00 | |
| access | text | YES | | NULL | |
| subscribed | enum('Yes','No') | NO | | No | |
| remember | enum('Yes','No') | NO | | Yes | |
| newsletter | enum('Yes','No') | NO | | No | |
| aeoncust | enum('Yes','No') | NO | | No | |
| nudity | enum('Yes','No') | NO | | No | |
| violence | enum('Yes','No') | NO | | No | |
| mature | enum('Yes','No') | NO | | No | |
+-------------+------------------+------+-----+---------------------+-------+
13 rows in set (0.22 sec)

However, the only columns required to make it work correctly are id and 
las_action (access is required if you want variable level access 
restrictions, and can be NULL or look something like this: 
'ADMIN:6;beta:3;SUPERUSER:7', and you probable also want login_dt in 
there for obvious reasons)

And of course you could put other stuff in there, like 'theme' for instance.

All column names will be uppercased by this BTW. But you could change that.