view release on metacpan or  search on metacpan

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

    }
    
    # Check for valid key format
    unless (CheckSidFormat($serverkey)) {
	# Not good, dude.  This should not happen
	$self->Log($r, ('error', "GetServerKey(): Invalid server session key (CheckSidFormat() failure) for $auth_name"));
	return undef;
    }

    return $serverkey;
}


# Apply the configured BasicAuthMap to the passed in credentials
# BasicAuthMap allows for flexibly parsing a single line of authentication
# data into multiple credentials in any order.  (Keep those users happy...)
# Returns an array with the parsed credentials in order, or an empty set on
# failure.
sub ApplyAuthMap {
    my ($self, $r, $pass, $amc) = @_;
    my $auth_name = ($r->auth_name) || ('');
    my ($o, $m, $i, @ct);
    my @creds = ();

    # Check basic map format
    ($r->dir_config("${auth_name}BasicAuthMap") =~ /^\s*([\d\,]+)\s*\=\s*(.+?)\s*$/) || (die("ApplyAuthMap(): Bad format in ${auth_name}BasicAuthMap\n"));
    $o = $1;
    $m = $2;
    
    # Try to map values from pass string
    (@ct) = $pass =~ /^$m$/;
    unless (scalar(@ct) eq $amc) {
	$self->Log($r, ('warn', "ApplyAuthMap: Unable to match credentials with ${auth_name}BasicAuthMap"));
	return ();
    }
    
    # Check credential numbers for sanity and assign values
    foreach $i (split(',', $o)) {
	($i =~ s/^\s*(\d+)\s*$/$1/) || (die("ApplyAuthMap(): Bad mapping format in ${auth_name}BasicAuthMap\n"));
	push(@creds, $ct[$i - 1]);
    }
	    
    return @creds;
}


# Gather header and argument items from request to build custom session
# authentication key.  Not nearly as secure as random generation, but
# for cookie losing clients (generally automated), it is the only choice.
#
# Synatax:
#
#    TYPE:NAME
#
# TYPE - Type of item (header or arg) to pull in
# NAME - Name of header or argument to pull in
#
# The name match is case insensitive, but strict:  Only the exact names
# will be used to ensure a consistent key text source.  MAKE SURE TO USE
# PER-CLIENT UNIQUE VALUES!  The less random the key text source is, the
# easier it can be guessed/hacked. (Once again: Do not use the custom
# key text source feature if you can avoid it!)
sub FetchKeysource {
    my ($self, $r) = @_;
    my $auth_name = ($r->auth_name()) || (die("FetchKeysource(): No auth name defined!\n"));
    my @srcs = $r->dir_config->get("${auth_name}Keysource");
 
    # Return empty, which session key creators MUST interpret as a request
    # for a fully randomized key
    return '' unless (scalar @srcs);

    # Use Apache::Request for immediate access to all arguments.
    my $ar = ($MP eq 1) ? Apache::Request->instance($r) : Apache2::Request->new($r);

    my ($s, $t);
    my $keytext = '';
    
    # Pull values in with very moderate checking
    foreach $s (@srcs) {
	if ($s =~ /^\s*header:([\w\d\-\_]+)\s*$/i) {
	    if ($r->headers_in->{$1} and
		($t) = $r->headers_in->{$1} =~ /^\s*([\x20-\x7e]+?)\s*$/s) {
		$keytext .= $t;
		$self->Log($r, ('debug', "FetchKeysource(): Collected $s: " . XHalf($t)));
	    } else {
		$self->Log($r, ('warn', "FetchKeysource(): Missing header field: \"$1\": Can not calculate session key"));
		return undef;
	    }
	} elsif ($s =~ /^\s*arg:([\w\d\.\-\_]+)\s*$/i) {
	    if (($t = $ar->param($1)) && ($t =~ s/^\s*([^\r\n]+?)\s*$/$1/)) {
		$keytext .= $t;
		$self->Log($r, ('debug', "FetchKeysource(): Collected $s: " . XHalf($t)));
	    } else {
		$self->Log($r, ('warn', "FetchKeysource(): Missing argument: \"$1\": Can not calculate session key"));
		return undef;
	    }
	} else {
	    $self->Log($r, ('error', "FetchKeysource(): Invalid Keysource definition for $auth_name"));
	    return undef;
	}
    }
    
    return $keytext;
}

# Initiate a new session and return a session key.  Takes the $r request (for
# record keeping), the username, and an optional "alter list" to be used
# to change cookies and/or headers sent from the proxy to the backend server.
sub CreateSession {
    my ($self, $r, $username, $alterlist) = @_;
    (defined($alterlist)) || ($alterlist = {});    
    my (%sess, $sid, $sessconfig, $kt);
    
    # Extract the session config
    ($sessconfig = $self->GetSessionConfig($r)) || (die "CreateSession(): Unable to get session configuration while creating new session");
    
    # Create a session auth key to send back to send back as the cookie
    # value, and to use the HMAC-SHA and optional session file encryptor.
    # FetchKeysource returns "" by default, resulting in a fully randomized
    # key.
    $kt = $self->FetchKeysource($r);