view release on metacpan or  search on metacpan

lib/Apache2/ClickPath.pm  view on Meta::CPAN

      $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' );
      $r->subprocess_env->unset( 'REMOTE_SESSION' );
      $r->subprocess_env->unset( 'REMOTE_SESSION_HOST' );
    } else {
      if( $ref=~s!^\w+://([^/]+)/+!/! ) {
	my $host=$1;
	my ($tab)=_get_friendly_session( $cf );
	my $el=($tab || {})->{$host};

	if( $el ) {
	  local $_;
	  my $args;
	  ($ref, $args)=split /\?/, $ref, 2;
	  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(