view release on metacpan or  search on metacpan

RewritingProxy.pm  view on Meta::CPAN

    # if (!$expires )
      # {
      # $expires = ht_time(time+3600, '%Y-%m-%d %H:%M:%S',0);
      # }
    my $proxiedCookieJar = HTTP::Cookies->new(
	File => "$jar",
	ignore_discard=>1,
	AutoSave=>1);
    $proxiedCookieJar->load();
    $proxiedCookieJar->set_cookie($version,$key,$val,$path,
	$domain,$port,$path_spec,$secure,$expires);
    $proxiedCookieJar->save();
    }
    
  if ($res->code =~ /^3/)
    {
    # This means it was a server redirect.
    # We should process the headers and insert 
    # ourselves into the headers everywhere we need to.
    my $textHeaders = $res->headers_as_string;


    # We need the address of the current script.
    my ($tmpUri,$junk) = split (/\/http/i, $r->uri);
    my $script_home = $r->get_server_name .":".
	$r->server->port . $tmpUri;

    # Replace any redirect links with a link pointing through us.
    if ($textHeaders =~ /Location: http:/i)
      {
      $textHeaders =~ s#http:#http://$script_home/http:#i;
      }
    else
      {
      $textHeaders =~ s#Location: (.*)
#Location: http://$script_home/$url$1#i;
      }
    # Dump out the headers as though we had created them.
    # Nothing like a little bit of http-plagiarism.
    $r->send_cgi_header($textHeaders); 
    }


  # We only process html documents.  Maybe someday we will
  # work on other types, but there is no need right now since 
  # this program only wants to look at web pages anyhow.
  if ($res->content_type =~ /html/i)
    {
    my $content = $res->content;                 # The actual text
    my $outString = "";				 # The content the user sees
    my $baseHref = "";				 # storage space for <base
    my $p = HTML::TokeParser->new(\$content)
	|| $r->log_error("No Content: $!"); 
		# TODO: This needs to be changed from warn!
    while (my $tolkens = $p->get_token )
      {
      my $text = "";
      # We process all of the possible token types.  
      # text and comments are printed unmolested to the browser.
      # Javascript would have to be parsed out by editing the text
      # between script tags.
      if ($tolkens->[0] eq 'T')
	{
  	if ($textHandlerSub)
	  {
          $outString .= &{$textHandlerSub}($r,$tolkens->[1]);
	  }
	else
	  {
          $outString .= mainTextHandler($r,$tolkens->[1]);
	  }
      	# $outString .= $tolkens->[1];
	}
      elsif ($tolkens->[0] eq 'C')
	{
	# HTML COmments. Wrap them back in their comment tags and
	# send em on to the browser...
	$outString .= "<!-- ".$tolkens->[1]." -->";
	}
      elsif ($tolkens->[0] eq 'S' && ($tolkens->[1] eq 'a' ||
	$tolkens->[1] eq 'A'))
	{
        $text = $tolkens->[4];
        if ($tolkens->[2]{href})
          {
          my $newLink = &fixLink($r,$tolkens->[2]{href},$url);
	  $tolkens->[2]{href} = regexEscape($tolkens->[2]{href});
          $text =~ s($tolkens->[2]{href})($newLink)gsx;
          }
        $outString .= $text;
	}
      elsif ($tolkens->[0] eq 'E')
	{
	$outString .= "</" . $tolkens->[1] . ">";
	}
      elsif ($tolkens->[1] =~ /^base$/i && $tolkens->[0] eq 'S')
  	{
	$text = $tolkens->[4];
        if ($tolkens->[2]{href})
	  {
	  my $newLink = &fixLink($r,$tolkens->[2]{href},$url);
	  $text =~ s#$tolkens->[2]{href}#$newLink#;

          $url = $tolkens->[2]{href};
	  }
	$outString .= $text;
	}
      elsif ($tolkens->[1] =~ /^meta$/i)
  	{
	$text = $tolkens->[4];
        if ($tolkens->[2]{content} =~ /url/i)
	  {
	  my ($junk,$tmpLink) = split (/=/, $tolkens->[2]{content});
	  my $newLink = &fixLink($r,$tmpLink,$url);
	  $tmpLink = regexEscape($tmpLink);
	  $text =~ s#$tmpLink#$newLink#;
	  }
	$outString .= $text;
	}
      elsif ($tolkens->[1] =~ /^(area|link)$/i && $tolkens->[0] eq 'S')