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]>