view release on metacpan or  search on metacpan

ProxyRewrite.pm  view on Meta::CPAN

# Agreement and does not cure such failure in a reasonable period of
# time after becoming aware of such noncompliance. If all Recipient's
# rights under this Agreement terminate, Recipient agrees to cease use
# and distribution of the Program as soon as reasonably practicable.
# However, Recipient's obligations under this Agreement and any
# licenses granted by Recipient relating to the Program shall continue
# and survive.
#
# IBM may publish new versions (including revisions) of this Agreement
# from time to time. Each new version of the Agreement will be given a
# distinguishing version number. The Program (including Contributions)
# may always be distributed subject to the version of the Agreement
# under which it was received. In addition, after a new version of the
# Agreement is published, Contributor may elect to distribute the
# Program (including its Contributions) under the new version. No one
# other than IBM has the right to modify this Agreement. Except as
# expressly stated in Sections 2(a) and 2(b) above, Recipient receives
# no rights or licenses to the intellectual property of any
# Contributor under this Agreement, whether expressly, by implication,
# estoppel or otherwise. All rights in the Program not expressly
# granted under this Agreement are reserved.
#
# This Agreement is governed by the laws of the State of New York and
# the intellectual property laws of the United States of America. No
# party to this Agreement will bring a legal action under this
# Agreement more than one year after the cause of action arose. Each
# party waives its rights to a jury trial in any resulting litigation.
#
###############################################################################


# Package name
package Apache::ProxyRewrite;


# Required libraries
use strict;
use Apache;
use Apache::Constants qw(OK AUTH_REQUIRED DECLINED DONE);
use Apache::Log;
use Apache::URI;
use LWP::UserAgent;
use Socket;
use URI::Escape qw(uri_unescape);


# Global variables
$Apache::ProxyRewrite::VERSION = '0.17';
$Apache::ProxyRewrite::PRODUCT = 'ProxyRewrite/' .
  $Apache::ProxyRewrite::VERSION;
my %LINK_ELEMENTS =
( # These represent all the possible valid tags that have links in them
 'a'       => 'href',
 'applet'  => {
               'archive'    => 1,
               'code'       => 1,
               'codebase'   => 1,
              },
 'area'    => 'href',
 'base'    => 'href',
 'body'    => 'background',
 'embed'   => 'src',
 'form'    => 'action',
 'frame'   => 'src',
 'img'     => {
               'src'        => 1,
               'lowsrc'     => 1,
               'usemap'     => 1,
              },
 'input'   => 'src',
 'isindex' => 'action',
 'link'    => {
               'href'       => 1,
               'src'        => 1,
              },
 'meta'    => {
               'content'    => 1,
               'http-equiv' => 1,
              },
 'object'  => {
               'classid'    => 1,
               'codebase'   => 1,
               'data'       => 1,
               'name'       => 1,
               'usemap'     => 1,
              },
 'script'  => 'src',
 'td'      => 'background',
 'th'      => 'background',
 'tr'      => 'background',
);


###############################################################################
###############################################################################
# handler: hook into Apache/mod_perl API
###############################################################################
###############################################################################
sub handler {
  my $r = shift;
  my %mappings = ();
  my ($auth_info, $auth_redirect, $remote_location) = undef;

  %mappings = split(/\s*(?:=>|,)\s*/, $r->dir_config('ProxyRewrite'));
  $auth_info = $r->dir_config('ProxyAuthInfo');
  $auth_redirect = $r->dir_config('ProxyAuthRedirect') || 'Off';
  if ($r->dir_config('ProxyTo')) {
    $remote_location = $r->dir_config('ProxyTo');
  } else {
    $r->log->error("ProxyRewrite::handler: ProxyTo directive must be defined");
    return DECLINED;
  }

  # Automatically add a mapping for the remote relative URI and the
  # current location. Also capture remote site information.
  $remote_location =~ m!^([^:]+://[^/]+)(/?.*)!;
  my $remote_site = $1;
  if ($2) {
    $mappings{$2} = $r->location;
  } elsif ($r->location eq '/') {
    $mappings{'/'} = $r->location;
  } else {
    $mappings{'/'} = $r->location . '/';
  }

  $r->log->debug("handler: Remote Site - $remote_site");
  $r->log->debug("handler: Remote Location - $remote_location");
  $r->log->debug("handler: Auth Info - $auth_info");
  foreach my $map (keys(%mappings)) {
    # Standardize host on lowercase
    if ($map =~ m!([^:]+://)([^/]+)(.*)!) {
      my $mapping = $mappings{$map};
      delete $mappings{$map};
      my ($protocol, $url_host, $uri) = ($1, $2, $3);
      $url_host =~ tr/A-Z/a-z/;
      $map = $protocol . $url_host . $uri;
      $mappings{$map} = $mapping;
    }
    $r->log->debug("handler: Mapping $map to $mappings{$map}");
  }

  # fetch URL
  $r->log->info("ProxyRewrite: Preparing to fetch ", $r->uri,
		" at time ", time);
  my $response = &fetch($r, $remote_location, $remote_site,
			$auth_info, \%mappings);

  # rewrite response URIs as needed
  $r->log->info("ProxyRewrite: Preparing to rewrite URIs for ", $r->uri,
		" at time ", time);