view release on metacpan or  search on metacpan

lib/Apache2/xForwardedFor.pm  view on Meta::CPAN

use Apache2::Const qw(:common);

sub handler {
	my 	( $r )= shift;
	return DECLINED if $r->uri eq '/favicon.ico';
	DEBUG && print STDERR "\n============================ Apache2::xForwardedFor";

	my 	$x_forwarded_for__header_name= $r->dir_config->get('xForwardedForAlternateHeaderName') || 'X-Forwarded-For' ;
	my 	$require_header= $r->dir_config->get('xForwardedForRequire') || undef;
	
	# for testing purposes, toss in a local header value
	TEST && $r->headers_in->set( $x_forwarded_for__header_name=> '10.0.1.140' );
	my 	$x_forwarded_for__header_value= $r->headers_in->{ $x_forwarded_for__header_name };

	# if we are requiring a header to be sent, and its not there, fail immediately
	if ( $require_header ) {
		DEBUG && print STDERR "\nRequire: true";
		if ( !$x_forwarded_for__header_value ) {
			DEBUG && print STDERR "\n \theader missing";
			return FORBIDDEN;
		}
	}

	# if we are requiring an additional header to be sent, and its not there or doesn't match, fail immediately
	if 	( my $require_header_other_name= $r->dir_config->get('xForwardedForRequireHeaderName') ) {
		if ( TEST ) {
			my 	@allowable_names= $r->dir_config->get('xForwardedForRequireHeaderValue');
			$r->headers_in->set( $require_header_other_name=> $allowable_names[0] );
		}
		DEBUG && print STDERR "\nRequire Additional Header: true";
		my 	$require_header_other_value= $r->headers_in->{ $require_header_other_name };
		if 	( !$require_header_other_value ) {
			DEBUG && print STDERR "\n \tadditional required header missing";
			return FORBIDDEN;		
		}
		my 	%values_accept= map { $_=> 1 } $r->dir_config->get('xForwardedForRequireHeaderValue');
		if ( !$values_accept{ $require_header_other_value } ) {
			DEBUG && print STDERR "\n \tadditional required header invalid";
			return FORBIDDEN;		
		}
	};
	

    # Block based on Remove / Add AcceptForwarder values
    
	my 	$_accept= 0;
    my 	$remote_ip= $r->connection->remote_ip ;
	TEST && ( $remote_ip= '192.168.1.2');
	DEBUG && print STDERR "\n remote_ip__proxy: ". $remote_ip;
		my %ips_accept= map { $_=> 1 } $r->dir_config->get('xForwardedForAccept');
		if ( exists $ips_accept{$remote_ip} ) {
			$_accept= 1;
		}
		my %ips_deny= map { $_=> 1 } $r->dir_config->get('xForwardedForDeny');
		if ( exists $ips_deny{$remote_ip} ) {
			$_accept= -1;
		}

	if 	( $_accept < 0 ) {
		DEBUG && print STDERR "\n ip in blocked list";
		return FORBIDDEN;
	}
	elsif ( !$_accept && $require_header) {
		DEBUG && print STDERR "\n ip not passed, and header required";
		return FORBIDDEN;
	}
	elsif ( !$_accept && !$require_header) {
		DEBUG && print STDERR "\n ip not passed, but header not required";
	}
	

    DEBUG && print STDERR "\n x_forwarded_for__header_value: ".$x_forwarded_for__header_value;
    # Extract the desired IP address
    if ( my ($ip)= $x_forwarded_for__header_value=~ /^([\d\.]+)/ ) {
        DEBUG && print STDERR "\n original remote_ip: ". $remote_ip;
        $r->connection->remote_ip($ip);
        DEBUG && print STDERR "\n new remote_ip: ".$r->connection->remote_ip;
    } 
    else {
        # do nothing if no ip is in forwarded-for header
		# should we toss an error if this is because we couldn't parse an ip, but the header was there?
        DEBUG && print STDERR "\n no ip change";
    }

	# stacked handlers should still run off this
	return OK;
};

=head1 NAME

Apache2::xForwardedFor - Re-set remote_ip to incoming client's ip when running mod_perl behind a reverse proxy server. 
In other words, copy the first IP from B<X-Forwarded-For> header, which was set by your reverse proxy server, 
to the B<remote_ip> connection property.

=head1 SYNOPSIS

  in httpd.conf

    PerlModule Apache2::xForwardedFor
	PerlSetVar  xForwardedForRequire 1
	PerlSetVar  xForwardedForAccept 192.168.1.1
	PerlAddVar  xForwardedForAccept 192.168.1.2
	PerlPostReadRequestHandler Apache2::xForwardedFor
	
  also note:
  	PerlSetVar  xForwardedForRequireHeaderName X-Internal-Password
	PerlSetVar  xForwardedForRequireHeaderValue shibby

  or:
    PerlSetVar  xForwardedForRequireHeaderName X-Forwarded-Server
	PerlSetVar  xForwardedForRequireHeaderValue lanServer1
	PerlAddVar  xForwardedForRequireHeaderValue lanServer2


=head1 USAGE

At this time you simply need to load the module and add it to the PerlPostReadRequestHandler phase of your mod_perl-enabled httpd, and set a few variables.

Apache2::xForwardedFor is really flexible and does some very odd ( but neat! ) things