view release on metacpan or  search on metacpan

lib/Apache/AxKit/Plugin/Session.pm  view on Meta::CPAN

#==================
sub orig_get_reason($) {
#------------------
    my ($self) = @_;
    $self->debug(3,"======= orig_get_reason(".join(',',@_).")");
    my $r = Apache->request();
    my $auth_name = $r->auth_name || 'AxKitSession';
    my $auth_type = $r->auth_type || __PACKAGE__;

    parse_input();
    return $r->pnotes('COOKIES')->{$auth_type.'_'.$auth_name.'Reason'};
}
# ____ End of get_reason ____


# save args of original request so it can be replayed after a redirect
#=====================
sub orig_save_params ($$) {
#---------------------
    my ($self, $uri) = @_;
    $self->debug(3,"======= save_params(".join(',',@_).")");
    my $r = Apache->request();

    parse_input(1);
    $uri = new URI($uri);
    $uri->query_form(%{$r->pnotes('INPUT')||{}});
    return $uri->as_string;
}
# ____ End of save_params ____



# restore args of original request in $r->pnotes('INPUT')
#=======================
sub orig_restore_params ($) {
#-----------------------
    my ($self) = @_;
    $self->debug(3,"======= restore_params(".join(',',@_).")");
    my $r = Apache->request();

    parse_input();
}
# ____ End of restore_params ____



#===================
sub login_form ($) {
#-------------------
    my ($self) = @_;
    $self->debug(3,"======= login_form(".join(',',@_).")");
    my $r = Apache->request();
    my $auth_name = $r->auth_name || 'AxKitSession';
    my $authen_script;
    unless ($authen_script = $r->dir_config($auth_name.'LoginScript')) {
        $r->log_reason("PerlSetVar '${auth_name}LoginScript' missing", $r->uri);
        return SERVER_ERROR;
    }

    my $uri = uri_escape($r->uri);
    $authen_script =~ s/((?:[?&])destination=)/$1$uri/;
    $self->debug(3,"Internally redirecting to $authen_script");
    $r->custom_response(FORBIDDEN, $authen_script);
    return FORBIDDEN;
}
# ____ End of login_form ____



####################################################################################
# you don't normally need to override anything below

#================
sub debug ($$$) {
#----------------
    my ($self, $level, $msg) = @_;
    my $r = Apache->request();
    my $debug = $r->dir_config('AxDebugSession') || 0;
    $r->log_error($msg) if $debug >= $level;
}
# ____ End of debug ____

#================
sub parse_input {
#----------------
    my ($full) = @_;
    my $or = my $r = Apache->request();

    while ($r->prev) {
        $r = $r->prev;
        $r = $r->main || $r;
    }
    if ($r->pnotes('INPUT') && $r ne $or) {
            $or->pnotes('INPUT',$r->pnotes('INPUT'));
            $or->pnotes('UPLOADS',$r->pnotes('UPLOADS'));
            $or->pnotes('COOKIES',$r->pnotes('COOKIES'));
            $or->pnotes('COOKIES',{}) unless $or->pnotes('COOKIES');
	    return;
    }

    my %cookies;
    my %cookiejar = Apache::Cookie->new($r)->parse;
    foreach (sort keys %cookiejar) {
        my $cookie = $cookiejar{$_};
        $cookies{$cookie->name} = $cookie->value;
    }
    $or->pnotes('COOKIES',\%cookies);
    $r->pnotes('COOKIES',$or->pnotes('COOKIES')) if ($r ne $or);

    # avoid parsing the input so later modules can modify it
    return if (!$full);
    return if $r->pnotes('INPUT');

    # from Apache::RequestNotes  
    my $maxsize   = $r->dir_config('MaxPostSize') || 1024;
    my $uploads   = $r->dir_config('DisableUploads') =~ m/Off/i ? 0 : 1;

    my $apr = Apache::Request->instance($r,
        POST_MAX => $maxsize,
        DISABLE_UPLOADS => $uploads,