view release on metacpan or  search on metacpan

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

			$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{$_});
				}
			}

			$value = "";
			foreach (keys %cookiehash) {
				$value .= "$_=".$cookiehash{$_}."; ";
			}

			$r->warn("new cookie data is '$name'='$value'") unless ($Apache::FilteringProxy::logging < 2);

			# Cookie headers may occur multiple times
			if ($value =~ /\S/) {
				$request->push_header ($name, $value);
			}
		} else {
			# push remaining headers as long as they aren't in our bad
			# list, because some of them will cause problems
			#
			# user-agent      - we will set this later
			# accept-encoding - we don't want to get encoded (gzip, compressed)
			#                   content & try to filter it
			# don't need to be kept by a proxy (affect only the immediate
			# connection)
			#     connection, keep-alive, TE, Trailers, Transfer-Encoding,
			#     Upgrade, Proxy-Authenticate, Proxy-Authorization
			if ($name !~ m/^(connection|keep-alive|user-agent|te|trailers|transfer-encoding|accept-encoding|upgrade|proxy-authenticate|proxy-authorization)$/i) {
				$request->header ($name, $value)
			} else {
				$r->warn("ignoring header '$name'='$value'") unless ($Apache::FilteringProxy::logging < 2);
			}
		}

		return 1;
	});

	# set this X-header so that aware developers/servers can be intelligent
	# when working with us.  May need to be removed if at some point this is
	# used by someone to deny access/foil our attempts to proxy.
	$request->header('X-FilteringProxy', '1');

	# If method is POST, we have to grab the posted data and stick it into
	# the request object to be sent with the request to the remote server
	if ($r->method eq 'POST') {
		my $len = $r->header_in('Content-length');
		my $content;
		$r->read($content, $len);
		$request->content($content);
	}

	# create our user agent object to prepare our request to the remote server
	my $ua = __PACKAGE__->new;

	# if we have defined a proxy, then make the actual requests using that
	# proxy by telling our user agent object what proxy to use
	if (defined($Apache::FilteringProxy::proxy_url) && $Apache::FilteringProxy::proxy_url) {
		$ua->proxy('http', $Apache::FilteringProxy::proxy_url);
	}

	# set our user agent to be the user agent that the client told us it was
	my $agent = $r->header_in ('User-agent');
	$ua->agent ($agent ? $agent : '');

	# now initiate a transation with the remote server (get the data).
	# we will take the data retrieved, read it in and send the data back to
	# the client, after filtering it if we are supposed to.
	my $response = $ua->request ($request);

	$r->warn("response code is '".$response->code."'") unless ($Apache::FilteringProxy::logging < 2);

	if ($response->is_error()) {
		# something died (remote server, network, etc.)
		# send back the HTTP::Response object's error_as_HTML() message.
		$r->content_type ('text/html');
		$r->print($response->error_as_HTML());
		$r->rflush;

		$r->warn("there was an error retreiving the document, dumping error: '".$response->error_as_HTML()."'") unless ($Apache::FilteringProxy::logging < 1);

		return OK;
	}

	# set our status and status line
	$r->status ($response->code());
	$r->status_line ($response->status_line());

	$r->warn("response code/message/status_line: '".$response->code()."','".$response->message()."','".$response->status_line()."'") unless ($Apache::FilteringProxy::logging < 2);