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 )