view release on metacpan or  search on metacpan

ProxyRewrite.pm  view on Meta::CPAN

	    $$tagblock .= " $key=\"$value\"";
	  }
	} else {
	  $$tagblock .= " $blocks[$i]";
	}
      } else {
        $$tagblock .= " $blocks[$i]";
      }
    }
  }
}

###############################################################################
###############################################################################
# rewrite_url: rewrite URLs as per the mappings hash
###############################################################################
###############################################################################
sub rewrite_url {
  my ($r, $remote_site, $url, $mapref) = @_;

  $r->log->debug("rewrite_url: Looking at rewriting $$url");
  $r->log->debug("rewrite_url: remote_site: $remote_site");

  # Remove remote_site from URI to get just the relative-from-root information
  if ($$url =~ s/^$remote_site//) {
    $r->log->debug("rewrite_url: Shrunk to $$url");
  }

  # Standardize host on lowercase
  if ($$url =~ m!([^:]+://)([^/]+)(.*)!) {
    my ($protocol, $url_host, $uri) = ($1, $2, $3);
    $url_host =~ tr/A-Z/a-z/;
    $$url = $protocol . $url_host . $uri;
  }

  # Ensure we go from most to least specific rewrite
  foreach my $mapping (sort { $b cmp $a } keys(%$mapref)) {
    $r->log->debug("rewrite_url: Testing match of $mapping ",
		   "($$mapref{$mapping})");
    last if ($$url =~ s/^$mapping/$$mapref{$mapping}/);
  }
}

###############################################################################
###############################################################################
# respond: respond to the client
###############################################################################
###############################################################################
sub respond {
  my ($r, $remote_site, $remote_location, $auth_redirect,
      $response, $mapref) = @_;
  my $parsed_uri = Apache::URI->parse($r);

  $r->log->debug("respond: URI: ", $r->uri);
  $r->log->debug("respond: Parsed hostinfo: ", $parsed_uri->hostinfo());

  # feed reponse back into our request_record
  $response->scan(sub {
		    my ($header, $value) = @_;
		    $r->log->debug("respond: OUT $header: $value");
		    if ($header =~ /^Set-Cookie/i) {
		      $value =~ /path=([^;]+)/i;
		      my $cookie_path = $1;
		      &rewrite_url($r, $remote_site, \$cookie_path, $mapref);
		      # Handle the special case of when the value
		      # begins with a port
		      if ($cookie_path =~ /^:/) {
			$value =~ 
			  s/(path=)([^;]+)/$1$remote_site$cookie_path/i;
		      } else {
			$value =~ s/(path=)([^;]+)/$1$cookie_path/i;
		      }
		    } elsif ($header =~/^Client-Peer/i) {
		      my $local_addr = $r->connection->local_addr;
		      my ($port, $ip) =
			Socket::unpack_sockaddr_in($local_addr);
		      $ip = Socket::inet_ntoa($ip);
		      $value = "$ip:$port";
		    }
		    $r->log->debug("respond: OUT-MOD $header: $value");
		    $r->headers_out->{$header} = $value;
		  });
  $r->content_type($response->header('Content-type'));
  $r->status($response->code);
  $r->status_line(join " ", $response->code, $response->message);

  # deal with redirects
  if ($r->status =~ /(301|302)/) {
    my $location = $response->header('Location');
    &rewrite_url($r, $remote_site, \$location, $mapref);
    # Only modify location if rewritten URL is relative
    unless ($location =~ m!://!) {
      if ($location =~ m!^/!) {
	$location = $parsed_uri->scheme . '://' . $parsed_uri->hostinfo .
	  $location;
      } else {
	my $base = $r->uri;
	$base =~ s!(/)[^/]+$!$1!;
	$location = $parsed_uri->scheme . '://' . $parsed_uri->hostinfo .
	  $base . $location;
      }
    }
    $r->log->debug("respond: Location: $location");
    $r->headers_out->{'Location'} = $location;
  }

  # deal with auth required redirects
  if ($r->status == 401 && $auth_redirect =~ /^on$/i) {
    my $base = $r->location();
    my $location = '';
    if ($base ne '/') {
      ($location = $r->uri) =~ s/^$base//;
    } else {
      $location = $r->uri;
    }
    $location = $remote_location . $location;
    $r->status('302');
    $r->status_line(join " ", '302', 'Moved Temporarily');
    $r->log->debug("respond: Location: $location");
    $r->headers_out->{'Location'} = $location;
    $response->content(undef);