validate results from the CPAN

Apache-AxKit-Plugin-Session
    <H1>Redirecting...</H1>
    You are being redirected <A HREF="$location">here</A>.<P>
  </BODY>
</HTML>
EOF

            $r->content_type('text/html');
            $r->send_http_header;
            $r->print($message);
            $r->rflush;
            return OK;
            }
        }

        $self->debug(6,"external redirect to self, ".$mr->uri);
        # remove session ID and externally redirect to ourselves
        if ($session && $mr->parsed_uri->path =~ /^$session/) {
            my $myuri = $mr->parsed_uri;
            $myuri->path($redirect_location.'/'.$uri->unparse);
            $uri = $myuri;
        }
        $uri->path(substr($uri->path,length($session))) if ($session && $uri->path =~ /^$session/);
    }


    my $status      = (($r->status != MOVED) && (!$r->prev || $r->prev->status != MOVED)?REDIRECT:MOVED);
    my $location    = $uri ? $uri->unparse : 'unknown';
    my $description = ( $status == MOVED ) ? 'Moved Permanently' : 'Found';
    $self->debug(6,"redirect to $location, status $status");

    my $message = <<EOF;

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<HTML>
  <HEAD>
    <TITLE>$status $description</TITLE>
  </HEAD>
  <BODY>
    <H1>$description</H1>
    The document has moved <A HREF="$location">$location</A>.<P>
  </BODY>
</HTML>
EOF

    $r->content_type('text/html');
    $r->status($status);
    $r->header_out('Location', $location);
    $r->header_out('URI', $location);
    $r->send_http_header;

    $r->print($message);

    $r->rflush;

    return $status;
}
# ____ End of fixup_redirect ____


# This one can be used as PerlHandler if a non-mod_perl script is doing the login form
# In that case, be sure to validate the login in authen_cred above!
#===============
sub login ($$) {
#---------------
    my ($self, $r, $destination ) = @_;
    $self->debug(3,"======= login(".join(',',@_).")");
    my $auth_name = $r->auth_name || 'AxKitSession';
    my $auth_type = $r->auth_type || __PACKAGE__;

    parse_input(1);
    my $args = $r->pnotes('INPUT');

    $destination = $$args{'destination'} if @_ < 3;
    if ($destination) {
        $destination = URI->new_abs($destination, $r->uri);
    } else {
        my $mr = $r;
        $mr = $mr->prev while ($mr->prev);
        $mr = $mr->main while ($mr->main);
        $destination = $mr->uri;
    }

    $self->debug(1,"destination = '$destination'");

    # Get the credentials from the data posted by the client, if any.
    my @credentials;
    while (exists $$args{"credential_" . ($#credentials + 1)}) {
        $self->debug(2,"credential_" . ($#credentials + 1) . "= '" .$$args{"credential_" . ($#credentials + 1)} . "'");
        push(@credentials, $$args{"credential_" . ($#credentials + 1)});
    }

    # convert post to get
    if ($r->method eq 'POST') {
        $r->method('GET');
        $r->method_number(M_GET);
        $r->headers_in->unset('Content-Length');
    }

    $r->no_cache(1) unless $r->dir_config($auth_name.'Cache');


    # Exchange the credentials for a session key.
    my ($ses_key, $error_message) = $self->authen_cred($r, @credentials);

    # Get the uri so can adjust path, and to redirect including the query string

    unless ($ses_key) {

        $self->debug(2,"No session returned from authen_cred: $error_message" );
        $self->save_reason($error_message) if ($r->is_main());

    } else {

        $self->debug(2,"ses_key returned from authen_cred: '$ses_key'");

        # Send cookie if a session was returned from authen_cred
        $self->send_cookie(value=>$ses_key);

        # add the session to the URI - if trans handler not installed prefix will be empty
        if (my $prefix = $r->notes('SessionPrefix')) {
            $r->notes('SESSION_URLPREFIX',"/$prefix$ses_key");
        } elsif (!$r->dir_config($auth_name.'LoginScript' ) ||
            lc($r->dir_config($auth_name.'LoginScript' )) eq 'none' ||
            $destination eq $r->uri) {

            # don't redirect if we only set a cookie
            my ($auth_user, $error_message) = $auth_type->authen_ses_key($r, $ses_key);
            $self->debug(2,"login() not redirecting, just setting cookie: user = $auth_user, SID = $ses_key");

            return SERVER_ERROR unless defined $auth_user;

            $r->notes('SESSION_ID',$ses_key);
            $r->connection->user($auth_user);
            return OK;
        }

    }

    if ($destination eq 'none') {
	$self->debug(2,"login() not redirecting: requested by application");
	return OK;
    }
    $self->debug(2,"login() redirecting to $destination");
    return $self->external_redirect($destination);
}
# ____ End of login ____



# Again, this can be used as PerlHandler or called directly
# subclass this one if you want to invalidate a session db
# entry or something like that
#================
sub orig_logout ($$) {
#----------------
    my ($self,$r, $location) = @_;
    $self->debug(3,"======= logout(".join(',',@_).")");
    my $auth_name = $r->auth_name || 'AxKitSession';
    my $auth_type = $r->auth_type || __PACKAGE__;

    # Send the Set-Cookie header to expire the auth cookie.
    $self->send_cookie(value=>'');

    $r->no_cache(1) unless $r->dir_config($auth_name.'Cache');
    $location = $r->dir_config($auth_name.'LogoutURI') if @_ < 3;
    $r->notes('SESSION_URLPREFIX',''); # so error doc doesn't fixup.
    return OK if !$location;
    $r->header_out(Location => $location);
    return REDIRECT;
}
# ____ End of logout ____



# PerlAuthenHandler, this one is the actual check point
#======================
sub authenticate ($$) {
#----------------------
    my ($self, $r) = @_;
    my $auth_type = $self;
    $self->debug(3,"======= authenticate(".join(',',@_).")");
    my ($authen_script, $auth_user);

    my $mr = $r;
    $mr = $mr->prev while ($mr->prev && !$mr->pnotes('SESSION'));
    $r->pnotes('SESSION',$mr->pnotes('SESSION'));
    # This is a way to open up some documents/directories
    return OK if lc $r->auth_name eq 'none';
    return OK if $r->uri eq $r->dir_config(($r->auth_name || 'AxKitSession').'LoginScript');
    return OK if ($r->main?$r->main->uri:$r->uri) =~ m/^$redirect_location(\/|$)/;

    # Only authenticate the first internal request
    # no. See sub authorize for rationale
    #return OK unless $r->is_initial_req;

    if (defined $r->auth_type && $r->auth_type ne $auth_type) {
        # This location requires authentication because we are being called,
        # but we don't handle this AuthType.
        $self->debug(3,"AuthType mismatch: $auth_type != ".$r->auth_type);
        return DECLINED;
    }

    my $auth_name = $r->auth_name || 'AxKitSession';
    $self->debug(2,"auth_name= '$auth_name'");

    parse_input();

    # Check and get session from cookie or URL
    my $session = $self->key;
    return REDIRECT if $session eq REDIRECT;
( run in 1.998 second using v1.01-cache-2.11-cpan-39bf76dae61 )