view release on metacpan or  search on metacpan

AuthCookieURL.pm  view on Meta::CPAN

    
}



sub recognize_user ($$) {
    my ($self, $r) = @_;
    my $debug = $r->dir_config( DEBUG ) || 0;
    my ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);
    return unless $auth_type && $auth_name;
    # return unless $r->header_in('Cookie');

    
    my ($cookie) = ($r->header_in( 'Cookie' ) || '') =~ /${auth_type}_$auth_name=([^;]+)/;

    # Get session from URI if not set in a cookie
    # (won't likely be here if this isn't a protected doc)
    $cookie ||= $r->notes( 'URI_Session' ) || '';


    $r->log_error("session provided  = '$cookie'" ) if $debug >= 1;

    return OK unless $cookie;

    if (my ($user) = $auth_type->authen_ses_key($r, $cookie)) {
        $r->log_error("recognize user = '$user'") if $debug >= 2;
        $r->connection->user($user);
    }
    return OK;
}


# Transhandler to strip the session from the URL
#
# $r->notes('Session_prefix')      session prefix found in httpd.conf
#                                  also used to idicate to login() that trans handler in use
#
# $r-notes('URI_Session')          is the extracted session.
#                                  authenticate() uses it if no cookie
#
# $r->subprocess_env( 'SESSION' )  is set so cgi scripts can prefix to href links
#
# $r->notes( 'SESSION' )           is set for ErrorDocument fixups - prefix
#                                  Location: headers if exists (might as well use the $ENV{SESSION})


sub URLsession ( $$ ) {
    my ($self, $r) = @_;

    return DECLINED unless $r->is_initial_req;

    # I'd like to be able to do this so don't need all that httpd.conf config
    # $r->custom_response( MOVED , \&error_document );
    # $r->custom_response( REDIRECT , \&error_document );


    my $debug = $r->dir_config( DEBUG ) || 0;
    $r->log_error('TRANS:Requested URI = \'' . $r->the_request() . "'" ) if $debug >= 3;


    my ( undef, $session, $rest ) = split m[/+], $r->uri, 3;
    $rest ||= '';

    my $prefix = $r->dir_config('SessionPrefix') || 'Session-';

    # This way simply adding the PerlTransHandler is enough to enable URL munging
    $r->notes( Session_prefix => $prefix );


    return DECLINED unless $session && $session =~ /^$prefix(.+)$/;


    # Session found.  Extract and make it available in notes();

    $session = $1;

    $r->log_error("Found session '$session' in url") if $debug >= 1;

    $r->notes( URI_Session => $session );


    # Make the prefix and session available to CGI scripts for use in absolute
    # links or redirects
    
    $r->subprocess_env( SESSION => "/$prefix$session" );

    $r->notes( SESSION => "/$prefix$session" );  # for error document fixup

 
    # Remove the session from the URI
    $r->uri( "/$rest" );

    return DECLINED;
}




# Error document

# Add the session ID to location headers on redirects
# iff not using cookies and host matches

sub error_document ($$) {
    my ( $self, $r )  = @_;

    my $uri;

    # unlikely, but might as well make sure there's a location header available

    if ( $r->prev->header_out('Location') ) {

        $uri = Apache::URI->parse($r, $r->prev->header_out('Location') );

        
        my $same_host   = 1;
        my $hostname    = $uri->hostname || '';
        $same_host = 0 if $hostname && $hostname ne $r->get_server_name;


        my $session = $r->prev->notes( 'SESSION' ) || '';