view release on metacpan or  search on metacpan

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

sub handle_cache {
    my ($self, $r) = @_;
    
    my $auth_name = $r->auth_name;
    return unless $auth_name;

    unless ($r->dir_config("${auth_name}Cache")) {
	$r->no_cache(1);
	if (!$r->headers_out->{'Pragma'}) {
	    $r->err_headers_out->{'Pragma'} = 'no-cache';
	}
    }
}

# Backdate cookie to attempt to clear from web browser cookie store
sub remove_cookie {
    my ($self, $r) = @_;
    
    my $cookie_name = $self->cookie_name($r);
    my $str = $self->cookie_string( request => $r,
				    key     => $cookie_name,
				    value   => '',
				    expires => 'Mon, 21-May-1971 00:00:00 GMT' );
    
    $r->err_headers_out->add("Set-Cookie" => "$str");
    
    $self->Log($r, ('debug', "remove_cookie(): removed_cookie \"$cookie_name\""));
}

# Convert current POST request to GET
# Note - The use of this is questionable now that Apache::Request is being
# used.  May go away in the future.
sub _convert_to_get {
    my ($self, $r) = @_;
    return unless $r->method eq 'POST';

    $self->Log($r, ('debug', "Converting POST -> GET"));

    # Use Apache::Request for immediate access to all arguments.
    my $ar = ($MP eq 1) ? 
	Apache::Request->instance($r) :
	Apache2::Request->new($r);
    
    # Pull list if GET and POST args
    my @params = $ar->param;
    my ($name, @values, $value);
    my @pairs = ();

    foreach $name (@params) {
	# we don't want to copy login data, only extra data.
	$name =~ /^(destination|credential_\d+)$/ and next;
		
	# Pull list of values for this key
	@values = $ar->param($name);
		
	# Make sure there is at least one value, which can be empty
	(scalar(@values)) or ($values[0] = '');

	foreach $value (@values) {
	    if ($MP eq 1) {
		push(@pairs, Apache::Util::escape_uri($name) . '=' .
		     Apache::Util::escape_uri($value));
	    } else {
		# Assume mod_perl 2 behaviour
		push(@pairs, Apache2::Util::escape_path($name, $r->pool) . 
		     '=' . Apache2::Util::escape_path($value, $r->pool));
	    }
	}   
    }
    
    $r->args(join '&', @pairs) if scalar(@pairs) > 0;
    
    $r->method('GET');
    $r->method_number(M_GET);
    $r->headers_in->unset('Content-Length');
}


# Handle regular (form based) login
sub login_mp1 ($$) { &login_real }
sub login_mp2 : method { &login_real }
*login = ($MP eq 1) ? \&login_mp1 : \&login_mp2;
sub login_real {
    my ($self, $r) = @_;
    my ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);
    
    # Use the magic of Apache::Request to ditch POST handling code
    # and cut to the args.
    my $ar = ($MP eq 1) ?
	Apache::Request->instance($r) :
	Apache2::Request->new($r);

    my ($ses_key, $tc, $destination, $nonce, $sig, $serverkey);
    my @credentials = ();

    # Get the hard set destination, or setup to just reload
    if ($r->dir_config("${auth_name}LoginDestination")) {
	$destination = $r->dir_config("${auth_name}LoginDestination");
    } elsif ($ar->param("destination")) {
	$destination = $ar->param("destination");
    } else {
	# Someday something slick could hold the URL, then cut through
	# to it.  Someday.  Today we die.
        $self->Log($r, ('warn', "No key 'destination' found in form data"));
        $r->subprocess_env('AuthCookieReason', 'no_cookie');
        return $auth_type->login_form($r);
    }  

    # Check form nonce and signature
    if (defined($ar->param("nonce")) and defined($ar->param("sig"))) {
	unless (($nonce = CheckSidFormat($ar->param("nonce"))) and
		($sig = CheckSidFormat($ar->param("sig")))) {
	    
	    $self->Log($r, ('warn', "Missing/invalid form nonce or sig"));
	    $r->subprocess_env('AuthCookieReason', 'no_cookie');
	    $r->err_headers_out->{'Location'} = $self->URLErrorCode($destination, 'bad_credentials');
	    $r->status(REDIRECT);
	    return REDIRECT;
	}
	$serverkey = $self->GetServerKey($r) or die("FATAL: Could not fetch valid server key\n");

	# Now check!
	unless ($sig eq ComputeSessionId($nonce, $serverkey)) {
	    # Failed!
	    $self->Log($r, ('warn', "Bad signature on posted form (Possible scripted attack)"));
	    $r->subprocess_env('AuthCookieReason', 'no_cookie');