package Apache::Session;
use strict;
use URI::URL ();
use IO::File ();
use File::CounterFile ();
use CGI::Switch ();
use Apache::Constants ':common';
use File::Path 'mkpath';
use File::Basename;
use File::Copy 'cp';
sub handler {
my $r = shift;
return DECLINED unless -x $r->server_root_relative("httpd");
Apache->request($r);
my $q = new CGI::Switch;
my(%id) = $q->cookie('session');
my $path = $r->uri;
my $port = $id{port} || allocate_port($r);
warn "id->port=$id{port} ($port) server->port=", $r->server->port;
return DECLINED if exists $id{port} and ($id{port} eq $r->server->port);
my $c = File::CounterFile->new("HTTPD_SESSION","00000000");
my $sdir = join "/",
($r->dir_config("SessionBaseDir") || "/tmp/httpd_sessions"),
$c->value;
unless ($id{seskey} and -d $sdir) {
$id{port} = $port;
$id{seskey} = $c->inc;
warn "creating new session seskey=$id{seskey}\n";
my $cookie = $q->cookie(-name=>'session',
-value=>\%id,
-expires=>'+1h');
for(qw(header_out err_header_out)) {
$r->$_("Set-Cookie" => $cookie);
}
start_server($r, $sdir, $port);
}
return redirect($r, $r->uri, $port);
}
sub allocate_port {
my($r) = @_;
my $c = File::CounterFile->new("HTTPD_SESSION_PORT","9000");
$c->inc;
$c->inc if $c->value eq $r->server->port;
$c->inc while(getservbyport($c->value, "tcp"));
$c->value;
}
sub start_server {
my($r, $root, $port) = @_;
my $httpd_conf = $r->server_root_relative("conf/httpd.conf");
my $base_conf = dirname $httpd_conf;
$port ||= $$;
mkpath $root, 0, 0755;
for ("$root/conf", "$root/logs") {
mkdir $_, 0755;
}
my $in = IO::File->new($httpd_conf);
$httpd_conf = "$root/conf/httpd.conf";
unless (-e $httpd_conf) {
my $out = IO::File->new(">$httpd_conf");
while(<$in>) {
if (/^Port/) {
print $out "Port $port\n";
}
elsif (/^ServerRoot/) {
print $out "ServerRoot $root\n";
}
else {
print $out $_;
}
}
for(<$base_conf/*.*>) {
cp $_, "$root/conf";
}
}
my $old_path = $ENV{PATH};
$ENV{PATH} = "/bin";
my $httpd = $r->server_root_relative("httpd");
system "$httpd -X -d $root &";
$ENV{PATH} = $old_path;
warn "started $httpd ($root)\n";
}
sub redirect {
my($r, $path, $port) = @_;
my $uri = new URI::URL $r->uri;
$uri->scheme("http");
$uri->host($r->server->server_hostname);
$uri->port($port);
$uri->epath($path);
$r->content_type("text/html");
$r->header_out(Location => $uri->abs->as_string);
$r->status(302);
return 302;
}
1;
__END__
=head1 NAME
Apache::Session - Maintain client <-> httpd instance session
=head1 SYNOPSIS
#httpd.conf or some such
PerlFixupHandler Apache::Session
#where to store session config files (default is /tmp/httpd_sessions)
PerlSetVar SessionBaseDir
=head1 DESCRIPTION
This module starts a session based httpd for a specific client.
By using HTTP cookies, the server redirects the client to it's session
on a dynamically allocated port.
=head1 TODO
=over 4
=item re-configuration issues, what else needs to be changed?
=item ensure server is started properly
=item cleanup when server shuts down
=item expire session
=item reset session and port counters
=item validate peer identity
=item httpd might not be in ServerRoot and it might not be called `httpd'
=back
=head1 SEE ALSO
mod_perl(3), Apache(3), File::CounterFile(3)
=head1 AUTHOR
Doug MacEachern <
[email protected]>