File Coverage

blib/lib/Apache/DNAT.pm

Criterion	Covered	Total	%
statement	7	46	15.2
branch	0	14	0.0
condition	0	9	0.0
subroutine	3	6	50.0
pod	0	3	0.0
total	10	78	12.8

package Apache::DNAT;

use strict;
use Socket qw(sockaddr_in inet_aton inet_ntoa);
eval q{use Apache::Connection; use Apache::Constants qw(DECLINED OK MOVED);};

sub handler {
  my $r = shift;
  my $c = $r->connection;
  my $old_remote_addr = $c->remote_addr;
  my ($old_port, $old_addr) = sockaddr_in($old_remote_addr);
  $old_addr = inet_ntoa $old_addr;
  if ($old_addr =~ /^(127|10|192.168|172\.(1[6-9]|2\d|3[01]))\./) {
    # Martian IP so it is safe
    my $headers = $r->headers_in;
    my $new_addr = $headers->{"remote-addr"};
    my $new_port = $headers->{"remote-port"};
    if ($new_addr && $new_port) {
      delete $headers->{"remote-addr"};
      delete $headers->{"remote-port"};
      $c->remote_addr(scalar sockaddr_in($new_port, inet_aton($new_addr)));
      $c->remote_ip($new_addr);
    }
  }

  # Now pretend like I didn't do anything.
  return DECLINED();
}


sub UnPort {
  my $r = shift;
  my $type = $r->content_type;
  if ($type && $type eq "httpd/unix-directory") {
    my $path = $r->uri;
    if ($path !~ m%/$%) {
      # Make sure the non-canonical bouncer routine runs
      $r->handler("perl-script");
      $r->push_handlers(PerlHandler => \&directory_bounce);
    }
  }
  return OK();
}

sub directory_bounce {
  my $r = shift;
  my $proto = $r->subprocess_env("https")?"https":"http";
  my $host = $r->header_in("host") || $r->hostname || $r->server->server_hostname;
  my $path = $r->uri;
  my $query = $r->args;

  my $url = "$proto://$host$path/";
  $url .= "?$query" if length $query;

  $r->status(MOVED());
  $r->content_type("text/html");
  $r->header_out(Location => $url);
  $r->send_http_header;

  return OK() if $r->header_only;
  $r->print("Moved here\n");
  return OK();
}

1;
__END__