view release on metacpan or  search on metacpan

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

		my $found = 0;
		if (!grep(/^$remote_servername$/, @{$Apache::FilteringProxy::proxy_host_include_list{$resource_id}})) {
			foreach (@{$Apache::FilteringProxy::proxy_domain_include_list{$resource_id}}) {
				$r->warn("DEBUG: testing '$remote_servername' against domain include '$_'") unless ($Apache::FilteringProxy::logging < 2);
				if ($remote_servername =~ m/([A-Za-z0-9\.\-]+\.)*$_$/i) {
					$found = 1;
					last;
				}
			}

			# we didn't find the host in the host include list or domain
			# include list for this resource
			if (!$found) {
				$r->warn("REDIRECTING: a document on an unconfigured host ('$remote_servername') for resource ('$resource_id') has been requested") unless ($Apache::FilteringProxy::logging < 1);
				if (defined($Apache::FilteringProxy::proxy_host_include_list{$resource_id})) {
					$r->warn("REDIRECTING: included hosts for this resource are: ".join(',',@{$Apache::FilteringProxy::proxy_host_include_list{$resource_id}})) unless ($Apache::FilteringProxy::logging < 2);
				}
				if (defined($Apache::FilteringProxy::proxy_domain_include_list{$resource_id})) {
					$r->warn("REDIRECTING: included domains for this resource are: ".join(',',@{$Apache::FilteringProxy::proxy_domain_include_list{$resource_id}})) unless ($Apache::FilteringProxy::logging < 2);
				}
				if (defined($Apache::FilteringProxy::proxy_host_exclude_list{$resource_id})) {
					$r->warn("REDIRECTING: excluded hosts for this resource are: ".join(',',@{$Apache::FilteringProxy::proxy_host_exclude_list{$resource_id}})) unless ($Apache::FilteringProxy::logging < 2);
				}
				if (defined($Apache::FilteringProxy::proxy_domain_exclude_list{$resource_id})) {
					$r->warn("REDIRECTING: excluded domains for this resource are: ".join(',',@{$Apache::FilteringProxy::proxy_domain_exclude_list{$resource_id}})) unless ($Apache::FilteringProxy::logging < 2);
				}

				$r->header_out("Location" => "http://$remote_servername/");
				return REDIRECT;
			}
			
			if (grep(/^$remote_servername$/i, @{$Apache::FilteringProxy::proxy_host_exclude_list{$resource_id}})) {
				$r->warn("REDIRECTING: a document on an excluded host has been requested") unless ($Apache::FilteringProxy::logging < 1);

				$r->header_out("Location" => "http://$remote_servername/");
				return REDIRECT;
			} else {
				foreach (@{$Apache::FilteringProxy::proxy_domain_exclude_list{$resource_id}}) {
					if ($remote_servername =~ m/([A-Za-z0-9\.\-]+.)*$_$/i) {
						$r->warn("REDIRECTING: a document in an excluded domain has been requested") unless ($Apache::FilteringProxy::logging < 1);

						$r->header_out("Location" => "http://$remote_servername/");
						return REDIRECT;
					}
				}
			}
		} else {
			$r->warn("DEBUG: '$remote_servername' was in host include list") unless ($Apache::FilteringProxy::logging < 2);
		}
	}

	# some servers actually barf with a port of 80 specified...let it default =P 
	my $port_string = "";
	if ($remote_port ne "80") {
		$port_string = ":$remote_port";
	}

	$r->warn("requesting document 'http://$remote_servername$port_string$path' via '".$r->method()."' method") unless ($Apache::FilteringProxy::logging < 2);

	# Create a request object to use to fetch data from the remote server
	my $request = HTTP::Request->new ($r->method, "http://$remote_servername$port_string$path");

	# Copy the headers the client gave us into the new request object
	$r->headers_in->do (sub {
		my $name = shift;
		my $value = shift || "";

		$r->warn("client header: '$name'='$value'") unless ($Apache::FilteringProxy::logging < 2);

		my $bad_header = 0;
		foreach (keys %Apache::FilteringProxy::strip_headers) {
			if ($name =~ /$_/) {
				$bad_header = 1;
			}
		}

		if ($bad_header) {
			# these are headers we have in our config file to strip
			$r->warn("stripping header '$name'='$value'") unless ($Apache::FilteringProxy::logging < 2);
		} elsif ($name =~ m/^((proxy-)?authorization)$/i) {
			# we don't want to send these to the server
			$r->warn("ignoring header '$name'='$value'") unless ($Apache::FilteringProxy::logging < 2);
		} elsif ($name =~ /^referer$/i) {
			my $new_value = $value;
			$new_value =~ s/(\.port[0-9]{1,5})?\.[^.]+\.$local_servername([^a-zA-Z0-9\-\.])/$2/;

			$r->warn("translating referer '$value' => '$new_value'") unless ($Apache::FilteringProxy::logging < 2);

			$request->header ('Referer', $new_value);
		} elsif ($name =~ /^(accept)$/i) {
			# FIXME - any mangling required for accept header?
			$request->header ($name, $value);
		} elsif ($name =~ /^(host)$/i) {
			# note - LWP automatically adds a host header
			my $new_value = $value;
			$new_value =~ s/(\.port[0-9]{1,5})?\.[^.]+\.$local_servername$//;

			$r->warn("translating hostname '$value' => '$new_value'") unless ($Apache::FilteringProxy::logging < 2);

			$request->header ('Host', $new_value);
		} elsif ($name =~ /^(cookie)$/i) {
			# strip session cookie information here if needed we don't want to
			# send cookies that were delivered to us by the browser because the
			# cookie is in our domain.  Strip anything that wasn't intended for
			# the remote domain we are proxying

			my %cookiehash;
			my @cookies = split(/\s*;\s*/, $value);
			foreach (@cookies) {
				$_ =~ /(\S*)\s*=\s*(\S*)/;
				$cookiehash{$1} = $2;
			}

			foreach (keys %Apache::FilteringProxy::strip_cookies) {
				$r->warn("stripping any cookies with name '$_'") unless ($Apache::FilteringProxy::logging < 2);
				if (exists($cookiehash{$_})) {
					$r->warn("stripped cookie '$_'='$cookiehash{$_}'") unless ($Apache::FilteringProxy::logging < 2);
					delete($cookiehash{$_});
				}
			}