view release on metacpan or  search on metacpan

RewritingProxy.pm  view on Meta::CPAN

   # really silly that I had done...
   # set name that will prefix all URLs.  Add trailing slash if not
   # included in location
   $script_name = $r->location();
   ($script_name,$junk) = split (/http:/, $script_name);
   $script_name .= '/'  if $script_name !~ m#/$#o;


   if ($r->server->port != 80)
     {
     $server_name .= ":".$r->server->port;
     }

  $hostname = "$protocol//$hostname";
  if ($r->server->port != 80)
    {
    $server_name .= ":".$r->server->port;
    }
  if ($link =~ /^http:/i)
    {
    return "http://". $server_name. $script_name . $link;
    }
  elsif ($link =~ /^mailto:/i)
    {
    return $link;
    }
  elsif ($link =~ /^\//)
    {
    return "http://". $server_name. $script_name . $hostname . $link;
    }
  elsif ($link =~ /^\w/)
    {
    if ($urlPath)
      {
      return "http://". $server_name.$script_name.$hostname.
	"/".$urlPath. "/".$link;
      }
    else
      {
      return "http://". $server_name.$script_name.$hostname.
	"/".$link;
      }
    }
  elsif ($link =~ /^\.\./)
    {
    # FOR THE LOVE OF GOD!!! WHY MUST THEY DO THIS!?!?!
        return "http://". $server_name.$script_name.$hostname.
        "/".$urlPath. "/".$link;
    }
  } #end of sub fixLink

# This is the function that one would replace if one were to 
# want to change the way this program handled text.
sub mainTextHandler
  {
  my $r = shift;
  my $string = shift;
  return($string);
  }

# We just escape the necessary crap in the URL we are given so that
# it can then be compared in a regex and all will be happy
sub regexEscape
  {
  my $url = shift;
  # This silly little regex fixes (*&?+|) in the URL for me.
  # withhout this regex, any of these characters in a URL will
  # cause a server error (unless they resolve into something
  # sensible to regex, in which case the server does something
  # magical and unpredictable with the URL)
  $url =~ s/(\-|\[|\]|\(|\)|\*|\+|\?|\||\&)/\\$1/g;
  return $url;
  }


1;

__END__

=head1 NAME

Apache::RewritingProxy - proxy that works by rewriting requested documents with no client proxy config needed.

=head1 SYNOPSIS

# Configuration in httpd.conf

	<Location /foo>
	SetHandler perl-script
	PerlHandler Apache::RewritingProxy
	Options ExecCGI
	PerlSendHeader On
	</Location>

requests to /foo/http://domain.dom/ will return the resource located at
http://domain.dom with all links pointing to /foo/http://otherlink.dom

=head1 DESCRIPTION

This module allows proxying of web sites without any configuration changes
on the client's part.  The client is simply pointed to a URL using this
module and it fetches the resource and rewrites all links to continue
using this proxy.  

RewritingProxy can also now be subclassed to allow users to write different
handlers for the text. See the eg for examples of this in action.

=head1 INSTALLATION


perl Makefile.PL;
make;
make install;

=head1 REQUIREMENTS

You need the following modules installed for this module to work:

  LWP::UserAgent
  HTML::TokeParser
  URI::URL