view release on metacpan or  search on metacpan

lib/Apache/iNcom.pm  view on Meta::CPAN

	}

	# Parse cookies
	my $c = $r->header_in( "Cookie" );
	my $cookies = Apache::Cookie->new( $r )->parse( $c );
	$r->pnotes( "INCOM_COOKIES", $cookies );

	# Parse languages
	my $rv = i18n_init( $r );
	return $rv if $rv != OK;

    } else {
	my $prev = $r->prev;
	foreach my $name ( keys %VALID_PNOTES ) {
	    $r->pnotes( $name, $prev->pnotes( $name ) );
	}
	return OK;
    }

    # Next handler is dispatch_handler
    $r->push_handlers( PerlTransHandler => \&dispatch_handler );

    return OK;
}

sub bake_session_cookie {
    my ($r, $session_id) = @_;

    my $prefix		= $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $session_secure  = $r->dir_config( "INCOM_SESSION_SECURE" );
    my $session_domain  = $r->dir_config( "INCOM_SESSION_DOMAIN" );
    my $session_expires = $r->dir_config( "INCOM_SESSION_EXPIRES" );
    my $session_path    = $r->dir_config( "INCOM_SESSION_PATH" )
      || $prefix;

    my $cookie = new Apache::Cookie( $r,
				     -name   => "INCOM_SESSION",
				     -value  => $session_id,
				     -path   => $session_path
				   );
    $cookie->domain( $session_domain )	    if $session_domain;
    $cookie->expires( $session_expires )    if $session_expires;
    $cookie->secure( 1 )		    if $session_secure;

    # Add cookie to outgoing headers
    $cookie->bake;
}

sub session_init {
    my $r = shift;

    my %session;

    # Check if there is a session id in the cookies
    my $cookies = $r->pnotes( "INCOM_COOKIES" );
    if ( $cookies->{INCOM_SESSION} ) {
	my $session_id = $cookies->{INCOM_SESSION}->value;

	# Load the user's session
	eval {
	    # Make sure it looks like a session id
	    die "Invalid session id: $session_id\n"
	      unless length $session_id == 32 &&
		$session_id =~ tr/a-fA-F0-9/a-fA-F0-9/ == 32;

	    tie %session, 'Apache::iNcom::Session', $session_id,
	      { dbh => $r->pnotes( "INCOM_DBH"),
		Serialize => $r->dir_config( "INCOM_SESSION_SERIALIZE_ACCESS" ),
	      };

	    # Save the session for future handlers
	    $r->pnotes( INCOM_SESSION => \%session );

	    if ( $r->dir_config( "INCOM_SESSION_EXPIRES" ) ) {
		# If session doesn't expire with the browser session
		# we must renew the cookie.
		bake_session_cookie( $r, $session_id );
	    }

	};
	if ( $@ ) {
	    # The session ID is probably invalid
	    chomp $@;
	    $r->warn( "error loading session: $@" );
	} else {
	    # Return ref to session to indicate success
	    return \%session;
	}
    }

    # No valid session could be loaded
    return undef;
}


# Return the requested error code but sets a custom response
# if the error condition is present in the error map.
sub return_error {
    my ( $r, $status ) = @_;

    my $prefix = $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $map = $r->dir_config( "INCOM_ERROR_PROFILE" );
    return $status unless $map;

    $map = $r->server_root_relative( $map );
    unless ( -e $map && -f _ && -r _ ) {
	$r->warn( "INCOM_ERROR_PROFILE is not valid" );
	return $status;
    }

    my $response = eval {
	my $profile = do $map;
	unless ( ref $profile eq "HASH" ) {
	    $r->warn( "INCOM_ERROR_PROFILE didn't return an hash ref" );
	    return $status;
	}

	my $error_cond = $r->pnotes( "INCOM_ERROR" );

	$profile->{$error_cond} || $profile->{$status};
    };