view release on metacpan or  search on metacpan

RewritingProxy.pm  view on Meta::CPAN

  my $r = shift;
  my $url = shift;
  my $ua = new LWP::UserAgent;
  # As we form the request to go to the remote server,
  # We should stuff any cookies that might be relavant
  # into the request.  We need to use the Table class
  # here to fetch the cookies and see what cookies 
  # apply to $url.  We then sent those cookies 
  # in the request after yanking out our own URL from 
  # the cookies.
  
  # Fetch a cookie named RewritingProxy from the client.
  my $cookieKey;
  my $clientCookies = $r->header_in('Cookie');
  my @clientCookiePairs = split (/; /, $clientCookies);
  my $thisClientCookiePair;
  foreach $thisClientCookiePair (@clientCookiePairs)
    {
    my ($name,$value) = split (/=/, $thisClientCookiePair);
    $cookieKey = $value if ($name eq "RewritingProxyCookieJar");
    }

  # Set the cookie to be the client's current IP (doesn' really matter).
  # Set the cookie to expire in 6 months.
  # TODO: Make this thing refresh if a client keeps using the proxy.
  if (!$cookieKey)
    {
    $cookieKey = $r->get_remote_host();
    my $cookieString = "RewritingProxyCookieJar=$cookieKey; expires=".
      ht_time(time+518400). "; path=/; domain=".$r->get_server_name;	
    $r->header_out('Set-Cookie'=>$cookieString);
    }
    
  # We now need to open the User's cookie jar and see if any cookies 
  # need to be sent to this particular server.
  $jar = "$Apache::RewritingProxy::cacheRoot/cookies/$cookieKey";
  $serverCookies = HTTP::Cookies->new(
	File => "$jar",
        ignore_discard=>1,
        AutoSave=>1);
  # Load the cookies into memory...
  $serverCookies->load() if (-e $jar);

  # Let's take care of Referer also.
  my $referer = $r->header_in('Referer');
  my $script_name = $r->location;
  $referer =~ s/(.*$script_name\/)//i;

  # Let's carry the User Agent to the server also.
  # TODO: We need to include the proxied via header here.
  my $browser = $r->header_in('User-Agent');
  $ua->agent($browser);

  # We have to append the query string since it got munged by
  # apache when this was first requested.
  my $rurl = $url;
  $rurl .= "?". $r->args if ($r->args && $url !~ /\?/);

  if ($r->method eq 'GET')
    {
    $req = new HTTP::Request 'GET' => "$rurl";
    $req->header('Referer'=>"$referer");
    $serverCookies->add_cookie_header($req);
    # This needs to be a simple request or else the redirects will 
    # not work very nicely.  LWP is too smart sometimes.
    $res = $ua->simple_request($req);
    }
  elsif ($r->method eq 'POST')
    {
    # This is a little bit of tricky ju ju here.
    # We will use another PERLy package to 
    # prepare the URL and pack in the encoded form data.
    use URI::URL;
    my %FORM;
    $req = new HTTP::Request 'POST' => "$rurl";
    $req->header('Referer'=>"$referer");
    $req->content_type('application/x-www-form-urlencoded');
    $serverCookies->add_cookie_header($req);
    # $req->content('$buffer');
    my $pair;
    my @pairs = split (/&/, $r->content);
    # TODO: This next bit more efficiently.
    # It works for the occasional cgi, but not for constant
    # hammering away at this code.  There has to be a better
    # and more OOP way.
    foreach $pair (@pairs)
      {
      my ($name, $value) = split (/=/, $pair);
      # Un-Webify plus signs and %-encoding
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $FORM{$name} = $value;
      }
    # Now we build the new URL structure with the form data
    # to be sent to the server on the client's behalf.
    my $curl = url("http:");
    $curl->query_form(%FORM);
    $req->content($curl->equery);
    $res = $ua->simple_request($req);
    }

  # We need to store any cookies the server sent to us for future use.

  #Old cookie jar...

  # TODO: Make this much much better.  We still need to lock the cookie
  # jar to keep simultaneous requests from killing each others' changes.
  while (-e "$Apache::RewritingProxy::cacheRoot/cookies/$cookieKey.lock")
	{sleep(1);}
  open (LOCK, ">$Apache::RewritingProxy::cacheRoot/cookies/$cookieKey.lock");
  print LOCK " ";
  close LOCK;
  # New cookies sent by the server...
  my $responseCookies = HTTP::Cookies->new;
  $responseCookies->extract_cookies($res);
  $responseCookies->scan(\&storeCookies);
  # Store the old plus the new...
  # $proxiedCookieJar->save();
  unlink ("$Apache::RewritingProxy::cacheRoot/cookies/$cookieKey.lock");


  sub storeCookies
    {
    my $version = shift;
    my $key = shift;
    my $val = shift;
    my $path = shift;
    my $domain = shift;
    my $port = shift;
    my $path_spec = shift;
    my $secure = shift;
    my $expires = shift;
    my $discard = shift;
    my $hash = shift;