Apache2-ClickPath
view release on metacpan or search on metacpan
lib/Apache2/ClickPath.pm view on Meta::CPAN
package Apache2::ClickPath;
use 5.008;
use strict;
use warnings;
no warnings qw(uninitialized);
use APR::Table ();
use APR::SockAddr ();
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::Connection ();
use Apache2::Filter ();
use Apache2::RequestRec ();
use Apache2::Module ();
use Apache2::CmdParms ();
use Apache2::Directive ();
use Apache2::Log ();
use Apache2::URI ();
use Apache2::Const -compile => qw(DECLINED OK
OR_ALL RSRC_CONF
TAKE1 RAW_ARGS NO_ARGS);
use MIME::Base64 ();
use Crypt::CBC ();
use Crypt::Blowfish ();
use Digest::MD5 ();
use Digest::CRC ();
use Apache2::ClickPath::_parse ();
our $VERSION = '1.901';
our $rcounter=int rand 0x10000;
my @directives=
(
{
name => 'ClickPathSessionPrefix',
func => __PACKAGE__ . '::ClickPathSessionPrefix',
req_override => Apache2::Const::RSRC_CONF,
args_how => Apache2::Const::TAKE1,
errmsg => 'ClickPathSessionPrefix string',
},
{
name => 'ClickPathMaxSessionAge',
func => __PACKAGE__ . '::ClickPathMaxSessionAge',
req_override => Apache2::Const::RSRC_CONF,
args_how => Apache2::Const::TAKE1,
errmsg => 'ClickPathMaxSessionAge time_in_seconds',
},
{
name => 'ClickPathUAExceptionsFile',
func => __PACKAGE__ . '::ClickPathUAExceptionsFile',
req_override => Apache2::Const::RSRC_CONF,
args_how => Apache2::Const::TAKE1,
errmsg => 'ClickPathUAExceptionsFile filename',
},
{
name => '<ClickPathUAExceptions',
func => __PACKAGE__ . '::ClickPathUAExceptions',
req_override => Apache2::Const::RSRC_CONF,
args_how => Apache2::Const::RAW_ARGS,
errmsg => '<ClickPathUAExceptions>
name1 regexp1
name2 regexp2
...
</ClickPathUAExceptions>',
},
{
name => '</ClickPathUAExceptions>',
func => __PACKAGE__ . '::ClickPathUAExceptionsEND',
req_override => Apache2::Const::OR_ALL,
args_how => Apache2::Const::NO_ARGS,
errmsg => '</ClickPathUAExceptions> without <ClickPathUAExceptions>',
},
{
name => 'ClickPathFriendlySessionsFile',
func => __PACKAGE__ . '::ClickPathFriendlySessionsFile',
req_override => Apache2::Const::RSRC_CONF,
args_how => Apache2::Const::TAKE1,
errmsg => 'ClickPathFriendlySessionsFile filename',
},
{
name => '<ClickPathFriendlySessions',
func => __PACKAGE__ . '::ClickPathFriendlySessions',
lib/Apache2/ClickPath.pm view on Meta::CPAN
$r->subprocess_env( SESSION=>$session );
$newsession=$pr->pnotes( __PACKAGE__.'::newsession' );
$r->pnotes( __PACKAGE__.'::newsession'=>$newsession )
if( $newsession );
#print STDERR "$$: ReUsing session $session\n";
}
} elsif( $file=~s!^/+\Q$tag\E ( [^/]+ ) /!/!x ) {
my $session=$1;
#print STDERR "$$: Using old session $session\n";
$ref=~s!^(\w+://[^/]+)/+\Q$tag\E[^/]+!$1!;
$r->headers_in->{Referer}=$ref;
$r->parse_uri( 'http://localhost'.$file.(length $r->args ? '?'.$r->args : '') );
$r->subprocess_env( SESSION=>$session );
$r->subprocess_env( CGI_SESSION=>'/'.$tag.$session );
# decode session
$session=~tr[N-Za-z0-9@\-,A-M][A-Za-z0-9@\-,];
my @l=split /,/, $session, 3;
# extract remote session
my $rtab;
(undef, $rtab)=_get_friendly_session( $cf );
$rtab={} unless( $rtab );
if( @l==3 and exists $rtab->{$l[1]} ) {
my %h=('**'=>'*', '*!'=>'!', '*.'=>'=', '!'=>"\n", '*x'=>'/', '*y'=>'#');
$l[2]=~s/(\*[*!.xy]|!)/$h{$1}/ge;
$r->subprocess_env( REMOTE_SESSION=>$l[2] );
$r->subprocess_env( REMOTE_SESSION_HOST=>$rtab->{$l[1]} );
} else {
$r->subprocess_env->unset( 'REMOTE_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
}
# extract session start time
$l[0]=~tr[@\-][+/];
@l=split /:/, $l[0], 2; # $l[0]: IP Addr, $l[1]: session
if( exists $cf->{ClickPathMachineReverse} ) {
if( exists $cf->{ClickPathMachineReverse}->{$l[0]} ) {
$r->subprocess_env('ClickPathMachineName'=>$l[0]);
$r->subprocess_env('ClickPathMachineStore'=>
$cf->{"ClickPathMachineReverse"}->{$l[0]}->[1])
if( length $cf->{"ClickPathMachineReverse"}->{$l[0]}->[1] );
} else {
$r->log->notice( "Caught invalid session: Unknown Machine name '$l[0]'" );
$r->subprocess_env( INVALID_SESSION=>$r->subprocess_env( 'SESSION' ) );
$r->subprocess_env->unset( 'SESSION' );
$r->subprocess_env->unset( 'CGI_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
$newsession++;
goto NEWSESSION;
}
}
my $len4=do {use integer; (length( $l[1] )+3)/4;};
$len4*=4;
$l[1]=MIME::Base64::decode_base64( $l[1].('='x($len4-length( $l[1] ))) );
if( exists $cf->{ClickPathSecret} ) {
my $crypt=Crypt::CBC->new(
-key=>$cf->{ClickPathSecret},
-keysize=>length($cf->{ClickPathSecret}),
-cipher=>'Crypt::Blowfish',
-literal_key=>1,
-header=>'none',
-iv=>$cf->{ClickPathSecretIV},
);
$l[1]=$crypt->decrypt( $l[1] );
}
my $crc;
if( length( $l[1] ) ) {
$crc=Digest::CRC::crc8( substr( $l[1], 1 ) );
} else {
$crc=-1; # invalid value
}
@l=unpack "CNNnN", $l[1];
my $maxage=$cf->{"ClickPathMaxSessionAge"};
my $age=$r->request_time-$l[1];
if( $crc!=$l[0] or ($maxage>0 and $age>$maxage) or $age<0 ) {
if( $crc!=$l[0] ) {
$r->log->notice( "Caught invalid session: CRC checksum failed" );
} else {
$r->subprocess_env( EXPIRED_SESSION=>$r->subprocess_env( 'SESSION' ) );
}
$r->subprocess_env->unset( 'SESSION' );
$r->subprocess_env->unset( 'CGI_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
$r->subprocess_env->unset( 'ClickPathMachineName' );
$r->subprocess_env->unset( 'ClickPathMachineStore' );
$newsession++;
goto NEWSESSION;
} else {
$r->subprocess_env( SESSION_START=>$l[1] );
$r->subprocess_env( SESSION_AGE=>$r->request_time-$l[1] );
}
$newsession=0;
} else {
$ref=~s!^(\w+://[^/]+)/\Q$tag\E[^/]+!$1!;
$r->headers_in->{Referer}=$ref;
NEWSESSION:
my $ua=$r->headers_in->{'User-Agent'};
my $disable='';
foreach my $el (@{_get_ua_exc( $cf )}) {
if( $ua=~/$el->[1]/ ) {
$disable=$el->[0];
last;
}
}
if( length $disable ) {
$r->subprocess_env( SESSION=>$disable );
$r->subprocess_env( SESSION_START=>$r->request_time );
$r->subprocess_env( SESSION_AGE=>0 );
$r->subprocess_env->unset( 'CGI_SESSION' );
lib/Apache2/ClickPath.pm view on Meta::CPAN
my @uri=split m!/+!, $ref;
my %args=map {
my ($k, $v)=split /=/;
length( $k ) ? ($k=>$v) : ();
} split /[;&]/, $args;
my @remote_session=map {
$_->[0] eq 'uri' ? $uri[$_->[1]] : $_->[1].'='.$args{$_->[1]};
} @{$el->[0]};
my $remote_session=join( "\n", @remote_session );
$r->subprocess_env( REMOTE_SESSION=>$remote_session );
$r->subprocess_env( REMOTE_SESSION_HOST=>$host );
my %h=('*'=>'**', '!'=>'*!', '='=>'*.', "\n"=>'!',
'/'=>'*x', '#'=>'*y');
$remote_session=~s^([*!=\n/#])^$h{$1}^ge;
$ref=$el->[1].','.$remote_session;
} else {
$r->subprocess_env->unset( 'REMOTE_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
$ref='';
}
} else {
$r->subprocess_env->unset( 'REMOTE_SESSION' );
$r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
$ref='';
}
my $session_ip=undef;
if( exists $cf->{"ClickPathMachine"} ) {
$session_ip=$cf->{"ClickPathMachine"};
} else {
my $serverip=$r->connection->local_addr->ip_get;
if( exists $cf->{"ClickPathMachineTable"} and
exists $cf->{"ClickPathMachineTable"}->{$serverip} ) {
$session_ip=$cf->{"ClickPathMachineTable"}->{$serverip}->[0];
$r->subprocess_env('ClickPathMachineName'=>
$cf->{"ClickPathMachineTable"}->{$serverip}->[0]);
$r->subprocess_env('ClickPathMachineStore'=>
$cf->{"ClickPathMachineTable"}->{$serverip}->[1])
if( length $cf->{"ClickPathMachineTable"}->{$serverip}->[1] );
} else {
$r->server->log->error( "Cannot find myself ($serverip) in ClickPathMachineTable" )
if( exists $cf->{"ClickPathMachineTable"} );
$session_ip=MIME::Base64::encode_base64
( pack( 'C*', split /\./, $serverip, 4 ), '' );
$session_ip=~s/={0,2}$//;
}
}
my $session=pack( 'NNnN',
$r->request_time, $$, $rcounter++,
$r->connection->id );
$rcounter%=2**16;
$session=pack( 'C', Digest::CRC::crc8( $session ) ).$session;
if( exists $cf->{ClickPathSecret} ) {
my $crypt=Crypt::CBC->new(
-key=>$cf->{ClickPathSecret},
-keysize=>length($cf->{ClickPathSecret}),
-cipher=>'Crypt::Blowfish',
-literal_key=>1,
-header=>'none',
-iv=>$cf->{ClickPathSecretIV},
);
$session=$crypt->encrypt( $session );
}
$session=MIME::Base64::encode_base64( $session, '' );
$session=~s/={0,2}$//;
$session=$session_ip.':'.$session;
$session=~tr[+/][@\-];
$session.=','.$ref;
$session=~tr[A-Za-z0-9@\-,][N-Za-z0-9@\-,A-M];
$r->subprocess_env( SESSION=>$session );
$r->subprocess_env( SESSION_START=>$r->request_time );
$r->subprocess_env( SESSION_AGE=>0 );
$r->subprocess_env( CGI_SESSION=>'/'.$tag.$session );
$r->pnotes( __PACKAGE__.'::newsession'=>$newsession );
#print STDERR "$$: Using new session $session\n";
}
}
return Apache2::Const::DECLINED
}
sub OutputFilter {
my $f=shift;
my $sess;
my $host;
my $sprefix;
my $context;
my ($re0, $re1, $re2, $re3, $re4, $the_request);
unless ($f->ctx) {
my $r=$f->r;
if( $r->main ) {
# skip filtering for subrequests
$f->remove;
return Apache2::Const::DECLINED;
}
$sess=$r->subprocess_env('CGI_SESSION');
unless( defined $sess and length $sess ) {
$f->remove;
return Apache2::Const::DECLINED;
}
$sprefix=$r->pnotes( __PACKAGE__.'::tag' );
unless( defined $sprefix and length $sprefix ) {
$f->remove;
return Apache2::Const::DECLINED;
}
$host=$r->headers_in->{Host};
( run in 0.986 second using v1.01-cache-2.11-cpan-e1769b4cff6 )